From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 14 Mar 2012 12:40:44 +0000 (+0100)
Subject: Fix leak of oracle storage objects in its _dbh_execute override
X-Git-Tag: v0.08197~84
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a6ae092b9b8145c49ff8d1ecd29940a996ddc4d0;p=dbsrgits%2FDBIx-Class.git

Fix leak of oracle storage objects in its _dbh_execute override

Replace with a much cleaner (and leak free) blockrunner instance
---

diff --git a/Changes b/Changes
index a08fcdf..97c47c9 100644
--- a/Changes
+++ b/Changes
@@ -24,6 +24,7 @@ Revision history for DBIx::Class
           handle
         - Fix leakage of $schema on in-memory new_related() calls
         - Fix more cases of $schema leakage in SQLT::Parser::DBIC
+        - Fix leakage of $storage in ::Storage::DBI::Oracle
         - Remove useless vestigial pessimization in Ordered.pm for cases 
           when the position column is part of a unique constraint
         - Fix dbicadmin to no longer ignore the documented 'config' option
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index 3840c34..c107934 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -284,49 +284,41 @@ sub _ping {
 }
 
 sub _dbh_execute {
-  my ($self, $dbh, $sql, @args) = @_;
+  my ($self, $dbh, $sql, $bind) = @_;
 
-  my (@res, $tried);
-  my $want = wantarray;
-  my $next = $self->next::can;
-  do {
-    try {
-      my $exec = sub {
-        # Turn off sth caching for multi-part LOBs. See _prep_for_execute above.
-        local $self->{disable_sth_caching} = 1
-          if first {
-            ($_->[0]{_ora_lob_autosplit_part}||0)
-              > (__cache_queries_with_max_lob_parts-1)
-          } @{ $args[0] };
-
-        $self->$next($dbh, $sql, @args)
-      };
+  # Turn off sth caching for multi-part LOBs. See _prep_for_execute above.
+  local $self->{disable_sth_caching} = 1 if first {
+    ($_->[0]{_ora_lob_autosplit_part}||0)
+      >
+    (__cache_queries_with_max_lob_parts - 1)
+  } @$bind;
 
-      if (!defined $want) {
-        $exec->();
-      }
-      elsif (! $want) {
-        $res[0] = $exec->();
-      }
-      else {
-        @res = $exec->();
-      }
+  my $next = $self->next::can;
 
-      $tried++;
-    }
-    catch {
-      if (! $tried and $_ =~ /ORA-01003/) {
-        # ORA-01003: no statement parsed (someone changed the table somehow,
-        # invalidating your cursor.)
-        delete $dbh->{CachedKids}{$sql};
-      }
-      else {
-        $self->throw_exception($_);
+  # if we are already in a txn we can't retry anything
+  return shift->$next(@_)
+    if $self->transaction_depth;
+
+  # cheat the blockrunner - we do want to rerun things regardless of outer state
+  local $self->{_in_do_block};
+
+  return DBIx::Class::Storage::BlockRunner->new(
+    storage => $self,
+    run_code => $next,
+    run_args => \@_,
+    wrap_txn => 0,
+    retry_handler => sub {
+      # ORA-01003: no statement parsed (someone changed the table somehow,
+      # invalidating your cursor.)
+      return 0 if ($_[0]->retried_count or $_[0]->last_exception !~ /ORA-01003/);
+
+      # re-prepare towards new table data
+      if (my $dbh = $_[0]->storage->_dbh) {
+        delete $dbh->{CachedKids}{$_[0]->run_args->[2]};
       }
-    };
-  } while (! $tried++);
-
-  return wantarray ? @res : $res[0];
+      return 1;
+    },
+  )->run;
 }
 
 sub _dbh_execute_for_fetch {