From: Peter Rabbitson Date: Fri, 18 Jul 2014 16:21:20 +0000 (+0200) Subject: Standardize the Moo import block, move quote_sub/qsub into ::_Util X-Git-Tag: v0.082800~127 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7f9a3f70074c5d4eb4e8260648f055b7556a7a4f;p=dbsrgits%2FDBIx-Class.git Standardize the Moo import block, move quote_sub/qsub into ::_Util This way we will have less boilerplate in subsequent commits where we will use quote_sub standalone Add yet another test to make absolutely sure quote_sub won't leak any of the strictures insanity --- diff --git a/lib/DBIx/Class/Storage/BlockRunner.pm b/lib/DBIx/Class/Storage/BlockRunner.pm index 70ded7e..d65595c 100644 --- a/lib/DBIx/Class/Storage/BlockRunner.pm +++ b/lib/DBIx/Class/Storage/BlockRunner.pm @@ -1,22 +1,26 @@ package # hide from pause until we figure it all out DBIx::Class::Storage::BlockRunner; +use warnings; use strict; +# DO NOT edit away without talking to riba first, he will just put it back +# BEGIN pre-Moo2 import block +BEGIN { + my $initial_fatal_bits = (${^WARNING_BITS}||'') & $warnings::DeadBits{all}; + local $ENV{PERL_STRICTURES_EXTRA} = 0; + require Moo; Moo->import; + ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} ); +} +# END pre-Moo2 import block + use DBIx::Class::Exception; use DBIx::Class::Carp; use Context::Preserve 'preserve_context'; -use DBIx::Class::_Util 'is_exception'; +use DBIx::Class::_Util qw(is_exception qsub); use Scalar::Util qw(weaken blessed reftype); use Try::Tiny; -# DO NOT edit away without talking to riba first, he will just put it back -BEGIN { - local $ENV{PERL_STRICTURES_EXTRA} = 0; - require Moo; Moo->import; - require Sub::Quote; Sub::Quote->import('quote_sub'); -} -use warnings NONFATAL => 'all'; use namespace::clean; =head1 NAME @@ -43,16 +47,16 @@ has wrap_txn => ( has retry_handler => ( is => 'ro', required => 1, - isa => quote_sub( q{ + isa => qsub q{ (Scalar::Util::reftype($_[0])||'') eq 'CODE' or DBIx::Class::Exception->throw('retry_handler must be a CODE reference') - }), + }, ); has retry_debug => ( is => 'rw', # use a sub - to be evaluated on the spot lazily - default => quote_sub( '$ENV{DBIC_STORAGE_RETRY_DEBUG}' ), + default => qsub '$ENV{DBIC_STORAGE_RETRY_DEBUG}', lazy => 1, ); @@ -67,19 +71,19 @@ has failed_attempt_count => ( writer => '_set_failed_attempt_count', default => 0, lazy => 1, - trigger => quote_sub(q{ + trigger => qsub q{ $_[0]->throw_exception( sprintf ( 'Reached max_attempts amount of %d, latest exception: %s', $_[0]->max_attempts, $_[0]->last_exception )) if $_[0]->max_attempts <= ($_[1]||0); - }), + }, ); has exception_stack => ( is => 'ro', init_arg => undef, clearer => '_reset_exception_stack', - default => quote_sub(q{ [] }), + default => qsub q{ [] }, lazy => 1, ); diff --git a/lib/DBIx/Class/Storage/Statistics.pm b/lib/DBIx/Class/Storage/Statistics.pm index 0248936..e241ad4 100644 --- a/lib/DBIx/Class/Storage/Statistics.pm +++ b/lib/DBIx/Class/Storage/Statistics.pm @@ -1,21 +1,20 @@ package DBIx::Class::Storage::Statistics; + use strict; use warnings; # DO NOT edit away without talking to riba first, he will just put it back # BEGIN pre-Moo2 import block BEGIN { - require warnings; my $initial_fatal_bits = (${^WARNING_BITS}||'') & $warnings::DeadBits{all}; local $ENV{PERL_STRICTURES_EXTRA} = 0; require Moo; Moo->import; - require Sub::Quote; Sub::Quote->import('quote_sub'); ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} ); } # END pre-Moo2 import block extends 'DBIx::Class'; -use DBIx::Class::_Util 'sigwarn_silencer'; +use DBIx::Class::_Util qw(sigwarn_silencer qsub); use namespace::clean; =head1 NAME @@ -64,7 +63,7 @@ sub debugfh { has _debugfh => ( is => 'rw', lazy => 1, - trigger => quote_sub( '$_[0]->_defaulted_to_stderr(undef)' ), + trigger => qsub '$_[0]->_defaulted_to_stderr(undef)', builder => '_build_debugfh', ); diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 8c2ef12..384d3e0 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -55,12 +55,23 @@ use Carp 'croak'; use Scalar::Util qw(weaken blessed reftype); use List::Util qw(first); +# DO NOT edit away without talking to riba first, he will just put it back +# BEGIN pre-Moo2 import block +BEGIN { + my $initial_fatal_bits = (${^WARNING_BITS}||'') & $warnings::DeadBits{all}; + local $ENV{PERL_STRICTURES_EXTRA} = 0; + require Sub::Quote; Sub::Quote->import('quote_sub'); + ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} ); +} +sub qsub ($) { goto "e_sub } # no point depping on new Moo just for this +# END pre-Moo2 import block + use base 'Exporter'; our @EXPORT_OK = qw( sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray fail_on_internal_call refdesc refcount hrefaddr is_exception - perlstring + quote_sub qsub perlstring UNRESOLVABLE_CONDITION ); diff --git a/t/53lean_startup.t b/t/53lean_startup.t index 6868191..27a4dd4 100644 --- a/t/53lean_startup.t +++ b/t/53lean_startup.t @@ -99,6 +99,7 @@ BEGIN { namespace::clean Try::Tiny Sub::Name + Sub::Quote Scalar::Util List::Util @@ -117,7 +118,6 @@ BEGIN { { register_lazy_loadable_requires(qw( Moo - Sub::Quote Context::Preserve )); diff --git a/xt/quote_sub.t b/xt/quote_sub.t new file mode 100644 index 0000000..7918cc5 --- /dev/null +++ b/xt/quote_sub.t @@ -0,0 +1,48 @@ +use warnings; +use strict; + +use Test::More; +use Test::Warn; + +use DBIx::Class::_Util 'quote_sub'; + +my $q = do { + no strict 'vars'; + quote_sub '$x = $x . "buh"; $x += 42'; +}; + +warnings_exist { + is $q->(), 42, 'Expected result after uninit and string/num conversion' +} [ + qr/Use of uninitialized value/i, + qr/isn't numeric in addition/, +], 'Expected warnings, strict did not leak inside the qsub' + or do { + require B::Deparse; + diag( B::Deparse->new->coderef2text( Sub::Quote::unquote_sub($q) ) ) + } +; + +my $no_nothing_q = do { + no strict; + no warnings; + quote_sub <<'EOC'; + my $n = "Test::Warn::warnings_exist"; + warn "-->@{[ *{$n}{CODE} ]}<--\n"; + warn "-->@{[ ${^WARNING_BITS} || '' ]}<--\n"; +EOC +}; + +my $we_cref = Test::Warn->can('warnings_exist'); + +warnings_exist { $no_nothing_q->() } [ + qr/^\Q-->$we_cref<--\E$/m, + qr/^\-\-\>\0*\<\-\-$/m, # some perls have a string of nulls, some just an empty string +], 'Expected warnings, strict did not leak inside the qsub' + or do { + require B::Deparse; + diag( B::Deparse->new->coderef2text( Sub::Quote::unquote_sub($no_nothing_q) ) ) + } +; + +done_testing;