eval => try where tests for $@ done

[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 4214463..62ade80 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -15,6 +15,7 @@ use Scalar::Util();
 use List::Util();
 use Data::Dumper::Concise();
 use Sub::Name ();
+use Try::Tiny;
 
 use File::Path ();
 
@@ -157,8 +158,7 @@ sub DESTROY {
 
   # some databases need this to stop spewing warnings
   if (my $dbh = $self->_dbh) {
-    local $@;
-    eval {
+    try {
       %{ $dbh->{CachedKids} } = ();
       $dbh->disconnect;
     };
@@ -730,22 +730,24 @@ sub dbh_do {
   my @result;
   my $want_array = wantarray;
 
-  eval {
+  my $exception;
+  my @args = @_;
+  try {
 
     if($want_array) {
-        @result = $self->$code($dbh, @_);
+        @result = $self->$code($dbh, @args);
     }
     elsif(defined $want_array) {
-        $result[0] = $self->$code($dbh, @_);
+        $result[0] = $self->$code($dbh, @args);
     }
     else {
-        $self->$code($dbh, @_);
+        $self->$code($dbh, @args);
     }
+  } catch {
+    $exception = shift;
   };
 
-  # ->connected might unset $@ - copy
-  my $exception = $@;
-  if(!$exception) { return $want_array ? @result : $result[0] }
+  if(! defined $exception) { return $want_array ? @result : $result[0] }
 
   $self->throw_exception($exception) if $self->connected;
 
@@ -776,30 +778,32 @@ sub txn_do {
 
   my $tried = 0;
   while(1) {
-    eval {
+    my $exception;
+    my @args = @_;
+    try {
       $self->_get_dbh;
 
       $self->txn_begin;
       if($want_array) {
-          @result = $coderef->(@_);
+          @result = $coderef->(@args);
       }
       elsif(defined $want_array) {
-          $result[0] = $coderef->(@_);
+          $result[0] = $coderef->(@args);
       }
       else {
-          $coderef->(@_);
+          $coderef->(@args);
       }
       $self->txn_commit;
+    } catch {
+      $exception = $_;
     };
 
-    # ->connected might unset $@ - copy
-    my $exception = $@;
-    if(!$exception) { return $want_array ? @result : $result[0] }
+    if(! defined $exception) { return $want_array ? @result : $result[0] }
 
     if($tried++ || $self->connected) {
-      eval { $self->txn_rollback };
-      my $rollback_exception = $@;
-      if($rollback_exception) {
+      my $rollback_exception;
+      try { $self->txn_rollback } catch { $rollback_exception = shift };
+      if(defined $rollback_exception) {
         my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
         $self->throw_exception($exception)  # propagate nested rollback
           if $rollback_exception =~ /$exception_class/;
@@ -1014,7 +1018,7 @@ sub _server_info {
 
     my $server_version = do {
       local $@; # might be happenin in some sort of destructor
-      eval { $self->_get_server_version };
+      try { $self->_get_server_version };
     };
 
     if (defined $server_version) {
@@ -1172,7 +1176,8 @@ sub _connect {
     $DBI::connect_via = 'connect';
   }
 
-  eval {
+  my $caught;
+  try {
     if(ref $info[0] eq 'CODE') {
        $dbh = $info[0]->();
     }
@@ -1197,12 +1202,14 @@ sub _connect {
       $dbh->{RaiseError} = 1;
       $dbh->{PrintError} = 0;
     }
+  } catch {
+    $caught = 1;
   };
 
   $DBI::connect_via = $old_connect_via if $old_connect_via;
 
   $self->throw_exception("DBI Connection failed: " . ($@||$DBI::errstr))
-    if !$dbh || $@;
+    if !$dbh || $caught;
 
   $self->_dbh_autocommit($dbh->{AutoCommit});
 
@@ -1353,7 +1360,7 @@ sub _dbh_commit {
 sub txn_rollback {
   my $self = shift;
   my $dbh = $self->_dbh;
-  eval {
+  try {
     if ($self->{transaction_depth} == 1) {
       $self->debugobj->txn_rollback()
         if ($self->debug);
@@ -1371,9 +1378,8 @@ sub txn_rollback {
     else {
       die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
     }
-  };
-  if ($@) {
-    my $error = $@;
+  } catch {
+    my $error = shift;
     my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
     $error =~ /$exception_class/ and $self->throw_exception($error);
     # ensure that a failed rollback resets the transaction depth
@@ -1676,16 +1682,20 @@ sub _execute_array {
     $placeholder_index++;
   }
 
-  my $rv = eval {
-    $self->_dbh_execute_array($sth, $tuple_status, @extra);
+  my $rv;
+  my $err;
+  try {
+    $rv = $self->_dbh_execute_array($sth, $tuple_status, @extra);
+  } catch {
+    $err = shift;
   };
-  my $err = $@ || $sth->errstr;
+  $err = defined $err ? $err : ($sth->err ? $sth->errstr : undef );
 
 # Statement must finish even if there was an exception.
-  eval { $sth->finish };
-  $err = $@ unless $err;
+  try { $sth->finish } 
+  catch { $err = shift unless defined $err };
 
-  if ($err) {
+  if (defined $err) {
     my $i = 0;
     ++$i while $i <= $#$tuple_status && !ref $tuple_status->[$i];
 
@@ -1711,20 +1721,25 @@ sub _dbh_execute_array {
 sub _dbh_execute_inserts_with_no_binds {
   my ($self, $sth, $count) = @_;
 
-  eval {
+  my $exception;
+  try {
     my $dbh = $self->_get_dbh;
     local $dbh->{RaiseError} = 1;
     local $dbh->{PrintError} = 0;
 
     $sth->execute foreach 1..$count;
+  } catch {
+    $exception = shift;
   };
-  my $exception = $@;
 
 # Make sure statement is finished even if there was an exception.
-  eval { $sth->finish };
-  $exception = $@ unless $exception;
+  try { 
+    $sth->finish 
+  } catch {
+    $exception = shift unless defined $exception;
+  };
 
-  $self->throw_exception($exception) if $exception;
+  $self->throw_exception($exception) if defined $exception;
 
   return $count;
 }
@@ -2059,7 +2074,8 @@ sub _dbh_columns_info_for {
 
   if ($dbh->can('column_info')) {
     my %result;
-    eval {
+    my $caught;
+    try {
       my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
       my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
       $sth->execute();
@@ -2074,8 +2090,10 @@ sub _dbh_columns_info_for {
 
         $result{$col_name} = \%column_info;
       }
+    } catch {
+      $caught = 1;
     };
-    return \%result if !$@ && scalar keys %result;
+    return \%result if !$caught && scalar keys %result;
   }
 
   my %result;
@@ -2176,12 +2194,15 @@ sub _placeholders_supported {
 
   # some drivers provide a $dbh attribute (e.g. Sybase and $dbh->{syb_dynamic_supported})
   # but it is inaccurate more often than not
-  eval {
+  my $rc = 1;
+  try {
     local $dbh->{PrintError} = 0;
     local $dbh->{RaiseError} = 1;
     $dbh->do('select ?', {}, 1);
+  } catch {
+    $rc = 0;
   };
-  return $@ ? 0 : 1;
+  return $rc;
 }
 
 # Check if placeholders bound to non-string types throw exceptions
@@ -2190,13 +2211,16 @@ sub _typeless_placeholders_supported {
   my $self = shift;
   my $dbh  = $self->_get_dbh;
 
-  eval {
+  my $rc = 1;
+  try {
     local $dbh->{PrintError} = 0;
     local $dbh->{RaiseError} = 1;
     # this specifically tests a bind that is NOT a string
     $dbh->do('select 1 where 1 = ?', {}, 1);
+  } catch {
+    $rc = 0;
   };
-  return $@ ? 0 : 1;
+  return $rc;
 }
 
 =head2 sqlt_type
@@ -2513,14 +2537,13 @@ sub deploy {
     return if($line =~ /^COMMIT/m);
     return if $line =~ /^\s+$/; # skip whitespace only
     $self->_query_start($line);
-    eval {
+    try {
       # do a dbh_do cycle here, as we need some error checking in
       # place (even though we will ignore errors)
       $self->dbh_do (sub { $_[1]->do($line) });
-    };
-    if ($@) {
+    } catch {
       carp qq{$@ (running "${line}")};
-    }
+    };
     $self->_query_end($line);
   };
   my @statements = $schema->deployment_statements($type, undef, $dir, { %{ $sqltargs || {} }, no_comments => 1 } );