From: Peter Rabbitson Date: Wed, 24 Sep 2014 00:22:48 +0000 (+0200) Subject: Viciously deal with more strictures fallout X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cbd7f87a859ccbb026af01fe38c832596323f156;hp=4ae45d6992654bfe668bdd96da26e0ec8bc9d2a2;p=dbsrgits%2FDBIx-Class-Historic.git Viciously deal with more strictures fallout The 'what can possibly go wrong' blew up with RT#99083, there is definitely more where this came from. Try to maintain safety by going to even greater lengths ensuring we do not load any of it ourselves --- diff --git a/lib/DBIx/Class/Storage/BlockRunner.pm b/lib/DBIx/Class/Storage/BlockRunner.pm index d65595c..4c5af9a 100644 --- a/lib/DBIx/Class/Storage/BlockRunner.pm +++ b/lib/DBIx/Class/Storage/BlockRunner.pm @@ -4,23 +4,33 @@ package # hide from pause until we figure it all out use warnings; use strict; +use DBIx::Class::Exception; +use DBIx::Class::Carp; +use Context::Preserve 'preserve_context'; +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 pre-Moo2 import block BEGIN { my $initial_fatal_bits = (${^WARNING_BITS}||'') & $warnings::DeadBits{all}; + local $ENV{PERL_STRICTURES_EXTRA} = 0; - require Moo; Moo->import; + # load all of these now, so that lazy-loading does not escape + # the current PERL_STRICTURES_EXTRA setting + require Sub::Quote; + require Sub::Defer; + require Moo; + require Moo::Object; + require Method::Generate::Accessor; + require Method::Generate::Constructor; + + 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 qw(is_exception qsub); -use Scalar::Util qw(weaken blessed reftype); -use Try::Tiny; - use namespace::clean; =head1 NAME diff --git a/lib/DBIx/Class/Storage/Statistics.pm b/lib/DBIx/Class/Storage/Statistics.pm index 5768db6..b0343d0 100644 --- a/lib/DBIx/Class/Storage/Statistics.pm +++ b/lib/DBIx/Class/Storage/Statistics.pm @@ -3,18 +3,29 @@ package DBIx::Class::Storage::Statistics; use strict; use warnings; +use DBIx::Class::_Util qw(sigwarn_silencer qsub); + # 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; + # load all of these now, so that lazy-loading does not escape + # the current PERL_STRICTURES_EXTRA setting + require Sub::Quote; + require Sub::Defer; + require Moo; + require Moo::Object; + require Method::Generate::Accessor; + require Method::Generate::Constructor; + + Moo->import; ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} ); } # END pre-Moo2 import block extends 'DBIx::Class'; -use DBIx::Class::_Util qw(sigwarn_silencer qsub); use namespace::clean; =head1 NAME diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 37dddfc..db885ce 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -92,8 +92,14 @@ use List::Util qw(first); # 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'); + # load all of these now, so that lazy-loading does not escape + # the current PERL_STRICTURES_EXTRA setting + require Sub::Quote; + require Sub::Defer; + + 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 diff --git a/maint/travis-ci_scripts/30_before_script.bash b/maint/travis-ci_scripts/30_before_script.bash index 7d247c8..c6b291c 100755 --- a/maint/travis-ci_scripts/30_before_script.bash +++ b/maint/travis-ci_scripts/30_before_script.bash @@ -23,6 +23,8 @@ if [[ "$POISON_ENV" = "true" ]] ; then export DBI_DSN="dbi:ODBC:server=NonexistentServerAddress" export DBI_DRIVER="ADO" + # some people do in fact set this - boggle!!! + export PERL_STRICTURES_EXTRA=1 # emulate a local::lib-like env # trick cpanm into executing true as shell - we just need the find+unpack diff --git a/t/53lean_startup.t b/t/53lean_startup.t index 2943507..0c66c7d 100644 --- a/t/53lean_startup.t +++ b/t/53lean_startup.t @@ -6,6 +6,9 @@ BEGIN { # these envvars *will* bring in more stuff than the baseline delete @ENV{qw(DBICTEST_SQLT_DEPLOY DBIC_TRACE)}; + # make sure extras do not load even when this is set + $ENV{PERL_STRICTURES_EXTRA} = 1; + unshift @INC, 't/lib'; require DBICTest::Util::OverrideRequire; @@ -100,6 +103,7 @@ BEGIN { Try::Tiny Sub::Name strictures + Sub::Defer Sub::Quote Scalar::Util @@ -121,6 +125,9 @@ BEGIN { { register_lazy_loadable_requires(qw( Moo + Moo::Object + Method::Generate::Accessor + Method::Generate::Constructor Context::Preserve Data::Compare )); @@ -167,6 +174,12 @@ BEGIN { assert_no_missing_expected_requires(); } +# make sure we never loaded any of the strictures XS bullshit +{ + ok( ! exists $INC{ Module::Runtime::module_notional_filename($_) }, "$_ load never attempted" ) + for qw(indirect multidimensional bareword::filehandles); +} + done_testing; sub register_lazy_loadable_requires { diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm index 1a56f41..645bc24 100644 --- a/t/lib/DBICTest/Util/LeakTracer.pm +++ b/t/lib/DBICTest/Util/LeakTracer.pm @@ -358,6 +358,21 @@ END { else { $tb->note("Auto checked $refs_traced references for leaks - none detected"); } + +# Disable this until better times - SQLT and probably other things +# still load strictures. Let's just wait until Moo2.0 and go from there +=begin for tears + # also while we are here and not in plain runmode: make sure we never + # loaded any of the strictures XS bullshit (it's a leak in a sense) + unless (DBICTest::RunMode->is_plain) { + for (qw(indirect multidimensional bareword::filehandles)) { + exists $INC{ Module::Runtime::module_notional_filename($_) } + and + $tb->ok(0, "$_ load apparently attempted!!!" ) + } + } +=cut + } }