fix and regression test for RT #62642
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Replicated.pm
index 930a3be..4477475 100644 (file)
@@ -16,6 +16,8 @@ use MooseX::Types::Moose qw/ClassName HashRef Object/;
 use Scalar::Util 'reftype';
 use Hash::Merge;
 use List::Util qw/min max reduce/;
+use Try::Tiny;
+use namespace::clean;
 
 use namespace::clean -except => 'meta';
 
@@ -37,7 +39,7 @@ that the Pool object should get.
   $schema->storage_type( ['::DBI::Replicated', {balancer=>'::Random'}] );
   $schema->connection(...);
 
-Next, you need to add in the Replicants.  Basically this is an array of 
+Next, you need to add in the Replicants.  Basically this is an array of
 arrayrefs, where each arrayref is database connect information.  Think of these
 arguments as what you'd pass to the 'normal' $schema->connect method.
 
@@ -58,7 +60,7 @@ attribute 'force_pool'.  For example:
   my $RS = $schema->resultset('Source')->search(undef, {force_pool=>'master'});
 
 Now $RS will force everything (both reads and writes) to use whatever was setup
-as the master storage.  'master' is hardcoded to always point to the Master, 
+as the master storage.  'master' is hardcoded to always point to the Master,
 but you can also use any Replicant name.  Please see:
 L<DBIx::Class::Storage::DBI::Replicated::Pool> and the replicants attribute for more.
 
@@ -123,7 +125,7 @@ has 'schema' => (
 
 =head2 pool_type
 
-Contains the classname which will instantiate the L</pool> object.  Defaults 
+Contains the classname which will instantiate the L</pool> object.  Defaults
 to: L<DBIx::Class::Storage::DBI::Replicated::Pool>.
 
 =cut
@@ -187,7 +189,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
@@ -205,8 +207,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
 
@@ -235,7 +237,7 @@ has 'master' => (
 
 =head1 ATTRIBUTES IMPLEMENTING THE DBIx::Storage::DBI INTERFACE
 
-The following methods are delegated all the methods required for the 
+The following methods are delegated all the methods required for the
 L<DBIx::Class::Storage::DBI> interface.
 
 =head2 read_handler
@@ -252,7 +254,7 @@ has 'read_handler' => (
     select
     select_single
     columns_info_for
-    _dbh_columns_info_for 
+    _dbh_columns_info_for
     _select
   /],
 );
@@ -306,18 +308,17 @@ has 'write_handler' => (
 
     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_end
@@ -326,7 +327,6 @@ has 'write_handler' => (
     _dbh
     _select_args
     _dbh_execute_array
-    _sql_maker_args
     _sql_maker
     _query_start
     _sqlt_version_error
@@ -341,12 +341,10 @@ has 'write_handler' => (
     _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
@@ -358,14 +356,13 @@ has 'write_handler' => (
     _resolve_column_info
     _prune_unused_joins
     _strip_cond_qualifiers
-    _parse_order_by
+    _extract_order_columns
     _resolve_aliastypes_from_select_args
     _execute
     _do_query
     _dbh_sth
     _dbh_execute
     _prefetch_insert_auto_nextvals
-    _server_info_hash
   /],
 );
 
@@ -374,6 +371,24 @@ my @unimplemented = qw(
   _preserve_foreign_dbh
   _verify_pid
   _verify_tid
+
+  get_use_dbms_capability
+  set_use_dbms_capability
+  get_dbms_capability
+  set_dbms_capability
+  _dbh_details
+
+  sql_limit_dialect
+
+  _inner_join_to_node
+  _group_over_selection
+);
+
+# the capability framework
+# not sure if CMOP->initialize does evil things to DBIC::S::DBI, fix if a problem
+push @unimplemented, ( grep
+  { $_ =~ /^ _ (?: use | supports | determine_supports ) _ /x }
+  ( Class::MOP::Class->initialize('DBIx::Class::Storage::DBI')->get_all_method_names )
 );
 
 for my $method (@unimplemented) {
@@ -415,8 +430,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/}) {
@@ -466,7 +482,7 @@ bits get put into the correct places.
 =cut
 
 sub BUILDARGS {
-  my ($class, $schema, $storage_type_args, @args) = @_;  
+  my ($class, $schema, $storage_type_args, @args) = @_;
 
   return {
     schema=>$schema,
@@ -619,7 +635,7 @@ Example:
   my $reliably = sub {
     my $name = shift @_;
     $schema->resultset('User')->create({name=>$name});
-    my $user_rs = $schema->resultset('User')->find({name=>$name}); 
+    my $user_rs = $schema->resultset('User')->find({name=>$name});
     return $user_rs;
   };
 
@@ -650,7 +666,7 @@ sub execute_reliably {
   my @result;
   my $want_array = wantarray;
 
-  eval {
+  try {
     if($want_array) {
       @result = $coderef->(@args);
     } elsif(defined $want_array) {
@@ -658,19 +674,14 @@ sub execute_reliably {
     } else {
       $coderef->(@args);
     }
+  } catch {
+    $self->throw_exception("coderef returned an error: $_");
+  } finally {
+    ##Reset to the original state
+    $self->read_handler($current);
   };
 
-  ##Reset to the original state
-  $self->read_handler($current);
-
-  ##Exception testing has to come last, otherwise you might leave the 
-  ##read_handler set to master.
-
-  if($@) {
-    $self->throw_exception("coderef returned an error: $@");
-  } else {
-    return $want_array ? @result : $result[0];
-  }
+  return $want_array ? @result : $result[0];
 }
 
 =head2 set_reliable_storage
@@ -740,7 +751,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
@@ -922,7 +933,7 @@ sub lag_behind_master {
   my $self = shift;
 
   return max map $_->lag_behind_master, $self->replicants;
-} 
+}
 
 =head2 is_replicating
 
@@ -970,7 +981,7 @@ sub _determine_driver {
 
 sub _driver_determined {
   my $self = shift;
-  
+
   if (@_) {
     $_->_driver_determined(@_) for $self->all_storages;
   }
@@ -980,19 +991,19 @@ sub _driver_determined {
 
 sub _init {
   my $self = shift;
-  
+
   $_->_init for $self->all_storages;
 }
 
 sub _run_connection_actions {
   my $self = shift;
-  
+
   $_->_run_connection_actions for $self->all_storages;
 }
 
 sub _do_connection_actions {
   my $self = shift;
-  
+
   if (@_) {
     $_->_do_connection_actions(@_) for $self->all_storages;
   }
@@ -1020,28 +1031,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 = (
-      reduce { $a->[0] < $b->[0] ? $a : $b } 
+  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 {