X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FReplicated.pm;h=930a3be51e5d0928cd6bbc56a19f08e226afe869;hb=7803e57ad8daee28020676140ea6894c31e3112e;hp=afd8d5c25db6f88cdf2097eb70857be9d31b22c5;hpb=6d766626a066b757058d023830f93cf39bb9c302;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index afd8d5c..930a3be 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -15,7 +15,7 @@ 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/; +use List::Util qw/min max reduce/; use namespace::clean -except => 'meta'; @@ -308,7 +308,6 @@ has 'write_handler' => ( is_datatype_numeric _supports_insert_returning _count_select - _subq_count_select _subq_update_delete svp_rollback svp_begin @@ -343,7 +342,6 @@ has 'write_handler' => ( _dbh_commit _execute_array _placeholders_supported - _verify_pid savepoints _sqlt_minimum_version _sql_maker_opts @@ -367,16 +365,22 @@ has 'write_handler' => ( _dbh_sth _dbh_execute _prefetch_insert_auto_nextvals - /, - - # TODO these need to be spread out to ALL servers not just the master - qw/ - _get_server_version - _server_info _server_info_hash /], ); +my @unimplemented = qw( + _arm_global_destructor + _preserve_foreign_dbh + _verify_pid + _verify_tid +); + +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 { {} }); @@ -1016,6 +1020,36 @@ sub _ping { return min map $_->_ping, $self->all_storages; } +my $numify_ver = sub { + my $ver = shift; + my @numparts = split /\D+/, $ver; + my $format = '%d.' . (join '', ('%05d') 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 } + 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; +} + +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