view release on metacpan or  search on metacpan

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

    $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);
    $db->del($me->{name}, 'meta', $vk);

    return $cshard;
}

################################################################

sub range {
    my $me    = shift;
    my $start = shift;
    my $end   = shift;

    my $db = $me->{db};
    return $db->range($me->{name}, 'vers', $start, $end);
}

################################################################

sub get_internal {
    my $me  = shift;
    my $key = shift;

    my($d, $found) = $me->{db}->get($me->{name}, 'internal', $key);
    return $d;
}

sub set_internal {
    my $me  = shift;
    my $key = shift;
    my $val = shift;

    $me->{db}->put($me->{name}, 'internal', $key, $val);
}

################################################################

sub expire {
    my $me     = shift;
    my $expire = shift;

    debug("expiring $me->{name}");

    my $db = $me->{db};

    # walk merkle tree, find all k/v to remove
    my @delete;

    my @walk = { level => 0, version => 0, shard => 0 };
    while(@walk){
        my @next;
        for my $node (@walk){
            my $res = $me->get_merkle( $node->{shard}, $node->{version}, $node->{level} );

            for my $r (@$res){
                next if $r->{version} > $expire;
                if( $r->{key} ){
                    push @delete, { key => $r->{key}, version => $r->{version}, shard => $r->{shard} };
                }else{
                    push @next, $r;
                }
            }
        }
        @walk = @next;
    }

    # remove k/v
    for my $r (@delete){
        debug("expiring $r->{key}/$r->{version}");
        $me->_remove( $r->{key}, $r->{version} );
    }

    # update merkle
    $me->merkle(undef, @delete);