my ($self, $rs) = @_;
my $vtable = $self->{vschema}->resultset('Table');
- my $version = eval {
- $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
+ my $version;
+ try {
+ $version = $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
->get_column ('version')
->next;
};
sub connection {
my $self = shift;
$self->next::method(@_);
- $self->_on_connect($_[3]);
+ $self->_on_connect();
return $self;
}
sub _on_connect
{
- my ($self, $args) = @_;
+ my ($self) = @_;
- $args = {} unless $args;
+ my $info = $self->storage->connect_info;
+ my $args = $info->[-1];
- $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
+ $self->{vschema} = DBIx::Class::Version->connect(@$info);
my $vtable = $self->{vschema}->resultset('Table');
# useful when connecting from scripts etc
return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
# check for legacy versions table and move to new if exists
- my $vschema_compat = DBIx::Class::VersionCompat->connect(@{$self->storage->connect_info()});
+ my $vschema_compat = DBIx::Class::VersionCompat->connect(@$info);
unless ($self->_source_exists($vtable)) {
my $vtable_compat = $vschema_compat->resultset('TableCompat');
if ($self->_source_exists($vtable_compat)) {
{
my ($self, $rs) = @_;
- my $c = eval {
- $rs->search({ 1, 0 })->count;
+ my $c;
+ my $exception;
+ try {
+ $c = $rs->search({ 1, 0 })->count;
+ } catch {
+ $exception=1;
};
- return 0 if $@ || !defined $c;
+ return 0 if $exception || !defined $c;
return 1;
}
use List::Util();
use Data::Dumper::Concise();
use Sub::Name ();
+use Try::Tiny;
use File::Path ();
my @rdbms_specific_methods = qw/
deployment_statements
sqlt_type
+ sql_maker
build_datetime_parser
datetime_parser_type
# some databases need this to stop spewing warnings
if (my $dbh = $self->_dbh) {
- local $@;
- eval {
+ try {
%{ $dbh->{CachedKids} } = ();
$dbh->disconnect;
};
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 $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) {
$DBI::connect_via = 'connect';
}
- eval {
+ my $caught;
+ try {
if(ref $info[0] eq 'CODE') {
$dbh = $info[0]->();
}
$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});
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
$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;
# 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) });
- };
- if ($@) {
+ } catch {
carp qq{$@ (running "${line}")};
- }
+ };
$self->_query_end($line);
};
my @statements = $schema->deployment_statements($type, undef, $dir, { %{ $sqltargs || {} }, no_comments => 1 } );
projects / dbsrgits/DBIx-Class.git / commitdiff