[Bast-commits] r4557 - in DBIx-Class/0.08/branches/replication_dedux: lib/DBIx/Class lib/DBIx/Class/Storage/DBI/Replicated t

[jnapiorkowski at dev.catalyst.perl.org]

Author: jnapiorkowski
Date: 2008-07-07 19:58:37 +0100 (Mon, 07 Jul 2008)
New Revision: 4557

Modified:
   DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Row.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/t/93storage_replication.t
Log:
removed some debugging comments, removed transaction from Row->get_from_storage, enabled support for new resultset attribute "execute_reliably" which signals the Balancer to send read requests to the master.  Also refactored connect_replicants to break down functionality into two methods and added new Balancer method to roll the replicant to the next in the queque.  added tests for all the above.

Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Row.pm	2008-07-07 13:08:34 UTC (rev 4556)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Row.pm	2008-07-07 18:58:37 UTC (rev 4557)
@@ -802,7 +802,7 @@
 =head2 get_from_storage
 
 Returns a new Row which is whatever the Storage has for the currently created
-Row object.  You ca use this to see if the storage has become inconsistent with
+Row object.  You can use this to see if the storage has become inconsistent with
 whatever your Row object is.
 
 =cut
@@ -810,9 +810,7 @@
 sub get_from_storage {
     my $self = shift @_;
     my @primary_columns = map { $self->$_ } $self->primary_columns;
-    return $self->result_source->schema->txn_do(sub {
-      return $self->result_source->resultset->find(@primary_columns); 	
-    });
+    return $self->result_source->resultset->find(@primary_columns); 	
 }
 
 =head2 throw_exception

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-07-07 13:08:34 UTC (rev 4556)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm	2008-07-07 18:58:37 UTC (rev 4557)
@@ -140,21 +140,38 @@
   return $next ? $next:$self->master; 
 };
 
-=head2 before: select
+=head2 increment_storage
 
+Rolls the Storage to whatever is next in the queue, as defined by the Balancer.
+
+=cut
+
+sub increment_storage {
+  my $self = shift @_;
+  my $next_replicant = $self->next_storage;
+  $self->current_replicant($next_replicant);
+}
+
+=head2 around: select
+
 Advice on the select attribute.  Each time we use a replicant
 we need to change it via the storage pool algorithm.  That way we are spreading
 the load evenly (hopefully) across existing capacity.
 
 =cut
 
-before 'select' => sub {
-  my $self = shift @_;
-  my $next_replicant = $self->next_storage;
-  $self->current_replicant($next_replicant);
+around 'select' => sub {
+  my ($select, $self, @args) = @_;
+  
+  if ($args[-1]->{execute_reliably}) {
+    return $self->master->select(@args);
+  } else {
+    $self->increment_storage;
+    return $self->$select(@args);
+  }
 };
 
-=head2 before: select_single
+=head2 around: select_single
 
 Advice on the select_single attribute.  Each time we use a replicant
 we need to change it via the storage pool algorithm.  That way we are spreading
@@ -162,10 +179,15 @@
 
 =cut
 
-before 'select_single' => sub {
-  my $self = shift @_;
-  my $next_replicant = $self->next_storage;
-  $self->current_replicant($next_replicant);
+around 'select_single' => sub {
+  my ($select_single, $self, @args) = @_;
+  
+  if ($args[-1]->{execute_reliably}) {
+    return $self->master->select_single(@args);
+  } else {
+  	$self->increment_storage;
+    return $self->$select_single(@args);
+  }
 };
 
 =head2 before: columns_info_for
@@ -178,8 +200,7 @@
 
 before 'columns_info_for' => sub {
   my $self = shift @_;
-  my $next_replicant = $self->next_storage;
-  $self->current_replicant($next_replicant);
+  $self->increment_storage;
 };
 
 =head1 AUTHOR

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-07-07 13:08:34 UTC (rev 4556)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm	2008-07-07 18:58:37 UTC (rev 4557)
@@ -149,10 +149,7 @@
   
   my @newly_created = ();
   foreach my $connect_info (@_) {
-    my $replicant = $self->create_replicant($schema);
-    $replicant->connect_info($connect_info);    
-    $replicant->ensure_connected;
-    DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant);
+    my $replicant = $self->connect_replicant($schema, $connect_info);
     my ($key) = ($connect_info->[0]=~m/^dbi\:.+\:(.+)$/);
     $self->set_replicant( $key => $replicant);  
     push @newly_created, $replicant;
@@ -161,6 +158,24 @@
   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);    
+  $replicant->ensure_connected;
+  DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant);
+    
+  return $replicant;
+}
+
 =head2 connected_replicants
 
 Returns true if there are connected replicants.  Actually is overloaded to
@@ -237,10 +252,8 @@
       $replicant->lag_behind_master <= $self->maximum_lag &&
       $replicant->ensure_connected
     ) {
-      ## TODO:: Hook debug for this
       $replicant->active(1)
     } else {
-      ## TODO:: Hook debug for this
       $replicant->active(0);
     }
   }

Modified: DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t	2008-07-07 13:08:34 UTC (rev 4556)
+++ DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t	2008-07-07 18:58:37 UTC (rev 4557)
@@ -9,7 +9,7 @@
     eval "use Moose; use Test::Moose";
     plan $@
         ? ( skip_all => 'needs Moose for testing' )
-        : ( tests => 77 );
+        : ( tests => 80 );
 }
 
 use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
@@ -569,6 +569,20 @@
        => 'Got expected single result from transaction';	  
 }     
 
+## Private attribute tests
+
+{
+	ok my $artist_rs = $replicated->schema->resultset('Artist')
+        => 'got artist resultset';
+	   
+	## Turn on Reliable Storage
+	ok my $reliable_artist_rs = $artist_rs->search(undef, {execute_reliably=>1})
+        => 'Created a resultset using reliable storage';
+	   
+    ok my $artist = $reliable_artist_rs->find(2) 
+        => 'got an artist to test see the attributes';
+}
+
 ## Delete the old database files
 $replicated->cleanup;