File Coverage

blib/lib/Acme/Signum.pm
Criterion Covered Total %
statement 20 42 47.6
branch 0 6 0.0
condition 2 3 66.6
subroutine 6 16 37.5
pod n/a
total 28 67 41.7


line stmt bran cond sub pod time code
1             package Acme::Signum;
2              
3 1     1   22707 use strict;
  1         2  
  1         34  
4 1     1   5 use warnings;
  1         2  
  1         28  
5 1     1   5 use vars qw/@SIG %signum @signame/;
  1         5  
  1         62  
6 1     1   5 use Config;
  1         1  
  1         439  
7              
8             require Exporter;
9              
10             our @ISA = qw(Exporter);
11              
12             our @EXPORT = qw(
13             @SIG
14             );
15              
16             our $VERSION = '0.01';
17              
18              
19             sub import {
20 1     1   10 tie @SIG => __PACKAGE__;
21 1         801 my @names = split ' ', $Config{sig_name};
22 1         3170 @signum{@names} = split ' ', $Config{sig_num};
23 1         121 foreach (@names) {
24 69   66     299 $signame[$signum{$_}]||=$_;
25             }
26             }
27              
28             sub _signame {
29 0     0   0 $signame[$_[0]];
30             }
31              
32             sub TIEARRAY {
33 1     1   2 my $cls = shift;
34 1         3 my $d = undef;
35 1         4 bless \$d => $cls;
36             }
37              
38             sub FETCH {
39 0     0     my $i = pop;
40 0           my $name = _signame($i);
41 0 0         unless ($name) { return }
  0            
42 0           return $SIG{$name};
43             }
44              
45             sub STORE {
46 0     0     my ($val, $i) = (pop,pop);
47 0           my $name = _signame($i);
48 0 0         unless ($name) { return }
  0            
49 0           $SIG{$name} = $val;
50             }
51              
52             sub FETCHSIZE {
53 0     0     scalar @signame;
54             }
55              
56 0     0     sub STORESIZE { undef }
57              
58 0     0     sub EXTEND { undef }
59              
60             sub EXISTS {
61 0     0     my $i = pop;
62 0           my $name = _signame($i);
63 0 0         unless ($name) { return 0 }
  0            
64 0           return exists $SIG{$name};
65             }
66              
67 0     0     sub PUSH { undef }
68              
69 0     0     sub CLEAR { undef }
70              
71 0     0     sub DELETE { undef }
72              
73             1;
74             __END__