[Bast-commits] r9380 - in DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class: . InflateColumn Manual Relationship Storage Storage/DBI Storage/DBI/ODBC Storage/DBI/Oracle Storage/DBI/Replicated Storage/DBI/Sybase

tonvoon at dev.catalyst.perl.org tonvoon at dev.catalyst.perl.org
Sat May 15 00:38:43 GMT 2010


Author: tonvoon
Date: 2010-05-15 01:38:43 +0100 (Sat, 15 May 2010)
New Revision: 9380

Modified:
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/InflateColumn/DateTime.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Manual/Cookbook.pod
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/Base.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/BelongsTo.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/HasMany.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/HasOne.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/ResultSource.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ADO.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/InterBase.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/MSSQL.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ODBC.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Oracle.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Replicated.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Sybase.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
   DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/TxnScopeGuard.pm
Log:
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


Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/InflateColumn/DateTime.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/InflateColumn/DateTime.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/InflateColumn/DateTime.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -4,6 +4,7 @@
 use warnings;
 use base qw/DBIx::Class/;
 use Carp::Clan qw/^DBIx::Class/;
+use Try::Tiny;
 
 =head1 NAME
 
@@ -167,11 +168,12 @@
           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 );
           },

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Manual/Cookbook.pod
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Manual/Cookbook.pod	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Manual/Cookbook.pod	2010-05-15 00:38:43 UTC (rev 9380)
@@ -1244,17 +1244,17 @@
     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).
@@ -1281,8 +1281,10 @@
   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 @@
       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 @@
               #      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 @@
           # 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 @@
         # 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 @@
 
     # 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 @@
 
 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>

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/Base.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/Base.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/Base.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -5,6 +5,7 @@
 
 use Scalar::Util ();
 use base qw/DBIx::Class/;
+use Try::Tiny;
 
 =head1 NAME
 
@@ -237,15 +238,16 @@
 
     # 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);

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/BelongsTo.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/BelongsTo.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/BelongsTo.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -6,6 +6,7 @@
 
 use strict;
 use warnings;
+use Try::Tiny;
 
 our %_pod_inherit_config = 
   (
@@ -24,10 +25,10 @@
   # 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(

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/HasMany.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/HasMany.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/HasMany.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -3,6 +3,7 @@
 
 use strict;
 use warnings;
+use Try::Tiny;
 
 our %_pod_inherit_config = 
   (
@@ -14,10 +15,10 @@
 
   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; ".

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/HasOne.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/HasOne.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Relationship/HasOne.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -4,6 +4,7 @@
 use strict;
 use warnings;
 use Carp::Clan qw/^DBIx::Class/;
+use Try::Tiny;
 
 our %_pod_inherit_config = 
   (
@@ -60,10 +61,10 @@
 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; ".

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/ResultSource.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/ResultSource.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -8,6 +8,7 @@
 
 use DBIx::Class::Exception;
 use Carp::Clan qw/^DBIx::Class/;
+use Try::Tiny;
 
 use base qw/DBIx::Class/;
 
@@ -367,9 +368,11 @@
     $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 @@
   }
   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;
 }
 

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ADO.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ADO.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ADO.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -2,6 +2,7 @@
     DBIx::Class::Storage::DBI::ADO;
 
 use base 'DBIx::Class::Storage::DBI';
+use Try::Tiny;
 
 sub _rebless {
   my $self = shift;
@@ -10,13 +11,17 @@
 # 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)) {

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/InterBase.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/InterBase.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/InterBase.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -5,6 +5,7 @@
 use base qw/DBIx::Class::Storage::DBI/;
 use mro 'c3';
 use List::Util();
+use Try::Tiny;
 
 =head1 NAME
 
@@ -125,11 +126,14 @@
   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

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/MSSQL.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/MSSQL.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -5,6 +5,7 @@
 
 use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/;
 use mro 'c3';
+use Try::Tiny;
 
 use List::Util();
 
@@ -23,13 +24,13 @@
   );
 
   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 @@
   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

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -7,6 +7,7 @@
 
 use List::Util();
 use Scalar::Util ();
+use Try::Tiny;
 
 __PACKAGE__->mk_group_accessors(simple => qw/
   _using_dynamic_cursors
@@ -84,12 +85,11 @@
   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),

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ODBC.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ODBC.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/ODBC.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -4,13 +4,17 @@
 
 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}";

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -4,6 +4,7 @@
 use warnings;
 use Scope::Guard ();
 use Context::Preserve ();
+use Try::Tiny;
 
 =head1 NAME
 
@@ -112,11 +113,14 @@
   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 @@
 
   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.)

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Oracle.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Oracle.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Oracle.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -5,13 +5,17 @@
 
 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

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -8,6 +8,7 @@
 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 @@
 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

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Replicated.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Replicated.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Replicated.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -16,6 +16,7 @@
 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 @@
   my @result;
   my $want_array = wantarray;
 
-  eval {
+  my $exception;
+  try {
     if($want_array) {
       @result = $coderef->(@args);
     } elsif(defined $want_array) {
@@ -658,19 +660,14 @@
     } 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

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -13,6 +13,7 @@
 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 @@
       return 0;
   });
 
-  eval {
+  my $exception;
+  try {
     my $bulk = $self->_bulk_storage;
 
     my $guard = $bulk->txn_scope_guard;
@@ -640,9 +642,10 @@
     );
 
     $bulk->_query_end($sql);
+  } catch {
+    $exception = shift;
   };
 
-  my $exception = $@;
   DBD::Sybase::set_cslib_cb($orig_cslib_cb);
 
   if ($exception =~ /-Y option/) {

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Sybase.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/DBI/Sybase.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -2,6 +2,7 @@
 
 use strict;
 use warnings;
+use Try::Tiny;
 
 use base qw/DBIx::Class::Storage::DBI/;
 
@@ -22,13 +23,13 @@
 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 @@
     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 {

Modified: DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/TxnScopeGuard.pm
===================================================================
--- DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/TxnScopeGuard.pm	2010-05-14 23:46:44 UTC (rev 9379)
+++ DBIx-Class/0.08/branches/try-tiny/lib/DBIx/Class/Storage/TxnScopeGuard.pm	2010-05-15 00:38:43 UTC (rev 9380)
@@ -3,6 +3,7 @@
 use strict;
 use warnings;
 use Carp::Clan qw/^DBIx::Class/;
+use Try::Tiny;
 
 sub new {
   my ($class, $storage) = @_;
@@ -31,10 +32,11 @@
     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}";




More information about the Bast-commits mailing list