lib/namespace/clean/_PP_OSE.pm

   1 package # hide from the pauses
   2   namespace::clean::_PP_OSE;
   3
   4 use warnings;
   5 use strict;
   6
   7 use Tie::Hash;
   8 use Hash::Util::FieldHash 'fieldhash';
   9
  10 # Here we rely on a combination of several behaviors:
  11 #
  12 # * %^H is deallocated on scope exit, so any references to it disappear
  13 # * A lost weakref in a fieldhash causes the corresponding key to be deleted
  14 # * Deletion of a key on a tied hash triggers DELETE
  15 #
  16 # Therefore the DELETE of a tied fieldhash containing a %^H reference will
  17 # be the hook to fire all our callbacks.
  18
  19 fieldhash my %hh;
  20 {
  21   package # hide from pause too
  22     namespace::clean::_TieHintHashFieldHash;
  23   use base 'Tie::StdHash';
  24   sub DELETE {
  25     my $ret = shift->SUPER::DELETE(@_);
  26     $_->() for @$ret;
  27     $ret;
  28   }
  29 }
  30
  31 sub on_scope_end (&) {
  32   $^H |= 0x020000;
  33
  34   tie(%hh, 'namespace::clean::_TieHintHashFieldHash')
  35     unless tied %hh;
  36
  37   push @{ $hh{\%^H} ||= [] }, shift;
  38 }
  39
  40 1;