X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FOracle%2FGeneric.pm;h=84799f14cbe9e14051a9cbe7ff37e28aafc2ce0b;hb=08ac7648;hp=cfefc772568874bf1737f19ca3fb5b04886fbb2c;hpb=00819de0cb0c81bbadaed7a7312cc575efae1bb8;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index cfefc77..84799f1 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -103,9 +103,6 @@ sub deployment_statements {
   my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_;
 
   $sqltargs ||= {};
-  my $quote_char = $self->schema->storage->sql_maker->quote_char;
-  $sqltargs->{quote_table_names} = $quote_char ? 1 : 0;
-  $sqltargs->{quote_field_names} = $quote_char ? 1 : 0;
 
   if (
     ! exists $sqltargs->{producer_args}{oracle_version}
@@ -203,7 +200,7 @@ sub _dbh_get_autoinc_seq {
     }
     else {
       $self->throw_exception( sprintf (
-        "Unable to introspect trigger '%s' for column %s.%s (references multiple sequences). "
+        "Unable to introspect trigger '%s' for column '%s.%s' (references multiple sequences). "
       . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
         $triggers[0]{name},
         $source_name,
@@ -225,7 +222,7 @@ sub _dbh_get_autoinc_seq {
     }
     else {
       $self->throw_exception( sprintf (
-        "Unable to reliably select a BEFORE INSERT trigger for column %s.%s (possibilities: %s). "
+        "Unable to reliably select a BEFORE INSERT trigger for column '%s.%s' (possibilities: %s). "
       . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
         $source_name,
         $col,
@@ -246,7 +243,7 @@ sub _dbh_get_autoinc_seq {
   }
 
   $self->throw_exception( sprintf (
-    "No suitable BEFORE INSERT triggers found for column %s.%s. "
+    "No suitable BEFORE INSERT triggers found for column '%s.%s'. "
   . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
     $source_name,
     $col,
@@ -284,55 +281,53 @@ sub _ping {
 }
 
 sub _dbh_execute {
-  my ($self, $dbh, $sql, @args) = @_;
+  #my ($self, $dbh, $sql, $bind, $bind_attrs) = @_;
+  my ($self, $sql, $bind) = @_[0,2,3];
 
-  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 below
+  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.)
+  # if we are already in a txn we can't retry anything
+  return shift->$next(@_)
+    if $self->transaction_depth;
+
+  # cheat the blockrunner we are just about to create
+  # we do want to rerun things regardless of outer state
+  local $self->{_in_do_block};
+
+  return DBIx::Class::Storage::BlockRunner->new(
+    storage => $self,
+    wrap_txn => 0,
+    retry_handler => sub {
+      # ORA-01003: no statement parsed (someone changed the table somehow,
+      # invalidating your cursor.)
+      if (
+        $_[0]->failed_attempt_count == 1
+          and
+        $_[0]->last_exception =~ /ORA-01003/
+          and
+        my $dbh = $_[0]->storage->_dbh
+      ) {
         delete $dbh->{CachedKids}{$sql};
+        return 1;
       }
       else {
-        $self->throw_exception($_);
+        return 0;
       }
-    };
-  } while (! $tried++);
-
-  return wantarray ? @res : $res[0];
+    },
+  )->run( $next, @_ );
 }
 
-sub _dbh_execute_array {
+sub _dbh_execute_for_fetch {
   #my ($self, $sth, $tuple_status, @extra) = @_;
 
-  # DBD::Oracle warns loudly on partial execute_array failures
+  # DBD::Oracle warns loudly on partial execute_for_fetch failures
   local $_[1]->{PrintWarn} = 0;
 
   shift->next::method(@_);
@@ -433,28 +428,35 @@ sub _dbi_attrs_for_bind {
   $attrs;
 }
 
-my $dbd_loaded;
 sub bind_attribute_by_data_type {
   my ($self, $dt) = @_;
 
-  $dbd_loaded ||= do {
-    require DBD::Oracle;
-    if ($DBD::Oracle::VERSION eq '1.23') {
-      $self->throw_exception(
-        "BLOB/CLOB support in DBD::Oracle == 1.23 is broken, use an earlier or later ".
-        "version.\n\nSee: https://rt.cpan.org/Public/Bug/Display.html?id=46016\n"
-      );
+  if ($self->_is_lob_type($dt)) {
+
+    # this is a hot-ish codepath, store an escape-flag in the DBD namespace, so that
+    # things like Class::Unload work (unlikely but possible)
+    unless ($DBD::Oracle::__DBIC_DBD_VERSION_CHECK_OK__) {
+
+      # no earlier - no later
+      if ($DBD::Oracle::VERSION eq '1.23') {
+        $self->throw_exception(
+          "BLOB/CLOB support in DBD::Oracle == 1.23 is broken, use an earlier or later ".
+          "version (https://rt.cpan.org/Public/Bug/Display.html?id=46016)"
+        );
+      }
+
+      $DBD::Oracle::__DBIC_DBD_VERSION_CHECK_OK__ = 1;
     }
-    1;
-  };
 
-  if ($self->_is_lob_type($dt)) {
     return {
       ora_type => $self->_is_text_lob_type($dt)
         ? DBD::Oracle::ORA_CLOB()
         : DBD::Oracle::ORA_BLOB()
     };
   }
+  else {
+    return undef;
+  }
 }
 
 # Handle blob columns in WHERE.
@@ -512,10 +514,11 @@ sub _prep_for_execute {
 
   my ($final_sql, @final_binds);
   if ($op eq 'update') {
-    $self->throw_exception('Update with complex WHERE clauses currently not supported')
+    $self->throw_exception('Update with complex WHERE clauses involving BLOB columns currently not supported')
       if $sql =~ /\bWHERE\b .+ \bWHERE\b/xs;
 
-    ($final_sql, $sql) = $sql =~ /^ (.+?) ( \bWHERE\b .+) /xs;
+    my $where_sql;
+    ($final_sql, $where_sql) = $sql =~ /^ (.+?) ( \bWHERE\b .+) /xs;
 
     if (my $set_bind_count = $final_sql =~ y/?//) {
 
@@ -530,6 +533,10 @@ sub _prep_for_execute {
         keys %$lob_bind_indices
       };
     }
+
+    # if we got that far - assume the where SQL is all we got
+    # (the first part is already shoved into $final_sql)
+    $sql = $where_sql;
   }
   elsif ($op ne 'select' and $op ne 'delete') {
     $self->throw_exception("Unsupported \$op: $op");
@@ -639,7 +646,7 @@ sub relname_to_table_alias {
   my $alias = $self->next::method(@_);
 
   # we need to shorten here in addition to the shortening in SQLA itself,
-  # since the final relnames are a crucial for the join optimizer
+  # since the final relnames are crucial for the join optimizer
   return $self->sql_maker->_shorten_identifier($alias);
 }
 
@@ -697,7 +704,7 @@ and child rows of the hierarchy.
   #     person me
   # CONNECT BY
   #     parentid = prior persionid
-  
+
 
   connect_by_nocycle => { parentid => 'prior personid' }