Get Storage::Oracle to behave when quoting is enabled

[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 33fe93d..6b6f7dd 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -27,7 +27,7 @@ __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker');
 
 __PACKAGE__->mk_group_accessors('simple' => qw/
   _connect_info _dbi_connect_info _dbic_connect_attributes _driver_determined
-  _dbh _dbh_details _conn_pid _conn_tid _sql_maker _sql_maker_opts
+  _dbh _dbh_details _conn_pid _sql_maker _sql_maker_opts
   transaction_depth _dbh_autocommit  savepoints
 /);
 
@@ -166,6 +166,8 @@ sub new {
 # of a fork()ed child to kill the parent's shared DBI handle,
 # *before perl reaches the DESTROY in this package*
 # Yes, it is ugly and effective.
+# Additionally this registry is used by the CLONE method to
+# make sure no handles are shared between threads
 {
   my %seek_and_destroy;
 
@@ -180,11 +182,22 @@ sub new {
     local $?; # just in case the DBI destructor changes it somehow
 
     # destroy just the object if not native to this process/thread
-    $_->_preserve_foreign_dbh for (grep
+    $_->_verify_pid for (grep
       { defined $_ }
       values %seek_and_destroy
     );
   }
+
+  sub CLONE {
+    # As per DBI's recommendation, DBIC disconnects all handles as
+    # soon as possible (DBIC will reconnect only on demand from within
+    # the thread)
+    for (values %seek_and_destroy) {
+      next unless $_;
+      $_->{_dbh_gen}++;  # so that existing cursors will drop as well
+      $_->_dbh(undef);
+    }
+  }
 }
 
 sub DESTROY {
@@ -193,53 +206,28 @@ sub DESTROY {
   # some databases spew warnings on implicit disconnect
   local $SIG{__WARN__} = sub {};
   $self->_dbh(undef);
-}
-
-sub _preserve_foreign_dbh {
-  my $self = shift;
-
-  return unless $self->_dbh;
-
-  $self->_verify_tid;
-
-  return unless $self->_dbh;
-
-  $self->_verify_pid;
 
+  # this op is necessary, since the very last perl runtime statement
+  # triggers a global destruction shootout, and the $SIG localization
+  # may very well be destroyed before perl actually gets to do the
+  # $dbh undef
+  1;
 }
 
 # handle pid changes correctly - do not destroy parent's connection
 sub _verify_pid {
   my $self = shift;
 
-  return if ( defined $self->_conn_pid and $self->_conn_pid == $$ );
-
-  $self->_dbh->{InactiveDestroy} = 1;
-  $self->_dbh(undef);
-  $self->{_dbh_gen}++;
-
-  return;
-}
-
-# very similar to above, but seems to FAIL if I set InactiveDestroy
-sub _verify_tid {
-  my $self = shift;
-
-  if ( ! defined $self->_conn_tid ) {
-    return; # no threads
-  }
-  elsif ( $self->_conn_tid == threads->tid ) {
-    return; # same thread
+  my $pid = $self->_conn_pid;
+  if( defined $pid and $pid != $$ and my $dbh = $self->_dbh ) {
+    $dbh->{InactiveDestroy} = 1;
+    $self->{_dbh_gen}++;
+    $self->_dbh(undef);
   }
 
-  #$self->_dbh->{InactiveDestroy} = 1;  # why does t/51threads.t fail...?
-  $self->_dbh(undef);
-  $self->{_dbh_gen}++;
-
   return;
 }
 
-
 =head2 connect_info
 
 This method is normally called by L<DBIx::Class::Schema/connection>, which
@@ -921,7 +909,7 @@ sub connected {
 sub _seems_connected {
   my $self = shift;
 
-  $self->_preserve_foreign_dbh;
+  $self->_verify_pid;
 
   my $dbh = $self->_dbh
     or return 0;
@@ -969,7 +957,7 @@ sub dbh {
 # this is the internal "get dbh or connect (don't check)" method
 sub _get_dbh {
   my $self = shift;
-  $self->_preserve_foreign_dbh;
+  $self->_verify_pid;
   $self->_populate_dbh unless $self->_dbh;
   return $self->_dbh;
 }
@@ -1023,8 +1011,7 @@ sub _populate_dbh {
 
   $self->_dbh($self->_connect(@info));
 
-  $self->_conn_pid($$);
-  $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
+  $self->_conn_pid($$) if $^O ne 'MSWin32'; # on win32 these are in fact threads
 
   $self->_determine_driver;
 
@@ -1590,14 +1577,12 @@ sub _execute {
     $self->dbh_do('_dbh_execute', @_);  # retry over disconnects
 }
 
-sub insert {
+sub _prefetch_autovalues {
   my ($self, $source, $to_insert) = @_;
 
   my $colinfo = $source->columns_info;
 
-  # mix with auto-nextval marked values (a bit of a speed hit, but
-  # no saner way to handle this yet)
-  my $auto_nextvals = {} ;
+  my %values;
   for my $col (keys %$colinfo) {
     if (
       $colinfo->{$col}{auto_nextval}
@@ -1608,8 +1593,8 @@ sub insert {
         ref $to_insert->{$col} eq 'SCALAR'
       )
     ) {
-      $auto_nextvals->{$col} = $self->_sequence_fetch(
-        'nextval',
+      $values{$col} = $self->_sequence_fetch(
+        'NEXTVAL',
         ( $colinfo->{$col}{sequence} ||=
             $self->_dbh_get_autoinc_seq($self->_get_dbh, $source, $col)
         ),
@@ -1617,8 +1602,16 @@ sub insert {
     }
   }
 
+  \%values;
+}
+
+sub insert {
+  my ($self, $source, $to_insert) = @_;
+
+  my $prefetched_values = $self->_prefetch_autovalues($source, $to_insert);
+
   # fuse the values
-  $to_insert = { %$to_insert, %$auto_nextvals };
+  $to_insert = { %$to_insert, %$prefetched_values };
 
   # list of primary keys we try to fetch from the database
   # both not-exsists and scalarrefs are considered
@@ -1643,7 +1636,7 @@ sub insert {
 
   my ($rv, $sth) = $self->_execute('insert' => [], $source, $bind_attributes, $to_insert, $sqla_opts);
 
-  my %returned_cols = %$auto_nextvals;
+  my %returned_cols;
 
   if (my $retlist = $sqla_opts->{returning}) {
     my @ret_vals = try {
@@ -1656,7 +1649,7 @@ sub insert {
     @returned_cols{@$retlist} = @ret_vals if @ret_vals;
   }
 
-  return \%returned_cols;
+  return { %$prefetched_values, %returned_cols };
 }