X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=3dbfd39719f00af8b3933be92d9bd18fef2fa1f5;hb=4edfce2f91ce49d56ea11eb7710600b3fe5b96c5;hp=62ade80435a8c84d974fefa34e65dc49b9cc2d24;hpb=7803e57ad8daee28020676140ea6894c31e3112e;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 62ade80..3dbfd39 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -16,14 +16,14 @@ use List::Util();
 use Data::Dumper::Concise();
 use Sub::Name ();
 use Try::Tiny;
-
 use File::Path ();
+use namespace::clean;
 
-__PACKAGE__->mk_group_accessors('simple' =>
-  qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid
-     _conn_tid transaction_depth _dbh_autocommit _driver_determined savepoints
-     _server_info_hash/
-);
+__PACKAGE__->mk_group_accessors('simple' => qw/
+  _connect_info _dbi_connect_info _dbic_connect_attributes _driver_determined
+  _dbh _server_info_hash _conn_pid _conn_tid _sql_maker _sql_maker_opts
+  transaction_depth _dbh_autocommit  savepoints
+/);
 
 # the values for these accessors are picked out (and deleted) from
 # the attribute hashref passed to connect_info
@@ -48,6 +48,7 @@ __PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks');
 my @rdbms_specific_methods = qw/
   deployment_statements
   sqlt_type
+  sql_maker
   build_datetime_parser
   datetime_parser_type
 
@@ -581,6 +582,11 @@ sub connect_info {
   $self->_dbi_connect_info([@args,
     %attrs && !(ref $args[0] eq 'CODE') ? \%attrs : ()]);
 
+  # FIXME - dirty:
+  # save attributes them in a separate accessor so they are always
+  # introspectable, even in case of a CODE $dbhmaker
+  $self->_dbic_connect_attributes (\%attrs);
+
   return $self->_connect_info;
 }
 
@@ -722,41 +728,25 @@ sub dbh_do {
 
   my $dbh = $self->_get_dbh;
 
-  return $self->$code($dbh, @_) if $self->{_in_dbh_do}
-      || $self->{transaction_depth};
+  return $self->$code($dbh, @_)
+    if ( $self->{_in_dbh_do} || $self->{transaction_depth} );
 
   local $self->{_in_dbh_do} = 1;
 
-  my @result;
-  my $want_array = wantarray;
-
-  my $exception;
   my @args = @_;
-  try {
-
-    if($want_array) {
-        @result = $self->$code($dbh, @args);
-    }
-    elsif(defined $want_array) {
-        $result[0] = $self->$code($dbh, @args);
-    }
-    else {
-        $self->$code($dbh, @args);
-    }
+  return try {
+    $self->$code ($dbh, @args);
   } catch {
-    $exception = shift;
-  };
-
-  if(! defined $exception) { return $want_array ? @result : $result[0] }
+    $self->throw_exception($_) if $self->connected;
 
-  $self->throw_exception($exception) if $self->connected;
+    # We were not connected - reconnect and retry, but let any
+    #  exception fall right through this time
+    carp "Retrying $code after catching disconnected exception: $_"
+      if $ENV{DBIC_DBIRETRY_DEBUG};
 
-  # We were not connected - reconnect and retry, but let any
-  #  exception fall right through this time
-  carp "Retrying $code after catching disconnected exception: $exception"
-    if $ENV{DBIC_DBIRETRY_DEBUG};
-  $self->_populate_dbh;
-  $self->$code($self->_dbh, @_);
+    $self->_populate_dbh;
+    $self->$code($self->_dbh, @args);
+  };
 }
 
 # This is basically a blend of dbh_do above and DBIx::Class::Storage::txn_do.
