From: Peter Rabbitson Date: Tue, 26 Jul 2011 18:47:49 +0000 (+0200) Subject: Pure-perlize X-Git-Tag: 0.21~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9887772bacd28d3ead3728d5a1c0c35b5fcdf794;p=p5sagit%2Fnamespace-clean.git Pure-perlize --- diff --git a/Changes b/Changes index 2ed7ad2..8172bab 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,9 @@ - Only invoke the deleted sub stashing if we run udner a debugger (avoid runtime penalty of Sub::Name/Sub::Identify) - Spellfixes (RT#54388) + - When B::Hooks::EndOfScope is not available, switch to a simple + tie() of %^H. While it can not 100% replace B::H::EOS, it does + everything n::c needs [0.20] - Bump Package::Stash dependency to 0.22 to pull in a bugfix in diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm index 9ee2893..8197618 100644 --- a/lib/namespace/clean.pm +++ b/lib/namespace/clean.pm @@ -5,11 +5,49 @@ use warnings; use strict; use vars qw( $STORAGE_VAR ); -use Package::Stash 0.22; -use B::Hooks::EndOfScope 0.07; +use Package::Stash; $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE'; +BEGIN { + if (eval { + require B::Hooks::EndOfScope; + B::Hooks::EndOfScope->VERSION('0.07'); + 1 + } ) { + B::Hooks::EndOfScope->import('on_scope_end'); + } + else { + eval <<'PP' or die $@; + + { + package namespace::clean::_ScopeGuard; + + sub arm { bless [ $_[1] ] } + + sub DESTROY { $_[0]->[0]->() } + } + + use Tie::Hash (); + + sub on_scope_end (&) { + $^H |= 0x020000; + + if( my $stack = tied( %^H ) ) { + push @$stack, namespace::clean::_ScopeGuard->arm(shift); + } + else { + tie( %^H, 'Tie::ExtraHash', namespace::clean::_ScopeGuard->arm(shift) ); + } + } + + 1; + +PP + + } +} + =head1 SYNOPSIS package Foo; @@ -351,6 +389,14 @@ will be stable in future releases. Just for completeness sake, if you want to remove the symbol completely, use C instead. +=head1 CAVEATS + +This module is fully functional in a pure-perl environment, where +L, a L dependency, may not be +available. However in this case this module falls back to a +L of L<%^H|perlvar/%^H> which may or may not interfere +with some crack you may be doing independently of namespace::clean. + =head1 SEE ALSO L diff --git a/t/10-pure-perl.t b/t/10-pure-perl.t new file mode 100644 index 0000000..d77551e --- /dev/null +++ b/t/10-pure-perl.t @@ -0,0 +1,40 @@ +use strict; +use warnings; +use Test::More; + +eval { require B::Hooks::EndOfScope } + or plan skip_all => "PP tests already executed"; + +eval { require Devel::Hide } + or plan skip_all => "Devel::Hide required for this test in presence of B::Hooks::EndOfScope"; + +use Config; +use FindBin qw($Bin); +use IPC::Open2 qw(open2); + +# for the $^X-es +$ENV{PERL5LIB} = join ($Config{path_sep}, @INC); + +# rerun the tests under the assumption of pure-perl +my $this_file = quotemeta(__FILE__); + +for my $fn (glob("$Bin/*.t")) { + next if $fn =~ /${this_file}$/; + + local $ENV{DEVEL_HIDE_VERBOSE} = 0; + my @cmd = ( $^X, '-MDevel::Hide=B::Hooks::EndOfScope', $fn ); + + # this is cheating, and may even hang here and there (testing on windows passed fine) + # if it does - will have to fix it somehow (really *REALLY* don't want to pull + # in IPC::Cmd just for a fucking test) + # the alternative would be to have an ENV check in each test to force a subtest + open2(my $out, my $in, @cmd); + while (my $ln = <$out>) { + print " $ln"; + } + + wait; + ok (! $?, "Exit $? from: @cmd"); +} + +done_testing;