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=fcb7fcbb6bde5f9a211c62011b3110f07828caec;hp=967d0e0f3ed31abc6a6abfa523dc478450fb3949;hpb=0a3441ee8e0e747cfa05eff02df0d918ed5d6acb;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index 967d0e0..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'); } @@ -240,39 +239,10 @@ has 'master' => ( The following methods are delegated all the methods required for the L interface. -=head2 read_handler - -Defines an object that implements the read side of L. - -=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, -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,37 +280,33 @@ 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 - _conn_tid _dbh_autocommit _native_data_type _get_dbh @@ -356,47 +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 - _prefetch_insert_auto_nextvals /], -); + 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 + 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 -); + _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. + +=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, +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 { {} }); @@ -411,8 +448,6 @@ C, C, C and C. around connect_info => sub { my ($next, $self, $info, @extra) = @_; - my $wantarray = wantarray; - my $merge = Hash::Merge->new('LEFT_PRECEDENT'); my %opts; @@ -430,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/}) { @@ -448,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. @@ -465,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 @@ -680,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