use Data::Dumper::Concise();
use Sub::Name ();
use Try::Tiny;
-
use File::Path ();
__PACKAGE__->mk_group_accessors('simple' =>
my @rdbms_specific_methods = qw/
deployment_statements
sqlt_type
+ sql_maker
build_datetime_parser
datetime_parser_type
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.
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;
$DBI::connect_via = 'connect';
}
- my $caught;
try {
if(ref $info[0] eq 'CODE') {
$dbh = $info[0]->();
$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 {
$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;
}
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 {
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;
$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;
}),
);
}
+
return $rv;
}
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;
}
}
# 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;
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;
# 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
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
# 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);
};