File Coverage

blib/lib/B/Hooks/EndOfScope/PP.pm
Criterion Covered Total %
statement 23 24 95.8
branch 4 6 66.6
condition n/a
subroutine 6 6 100.0
pod n/a
total 33 36 91.6


line stmt bran cond sub pod time code
1             package B::Hooks::EndOfScope::PP;
2             # ABSTRACT: Execute code after a scope finished compilation - PP implementation
3              
4 7     7   92586 use warnings;
  7         14  
  7         409  
5 7     7   39 use strict;
  7         12  
  7         412  
6              
7             our $VERSION = '0.28';
8              
9 7     7   40 use constant _PERL_VERSION => "$]";
  7         32  
  7         1502  
10              
11             BEGIN {
12 7 50   7   44 if (_PERL_VERSION =~ /^5\.009/) {
13             # CBA to figure out where %^H got broken and which H::U::HH is sane enough
14 0         0 die "By design B::Hooks::EndOfScope does not operate in pure-perl mode on perl 5.9.X\n"
15             }
16             elsif (_PERL_VERSION < '5.010') {
17             require B::Hooks::EndOfScope::PP::HintHash;
18             *on_scope_end = \&B::Hooks::EndOfScope::PP::HintHash::on_scope_end;
19             }
20             else {
21 7         3859 require B::Hooks::EndOfScope::PP::FieldHash;
22 7         409 *on_scope_end = \&B::Hooks::EndOfScope::PP::FieldHash::on_scope_end;
23             }
24             }
25              
26 7         68 use Sub::Exporter::Progressive 0.001006 -setup => {
27             exports => ['on_scope_end'],
28             groups => { default => ['on_scope_end'] },
29 7     7   4353 };
  7         9930  
30              
31             sub __invoke_callback {
32 11     11   23 local $@;
33 11 100       46 eval { $_[0]->(); 1 } or do {
  11         55  
  10         61  
34 1         10 my $err = $@;
35 1         7 require Carp;
36 1         230 Carp::cluck( (join ' ',
37             'A scope-end callback raised an exception, which can not be propagated when',
38             'B::Hooks::EndOfScope operates in pure-perl mode. Your program will CONTINUE',
39             'EXECUTION AS IF NOTHING HAPPENED AFTER THIS WARNING. Below is the complete',
40             'exception text, followed by a stack-trace of the callback execution:',
41             ) . "\n\n$err\n\r" );
42              
43 1 50       22 sleep 1 if -t *STDERR; # maybe a bad idea...?
44             };
45             }
46              
47             1;
48              
49             __END__