X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FReplicated.pm;h=9a9e05fbeeca13c9590612bde1e06bc8fd2ebbdd;hb=0e773352a;hp=ae81b7392fbf7d70faaaa3c074538367aac3e764;hpb=fd323bf1046faa7de5a8c985268d80ec5b703361;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index ae81b73..9a9e05f 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -1,9 +1,8 @@
 package DBIx::Class::Storage::DBI::Replicated;
 
 BEGIN {
-  use Carp::Clan qw/^DBIx::Class/;
   use DBIx::Class;
-  croak('The following modules are required for Replication ' . DBIx::Class::Optional::Dependencies->req_missing_for ('replicated') )
+  die('The following modules are required for Replication ' . DBIx::Class::Optional::Dependencies->req_missing_for ('replicated') . "\n" )
     unless DBIx::Class::Optional::Dependencies->req_ok_for ('replicated');
 }
 
@@ -189,7 +188,7 @@ has 'balancer_args' => (
 
 =head2 pool
 
-Is a <DBIx::Class::Storage::DBI::Replicated::Pool> or derived class.  This is a
+Is a L<DBIx::Class::Storage::DBI::Replicated::Pool> or derived class.  This is a
 container class for one or more replicated databases.
 
 =cut
@@ -207,8 +206,8 @@ has 'pool' => (
 
 =head2 balancer
 
-Is a <DBIx::Class::Storage::DBI::Replicated::Balancer> or derived class.  This
-is a class that takes a pool (<DBIx::Class::Storage::DBI::Replicated::Pool>)
+Is a L<DBIx::Class::Storage::DBI::Replicated::Balancer> or derived class.  This
+is a class that takes a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>)
 
 =cut
 
@@ -240,39 +239,10 @@ has 'master' => (
 The following methods are delegated all the methods required for the
 L<DBIx::Class::Storage::DBI> interface.
 
-=head2 read_handler
-
-Defines an object that implements the read side of L<BIx::Class::Storage::DBI>.
-
 =cut
 
-has 'read_handler' => (
-  is=>'rw',
-  isa=>Object,
-  lazy_build=>1,
-  handles=>[qw/
-    select
-    select_single
-    columns_info_for
-    _dbh_columns_info_for
-    _select
-  /],
-);
-
-=head2 write_handler
-
-Defines an object that implements the write side of L<BIx::Class::Storage::DBI>,
-as well as methods that don't write or read that can be called on only one
-storage, methods that return a C<$dbh>, and any methods that don't make sense to
-run on a replicant.
-
-=cut
-
-has 'write_handler' => (
-  is=>'ro',
-  isa=>Object,
-  lazy_build=>1,
-  handles=>[qw/
+my $method_dispatch = {
+  writer => [qw/
     on_connect_do
     on_disconnect_do
     on_connect_call
@@ -298,58 +268,45 @@ has 'write_handler' => (
     txn_commit
     txn_rollback
     txn_scope_guard
-    sth
     deploy
     with_deferred_fk_checks
     dbh_do
-    reload_row
-    with_deferred_fk_checks
     _prep_for_execute
-
-    backup
     is_datatype_numeric
-    _supports_insert_returning
     _count_select
     _subq_update_delete
     svp_rollback
     svp_begin
     svp_release
     relname_to_table_alias
-    _straight_join_to_node
     _dbh_last_insert_id
-    _fix_bind_params
     _default_dbi_connect_attributes
     _dbi_connect_info
+    _dbic_connect_attributes
     auto_savepoint
-    _sqlt_version_ok
+    _query_start
     _query_end
+    _format_for_trace
+    _dbi_attrs_for_bind
     bind_attribute_by_data_type
     transaction_depth
     _dbh
     _select_args
     _dbh_execute_array
-    _sql_maker_args
     _sql_maker
-    _query_start
-    _sqlt_version_error
     _per_row_update_delete
     _dbh_begin_work
     _dbh_execute_inserts_with_no_binds
     _select_args_to_query
     _svp_generate_name
     _multipk_update_delete
-    source_bind_attributes
     _normalize_connect_info
     _parse_connect_do
     _dbh_commit
     _execute_array
-    _placeholders_supported
     savepoints
-    _sqlt_minimum_version
     _sql_maker_opts
     _conn_pid
-    _typeless_placeholders_supported
-    _conn_tid
     _dbh_autocommit
     _native_data_type
     _get_dbh
@@ -360,30 +317,123 @@ has 'write_handler' => (
     _resolve_column_info
     _prune_unused_joins
     _strip_cond_qualifiers
-    _parse_order_by
+    _strip_cond_qualifiers_from_array
     _resolve_aliastypes_from_select_args
     _execute
     _do_query
+    _sth
     _dbh_sth
     _dbh_execute
-    _prefetch_insert_auto_nextvals
-    _server_info_hash
   /],
-);
+  reader => [qw/
+    select
+    select_single
+    columns_info_for
+    _dbh_columns_info_for
+    _select
+  /],
+  unimplemented => [qw/
+    _arm_global_destructor
+    _verify_pid
 
-my @unimplemented = qw(
-  _arm_global_destructor
-  _preserve_foreign_dbh
-  _verify_pid
-  _verify_tid
-);
+    source_bind_attributes
+
+    get_use_dbms_capability
+    set_use_dbms_capability
+    get_dbms_capability
+    set_dbms_capability
+    _dbh_details
+    _dbh_get_info
+
+    sql_limit_dialect
+    sql_quote_char
+    sql_name_sep
+
+    _inner_join_to_node
+    _group_over_selection
+    _extract_order_criteria
 
-for my $method (@unimplemented) {
+    _prefetch_autovalues
+
+    _max_column_bytesize
+    _is_lob_type
+    _is_binary_lob_type
+    _is_text_lob_type
+
+    sth
+  /,(
+    # the capability framework
+    # not sure if CMOP->initialize does evil things to DBIC::S::DBI, fix if a problem
+    grep
+      { $_ =~ /^ _ (?: use | supports | determine_supports ) _ /x }
+      ( Class::MOP::Class->initialize('DBIx::Class::Storage::DBI')->get_all_method_names )
+  )],
+};
+
+if (DBIx::Class::_ENV_::DBICTEST) {
+
+  my $seen;
+  for my $type (keys %$method_dispatch) {
+    for (@{$method_dispatch->{$type}}) {
+      push @{$seen->{$_}}, $type;
+    }
+  }
+
+  if (my @dupes = grep { @{$seen->{$_}} > 1 } keys %$seen) {
+    die(join "\n", '',
+      'The following methods show up multiple times in ::Storage::DBI::Replicated handlers:',
+      (map { "$_: " . (join ', ', @{$seen->{$_}}) } sort @dupes),
+      '',
+    );
+  }
+
+  if (my @cant = grep { ! DBIx::Class::Storage::DBI->can($_) } keys %$seen) {
+    die(join "\n", '',
+      '::Storage::DBI::Replicated specifies handling of the following *NON EXISTING* ::Storage::DBI methods:',
+      @cant,
+      '',
+    );
+  }
+}
+
+for my $method (@{$method_dispatch->{unimplemented}}) {
   __PACKAGE__->meta->add_method($method, sub {
-    croak "$method must not be called on ".(blessed shift).' objects';
+    my $self = shift;
+    $self->throw_exception("$method must not be called on ".(blessed $self).' objects');
   });
 }
 
+=head2 read_handler
+
+Defines an object that implements the read side of L<BIx::Class::Storage::DBI>.
+
+=cut
+
+has 'read_handler' => (
+  is=>'rw',
+  isa=>Object,
+  lazy_build=>1,
+  handles=>$method_dispatch->{reader},
+);
+
+=head2 write_handler
+
+Defines an object that implements the write side of L<BIx::Class::Storage::DBI>,
+as well as methods that don't write or read that can be called on only one
+storage, methods that return a C<$dbh>, and any methods that don't make sense to
+run on a replicant.
+
+=cut
+
+has 'write_handler' => (
+  is=>'ro',
+  isa=>Object,
+  lazy_build=>1,
+  handles=>$method_dispatch->{writer},
+);
+
+
+
 has _master_connect_info_opts =>
   (is => 'rw', isa => HashRef, default => sub { {} });
 
@@ -398,8 +448,6 @@ C<pool_type>, C<pool_args>, C<balancer_type> and C<balancer_args>.
 around connect_info => sub {
   my ($next, $self, $info, @extra) = @_;
 
-  my $wantarray = wantarray;
-
   my $merge = Hash::Merge->new('LEFT_PRECEDENT');
 
   my %opts;
@@ -417,8 +465,9 @@ around connect_info => sub {
       $merge->merge((delete $opts{pool_args} || {}), $self->pool_args)
     );
 
-    $self->pool($self->_build_pool)
-      if $self->pool;
+    ## Since we possibly changed the pool_args, we need to clear the current
+    ## pool object so that next time it is used it will be rebuilt.
+    $self->clear_pool;
   }
 
   if (@opts{qw/balancer_type balancer_args/}) {
@@ -435,11 +484,11 @@ around connect_info => sub {
 
   $self->_master_connect_info_opts(\%opts);
 
-  my (@res, $res);
-  if ($wantarray) {
+  my @res;
+  if (wantarray) {
     @res = $self->$next($info, @extra);
   } else {
-    $res = $self->$next($info, @extra);
+    $res[0] = $self->$next($info, @extra);
   }
 
   # Make sure master is blessed into the correct class and apply role to it.
@@ -452,7 +501,7 @@ around connect_info => sub {
   # link pool back to master
   $self->pool->master($master);
 
-  $wantarray ? @res : $res;
+  wantarray ? @res : $res[0];
 };
 
 =head1 METHODS
@@ -667,7 +716,7 @@ sub execute_reliably {
     $self->read_handler($current);
   };
 
-  return $want_array ? @result : $result[0];
+  return wantarray ? @result : $result[0];
 }
 
 =head2 set_reliable_storage
@@ -737,7 +786,7 @@ sub limit_dialect {
   foreach my $source ($self->all_storages) {
     $source->limit_dialect(@_);
   }
-  return $self->master->quote_char;
+  return $self->master->limit_dialect;
 }
 
 =head2 quote_char
@@ -1017,28 +1066,27 @@ sub _ping {
   return min map $_->_ping, $self->all_storages;
 }
 
+# not using the normalized_version, because we want to preserve
+# version numbers much longer than the conventional xxx.yyyzzz
 my $numify_ver = sub {
   my $ver = shift;
   my @numparts = split /\D+/, $ver;
-  my $format = '%d.' . (join '', ('%05d') x (@numparts - 1));
+  my $format = '%d.' . (join '', ('%06d') x (@numparts - 1));
 
   return sprintf $format, @numparts;
 };
-
 sub _server_info {
   my $self = shift;
 
-  if (not $self->_server_info_hash) {
-    my $min_version_info = (
+  if (not $self->_dbh_details->{info}) {
+    $self->_dbh_details->{info} = (
       reduce { $a->[0] < $b->[0] ? $a : $b }
       map [ $numify_ver->($_->{dbms_version}), $_ ],
       map $_->_server_info, $self->all_storages
     )->[1];
-
-    $self->_server_info_hash($min_version_info); # on master
   }
 
-  return $self->_server_info_hash;
+  return $self->next::method;
 }
 
 sub _get_server_version {