From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 25 May 2010 14:09:39 +0000 (+0000)
Subject: More try::tiny conversions
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9780718f9c36738245f90b1f036998c3b076cffc;p=dbsrgits%2FDBIx-Class-Historic.git

More try::tiny conversions
---

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index 1036b53..f8bb0e4 100644
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -43,14 +43,11 @@ sub MODIFY_CODE_ATTRIBUTES {
 sub _attr_cache {
   my $self = shift;
   my $cache = $self->can('__attr_cache') ? $self->__attr_cache : {};
-  my $rest;
-  my $exception;
-  try {
-    $rest = $self->next::method;
-  } catch {
-    $exception = 1;
+
+  return {
+    %$cache,
+    %{ $self->maybe::next::method || {} },
   };
-  return $exception ? $cache : { %$cache, %$rest };
 }
 
 1;
diff --git a/lib/DBIx/Class/Admin.pm b/lib/DBIx/Class/Admin.pm
index 284f72d..ac47c61 100644
--- a/lib/DBIx/Class/Admin.pm
+++ b/lib/DBIx/Class/Admin.pm
@@ -209,8 +209,8 @@ has config => (
 sub _build_config {
   my ($self) = @_;
 
-  eval { require Config::Any }
-    or die ("Config::Any is required to parse the config file.\n");
+  try { require Config::Any }
+    catch { die ("Config::Any is required to parse the config file.\n") };
 
   my $cfg = Config::Any->load_files ( {files => [$self->config_file], use_ext =>1, flatten_to_hash=>1});
 
diff --git a/lib/DBIx/Class/Exception.pm b/lib/DBIx/Class/Exception.pm
index 2bdfc8d..401bbcd 100644
--- a/lib/DBIx/Class/Exception.pm
+++ b/lib/DBIx/Class/Exception.pm
@@ -3,7 +3,7 @@ package DBIx::Class::Exception;
 use strict;
 use warnings;
 
-use Carp::Clan qw/^DBIx::Class/;
+use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
 use Scalar::Util qw/blessed/;
 use Try::Tiny;
 
diff --git a/lib/DBIx/Class/InflateColumn/DateTime.pm b/lib/DBIx/Class/InflateColumn/DateTime.pm
index 6b01104..609df1e 100644
--- a/lib/DBIx/Class/InflateColumn/DateTime.pm
+++ b/lib/DBIx/Class/InflateColumn/DateTime.pm
@@ -168,17 +168,18 @@ sub register_column {
           inflate => sub {
             my ($value, $obj) = @_;
 
-            my ($dt, $err);
-            try { $dt = $obj->_inflate_to_datetime( $value, \%info ) }
-            catch {
-              $err = 1;
-              if (! $undef_if_invalid) {
-                $self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $_");
-              }
-            };
-            return undef if $err;
-
-            return $obj->_post_inflate_datetime( $dt, \%info );
+            my $dt = try
+              { $obj->_inflate_to_datetime( $value, \%info ) }
+              catch {
+                $self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $_")
+                  unless $undef_if_invalid;
+                undef;  # rv
+              };
+
+            return (defined $dt)
+              ? $obj->_post_inflate_datetime( $dt, \%info )
+              : undef
+            ;
           },
           deflate => sub {
             my ($value, $obj) = @_;
diff --git a/lib/DBIx/Class/Relationship/HasMany.pm b/lib/DBIx/Class/Relationship/HasMany.pm
index 6063eae..d8e651d 100644
--- a/lib/DBIx/Class/Relationship/HasMany.pm
+++ b/lib/DBIx/Class/Relationship/HasMany.pm
@@ -40,7 +40,7 @@ sub has_many {
       $guess = "using our class name '$class' as foreign key";
     }
 
-    my $f_class_loaded = eval { $f_class->columns };
+    my $f_class_loaded = try { $f_class->columns };
     $class->throw_exception(
       "No such column ${f_key} on foreign class ${f_class} ($guess)"
     ) if $f_class_loaded && !$f_class->has_column($f_key);
diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm
index fd8be7e..dddf4e5 100644
--- a/lib/DBIx/Class/Relationship/HasOne.pm
+++ b/lib/DBIx/Class/Relationship/HasOne.pm
@@ -31,7 +31,7 @@ sub _has_one {
       "${class} has none"
     ) if !defined $pri && (!defined $cond || !length $cond);
 
-    my $f_class_loaded = eval { $f_class->columns };
+    my $f_class_loaded = try { $f_class->columns };
     my ($f_key,$too_many,$guess);
     if (defined $cond && length $cond) {
       $f_key = $cond;
@@ -63,7 +63,7 @@ sub _get_primary_key {
   $target_class ||= $class;
   my ($pri, $too_many) = try { $target_class->_pri_cols }
     catch {
-      $class->throw_exception("Can't infer join condition on ${target_class}: $@");
+      $class->throw_exception("Can't infer join condition on ${target_class}: $_");
     };
 
   $class->throw_exception(
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 310e10e..6678a79 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -7,6 +7,7 @@ use base qw/DBIx::Class/;
 
 use DBIx::Class::Exception;
 use Scalar::Util ();
+use Try::Tiny;
 
 ###
 ### Internal method
@@ -862,7 +863,7 @@ sub set_column {
   my ($self, $column, $new_value) = @_;
 
   # if we can't get an ident condition on first try - mark the object as unidentifiable
-  $self->{_orig_ident} ||= (eval { $self->ident_condition }) || {};
+  $self->{_orig_ident} ||= (try { $self->ident_condition }) || {};
 
   my $old_value = $self->get_column($column);
   $new_value = $self->store_column($column, $new_value);
diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index cea821a..c6974c1 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -5,6 +5,7 @@ use warnings;
 
 use DBIx::Class::Exception;
 use Carp::Clan qw/^DBIx::Class/;
+use Try::Tiny;
 use Scalar::Util ();
 use File::Spec;
 use Sub::Name ();
@@ -817,10 +818,14 @@ sub connection {
 
   $storage_class = 'DBIx::Class::Storage'.$storage_class
     if $storage_class =~ m/^::/;
-  eval { $self->ensure_class_loaded ($storage_class) };
-  $self->throw_exception(
-    "No arguments to load_classes and couldn't load ${storage_class} ($@)"
-  ) if $@;
+  try {
+    $self->ensure_class_loaded ($storage_class);
+  }
+  catch {
+    $self->throw_exception(
+      "No arguments to load_classes and couldn't load ${storage_class} ($_)"
+    );
+  };
   my $storage = $storage_class->new($self=>$args);
   $storage->connect_info(\@info);
   $self->storage($storage);
@@ -1400,10 +1405,13 @@ more information.
       unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
 
     my $base = 'DBIx::Class::ResultSetProxy';
-    eval "require ${base};";
-    $self->throw_exception
-      ("No arguments to load_classes and couldn't load ${base} ($@)")
-        if $@;
+    try {
+      eval "require ${base};"
+    }
+    catch {
+      $self->throw_exception
+        ("No arguments to load_classes and couldn't load ${base} ($_)")
+    };
 
     if ($self eq $target) {
       # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm
index 2021cf7..853203b 100644
--- a/lib/DBIx/Class/Schema/Versioned.pm
+++ b/lib/DBIx/Class/Schema/Versioned.pm
@@ -182,6 +182,7 @@ use base 'DBIx::Class::Schema';
 
 use Carp::Clan qw/^DBIx::Class/;
 use Time::HiRes qw/gettimeofday/;
+use Try::Tiny;
 
 __PACKAGE__->mk_classdata('_filedata');
 __PACKAGE__->mk_classdata('upgrade_directory');
@@ -503,7 +504,7 @@ sub get_db_version
     my ($self, $rs) = @_;
 
     my $vtable = $self->{vschema}->resultset('Table');
-    my $version = eval {
+    my $version = try {
       $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
               ->get_column ('version')
                ->next;
diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
index 0e092ee..0575c32 100644
--- a/lib/DBIx/Class/Storage.pm
+++ b/lib/DBIx/Class/Storage.pm
@@ -195,7 +195,7 @@ sub txn_do {
   $self->txn_begin; # If this throws an exception, no rollback is needed
 
   my $wantarray = wantarray; # Need to save this since the context
-                             # inside the eval{} block is independent
+                             # inside the try{} block is independent
                              # of the context that called txn_do()
   try {
 
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 20c1b1a..c103721 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1017,10 +1017,7 @@ sub _server_info {
 
     my %info;
 
-    my $server_version = do {
-      local $@; # might be happenin in some sort of destructor
-      try { $self->_get_server_version };
-    };
+    my $server_version = try { $self->_get_server_version };
 
     if (defined $server_version) {
       $info{dbms_version} = $server_version;
@@ -1528,7 +1525,7 @@ sub insert {
   if ($opts->{returning}) {
     my @ret_cols = @{$opts->{returning}};
 
-    my @ret_vals = eval {
+    my @ret_vals = try {
       local $SIG{__WARN__} = sub {};
       my @r = $sth->fetchrow_array;
       $sth->finish;
@@ -2144,7 +2141,7 @@ Return the row id of the last insert.
 sub _dbh_last_insert_id {
     my ($self, $dbh, $source, $col) = @_;
 
-    my $id = eval { $dbh->last_insert_id (undef, undef, $source->name, $col) };
+    my $id = try { $dbh->last_insert_id (undef, undef, $source->name, $col) };
 
     return $id if defined $id;
 
@@ -2543,7 +2540,7 @@ sub deploy {
       # place (even though we will ignore errors)
       $self->dbh_do (sub { $_[1]->do($line) });
     } catch {
-      carp qq{$@ (running "${line}")};
+      carp qq{$_ (running "${line}")};
     };
     $self->_query_end($line);
   };
diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm
index 875a3cb..ef3ba30 100644
--- a/lib/DBIx/Class/Storage/DBI/Cursor.pm
+++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm
@@ -5,6 +5,8 @@ use warnings;
 
 use base qw/DBIx::Class::Cursor/;
 
+use Try::Tiny;
+
 __PACKAGE__->mk_group_accessors('simple' =>
     qw/sth/
 );
@@ -150,7 +152,7 @@ sub reset {
   my ($self) = @_;
 
   # No need to care about failures here
-  eval { $self->sth->finish if $self->sth && $self->sth->{Active} };
+  try { $self->sth->finish if $self->sth && $self->sth->{Active} };
   $self->_soft_reset;
   return undef;
 }
@@ -176,8 +178,7 @@ sub DESTROY {
   my ($self) = @_;
 
   # None of the reasons this would die matter if we're in DESTROY anyways
-  local $@;
-  eval { $self->sth->finish if $self->sth && $self->sth->{Active} };
+  try { $self->sth->finish if $self->sth && $self->sth->{Active} };
 }
 
 1;
diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
index 5864364..5218070 100644
--- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
@@ -129,7 +129,7 @@ sub _execute {
 
     # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
     # on in _prep_for_execute above
-    my ($identity) = eval { $sth->fetchrow_array };
+    my ($identity) = try { $sth->fetchrow_array };
 
     # SCOPE_IDENTITY failed, but we can do something else
     if ( (! $identity) && $self->_identity_method) {
@@ -216,9 +216,10 @@ sub sql_maker {
         # stored procedures like xp_msver, or version detection failed for some
         # other reason.
         # So, we use a query to check if RNO is implemented.
-        $have_rno = 1 if (eval { local $@; ($self->_get_dbh
-          ->selectrow_array('SELECT row_number() OVER (ORDER BY rand())')
-          )[0] });
+        try {
+          $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
+          $have_rno = 1;
+        };
       }
 
       $self->{_sql_maker_opts} = {
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index 3e74d42..770a3fe 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -40,7 +40,7 @@ sub deployment_statements {
   $sqltargs->{quote_table_names} = $quote_char ? 1 : 0;
   $sqltargs->{quote_field_names} = $quote_char ? 1 : 0;
 
-  my $oracle_version = eval { $self->_get_dbh->get_info(18) };
+  my $oracle_version = try { $self->_get_dbh->get_info(18) };
 
   $sqltargs->{producer_args}{oracle_version} = $oracle_version;
 
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index a625101..a9f3793 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -300,7 +300,7 @@ sub _safely {
   } catch {
     $replicant->debugobj->print(sprintf(
       "Exception trying to $name for replicant %s, error is %s",
-      $replicant->_dbi_connect_info->[0], $@)
+      $replicant->_dbi_connect_info->[0], $_)
     );
     $rc = undef;
   };
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm b/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
index 7cab9a9..a8e2d8a 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
@@ -32,7 +32,7 @@ Add C<DSN: > to debugging output.
 around '_query_start' => sub {
   my ($method, $self, $sql, @bind) = @_;
 
-  my $dsn = eval { $self->dsn } || $self->_dbi_connect_info->[0];
+  my $dsn = (try { $self->dsn }) || $self->_dbi_connect_info->[0];
 
   my($op, $rest) = (($sql=~m/^(\w+)(.+)$/),'NOP', 'NO SQL');
   my $storage_type = $self->can('active') ? 'REPLICANT' : 'MASTER';
@@ -41,7 +41,7 @@ around '_query_start' => sub {
     if ((reftype($dsn)||'') ne 'CODE') {
       "$op [DSN_$storage_type=$dsn]$rest";
     }
-    elsif (my $id = eval { $self->id }) {
+    elsif (my $id = try { $self->id }) {
       "$op [$storage_type=$id]$rest";
     }
     else {
diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
index 16adca4..38a1775 100644
--- a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
@@ -62,8 +62,8 @@ sub insert {
     my $table_name = $source->from;
     $table_name    = $$table_name if ref $table_name;
 
-    my ($identity) = eval {
-      local $@; $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')")
+    my ($identity) = try {
+      $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')")
     };
 
     if (defined $identity) {
@@ -114,8 +114,13 @@ sub _sql_maker_opts {
 sub build_datetime_parser {
   my $self = shift;
   my $type = "DateTime::Format::Strptime";
-  eval "use ${type}";
-  $self->throw_exception("Couldn't load ${type}: $@") if $@;
+  try {
+    eval "use ${type}"
+  }
+  catch {
+    $self->throw_exception("Couldn't load ${type}: $_");
+  };
+
   return $type->new( pattern => '%Y-%m-%d %H:%M:%S.%6N' );
 }
 
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm
index 8019569..3fe0930 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm
@@ -54,8 +54,9 @@ sub _ping {
 
   if ($dbh->{syb_no_child_con}) {
 # if extra connections are not allowed, then ->ping is reliable
-    my $ping = eval { $dbh->ping };
-    return $@ ? 0 : $ping;
+    my $alive;
+    try { $alive = $dbh->ping } catch { $alive = 0 };
+    return $alive;
   }
 
   my $rc = 1;
@@ -114,8 +115,11 @@ back to the C<32768> which is the L<DBD::Sybase> default.
 
 sub set_textsize {
   my $self = shift;
-  my $text_size = shift ||
-    eval { $self->_dbi_connect_info->[-1]->{LongReadLen} } ||
+  my $text_size =
+    shift
+      ||
+    try { $self->_dbi_connect_info->[-1]->{LongReadLen} }
+      ||
     32768; # the DBD::Sybase default
 
   return unless defined $text_size;
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
index 0a0295f..47e0aca 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
@@ -731,9 +731,11 @@ sub _remove_blob_cols_array {
 sub _update_blobs {
   my ($self, $source, $blob_cols, $where) = @_;
 
-  my @primary_cols = eval { $source->_pri_cols };
-  $self->throw_exception("Cannot update TEXT/IMAGE column(s): $@")
-    if $@;
+  my @primary_cols = try
+    { $source->_pri_cols }
+    catch {
+      $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
+    };
 
 # check if we're updating a single row by PK
   my $pk_cols_in_where = 0;
@@ -765,9 +767,11 @@ sub _insert_blobs {
   my $table = $source->name;
 
   my %row = %$row;
-  my @primary_cols = eval { $source->_pri_cols} ;
-  $self->throw_exception("Cannot update TEXT/IMAGE column(s): $@")
-    if $@;
+  my @primary_cols = try
+    { $source->_pri_cols }
+    catch {
+      $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
+    };
 
   $self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values')
     if ((grep { defined $row{$_} } @primary_cols) != @primary_cols);
@@ -782,14 +786,13 @@ sub _insert_blobs {
     my $sth = $cursor->sth;
 
     if (not $sth) {
-
       $self->throw_exception(
           "Could not find row in table '$table' for blob update:\n"
         . Data::Dumper::Concise::Dumper (\%where)
       );
     }
 
-    eval {
+    try {
       do {
         $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
       } while $sth->fetch;
@@ -807,19 +810,20 @@ sub _insert_blobs {
       $sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
 
       $sth->func('ct_finish_send') or die $sth->errstr;
-    };
-    my $exception = $@;
-    $sth->finish if $sth;
-    if ($exception) {
+    }
+    catch {
       if ($self->using_freetds) {
         $self->throw_exception (
-          'TEXT/IMAGE operation failed, probably because you are using FreeTDS: '
-          . $exception
+          "TEXT/IMAGE operation failed, probably because you are using FreeTDS: $_"
         );
-      } else {
-        $self->throw_exception($exception);
+      }
+      else {
+        $self->throw_exception($_);
       }
     }
+    finally {
+      $sth->finish if $sth;
+    };
   }
 }
 
diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm
index 32fe04f..ca25aa2 100644
--- a/lib/SQL/Translator/Parser/DBIx/Class.pm
+++ b/lib/SQL/Translator/Parser/DBIx/Class.pm
@@ -14,8 +14,9 @@ $DEBUG = 0 unless defined $DEBUG;
 
 use Exporter;
 use SQL::Translator::Utils qw(debug normalize_name);
-use Carp::Clan qw/^SQL::Translator|^DBIx::Class/;
+use Carp::Clan qw/^SQL::Translator|^DBIx::Class|^Try::Tiny/;
 use Scalar::Util ();
+use Try::Tiny;
 
 use base qw(Exporter);
 
@@ -43,8 +44,12 @@ sub parse {
 
     croak 'No DBIx::Class::Schema' unless ($dbicschema);
     if (!ref $dbicschema) {
-      eval "use $dbicschema;";
-      croak "Can't load $dbicschema ($@)" if($@);
+      try {
+        eval "require $dbicschema;"
+      }
+      catch {
+        croak "Can't load $dbicschema ($_)";
+      }
     }
 
     my $schema      = $tr->schema;