[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