X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FReplicated.pm;h=6a2f7ad8f34e9fb999718685faac9a7336919371;hb=12a184d0a0c1868708e43aaabefe08f9e7ac9ec4;hp=0a73c4b8d11528be3321742ea1daf60163eb3c3a;hpb=2a6dda4b4b591e4da531d6c78ff9dc9e359d5fd9;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 0a73c4b..6a2f7ad 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -1,9 +1,13 @@ package DBIx::Class::Storage::DBI::Replicated; +use warnings; +use strict; + BEGIN { - use DBIx::Class; - 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'); + require DBIx::Class::Optional::Dependencies; + if ( my $missing = DBIx::Class::Optional::Dependencies->req_missing_for('replicated') ) { + die "The following modules are required for Replicated storage support: $missing\n"; + } } use Moose; @@ -14,14 +18,13 @@ use DBIx::Class::Storage::DBI::Replicated::Types qw/BalancerClassNamePart DBICSc use MooseX::Types::Moose qw/ClassName HashRef Object/; use Scalar::Util 'reftype'; use Hash::Merge; -use List::Util qw/min max reduce/; +use List::Util qw( min max ); use Context::Preserve 'preserve_context'; use Try::Tiny; +use DBIx::Class::_Util 'dbic_internal_try'; use namespace::clean -except => 'meta'; -=encoding utf8 - =head1 NAME DBIx::Class::Storage::DBI::Replicated - BETA Replicated database support @@ -309,6 +312,7 @@ my $method_dispatch = { _parse_connect_do savepoints _sql_maker_opts + _use_multicolumn_in _conn_pid _dbh_autocommit _native_data_type @@ -330,6 +334,7 @@ my $method_dispatch = { unimplemented => [qw/ _arm_global_destructor _verify_pid + __delicate_rollback get_use_dbms_capability set_use_dbms_capability @@ -337,6 +342,9 @@ my $method_dispatch = { set_dbms_capability _dbh_details _dbh_get_info + _get_rdbms_name + _get_server_version + _server_info _determine_connector_driver _extract_driver_from_connect_info @@ -365,12 +373,13 @@ my $method_dispatch = { # 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 } + { $_ =~ /^ _ (?: use | supports | determine_supports ) _ /x and $_ ne '_use_multicolumn_in' } ( Class::MOP::Class->initialize('DBIx::Class::Storage::DBI')->get_all_method_names ) )], }; -if (DBIx::Class::_ENV_::DBICTEST) { +# this only happens during DBIC-internal testing +if ( $INC{"t/lib/ANFANG.pm"} ) { my $seen; for my $type (keys %$method_dispatch) { @@ -399,13 +408,16 @@ if (DBIx::Class::_ENV_::DBICTEST) { for my $method (@{$method_dispatch->{unimplemented}}) { __PACKAGE__->meta->add_method($method, sub { my $self = shift; - $self->throw_exception("$method() must not be called on ".(blessed $self).' objects'); + $self->throw_exception( + "$method() may not be called on '@{[ blessed $self ]}' objects, " + . 'call it on a specific pool instance instead' + ); }); } =head2 read_handler -Defines an object that implements the read side of L. +Defines an object that implements the read side of L. =cut @@ -418,7 +430,7 @@ has 'read_handler' => ( =head2 write_handler -Defines an object that implements the write side of L, +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. @@ -590,7 +602,8 @@ sub _build_read_handler { =head2 around: connect_replicants All calls to connect_replicants needs to have an existing $schema tacked onto -top of the args, since L needs it, and any C +top of the args, since L needs it, and any +L options merged with the master, with replicant opts having higher priority. =cut @@ -685,19 +698,13 @@ sub execute_reliably { my $self = shift; my $coderef = shift; - unless( ref $coderef eq 'CODE') { - $self->throw_exception('Second argument must be a coderef'); - } + $self->throw_exception('Second argument must be a coderef') + unless( ref $coderef eq 'CODE'); ## replace the current read handler for the remainder of the scope local $self->{read_handler} = $self->master; - my $args = \@_; - return try { - $coderef->(@$args); - } catch { - $self->throw_exception("coderef returned an error: $_"); - }; + &$coderef; } =head2 set_reliable_storage @@ -1047,35 +1054,6 @@ 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 @@ -1114,18 +1092,16 @@ using the Schema clone method. ## $new_schema will use only the Master storage for all reads/writes while ## the $schema object will use replicated storage. -=head1 AUTHOR - - John Napiorkowski - -Based on code originated by: +=head1 FURTHER QUESTIONS? - Norbert Csongrádi - Peter Siklósi +Check the list of L. -=head1 LICENSE +=head1 COPYRIGHT AND LICENSE -You may distribute this code under the same terms as Perl itself. +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L. =cut