X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FReplicated%2FPool.pm;h=db38c42680a650c833dbdc15ecb7be1b83585ae2;hb=48580715af3072905f2c71dc27e7f70f21a11338;hp=56a40c90a1df068d9f1b37b57f57530dba3e53bb;hpb=e2cfa48bc2f3768437623e86abc7f2e5238f6be1;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 56a40c9..db38c42 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm @@ -1,23 +1,29 @@ package DBIx::Class::Storage::DBI::Replicated::Pool; use Moose; -use MooseX::AttributeHelpers; use DBIx::Class::Storage::DBI::Replicated::Replicant; -use List::Util qw(sum); +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'; =head1 NAME -DBIx::Class::Storage::DBI::Replicated::Pool; Manage a pool of replicants +DBIx::Class::Storage::DBI::Replicated::Pool - Manage a pool of replicants =head1 SYNOPSIS 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 -read only traffic. The Pool class manages this replicant, or list of +read-only traffic. The Pool class manages this replicant, or list of replicants, and gives some methods for querying information about their status. =head1 ATTRIBUTES @@ -29,37 +35,35 @@ 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. =cut has 'maximum_lag' => ( - is=>'rw', - isa=>'Num', - required=>1, - lazy=>1, - default=>0, + is=>'rw', + isa=>Num, + required=>1, + lazy=>1, + default=>0, ); =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 -builtin. +validated. It's nothing fancy, just an integer provided via the perl L +built-in. =cut has 'last_validated' => ( - is=>'rw', - isa=>'Int', - reader=>'last_validated', - writer=>'_last_validated', - lazy=>1, - default=>sub { - time; - }, + is=>'rw', + isa=>Int, + reader=>'last_validated', + writer=>'_last_validated', + lazy=>1, + default=>0, ); =head2 replicant_type ($classname) @@ -71,27 +75,27 @@ just leave this alone. =cut has 'replicant_type' => ( - is=>'ro', - isa=>'ClassName', - required=>1, - default=>'DBIx::Class::Storage::DBI', - handles=>{ - 'create_replicant' => 'new', - }, + is=>'ro', + isa=>ClassName, + required=>1, + default=>'DBIx::Class::Storage::DBI', + handles=>{ + 'create_replicant' => 'new', + }, ); =head2 replicants 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: +actual replicant storage. For example, if the $dsn element is something like: + + "dbi:SQLite:dbname=dbfile" - "dbi:SQLite:dbname=dbfile" - You could access the specific replicant via: - $schema->storage->replicants->{'dbname=dbfile'} - -This attributes also supports the following helper methods + $schema->storage->replicants->{'dbname=dbfile'} + +This attributes also supports the following helper methods: =over 4 @@ -113,56 +117,194 @@ The number of replicants in the pool =item delete_replicant ($key) -removes the replicant under $key from the pool +Removes the replicant under $key from the pool =back =cut has 'replicants' => ( - is=>'rw', - metaclass => 'Collection::Hash', - isa=>'HashRef[DBIx::Class::Storage::DBI]', - default=>sub {{}}, - provides => { - 'set' => 'set_replicant', - 'get' => 'get_replicant', - 'empty' => 'has_replicants', - 'count' => 'num_replicants', - 'delete' => 'delete_replicant', - }, + is=>'rw', + traits => ['Hash'], + isa=>HashRef['Object'], + default=>sub {{}}, + 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. =head2 connect_replicants ($schema, Array[$connect_info]) -Given an array of $dsn suitable for connected to a database, create an -L object and store it in the -L attribute. +Given an array of $dsn or connect_info structures suitable for connected to a +database, create an L object +and store it in the L attribute. =cut sub connect_replicants { - my $self = shift @_; - my $schema = shift @_; - - my @newly_created = (); - foreach my $connect_info (@_) { - - my $replicant = $self->create_replicant($schema); - $replicant->connect_info($connect_info); - $replicant->ensure_connected; - DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant); - - my ($key) = ($connect_info->[0]=~m/^dbi\:.+\:(.+)$/); - $self->set_replicant( $key => $replicant); - push @newly_created, $replicant; - } - - return @newly_created; + my $self = shift @_; + my $schema = shift @_; + + my @newly_created = (); + foreach my $connect_info (@_) { + $connect_info = [ $connect_info ] + if reftype $connect_info ne 'ARRAY'; + + 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); + } + + $replicant->id($key); + $self->set_replicant($key => $replicant); + + push @newly_created, $replicant; + } + + return @newly_created; +} + +=head2 connect_replicant ($schema, $connect_info) + +Given a schema object and a hashref of $connect_info, connect the replicant +and return it. + +=cut + +sub connect_replicant { + my ($self, $schema, $connect_info) = @_; + my $replicant = $self->create_replicant($schema); + $replicant->connect_info($connect_info); + +## It is undesirable for catalyst to connect at ->conect_replicants time, as +## connections should only happen on the first request that uses the database. +## 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 + }); + + Moose::Meta::Class->initialize(ref $replicant); + + DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant); + + # link back to master + $replicant->master($self->master); + + return $replicant; +} + +=head2 _safely_ensure_connected ($replicant) + +The standard ensure_connected method with throw an exception should it fail to +connect. For the master database this is desirable, but since replicants are +allowed to fail, this behavior is not desirable. This method wraps the call +to ensure_connected in an eval in order to catch any generated errors. That +way a slave can go completely offline (e.g. the box itself can die) without +bringing down your entire pool of databases. + +=cut + +sub _safely_ensure_connected { + my ($self, $replicant, @args) = @_; + + return $self->_safely($replicant, '->ensure_connected', sub { + $replicant->ensure_connected(@args) + }); +} + +=head2 _safely ($replicant, $name, $code) + +Execute C<$code> for operation C<$name> catching any exceptions and printing an +error message to the C<<$replicant->debugobj>>. + +Returns 1 on success and undef on failure. + +=cut + +sub _safely { + my ($self, $replicant, $name, $code) = @_; + + eval { + $code->() + }; + if ($@) { + $replicant->debugobj->print(sprintf( + "Exception trying to $name for replicant %s, error is %s", + $replicant->_dbi_connect_info->[0], $@) + ); + return undef; + } + + return 1; } =head2 connected_replicants @@ -170,11 +312,11 @@ sub connect_replicants { Returns true if there are connected replicants. Actually is overloaded to return the number of replicants. So you can do stuff like: - if( my $num_connected = $storage->has_connected_replicants ) { - print "I have $num_connected connected replicants"; - } else { - print "Sorry, no replicants."; - } + if( my $num_connected = $storage->has_connected_replicants ) { + print "I have $num_connected connected replicants"; + } else { + print "Sorry, no replicants."; + } This method will actually test that each replicant in the L hashref is actually connected, try not to hit this 10 times a second. @@ -182,10 +324,10 @@ is actually connected, try not to hit this 10 times a second. =cut sub connected_replicants { - my $self = shift @_; - return sum( map { - $_->connected ? 1:0 - } $self->all_replicants ); + my $self = shift @_; + return sum( map { + $_->connected ? 1:0 + } $self->all_replicants ); } =head2 active_replicants @@ -197,10 +339,10 @@ should automatically reconnect them for us when we hit them with a query. =cut sub active_replicants { - my $self = shift @_; - return ( grep {$_} map { - $_->active ? $_:0 - } $self->all_replicants ); + my $self = shift @_; + return ( grep {$_} map { + $_->active ? $_:0 + } $self->all_replicants ); } =head2 all_replicants @@ -211,8 +353,8 @@ array is given, nor should any meaning be derived. =cut sub all_replicants { - my $self = shift @_; - return values %{$self->replicants}; + my $self = shift @_; + return values %{$self->replicants}; } =head2 validate_replicants @@ -223,7 +365,7 @@ defined by L. Replicants that fail any of these tests are set to inactive, and thus removed from the replication pool. This tests L, since a replicant that has been previous marked -as inactive can be reactived should it start to pass the validation tests again. +as inactive can be reactivated should it start to pass the validation tests again. See L for more about checking if a replicating connection is not following a master or is lagging. @@ -231,26 +373,43 @@ connection is not following a master or is lagging. Calling this method will generate queries on the replicant databases so it is not recommended that you run them very often. +This method requires that your underlying storage engine supports some sort of +native replication mechanism. Currently only MySQL native replication is +supported. Your patches to make other replication types work are welcomed. + =cut sub validate_replicants { - my $self = shift @_; - foreach my $replicant($self->all_replicants) { - if( - $replicant->is_replicating && - $replicant->lag_behind_master <= $self->maximum_lag && - $replicant->ensure_connected - ) { - ## TODO:: Hook debug for this - $replicant->active(1) + my $self = shift @_; + foreach my $replicant($self->all_replicants) { + if($self->_safely_ensure_connected($replicant)) { + my $is_replicating = $replicant->is_replicating; + unless(defined $is_replicating) { + $replicant->debugobj->print("Storage Driver ".ref($self)." Does not support the 'is_replicating' method. Assuming you are manually managing.\n"); + next; + } else { + if($is_replicating) { + my $lag_behind_master = $replicant->lag_behind_master; + unless(defined $lag_behind_master) { + $replicant->debugobj->print("Storage Driver ".ref($self)." Does not support the 'lag_behind_master' method. Assuming you are manually managing.\n"); + next; + } else { + if($lag_behind_master <= $self->maximum_lag) { + $replicant->active(1); + } else { + $replicant->active(0); + } + } } else { - ## TODO:: Hook debug for this - $replicant->active(0); + $replicant->active(0); } + } + } else { + $replicant->active(0); } - - ## Mark that we completed this validation. - $self->_last_validated(time); + } + ## Mark that we completed this validation. + $self->_last_validated(time); } =head1 AUTHOR @@ -263,4 +422,6 @@ You may distribute this code under the same terms as Perl itself. =cut +__PACKAGE__->meta->make_immutable; + 1;