[Bast-commits] r4309 - in DBIx-Class/0.08/branches/replication_dedux: . 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 21:26:26 BST 2008


Author: jnapiorkowski
Date: 2008-04-30 21:26:26 +0100 (Wed, 30 Apr 2008)
New Revision: 4309

Added:
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/
   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
Modified:
   DBIx-Class/0.08/branches/replication_dedux/Makefile.PL
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated.pm
   DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t
Log:
got first pass on the replication and balancer, passing all of the old test suite (which is not much, but it is a milestone of some sort)

Modified: DBIx-Class/0.08/branches/replication_dedux/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/Makefile.PL	2008-04-30 17:15:41 UTC (rev 4308)
+++ DBIx-Class/0.08/branches/replication_dedux/Makefile.PL	2008-04-30 20:26:26 UTC (rev 4309)
@@ -20,6 +20,7 @@
 requires 'Scope::Guard'              => 0.03;
 requires 'Digest::SHA1'              => 2.00;
 requires 'Path::Class'               => 0;
+requires 'List::Util'                => 1.19;
 
 # Perl 5.8.0 doesn't have utf8::is_utf8()
 requires 'Encode'                    => 0 if ($] <= 5.008000);  

Added: 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	                        (rev 0)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm	2008-04-30 20:26:26 UTC (rev 4309)
@@ -0,0 +1,56 @@
+package DBIx::Class::Storage::DBI::Replicated::Balancer;
+
+use Moose;
+use List::Util qw(shuffle);
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Balancer; A Software Load Balancer 
+
+=head1 SYNOPSIS
+
+This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.  You
+shouldn't need to create instances of this class.
+    
+=head1 DESCRIPTION
+
+Given a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>) of replicated
+database's (L<DBIx::Class::Storage::DBI::Replicated::Replicant>), defines a
+method by which query load can be spread out across each replicant in the pool.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head2 next_storage ($pool)
+
+Given a pool object, return the next replicant that will serve queries.  The
+default behavior is to randomize but you can write your own subclasses of
+L<DBIx::Class::Storage::DBI::Replicated::Balancer> to support other balance
+systems.
+
+=cut
+
+sub next_storage {
+	my $self = shift @_;
+	my $pool = shift @_;
+	
+	return (shuffle($pool->all_replicants))[0];
+}
+
+
+=head1 AUTHOR
+
+John Napiorkowski <john.napiorkowski at takkle.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
\ No newline at end of file

Added: 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	                        (rev 0)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm	2008-04-30 20:26:26 UTC (rev 4309)
@@ -0,0 +1,176 @@
+package DBIx::Class::Storage::DBI::Replicated::Pool;
+
+use Moose;
+use MooseX::AttributeHelpers;
+use DBIx::Class::Storage::DBI::Replicated::Replicant;
+use List::Util qw(sum);
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Pool; Manage a pool of replicants
+
+=head1 SYNOPSIS
+
+This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.  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 
+replicants, and gives some methods for querying information about their status.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head2 replicant_type
+
+Base class used to instantiate replicants that are in the pool.  Unless you
+need to subclass L<DBIx::Class::Storage::DBI::Replicated::Replicant> you should
+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',
+    },	
+);
+
+
+=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:
+
+    "dbi:SQLite:dbname=dbfile"
+    
+You could access the specific replicant via:
+
+    $schema->storage->replicants->{'dbname=dbfile'}
+    
+This attributes also supports the following helper methods
+
+=over 4
+
+=item set_replicant($key=>$storage)
+
+Pushes a replicant onto the HashRef under $key
+
+=item get_replicant($key)
+
+Retrieves the named replicant
+
+=item has_replicants
+
+Returns true if the Pool defines replicants.
+
+=item num_replicants
+
+The number of replicants in the pool
+
+=item delete_replicant ($key)
+
+removes the replicant under $key from the pool
+
+=back
+
+=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',
+	},
+);
+
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head2 create_replicants (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
+L</replicants> attribute.
+
+=cut
+
+sub create_replicants {
+	my $self = shift @_;
+	
+	my @newly_created = ();
+	foreach my $connect_info (@_) {
+		my $replicant = $self->create_replicant;
+		$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;
+}
+
+
+=head2 connected_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.";
+    }
+
+This method will actually test that each replicant in the L</replicants> hashref
+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 );
+}
+
+=head2 all_replicants
+
+Just a simple array of all the replicant storages.  No particular order to the
+array is given, nor should any meaning be derived.
+
+=cut
+
+sub all_replicants {
+	my $self = shift @_;
+	return values %{$self->replicants};
+}
+
+
+=head1 AUTHOR
+
+John Napiorkowski <john.napiorkowski at takkle.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+
+1;
\ No newline at end of file

