File Coverage

blib/lib/Stack/Persistent.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Stack::Persistent;

use 5.008;
use strict;
use warnings;

use File::Spec;
use Cache::FastMmap;

our @ISA = qw();
our $VERSION = '0.04';

# ------------------------------------------------------------------------
# Public Methods
# ------------------------------------------------------------------------

sub new {
    my $proto = shift;
    my %params = @_;
    my $class = ref($proto) || $proto;

    my $self = {};

    $self->{handle} = undef;
    $self->{initialize} = 0;
    $self->{num_pages} = 64;
    $self->{page_size} = "64k";
    $self->{expiration} = 0;
    $self->{cachefile} = File::Spec->catfile('tmp', 'stack-persistent.cache');

    bless($self, $class);

    my ($k, $v);
    local $_;

    if (defined($v = delete $params{'-initialize'})) {

        $self->{initialize} = $v;

    }

    if (defined($v = delete $params{'-pages'})) {

        $self->{num_pages} = $v;

    }

    if (defined($v = delete $params{'-size'})) {

        $self->{page_size} = $v;

    }

    if (defined($v = delete $params{'-expiration'})) {

        $self->{expiration} = $v;

    }

    if (defined($v = delete $params{'-filename'})) {

        $self->{cachefile} = $v;

    }

    $self->{handle} = Cache::FastMmap->new(init_file => $self->{initialize},
                                           num_pages => $self->{num_pages},
                                           page_size => $self->{page_size},
                                           expire_time => $self->{expiration},
                                           share_file => $self->{cachefile},
                                           unlink_on_exit => 0);

    $self->{handle}->purge();

    return $self;

}

sub push {
    my ($self, $stack, $data) = @_;

    my ($ckey, $skey, $counter);

    $skey = $stack . ':counter';
    $counter = $self->{handle}->get($skey) || 0;
    $self->{handle}->remove($skey);

    $counter++;
    $ckey = $stack . ':' . $counter;

    $self->{handle}->set($ckey, $data);
    $self->{handle}->set($skey, $counter);

}

sub pop {
    my ($self, $stack) = @_;

    my ($ckey, $skey, $data, $counter);

    $skey = $stack . ':counter';
    $counter = $self->{handle}->get($skey) || 0;

    $ckey = $stack . ':' . $counter;
    $data = $self->{handle}->get($ckey);

    $self->{handle}->remove($skey);
    $self->{handle}->remove($ckey);

    $counter--;
    $self->{handle}->set($skey, $counter);

    return($data);

}

sub peek {
    my ($self, $stack) = @_;

    my ($ckey, $skey, $data, $counter);

    $skey = $stack . ':counter';
    $counter = $self->{handle}->get($skey) || 0;

    $ckey = $stack . ':' . $counter;
    $data = $self->{handle}->get($ckey);

    return($data);

}

sub items {
    my ($self, $stack) = @_;

    my ($skey, $counter);

    $skey = $stack . ':counter';
    $counter = $self->{handle}->get($skey) || 0;

    return($counter);

}

sub clear {
    my ($self, $stack) = @_;

    my ($skey, $ckey, $counter);

    $skey = $stack . ':counter';
    $counter = $self->{handle}->get($skey) || 0;

    for (; $counter > 0; $counter--) {

        $ckey = $stack . ':' . $counter;
        $self->{handle}->remove($ckey);

    }

    $self->{handle}->set($skey, $counter);

}

sub dump {
    my ($self, $stack) = @_;

    my $item;
    my @items = $self->{handle}->get_keys(2);

    foreach $item (@items) {

        if ($stack eq substr($item->{key}, 0, index($item->{key}, ':'))) {

            printf("key: %s; last_access: %s; expiration: %s; flags: %s\n",
                   $item->{key}, $item->{last_access}, $item->{expire_time},
                   $item->{flags});
            printf("    value: %s\n", $item->{value});

        }

    }

    return 0;

}

sub handle {
    my $self = shift;

    return($self->{handle});

}

1;

__END__