Massive rewrite of bind handling, and overall simplification of ::Storage::DBI
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Replicated.pm
index 9fa00f2..9a9e05f 100644 (file)
@@ -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');
 }
 
@@ -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,15 +268,10 @@ 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
     _count_select
     _subq_update_delete
@@ -315,34 +280,31 @@ has 'write_handler' => (
     svp_release
     relname_to_table_alias
     _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
-    _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
     savepoints
-    _sqlt_minimum_version
     _sql_maker_opts
     _conn_pid
     _dbh_autocommit
@@ -355,45 +317,123 @@ has 'write_handler' => (
     _resolve_column_info
     _prune_unused_joins
     _strip_cond_qualifiers
-    _extract_order_columns
+    _strip_cond_qualifiers_from_array
     _resolve_aliastypes_from_select_args
     _execute
     _do_query
+    _sth
     _dbh_sth
     _dbh_execute
   /],
-);
+  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
-  _verify_pid
+    source_bind_attributes
 
-  get_use_dbms_capability
-  set_use_dbms_capability
-  get_dbms_capability
-  set_dbms_capability
-  _dbh_details
+    get_use_dbms_capability
+    set_use_dbms_capability
+    get_dbms_capability
+    set_dbms_capability
+    _dbh_details
+    _dbh_get_info
 
-  sql_limit_dialect
+    sql_limit_dialect
+    sql_quote_char
+    sql_name_sep
 
-  _inner_join_to_node
-  _group_over_selection
-  _prefetch_autovalues
-);
+    _inner_join_to_node
+    _group_over_selection
+    _extract_order_criteria
 
-# 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 )
-);
+    _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),
+      '',
+    );
+  }
 
-for my $method (@unimplemented) {
+  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 { {} });
 
@@ -408,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;
@@ -446,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.
@@ -463,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
@@ -678,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