X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FReplicated%2FPool.pm;h=a3db2651e5feebcfa1b482647b0a3e0d770611d3;hb=f15afa13598dd767ba9547328a31d4b98313a896;hp=bba95d2a01ef3532481a9b9a5b0a5083e7eb525c;hpb=cb6ec758e3c4607ec8e30dd943a500a1d70d8940;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 bba95d2..a3db265 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm @@ -7,13 +7,13 @@ use List::Util qw(sum); =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 @@ -24,7 +24,43 @@ replicants, and gives some methods for querying information about their status. This class defines the following attributes. -=head2 replicant_type +=head2 maximum_lag ($num) + +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 +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, +); + +=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. + +=cut + +has 'last_validated' => ( + is=>'rw', + isa=>'Int', + reader=>'last_validated', + writer=>'_last_validated', + lazy=>1, + default=>0, +); + +=head2 replicant_type ($classname) Base class used to instantiate replicants that are in the pool. Unless you need to subclass L you should @@ -33,13 +69,13 @@ just leave this alone. =cut has 'replicant_type' => ( - is=>'ro', - isa=>'ClassName', - required=>1, - default=>'DBIx::Class::Storage::DBI::Replicated::Replicant', - handles=>{ - 'create_replicant' => 'new', - }, + is=>'ro', + isa=>'ClassName', + required=>1, + default=>'DBIx::Class::Storage::DBI', + handles=>{ + 'create_replicant' => 'new', + }, ); =head2 replicants @@ -47,13 +83,13 @@ has 'replicant_type' => ( 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" - + "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 @@ -82,17 +118,17 @@ removes the replicant under $key from the pool =cut has 'replicants' => ( - is=>'rw', - metaclass => 'Collection::Hash', - isa=>'HashRef[DBIx::Class::Storage::DBI::Replicated::Replicant]', - default=>sub {{}}, - provides => { - 'set' => 'set_replicant', - 'get' => 'get_replicant', - 'empty' => 'has_replicants', - 'count' => 'num_replicants', - 'delete' => 'delete_replicant', - }, + 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', + }, ); =head1 METHODS @@ -108,20 +144,53 @@ 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; - 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 (@_) { + my $replicant = $self->connect_replicant($schema, $connect_info); + my ($key) = ($connect_info->[0]=~m/^dbi\:.+\:(.+)$/); + $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); + $self->_safely_ensure_connected($replicant); + DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant); + 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 to go completely offline (ie, the box itself can die) without +bringing down your entire pool of databases. + +=cut + +sub _safely_ensure_connected { + my ($self, $replicant, @args) = @_; + my $return; eval { + $return = $replicant->ensure_connected(@args); + }; + return $return; } =head2 connected_replicants @@ -129,11 +198,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. @@ -141,10 +210,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 @@ -156,10 +225,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 @@ -170,8 +239,43 @@ 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 + +This does a check to see if 1) each replicate is connected (or reconnectable), +2) that is ->is_replicating, and 3) that it is not exceeding the lag amount +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. + +See L for more about checking if a replicating +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. + +=cut + +sub validate_replicants { + my $self = shift @_; + foreach my $replicant($self->all_replicants) { + if( + $self->_safely_ensure_connected($replicant) && + $replicant->is_replicating && + $replicant->lag_behind_master <= $self->maximum_lag + ) { + $replicant->active(1) + } else { + $replicant->active(0); + } + } + ## Mark that we completed this validation. + $self->_last_validated(time); } =head1 AUTHOR @@ -184,4 +288,6 @@ You may distribute this code under the same terms as Perl itself. =cut +__PACKAGE__->meta->make_immutable; + 1;