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

diff --git a/Changes b/Changes
index ebe2fb6..6c43eed 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,4 +1,6 @@
-        - Compile away the debugger fixup on perls >= 5.15.5
+        - Replace the %^H tie approach with fieldhashes, fixes all known
+          corner cases and caveats on supported perls >= 5.8.1 (FC)
+        - Compile away the debugger fixup on perls >= 5.15.5 (FC)
 
     [0.21_01]
         - More robust handling of the tied %^H in pure perl mode (RT#73402)

diff --git a/lib/namespace/clean.pm b/lib/namespace/clean.pm
index 6e081ec..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]->() }
-  }
-
-
-  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;
-    }
+  elsif ($] < 5.009_003_9) {
+    require namespace::clean::_PP_OSE_5_8;
+    *on_scope_end = \&namespace::clean::_PP_OSE_5_8::on_scope_end;
   }
-
-  1;
-
-PP
-
+  else {
+    require namespace::clean::_PP_OSE;
+    *on_scope_end = \&namespace::clean::_PP_OSE::on_scope_end;
   }
 }
 
@@ -484,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>
@@ -523,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.
 

diff --git a/lib/namespace/clean/_PP_OSE.pm b/lib/namespace/clean/_PP_OSE.pm
new file mode 100644 (file)
index 0000000..26fc091
--- /dev/null
+++ b/lib/namespace/clean/_PP_OSE.pm
@@ -0,0 +1,42 @@
+package # hide from the pauses
+  namespace::clean::_PP_OSE;
+
+use warnings;
+use strict;
+
+use namespace::clean::_PP_SG;
+use Tie::Hash;
+use Hash::Util::FieldHash 'fieldhash';
+
+# Hash::Util::FieldHash is not deleting elements in void context. When
+# you call delete() in non-void context, a mortal scalar is returned. A
+# mortal scalar is one whose reference count decreases at the end of the
+# current statement. During scope exit, ‘statement’ is not clearly
+# defined, so more scope unwinding could happen before the mortal gets
+# freed.
+# By tying it and overriding DELETE, we can force the deletion into
+# void context.
+
+fieldhash my %hh;
+
+{
+  package namespace::clean::_TieHintHashFieldHash;
+  use base 'Tie::StdHash';
+  sub DELETE {
+    shift->SUPER::DELETE(@_);
+    1; # put the preceding statement in void context
+  }
+}
+
+
+sub on_scope_end (&) {
+  $^H |= 0x020000;
+
+  tie(%hh, 'namespace::clean::_TieHintHashFieldHash')
+    unless tied %hh;
+
+  push @{$hh{\%^H} ||= []},
+    namespace::clean::_PP_SG->arm(shift);
+}
+
+1;

diff --git a/lib/namespace/clean/_PP_OSE_5_8.pm b/lib/namespace/clean/_PP_OSE_5_8.pm
new file mode 100644 (file)
index 0000000..15cc00b
--- /dev/null
+++ b/lib/namespace/clean/_PP_OSE_5_8.pm
@@ -0,0 +1,18 @@
+package # hide from the pauses
+  namespace::clean::_PP_OSE_5_8;
+
+use warnings;
+use strict;
+
+use namespace::clean::_PP_SG;
+
+# This is the original implementation, which sadly is broken
+# on perl 5.10+ withing string evals
+sub on_scope_end (&) {
+  $^H |= 0x020000;
+
+  push @{$^H{'__namespace::clean__guardstack__'} ||= [] },
+    namespace::clean::_PP_SG->arm(shift);
+}
+
+1;

diff --git a/lib/namespace/clean/_PP_SG.pm b/lib/namespace/clean/_PP_SG.pm
new file mode 100644 (file)
index 0000000..768ce41
--- /dev/null
+++ b/lib/namespace/clean/_PP_SG.pm
@@ -0,0 +1,10 @@
+package # hide from the pauses
+  namespace::clean::_PP_SG;
+
+use warnings;
+use strict;
+
+sub arm { bless [ $_[1] ] }
+sub DESTROY { $_[0]->[0]->() }
+
+1;

diff --git a/t/09-fiddle-hinthash.t b/t/09-fiddle-hinthash.t
index adc1923..bf7b075 100644 (file)
--- a/t/09-fiddle-hinthash.t
+++ b/t/09-fiddle-hinthash.t
@@ -24,10 +24,15 @@ use Test::More 0.88;
   use namespace::clean;
 
   BEGIN {
-    Test::More::is( $^H{'foo'}, 'bar', 'hinthash intact' );
+    Test::More::is( $^H{'foo'}, 'bar', 'compiletime hinthash intact after n::c' );
   }
 
   {
+    BEGIN {
+      Test::More::is(
+        $^H{'foo'}, 'bar', 'compile-time hinthash intact in inner scope'
+      );
+    }
     1;
   }