workaround for Moose bug affecting Replicated storage
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Replicated.pm
index d8a5f6d..9e3f59c 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
 
   my %replication_required = (
     'Moose' => '0.90',
-    'MooseX::Types' => '0.16',
+    'MooseX::Types' => '0.21',
     'namespace::clean' => '0.11',
     'Hash::Merge' => '0.11'
   );
@@ -50,7 +50,9 @@ You should set the 'storage_type attribute to a replicated type.  You should
 also define your arguments, such as which balancer you want and any arguments
 that the Pool object should get.
 
+  my $schema = Schema::Class->clone;
   $schema->storage_type( ['::DBI::Replicated', {balancer=>'::Random'}] );
+  $schema->connection(...);
 
 Next, you need to add in the Replicants.  Basically this is an array of 
 arrayrefs, where each arrayref is database connect information.  Think of these
@@ -119,7 +121,7 @@ to force a query to run against Master when needed.
 Replicated Storage has additional requirements not currently part of L<DBIx::Class>
 
   Moose => '0.90',
-  MooseX::Types => '0.16',
+  MooseX::Types => '0.21',
   namespace::clean => '0.11',
   Hash::Merge => '0.11'
 
@@ -389,7 +391,16 @@ around connect_info => sub {
   my $master = $self->master;
   $master->_determine_driver;
   Moose::Meta::Class->initialize(ref $master);
-  DBIx::Class::Storage::DBI::Replicated::WithDSN->meta->apply($master);
+
+  my $class = Moose::Meta::Class->create_anon_class(
+    superclasses => [ ref $master ],
+    roles        => [ 'DBIx::Class::Storage::DBI::Replicated::WithDSN' ],
+    cache        => 1,
+  );
+  $class->rebless_instance($master);
+
+  # link pool back to master
+  $self->pool->master($master);
 
   $wantarray ? @res : $res;
 };
@@ -407,7 +418,7 @@ bits get put into the correct places.
 =cut
 
 sub BUILDARGS {
-  my ($class, $schema, $storage_type_args, @args) = @_;        
+  my ($class, $schema, $storage_type_args, @args) = @_;  
 
   return {
     schema=>$schema,
@@ -742,50 +753,35 @@ sub debug {
 
 =head2 debugobj
 
-set a debug object across all storages
+set a debug object
 
 =cut
 
 sub debugobj {
   my $self = shift @_;
-  if(@_) {
-    foreach my $source ($self->all_storages) {
-      $source->debugobj(@_);
-    }
-  }
-  return $self->master->debugobj;
+  return $self->master->debugobj(@_);
 }
 
 =head2 debugfh
 
-set a debugfh object across all storages
+set a debugfh object
 
 =cut
 
 sub debugfh {
   my $self = shift @_;
-  if(@_) {
-    foreach my $source ($self->all_storages) {
-      $source->debugfh(@_);
-    }
-  }
-  return $self->master->debugfh;
+  return $self->master->debugfh(@_);
 }
 
 =head2 debugcb
 
-set a debug callback across all storages
+set a debug callback
 
 =cut
 
 sub debugcb {
   my $self = shift @_;
-  if(@_) {
-    foreach my $source ($self->all_storages) {
-      $source->debugcb(@_);
-    }
-  }
-  return $self->master->debugcb;
+  return $self->master->debugcb(@_);
 }
 
 =head2 disconnect