Rewrite the DBI connector to use Try::Tiny, avoid a leak by evoking a callback codere...

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

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 1630180..9e4256c 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -15,7 +15,7 @@ use Scalar::Util qw/refaddr weaken reftype blessed/;
 use Data::Dumper::Concise 'Dumper';
 use Sub::Name 'subname';
 use Try::Tiny;
-use File::Path 'mkpath';
+use File::Path 'make_path';
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors('simple' => qw/
@@ -732,9 +732,10 @@ sub dbh_do {
 
   local $self->{_in_dbh_do} = 1;
 
-  my @args = @_;
+  # take a ref instead of a copy, to preserve coderef @_ aliasing semantics
+  my $args = \@_;
   return try {
-    $self->$code ($dbh, @args);
+    $self->$code ($dbh, @$args);
   } catch {
     $self->throw_exception($_) if $self->connected;
 
@@ -744,7 +745,7 @@ sub dbh_do {
       if $ENV{DBIC_DBIRETRY_DEBUG};
 
     $self->_populate_dbh;
-    $self->$code($self->_dbh, @args);
+    $self->$code($self->_dbh, @$args);
   };
 }
 
@@ -768,19 +769,22 @@ sub txn_do {
   my $tried = 0;
   while(1) {
     my $exception;
-    my @args = @_;
+
+    # take a ref instead of a copy, to preserve coderef @_ aliasing semantics
+    my $args = \@_;
+
     try {
       $self->_get_dbh;
 
       $self->txn_begin;
       if($want_array) {
-          @result = $coderef->(@args);
+          @result = $coderef->(@$args);
       }
       elsif(defined $want_array) {
-          $result[0] = $coderef->(@args);
+          $result[0] = $coderef->(@$args);
       }
       else {
-          $coderef->(@args);
+          $coderef->(@$args);
       }
       $self->txn_commit;
     } catch {
@@ -1175,18 +1179,26 @@ sub _connect {
     }
 
     unless ($self->unsafe) {
-      my $weak_self = $self;
-      weaken $weak_self;
-      $dbh->{HandleError} = sub {
+
+      # this odd anonymous coderef dereference is in fact really
+      # necessary to avoid the unwanted effect described in perl5
+      # RT#75792
+      sub {
+        my $weak_self = $_[0];
+        weaken $weak_self;
+
+        $_[1]->{HandleError} = sub {
           if ($weak_self) {
             $weak_self->throw_exception("DBI Exception: $_[0]");
           }
           else {
             # the handler may be invoked by something totally out of
             # the scope of DBIC
-            croak ("DBI Exception: $_[0]");
+            croak ("DBI Exception (unhandled by DBIC, ::Schema GCed): $_[0]");
           }
-      };
+        };
+      }->($self, $dbh);
+
       $dbh->{ShowErrorStatement} = 1;
       $dbh->{RaiseError} = 1;
       $dbh->{PrintError} = 0;
@@ -1622,7 +1634,7 @@ sub insert_bulk {
   # scope guard
   my $guard = $self->txn_scope_guard;
 
-  $self->_query_start( $sql, ['__BULK__'] );
+  $self->_query_start( $sql, [ dummy => '__BULK_INSERT__' ] );
   my $sth = $self->sth($sql);
   my $rv = do {
     if ($empty_bind) {
@@ -1635,7 +1647,7 @@ sub insert_bulk {
     }
   };
 
-  $self->_query_end( $sql, ['__BULK__'] );
+  $self->_query_end( $sql, [ dummy => '__BULK_INSERT__' ] );
 
   $guard->commit;
 
@@ -1933,7 +1945,7 @@ sub _select_args {
   }
   elsif (defined $attrs->{offset}) {
     # MySQL actually recommends this approach.  I cringe.
-    $attrs->{rows} = 2**32;
+    $attrs->{rows} = $sql_maker->__max_int;
   }
 
   my @limit;
@@ -2327,8 +2339,13 @@ sub create_ddl_dir {
     carp "No directory given, using ./\n";
     $dir = './';
   } else {
-      -d $dir or mkpath $dir
-          or $self->throw_exception("create_ddl_dir: $! creating dir '$dir'");
+      -d $dir
+        or
+      make_path ("$dir")  # make_path does not like objects (i.e. Path::Class::Dir)
+        or
+      $self->throw_exception(
+        "Failed to create '$dir': " . ($! || $@ || 'error unknow')
+      );
   }
 
   $self->throw_exception ("Directory '$dir' does not exist\n") unless(-d $dir);