File Coverage

blib/lib/Tie/Senna.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

# $Id: Senna.pm 2 2005-11-15 15:43:07Z daisuke $
#
# Copyright (c) 2005 Daisuke Maki
# All rights reserved.

package Tie::Senna;
use strict;
use base qw(Tie::Hash);
use Senna;
our $VERSION = '0.02';

sub TIEHASH
{
    my $class = shift;
    my %args  = @_;
    my $index = $args{index};
    my $storage = $args{storage};

    # If not storage given, use a plain hash (all in memory)
    if (!$storage) {
        warn "no storage given, using in-memory hash (all data will be lost when program exits)";
        $storage = {};
    }

    if (ref($storage) ne 'HASH') {
        Carp::croak("storage must be a hash!");
    }

    bless {
        index => $index,
        storage => $storage,
    }, $class;
}

sub index { shift->{index} }
sub storage { shift->{storage} }

sub search
{
    my $self = shift;
    my $query = shift;

    my $c = $self->{index}->search($query);
    return wantarray ? $c->as_list : $c;
}

sub STORE
{
    my $self = shift;
    my $key  = shift;
    my $val  = shift;

    if ($self->EXISTS($key)) {
        $self->{index}->replace($key,
            delete $self->{storage}->{$key},
            $val);
    } else {
        $self->{index}->put($key, $val);
    }
    $self->{storage}->{$key} = $val;
}

sub DELETE
{
    my $self = shift;
    my $key  = shift;
    $self->{index}->del($key, $self->{storage}->{$key});
    delete $self->{storage}->{$key};
}

sub EXISTS
{
    my $self = shift;
    my $key  = shift;
    return exists $self->{storage}->{$key};
}

sub FIRSTKEY
{
    my $self = shift;
    my $storage = $self->{storage};
    if (my $tied = tied(%$storage)) {
        return $tied->FIRSTKEY(@_);
    } else {
        my $a = scalar keys %{$storage};
        return each %{$_[0]};
    }
}

sub NEXTKEY
{
    my $self = shift;
    my $storage = $self->{storage};
    if (my $tied = tied(%$storage)) {
        return $tied->NEXTKEY(@_);
    } else {
        my $a = scalar keys %{$storage};
        return each %{$_[0]};
    }
}

sub CLEAR
{
    my $self = shift;

    my @args = (
        $self->{index}->filename,
        $self->{index}->key_size,
        $self->{index}->flags,
        $self->{index}->initial_n_segments,
        $self->{index}->encoding,
    );
    $self->{index}->remove;
    $self->{index}->create(@args);

    if (my $tied = tied(%{$self->{storage}})) {
        $tied->CLEAR(@_);
    } else {
        %{$self->{storage}} = ();
    }
}

1;

__END__