| Objects-Collection documentation | Contained in the Objects-Collection distribution. |
Objects::Collection::HashUnion - Union hashes.
use Objects::Collection::HashUnion; tie %hashu, 'Objects::Collection::HashUnion', \%hash1, \%hash2;
Handle collections key _changed
Tie::StdHash
Zahatski Aliaksandr, <zag@cpan.org>
Copyright (C) 2005-2006 by Zahatski Aliaksandr
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available.
| Objects-Collection documentation | Contained in the Objects-Collection distribution. |
package Objects::Collection::HashUnion;
use strict; use warnings; use strict; use Carp; use Data::Dumper; require Tie::Hash; use Objects::Collection::Base; @Objects::Collection::HashUnion::ISA = qw(Tie::StdHash Objects::Collection::Base); $Objects::Collection::HashUnion::VERSION = '0.01'; attributes qw( _orig_hashes _for_write __temp_array); sub Init { my ( $self, @hashes ) = @_; $self->_for_write($hashes[ -1 ]); $self->_orig_hashes(\@hashes); return 1; } sub _init { my $self = shift; return $self->Init(@_); } #delete keys only from _for_write hashe! sub DELETE { my ( $self, $key ) = @_; delete $self->_for_write->{ $key }; } sub STORE { my ( $self, $key, $val ) = @_; my $hashes = $self->_orig_hashes; foreach my $hash ( @$hashes) { next unless exists $hash->{$key}; return $hash->{$key} = $val; } $self->_for_write->{ $key } =$val; }
sub _changed { my $self = shift; my $hashes = $self->_orig_hashes; my $res; foreach my $hash ( @$hashes) { $res++ if $hash->{_changed}; } return $res } sub FETCH { my ( $self, $key ) = @_; if ( $key eq '_changed' ) { $self->_changed(); } else { my $hashes = $self->_orig_hashes; foreach my $hash ( @$hashes) { next unless exists $hash->{$key}; return $hash->{$key}; } return } } sub GetKeys { my $self = shift; my $hashes = $self->_orig_hashes; my %uniq; foreach my $hash ( @$hashes) { $uniq{$_}++ for keys %$hash; } return [ keys %uniq ]; } sub TIEHASH {return Objects::Collection::Base::new(@_) } sub FIRSTKEY { my ($self) = @_; $self->__temp_array( [ sort { $a cmp $b } @{ $self->GetKeys() } ] ); shift( @{ $self->__temp_array() } ); } sub NEXTKEY { my ( $self, $key ) = @_; shift( @{ $self->__temp_array() } ); } sub EXISTS { my ( $self, $key ) = @_; my $hashes = $self->_orig_hashes; my %uniq; foreach my $hash ( @$hashes) { $uniq{$_}++ for keys %$hash; } return exists $uniq{$key}; } sub CLEAR { my $self = shift; %{ $self->_for_write } = () } 1; __END__