File Coverage

blib/lib/Hash/DefaultValue.pm
Criterion Covered Total %
statement 44 45 97.7
branch 9 10 90.0
condition n/a
subroutine 13 13 100.0
pod n/a
total 66 68 97.0


line stmt bran cond sub pod time code
1             package Hash::DefaultValue;
2              
3 4     4   71909 use 5.006;
  4         14  
  4         131  
4 4     4   16 use strict;
  4         6  
  4         128  
5 4     4   19 use warnings;
  4         10  
  4         93  
6 4     4   2792 use utf8;
  4         35  
  4         19  
7              
8 4     4   3705 use Tie::Hash qw();
  4         3610  
  4         85  
9 4     4   20 use Carp qw(croak);
  4         6  
  4         192  
10              
11             use constant {
12 4         280 IDX_HASH => 0,
13             IDX_CODE => 1,
14             NEXT_IDX => 2,
15 4     4   19 };
  4         12  
16 4     4   19 use constant _default => undef;
  4         5  
  4         173  
17              
18             BEGIN {
19 4     4   18 no warnings 'once';
  4         5  
  4         227  
20 4     4   36 $Hash::DefaultValue::AUTHORITY = 'cpan:TOBYINK';
21 4         6 $Hash::DefaultValue::VERSION = '0.007';
22 4         1018 @Hash::DefaultValue::ISA = qw(Tie::ExtraHash);
23             }
24              
25             sub TIEHASH
26             {
27 5     5   3598 my $class = shift;
28 5 100       40 my $coderef = @_ ? shift : $class->_default;
29              
30 5 100       20 unless (ref $coderef)
31             {
32 2         4 my $value = $coderef;
33 2     4   12 $coderef = sub { $value };
  4         25  
34             }
35            
36 5 50       19 unless (ref $coderef eq 'CODE')
37             {
38 0         0 croak "must provide a coderef or non-reference scalar value for $class";
39             }
40            
41 5         44 $class->SUPER::TIEHASH($coderef)
42             }
43              
44             sub FETCH
45             {
46 12     12   6255 my ($this, $key) = @_;
47 12 100       37 $key = '' unless defined $key;
48            
49 12 100       46 unless (exists $this->[IDX_HASH]{$key})
50             {
51 9         15 local $_ = $key;
52 9         26 return scalar $this->[IDX_CODE]($this->[IDX_HASH], $key);
53             }
54            
55 3         14 $this->[IDX_HASH]{$key}
56             }
57              
58             __PACKAGE__
59             __END__