[Bast-commits] r4311 - in
DBIx-Class/0.08/branches/replication_dedux:
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI
lib/DBIx/Class/Storage/DBI/Replicated t
jnapiorkowski at dev.catalyst.perl.org
jnapiorkowski at dev.catalyst.perl.org
Wed Apr 30 23:16:55 BST 2008
Author: jnapiorkowski
Date: 2008-04-30 23:16:55 +0100 (Wed, 30 Apr 2008)
New Revision: 4311
Modified:
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated.pm
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t
Log:
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
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm 2008-04-30 20:32:54 UTC (rev 4310)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm 2008-04-30 22:16:55 UTC (rev 4311)
@@ -39,7 +39,7 @@
my $self = shift @_;
my $pool = shift @_;
- return (shuffle($pool->all_replicants))[0];
+ return (shuffle($pool->active_replicants))[0];
}
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2008-04-30 20:32:54 UTC (rev 4310)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2008-04-30 22:16:55 UTC (rev 4311)
@@ -101,7 +101,7 @@
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<DBIx::Class::Storage::DBI::Replicated::Replicant> object and store it in the
@@ -111,10 +111,11 @@
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 @@
} $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
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2008-04-30 20:32:54 UTC (rev 4310)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2008-04-30 22:16:55 UTC (rev 4311)
@@ -26,10 +26,40 @@
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 <john.napiorkowski at takkle.com>
@@ -38,4 +68,6 @@
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
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated.pm 2008-04-30 20:32:54 UTC (rev 4310)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated.pm 2008-04-30 22:16:55 UTC (rev 4311)
@@ -32,16 +32,9 @@
## 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
Warning: This class is marked ALPHA. We are using this in development and have
@@ -105,6 +98,7 @@
txn_rollback
sth
deploy
+ schema
/],
);
@@ -150,6 +144,7 @@
select_single
columns_info_for
/],
+ trigger=>sub {'xxxxxxxxxxxxxxxxxxxxxxxxxxx'},
);
@@ -277,6 +272,19 @@
}
+=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 @@
=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);
};
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI.pm 2008-04-30 20:32:54 UTC (rev 4310)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI.pm 2008-04-30 22:16:55 UTC (rev 4311)
@@ -1063,6 +1063,7 @@
if ( $self->debug ) {
@bind = $self->_fix_bind_params(@bind);
+
$self->debugobj->query_start( $sql, @bind );
}
}
Modified: DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t 2008-04-30 20:32:54 UTC (rev 4310)
+++ DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t 2008-04-30 22:16:55 UTC (rev 4311)
@@ -8,7 +8,7 @@
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 @@
use DBICTest;
use File::Copy;
+ use Data::Dump qw/dump/;
use base qw/Class::Accessor::Fast/;
@@ -64,7 +65,8 @@
}
## 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 @@
## 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 @@
is $artist3->name, "Dead On Arrival"
=> 'Found expected name for first result';
+is $replicated->schema->storage->pool->connected_replicants => 1
+ => "One replicant reconnected to handle the job";
-__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';
-
## Delete the old database files
-$replicate->cleanup;
+$replicated->cleanup;
More information about the Bast-commits
mailing list