view release on metacpan or  search on metacpan

lib/Tie/Hash/MinPerfHashTwoLevel/OnDisk.pm  view on Meta::CPAN

my %constants;
BEGIN {
    %constants= (
        MAGIC_STR               =>  "PH2L",
       #MPH_F_FILTER_UNDEF      =>  (1<<0),
       #MPH_F_DETERMINISTIC     =>  (1<<1),
        MPH_F_NO_DEDUPE         =>  (1<<2),
        MPH_F_VALIDATE          =>  (1<<3),
    );
}

use constant \%constants;
use Carp;

our %EXPORT_TAGS = (
    'all' => [ qw(mph2l_tied_hashref mph2l_make_file MAX_VARIANT MIN_VARIANT), sort keys %constants ],
    'flags' => ['MPH_F_DETERMINISTIC', grep /MPH_F_/, sort keys %constants],
    'magic' => [grep /MAGIC/, sort keys %constants],
);

my $scalar_has_slash= scalar(%EXPORT_TAGS)=~m!/!;
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();

sub mph2l_tied_hashref {
    my ($file, %opts)= @_;
    tie my %tied, __PACKAGE__, $file, %opts;
    return \%tied;
}

sub mph2l_make_file {
    my ($file,%opts)= @_;
    return __PACKAGE__->make_file(file => $file, %opts);
}

sub mph2l_validate_file {
    my ($file, %opts)= @_;
    return __PACKAGE__->validate_file(file => $file, %opts);
}

sub new {
    my ($class, %opts)= @_;

    $opts{flags} ||= 0;
    $opts{flags} |= MPH_F_VALIDATE if $opts{validate};
    my $error;
    my $mount= mount_file($opts{file},$error,$opts{flags});
    my $error_rsv= delete $opts{error_rsv};
    if ($error_rsv) {
        $$error_rsv= $error;
    }
    if (!defined($mount)) {
        if ($error_rsv) {
            return;
        } else {
            die "Failed to mount file '$opts{file}': $error";
        }
    }
    $opts{mount}= $mount;
    return bless \%opts, $class;
}

sub TIEHASH {
    my ($class, $file, %opts)= @_;
    return $class->new( file => $file, %opts );
}

sub FETCH {
    my ($self, $key)= @_;
    my $value;
    fetch_by_key($self->{mount},$key,$value)
        or return;
    return $value;
}

sub EXISTS {
    my ($self, $key)= @_;
    return fetch_by_key($self->{mount},$key);
}

sub FIRSTKEY {
    my ($self)= @_;
    $self->{iter_idx}= 0;
    return $self->NEXTKEY();
}

sub NEXTKEY {
    my ($self, $lastkey)= @_;
    fetch_by_index($self->{mount},$self->{iter_idx}++,my $key);
    return $key;
}

sub SCALAR {
    my ($self)= @_;
    my $buckets= $self->get_hdr_num_buckets();
    if ($scalar_has_slash) {
        $buckets .= "/" . $buckets;
    }
    return $buckets;
}

sub UNTIE {
    my ($self)= @_;
}

sub DESTROY {
    my ($self)= @_;
    unmount_file($self->{mount}) if $self->{mount};
}

sub STORE {
    my ($self, $key, $value)= @_;
    confess __PACKAGE__ . " is readonly, STORE operations are not supported";
}

sub DELETE {
    my ($self, $key)= @_;
    confess __PACKAGE__ . " is readonly, DELETE operations are not supported";
}