From: Rafael Kitover <rkitover@cpan.org>
Date: Wed, 10 Feb 2010 20:29:51 +0000 (+0000)
Subject: workaround for Moose bug affecting Replicated storage
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cea43436e10983c218ded47e1561183096685f9b;p=dbsrgits%2FDBIx-Class-Historic.git

workaround for Moose bug affecting Replicated storage
---

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 3275de2..9e3f59c 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -391,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;
 };
@@ -744,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
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index a496512..dfc33ec 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -7,6 +7,7 @@ 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';
 
@@ -152,6 +153,14 @@ has next_unknown_replicant_id => (
   },
 );
 
+=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.
@@ -243,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;
 }
 
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
index 08a95ef..f5b4f34 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
@@ -4,6 +4,7 @@ use Moose::Role;
 requires qw/_query_start/;
 with 'DBIx::Class::Storage::DBI::Replicated::WithDSN';
 use MooseX::Types::Moose qw/Bool Str/;
+use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
 
 use namespace::clean -except => 'meta';
 
@@ -55,6 +56,14 @@ has 'active' => (
 has dsn => (is => 'rw', isa => Str);
 has id  => (is => 'rw', isa => Str);
 
+=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.
@@ -66,7 +75,9 @@ Override the debugobj method to redirect this method call back to the master.
 =cut
 
 sub debugobj {
-    return shift->schema->storage->debugobj;
+  my $self = shift;
+
+  return $self->master->debugobj;
 }
 
 =head1 ALSO SEE
diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
index 936edb1..c233361 100644
--- a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
@@ -43,6 +43,16 @@ sub insert {
       $source->column_info($_)->{is_auto_increment} 
   } $source->columns;
 
+# user might have an identity PK without is_auto_increment
+  if (not $identity_col) {
+    foreach my $pk_col ($source->primary_columns) {
+      if (not exists $to_insert->{$pk_col}) {
+        $identity_col = $pk_col;
+        last;
+      }
+    }
+  }
+
   if ($identity_col && (not exists $to_insert->{$identity_col})) {
     my $dbh = $self->_get_dbh;
     my $table_name = $source->from;