| Collection documentation | Contained in the Collection distribution. |
Collection::Utl::Mirror - Mirror two collections.
use Collection::Utl::Mirror;
my $coll1 = ( new Collection::Utl::Mem:: mem => \%h1 );# fast but nonstable source ( Memcached )
my $coll2 = ( new Collection::Utl::Mem:: mem => \%h2 );# slow but stable source ( database )
my $mirror_coll1 = new Collection::Utl::Mirror:: $coll1, $coll2 ;
Mirror two collections.
Fetch keys from collection1. And then from collection2
create items
Return union of keys from collection1 and collection2
Tie::StdHash
Zahatski Aliaksandr, <zag@cpan.org>
Copyright (C) 2005-2009 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.
| Collection documentation | Contained in the Collection distribution. |
package Collection::Utl::Mirror;
use strict; use warnings; use strict; use Carp; use Data::Dumper; use Test::More; require Tie::Hash; use Collection; @Collection::Utl::Mirror::ISA = qw(Collection); $Collection::Utl::Mirror::VERSION = '0.02'; __PACKAGE__->attributes qw( _c1 _c2 _stack); sub Init { my ( $self, $c1, $c2 ) = @_; _c1 $self $c1; _c2 $self $c2; $self->_stack( [ $c1, $c2 ] ); return 1; } sub _init { my $self = shift; $self->SUPER::_init(@_); return $self->Init(@_); }
sub _fetch { my $self = shift; #collect ids to fetch my @ids = @_; return {} unless @ids; #skip empty ids list my ( $c1, $c2 ) = @{ $self->_stack }; #read keys from first collection my $res1 = $c1->fetch(@ids); my @notfound = (); foreach my $key (@ids) { push @notfound, $key unless exists $res1->{$key}; } if (@notfound) { #if we not found some keys, then fetch from coll2 #and store to coll1 # diag "Fetch non exists in col1".Dumper (\@notfound); my $res2 = $c2->fetch(@notfound); my %create_keys = (); while ( my( $k1, $value ) = each %$res2 ) { #save results from $c2 storage in #out put results $res1->{$k1} = $value; #save for create $create_keys{$k1} = $value; } if ( keys %create_keys ) { # diag "create". Dumper (\%create_keys); #store only simply results #now store to coll1 my $created = $c1->create( %create_keys ); #if suss create use records from fast source while ( my ( $key, $val) = each %create_keys ) { #if fail create record in fast src #use record from stable next unless exists $created->{$key}; $res1->{$key} = $created->{$key}; } } } # diag "try " . Dumper( \@_ ); # diag "Diff two keys" . Dumper [ \@keys1, \@keys2 ]; return $res1; }
sub _create { my $self = shift; my ( $c1, $c2 ) = @{ $self->_stack }; return $c2->create(@_); }
sub _store { my $self = shift; my ( $c1, $c2 ) = @{ $self->_stack }; my $hash2store = shift; my @ids2store = keys %$hash2store; my $coll2res = $c2->fetch(@ids2store); #and create new in col2 #create non exists keys on c2 my %tocreate = (); while ( my ( $key, $val ) = each %$hash2store ) { if ( exists $coll2res->{$key} ) { my $value = $coll2res->{$key}; #mirror only HASHes if ( ref($val) eq 'HASH' ) { #use value as hash %$value = %$val; } elsif ( UNIVERSAL::isa( $val, 'Collection::Utl::Item' ) ) { %$value = %{$val->attr} } } else { #warn "resync source collections"; #syncing stable $tocreate{$key} = $val; } } if ( keys %tocreate ) { $c2->create( \%tocreate ); } #now mirroring changed data #mirror coll1 to coll2 while ( my ( $key, $val ) = each %$hash2store ) { next unless exists $coll2res->{$key}; } # changed items we also mirror to coll2 $c1->store(@ids2store); $c2->store(@ids2store); return; }
sub list_ids { my $self = shift; my ( $c1, $c2 ) = @{ $self->_stack }; my %uniq = (); @uniq{ @{ $c1->list_ids }, @{ $c2->list_ids } } = (); return [ keys %uniq ]; } sub _delete { my $self = shift; my ( $c1, $c2 ) = @{ $self->_stack }; my %res = (); for ( $c1, $c2 ) { #save results @res{ @{ $_->delete(@_) || [] } } = (); } [ keys %res ]; } 1; __END__