Support for saving CLOB and BLOB types in Oracle.

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

diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index 3ca19d9..92a920a 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -25,7 +25,9 @@ This class implements autoincrements for Oracle.
 =cut
 
 use Carp::Clan qw/^DBIx::Class/;
-use Scalar::Util ();
+
+use DBD::Oracle qw( :ora_types );
+#use constant ORA_BLOB => 113;  ## ORA_CLOB is 112
 
 use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
 
@@ -85,28 +87,36 @@ sub _sequence_fetch {
   return $id;
 }
 
+=head2 connected
+
+Returns true if we have an open (and working) database connection, false if it is not (yet)
+open (or does not work). (Executes a simple SELECT to make sure it works.)
+
+The reason this is needed is that L<DBD::Oracle>'s ping() does not do a real
+OCIPing but just gets the server version, which doesn't help if someone killed
+your session.
+
+=cut
+
 sub connected {
   my $self = shift;
 
-  if ($self->SUPER::connected(@_)) {
+  if (not $self->SUPER::connected(@_)) {
+    return 0;
+  }
+  else {
     my $dbh = $self->_dbh;
 
-    my $ping_sth = $dbh->prepare_cached("select 1 from dual");
-
     local $dbh->{RaiseError} = 1;
+
     eval {
+      my $ping_sth = $dbh->prepare_cached("select 1 from dual");
       $ping_sth->execute;
       $ping_sth->finish;
     };
 
-    if ($@) {
-      return 0;
-    } else {
-      return 1;
-    }
+    return $@ ? 0 : 1;
   }
-
-  return 0;
 }
 
 sub _dbh_execute {
@@ -114,28 +124,28 @@ sub _dbh_execute {
   my ($dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
 
   my $wantarray = wantarray;
-  my @res;
-  my $exception;
 
-  my $try = 2;
-  
-  while ($try--) {
-    eval {
-      if ($wantarray) {
-        @res    = $self->SUPER::_dbh_execute(@_);
+  my (@res, $exception, $retried);
+
+  RETRY: {
+    do {
+      eval {
+        if ($wantarray) {
+          @res    = $self->SUPER::_dbh_execute(@_);
+        } else {
+          $res[0] = $self->SUPER::_dbh_execute(@_);
+        }
+      };
+      $exception = $@;
+      if ($exception =~ /ORA-01003/) {
+        # ORA-01003: no statement parsed (someone changed the table somehow,
+        # invalidating your cursor.)
+        my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
+        delete $dbh->{CachedKids}{$sql};
       } else {
-        $res[0] = $self->SUPER::_dbh_execute(@_);
+        last RETRY;
       }
-    };
-    $exception = $@;
-    if ($exception =~ /ORA-01003/) {
-# ORA-01003: no statement parsed (someone changed the table somehow,
-# invalidating your cursor.)
-      my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
-      delete $dbh->{CachedKids}{$sql};
-    } else {
-      last;
-    }
+    } while (not $retried++);
   }
 
   $self->throw_exception($exception) if $exception;
@@ -183,6 +193,48 @@ sub _svp_begin {
     $self->dbh->do("SAVEPOINT $name");
 }
 
+=head2 source_bind_attributes
+
+Handle LOB types in Oracle.  Under a certain size (4k?), you can get away
+with the driver assuming your input is the deprecated LONG type if you
+encode it as a hex string.  That ain't gonna fly at larger values, where
+you'll discover you have to do what this does.
+
+This method had to be overridden because we need to set ora_field to the
+actual column, and that isn't passed to the call (provided by Storage) to
+bind_attribute_by_data_type.
+
+According to L<DBD::Oracle>, the ora_field isn't always necessary, but
+adding it doesn't hurt, and will save your bacon if you're modifying a
+table with more than one LOB column.
+
+=cut
+
+sub source_bind_attributes 
+{
+       my $self = shift;
+       my($source) = @_;
+
+       my %bind_attributes;
+
+       foreach my $column ($source->columns) {
+               my $data_type = $source->column_info($column)->{data_type} || '';
+               next unless $data_type;
+
+               my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type);
+
+               if ($data_type =~ /^[BC]LOB$/i) {
+                       $column_bind_attrs{'ora_type'}
+                               = uc($data_type) eq 'CLOB' ? ORA_CLOB : ORA_BLOB;
+                       $column_bind_attrs{'ora_field'} = $column;
+               }
+
+               $bind_attributes{$column} = \%column_bind_attrs;
+       }
+
+       return \%bind_attributes;
+}
+
 # Oracle automatically releases a savepoint when you start another one with the
 # same name.
 sub _svp_release { 1 }