@@ -1016,10 +1006,7 @@ sub _server_info {
 
     my %info;
 
-    my $server_version = do {
-      local $@; # might be happenin in some sort of destructor
-      try { $self->_get_server_version };
-    };
+    my $server_version = try { $self->_get_server_version };
 
     if (defined $server_version) {
       $info{dbms_version} = $server_version;
@@ -1176,7 +1163,6 @@ sub _connect {
     $DBI::connect_via = 'connect';
   }
 
-  my $caught;
   try {
     if(ref $info[0] eq 'CODE') {
        $dbh = $info[0]->();
@@ -1185,7 +1171,11 @@ sub _connect {
        $dbh = DBI->connect(@info);
     }
 
-    if($dbh && !$self->unsafe) {
+    if (!$dbh) {
+      die $DBI::errstr;
+    }
+
+    unless ($self->unsafe) {
       my $weak_self = $self;
       Scalar::Util::weaken($weak_self);
       $dbh->{HandleError} = sub {
@@ -1202,17 +1192,15 @@ sub _connect {
       $dbh->{RaiseError} = 1;
       $dbh->{PrintError} = 0;
     }
-  } catch {
-    $caught = 1;
+  }
+  catch {
+    $self->throw_exception("DBI Connection failed: $_")
+  }
+  finally {
+    $DBI::connect_via = $old_connect_via if $old_connect_via;
   };
 
-  $DBI::connect_via = $old_connect_via if $old_connect_via;
-
-  $self->throw_exception("DBI Connection failed: " . ($@||$DBI::errstr))
-    if !$dbh || $caught;
-
   $self->_dbh_autocommit($dbh->{AutoCommit});
-
   $dbh;
 }
 
@@ -1378,14 +1366,17 @@ sub txn_rollback {
     else {
       die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
     }
-  } 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
-    $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
-    $self->throw_exception($error);
   }
+  catch {
+    my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
+
+    if ($_ !~ /$exception_class/) {
+      # ensure that a failed rollback resets the transaction depth
+      $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
+    }
+
+    $self->throw_exception($_)
+  };
 }
 
 sub _dbh_rollback {
@@ -1480,7 +1471,9 @@ sub _dbh_execute {
 
   # Can this fail without throwing an exception anyways???
   my $rv = $sth->execute();
-  $self->throw_exception($sth->errstr) if !$rv;
+  $self->throw_exception(
+    $sth->errstr || $sth->err || 'Unknown error: execute() returned false, but error flags were not set...'
+  ) if !$rv;
 
   $self->_query_end( $sql, @$bind );
 
@@ -1527,7 +1520,7 @@ sub insert {
   if ($opts->{returning}) {
     my @ret_cols = @{$opts->{returning}};
 
-    my @ret_vals = eval {
+    my @ret_vals = try {
       local $SIG{__WARN__} = sub {};
       my @r = $sth->fetchrow_array;
       $sth->finish;
@@ -1682,18 +1675,25 @@ sub _execute_array {
     $placeholder_index++;
   }
 
-  my $rv;
-  my $err;
+  my ($rv, $err);
   try {
     $rv = $self->_dbh_execute_array($sth, $tuple_status, @extra);
-  } catch {
+  }
+  catch {
     $err = shift;
+  }
+  finally {
+    # Statement must finish even if there was an exception.
+    try {
+      $sth->finish
+    }
+    catch {
+      $err = shift unless defined $err
+    };
   };
-  $err = defined $err ? $err : ($sth->err ? $sth->errstr : undef );
 
-# Statement must finish even if there was an exception.
-  try { $sth->finish } 
-  catch { $err = shift unless defined $err };
+  $err = $sth->errstr
+    if (! defined $err and $sth->err);
 
   if (defined $err) {
     my $i = 0;
@@ -1709,6 +1709,7 @@ sub _execute_array {
       }),
     );
   }
+
   return $rv;
 }
 
@@ -1721,25 +1722,28 @@ sub _dbh_execute_array {
 sub _dbh_execute_inserts_with_no_binds {
   my ($self, $sth, $count) = @_;
 
-  my $exception;
+  my $err;
   try {
     my $dbh = $self->_get_dbh;
     local $dbh->{RaiseError} = 1;
     local $dbh->{PrintError} = 0;
 
     $sth->execute foreach 1..$count;
-  } catch {
-    $exception = shift;
-  };
-
-# Make sure statement is finished even if there was an exception.
-  try { 
-    $sth->finish 
-  } catch {
-    $exception = shift unless defined $exception;
+  }
+  catch {
+    $err = shift;
+  }
+  finally {
+    # Make sure statement is finished even if there was an exception.
+    try {
+      $sth->finish
+    }
+    catch {
+      $err = shift unless defined $err;
+    };
   };
 
-  $self->throw_exception($exception) if defined $exception;
+  $self->throw_exception($err) if defined $err;
 
   return $count;
 }
@@ -1926,19 +1930,13 @@ sub _select_args {
   }
 
   # adjust limits
-  if (
-    $attrs->{software_limit}
-      ||
-    $sql_maker->_default_limit_syntax eq "GenericSubQ"
-  ) {
-    $attrs->{software_limit} = 1;
-  }
-  else {
+  if (defined $attrs->{rows}) {
     $self->throw_exception("rows attribute must be positive if present")
-      if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
-
+      unless $attrs->{rows} > 0;
+  }
+  elsif (defined $attrs->{offset}) {
     # MySQL actually recommends this approach.  I cringe.
-    $attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
+    $attrs->{rows} = 2**32;
   }
 
   my @limit;
@@ -2143,7 +2141,7 @@ Return the row id of the last insert.
 sub _dbh_last_insert_id {
     my ($self, $dbh, $source, $col) = @_;
 
-    my $id = eval { $dbh->last_insert_id (undef, undef, $source->name, $col) };
+    my $id = try { $dbh->last_insert_id (undef, undef, $source->name, $col) };
 
     return $id if defined $id;
 
@@ -2194,15 +2192,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
-  my $rc = 1;
-  try {
+  return try {
     local $dbh->{PrintError} = 0;
     local $dbh->{RaiseError} = 1;
     $dbh->do('select ?', {}, 1);
-  } catch {
-    $rc = 0;
+    1;
+  }
+  catch {
+    0;
   };
-  return $rc;
 }
 
 # Check if placeholders bound to non-string types throw exceptions
@@ -2211,16 +2209,16 @@ sub _typeless_placeholders_supported {
   my $self = shift;
   my $dbh  = $self->_get_dbh;
 
-  my $rc = 1;
-  try {
+  return 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;
+    1;
+  }
+  catch {
+    0;
   };
-  return $rc;
 }
 
 =head2 sqlt_type
@@ -2542,7 +2540,7 @@ sub deploy {
       # place (even though we will ignore errors)
       $self->dbh_do (sub { $_[1]->do($line) });
     } catch {
-      carp qq{$@ (running "${line}")};
+      carp qq{$_ (running "${line}")};
     };
     $self->_query_end($line);
   };