From: John Napiorkowski Date: Wed, 30 Apr 2008 22:16:55 +0000 (+0000) Subject: added some advice to debugging replicants so that we can see a replicant dsn, got... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=503363253e1fa2c35e3b5368dd7f453b9cfbc6a1;p=dbsrgits%2FDBIx-Class-Historic.git added some advice to debugging replicants so that we can see a replicant dsn, got this balancing between one master and slave, seems to run well --- diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index d0f5b1e..c902877 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1063,6 +1063,7 @@ sub _query_start { if ( $self->debug ) { @bind = $self->_fix_bind_params(@bind); + $self->debugobj->query_start( $sql, @bind ); } } diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index a9be9ab..aca3ea7 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -32,15 +32,8 @@ tasks ## supports everything that method supports, such as connecting to an ## existing database handle. [$dbh], - \%global_opts ); - - ## a hash of replicants, keyed by their DSN - my %replicants = $schema->storage->replicants; - my $replicant = $schema->storage->get_replicant($dsn); - $replicant->status; - $replicant->is_active; - $replicant->active; + =head1 DESCRIPTION @@ -105,6 +98,7 @@ has 'master' => ( txn_rollback sth deploy + schema /], ); @@ -150,6 +144,7 @@ has 'current_replicant' => ( select_single columns_info_for /], + trigger=>sub {'xxxxxxxxxxxxxxxxxxxxxxxxxxx'}, ); @@ -277,6 +272,19 @@ sub _build_balancer { } +=head2 around: create_replicants + +All calls to create_replicants needs to have an existing $schema tacked onto +top of the args + +=cut + +around 'create_replicants' => sub { + my ($method, $self, @args) = @_; + $self->$method($self->schema, @args); +}; + + =head2 after: get_current_replicant_storage Advice on the current_replicant_storage attribute. Each time we use a replicant @@ -285,10 +293,11 @@ the load evenly (hopefully) across existing capacity. =cut -after 'get_current_replicant' => sub { +after 'current_replicant' => sub { my $self = shift @_; my $next_replicant = $self->next_storage($self->pool); - + +warn '......................'; $self->set_current_replicant($next_replicant); }; diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm index 293fe09..6221bdd 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm @@ -39,7 +39,7 @@ sub next_storage { my $self = shift @_; my $pool = shift @_; - return (shuffle($pool->all_replicants))[0]; + return (shuffle($pool->active_replicants))[0]; } diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm index 3bf1ac8..513752a 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm @@ -101,7 +101,7 @@ has 'replicants' => ( This class defines the following methods. -=head2 create_replicants (Array[$connect_info]) +=head2 create_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 @@ -111,10 +111,11 @@ L attribute. sub create_replicants { my $self = shift @_; + my $schema = shift @_; my @newly_created = (); foreach my $connect_info (@_) { - my $replicant = $self->create_replicant; + my $replicant = $self->create_replicant($schema); $replicant->connect_info($connect_info); $replicant->ensure_connected; my ($key) = ($connect_info->[0]=~m/^dbi\:.+\:(.+)$/); @@ -149,6 +150,21 @@ sub connected_replicants { } $self->all_replicants ); } +=head2 active_replicants + +This is an array of replicants that are considered to be active in the pool. +This does not check to see if they are connected, but if they are not, DBIC +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 ); +} + =head2 all_replicants Just a simple array of all the replicant storages. No particular order to the diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm index 22ca9fe..8d53297 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm @@ -26,10 +26,40 @@ given master database. This class defines the following attributes. +=head2 active + +This is a boolean which allows you to programmatically activate or deactivate a +replicant from the pool. This way to you do stuff like disallow a replicant +when it get's too far behind the master, if it stops replicating, etc. + +=cut + +has 'active' => ( + is=>'rw', + isa=>'Bool', + lazy=>1, + required=>1, + default=>1, +); + + =head1 METHODS This class defines the following methods. +=head2 after: _query_start + +advice iof the _query_start method to add more debuggin + +=cut + +around '_query_start' => sub { + my ($method, $self, $sql, @bind) = @_; + my $dsn = $self->connect_info->[0]; + $self->$method("DSN: $dsn SQL: $sql", @bind); +}; + + =head1 AUTHOR John Napiorkowski @@ -38,4 +68,6 @@ John Napiorkowski You may distribute this code under the same terms as Perl itself. -=cut \ No newline at end of file +=cut + +1; \ No newline at end of file diff --git a/t/93storage_replication.t b/t/93storage_replication.t index 146a549..6312831 100644 --- a/t/93storage_replication.t +++ b/t/93storage_replication.t @@ -8,7 +8,7 @@ BEGIN { eval "use Moose"; plan $@ ? ( skip_all => 'needs Moose for testing' ) - : ( tests => 30 ); + : ( tests => 33 ); } use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool'; @@ -26,6 +26,7 @@ TESTSCHEMACLASS: { use DBICTest; use File::Copy; + use Data::Dump qw/dump/; use base qw/Class::Accessor::Fast/; @@ -64,7 +65,8 @@ TESTSCHEMACLASS: { } ## Do a 'good enough' replication by copying the master dbfile over each of - ## the slave dbfiles. + ## the slave dbfiles. If the master is SQLite we do this, otherwise we + ## just do a one second pause to let the slaves catch up. sub replicate { my $self = shift @_; @@ -201,9 +203,17 @@ is $artist2->name, "Doom's Children" ## What happens when we disconnect all the replicants? +is $replicated->schema->storage->pool->connected_replicants => 2 + => "both replicants are connected"; + $replicated->schema->storage->replicants->{"t/var/DBIxClass_slave1.db"}->disconnect; $replicated->schema->storage->replicants->{"t/var/DBIxClass_slave2.db"}->disconnect; +is $replicated->schema->storage->pool->connected_replicants => 0 + => "both replicants are now disconnected"; + +## All these should pass, since the database should automatically reconnect + ok my $artist3 = $replicated->schema->resultset('Artist')->find(6) => 'Still finding stuff.'; @@ -213,260 +223,11 @@ isa_ok $artist3 is $artist3->name, "Dead On Arrival" => 'Found expected name for first result'; - -__END__ - -## ---------------------------------------------------------------------------- -## Build a class to hold all our required testing data and methods. -## ---------------------------------------------------------------------------- - -TESTSCHEMACLASS: { - - package DBIx::Class::DBI::Replicated::TestReplication; - - use DBI; - use DBICTest; - use File::Copy; - - ## Create a constructor - - sub new { - my $class = shift @_; - my %params = @_; - - my $self = bless { - db_paths => $params{db_paths}, - dsns => $class->init_dsns(%params), - schema=>$class->init_schema, - }, $class; - - $self->connect; - return $self; - } - - ## get the DSNs. We build this up from the list of file paths - - sub init_dsns { - my $class = shift @_; - my %params = @_; - my $db_paths = $params{db_paths}; - - my @dsn = map { - "dbi:SQLite:${_}"; - } @$db_paths; - - return \@dsn; - } - - ## get the Schema and set the replication storage type - - sub init_schema { - my $class = shift @_; - my $schema = DBICTest->init_schema(); - $schema->storage_type( '::DBI::Replicated' ); - - return $schema; - } - - ## connect the Schema - - sub connect { - my $self = shift @_; - my ($master, @slaves) = @{$self->{dsns}}; - my $master_connect_info = [$master, '','', {AutoCommit=>1, PrintError=>0}]; - - my @slavesob; - foreach my $slave (@slaves) - { - my $dbh = shift @{$self->{slaves}} - || DBI->connect($slave,"","",{PrintError=>0, PrintWarn=>0}); - - push @{$master_connect_info->[-1]->{slaves_connect_info}}, - [$dbh, '','',{priority=>10}]; - - push @slavesob, - $dbh; - } - - ## Keep track of the created slave databases - $self->{slaves} = \@slavesob; - - $self - ->{schema} - ->connect(@$master_connect_info); - } - - ## replication - - sub replicate { - my $self = shift @_; - my ($master, @slaves) = @{$self->{db_paths}}; - - foreach my $slave (@slaves) { - copy($master, $slave); - } - } - - ## Cleanup afer ourselves. - - sub cleanup { - my $self = shift @_; - my ($master, @slaves) = @{$self->{db_paths}}; - - foreach my $slave (@slaves) { - unlink $slave; - } - } - - ## Force a reconnection - - sub reconnect { - my $self = shift @_; - my $schema = $self->connect; - $self->{schema} = $schema; - return $schema; - } -} - -## ---------------------------------------------------------------------------- -## Create an object and run some tests -## ---------------------------------------------------------------------------- - -my %params = ( - db_paths => [ - "t/var/DBIxClass.db", - "t/var/DBIxClass_slave1.db", - "t/var/DBIxClass_slave2.db", - ], -); - -ok my $replicate = DBIx::Class::DBI::Replicated::TestReplication->new(%params) - => 'Created a replication object'; - -isa_ok $replicate->{schema} - => 'DBIx::Class::Schema'; - -## Add some info to the database - -$replicate - ->{schema} - ->populate('Artist', [ - [ qw/artistid name/ ], - [ 4, "Ozric Tentacles"], - ]); - -## Make sure all the slaves have the table definitions - -$replicate->replicate; - -## Make sure we can read the data. - -ok my $artist1 = $replicate->{schema}->resultset('Artist')->find(4) - => 'Created Result'; - -isa_ok $artist1 - => 'DBICTest::Artist'; - -is $artist1->name, 'Ozric Tentacles' - => 'Found expected name for first result'; - -## Add some new rows that only the master will have This is because -## we overload any type of write operation so that is must hit the master -## database. - -$replicate - ->{schema} - ->populate('Artist', [ - [ qw/artistid name/ ], - [ 5, "Doom's Children"], - [ 6, "Dead On Arrival"], - [ 7, "Watergate"], - ]); - -## Reconnect the database -$replicate->reconnect; - -## Alright, the database 'cluster' is not in a consistent state. When we do -## a read now we expect bad news - -is $replicate->{schema}->resultset('Artist')->find(5), undef - => 'read after disconnect fails because it uses slave 1 which we have neglected to "replicate" yet'; - -## Make sure all the slaves have the table definitions -$replicate->replicate; - -## Should find some data now - -ok my $artist2 = $replicate->{schema}->resultset('Artist')->find(5) - => 'Sync succeed'; - -isa_ok $artist2 - => 'DBICTest::Artist'; - -is $artist2->name, "Doom's Children" - => 'Found expected name for first result'; - -## What happens when we delete one of the slaves? - -ok my $slave1 = @{$replicate->{slaves}}[0] - => 'Got Slave1'; - -ok $slave1->disconnect - => 'disconnected slave1'; - -$replicate->reconnect; - -ok my $artist3 = $replicate->{schema}->resultset('Artist')->find(6) - => 'Still finding stuff.'; - -isa_ok $artist3 - => 'DBICTest::Artist'; - -is $artist3->name, "Dead On Arrival" - => 'Found expected name for first result'; - -## Let's delete all the slaves - -ok my $slave2 = @{$replicate->{slaves}}[1] - => 'Got Slave2'; - -ok $slave2->disconnect - => 'Disconnected slave2'; - -$replicate->reconnect; - -## We expect an error now, since all the slaves are dead - -eval { - $replicate->{schema}->resultset('Artist')->find(4)->name; -}; - -ok $@ => 'Got error when trying to find artistid 4'; - -## This should also be an error - -eval { - my $artist4 = $replicate->{schema}->resultset('Artist')->find(7); -}; - -ok $@ => 'Got read errors after everything failed'; - -## make sure ->connect_info returns something sane - -ok $replicate->{schema}->storage->connect_info - => 'got something out of ->connect_info'; - -## Force a connection to the write source for testing. - -$replicate->{schema}->storage($replicate->{schema}->storage->write_source); - -## What happens when we do a find for something that doesn't exist? - -ok ! $replicate->{schema}->resultset('Artist')->find(666) - => 'Correctly did not find a bad artist id'; +is $replicated->schema->storage->pool->connected_replicants => 1 + => "One replicant reconnected to handle the job"; ## Delete the old database files -$replicate->cleanup; +$replicated->cleanup;