File Coverage

blib/lib/Objects/Collection/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 Objects::Collection::HashUnion;
2              
3             =head1 NAME
4              
5             Objects::Collection::HashUnion - Union hashes.
6              
7             =head1 SYNOPSIS
8              
9             use Objects::Collection::HashUnion;
10              
11             tie %hashu, 'Objects::Collection::HashUnion', \%hash1, \%hash2;
12              
13             =head1 DESCRIPTION
14              
15            
16            
17             =cut
18              
19 1     1   36731 use strict;
  1         3  
  1         29  
20 1     1   5 use warnings;
  1         2  
  1         22  
21 1     1   3 use strict;
  1         1  
  1         19  
22 1     1   4 use Carp;
  1         1  
  1         46  
23 1     1   4 use Data::Dumper;
  1         2  
  1         43  
24             require Tie::Hash;
25 1     1   411 use Objects::Collection::Base;
  1         2  
  1         612  
26             @Objects::Collection::HashUnion::ISA = qw(Tie::StdHash Objects::Collection::Base);
27             $Objects::Collection::HashUnion::VERSION = '0.01';
28              
29             attributes qw( _orig_hashes _for_write __temp_array);
30              
31              
32             sub Init {
33 1     1 0 3 my ( $self, @hashes ) = @_;
34 1         25 $self->_for_write($hashes[ -1 ]);
35 1         24 $self->_orig_hashes(\@hashes);
36 1         4 return 1;
37             }
38              
39              
40              
41              
42             sub _init {
43 1     1   2 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   452 my ( $self, $key ) = @_;
50 1         32 delete $self->_for_write->{ $key };
51             }
52              
53             sub STORE {
54 2     2   6 my ( $self, $key, $val ) = @_;
55 2         63 my $hashes = $self->_orig_hashes;
56 2         4 foreach my $hash ( @$hashes) {
57 3 100       15 next unless exists $hash->{$key};
58 1         7 return $hash->{$key} = $val;
59             }
60 1         45 $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   4 my $self = shift;
72 2         56 my $hashes = $self->_orig_hashes;
73 2         3 my $res;
74 2         5 foreach my $hash ( @$hashes) {
75 4 100       14 $res++ if $hash->{_changed};
76             }
77 2         8 return $res
78             }
79              
80             sub FETCH {
81 16     16   508 my ( $self, $key ) = @_;
82 16 100       31 if ( $key eq '_changed' ) {
83 2         5 $self->_changed();
84             }
85             else {
86            
87 14         347 my $hashes = $self->_orig_hashes;
88 14         28 foreach my $hash ( @$hashes) {
89 20 100       75 next unless exists $hash->{$key};
90 14         59 return $hash->{$key};
91             }
92             return
93 0         0 }
94             }
95              
96              
97             sub GetKeys {
98 5     5 0 6 my $self = shift;
99 5         142 my $hashes = $self->_orig_hashes;
100 5         8 my %uniq;
101 5         8 foreach my $hash ( @$hashes) {
102 10         41 $uniq{$_}++ for keys %$hash;
103             }
104              
105 5         22 return [ keys %uniq ];
106             }
107              
108              
109 1     1   12 sub TIEHASH {return Objects::Collection::Base::new(@_) }
110              
111             sub FIRSTKEY {
112 5     5   2864 my ($self) = @_;
113 5         8 $self->__temp_array( [ sort { $a cmp $b } @{ $self->GetKeys() } ] );
  19         159  
  5         13  
114 5         12 shift( @{ $self->__temp_array() } );
  5         115  
115             }
116              
117             sub NEXTKEY {
118 17     17   25 my ( $self, $key ) = @_;
119 17         13 shift( @{ $self->__temp_array() } );
  17         387  
120             }
121              
122             sub EXISTS {
123 16     16   181 my ( $self, $key ) = @_;
124 16         423 my $hashes = $self->_orig_hashes;
125 16         20 my %uniq;
126 16         26 foreach my $hash ( @$hashes) {
127 32         114 $uniq{$_}++ for keys %$hash;
128             }
129 16         61 return exists $uniq{$key};
130             }
131              
132             sub CLEAR {
133 1     1   440 my $self = shift;
134 1         3 %{ $self->_for_write } = ()
  1         29  
135             }
136              
137             1;
138             __END__