Pure-perlize

diff --git a/Changes b/Changes
index 2ed7ad2..8172bab 100644 (file)
--- 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 (file)
--- 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<undef> instead.
 
+=head1 CAVEATS
+
+This module is fully functional in a pure-perl environment, where
+L<Variable::Magic>, a L<B::Hooks::EndOfScope> dependency, may not be
+available. However in this case this module falls back to a
+L<tie()|perlfunc/tie> 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<B::Hooks::EndOfScope>

diff --git a/t/10-pure-perl.t b/t/10-pure-perl.t
new file mode 100644 (file)
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;