File Coverage

blib/lib/Collection/Utl/Mirror.pm

Criterion	Covered	Total	%
statement	90	92	97.8
branch	16	22	72.7
condition			n/a
subroutine	14	14	100.0
pod	1	2	50.0
total	121	130	93.0

package Collection::Utl::Mirror;

=head1 NAME

 Collection::Utl::Mirror -  Mirror two collections.

=head1 SYNOPSIS

    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 ;


=head1 DESCRIPTION

Mirror two collections.


=cut

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(@_);
}

=head2 _fetch

Fetch keys from collection1. And then from collection2

=cut

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;
}

=head2 _create

create items

=cut

sub _create {
    my $self = shift;
    my ( $c1, $c2 ) = @{ $self->_stack };
    return $c2->create(@_);
}

=head2 _store

=cut

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;
}

=head2 list_ids

Return  union of keys from collection1 and collection2

=cut

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__