File Coverage

blib/lib/B/Hooks/EndOfScope/PP/FieldHash.pm
Criterion Covered Total %
statement 19 19 100.0
branch 1 2 50.0
condition 1 2 50.0
subroutine 6 6 100.0
pod 0 1 0.0
total 27 30 90.0


line stmt bran cond sub pod time code
1             # Implementation of a pure-perl on_scope_end for perls > 5.10
2             # (relies on Hash::Util:FieldHash)
3              
4             package # hide from pause
5             B::Hooks::EndOfScope::PP::FieldHash;
6              
7 1     1   5 use strict;
  1         1  
  1         22  
8 1     1   4 use warnings;
  1         2  
  1         29  
9              
10             our $VERSION = '0.24';
11              
12 1     1   387 use Tie::Hash ();
  1         740  
  1         18  
13 1     1   898 use Hash::Util::FieldHash 'fieldhash';
  1         714  
  1         167  
14              
15             # Here we rely on a combination of several behaviors:
16             #
17             # * %^H is deallocated on scope exit, so any references to it disappear
18             # * A lost weakref in a fieldhash causes the corresponding key to be deleted
19             # * Deletion of a key on a tied hash triggers DELETE
20             #
21             # Therefore the DELETE of a tied fieldhash containing a %^H reference will
22             # be the hook to fire all our callbacks.
23              
24             fieldhash my %hh;
25             {
26             package # hide from pause too
27             B::Hooks::EndOfScope::PP::_TieHintHashFieldHash;
28             our @ISA = ( 'Tie::StdHash' ); # in Tie::Hash, in core
29             sub DELETE {
30 1     1   41 my $ret = shift->SUPER::DELETE(@_);
31 1         6 B::Hooks::EndOfScope::PP::__invoke_callback($_) for @$ret;
32 1         27 $ret;
33             }
34             }
35              
36             sub on_scope_end (&) {
37 1     1 0 843 $^H |= 0x020000;
38              
39 1 50       10 tie(%hh, 'B::Hooks::EndOfScope::PP::_TieHintHashFieldHash')
40             unless tied %hh;
41              
42 1   50     4 push @{ $hh{\%^H} ||= [] }, $_[0];
  1         10  
43             }
44              
45             1;