use warnings;
use base qw/DBIx::Class/;
use Carp::Clan qw/^DBIx::Class/;
+use Try::Tiny;
=head1 NAME
inflate => sub {
my ($value, $obj) = @_;
- my $dt = eval { $obj->_inflate_to_datetime( $value, \%info ) };
- if (my $err = $@ ) {
+ my ($dt, $err);
+ try { $dt = $obj->_inflate_to_datetime( $value, \%info ) }
+ catch {;
return undef if ($undef_if_invalid);
- $self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $err");
- }
+ $self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $_");
+ };
return $obj->_post_inflate_datetime( $dt, \%info );
},
return $genus->species;
};
+ use Try::Tiny;
my $rs;
- eval {
+ try {
$rs = $schema->txn_do($coderef1);
- };
-
- if ($@) { # Transaction failed
+ } catch {
+ # Transaction failed
die "the sky is falling!" #
- if ($@ =~ /Rollback failed/); # Rollback failed
+ if ($_ =~ /Rollback failed/); # Rollback failed
deal_with_failed_transaction();
- }
+ };
Note: by default C<txn_do> will re-run the coderef one more time if an
error occurs due to client disconnection (e.g. the server is bounced).
my $schema = MySchema->connect("dbi:Pg:dbname=my_db");
# Start a transaction. Every database change from here on will only be
- # committed into the database if the eval block succeeds.
- eval {
+ # committed into the database if the try block succeeds.
+ use Try::Tiny;
+ my $exception;
+ try {
$schema->txn_do(sub {
# SQL: BEGIN WORK;
for (1..10) {
# Start a nested transaction, which in fact sets a savepoint.
- eval {
+ try {
$schema->txn_do(sub {
# SQL: SAVEPOINT savepoint_0;
# WHERE ( id = 42 );
}
});
- };
- if ($@) {
+ } catch {
# SQL: ROLLBACK TO SAVEPOINT savepoint_0;
# There was an error while creating a $thing. Depending on the error
# changes related to the creation of this $thing
# Abort the whole job
- if ($@ =~ /horrible_problem/) {
+ if ($_ =~ /horrible_problem/) {
print "something horrible happend, aborting job!";
- die $@; # rethrow error
+ die $_; # rethrow error
}
# Ignore this $thing, report the error, and continue with the
# next $thing
- print "Cannot create thing: $@";
+ print "Cannot create thing: $_";
}
# There was no error, so save all changes since the last
# savepoint.
# SQL: RELEASE SAVEPOINT savepoint_0;
}
});
- };
- if ($@) {
+ } catch {
+ $exception = $_;
+ }
+
+ if ($caught) {
# There was an error while handling the $job. Rollback all changes
# since the transaction started, including the already committed
# ('released') savepoints. There will be neither a new $job nor any
# SQL: ROLLBACK;
- print "ERROR: $@\n";
+ print "ERROR: $exception\n";
}
else {
# There was no error while handling the $job. Commit all changes.
In this example it might be hard to see where the rollbacks, releases and
commits are happening, but it works just the same as for plain L<<txn_do>>: If
-the C<eval>-block around C<txn_do> fails, a rollback is issued. If the C<eval>
+the C<try>-block around C<txn_do> fails, a rollback is issued. If the C<try>
succeeds, the transaction is committed (or the savepoint released).
While you can get more fine-grained control using C<svp_begin>, C<svp_release>
use Scalar::Util ();
use base qw/DBIx::Class/;
+use Try::Tiny;
=head1 NAME
# condition resolution may fail if an incomplete master-object prefetch
# is encountered - that is ok during prefetch construction (not yet in_storage)
- my $cond = eval { $source->_resolve_condition( $rel_info->{cond}, $rel, $self ) };
- if (my $err = $@) {
+ my $cond;
+ try { $cond = $source->_resolve_condition( $rel_info->{cond}, $rel, $self ) }
+ catch {
if ($self->in_storage) {
- $self->throw_exception ($err);
+ $self->throw_exception ($_);
}
else {
$cond = $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION;
}
- }
+ };
if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
my $reverse = $source->reverse_relationship_info($rel);
use strict;
use warnings;
+use Try::Tiny;
our %_pod_inherit_config =
(
# no join condition or just a column name
if (!ref $cond) {
$class->ensure_class_loaded($f_class);
- my %f_primaries = map { $_ => 1 } eval { $f_class->_pri_cols };
- $class->throw_exception(
- "Can't infer join condition for ${rel} on ${class}: $@"
- ) if $@;
+ my %f_primaries = map { $_ => 1 } try { $f_class->_pri_cols }
+ catch {
+ $class->throw_exception( "Can't infer join condition for ${rel} on ${class}: $_");
+ };
my ($pri, $too_many) = keys %f_primaries;
$class->throw_exception(
use strict;
use warnings;
+use Try::Tiny;
our %_pod_inherit_config =
(
unless (ref $cond) {
$class->ensure_class_loaded($f_class);
- my ($pri, $too_many) = eval { $class->_pri_cols };
- $class->throw_exception(
- "Can't infer join condition for ${rel} on ${class}: $@"
- ) if $@;
+ my ($pri, $too_many) = try { $class->_pri_cols }
+ catch {
+ $class->throw_exception("Can't infer join condition for ${rel} on ${class}: $_");
+ };
$class->throw_exception(
"has_many can only infer join for a single primary key; ".
use strict;
use warnings;
use Carp::Clan qw/^DBIx::Class/;
+use Try::Tiny;
our %_pod_inherit_config =
(
sub _get_primary_key {
my ( $class, $target_class ) = @_;
$target_class ||= $class;
- my ($pri, $too_many) = eval { $target_class->_pri_cols };
- $class->throw_exception(
- "Can't infer join condition on ${target_class}: $@"
- ) if $@;
+ my ($pri, $too_many) = try { $target_class->_pri_cols }
+ catch {
+ $class->throw_exception("Can't infer join condition on ${target_class}: $@");
+ };
$class->throw_exception(
"might_have/has_one can only infer join for a single primary key; ".
use DBIx::Class::Exception;
use Carp::Clan qw/^DBIx::Class/;
+use Try::Tiny;
use base qw/DBIx::Class/;
$self->{_columns_info_loaded}++;
my $info = {};
my $lc_info = {};
- # eval for the case of storage without table
- eval { $info = $self->storage->columns_info_for( $self->from ) };
- unless ($@) {
+ # try for the case of storage without table
+ my $caught;
+ try { $info = $self->storage->columns_info_for( $self->from ) }
+ catch { $caught = 1 };
+ unless ($caught) {
for my $realcol ( keys %{$info} ) {
$lc_info->{lc $realcol} = $info->{$realcol};
}
}
return unless $f_source; # Can't test rel without f_source
- eval { $self->_resolve_join($rel, 'me', {}, []) };
-
- if ($@) { # If the resolve failed, back out and re-throw the error
+ try { $self->_resolve_join($rel, 'me', {}, []) }
+ catch {
+ # If the resolve failed, back out and re-throw the error
delete $rels{$rel}; #
$self->_relationships(\%rels);
- $self->throw_exception("Error creating relationship $rel: $@");
- }
+ $self->throw_exception("Error creating relationship $rel: $_");
+ };
1;
}
DBIx::Class::Storage::DBI::ADO;
use base 'DBIx::Class::Storage::DBI';
+use Try::Tiny;
sub _rebless {
my $self = shift;
# 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 $dbtype = eval {
- @{$self->_get_dbh
+ my $caught;
+ my $dbtype;
+ try {
+ $dbtype = @{$self->_get_dbh
->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})
}[2]
+ } catch {
+ $caught = 1;
};
- unless ($@) {
+ unless ($caught) {
$dbtype =~ s/\W/_/gi;
my $subclass = "DBIx::Class::Storage::DBI::ADO::${dbtype}";
if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
use base qw/DBIx::Class::Storage::DBI/;
use mro 'c3';
use List::Util();
+use Try::Tiny;
=head1 NAME
local $dbh->{RaiseError} = 1;
local $dbh->{PrintError} = 0;
- eval {
+ my $rc = 1;
+ try {
$dbh->do('select 1 from rdb$database');
+ } catch {
+ $rc = 0;
};
- return $@ ? 0 : 1;
+ return $rc;
}
# We want dialect 3 for new features and quoting to work, DBD::InterBase uses
use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/;
use mro 'c3';
+use Try::Tiny;
use List::Util();
);
my $dbh = $self->_get_dbh;
- eval { $dbh->do ($sql) };
- if ($@) {
+ try { $dbh->do ($sql) }
+ catch {
$self->throw_exception (sprintf "Error executing '%s': %s",
$sql,
$dbh->errstr,
);
- }
+ };
}
sub _unset_identity_insert {
local $dbh->{RaiseError} = 1;
local $dbh->{PrintError} = 0;
- eval {
+ my $rc = 1;
+ try {
$dbh->do('select 1');
+ } catch {
+ $rc = 0;
};
- return $@ ? 0 : 1;
+ return $rc;
}
package # hide from PAUSE
use base qw/DBIx::Class::Storage::DBI/;
use mro 'c3';
+use Try::Tiny;
sub _rebless {
my ($self) = @_;
- my $dbtype = eval { $self->_get_dbh->get_info(17) };
+ my $caught;
+ my $dbtype;
+ try { $self->_get_dbh->get_info(17) }
+ catch { $caught = 1 };
- unless ( $@ ) {
+ unless ( $caught ) {
# Translate the backend name into a perl identifier
$dbtype =~ s/\W/_/gi;
my $subclass = "DBIx::Class::Storage::DBI::ODBC::${dbtype}";
use List::Util();
use Scalar::Util ();
+use Try::Tiny;
__PACKAGE__->mk_group_accessors(simple => qw/
_using_dynamic_cursors
my $self = shift;
my $dbh = $self->_get_dbh;
- eval {
+ try {
local $dbh->{RaiseError} = 1;
local $dbh->{PrintError} = 0;
$dbh->do('SELECT @@IDENTITY');
- };
- if ($@) {
+ } catch {
$self->throw_exception (<<'EOF');
Your drivers do not seem to support dynamic cursors (odbc_cursortype => 2),
use base qw/DBIx::Class::Storage::DBI/;
use mro 'c3';
+use Try::Tiny;
sub _rebless {
my ($self) = @_;
- my $version = eval { $self->_get_dbh->get_info(18); };
+ my $caught;
+ my $version;
+ try { $self->_get_dbh->get_info(18); }
+ catch { $caught = 1 };
- if ( !$@ ) {
+ if ( ! $caught ) {
my ($major, $minor, $patchlevel) = split(/\./, $version);
# Default driver
use warnings;
use Scope::Guard ();
use Context::Preserve ();
+use Try::Tiny;
=head1 NAME
local $dbh->{RaiseError} = 1;
local $dbh->{PrintError} = 0;
- eval {
+ my $rc = 1;
+ try {
$dbh->do('select 1 from dual');
+ } catch {
+ $rc = 0;
};
- return $@ ? 0 : 1;
+ return $rc;
}
sub _dbh_execute {
RETRY: {
do {
- eval {
+ my $exception;
+ try {
if ($wantarray) {
@res = $self->next::method(@_);
} else {
$res[0] = $self->next::method(@_);
}
+ } catch {
+ $exception = shift;
};
- $exception = $@;
if ($exception =~ /ORA-01003/) {
# ORA-01003: no statement parsed (someone changed the table somehow,
# invalidating your cursor.)
use Scalar::Util 'reftype';
use Hash::Merge;
use List::Util qw/min max reduce/;
+use Try::Tiny;
use namespace::clean -except => 'meta';
my @result;
my $want_array = wantarray;
- eval {
+ my $exception;
+ try {
if($want_array) {
@result = $coderef->(@args);
} elsif(defined $want_array) {
} else {
$coderef->(@args);
}
+ } catch {
+ $self->throw_exception("coderef returned an error: $_");
+ } finally {
+ ##Reset to the original state
+ $self->read_handler($current);
};
- ##Reset to the original state
- $self->read_handler($current);
-
- ##Exception testing has to come last, otherwise you might leave the
- ##read_handler set to master.
-
- if($@) {
- $self->throw_exception("coderef returned an error: $@");
- } else {
- return $want_array ? @result : $result[0];
- }
+ return $want_array ? @result : $result[0];
}
=head2 set_reliable_storage
use Carp::Clan qw/^DBIx::Class/;
use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
+use Try::Tiny;
use namespace::clean -except => 'meta';
sub _safely {
my ($self, $replicant, $name, $code) = @_;
- eval {
+ my $rc = 1;
+ try {
$code->()
- };
- if ($@) {
+ } catch {
$replicant->debugobj->print(sprintf(
"Exception trying to $name for replicant %s, error is %s",
$replicant->_dbi_connect_info->[0], $@)
);
- return undef;
- }
+ $rc = undef;
+ };
- return 1;
+ return $rc;
}
=head2 connected_replicants
use strict;
use warnings;
+use Try::Tiny;
use base qw/DBIx::Class::Storage::DBI/;
sub _rebless {
my $self = shift;
- my $dbtype = eval {
- @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
+ my $dbtype;
+ try {
+ $dbtype = @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
+ } catch {
+ $self->throw_exception("Unable to estable connection to determine database type: $_")
};
- $self->throw_exception("Unable to estable connection to determine database type: $@")
- if $@;
-
if ($dbtype) {
$dbtype =~ s/\W/_/gi;
return $@ ? 0 : $ping;
}
- eval {
+ my $rc = 1;
+ try {
# XXX if the main connection goes stale, does opening another for this statement
# really determine anything?
$dbh->do('select 1');
+ } catch {
+ $rc = 0;
};
- return $@ ? 0 : 1;
+ return $rc;
}
sub _set_max_connect {
use List::Util();
use Sub::Name();
use Data::Dumper::Concise();
+use Try::Tiny;
__PACKAGE__->mk_group_accessors('simple' =>
qw/_identity _blob_log_on_update _writer_storage _is_extra_storage
return 0;
});
- eval {
+ my $exception;
+ try {
my $bulk = $self->_bulk_storage;
my $guard = $bulk->txn_scope_guard;
);
$bulk->_query_end($sql);
+ } catch {
+ $exception = shift;
};
- my $exception = $@;
DBD::Sybase::set_cslib_cb($orig_cslib_cb);
if ($exception =~ /-Y option/) {
use strict;
use warnings;
use Carp::Clan qw/^DBIx::Class/;
+use Try::Tiny;
sub new {
my ($class, $storage) = @_;
carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
unless $exception;
- eval { $storage->txn_rollback };
- my $rollback_exception = $@;
+ my $rollback_exception;
+ try { $storage->txn_rollback }
+ catch { $rollback_exception = shift };
- if ($rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) {
+ if (defined $rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) {
if ($exception) {
$exception = "Transaction aborted: ${exception} "
."Rollback failed: ${rollback_exception}";
projects / dbsrgits/DBIx-Class.git / commitdiff