[Bast-commits] r3131 - in branches/DBIx-Class-current: . lib/DBIx/Class/Storage t t/lib/DBICTest

[ash at dev.catalyst.perl.org]

Author: ash
Date: 2007-03-17 19:25:17 +0000 (Sat, 17 Mar 2007)
New Revision: 3131

Added:
   branches/DBIx-Class-current/t/lib/DBICTest/ExplodingStorage.pm
Modified:
   branches/DBIx-Class-current/Changes
   branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI.pm
   branches/DBIx-Class-current/t/92storage.t
Log:
fix server disconnect checking for select outside of transaction

Modified: branches/DBIx-Class-current/Changes
===================================================================
--- branches/DBIx-Class-current/Changes	2007-03-16 16:06:21 UTC (rev 3130)
+++ branches/DBIx-Class-current/Changes	2007-03-17 19:25:17 UTC (rev 3131)
@@ -1,5 +1,8 @@
 Revision history for DBIx::Class
 
+        - select et al weren't properly detecing when the server connection
+          had timed out when not in a transaction
+
 0.07999_02 2007-01-25 20:11:00
         - add support for binding BYTEA and similar parameters (w/Pg impl)
         - add support to Ordered for multiple ordering columns

Modified: branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI.pm	2007-03-16 16:06:21 UTC (rev 3130)
+++ branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI.pm	2007-03-17 19:25:17 UTC (rev 3131)
@@ -842,47 +842,55 @@
         map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind;
       $self->debugobj->query_start($sql, @debug_bind);
   }
-  my $sth = eval { $self->sth($sql,$op) };
 
-  if (!$sth || $@) {
-    $self->throw_exception(
-      'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
-    );
-  }
+  my ($rv, $sth);
+  RETRY: while (1) {
+    $sth = eval { $self->sth($sql,$op) };
 
-  my $rv;
-  if ($sth) {
-    my $time = time();
-    $rv = eval {
-      my $placeholder_index = 1; 
+    if (!$sth || $@) {
+      $self->throw_exception(
+        'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
+      );
+    }
 
-      foreach my $bound (@bind) {
+    if ($sth) {
+      my $time = time();
+      $rv = eval {
+        my $placeholder_index = 1; 
 
-        my $attributes = {};
-        my($column_name, @data) = @$bound;
+        foreach my $bound (@bind) {
 
-        if( $bind_attributes ) {
-          $attributes = $bind_attributes->{$column_name}
-          if defined $bind_attributes->{$column_name};
-        }
+          my $attributes = {};
+          my($column_name, @data) = @$bound;
 
-        foreach my $data (@data)
-        {
-          $data = ref $data ? ''.$data : $data; # stringify args
+          if( $bind_attributes ) {
+            $attributes = $bind_attributes->{$column_name}
+            if defined $bind_attributes->{$column_name};
+          }
 
-          $sth->bind_param($placeholder_index, $data, $attributes);
-          $placeholder_index++;
+          foreach my $data (@data)
+          {
+            $data = ref $data ? ''.$data : $data; # stringify args
+
+            $sth->bind_param($placeholder_index, $data, $attributes);
+            $placeholder_index++;
+          }
         }
+        $sth->execute();
+      };
+    
+      if ($@ || !$rv) {
+        $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr))
+          if $self->connected;
+        $self->_populate_dbh;
+      } else {
+        last RETRY;
       }
-      $sth->execute();
-    };
-  
-    if ($@ || !$rv) {
-      $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
+    } else {
+      $self->throw_exception("'$sql' did not generate a statement.");
     }
-  } else {
-    $self->throw_exception("'$sql' did not generate a statement.");
-  }
+  } # While(1) to retry if disconencted
+
   if ($self->debug) {
      my @debug_bind =
        map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind; 

Modified: branches/DBIx-Class-current/t/92storage.t
===================================================================
--- branches/DBIx-Class-current/t/92storage.t	2007-03-16 16:06:21 UTC (rev 3130)
+++ branches/DBIx-Class-current/t/92storage.t	2007-03-17 19:25:17 UTC (rev 3131)
@@ -4,12 +4,30 @@
 use Test::More;
 use lib qw(t/lib);
 use DBICTest;
+use DBICTest::ExplodingStorage;
 
-plan tests => 1;
+plan tests => 3;
 
 my $schema = DBICTest->init_schema();
 
 is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite',
     'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' );
 
+
+my $storage = $schema->storage;
+$storage->ensure_connected;
+
+bless $storage, "DBICTest::ExplodingStorage";
+$schema->storage($storage);
+
+eval { 
+    $schema->resultset('Artist')->create({ name => "Exploding Sheep" }) 
+};
+
+is($@, "", "Exploding \$sth->execute was caught");
+
+is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count,
+  "And the STH was retired");
+
+
 1;

Added: branches/DBIx-Class-current/t/lib/DBICTest/ExplodingStorage.pm
===================================================================
--- branches/DBIx-Class-current/t/lib/DBICTest/ExplodingStorage.pm	                        (rev 0)
+++ branches/DBIx-Class-current/t/lib/DBICTest/ExplodingStorage.pm	2007-03-17 19:25:17 UTC (rev 3131)
@@ -0,0 +1,28 @@
+package DBICTest::ExplodingStorage::Sth;
+
+sub execute {
+  die "Kablammo!";
+}
+
+sub bind_param {}
+
+package DBICTest::ExplodingStorage;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Storage::DBI::SQLite';
+
+my $count = 0;
+sub sth {
+  my ($self, $sql) = @_;
+  return bless {},  "DBICTest::ExplodingStorage::Sth" unless $count++;
+  return $self->next::method($sql);
+}
+
+sub connected {
+  return 0 if $count == 1;
+  return shift->next::method(@_);
+}
+
+1;