fix and regression test for RT #62642
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Replicated.pm
index d2d4f3a..4477475 100644 (file)
@@ -14,8 +14,10 @@ use DBIx::Class::Storage::DBI::Replicated::Balancer;
 use DBIx::Class::Storage::DBI::Replicated::Types qw/BalancerClassNamePart DBICSchema DBICStorageDBI/;
 use MooseX::Types::Moose qw/ClassName HashRef Object/;
 use Scalar::Util 'reftype';
-use Hash::Merge 'merge';
-use List::Util qw/min max/;
+use Hash::Merge;
+use List::Util qw/min max reduce/;
+use Try::Tiny;
+use namespace::clean;
 
 use namespace::clean -except => 'meta';
 
@@ -26,7 +28,7 @@ DBIx::Class::Storage::DBI::Replicated - BETA Replicated database support
 =head1 SYNOPSIS
 
 The Following example shows how to change an existing $schema to a replicated
-storage type, add some replicated (readonly) databases, and perform reporting
+storage type, add some replicated (read-only) databases, and perform reporting
 tasks.
 
 You should set the 'storage_type attribute to a replicated type.  You should
@@ -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.
 
@@ -75,7 +77,7 @@ walkthroughs.
 Warning: This class is marked BETA.  This has been running a production
 website using MySQL native replication as its backend and we have some decent
 test coverage but the code hasn't yet been stressed by a variety of databases.
-Individual DB's may have quirks we are not aware of.  Please use this in first
+Individual DBs may have quirks we are not aware of.  Please use this in first
 development and pass along your experiences/bug fixes.
 
 This class implements replicated data store for DBI. Currently you can define
@@ -89,12 +91,12 @@ L</write_handler>.  Additionally, some methods need to be distributed
 to all existing storages.  This way our storage class is a drop in replacement
 for L<DBIx::Class::Storage::DBI>.
 
-Read traffic is spread across the replicants (slaves) occuring to a user
+Read traffic is spread across the replicants (slaves) occurring to a user
 selected algorithm.  The default algorithm is random weighted.
 
 =head1 NOTES
 
-The consistancy betweeen master and replicants is database specific.  The Pool
+The consistency between master and replicants is database specific.  The Pool
 gives you a method to validate its replicants, removing and replacing them
 when they fail/pass predefined criteria.  Please make careful use of the ways
 to force a query to run against Master when needed.
@@ -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
   /],
 );
@@ -307,17 +309,16 @@ has 'write_handler' => (
     backup
     is_datatype_numeric
     _count_select
-    _subq_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,13 +341,10 @@ has 'write_handler' => (
     _parse_connect_do
     _dbh_commit
     _execute_array
-    _placeholders_supported
-    _verify_pid
     savepoints
     _sqlt_minimum_version
     _sql_maker_opts
     _conn_pid
-    _typeless_placeholders_supported
     _conn_tid
     _dbh_autocommit
     _native_data_type
@@ -359,22 +356,54 @@ 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
   /],
 );
 
+my @unimplemented = qw(
+  _arm_global_destructor
+  _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) {
+  __PACKAGE__->meta->add_method($method, sub {
+    croak "$method must not be called on ".(blessed shift).' objects';
+  });
+}
+
 has _master_connect_info_opts =>
   (is => 'rw', isa => HashRef, default => sub { {} });
 
 =head2 around: connect_info
 
-Preserve master's C<connect_info> options (for merging with replicants.)
-Also set any Replicated related options from connect_info, such as
+Preserves master's C<connect_info> options (for merging with replicants.)
+Also sets any Replicated-related options from connect_info, such as
 C<pool_type>, C<pool_args>, C<balancer_type> and C<balancer_args>.
 
 =cut
@@ -384,10 +413,12 @@ around connect_info => sub {
 
   my $wantarray = wantarray;
 
+  my $merge = Hash::Merge->new('LEFT_PRECEDENT');
+
   my %opts;
   for my $arg (@$info) {
     next unless (reftype($arg)||'') eq 'HASH';
-    %opts = %{ merge($arg, \%opts) };
+    %opts = %{ $merge->merge($arg, \%opts) };
   }
   delete $opts{dsn};
 
@@ -396,11 +427,12 @@ around connect_info => sub {
       if $opts{pool_type};
 
     $self->pool_args(
-      merge((delete $opts{pool_args} || {}), $self->pool_args)
+      $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/}) {
@@ -408,7 +440,7 @@ around connect_info => sub {
       if $opts{balancer_type};
 
     $self->balancer_args(
-      merge((delete $opts{balancer_args} || {}), $self->balancer_args)
+      $merge->merge((delete $opts{balancer_args} || {}), $self->balancer_args)
     );
 
     $self->balancer($self->_build_balancer)
@@ -450,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,
@@ -553,7 +585,8 @@ around connect_replicants => sub {
     $self->throw_exception('too many hashrefs in connect_info')
       if @hashes > 2;
 
-    my %opts = %{ merge(reverse @hashes) };
+    my $merge = Hash::Merge->new('LEFT_PRECEDENT');
+    my %opts = %{ $merge->merge(reverse @hashes) };
 
 # delete them
     splice @$r, $i+1, ($#{$r} - $i), ();
@@ -566,7 +599,7 @@ around connect_replicants => sub {
     delete $master_opts{dbh_maker};
 
 # merge with master
-    %opts = %{ merge(\%opts, \%master_opts) };
+    %opts = %{ $merge->merge(\%opts, \%master_opts) };
 
 # update
     $r->[$i] = \%opts;
@@ -594,7 +627,7 @@ sub all_storages {
 =head2 execute_reliably ($coderef, ?@args)
 
 Given a coderef, saves the current state of the L</read_handler>, forces it to
-use reliable storage (ie sets it to the master), executes a coderef and then
+use reliable storage (e.g. sets it to the master), executes a coderef and then
 restores the original state.
 
 Example:
@@ -602,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;
   };
 
@@ -633,7 +666,7 @@ sub execute_reliably {
   my @result;
   my $want_array = wantarray;
 
-  eval {
+  try {
     if($want_array) {
       @result = $coderef->(@args);
     } elsif(defined $want_array) {
@@ -641,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
@@ -674,7 +702,7 @@ sub set_reliable_storage {
 =head2 set_balanced_storage
 
 Sets the current $schema to be use the </balancer> for all reads, while all
-writea are sent to the master only
+writes are sent to the master only
 
 =cut
 
@@ -723,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
@@ -905,7 +933,7 @@ sub lag_behind_master {
   my $self = shift;
 
   return max map $_->lag_behind_master, $self->replicants;
-} 
+}
 
 =head2 is_replicating
 
@@ -953,7 +981,7 @@ sub _determine_driver {
 
 sub _driver_determined {
   my $self = shift;
-  
+
   if (@_) {
     $_->_driver_determined(@_) for $self->all_storages;
   }
@@ -963,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;
   }
@@ -1003,6 +1031,35 @@ 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 '', ('%06d') x (@numparts - 1));
+
+  return sprintf $format, @numparts;
+};
+sub _server_info {
+  my $self = shift;
+
+  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];
+  }
+
+  return $self->next::method;
+}
+
+sub _get_server_version {
+  my $self = shift;
+
+  return $self->_server_info->{dbms_version};
+}
+
 =head1 GOTCHAS
 
 Due to the fact that replicants can lag behind a master, you must take care to