The real fix for RT#73402 (abaondon tie %^H entirely), FC++

[p5sagit/namespace-clean.git] / lib / namespace / clean.pm

diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm
index 7db0875..c1450b4 100644 (file)
--- a/lib/namespace/clean.pm
+++ b/lib/namespace/clean.pm
@@ -1,5 +1,4 @@
 package namespace::clean;
-# ABSTRACT: Keep imports and functions out of your namespace
 
 use warnings;
 use strict;
@@ -11,11 +10,8 @@ our $VERSION = '0.21_01';
 
 $STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
 
+# FIXME - all of this buggery will migrate to B::H::EOS soon
 BEGIN {
-
-  use warnings;
-  use strict;
-
   # when changing also change in Makefile.PL
   my $b_h_eos_req = '0.07';
 
@@ -26,71 +22,13 @@ BEGIN {
   } ) {
     B::Hooks::EndOfScope->import('on_scope_end');
   }
-  else {
-    eval <<'PP' or die $@;
-
-  use Tie::Hash ();
-
-  {
-    package namespace::clean::_TieHintHash;
-
-    use warnings;
-    use strict;
-
-    use base 'Tie::ExtraHash';
-  }
-
-  {
-    package namespace::clean::_ScopeGuard;
-
-    use warnings;
-    use strict;
-
-    sub arm { bless [ $_[1] ] }
-
-    sub DESTROY { $_[0]->[0]->() }
+  elsif ($] < 5.009_003_9) {
+    require namespace::clean::_PP_OSE_5_8;
+    *on_scope_end = \&namespace::clean::_PP_OSE_5_8::on_scope_end;
   }
-
-
-  sub on_scope_end (&) {
-    $^H |= 0x020000;
-
-    if( my $stack = tied( %^H ) ) {
-      if ( (my $c = ref $stack) ne 'namespace::clean::_TieHintHash') {
-        die <<EOE;
-========================================================================
-               !!!   F A T A L   E R R O R   !!!
-
-                 foreign tie() of %^H detected
-========================================================================
-
-namespace::clean is currently operating in pure-perl fallback mode, because
-your system is lacking the necessary dependency B::Hooks::EndOfScope $b_h_eos_req.
-In this mode namespace::clean expects to be able to tie() the hinthash %^H,
-however it is apparently already tied by means unknown to the tie-class
-$c
-
-Since this is a no-win situation execution will abort here and now. Please
-try to find out which other module is relying on hinthash tie() ability,
-and file a bug for both the perpetrator and namespace::clean, so that the
-authors can figure out an acceptable way of moving forward.
-
-EOE
-      }
-      push @$stack, namespace::clean::_ScopeGuard->arm(shift);
-    }
-    else {
-      my %old_contents = %^H;
-      %^H = ();
-      tie( %^H, 'namespace::clean::_TieHintHash', namespace::clean::_ScopeGuard->arm(shift) );
-      $^H{$_} = $old_contents{$_} for keys %old_contents;
-    }
-  }
-
-  1;
-
-PP
-
+  else {
+    require namespace::clean::_PP_OSE;
+    *on_scope_end = \&namespace::clean::_PP_OSE::on_scope_end;
   }
 }
 
@@ -227,9 +165,16 @@ it is your responsibility to make sure it runs at that time.
 =cut
 
 # Constant to optimise away the unused code branches
-use constant RENAME_SUB => $] > 5.008_008_9 && $] < 5.013_006_1;
-{ no strict; delete ${__PACKAGE__."::"}{RENAME_SUB} }
+use constant FIXUP_NEEDED => $] < 5.015_005_1;
+use constant FIXUP_RENAME_SUB => $] > 5.008_008_9 && $] < 5.013_006_1;
+{
+  no strict;
+  delete ${__PACKAGE__."::"}{FIXUP_NEEDED};
+  delete ${__PACKAGE__."::"}{FIXUP_RENAME_SUB};
+}
 
+# Debugger fixup necessary before perl 5.15.5
+#
 # In perl 5.8.9-5.12, it assumes that sub_fullname($sub) can
 # always be used to find the CV again.
 # In perl 5.8.8 and 5.14, it assumes that the name of the glob
@@ -246,7 +191,7 @@ my $sub_utils_loaded;
 my $DebuggerFixup = sub {
   my ($f, $sub, $cleanee_stash, $deleted_stash) = @_;
 
-  if (RENAME_SUB) {
+  if (FIXUP_RENAME_SUB) {
     if (! defined $sub_utils_loaded ) {
       $sub_utils_loaded = do {
 
@@ -291,12 +236,14 @@ my $RemoveSubs = sub {
           or next SYMBOL;
 
         my $need_debugger_fixup =
+          FIXUP_NEEDED
+            &&
           $^P
             &&
           ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB'
         ;
 
-        if ($need_debugger_fixup) {
+        if (FIXUP_NEEDED && $need_debugger_fixup) {
           # convince the Perl debugger to work
           # see the comment on top of $DebuggerFixup
           $DebuggerFixup->(
@@ -318,7 +265,7 @@ my $RemoveSubs = sub {
         # if this perl needs no renaming trick we need to
         # rename the original glob after the fact
         # (see commend of $DebuggerFixup
-        if (!RENAME_SUB && $need_debugger_fixup) {
+        if (FIXUP_NEEDED && !FIXUP_RENAME_SUB && $need_debugger_fixup) {
           *$globref = $deleted_stash->namespace->{$f};
         }
 
@@ -475,17 +422,6 @@ 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<B::Hooks::EndOfScope> (with the XS dependency L<Variable::Magic>), 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.
-
-If you want to ensure that your codebase is protected from this unlikely
-clash, you need to explicitly depend on L<B::Hooks::EndOfScope>.
-
 =head1 SEE ALSO
 
 L<B::Hooks::EndOfScope>
@@ -514,11 +450,15 @@ Jesse Luehrs <doy@tozt.net>
 
 Peter Rabbitson <ribasushi@cpan.org>
 
+=item *
+
+Father Chrysostomos <sprout@cpan.org>
+
 =back
 
 =head1 COPYRIGHT AND LICENSE
 
-This software is copyright (c) 2011 by Robert 'phaylon' Sedlacek.
+This software is copyright (c) 2011 by L</AUTHORS>
 
 This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.