X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FReplicated%2FPool.pm;h=dfc33ecdbb5ae776ce624c305f7c652b0ce631de;hb=cea43436e10983c218ded47e1561183096685f9b;hp=8f1e76659f2e769dcf936e3d43dccc0ba9c3716f;hpb=d40080c39809e75e0aa8b949ea157e274db1b66d;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm index 8f1e766..dfc33ec 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm @@ -1,12 +1,13 @@ package DBIx::Class::Storage::DBI::Replicated::Pool; use Moose; -use MooseX::AttributeHelpers; use DBIx::Class::Storage::DBI::Replicated::Replicant; use List::Util 'sum'; use Scalar::Util 'reftype'; +use DBI (); use Carp::Clan qw/^DBIx::Class/; use MooseX::Types::Moose qw/Num Int ClassName HashRef/; +use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI'; use namespace::clean -except => 'meta'; @@ -18,7 +19,7 @@ DBIx::Class::Storage::DBI::Replicated::Pool - Manage a pool of replicants This class is used internally by L. You shouldn't need to create instances of this class. - + =head1 DESCRIPTION In a replicated storage type, there is at least one replicant to handle the @@ -34,7 +35,7 @@ This class defines the following attributes. This is a number which defines the maximum allowed lag returned by the L method. The default is 0. In general, this should return a larger number when the replicant is lagging -behind it's master, however the implementation of this is database specific, so +behind its master, however the implementation of this is database specific, so don't count on this number having a fixed meaning. For example, MySQL will return a number of seconds that the replicating database is lagging. @@ -51,7 +52,7 @@ has 'maximum_lag' => ( =head2 last_validated This is an integer representing a time since the last time the replicants were -validated. It's nothing fancy, just an integer provided via the perl time +validated. It's nothing fancy, just an integer provided via the perl L builtin. =cut @@ -89,11 +90,11 @@ A hashref of replicant, with the key being the dsn and the value returning the actual replicant storage. For example if the $dsn element is something like: "dbi:SQLite:dbname=dbfile" - + You could access the specific replicant via: $schema->storage->replicants->{'dbname=dbfile'} - + This attributes also supports the following helper methods: =over 4 @@ -124,18 +125,42 @@ removes the replicant under $key from the pool has 'replicants' => ( is=>'rw', - metaclass => 'Collection::Hash', - isa=>HashRef['DBIx::Class::Storage::DBI'], + traits => ['Hash'], + isa=>HashRef['Object'], default=>sub {{}}, - provides => { - 'set' => 'set_replicant', - 'get' => 'get_replicant', - 'empty' => 'has_replicants', - 'count' => 'num_replicants', - 'delete' => 'delete_replicant', + handles => { + 'set_replicant' => 'set', + 'get_replicant' => 'get', + 'has_replicants' => 'is_empty', + 'num_replicants' => 'count', + 'delete_replicant' => 'delete', + 'all_replicant_storages' => 'values', + }, +); + +around has_replicants => sub { + my ($orig, $self) = @_; + return !$self->$orig; +}; + +has next_unknown_replicant_id => ( + is => 'rw', + traits => ['Counter'], + isa => Int, + default => 1, + handles => { + 'inc_unknown_replicant_id' => 'inc', }, ); +=head2 master + +Reference to the master Storage. + +=cut + +has master => (is => 'rw', isa => DBICStorageDBI, weak_ref => 1); + =head1 METHODS This class defines the following methods. @@ -151,25 +176,54 @@ and store it in the L attribute. sub connect_replicants { my $self = shift @_; my $schema = shift @_; - + my @newly_created = (); foreach my $connect_info (@_) { $connect_info = [ $connect_info ] if reftype $connect_info ne 'ARRAY'; - croak "coderef replicant connect_info not supported" - if ref $connect_info->[0] && reftype $connect_info->[0] eq 'CODE'; - - my $replicant = $self->connect_replicant($schema, $connect_info); + my $connect_coderef = + (reftype($connect_info->[0])||'') eq 'CODE' ? $connect_info->[0] + : (reftype($connect_info->[0])||'') eq 'HASH' && + $connect_info->[0]->{dbh_maker}; + + my $dsn; + my $replicant = do { +# yes this is evil, but it only usually happens once (for coderefs) +# this will fail if the coderef does not actually DBI::connect + no warnings 'redefine'; + my $connect = \&DBI::connect; + local *DBI::connect = sub { + $dsn = $_[1]; + goto $connect; + }; + $self->connect_replicant($schema, $connect_info); + }; + + my $key; + + if (!$dsn) { + if (!$connect_coderef) { + $dsn = $connect_info->[0]; + $dsn = $dsn->{dsn} if (reftype($dsn)||'') eq 'HASH'; + } + else { + # all attempts to get the DSN failed + $key = "UNKNOWN_" . $self->next_unknown_replicant_id; + $self->inc_unknown_replicant_id; + } + } + if ($dsn) { + $replicant->dsn($dsn); + ($key) = ($dsn =~ m/^dbi\:.+\:(.+)$/i); + } - my $key = $connect_info->[0]; - $key = $key->{dsn} if ref $key && reftype $key eq 'HASH'; - ($key) = ($key =~ m/^dbi\:.+\:(.+)$/); + $replicant->id($key); + $self->set_replicant($key => $replicant); - $self->set_replicant( $key => $replicant); push @newly_created, $replicant; } - + return @newly_created; } @@ -190,12 +244,26 @@ sub connect_replicant { ## So we try to set the driver without connecting, however this doesn't always ## work, as a driver may need to connect to determine the DB version, and this ## may fail. +## +## Why this is necessary at all, is that we need to have the final storage +## class to apply the Replicant role. $self->_safely($replicant, '->_determine_driver', sub { $replicant->_determine_driver }); - DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant); + Moose::Meta::Class->initialize(ref $replicant); + + my $class = Moose::Meta::Class->create_anon_class( + superclasses => [ ref $replicant ], + roles => [ 'DBIx::Class::Storage::DBI::Replicated::Replicant' ], + cache => 1, + ); + $class->rebless_instance($replicant); + + # link back to master + $replicant->master($self->master); + return $replicant; } @@ -232,16 +300,15 @@ sub _safely { eval { $code->() - }; + }; if ($@) { - $replicant - ->debugobj - ->print( - sprintf( "Exception trying to $name for replicant %s, error is %s", - $replicant->_dbi_connect_info->[0], $@) - ); - return; + $replicant->debugobj->print(sprintf( + "Exception trying to $name for replicant %s, error is %s", + $replicant->_dbi_connect_info->[0], $@) + ); + return undef; } + return 1; }