view release on metacpan or  search on metacpan

lib/AC/Yenta/Store/Map.pm  view on Meta::CPAN

    # I have room for it?
    return 1 if @versions < $cf->{history};

    # I can make room for it?
    return 1 if $v gt $versions[-1];

    # I'll just throw it away.
    return;
}

sub put {
    my $me    = shift;
    my $shard = shift;
    my $key   = shift;
    my $ver   = shift;
    my $data  = shift;
    my $file  = shift;	# reference
    my $meta  = shift;

    my $cf = $me->{conf};
    my $db = $me->{db};
    my $v  = encode_version($ver);
    my $vk = $me->vkey($key, $v);

    debug("storing $vk");

    # get version history
    my @deletehist;
    my %deletedata;
    my @versions = $me->_versget( $key );

    return if grep { $_ eq $v } @versions;	# dupe!

    # is this the newest version? should we save this data?
    if( !@versions || ($v gt $versions[0]) || $cf->{keepold} ){

        # save file; data is filename
        if( $file ){
            my $r = $me->{fs}->put($data, $file);
            return unless $r;
        }
        # put meta + data
        $db->put($me->{name}, 'meta', $vk, $meta) if length $meta;
        $db->put($me->{name}, 'data', $vk, $data);

        unless( $cf->{keepold} ){
            # unless we are keeping old data, remove previous version
            $deletedata{$versions[0]} = 1 if @versions;
        }
    }

    # add new version to list. newest 1st
    @versions = sort {$b cmp $a} (@versions, $v);
    if( $cf->{history} && @versions > $cf->{history} ){
        # trim list
        my @rm = splice @versions, $cf->{history}, @versions, ();
        push @deletehist, (map { ({version => decode_version($_), key => $key, shard => $shard}) } @rm);
        $deletedata{$_} = 1 for @_;
    }
    if( $me->is_sharded() ){
        # QQQ - shard changed?
        $db->put($me->{name}, 'shard', $key, encode_shard($shard || 0));
    }

    my $dd = join(' ', map { $_->{version} } @deletehist);
    debug("version list: @versions [delete: $dd]");

    $me->_versput( $key, @versions );

    # update merkles
    $me->merkle( { shard => $shard, key => $key, version => $ver }, @deletehist);

    # delete old data
    for my $rm (keys %deletedata){
        debug("removing old version $key/$rm");
        my $rmvk = $me->vkey($key, $rm);
        $db->del($me->{name}, 'data', $rmvk);
        $db->del($me->{name}, 'meta', $rmvk);
    }

    $db->sync();

    return 1;
}

sub remove {
    my $me  = shift;
    my $key = shift;
    my $ver = shift;

    my $shard = $me->_remove( $key, $ver );
    $me->merkle( undef, { shard => decode_shard($shard), key => $key, version => $ver } );
    $me->{db}->sync();

    return 1;
}

# NB: does not update merkle tree
sub _remove {
    my $me  = shift;
    my $key = shift;
    my $ver = shift;

    my $db = $me->{db};
    my $v  = encode_version($ver);

    my $cshard   = $db->get($me->{name}, 'shard', $key);
    my @versions = grep { $_ ne $v } $me->_versget( $key );

    debug("new ver list: @versions");

    if( @versions ){
        $me->_versput( $key, @versions );
    }else{
        $db->del($me->{name}, 'vers',  $key);
        $db->del($me->{name}, 'shard', $key);
        $me->_versdel( $key );
    }

    my $vk = $me->vkey($key, $ver);
    $db->del($me->{name}, 'data', $vk);