my @rdbms_specific_methods = qw/
deployment_statements
sqlt_type
+ sql_maker
build_datetime_parser
datetime_parser_type
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;
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/;
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;
+ my $exception;
try {
if(ref $info[0] eq 'CODE') {
$dbh = $info[0]->();
$dbh->{PrintError} = 0;
}
} catch {
- $caught = 1;
+ $exception = $_;
};
$DBI::connect_via = $old_connect_via if $old_connect_via;
- $self->throw_exception("DBI Connection failed: " . ($@||$DBI::errstr))
- if !$dbh || $caught;
+ $self->throw_exception("DBI Connection failed: " . ((defined $exception && $exception) || $DBI::errstr))
+ if !$dbh || defined $exception;
$self->_dbh_autocommit($dbh->{AutoCommit});
sub txn_rollback {
my $self = shift;
my $dbh = $self->_dbh;
- eval {
+ try {
if ($self->{transaction_depth} == 1) {
$self->debugobj->txn_rollback()
if ($self->debug);
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
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 = 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];
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;
}
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();
$result{$col_name} = \%column_info;
}
+ } catch {
+ $caught = 1;
};
- return \%result if !$@ && scalar keys %result;
+ return \%result if !$caught && scalar keys %result;
}
my %result;
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
- 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
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
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) });
+ } catch {
+ carp qq{$_ (running "${line}")};
};
- if ($@) {
- carp qq{$@ (running "${line}")};
- }
$self->_query_end($line);
};
my @statements = $schema->deployment_statements($type, undef, $dir, { %{ $sqltargs || {} }, no_comments => 1 } );