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 namespace::clean::_TieHintHashFieldHash;
  22   use base 'Tie::StdHash';
  23   sub DELETE {
  24     my $ret = shift->SUPER::DELETE(@_);
  25     $_->() for @$ret;
  26     $ret;
  27   }
  28 }
  29
  30 sub on_scope_end (&) {
  31   $^H |= 0x020000;
  32
  33   tie(%hh, 'namespace::clean::_TieHintHashFieldHash')
  34     unless tied %hh;
  35
  36   push @{ $hh{\%^H} ||= [] }, shift;
  37 }
  38
  39 1;