workaround for Moose bug affecting Replicated storage

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Replicated / Pool.pm

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index c31cd4d..dfc33ec 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -1,13 +1,13 @@
 package DBIx::Class::Storage::DBI::Replicated::Pool;
 
 use Moose;
-use MooseX::AttributeHelpers;
 use DBIx::Class::Storage::DBI::Replicated::Replicant;
 use List::Util 'sum';
 use Scalar::Util 'reftype';
 use DBI ();
 use Carp::Clan qw/^DBIx::Class/;
 use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
+use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
 
 use namespace::clean -except => 'meta';
 
@@ -125,19 +125,42 @@ removes the replicant under $key from the pool
 
 has 'replicants' => (
   is=>'rw',
-  metaclass => 'Collection::Hash',
+  traits => ['Hash'],
   isa=>HashRef['Object'],
   default=>sub {{}},
-  provides  => {
-    'set' => 'set_replicant',
-    'get' => 'get_replicant',
-    'empty' => 'has_replicants',
-    'count' => 'num_replicants',
-    'delete' => 'delete_replicant',
-    'values' => 'all_replicant_storages',
+  handles  => {
+    'set_replicant' => 'set',
+    'get_replicant' => 'get',
+    'has_replicants' => 'is_empty',
+    'num_replicants' => 'count',
+    'delete_replicant' => 'delete',
+    'all_replicant_storages' => 'values',
   },
 );
 
+around has_replicants => sub {
+    my ($orig, $self) = @_;
+    return !$self->$orig;
+};
+
+has next_unknown_replicant_id => (
+  is => 'rw',
+  traits => ['Counter'],
+  isa => Int,
+  default => 1,
+  handles => {
+    'inc_unknown_replicant_id' => 'inc',
+  },
+);
+
+=head2 master
+
+Reference to the master Storage.
+
+=cut
+
+has master => (is => 'rw', isa => DBICStorageDBI, weak_ref => 1);
+
 =head1 METHODS
 
 This class defines the following methods.
@@ -159,32 +182,45 @@ sub connect_replicants {
     $connect_info = [ $connect_info ]
       if reftype $connect_info ne 'ARRAY';
 
-    my $replicant = $self->connect_replicant($schema, $connect_info);
-
     my $connect_coderef =
       (reftype($connect_info->[0])||'') eq 'CODE' ? $connect_info->[0]
         : (reftype($connect_info->[0])||'') eq 'HASH' &&
           $connect_info->[0]->{dbh_maker};
 
     my $dsn;
-    if (not $connect_coderef) {
-      $dsn = $connect_info->[0];
-      $dsn = $dsn->{dsn} if (reftype($dsn)||'') eq 'HASH';
-    }
-    else {
-# yes this is evil, but it only usually happens once
+    my $replicant = do {
+# yes this is evil, but it only usually happens once (for coderefs)
+# this will fail if the coderef does not actually DBI::connect
       no warnings 'redefine';
       my $connect = \&DBI::connect;
       local *DBI::connect = sub {
         $dsn = $_[1];
         goto $connect;
       };
-      $connect_coderef->();
+      $self->connect_replicant($schema, $connect_info);
+    };
+
+    my $key;
+
+    if (!$dsn) {
+      if (!$connect_coderef) {
+        $dsn = $connect_info->[0];
+        $dsn = $dsn->{dsn} if (reftype($dsn)||'') eq 'HASH';
+      }
+      else {
+        # all attempts to get the DSN failed
+        $key = "UNKNOWN_" . $self->next_unknown_replicant_id;
+        $self->inc_unknown_replicant_id;
+      }
+    }
+    if ($dsn) {
+      $replicant->dsn($dsn);
+      ($key) = ($dsn =~ m/^dbi\:.+\:(.+)$/i);
     }
-    $replicant->dsn($dsn);
-    my ($key) = ($dsn =~ m/^dbi\:.+\:(.+)$/i);
 
+    $replicant->id($key);
     $self->set_replicant($key => $replicant);  
+
     push @newly_created, $replicant;
   }
 
@@ -216,7 +252,18 @@ sub connect_replicant {
     $replicant->_determine_driver
   });
 
-  DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant);  
+  Moose::Meta::Class->initialize(ref $replicant);
+
+  my $class = Moose::Meta::Class->create_anon_class(
+    superclasses => [ ref $replicant ],
+    roles        => [ 'DBIx::Class::Storage::DBI::Replicated::Replicant' ],
+    cache        => 1,
+  );
+  $class->rebless_instance($replicant);
+
+  # link back to master
+  $replicant->master($self->master);
+
   return $replicant;
 }
 
@@ -253,16 +300,15 @@ sub _safely {
 
   eval {
     $code->()
-  }; 
+  };
   if ($@) {
-    $replicant
-      ->debugobj
-      ->print(
-        sprintf( "Exception trying to $name for replicant %s, error is %s",
-          $replicant->_dbi_connect_info->[0], $@)
-        );
-       return;
+    $replicant->debugobj->print(sprintf(
+      "Exception trying to $name for replicant %s, error is %s",
+      $replicant->_dbi_connect_info->[0], $@)
+    );
+    return undef;
   }
+
   return 1;
 }