view release on metacpan or  search on metacpan

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

my $CACHESIZE = 256;

sub merkle_init {
    my $me = shift;

    $me->{merkle_cache} = AC::Cache->new( $CACHESIZE );
}

my($cachechk, $cachemiss, $cacheT);

sub _mcget {
    my $me = shift;
    my $mk = shift;

    $cachechk++;
    my $d = $me->{merkle_cache}->fetch( $mk );
    return $d if $d;
    $cachemiss ++;

    my $db = $me->{db};
    return $db->get($me->{name}, 'merkle', $mk);
}

sub _mcput {
    my $me = shift;
    my $mk = shift;
    my $d  = shift;

    my $db = $me->{db};
    $db->put($me->{name}, 'merkle', $mk, $d);
    $me->{merkle_cache}->store( $mk, $d );
}

sub _mcdel {
    my $me = shift;
    my $mk = shift;

    my $db = $me->{db};
    $db->del($me->{name}, 'merkle', $mk);
    $me->{merkle_cache}->remove( $mk );

}

sub get_merkle {
    my $me    = shift;
    my $shard = shift;
    my $ver   = shift;
    my $lev   = shift;

    return if $lev > $me->{merkle_height};

    my $db = $me->{db};
    my $mk = $me->_mkey(encode_shard($shard), encode_version($ver), $lev);
    debug("getting merkle for $mk");

    my $d = $me->_mcget( $mk );
    return unless $d;
    my @d = split /\0/, $d;

    my @res;

    if( $^T - $cacheT > 60 ){
        debug("merk cache stats: check: $cachechk, miss: $cachemiss") if $cachechk > 1;
        $cacheT = $^T;
    }

    if( $lev == $me->{merkle_height} ){
        # data is: lkey, ...
        for my $r (@d){
            my($s,$v,$k) = $me->_decode_lkey($r);
            push @res, { version => decode_version($v), key => $k, count => 1, shard => decode_shard($s) };
        }
    }else{
        # data is: mkey => hash count, ...
        my %d = @d;
        for my $lv (keys %d){
            my($l, $s, $v) = $me->_decode_mkey( $lv );
            my($h,$c)  = split /\s/, $d{$lv};
            push @res, { version => decode_version($v), level => hex($l), hash => $h, count => $c, shard => decode_shard($s) };
        }
    }

    return \@res;
}

################################################################
# we maintain a 16-ary merkle tree of all of the <key,version>s we have stored

sub merkle {
    my $me    = shift;
    my $add   = shift;
    my @del   = @_;

    # update leaf nodes
    my %todo;
    for my $rm (@del){
        my($ns,$nv,$h,$c) = $me->_merkle_leaf_del(encode_shard($rm->{shard}), $rm->{key}, encode_version($rm->{version}));
        $todo{"$ns $nv"} = { ver => $nv, hash => $h, count => $c, shard => $ns };
    }
    if( defined $add ){
        my($ns,$nv,$h,$c) = $me->_merkle_leaf_add(encode_shard($add->{shard}), $add->{key}, encode_version($add->{version}));
        $todo{"$ns $nv"} = { ver => $nv, hash => $h, count => $c, shard => $ns };
    }

    # update upper levels
    my $level = $me->{merkle_height};

    while($level >= 0 && keys %todo){
        my %next = %todo;
        %todo = ();

        for my $hd (values %next){
            # update level - 1 with hash
            # put level-1 hash into todo
            my($ns, $nv, $h, $c) = $me->_merkle_update( $hd->{shard}, $level, $hd->{ver}, $hd->{hash}, $hd->{count} );
            $todo{"$ns $nv"} = { ver => $nv, hash => $h, count => $c, shard => $ns } if defined $nv;
        }
        $level --;
    }
}

# non-leaf node:
#  list of (ver => hash+count)
#  of up to 16 next-level-down vers
#  \0 delimited, sorted by ver

# update merkle node
sub _merkle_update {
    my $me    = shift;
    my $shard = shift;
    my $lev   = shift;
    my $ver   = shift;
    my $hash  = shift;
    my $count = shift;

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

    my $k0 = $me->_mkey($shard, $ver, $lev);
    my $k1 = $me->_mkey($shard, $ver, $lev - 1);

    my(undef, $nextshard, $nextver) = $me->_decode_mkey($k1);

    unless( $lev ){