Commit | Line | Data |
b2e54862 |
1 | package # hide from the pauses |
2 | namespace::clean::_PP_OSE; |
3 | |
4 | use warnings; |
5 | use strict; |
6 | |
b2e54862 |
7 | use Tie::Hash; |
8 | use Hash::Util::FieldHash 'fieldhash'; |
9 | |
aabe8f1c |
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. |
b2e54862 |
18 | |
19 | fieldhash my %hh; |
b2e54862 |
20 | { |
21 | package namespace::clean::_TieHintHashFieldHash; |
22 | use base 'Tie::StdHash'; |
23 | sub DELETE { |
4dc0aa54 |
24 | my $ret = shift->SUPER::DELETE(@_); |
25 | $_->() for @$ret; |
26 | $ret; |
b2e54862 |
27 | } |
28 | } |
29 | |
b2e54862 |
30 | sub on_scope_end (&) { |
31 | $^H |= 0x020000; |
32 | |
33 | tie(%hh, 'namespace::clean::_TieHintHashFieldHash') |
34 | unless tied %hh; |
35 | |
aabe8f1c |
36 | push @{ $hh{\%^H} ||= [] }, shift; |
b2e54862 |
37 | } |
38 | |
39 | 1; |