File Coverage

blib/lib/Tie/Hash/Check.pm
Criterion Covered Total %
statement 61 61 100.0
branch 10 10 100.0
condition n/a
subroutine 14 14 100.0
pod n/a
total 85 85 100.0


line stmt bran cond sub pod time code
1             package Tie::Hash::Check;
2              
3 11     11   118196 use strict;
  11         91  
  11         324  
4 11     11   58 use warnings;
  11         20  
  11         338  
5              
6 11     11   5165 use Error::Pure qw(err);
  11         93670  
  11         232  
7 11     11   659 use Error::Pure::Utils;
  11         27  
  11         7495  
8              
9             our $VERSION = 0.09;
10              
11             # Error level.
12             $Error::Pure::Utils::LEVEL = 5;
13              
14             # Hash create.
15             sub TIEHASH {
16 17     17   22915 my ($class, $hash_hr, $stack_ar) = @_;
17 17 100       81 if (ref $hash_hr ne 'HASH') {
18 1         6 err 'Parameter isn\'t hash.';
19             }
20 16 100       52 if (! $stack_ar) {
21 11         27 $stack_ar = [];
22             }
23 16 100       57 if (ref $stack_ar ne 'ARRAY') {
24 1         5 err 'Stack isn\'t array.';
25             }
26 15         40 my $self = bless {}, $class;
27 15         67 $self->{'data'} = {};
28 15         32 foreach my $key (keys %{$hash_hr}) {
  15         54  
29 21         79 _add_hash_value($self->{'data'}, $key, $hash_hr->{$key},
30             $stack_ar);
31             }
32 15         33 $self->{'stack'} = $stack_ar;
33 15         48 return $self;
34             }
35              
36             # Hash clear.
37             sub CLEAR {
38 1     1   843 my $self = shift;
39 1         4 $self->{'data'} = {};
40 1         2 return;
41             }
42              
43             # Hash delete.
44             sub DELETE {
45 2     2   17671 my ($self, $key) = @_;
46 2         7 delete $self->{'data'}->{$key};
47 2         8 return;
48             }
49              
50             # Hash exists.
51             sub EXISTS {
52 17     17   147 my ($self, $key) = @_;
53 17         56 return exists $self->{'data'}->{$key};
54             }
55              
56             # Hash fetch.
57             sub FETCH {
58 30     30   22050 my ($self, $key) = @_;
59 30 100       104 if (! exists $self->{'data'}->{$key}) {
60 5         27 my @stack = (@{$self->{'stack'}}, $key);
  5         18  
61 5         36 err 'Key \''.join('->', @stack).'\' doesn\'t exist.';
62             }
63 25         83 return $self->{'data'}->{$key};
64             }
65              
66             # Hash first key.
67             sub FIRSTKEY {
68 20     20   8268 my $self = shift;
69              
70             # Resets each.
71 20         33 my $a = scalar keys %{$self->{'data'}};
  20         56  
72              
73 20         33 return each %{$self->{'data'}};
  20         97  
74             }
75              
76             # Hash nextkey.
77             sub NEXTKEY {
78 24     24   2632 my $self= shift;
79 24         94 return each %{$self->{'data'}};
  24         87  
80             }
81              
82             # Hash scalar.
83             sub SCALAR {
84 1     1   9 my $self = shift;
85 1         1 return scalar %{$self->{'data'}};
  1         5  
86             }
87              
88             # Hash store.
89             sub STORE {
90 2     2   3284 my ($self, $key, $value) = @_;
91 2         9 _add_hash_value($self->{'data'}, $key, $value, $self->{'stack'});
92 2         33 return;
93             }
94              
95             # Add hash value to storage.
96             sub _add_hash_value {
97 23     23   57 my ($hash_hr, $key, $value, $stack_ar) = @_;
98 23 100       68 if (ref $value eq 'HASH') {
99             tie my %tmp, 'Tie::Hash::Check', $value,
100 4         9 [@{$stack_ar}, $key];
  4         24  
101 4         12 $hash_hr->{$key} = \%tmp;
102             } else {
103 19         54 $hash_hr->{$key} = $value;
104             }
105 23         52 return;
106             }
107              
108             1;
109              
110             __END__