[Bast-commits] r7287 - in DBIx-Class/0.08/branches/sybase: lib/DBIx/Class/Storage t

[caelum at dev.catalyst.perl.org]

Author: caelum
Date: 2009-08-10 08:07:45 +0000 (Mon, 10 Aug 2009)
New Revision: 7287

Modified:
   DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm
   DBIx-Class/0.08/branches/sybase/t/746sybase.t
Log:
fix and test redispatch to reblessed storage insert/update

Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm	2009-08-10 06:44:51 UTC (rev 7286)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm	2009-08-10 08:07:45 UTC (rev 7287)
@@ -825,7 +825,7 @@
 sub _determine_driver {
   my ($self) = @_;
 
-  if (not $self->_driver_determined) {
+  if ((not $self->_driver_determined) && (not $self->{_in_determine_driver})) {
     my $started_unconnected = 0;
     local $self->{_in_determine_driver} = 1;
 
@@ -1331,7 +1331,7 @@
 }
 
 sub update {
-  my $self = shift @_;
+  my ($self, $source, @args) = @_; 
 
 # redispatch to update method of storage we reblessed into, if necessary
   if (not $self->_driver_determined) {
@@ -1339,10 +1339,9 @@
     goto $self->can('update');
   }
 
-  my $source = shift @_;
   my $bind_attributes = $self->source_bind_attributes($source);
 
-  return $self->_execute('update' => [], $source, $bind_attributes, @_);
+  return $self->_execute('update' => [], $source, $bind_attributes, @args);
 }
 
 

Modified: DBIx-Class/0.08/branches/sybase/t/746sybase.t
===================================================================
--- DBIx-Class/0.08/branches/sybase/t/746sybase.t	2009-08-10 06:44:51 UTC (rev 7286)
+++ DBIx-Class/0.08/branches/sybase/t/746sybase.t	2009-08-10 08:07:45 UTC (rev 7287)
@@ -27,21 +27,22 @@
 my $schema;
 my $storage_idx = -1;
 
+sub get_connected_schema {
+  DBICTest::Schema->connect($dsn, $user, $pass, {
+    on_connect_call => [
+      [ blob_setup => log_on_update => 1 ], # this is a safer option
+    ],
+  });
+}
+
 for my $storage_type (@storage_types) {
   $storage_idx++;
-# this is so we can set ->storage_type before connecting
-  my $schema = DBICTest::Schema->clone;
 
   unless ($storage_type eq 'DBI::Sybase') { # autodetect
-    $schema->storage_type("::$storage_type");
+    DBICTest::Schema->storage_type("::$storage_type");
   }
 
-  $schema->connection($dsn, $user, $pass, {
-    AutoCommit => 1,
-    on_connect_call => [
-      [ blob_setup => log_on_update => 1 ], # this is a safer option
-    ],
-  });
+  $schema = get_connected_schema();
 
   $schema->storage->ensure_connected;
 
@@ -76,16 +77,26 @@
 # so we start unconnected
   $schema->storage->disconnect;
 
-# inserts happen in a txn, so we make sure it still works inside a txn too
-  $schema->txn_begin;
-
 # test primary key handling
   my $new = $schema->resultset('Artist')->create({ name => 'foo' });
   ok($new->artistid > 0, "Auto-PK worked");
 
   $seen_id{$new->artistid}++;
 
-  for (1..6) {
+# check redispatch to storage-specific insert when auto-detected storage
+  if ($storage_type eq 'DBI::Sybase') {
+    DBICTest::Schema->storage_type('::DBI');
+    $schema = get_connected_schema();
+  }
+
+  $new = $schema->resultset('Artist')->create({ name => 'Artist 1' });
+  is ( $seen_id{$new->artistid}, undef, 'id for Artist 1 is unique' );
+  $seen_id{$new->artistid}++;
+
+# inserts happen in a txn, so we make sure it still works inside a txn too
+  $schema->txn_begin;
+
+  for (2..6) {
     $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
     is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
     $seen_id{$new->artistid}++;
@@ -216,6 +227,13 @@
 
     # try a blob update
     my $new_str = $binstr{large} . 'mtfnpy';
+
+    # check redispatch to storage-specific update when auto-detected storage
+    if ($storage_type eq 'DBI::Sybase') {
+      DBICTest::Schema->storage_type('::DBI');
+      $schema = get_connected_schema();
+    }
+
     eval { $rs->search({ id => 1 })->update({ blob => $new_str }) };
     ok !$@, 'updated blob successfully';
     diag $@ if $@;