File Coverage

blib/lib/Devel/TrackSIG.pm
Criterion Covered Total %
statement 28 45 62.2
branch 4 14 28.5
condition n/a
subroutine 8 11 72.7
pod 2 2 100.0
total 42 72 58.3


line stmt bran cond sub pod time code
1             package Devel::TrackSIG;
2 1     1   23910 use strict;
  1         3  
  1         36  
3 1     1   6 use warnings;
  1         1  
  1         30  
4 1     1   6 use Carp;
  1         6  
  1         824  
5 1     1   978 eval "use Carp::Heavy;";
  1         181  
  1         18  
6             require Tie::Hash;
7             our @ISA = qw(Tie::ExtraHash);
8              
9             our $VERSION = '0.03';
10              
11             tie %main::SIG => __PACKAGE__;
12              
13             our %opt = (
14             track_source => 1,
15             report_write_access => 0,
16             );
17              
18             sub import {
19 1     1   6 my $class = shift;
20 1         2 my %args = @_;
21              
22 1         26 $opt{$_} = $args{$_} for keys %args;
23             }
24              
25              
26             sub DELETE {
27 73     73   823 _report($_[0], $_[1], 'DELETE');
28 73         4734 return delete $_[0]->[0]->{$_[1]};
29             }
30              
31             sub STORE {
32 72     72   2052 _report($_[0], $_[1], 'STORE');
33 72         1404 return $_[0]->[0]->{$_[1]} = $_[2];
34             }
35              
36             sub CLEAR {
37 0     0   0 _report($_[0], '', 'CLEAR');
38 0         0 %{$_[0]->[0]} = ();
  0         0  
39             }
40              
41              
42             sub _report {
43 145     145   195 my $obj = shift;
44 145         183 my $key = shift;
45 145         158 my $action = shift;
46              
47            
48 145 100       319 push @$obj, {} if @$obj < 2;
49              
50 145         204 my $sources = $obj->[1];
51              
52 145         39397 my $msg = Carp::longmess("${action}ing signal handler '$key' at");
53 145 50       36454 if ($opt{track_source}) {
54 145         371 $sources->{$key} = $msg;
55             }
56 145 50       425 if ($opt{report_write_access}) {
57 0           print STDERR $msg . "\n";
58             }
59             }
60              
61             sub get_source {
62 0     0 1   my $self = shift;
63 0           my $key = shift;
64 0 0         print STDERR "Source tracking not enabled. Pass the track_source => 1 option when loading TrackSIG to enable\n"
65             if not $opt{track_source};
66 0 0         return '' if not @{$self} > 1;
  0            
67 0           return $self->[1]->{$key};
68             }
69              
70             sub dump_all_sources {
71 0     0 1   my $self = shift;
72 0 0         print STDERR "Source tracking not enabled. Pass the track_source => 1 option when loading TrackSIG to enable\n"
73             if not $opt{track_source};
74 0 0         return if not @{$self} > 1;
  0            
75 0           my $sources = $self->[1];
76 0           foreach my $key (keys %$sources) {
77 0           print STDERR "\$SIG{$key} was last set at:\n" . $sources->{$key} . "\n\n";
78             }
79             }
80              
81             1;
82              
83             __END__