Added: 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	                        (rev 0)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm	2008-04-30 20:26:26 UTC (rev 4309)
@@ -0,0 +1,41 @@
+package DBIx::Class::Storage::DBI::Replicated::Replicant;
+
+use Moose;
+extends 'DBIx::Class::Storage::DBI', 'Moose::Object';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Replicant; A replicated DBI Storage
+
+=head1 SYNOPSIS
+
+This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.  You
+shouldn't need to create instances of this class.
+    
+=head1 DESCRIPTION
+
+Replicants are DBI Storages that follow a master DBI Storage.  Typically this
+is accomplished via an external replication system.  Please see the documents
+for L<DBIx::Class::Storage::DBI::Replicated> for more details.
+
+This class exists to define methods of a DBI Storage that only make sense when
+it's a classic 'slave' in a pool of slave databases which replicate from a
+given master database.
+
+=head1 ATTRIBUTES
+
+This class defines the following attributes.
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head1 AUTHOR
+
+John Napiorkowski <john.napiorkowski at takkle.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
\ 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 17:15:41 UTC (rev 4308)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated.pm	2008-04-30 20:26:26 UTC (rev 4309)
@@ -1,9 +1,12 @@
 package DBIx::Class::Storage::DBI::Replicated;
 
 use Moose;
+use DBIx::Class::Storage::DBI;
 use DBIx::Class::Storage::DBI::Replicated::Pool;
+use DBIx::Class::Storage::DBI::Replicated::Balancer;
+use Scalar::Util qw(blessed);
 
-#extends 'DBIx::Class::Storage::DBI', 'Moose::Object';
+extends 'DBIx::Class::Storage::DBI', 'Moose::Object';
 
 =head1 NAME
 
@@ -83,7 +86,6 @@
     handles=>[qw/   
         on_connect_do
         on_disconnect_do       
-        columns_info_for
         connect_info
         throw_exception
         sql_maker
@@ -151,121 +153,127 @@
 );
 
 
-=head2 replicant_storage_pool_type
+=head2 pool_type
 
-Contains the classname which will instantiate the L</replicant_storage_pool>
-object.  Defaults to: L<DBIx::Class::Storage::DBI::Replicated::Pool>.
+Contains the classname which will instantiate the L</pool> object.  Defaults 
+to: L<DBIx::Class::Storage::DBI::Replicated::Pool>.
 
 =cut
 
