view release on metacpan or  search on metacpan

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

# -*- perl -*-

# Copyright (c) 2009 AdCopy
# Author: Jeff Weisberg
# Created: 2009-Mar-30 19:21 (EDT)
# Function: storage maps
#
# $Id$

package AC::Yenta::Store::Map;
use AC::Yenta::Store::File;
use AC::Yenta::Store::Merkle;
use AC::Yenta::Debug 'map';
use AC::Yenta::Conf;
use AC::Cache;
use strict;

our @ISA = 'AC::Yenta::Store::Merkle';

my $DEFAULT = 'bdb';
my %BACKEND ;
my $CACHESIZE = 1024;	# gives us ~90% cache hit rate


sub add_backend {
    my $class = shift;
    my $name  = shift;
    my $impl  = shift;

    $BACKEND{$name} = $impl;
}

sub new {
    my $class = shift;
    my $name  = shift;
    my $bkend = shift;
    my $conf  = shift;

    unless( $bkend ){
        # from extension, or default
        my($ext) = $conf->{dbfile} =~ /\.(.+)$/;
        $bkend = $ext if $BACKEND{$ext};
    }

    my $c  = $BACKEND{$bkend || $DEFAULT};
    unless( $c ){
        problem("invalid storage backend: $bkend - ignoring map");
        return ;
    }

    debug("configuring map $name with $c");

    my $db = $c->new( $name, $conf );
    my $fs = AC::Yenta::Store::File->new( $name, $conf );

    my $me = bless {
        name		=> $name,
        conf		=> $conf,
        db		=> $db,
        fs		=> $fs,
        merkle_height	=> 16,
        vers_cache	=> AC::Cache->new( $CACHESIZE ),
    }, $class;

    $me->merkle_init();

    return $me;
}

my($cachechk, $cachemiss, $cacheT);
sub _versget {
    my $me  = shift;
    my $key = shift;

    $cachechk ++;
    my $d = $me->{vers_cache}->fetch( $key );
    return @$d if $d;

    $cachemiss ++;
    my $db = $me->{db};
    my($versions, $foundver) = $db->get($me->{name}, 'vers', $key);
    my @d = split /\s+/, $versions;
    $me->{vers_cache}->store( $key, \@d );
    return @d;
}

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

    my $db = $me->{db};
    $db->put($me->{name}, 'vers', $key, join(' ', @_));
    $me->{vers_cache}->store( $key, \@_ );
}

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

    $me->{vers_cache}->remove( $key );
}

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

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

    my @versions = $me->_versget( $key );
    return unless @versions;
    debug("found ver: @versions");

    if( $ver ){
        $ver = encode_version($ver);
        return unless grep { $_ eq $ver } @versions;