From: Ton Voon Date: Sat, 15 May 2010 00:38:43 +0000 (+0000) Subject: All expected evals converted to try, except where no test is done, X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ed7ab0f4ce1a9118ea6285ee562ef003085a6b64;p=dbsrgits%2FDBIx-Class-Historic.git All expected evals converted to try, except where no test is done, runtime evaluation, or base perl (such as "require"). Only one test failure due to string difference in output --- diff --git a/lib/DBIx/Class/InflateColumn/DateTime.pm b/lib/DBIx/Class/InflateColumn/DateTime.pm index db899cb..9d8c61b 100644 --- a/lib/DBIx/Class/InflateColumn/DateTime.pm +++ b/lib/DBIx/Class/InflateColumn/DateTime.pm @@ -4,6 +4,7 @@ use strict; use warnings; use base qw/DBIx::Class/; use Carp::Clan qw/^DBIx::Class/; +use Try::Tiny; =head1 NAME @@ -167,11 +168,12 @@ sub register_column { 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 ); }, diff --git a/lib/DBIx/Class/Manual/Cookbook.pod b/lib/DBIx/Class/Manual/Cookbook.pod index e31245f..e5f2559 100644 --- a/lib/DBIx/Class/Manual/Cookbook.pod +++ b/lib/DBIx/Class/Manual/Cookbook.pod @@ -1244,17 +1244,17 @@ example of the recommended way to use it: 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 will re-run the coderef one more time if an error occurs due to client disconnection (e.g. the server is bounced). @@ -1281,8 +1281,10 @@ row. 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; @@ -1292,7 +1294,7 @@ row. for (1..10) { # Start a nested transaction, which in fact sets a savepoint. - eval { + try { $schema->txn_do(sub { # SQL: SAVEPOINT savepoint_0; @@ -1307,8 +1309,7 @@ row. # WHERE ( id = 42 ); } }); - }; - if ($@) { + } catch { # SQL: ROLLBACK TO SAVEPOINT savepoint_0; # There was an error while creating a $thing. Depending on the error @@ -1316,14 +1317,14 @@ row. # 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. @@ -1331,8 +1332,11 @@ row. # 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 @@ -1340,7 +1344,7 @@ row. # SQL: ROLLBACK; - print "ERROR: $@\n"; + print "ERROR: $exception\n"; } else { # There was no error while handling the $job. Commit all changes. @@ -1354,7 +1358,7 @@ row. 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<>: If -the C-block around C fails, a rollback is issued. If the C +the C-block around C fails, a rollback is issued. If the C succeeds, the transaction is committed (or the savepoint released). While you can get more fine-grained control using C, C diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm index 35ae568..e533117 100644 --- a/lib/DBIx/Class/Relationship/Base.pm +++ b/lib/DBIx/Class/Relationship/Base.pm @@ -5,6 +5,7 @@ use warnings; use Scalar::Util (); use base qw/DBIx::Class/; +use Try::Tiny; =head1 NAME @@ -237,15 +238,16 @@ sub related_resultset { # 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); diff --git a/lib/DBIx/Class/Relationship/BelongsTo.pm b/lib/DBIx/Class/Relationship/BelongsTo.pm index 471a417..050c1e4 100644 --- a/lib/DBIx/Class/Relationship/BelongsTo.pm +++ b/lib/DBIx/Class/Relationship/BelongsTo.pm @@ -6,6 +6,7 @@ package # hide from PAUSE use strict; use warnings; +use Try::Tiny; our %_pod_inherit_config = ( @@ -24,10 +25,10 @@ sub belongs_to { # 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( diff --git a/lib/DBIx/Class/Relationship/HasMany.pm b/lib/DBIx/Class/Relationship/HasMany.pm index 7690af8..6063eae 100644 --- a/lib/DBIx/Class/Relationship/HasMany.pm +++ b/lib/DBIx/Class/Relationship/HasMany.pm @@ -3,6 +3,7 @@ package # hide from PAUSE use strict; use warnings; +use Try::Tiny; our %_pod_inherit_config = ( @@ -14,10 +15,10 @@ sub has_many { 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; ". diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm index 33a0641..fd8be7e 100644 --- a/lib/DBIx/Class/Relationship/HasOne.pm +++ b/lib/DBIx/Class/Relationship/HasOne.pm @@ -4,6 +4,7 @@ package # hide from PAUSE use strict; use warnings; use Carp::Clan qw/^DBIx::Class/; +use Try::Tiny; our %_pod_inherit_config = ( @@ -60,10 +61,10 @@ sub _has_one { 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; ". diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 1329fe1..171218b 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -8,6 +8,7 @@ use DBIx::Class::ResultSourceHandle; use DBIx::Class::Exception; use Carp::Clan qw/^DBIx::Class/; +use Try::Tiny; use base qw/DBIx::Class/; @@ -367,9 +368,11 @@ sub column_info { $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}; } @@ -1035,13 +1038,13 @@ sub add_relationship { } 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; } diff --git a/lib/DBIx/Class/Storage/DBI/ADO.pm b/lib/DBIx/Class/Storage/DBI/ADO.pm index e457b96..6523664 100644 --- a/lib/DBIx/Class/Storage/DBI/ADO.pm +++ b/lib/DBIx/Class/Storage/DBI/ADO.pm @@ -2,6 +2,7 @@ package # hide from PAUSE DBIx::Class::Storage::DBI::ADO; use base 'DBIx::Class::Storage::DBI'; +use Try::Tiny; sub _rebless { my $self = shift; @@ -10,13 +11,17 @@ sub _rebless { # 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)) { diff --git a/lib/DBIx/Class/Storage/DBI/InterBase.pm b/lib/DBIx/Class/Storage/DBI/InterBase.pm index a0f934a..db1021a 100644 --- a/lib/DBIx/Class/Storage/DBI/InterBase.pm +++ b/lib/DBIx/Class/Storage/DBI/InterBase.pm @@ -5,6 +5,7 @@ use warnings; use base qw/DBIx::Class::Storage::DBI/; use mro 'c3'; use List::Util(); +use Try::Tiny; =head1 NAME @@ -125,11 +126,14 @@ sub _ping { 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 diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index 515ff9b..5864364 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -5,6 +5,7 @@ use warnings; use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/; use mro 'c3'; +use Try::Tiny; use List::Util(); @@ -23,13 +24,13 @@ sub _set_identity_insert { ); 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 { @@ -240,11 +241,14 @@ sub _ping { 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 diff --git a/lib/DBIx/Class/Storage/DBI/ODBC.pm b/lib/DBIx/Class/Storage/DBI/ODBC.pm index f8e9209..98ca586 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC.pm @@ -4,13 +4,17 @@ use warnings; 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}"; diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm index f8cfdfc..74fed68 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm @@ -7,6 +7,7 @@ use mro 'c3'; use List::Util(); use Scalar::Util (); +use Try::Tiny; __PACKAGE__->mk_group_accessors(simple => qw/ _using_dynamic_cursors @@ -84,12 +85,11 @@ sub _set_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), diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm index 399eb70..cfa9df6 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm @@ -5,13 +5,17 @@ use warnings; 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 diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index c832536..3e74d42 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -4,6 +4,7 @@ use strict; use warnings; use Scope::Guard (); use Context::Preserve (); +use Try::Tiny; =head1 NAME @@ -112,11 +113,14 @@ sub _ping { 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 { @@ -129,14 +133,16 @@ 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.) diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index 930a3be..1024d47 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -16,6 +16,7 @@ use MooseX::Types::Moose qw/ClassName HashRef Object/; use Scalar::Util 'reftype'; use Hash::Merge; use List::Util qw/min max reduce/; +use Try::Tiny; use namespace::clean -except => 'meta'; @@ -650,7 +651,8 @@ sub execute_reliably { my @result; my $want_array = wantarray; - eval { + my $exception; + try { if($want_array) { @result = $coderef->(@args); } elsif(defined $want_array) { @@ -658,19 +660,14 @@ sub execute_reliably { } 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 diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm index db38c42..a625101 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm @@ -8,6 +8,7 @@ use DBI (); 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'; @@ -293,18 +294,18 @@ Returns 1 on success and undef on failure. 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 diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm index 8c5f988..8019569 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -2,6 +2,7 @@ package DBIx::Class::Storage::DBI::Sybase; use strict; use warnings; +use Try::Tiny; use base qw/DBIx::Class::Storage::DBI/; @@ -22,13 +23,13 @@ L 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; @@ -57,13 +58,16 @@ sub _ping { 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 { diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm index 914b75f..0a0295f 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm @@ -13,6 +13,7 @@ use Scalar::Util(); 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 @@ -596,7 +597,8 @@ EOF return 0; }); - eval { + my $exception; + try { my $bulk = $self->_bulk_storage; my $guard = $bulk->txn_scope_guard; @@ -640,9 +642,10 @@ EOF ); $bulk->_query_end($sql); + } catch { + $exception = shift; }; - my $exception = $@; DBD::Sybase::set_cslib_cb($orig_cslib_cb); if ($exception =~ /-Y option/) { diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm index 459931c..2014e1d 100644 --- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm +++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm @@ -3,6 +3,7 @@ package DBIx::Class::Storage::TxnScopeGuard; use strict; use warnings; use Carp::Clan qw/^DBIx::Class/; +use Try::Tiny; sub new { my ($class, $storage) = @_; @@ -31,10 +32,11 @@ sub DESTROY { 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}";