File Coverage

blib/lib/Collection/Utl/HashUnion.pm
Criterion Covered Total %
statement 70 71 98.5
branch 8 8 100.0
condition n/a
subroutine 18 18 100.0
pod 0 2 0.0
total 96 99 96.9


line stmt bran cond sub pod time code
1             package Collection::Utl::HashUnion;
2              
3             =head1 NAME
4              
5             Collection::Utl::HashUnion - Union hashes.
6              
7             =head1 SYNOPSIS
8              
9             use Collection::Utl::HashUnion;
10              
11             tie %hashu, 'Collection::Utl::HashUnion', \%hash1, \%hash2;
12              
13             =head1 DESCRIPTION
14              
15            
16            
17             =cut
18              
19 1     1   50805 use strict;
  1         3  
  1         43  
20 1     1   7 use warnings;
  1         1  
  1         37  
21 1     1   5 use strict;
  1         2  
  1         22  
22 1     1   5 use Carp;
  1         1  
  1         63  
23 1     1   6 use Data::Dumper;
  1         2  
  1         64  
24             require Tie::Hash;
25 1     1   596 use Collection::Utl::Base;
  1         2  
  1         738  
26             @Collection::Utl::HashUnion::ISA = qw(Tie::StdHash Collection::Utl::Base);
27             $Collection::Utl::HashUnion::VERSION = '0.01';
28              
29             attributes qw( _orig_hashes _for_write __temp_array);
30              
31              
32             sub Init {
33 1     1 0 2 my ( $self, @hashes ) = @_;
34 1         23 $self->_for_write($hashes[ -1 ]);
35 1         21 $self->_orig_hashes(\@hashes);
36 1         4 return 1;
37             }
38              
39              
40              
41              
42             sub _init {
43 1     1   1 my $self = shift;
44 1         4 return $self->Init(@_);
45             }
46              
47             #delete keys only from _for_write hashe!
48             sub DELETE {
49 1     1   738 my ( $self, $key ) = @_;
50 1         29 delete $self->_for_write->{ $key };
51             }
52              
53             sub STORE {
54 2     2   6 my ( $self, $key, $val ) = @_;
55 2         65 my $hashes = $self->_orig_hashes;
56 2         8 foreach my $hash ( @$hashes) {
57 3 100       14 next unless exists $hash->{$key};
58 1         8 return $hash->{$key} = $val;
59             }
60 1         30 $self->_for_write->{ $key } =$val;
61            
62             }
63              
64             =head2 _changed
65              
66             Handle collections key _changed
67              
68             =cut
69              
70             sub _changed {
71 2     2   5 my $self = shift;
72 2         63 my $hashes = $self->_orig_hashes;
73 2         3 my $res;
74 2         6 foreach my $hash ( @$hashes) {
75 4 100       16 $res++ if $hash->{_changed};
76             }
77 2         13 return $res
78             }
79              
80             sub FETCH {
81 16     16   516 my ( $self, $key ) = @_;
82 16 100       40 if ( $key eq '_changed' ) {
83 2         16 $self->_changed();
84             }
85             else {
86            
87 14         421 my $hashes = $self->_orig_hashes;
88 14         28 foreach my $hash ( @$hashes) {
89 20 100       77 next unless exists $hash->{$key};
90 14         64 return $hash->{$key};
91             }
92             return
93 0         0 }
94             }
95              
96              
97             sub GetKeys {
98 5     5 0 8 my $self = shift;
99 5         143 my $hashes = $self->_orig_hashes;
100 5         8 my %uniq;
101 5         12 foreach my $hash ( @$hashes) {
102 10         46 $uniq{$_}++ for keys %$hash;
103             }
104              
105 5         33 return [ keys %uniq ];
106             }
107              
108              
109 1     1   15 sub TIEHASH {return Collection::Utl::Base::new(@_) }
110              
111             sub FIRSTKEY {
112 5     5   3176 my ($self) = @_;
113 5         8 $self->__temp_array( [ sort { $a cmp $b } @{ $self->GetKeys() } ] );
  15         269  
  5         15  
114 5         12 shift( @{ $self->__temp_array() } );
  5         120  
115             }
116              
117             sub NEXTKEY {
118 17     17   27 my ( $self, $key ) = @_;
119 17         21 shift( @{ $self->__temp_array() } );
  17         418  
120             }
121              
122             sub EXISTS {
123 16     16   236 my ( $self, $key ) = @_;
124 16         414 my $hashes = $self->_orig_hashes;
125 16         25 my %uniq;
126 16         27 foreach my $hash ( @$hashes) {
127 32         148 $uniq{$_}++ for keys %$hash;
128             }
129 16         81 return exists $uniq{$key};
130             }
131              
132             sub CLEAR {
133 1     1   492 my $self = shift;
134 1         2 %{ $self->_for_write } = ()
  1         32  
135             }
136              
137             1;
138             __END__