From: Peter Rabbitson Date: Mon, 5 Sep 2016 12:27:24 +0000 (+0200) Subject: Remove use of Try::Tiny entirely (the missing part of ddcc02d1) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e2741c7fd695dca054614f297b01d351a45bbf38;p=dbsrgits%2FDBIx-Class.git Remove use of Try::Tiny entirely (the missing part of ddcc02d1) While at the time it seemed expedient to keep relying on Try::Tiny::catch and only replace Try::Tiny::try internally, it turns out that the current naming behavior of T::T [1] means we can not get DBIC::Carp to report a friendly callsite, as finding which catch{} frames are skippable becomes problematic. Additionally this drops a flurry of runtime Sub::Name calls which in turn is likely to take less time ( note - this has not been explicitly timed, but seems to pop up often in profiles: https://youtu.be/PYCbumw0Fis?t=1919 ) In any case - one less dep that we do not really use is always a win Despite the large changeset there should be zero functional changes This essentially reverts the entirety of 9b58d129 Read under -w [1] https://metacpan.org/diff/file?source=DOY/Try-Tiny-0.14&target=DOY/Try-Tiny-0.15#lib/Try/Tiny.pm --- diff --git a/Makefile.PL b/Makefile.PL index df82cb7..7aab0d5 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -58,7 +58,6 @@ my $runtime_requires = { 'namespace::clean' => '0.24', 'Scope::Guard' => '0.03', 'SQL::Abstract' => '1.81', - 'Try::Tiny' => '0.07', # Technically this is not a core dependency - it is only required # by the MySQL codepath. However this particular version is bundled diff --git a/lib/DBIx/Class/InflateColumn/DateTime.pm b/lib/DBIx/Class/InflateColumn/DateTime.pm index b284a64..3291668 100644 --- a/lib/DBIx/Class/InflateColumn/DateTime.pm +++ b/lib/DBIx/Class/InflateColumn/DateTime.pm @@ -4,8 +4,7 @@ use strict; use warnings; use base qw/DBIx::Class/; use DBIx::Class::Carp; -use DBIx::Class::_Util 'dbic_internal_try'; -use Try::Tiny; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); use namespace::clean; =head1 NAME @@ -216,12 +215,13 @@ sub _flate_or_fallback my $preferred_method = sprintf($method_fmt, $info->{ _ic_dt_method }); my $method = $parser->can($preferred_method) || sprintf($method_fmt, 'datetime'); - return dbic_internal_try { + dbic_internal_try { $parser->$method($value); } - catch { + dbic_internal_catch { $self->throw_exception ("Error while inflating '$value' for $info->{__dbic_colname} on ${self}: $_") unless $info->{datetime_undef_if_invalid}; + undef; # rv }; } diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm index 007676e..8e4b280 100644 --- a/lib/DBIx/Class/Relationship/Base.pm +++ b/lib/DBIx/Class/Relationship/Base.pm @@ -6,7 +6,6 @@ use warnings; use base qw/DBIx::Class/; use Scalar::Util qw/weaken blessed/; -use Try::Tiny; use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION fail_on_internal_call ); use namespace::clean; diff --git a/lib/DBIx/Class/Relationship/BelongsTo.pm b/lib/DBIx/Class/Relationship/BelongsTo.pm index 50ddc2e..0a0f0db 100644 --- a/lib/DBIx/Class/Relationship/BelongsTo.pm +++ b/lib/DBIx/Class/Relationship/BelongsTo.pm @@ -6,8 +6,7 @@ package # hide from PAUSE use strict; use warnings; -use Try::Tiny; -use DBIx::Class::_Util 'dbic_internal_try'; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); use namespace::clean; our %_pod_inherit_config = @@ -45,7 +44,7 @@ sub belongs_to { my $f_rsrc = dbic_internal_try { $f_class->result_source; } - catch { + dbic_internal_catch { $class->throw_exception( "Foreign class '$f_class' does not seem to be a Result class " . "(or it simply did not load entirely due to a circular relation chain): $_" diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm index 8f74bb8..2894aa0 100644 --- a/lib/DBIx/Class/Relationship/HasOne.pm +++ b/lib/DBIx/Class/Relationship/HasOne.pm @@ -4,8 +4,7 @@ package # hide from PAUSE use strict; use warnings; use DBIx::Class::Carp; -use Try::Tiny; -use DBIx::Class::_Util 'dbic_internal_try'; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); use namespace::clean; our %_pod_inherit_config = @@ -41,7 +40,7 @@ sub _has_one { unless $r->columns; $r; } - catch { + dbic_internal_catch { $class->throw_exception( "Foreign class '$f_class' does not seem to be a Result class " . "(or it simply did not load entirely due to a circular relation chain)" diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 7ab7a72..4338392 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -10,11 +10,10 @@ use DBIx::Class::ResultSetColumn; use DBIx::Class::ResultClass::HashRefInflator; use Scalar::Util qw( blessed reftype ); use DBIx::Class::_Util qw( - dbic_internal_try dump_value + dbic_internal_try dbic_internal_catch dump_value fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION ); use DBIx::Class::SQLMaker::Util qw( normalize_sqla_condition extract_equality_conditions ); -use Try::Tiny; BEGIN { # De-duplication in _merge_attr() is disabled, but left in for reference @@ -884,7 +883,7 @@ sub find { $alias ); } - catch { + dbic_internal_catch { push @fc_exceptions, $_ if $_ =~ /\bFilterColumn\b/; }; } diff --git a/lib/DBIx/Class/ResultSource/RowParser.pm b/lib/DBIx/Class/ResultSource/RowParser.pm index 676a548..6fe946f 100644 --- a/lib/DBIx/Class/ResultSource/RowParser.pm +++ b/lib/DBIx/Class/ResultSource/RowParser.pm @@ -6,8 +6,6 @@ use warnings; use base 'DBIx::Class'; -use Try::Tiny; - use DBIx::Class::ResultSource::RowParser::Util qw( assemble_simple_parser assemble_collapsing_parser diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 5987f75..1bf1965 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -6,11 +6,10 @@ use warnings; use base 'DBIx::Class'; use DBIx::Class::Carp; -use Try::Tiny; use Scalar::Util qw( weaken blessed refaddr ); use DBIx::Class::_Util qw( refdesc refcount quote_sub scope_guard - is_exception dbic_internal_try + is_exception dbic_internal_try dbic_internal_catch fail_on_internal_call emit_loud_diag ); use Devel::GlobalDestruction; @@ -205,7 +204,7 @@ sub _ns_get_rsrc_instance { return dbic_internal_try { $rs_class->result_source - } catch { + } dbic_internal_catch { $me->throw_exception ( "Attempt to load_namespaces() class $rs_class failed - are you sure this is a real Result Class?: $_" ); @@ -914,7 +913,7 @@ sub connection { dbic_internal_try { $self->ensure_class_loaded ($storage_class); } - catch { + dbic_internal_catch { $self->throw_exception( "Unable to load storage class ${storage_class}: $_" ); @@ -1209,7 +1208,7 @@ This guard was activated starting", 1; } - catch { + dbic_internal_catch { # We call this to get the necessary warnings emitted and disregard the RV # as it's definitely an exception if we got as far as this catch{} block is_exception( @@ -1674,7 +1673,7 @@ sub compose_connection { dbic_internal_try { require DBIx::Class::ResultSetProxy; } - catch { + dbic_internal_catch { $self->throw_exception ("No arguments to load_classes and couldn't load DBIx::Class::ResultSetProxy ($_)") }; diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm index acae96a..dfff9a1 100644 --- a/lib/DBIx/Class/Storage.pm +++ b/lib/DBIx/Class/Storage.pm @@ -16,8 +16,7 @@ use DBIx::Class::Carp; use DBIx::Class::Storage::BlockRunner; use Scalar::Util qw/blessed weaken/; use DBIx::Class::Storage::TxnScopeGuard; -use DBIx::Class::_Util qw( dbic_internal_try fail_on_internal_call ); -use Try::Tiny; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch fail_on_internal_call ); use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/debug schema transaction_depth auto_savepoint savepoints/); @@ -152,7 +151,7 @@ For example, my $rs; try { $rs = $schema->txn_do($coderef); - } catch { + } dbic_internal_catch { my $error = shift; # Transaction failed die "something terrible has happened!" @@ -320,7 +319,7 @@ sub __delicate_rollback { dbic_internal_try { $self->txn_rollback; 1 } - catch { + dbic_internal_catch { $rbe = $_; @@ -590,7 +589,7 @@ sub debugobj { my $cfg = dbic_internal_try { Config::Any->load_files({ files => [$profile], use_ext => 1 }); - } catch { + } dbic_internal_catch { # sanitize the error message a bit $_ =~ s/at \s+ .+ Storage\.pm \s line \s \d+ $//x; $self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_"); @@ -616,7 +615,7 @@ sub debugobj { # a better fix. This is another yak to shave... :( dbic_internal_try { DBIx::Class::Storage::Debug::PrettyPrint->new(@pp_args); - } catch { + } dbic_internal_catch { $self->throw_exception($_); } } diff --git a/lib/DBIx/Class/Storage/BlockRunner.pm b/lib/DBIx/Class/Storage/BlockRunner.pm index 63f5be3..64d5164 100644 --- a/lib/DBIx/Class/Storage/BlockRunner.pm +++ b/lib/DBIx/Class/Storage/BlockRunner.pm @@ -6,9 +6,8 @@ use strict; use DBIx::Class::Carp; use Context::Preserve 'preserve_context'; -use DBIx::Class::_Util qw( is_exception qsub dbic_internal_try ); +use DBIx::Class::_Util qw( is_exception qsub dbic_internal_try dbic_internal_catch ); use Scalar::Util qw(weaken blessed reftype); -use Try::Tiny; use Moo; use namespace::clean; @@ -127,7 +126,7 @@ sub _run { $txn_begin_ok = 1; } $cref->( @$args ); - } catch { + } dbic_internal_catch { $run_err = $_; (); # important, affects @_ below }; @@ -159,7 +158,7 @@ sub _run { $storage->txn_commit; 1; } - catch { + dbic_internal_catch { $run_err = $_; }; } diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 1a9d792..4a91bb4 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -10,11 +10,10 @@ use mro 'c3'; use DBIx::Class::Carp; use Scalar::Util qw/refaddr weaken reftype blessed/; use Context::Preserve 'preserve_context'; -use Try::Tiny; use SQL::Abstract qw(is_plain_value is_literal_value); use DBIx::Class::_Util qw( quote_sub perlstring serialize dump_value - dbic_internal_try + dbic_internal_try dbic_internal_catch detected_reinvoked_destructor scope_guard mkdir_p ); @@ -1174,7 +1173,7 @@ sub _server_info { my $server_version = dbic_internal_try { $self->_get_server_version - } catch { + } dbic_internal_catch { # driver determination *may* use this codepath # in which case we must rethrow $self->throw_exception($_) if $self->{_in_determine_driver}; @@ -1469,7 +1468,7 @@ sub _do_connection_actions { $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) ); } } - catch { + dbic_internal_catch { if ( $method_prefix =~ /^connect/ ) { # this is an on_connect cycle - we can't just throw while leaving # a handle in an undefined state in our storage object @@ -1619,7 +1618,7 @@ sub _connect { $dbh_error_handler_installer->($self, $dbh); } } - catch { + dbic_internal_catch { $self->throw_exception("DBI Connection failed: $_") }; @@ -2104,7 +2103,7 @@ sub insert { @ir_container = $sth->fetchrow_array; $sth->finish; - } catch { + } dbic_internal_catch { # Evict the $sth from the cache in case we got here, since the finish() # is crucial, at least on older Firebirds, possibly on other engines too # @@ -2446,7 +2445,7 @@ sub _dbh_execute_for_fetch { $tuple_status, ); } - catch { + dbic_internal_catch { $err = shift; }; @@ -2462,7 +2461,7 @@ sub _dbh_execute_for_fetch { dbic_internal_try { $sth->finish } - catch { + dbic_internal_catch { $err = shift unless defined $err }; @@ -2493,7 +2492,7 @@ sub _dbh_execute_inserts_with_no_binds { $sth->execute foreach 1..$count; } - catch { + dbic_internal_catch { $err = shift; }; @@ -2501,7 +2500,7 @@ sub _dbh_execute_inserts_with_no_binds { dbic_internal_try { $sth->finish } - catch { + dbic_internal_catch { $err = shift unless defined $err; }; @@ -2729,7 +2728,7 @@ sub _dbh_columns_info_for { $result{$col_name} = \%column_info; } - } catch { + } dbic_internal_catch { %result = (); }; @@ -3235,7 +3234,7 @@ sub deploy { # do a dbh_do cycle here, as we need some error checking in # place (even though we will ignore errors) $self->dbh_do (sub { $_[1]->do($line) }); - } catch { + } dbic_internal_catch { carp qq{$_ (running "${line}")}; }; $self->_query_end($line); diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index f07adfd..9a49a42 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -9,8 +9,7 @@ use base qw/ /; use mro 'c3'; -use Try::Tiny; -use DBIx::Class::_Util qw( dbic_internal_try sigwarn_silencer ); +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch sigwarn_silencer ); use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/ @@ -182,7 +181,7 @@ sub _ping { $dbh->do('select 1'); 1; } - catch { + dbic_internal_catch { # MSSQL is *really* annoying wrt multiple active resultsets, # and this may very well be the reason why the _ping failed # diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Firebird.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Firebird.pm index 91f7292..1d549e8 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Firebird.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Firebird.pm @@ -7,8 +7,7 @@ use base qw/ DBIx::Class::Storage::DBI::Firebird::Common /; use mro 'c3'; -use Try::Tiny; -use DBIx::Class::_Util 'dbic_internal_try'; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); use namespace::clean; =head1 NAME @@ -52,7 +51,7 @@ sub _exec_svp_rollback { dbic_internal_try { $self->_dbh->do("ROLLBACK TO SAVEPOINT $name") } - catch { + dbic_internal_catch { # Firebird ODBC driver bug, ignore if (not /Unable to fetch information about the error/) { $self->throw_exception($_); 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 4ee00eb..8e25644 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm @@ -8,8 +8,7 @@ use base qw/ /; use mro 'c3'; use Scalar::Util 'reftype'; -use Try::Tiny; -use DBIx::Class::_Util 'dbic_internal_try'; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); use DBIx::Class::Carp; use namespace::clean; @@ -233,7 +232,8 @@ sub _run_connection_actions { local $dbh->{RaiseError} = 1; local $dbh->{PrintError} = 0; $dbh->do('SELECT @@IDENTITY'); - } catch { + } + dbic_internal_catch { $self->throw_exception ( 'Your drivers do not seem to support dynamic cursors (odbc_cursortype => 2).' . ( diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index 6a2f7ad..48642ec 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -20,8 +20,6 @@ use Scalar::Util 'reftype'; use Hash::Merge; use List::Util qw( min max ); use Context::Preserve 'preserve_context'; -use Try::Tiny; -use DBIx::Class::_Util 'dbic_internal_try'; use namespace::clean -except => 'meta'; diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm index ed66b28..cea3788 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm @@ -6,8 +6,7 @@ use Scalar::Util 'reftype'; use DBI (); use MooseX::Types::Moose qw/Num Int ClassName HashRef/; use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI'; -use DBIx::Class::_Util 'dbic_internal_try'; -use Try::Tiny; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); use namespace::clean -except => 'meta'; @@ -293,14 +292,17 @@ Returns 1 on success and undef on failure. sub _safely { my ($self, $replicant, $name, $code) = @_; - return dbic_internal_try { + dbic_internal_try { $code->(); 1; - } catch { + } + dbic_internal_catch { $replicant->debugobj->print(sprintf( "Exception trying to $name for replicant %s, error is %s", $replicant->_dbi_connect_info->[0], $_) ); + + # rv undef; }; } diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm index 57687ad..e9bc102 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm @@ -4,9 +4,6 @@ use strict; use warnings; use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/; use mro 'c3'; -use DBIx::Class::_Util 'dbic_internal_try'; -use Try::Tiny; -use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/_identity/); __PACKAGE__->sql_limit_dialect ('RowNumberOver'); @@ -135,18 +132,11 @@ sub select_single { return @row; } -# this sub stolen from MSSQL - sub build_datetime_parser { - my $self = shift; - dbic_internal_try { - require DateTime::Format::Strptime; - } - catch { - $self->throw_exception("Couldn't load DateTime::Format::Strptime: $_"); - }; - return DateTime::Format::Strptime->new( pattern => '%Y-%m-%d %H:%M:%S.%6N' ); + require DateTime::Format::Strptime; + + DateTime::Format::Strptime->new( pattern => '%Y-%m-%d %H:%M:%S.%6N' ); } =head2 connect_call_datetime_setup diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm index 28cadaa..714b107 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLite.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm @@ -7,9 +7,11 @@ use base qw/DBIx::Class::Storage::DBI/; use mro 'c3'; use SQL::Abstract 'is_plain_value'; -use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer dbic_internal_try); +use DBIx::Class::_Util qw( + modver_gt_or_eq sigwarn_silencer + dbic_internal_try dbic_internal_catch +); use DBIx::Class::Carp; -use Try::Tiny; use namespace::clean; __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::SQLite'); @@ -181,7 +183,7 @@ sub _ping { $really_not_in_txn = 1; } - catch { + dbic_internal_catch { $really_not_in_txn = ( $_[0] =~ qr/transaction within a transaction/ ? 0 : undef diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm index 9f2b84a..a714268 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -2,8 +2,7 @@ package DBIx::Class::Storage::DBI::Sybase; use strict; use warnings; -use DBIx::Class::_Util 'dbic_internal_try'; -use Try::Tiny; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); use namespace::clean; use base qw/DBIx::Class::Storage::DBI/; @@ -38,7 +37,8 @@ sub _get_rdbms_name { } $name; # RV - } catch { + } + dbic_internal_catch { $self->throw_exception("Unable to establish connection to determine database type: $_") }; } diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm index 5282b7f..fde0b73 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm @@ -11,9 +11,11 @@ use base qw/ use mro 'c3'; use DBIx::Class::Carp; use Scalar::Util qw/blessed weaken/; -use Try::Tiny; use Context::Preserve 'preserve_context'; -use DBIx::Class::_Util qw( sigwarn_silencer dbic_internal_try dump_value scope_guard set_subname ); +use DBIx::Class::_Util qw( + sigwarn_silencer dbic_internal_try dbic_internal_catch + dump_value scope_guard set_subname +); use namespace::clean; __PACKAGE__->sql_limit_dialect ('GenericSubQ'); @@ -653,8 +655,9 @@ sub _insert_bulk { $guard->commit; $bulk->_query_end($sql); - } catch { - $exception = shift; + } + dbic_internal_catch { + $exception = $_; }; DBD::Sybase::set_cslib_cb($orig_cslib_cb); @@ -731,11 +734,14 @@ sub _remove_blob_cols_array { sub _update_blobs { my ($self, $source, $blob_cols, $where) = @_; - my @primary_cols = dbic_internal_try - { $source->_pri_cols_or_die } - catch { + my @primary_cols = + dbic_internal_try { + $source->_pri_cols_or_die + } + dbic_internal_catch { $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_") - }; + } + ; my @pks_to_update; if ( @@ -766,7 +772,7 @@ sub _insert_blobs { my @primary_cols = dbic_internal_try { $source->_pri_cols_or_die } - catch { + dbic_internal_catch { $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_") }; @@ -819,7 +825,7 @@ sub _insert_blobs { $sth->func('ct_finish_send') or die $sth->errstr; } - catch { + dbic_internal_catch { if ($self->_using_freetds) { $self->throw_exception ( "TEXT/IMAGE operation failed, probably because you are using FreeTDS: $_" diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 7d26850..b8f0b06 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -202,7 +202,7 @@ our @EXPORT_OK = qw( refdesc refcount hrefaddr set_subname get_subname describe_class_methods scope_guard detected_reinvoked_destructor emit_loud_diag true false - is_exception dbic_internal_try visit_namespaces + is_exception dbic_internal_try dbic_internal_catch visit_namespaces quote_sub qsub perlstring serialize deep_clone dump_value uniq parent_dir mkdir_p UNRESOLVABLE_CONDITION @@ -608,10 +608,10 @@ sub is_exception ($) { { my $callstack_state; - # Recreate the logic of try(), while reusing the catch()/finally() as-is - # - # FIXME: We need to move away from Try::Tiny entirely (way too heavy and - # yes, shows up ON TOP of profiles) but this is a batle for another maint + # Recreate the logic of Try::Tiny, but without the crazy Sub::Name + # invocations and without support for finally() altogether + # ( yes, these days Try::Tiny is so "tiny" it shows *ON TOP* of most + # random profiles https://youtu.be/PYCbumw0Fis?t=1919 ) sub dbic_internal_try (&;@) { my $try_cref = shift; @@ -619,30 +619,30 @@ sub is_exception ($) { for my $arg (@_) { - if( ref($arg) eq 'Try::Tiny::Catch' ) { + croak 'dbic_internal_try() may not be followed by multiple dbic_internal_catch() blocks' + if $catch_cref; - croak 'dbic_internal_try() may not be followed by multiple catch() blocks' - if $catch_cref; + ($catch_cref = $$arg), next + if ref($arg) eq 'DBIx::Class::_Util::Catch'; - $catch_cref = $$arg; - } - elsif ( ref($arg) eq 'Try::Tiny::Finally' ) { - croak 'dbic_internal_try() does not support finally{}'; - } - else { - croak( - 'dbic_internal_try() encountered an unexpected argument ' - . "'@{[ defined $arg ? $arg : 'UNDEF' ]}' - perhaps " - . 'a missing semi-colon before or ' # trailing space important - ); - } + croak( 'Mixing dbic_internal_try() with Try::Tiny::catch() is not supported' ) + if ref($arg) eq 'Try::Tiny::Catch'; + + croak( 'dbic_internal_try() does not support finally{}' ) + if ref($arg) eq 'Try::Tiny::Finally'; + + croak( + 'dbic_internal_try() encountered an unexpected argument ' + . "'@{[ defined $arg ? $arg : 'UNDEF' ]}' - perhaps " + . 'a missing semi-colon before or ' # trailing space important + ); } my $wantarray = wantarray; my $preexisting_exception = $@; my @ret; - my $all_good = eval { + my $saul_goodman = eval { $@ = $preexisting_exception; local $callstack_state->{in_internal_try} = 1 @@ -667,7 +667,7 @@ sub is_exception ($) { my $exception = $@; $@ = $preexisting_exception; - if ( $all_good ) { + if ( $saul_goodman ) { return $wantarray ? @ret : $ret[0] } elsif ( $catch_cref ) { @@ -679,7 +679,23 @@ sub is_exception ($) { return; } - sub in_internal_try { !! $callstack_state->{in_internal_try} } + sub dbic_internal_catch (&;@) { + + croak( 'Useless use of bare dbic_internal_catch()' ) + unless wantarray; + + croak( 'dbic_internal_catch() must receive exactly one argument at end of expression' ) + if @_ > 1; + + bless( + \( $_[0] ), + 'DBIx::Class::_Util::Catch' + ), + } + + sub in_internal_try () { + !! $callstack_state->{in_internal_try} + } } { diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm index ff63694..74d455a 100644 --- a/lib/SQL/Translator/Parser/DBIx/Class.pm +++ b/lib/SQL/Translator/Parser/DBIx/Class.pm @@ -15,10 +15,9 @@ $DEBUG = 0 unless defined $DEBUG; use Exporter; use SQL::Translator::Utils qw(debug normalize_name); use DBIx::Class::Carp qw/^SQL::Translator|^DBIx::Class|^Try::Tiny/; -use DBIx::Class::_Util 'dbic_internal_try'; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); use Class::C3::Componentised; use Scalar::Util 'blessed'; -use Try::Tiny; use namespace::clean; use base qw(Exporter); @@ -56,7 +55,8 @@ sub parse { if (!ref $dbicschema) { dbic_internal_try { Class::C3::Componentised->ensure_class_loaded($dbicschema) - } catch { + } + dbic_internal_catch { DBIx::Class::Exception->throw("Can't load $dbicschema: $_"); } } diff --git a/t/52leaks.t b/t/52leaks.t index bd159a7..b395483 100644 --- a/t/52leaks.t +++ b/t/52leaks.t @@ -90,15 +90,26 @@ if ( !$ENV{DBICTEST_VIA_REPLICATED} and !DBICTest::RunMode->is_plain ) { return populate_weakregistry ($weak_registry, $obj ); }; - require Try::Tiny; - for my $func (qw/try catch finally/) { - my $orig = \&{"Try::Tiny::$func"}; - *{"Try::Tiny::$func"} = sub (&;@) { + + for my $func (qw( dbic_internal_try dbic_internal_catch )) { + my $orig = \&{"DBIx::Class::_Util::$func"}; + *{"DBIx::Class::_Util"} = sub (&;@) { populate_weakregistry( $weak_registry, $_[0] ); goto $orig; } } + if ( eval { require Try::Tiny } ) { + for my $func (qw( try catch finally )) { + my $orig = \&{"Try::Tiny::$func"}; + *{"Try::Tiny::$func"} = sub (&;@) { + populate_weakregistry( $weak_registry, $_[0] ); + goto $orig; + } + } + } + + # Some modules are known to install singletons on-load # Load them and empty the registry diff --git a/t/73oracle.t b/t/73oracle.t index e7096ea..c8c4cd0 100644 --- a/t/73oracle.t +++ b/t/73oracle.t @@ -6,7 +6,6 @@ use warnings; use Test::Exception; use Test::More; -use Try::Tiny; use DBIx::Class::_Util 'set_subname'; use DBICTest; diff --git a/t/73oracle_blob.t b/t/73oracle_blob.t index d067c2b..6e5c903 100644 --- a/t/73oracle_blob.t +++ b/t/73oracle_blob.t @@ -6,7 +6,6 @@ use warnings; use Test::Exception; use Test::More; -use Try::Tiny; use DBICTest::Schema::BindType; BEGIN { @@ -105,10 +104,14 @@ SKIP: { 'multi-part LOB equality query was not cached', ) if $size eq 'large'; is @objs, 1, 'One row found matching on both LOBs'; - ok (try { $objs[0]->blob }||'' eq "blob:$str", 'blob inserted/retrieved correctly'); - ok (try { $objs[0]->clob }||'' eq "clob:$str", 'clob inserted/retrieved correctly'); - ok (try { $objs[0]->clb2 }||'' eq "clb2:$str", "clb2 inserted correctly"); - ok (try { $objs[0]->blb2 }||'' eq "blb2:$str", "blb2 inserted correctly"); + + for my $type (qw( blob clob clb2 blb2 )) { + is ( + eval { $objs[0]->$type }, + "$type:$str", + "$type inserted/retrieved correctly" + ); + } { local $TODO = '-like comparison on blobs not tested before ora 10 (fails on 8i)' @@ -138,10 +141,14 @@ SKIP: { @objs = $rs->search({ blob => "updated blob", clob => 'updated clob' })->all; is @objs, 1, 'found updated row'; - ok (try { $objs[0]->blob }||'' eq "updated blob", 'blob updated/retrieved correctly'); - ok (try { $objs[0]->clob }||'' eq "updated clob", 'clob updated/retrieved correctly'); - ok (try { $objs[0]->clb2 }||'' eq "updated clb2", "clb2 updated correctly"); - ok (try { $objs[0]->blb2 }||'' eq "updated blb2", "blb2 updated correctly"); + + for my $type (qw( blob clob clb2 blb2 )) { + is ( + eval { $objs[0]->$type }, + "updated $type", + "$type updated/retrieved correctly" + ); + } lives_ok { $rs->search({ id => $id }) @@ -150,8 +157,14 @@ SKIP: { @objs = $rs->search({ blob => 're-updated blob', clob => 're-updated clob' })->all; is @objs, 1, 'found updated row'; - ok (try { $objs[0]->blob }||'' eq 're-updated blob', 'blob updated/retrieved correctly'); - ok (try { $objs[0]->clob }||'' eq 're-updated clob', 'clob updated/retrieved correctly'); + + for my $type (qw( blob clob )) { + is ( + eval { $objs[0]->$type }, + "re-updated $type", + "$type updated/retrieved correctly" + ); + } lives_ok { $rs->search({ blob => "re-updated blob", clob => "re-updated clob" }) diff --git a/t/745db2.t b/t/745db2.t index 34cc2a1..e9a3fa6 100644 --- a/t/745db2.t +++ b/t/745db2.t @@ -6,7 +6,6 @@ use warnings; use Test::More; use Test::Exception; -use Try::Tiny; use DBICTest; @@ -22,9 +21,9 @@ my $dbh = $schema->storage->dbh; is $schema->storage->sql_maker->name_sep, $name_sep, 'name_sep detection'; -my $have_rno = try { +my $have_rno = eval { $dbh->selectrow_array( -"SELECT row_number() OVER (ORDER BY 1) FROM sysibm${name_sep}sysdummy1" + "SELECT row_number() OVER (ORDER BY 1) FROM sysibm${name_sep}sysdummy1" ); 1; }; diff --git a/t/746mssql.t b/t/746mssql.t index 5fc3d30..e3ddd6d 100644 --- a/t/746mssql.t +++ b/t/746mssql.t @@ -7,9 +7,9 @@ use warnings; use Test::More; use Test::Exception; use Test::Warn; -use Try::Tiny; use DBICTest; +use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch ); my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/}; @@ -62,10 +62,10 @@ for my $opts_name (keys %opts) { my $opts = $opts{$opts_name}{opts}; $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); - try { + dbic_internal_try { $schema->storage->ensure_connected } - catch { + dbic_internal_catch { if ($opts{$opts_name}{required}) { die "on_connect_call option '$opts_name' is not functional: $_"; } @@ -500,22 +500,35 @@ SQL $row = $rs->create({ amount => 100 }); } 'inserted a money value'; - cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 100, - 'money value round-trip'); + cmp_ok ( + ( eval { $rs->find($row->id)->amount } ) || 0, + '==', + 100, + 'money value round-trip' + ); lives_ok { $row->update({ amount => 200 }); } 'updated a money value'; - cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 200, - 'updated money value round-trip'); + cmp_ok ( + ( eval { $rs->find($row->id)->amount } ) || 0, + '==', + 200, + 'updated money value round-trip' + ); lives_ok { $row->update({ amount => undef }); } 'updated a money value to NULL'; - is try { $rs->find($row->id)->amount }, undef, - 'updated money value to NULL round-trip'; + lives_ok { + is( + $rs->find($row->id)->amount, + undef, + 'updated money value to NULL round-trip' + ); + } } } diff --git a/t/747mssql_ado.t b/t/747mssql_ado.t index d40cd17..a426605 100644 --- a/t/747mssql_ado.t +++ b/t/747mssql_ado.t @@ -6,7 +6,6 @@ use warnings; use Test::More; use Test::Exception; -use Try::Tiny; use DBICTest; @@ -40,7 +39,7 @@ is $schema->storage->sql_limit_dialect, ($ver >= 9 ? 'RowNumberOver' : 'Top'), $schema->storage->dbh_do (sub { my ($storage, $dbh) = @_; - try { local $^W = 0; $dbh->do("DROP TABLE artist") }; + eval { local $^W = 0; $dbh->do("DROP TABLE artist") }; $dbh->do(<<'SQL'); CREATE TABLE artist ( artistid INT IDENTITY NOT NULL, @@ -54,7 +53,7 @@ SQL $schema->storage->dbh_do (sub { my ($storage, $dbh) = @_; - try { local $^W = 0; $dbh->do("DROP TABLE artist_guid") }; + eval { local $^W = 0; $dbh->do("DROP TABLE artist_guid") }; $dbh->do(<<"SQL"); CREATE TABLE artist_guid ( artistid UNIQUEIDENTIFIER NOT NULL, @@ -71,7 +70,7 @@ my $have_max = $ver >= 9; # 2005 and greater $schema->storage->dbh_do (sub { my ($storage, $dbh) = @_; - try { local $^W = 0; $dbh->do("DROP TABLE varying_max_test") }; + eval { local $^W = 0; $dbh->do("DROP TABLE varying_max_test") }; $dbh->do(" CREATE TABLE varying_max_test ( id INT IDENTITY NOT NULL, @@ -115,7 +114,7 @@ my $rs1 = $schema->resultset('Artist')->search({}, { order_by => 'artistid' }); my $rs2 = $schema->resultset('Artist')->search({}, { order_by => 'name' }); while ($rs1->next) { - ok try { $rs2->next }, 'multiple active cursors'; + lives_ok { ok $rs2->next } 'multiple active cursors'; } # test bug where ADO blows up if the first bindparam is shorter than the second @@ -232,14 +231,19 @@ foreach my $size (qw/small large/) { $row->discard_changes; } 're-selected just-inserted LOBs'; - cmp_ok try { $row->varchar_max }, 'eq', $str, 'VARCHAR(MAX) matches'; - cmp_ok try { $row->nvarchar_max }, 'eq', $str, 'NVARCHAR(MAX) matches'; - cmp_ok try { $row->varbinary_max }, 'eq', $str, 'VARBINARY(MAX) matches'; + for my $type (qw( varchar nvarchar varbinary ) ) { + my $meth = "${type}_max"; + is( + eval { $row->$meth }, + $str, + ( uc $type ) . '(MAX) matches' + ); + } } # test regular blobs -try { local $^W = 0; $schema->storage->dbh->do('DROP TABLE bindtype_test') }; +eval { local $^W = 0; $schema->storage->dbh->do('DROP TABLE bindtype_test') }; $schema->storage->dbh->do(qq[ CREATE TABLE bindtype_test ( @@ -299,7 +303,7 @@ ok( ); diag $@ if $@; -my $guid = try { $row->artistid }||''; +my $guid = eval { $row->artistid }||''; ok(($guid !~ /^{.*?}\z/), 'GUID not enclosed in braces') or diag "GUID is: $guid"; @@ -313,29 +317,48 @@ diag $@ if $@; my $row_from_db = $schema->resultset('ArtistGUID') ->search({ name => 'mtfnpy' })->first; -is try { $row_from_db->artistid }, try { $row->artistid }, - 'PK GUID round trip (via ->search->next)'; +is( + eval { $row_from_db->artistid }, + eval { $row->artistid }, + 'PK GUID round trip (via ->search->next)' +); -is try { $row_from_db->a_guid }, try { $row->a_guid }, - 'NON-PK GUID round trip (via ->search->next)'; +is( + eval { $row_from_db->a_guid }, + eval { $row->a_guid }, + 'NON-PK GUID round trip (via ->search->next)' +); -$row_from_db = try { $schema->resultset('ArtistGUID') - ->find($row->artistid) }; +$row_from_db = eval { + $schema->resultset('ArtistGUID')->find($row->artistid) +}; -is try { $row_from_db->artistid }, try { $row->artistid }, - 'PK GUID round trip (via ->find)'; +is( + eval { $row_from_db->artistid }, + eval { $row->artistid }, + 'PK GUID round trip (via ->find)' +); -is try { $row_from_db->a_guid }, try { $row->a_guid }, - 'NON-PK GUID round trip (via ->find)'; +is( + eval { $row_from_db->a_guid }, + eval { $row->a_guid }, + 'NON-PK GUID round trip (via ->find)' +); ($row_from_db) = $schema->resultset('ArtistGUID') ->search({ name => 'mtfnpy' })->all; -is try { $row_from_db->artistid }, try { $row->artistid }, - 'PK GUID round trip (via ->search->all)'; +is( + eval { $row_from_db->artistid }, + eval { $row->artistid }, + 'PK GUID round trip (via ->search->all)' +); -is try { $row_from_db->a_guid }, try { $row->a_guid }, - 'NON-PK GUID round trip (via ->search->all)'; +is( + eval { $row_from_db->a_guid }, + eval { $row->a_guid }, + 'NON-PK GUID round trip (via ->search->all)' +); lives_ok { $row = $schema->resultset('ArtistGUID')->create({ @@ -344,15 +367,21 @@ lives_ok { }); } 'created a row with explicit PK GUID'; -is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C06', - 'row has correct PK GUID'; +is( + eval { $row->artistid }, + '70171270-4822-4450-81DF-921F99BA3C06', + 'row has correct PK GUID' +); lives_ok { $row->update({ artistid => '70171270-4822-4450-81DF-921F99BA3C07' }); } "updated row's PK GUID"; -is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C07', - 'row has correct PK GUID'; +is( + eval { $row->artistid }, + '70171270-4822-4450-81DF-921F99BA3C07', + 'row has correct PK GUID' +); lives_ok { $row->delete; @@ -370,8 +399,8 @@ done_testing; # clean up our mess END { local $SIG{__WARN__} = sub {}; - if (my $dbh = try { $schema->storage->_dbh }) { - (try { $dbh->do("DROP TABLE $_") }) + if (my $dbh = eval { $schema->storage->_dbh }) { + (eval { $dbh->do("DROP TABLE $_") }) for qw/artist artist_guid varying_max_test bindtype_test/; } diff --git a/t/749sqlanywhere.t b/t/749sqlanywhere.t index d4067b5..ed9c382 100644 --- a/t/749sqlanywhere.t +++ b/t/749sqlanywhere.t @@ -5,7 +5,6 @@ use warnings; use Test::More; use Test::Exception; -use Try::Tiny; use DBIx::Class::Optional::Dependencies (); use DBIx::Class::_Util 'scope_guard'; @@ -226,35 +225,54 @@ SQL ); diag $@ if $@; - my $row_from_db = try { $schema->resultset('ArtistGUID') - ->search({ name => 'mtfnpy' })->first } - catch { diag $_ }; + my $row_from_db; + lives_ok { + $row_from_db = $schema->resultset('ArtistGUID')->search({ name => 'mtfnpy' })->first + }; - is try { $row_from_db->artistid }, $row->artistid, - 'PK GUID round trip (via ->search->next)'; + is( + eval { $row_from_db->artistid }, + $row->artistid, + 'PK GUID round trip (via ->search->next)' + ); - is try { $row_from_db->a_guid }, $row->a_guid, - 'NON-PK GUID round trip (via ->search->next)'; + is( + eval { $row_from_db->a_guid }, + $row->a_guid, + 'NON-PK GUID round trip (via ->search->next)' + ); - $row_from_db = try { $schema->resultset('ArtistGUID') - ->find($row->artistid) } - catch { diag $_ }; + lives_ok { + $row_from_db = $schema->resultset('ArtistGUID')->find($row->artistid) + }; - is try { $row_from_db->artistid }, $row->artistid, - 'PK GUID round trip (via ->find)'; + is( + eval { $row_from_db->artistid }, + $row->artistid, + 'PK GUID round trip (via ->find)' + ); - is try { $row_from_db->a_guid }, $row->a_guid, - 'NON-PK GUID round trip (via ->find)'; + is( + eval { $row_from_db->a_guid }, + $row->a_guid, + 'NON-PK GUID round trip (via ->find)' + ); - ($row_from_db) = try { $schema->resultset('ArtistGUID') - ->search({ name => 'mtfnpy' })->all } - catch { diag $_ }; + lives_ok { + ($row_from_db) = $schema->resultset('ArtistGUID')->search({ name => 'mtfnpy' })->all + }; - is try { $row_from_db->artistid }, $row->artistid, - 'PK GUID round trip (via ->search->all)'; + is( + eval { $row_from_db->artistid }, + $row->artistid, + 'PK GUID round trip (via ->search->all)' + ); - is try { $row_from_db->a_guid }, $row->a_guid, - 'NON-PK GUID round trip (via ->search->all)'; + is( + eval { $row_from_db->a_guid }, + $row->a_guid, + 'NON-PK GUID round trip (via ->search->all)' + ); } } diff --git a/t/750firebird.t b/t/750firebird.t index fac50d5..eb4122a 100644 --- a/t/750firebird.t +++ b/t/750firebird.t @@ -8,7 +8,6 @@ use Test::Exception; use DBIx::Class::Optional::Dependencies (); use DBIx::Class::_Util 'scope_guard'; use List::Util 'shuffle'; -use Try::Tiny; use DBICTest; @@ -218,7 +217,11 @@ EOF $row = $paged->next; } 'paged query survived'; - is try { $row->artistid }, 5, 'correct row from paged query'; + is( + eval { $row->artistid }, + 5, + 'correct row from paged query' + ); # DBD bug - if any unfinished statements are present during # DDL manipulation (test blobs below)- a segfault will occur diff --git a/t/751msaccess.t b/t/751msaccess.t index 479124a..2b70a4a 100644 --- a/t/751msaccess.t +++ b/t/751msaccess.t @@ -5,7 +5,6 @@ use warnings; use Test::More; use Test::Exception; -use Try::Tiny; use DBIx::Class::Optional::Dependencies (); use DBIx::Class::_Util 'scope_guard'; @@ -144,37 +143,38 @@ EOF title => 'my track', }); - my $joined_track = try { - $schema->resultset('Artist')->search({ + my $joined_track; + lives_ok { + $joined_track = $schema->resultset('Artist')->search({ artistid => $first_artistid, }, { join => [{ cds => 'tracks' }], '+select' => [ 'tracks.title' ], '+as' => [ 'track_title' ], })->next; - } - catch { - diag "Could not execute two-step left join: $_"; - }; + } 'Two-step left join executed'; - is try { $joined_track->get_column('track_title') }, 'my track', - 'two-step left join works'; + is( + eval { $joined_track->get_column('track_title') }, + 'my track', + 'two-step left join works' + ); - $joined_artist = try { - $schema->resultset('Track')->search({ + lives_ok { + $joined_artist = $schema->resultset('Track')->search({ trackid => $track->trackid, }, { join => [{ cd => 'artist' }], '+select' => [ 'artist.name' ], '+as' => [ 'artist_name' ], })->next; - } - catch { - diag "Could not execute two-step inner join: $_"; - }; + } 'Two-step inner join executed'; - is try { $joined_artist->get_column('artist_name') }, 'foo', - 'two-step inner join works'; + is( + eval { $joined_artist->get_column('artist_name') }, + 'foo', + 'two-step inner join works' + ); # test basic transactions $schema->txn_do(sub { diff --git a/t/icdt/engine_specific/msaccess.t b/t/icdt/engine_specific/msaccess.t index a3cb63c..8f304ca 100644 --- a/t/icdt/engine_specific/msaccess.t +++ b/t/icdt/engine_specific/msaccess.t @@ -5,7 +5,6 @@ use strict; use warnings; use Test::More; -use Try::Tiny; use DBIx::Class::_Util 'scope_guard'; use DBICTest; @@ -39,7 +38,7 @@ for my $connect_info (@connect_info) { my $guard = scope_guard { cleanup($schema) }; - try { local $^W = 0; $schema->storage->dbh->do('DROP TABLE track') }; + eval { local $^W = 0; $schema->storage->dbh->do('DROP TABLE track') }; $schema->storage->dbh->do(<<"SQL"); CREATE TABLE track ( trackid AUTOINCREMENT PRIMARY KEY, diff --git a/t/icdt/engine_specific/mssql.t b/t/icdt/engine_specific/mssql.t index 2756858..3ba9d12 100644 --- a/t/icdt/engine_specific/mssql.t +++ b/t/icdt/engine_specific/mssql.t @@ -6,7 +6,6 @@ use warnings; use Test::More; use Test::Exception; -use Try::Tiny; use DBIx::Class::_Util 'scope_guard'; use DBICTest; @@ -56,7 +55,7 @@ for my $connect_info (@connect_info) { my $guard = scope_guard { cleanup($schema) }; # $^W because DBD::ADO is a piece of crap - try { local $^W = 0; $schema->storage->dbh->do("DROP TABLE track") }; + eval { local $^W = 0; $schema->storage->dbh->do("DROP TABLE track") }; $schema->storage->dbh->do(<<"SQL"); CREATE TABLE track ( trackid INT IDENTITY PRIMARY KEY, @@ -65,14 +64,14 @@ CREATE TABLE track ( last_updated_at DATETIME, ) SQL - try { local $^W = 0; $schema->storage->dbh->do("DROP TABLE event_small_dt") }; + eval { local $^W = 0; $schema->storage->dbh->do("DROP TABLE event_small_dt") }; $schema->storage->dbh->do(<<"SQL"); CREATE TABLE event_small_dt ( id INT IDENTITY PRIMARY KEY, small_dt SMALLDATETIME, ) SQL - try { local $^W = 0; $schema->storage->dbh->do("DROP TABLE event") }; + eval { local $^W = 0; $schema->storage->dbh->do("DROP TABLE event") }; $schema->storage->dbh->do(<<"SQL"); CREATE TABLE event ( id int IDENTITY(1,1) NOT NULL, diff --git a/t/icdt/engine_specific/sqlite.t b/t/icdt/engine_specific/sqlite.t index 1bee9d6..1c8b921 100644 --- a/t/icdt/engine_specific/sqlite.t +++ b/t/icdt/engine_specific/sqlite.t @@ -6,7 +6,6 @@ use warnings; use Test::More; use Test::Warn; -use Try::Tiny; use DBICTest; diff --git a/t/lib/ANFANG.pm b/t/lib/ANFANG.pm index c60ba9e..e5e6035 100644 --- a/t/lib/ANFANG.pm +++ b/t/lib/ANFANG.pm @@ -112,32 +112,36 @@ $INC{$_} ||= __FILE__ for (qw( ANFANG.pm t/lib/ANFANG.pm ./t/lib/ANFANG.pm )); ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$| ) ) { - require Try::Tiny; - my $orig = \&Try::Tiny::try; - - # in case we loaded warnings.pm / used -w - # ( do not do `no warnings ...` as it is also a load ) - local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /redefined/ }; - - *Try::Tiny::try = sub (&;@) { - my ($fr, $first_pkg) = 0; - while( $first_pkg = caller($fr++) ) { - last if $first_pkg !~ /^ - __ANON__ - | - \Q(eval)\E - $/x; - } - - if ($first_pkg =~ /DBIx::Class/) { - require Test::Builder; - Test::Builder->new->ok(0, - 'Using try{} within DBIC internals is a mistake - use dbic_internal_try{} instead' - ); - } - - goto $orig; - }; + # two levels of if() because of taint mode tangling the %ENV-checks + # with the require() call, sigh... + + if ( eval { require Try::Tiny } ) { + my $orig = \&Try::Tiny::try; + + # in case we loaded warnings.pm / used -w + # ( do not do `no warnings ...` as it is also a load ) + local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /redefined/ }; + + *Try::Tiny::try = sub (&;@) { + my ($fr, $first_pkg) = 0; + while( $first_pkg = caller($fr++) ) { + last if $first_pkg !~ /^ + __ANON__ + | + \Q(eval)\E + $/x; + } + + if ($first_pkg =~ /DBIx::Class/) { + require Test::Builder; + Test::Builder->new->ok(0, + 'Using try{} within DBIC internals is a mistake - use dbic_internal_try{} instead' + ); + } + + goto $orig; + }; + } } } diff --git a/t/storage/debug.t b/t/storage/debug.t index aac2a23..d0a6b4f 100644 --- a/t/storage/debug.t +++ b/t/storage/debug.t @@ -14,12 +14,11 @@ BEGIN { } use Test::More; -use Test::Exception; -use Try::Tiny; use File::Spec; use DBICTest; use DBICTest::Util 'slurp_bytes'; +use DBIx::Class::_Util 'scope_guard'; my $schema = DBICTest->init_schema(); @@ -69,15 +68,16 @@ open(STDERRCOPY, '>&STDERR'); my $exception_line_number; # STDERR will be closed, no T::B diag in blocks -my $exception = try { +my $exception = do { + my $restore_guard = scope_guard { open(STDERR, '>&STDERRCOPY') }; close(STDERR); - $exception_line_number = __LINE__ + 1; # important for test, do not reformat - $schema->resultset('CD')->search({})->count; -} catch { - $_ -} finally { - # restore STDERR - open(STDERR, '>&STDERRCOPY'); + + eval { + $exception_line_number = __LINE__ + 1; # important for test, do not reformat + $schema->resultset('CD')->search({})->count; + }; + + my $err = $@; }; ok $exception =~ / @@ -87,19 +87,19 @@ ok $exception =~ / /xms or diag "Unexpected exception text:\n\n$exception\n"; + my @warnings; -$exception = try { +$exception = do { local $SIG{__WARN__} = sub { push @warnings, @_ if $_[0] =~ /character/i }; + my $restore_guard = scope_guard { close STDERR; open(STDERR, '>&STDERRCOPY') }; close STDERR; - open(STDERR, '>', File::Spec->devnull) or die $!; - $schema->resultset('CD')->search({ title => "\x{1f4a9}" })->count; - ''; -} catch { - $_; -} finally { - # restore STDERR - close STDERR; - open(STDERR, '>&STDERRCOPY'); + + eval { + open(STDERR, '>', File::Spec->devnull) or die $!; + $schema->resultset('CD')->search({ title => "\x{1f4a9}" })->count; + }; + + my $err = $@; }; die "How did that fail... $exception" diff --git a/t/storage/quote_names.t b/t/storage/quote_names.t index 591606c..215c011 100644 --- a/t/storage/quote_names.t +++ b/t/storage/quote_names.t @@ -3,7 +3,6 @@ BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } use strict; use warnings; use Test::More; -use Try::Tiny; use DBICTest; use DBIx::Class::_Util 'dump_value'; @@ -112,7 +111,7 @@ for my $db (sort { my $schema; - my $sql_maker = try { + my $sql_maker = eval { $schema = DBICTest::Schema->connect($dsn, $user, $pass, { quote_names => 1 }); @@ -140,7 +139,7 @@ for my $db (sort { # the SQLT producer has no idea what quotes are :/ ! grep { $db eq $_ } qw( SYBASE DB2 ) and - my $ddl = try { $schema->deployment_statements } + my $ddl = eval { $schema->deployment_statements } ) { my $quoted_artist = $sql_maker->_quote('artist'); diff --git a/xt/extra/internals/namespaces_cleaned.t b/xt/extra/internals/namespaces_cleaned.t index b0a7cdb..89e2b54 100644 --- a/xt/extra/internals/namespaces_cleaned.t +++ b/xt/extra/internals/namespaces_cleaned.t @@ -159,7 +159,10 @@ for my $mod (@modules) { } # some common import names (these should never ever be methods) - for my $f (qw/carp carp_once carp_unique croak confess cluck try catch finally/) { + for my $f (qw( + carp carp_once carp_unique croak confess cluck + try catch finally dbic_internal_try dbic_internal_catch + )) { if ($mod->can($f)) { my $via; for (reverse @{mro::get_linear_isa($mod)} ) { diff --git a/xt/extra/lean_startup.t b/xt/extra/lean_startup.t index f915819..b53d1e8 100644 --- a/xt/extra/lean_startup.t +++ b/xt/extra/lean_startup.t @@ -141,7 +141,6 @@ BEGIN { Carp namespace::clean - Try::Tiny Sub::Name Sub::Defer Sub::Quote