-has 'replicant_storage_pool_type' => (
+has 'pool_type' => (
     is=>'ro',
     isa=>'ClassName',
     required=>1,
+    lazy=>1,
     default=>'DBIx::Class::Storage::DBI::Replicated::Pool',
-    handles=> {
-    	'create_replicant_storage_pool' => 'new',
+    handles=>{
+    	'create_pool' => 'new',
     },
 );
 
 
-=head2 pool_balancer_type
+=head2 balancer_type
 
 The replication pool requires a balance class to provider the methods for
 choose how to spread the query load across each replicant in the pool.
 
 =cut
 
-has 'pool_balancer_type' => (
+has 'balancer_type' => (
     is=>'ro',
     isa=>'ClassName',
     required=>1,
-    default=>'DBIx::Class::Storage::DBI::Replicated::Pool::Balancer',
-    handles=> {
-    	'create_replicant_storage_pool' => 'new',
+    lazy=>1,
+    default=>'DBIx::Class::Storage::DBI::Replicated::Balancer',
+    handles=>{
+    	'create_balancer' => 'new',
     },
 );
 
 
-=head2 replicant_storage_pool
+=head2 pool
 
-Holds the list of connected replicants, their status and other housekeeping or
-reporting methods.
+Is a <DBIx::Class::Storage::DBI::Replicated::Pool> or derived class.  This is a
+container class for one or more replicated databases.
 
 =cut
 
-has 'replicant_storage_pool' => (
+has 'pool' => (
     is=>'ro',
     isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
     lazy_build=>1,
-    handles=>[qw/replicant_storages/],
+    handles=>[qw/
+        replicants
+        has_replicants
+        create_replicants
+        num_replicants
+        delete_replicant
+    /],
 );
 
 
+=head2 balancer
 
-=head1 METHODS
+Is a <DBIx::Class::Storage::DBI::Replicated::Balancer> or derived class.  This 
+is a class that takes a pool (<DBIx::Class::Storage::DBI::Replicated::Pool>)
 
-This class defines the following methods.
+=cut
 
-=head2 new
+has 'balancer' => (
+    is=>'ro',
+    isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer',
+    lazy_build=>1,
+    handles=>[qw/next_storage/],
+);
 
-Make sure we properly inherit from L<Moose>.
+=head1 METHODS
 
-=cut
+This class defines the following methods.
 
-sub new {
-    my $class = shift @_;
-    my $obj = $class->SUPER::new(@_);
-  
-    return $class->meta->new_object(
-        __INSTANCE__ => $obj, @_
-    );
-}
+=head2 _build_master
 
-=head2 _build_master_storage
+Lazy builder for the L</master> attribute.
 
-Lazy builder for the L</master_storage> attribute.
-
 =cut
 
-sub _build_next_replicant_storage {
+sub _build_master {
 	DBIx::Class::Storage::DBI->new;
 }
 
 
-=head2 _build_current_replicant_storage
+=head2 _build_current_replicant
 
 Lazy builder for the L</current_replicant_storage> attribute.
 
 =cut
 
-sub _build_current_replicant_storage {
-    shift->replicant_storage_pool->first;
+sub _build_current_replicant {
+	my $self = shift @_;
+	$self->next_storage($self->pool);
 }
 
 
-=head2 _build_replicant_storage_pool
+=head2 _build_pool
 
-Lazy builder for the L</replicant_storage_pool> attribute.
+Lazy builder for the L</pool> attribute.
 
 =cut
 
-sub _build_replicant_storage_pool {
+sub _build_pool {
     my $self = shift @_;
-    $self->create_replicant_storage_pool;
+    $self->create_pool;
 }
 
 
-=head2 around: create_replicant_storage_pool
+=head2 _build_balancer
 
-Make sure all calles to the method set a default balancer type to our current
-balancer type.
+Lazy builder for the L</balancer> attribute.
 
 =cut
 
-around 'create_replicant_storage_pool' => sub {
-    my ($method, $self, @args) = @_;
-    return $self->$method(balancer_type=>$self->pool_balancer_type, @args);
+sub _build_balancer {
+    my $self = shift @_;
+    $self->create_balancer;
 }
 
 
@@ -277,24 +285,14 @@
 
 =cut
 
-after 'get_current_replicant_storage' => sub {
+after 'get_current_replicant' => sub {
     my $self = shift @_;
-    my $next_replicant = $self->replicant_storage_pool->next;
-    $self->next_replicant_storage($next_replicant);
+    my $next_replicant = $self->next_storage($self->pool);
+    
+    $self->set_current_replicant($next_replicant);
 };
 
 
-=head2 find_or_create
-
-First do a find on the replicant.  If no rows are found, pass it on to the
-L</master_storage>
-
-=cut
-
-sub find_or_create {
-	my $self = shift @_;
-}
-
 =head2 all_storages
 
 Returns an array of of all the connected storage backends.  The first element
@@ -306,9 +304,9 @@
 sub all_storages {
 	my $self = shift @_;
 	
-	return (
-	   $self->master_storage,
-	   $self->replicant_storages,
+	return grep {defined $_ && blessed $_} (
+	   $self->master,
+	   $self->replicants,
 	);
 }
 
@@ -323,8 +321,8 @@
 	my $self = shift @_;
 	
 	return
-	   $self->master_storage->connected &&
-	   $self->replicant_storage_pool->has_connected_slaves;
+	   $self->master->connected &&
+	   $self->pool->connected_replicants;
 }
 
 
@@ -336,7 +334,7 @@
 
 sub ensure_connected {
     my $self = shift @_;
-    foreach $source (shift->all_sources) {
+    foreach my $source ($self->all_storages) {
         $source->ensure_connected(@_);
     }
 }
@@ -350,8 +348,8 @@
 
 sub limit_dialect {
     my $self = shift @_;
-    foreach $source (shift->all_sources) {
-        $source->name_sep(@_);
+    foreach my $source ($self->all_storages) {
+        $source->limit_dialect(@_);
     }
 }
 
@@ -364,8 +362,8 @@
 
 sub quote_char {
     my $self = shift @_;
-    foreach $source (shift->all_sources) {
-        $source->name_sep(@_);
+    foreach my $source ($self->all_storages) {
+        $source->quote_char(@_);
     }
 }
 
@@ -378,7 +376,7 @@
 
 sub name_sep {
     my $self = shift @_;
-    foreach $source (shift->all_sources) {
+    foreach my $source ($self->all_storages) {
         $source->name_sep(@_);
     }
 }
@@ -392,7 +390,7 @@
 
 sub set_schema {
 	my $self = shift @_;
-	foreach $source (shift->all_sources) {
+	foreach my $source ($self->all_storages) {
 		$source->set_schema(@_);
 	}
 }
@@ -406,7 +404,7 @@
 
 sub debug {
     my $self = shift @_;
-    foreach $source (shift->all_sources) {
+    foreach my $source ($self->all_storages) {
         $source->debug(@_);
     }
 }
@@ -420,7 +418,7 @@
 
 sub debugobj {
     my $self = shift @_;
-    foreach $source (shift->all_sources) {
+    foreach my $source ($self->all_storages) {
         $source->debugobj(@_);
     }
 }
@@ -434,7 +432,7 @@
 
 sub debugfh {
     my $self = shift @_;
-    foreach $source (shift->all_sources) {
+    foreach my $source ($self->all_storages) {
         $source->debugfh(@_);
     }
 }
@@ -448,7 +446,7 @@
 
 sub debugcb {
     my $self = shift @_;
-    foreach $source (shift->all_sources) {
+    foreach my $source ($self->all_storages) {
         $source->debugcb(@_);
     }
 }
@@ -462,7 +460,7 @@
 
 sub disconnect {
     my $self = shift @_;
-    foreach $source (shift->all_sources) {
+    foreach my $source ($self->all_storages) {
         $source->disconnect(@_);
     }
 }

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 17:15:41 UTC (rev 4308)
+++ DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t	2008-04-30 20:26:26 UTC (rev 4309)
@@ -8,9 +8,14 @@
     eval "use Moose";
     plan $@
         ? ( skip_all => 'needs Moose for testing' )
-        : ( tests => 2 );
-}	
+        : ( tests => 30 );
+}
 
+use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
+use_ok 'DBIx::Class::Storage::DBI::Replicated::Balancer';
+use_ok 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+use_ok 'DBIx::Class::Storage::DBI::Replicated';
+
 ## ----------------------------------------------------------------------------
 ## Build a class to hold all our required testing data and methods.
 ## ----------------------------------------------------------------------------
@@ -20,57 +25,195 @@
     package DBIx::Class::DBI::Replicated::TestReplication;
    
     use DBICTest;
+    use File::Copy;
+    
     use base qw/Class::Accessor::Fast/;
     
-    __PACKAGE__->mk_accessors( qw/schema/ );
+    __PACKAGE__->mk_accessors( qw/schema master_path slave_paths/ );
 
     ## Initialize the object
     
 	sub new {
-	    my $proto = shift;
-	    my $class = ref( $proto ) || $proto;
-	    my $self = {};
+	    my $class = shift @_;
+	    my $self = $class->SUPER::new(@_);
 	
-	    bless( $self, $class );
-	
 	    $self->schema( $self->init_schema );
+	    $self->master_path("t/var/DBIxClass.db");
 	
 	    return $self;
 	}
     
-    ## get the Schema and set the replication storage type
+    ## Get the Schema and set the replication storage type
     
     sub init_schema {
         my $class = shift @_;
         my $schema = DBICTest->init_schema(storage_type=>'::DBI::Replicated');
         return $schema;
     }
+    
+    ## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
+    ## $storage->connect_info to be used for connecting replicants.
+    
+    sub generate_replicant_connect_info {
+    	my $self = shift @_;
+        my @dsn = map {
+            "dbi:SQLite:${_}";
+        } @{$self->slave_paths};
+        
+        return map { [$_,'','',{}] } @dsn;
+    }
+    
+    ## Do a 'good enough' replication by copying the master dbfile over each of
+    ## the slave dbfiles.
+    
+    sub replicate {
+        my $self = shift @_;
+        foreach my $slave (@{$self->slave_paths}) {
+            copy($self->master_path, $slave);
+        }
+    }
+    
+    ## Cleanup after ourselves.  Unlink all gthe slave paths.
+    
+    sub cleanup {
+        my $self = shift @_;
+        foreach my $slave (@{$self->slave_paths}) {
+            unlink $slave;
+        }     
+    }
 }
 
 ## ----------------------------------------------------------------------------
 ## 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",
-    ],
-);
+## Thi first bunch of tests are basic, just make sure all the bits are behaving
 
-ok my $replicate = DBIx::Class::DBI::Replicated::TestReplication->new()
-    => 'Created a replication object';
+ok my $replicated = DBIx::Class::DBI::Replicated::TestReplication
+    ->new({
+        slave_paths=>[
+	        "t/var/DBIxClass_slave1.db",
+	        "t/var/DBIxClass_slave2.db",    
+        ],
+    }) => 'Created a replication object';
     
-isa_ok $replicate->schema
+isa_ok $replicated->schema
     => 'DBIx::Class::Schema';
     
+isa_ok $replicated->schema->storage
+    => 'DBIx::Class::Storage::DBI::Replicated';
+
+ok $replicated->schema->storage->meta
+    => 'has a meta object';
     
-    warn dump $replicate->schema->storage->meta;
+isa_ok $replicated->schema->storage->master
+    => 'DBIx::Class::Storage::DBI';
     
-    warn dump $replicate->schema->storage->master;
+isa_ok $replicated->schema->storage->pool
+    => 'DBIx::Class::Storage::DBI::Replicated::Pool';
+    
+isa_ok $replicated->schema->storage->balancer
+    => 'DBIx::Class::Storage::DBI::Replicated::Balancer'; 
 
+ok my @replicant_connects = $replicated->generate_replicant_connect_info
+    => 'got replication connect information';
 
+ok my @replicated_storages = $replicated->schema->storage->create_replicants(@replicant_connects)
+    => 'Created some storages suitable for replicants';
+    
+isa_ok $replicated->schema->storage->current_replicant
+    => 'DBIx::Class::Storage::DBI';
+    
+ok $replicated->schema->storage->pool->has_replicants
+    => 'does have replicants';     
+
+is $replicated->schema->storage->num_replicants => 2
+    => 'has two replicants';
+       
+isa_ok $replicated_storages[0]
+    => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+
+isa_ok $replicated_storages[1]
+    => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+    
+isa_ok $replicated->schema->storage->replicants->{"t/var/DBIxClass_slave1.db"}
+    => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+
+isa_ok $replicated->schema->storage->replicants->{"t/var/DBIxClass_slave2.db"}
+    => 'DBIx::Class::Storage::DBI::Replicated::Replicant';  
+
+## Add some info to the database
+
+$replicated
+    ->schema
+    ->populate('Artist', [
+        [ qw/artistid name/ ],
+        [ 4, "Ozric Tentacles"],
+    ]);
+                
+## Make sure all the slaves have the table definitions
+
+$replicated->replicate;
+
+## Make sure we can read the data.
+
+ok my $artist1 = $replicated->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.
+
+$replicated
+    ->schema
+    ->populate('Artist', [
+        [ qw/artistid name/ ],
+        [ 5, "Doom's Children"],
+        [ 6, "Dead On Arrival"],
+        [ 7, "Watergate"],
+    ]);
+
+## Alright, the database 'cluster' is not in a consistent state.  When we do
+## a read now we expect bad news
+
+is $replicated->schema->resultset('Artist')->find(5), undef
+    => 'read after disconnect fails because it uses a replicant which we have neglected to "replicate" yet';
+
+## Make sure all the slaves have the table definitions
+$replicated->replicate;
+
+## Should find some data now
+
+ok my $artist2 = $replicated->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 disconnect all the replicants?
+
+$replicated->schema->storage->replicants->{"t/var/DBIxClass_slave1.db"}->disconnect;
+$replicated->schema->storage->replicants->{"t/var/DBIxClass_slave2.db"}->disconnect;
+
+ok my $artist3 = $replicated->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';
+
+
 __END__
 
 ## ----------------------------------------------------------------------------




More information about the Bast-commits mailing list