- ::Storage::DBI now correctly preserves a parent $dbh from
terminating children, even during interpreter-global
out-of-order destruction
+ - All DBIC exception-handling switched to Try::Tiny
- Add DBIx::Class::FilterColumn for non-ref filtering
- InflateColumn::DateTime support for MSSQL via DBD::Sybase
- Millisecond precision support for MSSQL datetimes for
use vars qw($VERSION);
use base qw/DBIx::Class::Componentised Class::Accessor::Grouped/;
use DBIx::Class::StartupCheck;
-use Try::Tiny;
sub mk_classdata {
shift->mk_classaccessor(@_);
# condition resolution may fail if an incomplete master-object prefetch
# is encountered - that is ok during prefetch construction (not yet in_storage)
- my $cond;
- try { $cond = $source->_resolve_condition( $rel_info->{cond}, $rel, $self ) }
+ my $cond = try {
+ $source->_resolve_condition( $rel_info->{cond}, $rel, $self )
+ }
catch {
if ($self->in_storage) {
$self->throw_exception ($_);
}
- else {
- $cond = $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION;
- }
+
+ $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION; # RV
};
if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
$self->{_columns_info_loaded}++;
my $info = {};
my $lc_info = {};
+
# try for the case of storage without table
- my $caught;
- try { $info = $self->storage->columns_info_for( $self->from ) }
- catch { $caught = 1 };
- unless ($caught) {
+ try {
+ $info = $self->storage->columns_info_for( $self->from );
for my $realcol ( keys %{$info} ) {
$lc_info->{lc $realcol} = $info->{$realcol};
}
%{ $info->{$col} || $lc_info->{lc $col} || {} }
};
}
- }
+ };
}
return $self->_columns->{$column};
}
return $self;
- # XXX disabled. doesn't work properly currently. skip in tests.
+# XXX disabled. doesn't work properly currently. skip in tests.
my $f_source = $self->schema->source($f_source_name);
unless ($f_source) {
try { $self->_resolve_join($rel, 'me', {}, []) }
catch {
# If the resolve failed, back out and re-throw the error
- delete $rels{$rel}; #
+ delete $rels{$rel};
$self->_relationships(\%rels);
$self->throw_exception("Error creating relationship $rel: $_");
};
+
1;
}
{
my ($self, $rs) = @_;
- my $c;
- my $exception;
- try {
- $c = $rs->search({ 1, 0 })->count;
- } catch {
- $exception=1;
- };
- return 0 if $exception || !defined $c;
+ my $c = try { $rs->search({ 1, 0 })->count };
- return 1;
+ return (defined $c) ? 1 : 0;
}
1;
$coderef->(@args);
}
$self->txn_commit;
- } catch {
+ }
+ catch {
my $error = shift;
try {
$self->txn_rollback;
} catch {
- my $rollback_error = shift;
my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
$self->throw_exception($error) # propagate nested rollback
- if $rollback_error =~ /$exception_class/;
+ if $_ =~ /$exception_class/;
$self->throw_exception(
- "Transaction aborted: $error. Rollback failed: ${rollback_error}"
+ "Transaction aborted: $error. Rollback failed: $_"
);
}
$self->throw_exception($error); # txn failed but rollback succeeded
- }
+ };
return $wantarray ? @return_values : $return_value;
}
use Data::Dumper::Concise();
use Sub::Name ();
use Try::Tiny;
-
use File::Path ();
__PACKAGE__->mk_group_accessors('simple' =>
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 $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.
$DBI::connect_via = 'connect';
}
- my $exception;
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 {
- $exception = $_;
+ }
+ 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: " . ((defined $exception && $exception) || $DBI::errstr))
- if !$dbh || defined $exception;
-
$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 {
$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;
}
# 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
# XXX This should be using an OpenSchema method of some sort, but I don't know
# how.
# Current version is stolen from Sybase.pm
- my $caught;
- my $dbtype;
try {
- $dbtype = @{$self->_get_dbh
+ my $dbtype = @{$self->_get_dbh
->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})
- }[2]
- } catch {
- $caught = 1;
- };
+ }[2];
- unless ($caught) {
$dbtype =~ s/\W/_/gi;
my $subclass = "DBIx::Class::Storage::DBI::ADO::${dbtype}";
if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
bless $self, $subclass;
$self->_rebless;
}
- }
+ };
}
# Here I was just experimenting with ADO cursor types, left in as a comment in
my ($self) = @_;
# No need to care about failures here
- try { $self->sth->finish if $self->sth && $self->sth->{Active} };
+ try { $self->sth->finish }
+ if $self->sth && $self->sth->{Active};
$self->_soft_reset;
return undef;
}
my ($self) = @_;
# None of the reasons this would die matter if we're in DESTROY anyways
- try { $self->sth->finish if $self->sth && $self->sth->{Active} };
+ try { $self->sth->finish }
+ if $self->sth && $self->sth->{Active};
}
1;
local $dbh->{RaiseError} = 1;
local $dbh->{PrintError} = 0;
- my $rc = 1;
- try {
+ return try {
$dbh->do('select 1 from rdb$database');
+ 1;
} catch {
- $rc = 0;
+ 0;
};
-
- return $rc;
}
# We want dialect 3 for new features and quoting to work, DBD::InterBase uses
local $dbh->{RaiseError} = 1;
local $dbh->{PrintError} = 0;
- my $rc = 1;
- try {
+ return try {
$dbh->do('select 1');
+ 1;
} catch {
- $rc = 0;
+ 0;
};
-
- return $rc;
}
package # hide from PAUSE
use Try::Tiny;
sub _rebless {
- my ($self) = @_;
-
- my $caught;
- my $dbtype;
- try { $self->_get_dbh->get_info(17) }
- catch { $caught = 1 };
-
- unless ( $caught ) {
- # Translate the backend name into a perl identifier
- $dbtype =~ s/\W/_/gi;
- my $subclass = "DBIx::Class::Storage::DBI::ODBC::${dbtype}";
- if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
- bless $self, $subclass;
- $self->_rebless;
- }
+ my ($self) = @_;
+
+ try {
+ my $dbtype = $self->_get_dbh->get_info(17);
+
+ # Translate the backend name into a perl identifier
+ $dbtype =~ s/\W/_/gi;
+ my $subclass = "DBIx::Class::Storage::DBI::ODBC::${dbtype}";
+
+ if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
+ bless $self, $subclass;
+ $self->_rebless;
}
+ };
}
1;
sub _rebless {
my ($self) = @_;
- my $caught;
- my $version;
- try { $self->_get_dbh->get_info(18); }
- catch { $caught = 1 };
-
- if ( ! $caught ) {
- my ($major, $minor, $patchlevel) = split(/\./, $version);
-
- # Default driver
- my $class = $major <= 8
- ? 'DBIx::Class::Storage::DBI::Oracle::WhereJoins'
- : 'DBIx::Class::Storage::DBI::Oracle::Generic';
-
- $self->ensure_class_loaded ($class);
- bless $self, $class;
- }
+ try {
+ my $version = $self->_get_dbh->get_info(18);
+
+ my ($major, $minor, $patchlevel) = split(/\./, $version);
+
+ # Default driver
+ my $class = $major <= 8
+ ? 'DBIx::Class::Storage::DBI::Oracle::WhereJoins'
+ : 'DBIx::Class::Storage::DBI::Oracle::Generic';
+
+ $self->ensure_class_loaded ($class);
+ bless $self, $class;
+ };
}
1;
local $dbh->{RaiseError} = 1;
local $dbh->{PrintError} = 0;
- my $rc = 1;
- try {
+ return try {
$dbh->do('select 1 from dual');
+ 1;
} catch {
- $rc = 0;
+ 0;
};
-
- return $rc;
}
sub _dbh_execute {
my $self = shift;
my ($dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
- my $wantarray = wantarray;
-
- my (@res, $exception, $retried);
-
- RETRY: {
- do {
- my $exception;
- try {
- if ($wantarray) {
- @res = $self->next::method(@_);
- } else {
- $res[0] = $self->next::method(@_);
- }
- } catch {
- $exception = shift;
- };
- if ($exception =~ /ORA-01003/) {
+ my $retried;
+ do {
+ try {
+ return $self->next::method($dbh, $op, $extra_bind, $ident, $bind_attributes, @args);
+ }
+ catch {
+ if (!$retried and $_ =~ /ORA-01003/) {
# ORA-01003: no statement parsed (someone changed the table somehow,
# invalidating your cursor.)
my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
delete $dbh->{CachedKids}{$sql};
- } else {
- last RETRY;
}
- } while (not $retried++);
- }
-
- $self->throw_exception($exception) if $exception;
-
- $wantarray ? @res : $res[0]
+ else {
+ $self->throw_exception($_);
+ }
+ };
+ } while (not $retried++);
}
=head2 get_autoinc_seq
my @result;
my $want_array = wantarray;
- my $exception;
try {
if($want_array) {
@result = $coderef->(@args);
sub _safely {
my ($self, $replicant, $name, $code) = @_;
- my $rc = 1;
- try {
- $code->()
+ return try {
+ $code->();
+ 1;
} catch {
$replicant->debugobj->print(sprintf(
"Exception trying to $name for replicant %s, error is %s",
$replicant->_dbi_connect_info->[0], $_)
);
- $rc = undef;
+ undef;
};
-
- return $rc;
}
=head2 connected_replicants
requires qw/_query_start/;
use namespace::clean -except => 'meta';
+use Try::Tiny;
=head1 NAME
use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/;
use mro 'c3';
use List::Util ();
+use Try::Tiny;
__PACKAGE__->mk_group_accessors(simple => qw/
_identity
my $self = shift;
my $type = "DateTime::Format::Strptime";
try {
- eval "use ${type}"
+ eval "require ${type}"
}
catch {
$self->throw_exception("Couldn't load ${type}: $_");
if ($dbh->{syb_no_child_con}) {
# if extra connections are not allowed, then ->ping is reliable
- my $alive;
- try { $alive = $dbh->ping } catch { $alive = 0 };
- return $alive;
+ return try { $dbh->ping } catch { 0; };
}
- my $rc = 1;
- try {
+ return try {
# XXX if the main connection goes stale, does opening another for this statement
# really determine anything?
$dbh->do('select 1');
+ 1;
} catch {
- $rc = 0;
+ 0;
};
-
- return $rc;
}
sub _set_max_connect {
projects / dbsrgits/DBIx-Class.git / commitdiff