The complete fix for intermittent t/750firebird.t failures (RT#110979)

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

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 3e746ad..af27c55 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1968,12 +1968,30 @@ sub insert {
 
   my %returned_cols = %$to_insert;
   if (my $retlist = $sqla_opts->{returning}) {  # if IR is supported - we will get everything in one set
-    @ir_container = try {
-      local $SIG{__WARN__} = sub {};
-      my @r = $sth->fetchrow_array;
-      $sth->finish;
-      @r;
-    } unless @ir_container;
+
+    unless( @ir_container ) {
+      try {
+
+        # FIXME - need to investigate why Caelum silenced this in 4d4dc518
+        local $SIG{__WARN__} = sub {};
+
+        @ir_container = $sth->fetchrow_array;
+        $sth->finish;
+
+      } catch {
+        # Evict the $sth from the cache in case we got here, since the finish()
+        # is crucial, at least on older Firebirds, possibly on other engines too
+        #
+        # It would be too complex to make this a proper subclass override,
+        # and besides we already take the try{} penalty, adding a catch that
+        # triggers infrequently is a no-brainer
+        #
+        if( my $kids = $self->_dbh->{CachedKids} ) {
+          $kids->{$_} == $sth and delete $kids->{$_}
+            for keys %$kids
+        }
+      };
+    }
 
     @returned_cols{@$retlist} = @ir_container if @ir_container;
   }
@@ -2286,10 +2304,12 @@ sub _dbh_execute_for_fetch {
 
       # FIXME SUBOPTIMAL - DBI needs fixing to always stringify regardless of DBD
       # For the time being forcibly stringify whatever is stringifiable
-      (length ref $v and is_plain_value $v)
-        ? "$v"
-        : $v
-      ;
+      my $vref;
+
+      ( !length ref $v or ! ($vref = is_plain_value $v) )   ? $v
+    : defined blessed( $$vref )                             ? "$$vref"
+                                                            : $$vref
+    ;
     } map { $_->[0] } @$proto_bind ];
   };
 
@@ -2425,21 +2445,9 @@ sub _select_args {
     where => $where,
   };
 
-  # Sanity check the attributes (SQLMaker does it too, but
-  # in case of a software_limit we'll never reach there)
-  if (defined $attrs->{offset}) {
-    $self->throw_exception('A supplied offset attribute must be a non-negative integer')
-      if ( $attrs->{offset} =~ /\D/ or $attrs->{offset} < 0 );
-  }
-
-  if (defined $attrs->{rows}) {
-    $self->throw_exception("The rows attribute must be a positive integer if present")
-      if ( $attrs->{rows} =~ /\D/ or $attrs->{rows} <= 0 );
-  }
-  elsif ($attrs->{offset}) {
-    # MySQL actually recommends this approach.  I cringe.
-    $attrs->{rows} = $sql_maker->__max_int;
-  }
+  # MySQL actually recommends this approach.  I cringe.
+  $attrs->{rows} ||= $sql_maker->__max_int
+    if $attrs->{offset};
 
   # see if we will need to tear the prefetch apart to satisfy group_by == select
   # this is *extremely tricky* to get right, I am still not sure I did