The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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__

=head1 NAME

Stack::Persistent - A persistent stack

=head1 SYNOPSIS

This module implements a named, persistent stack for usage by programs that 
need to recover the items on a  stack when something unexpected happens.
The stack is LIFO based.

=head1 DESCRIPTION

This module can be used as follows:

 use Stack::Persistent;

 $stack = Stack::Persistent->new();

 $stack->push('default', 'some really cool stuff');
 printf("There are %s items on the stack\n", $stack->items('default'));
 printf("My data is: %s\n", $stack->pop('default'));

The main purpose of this module was to have a persistent stack that 
could survive the restart of a program. Multiple, named stacks can be 
maintained. 

=head1 METHODS

=over 4

=item new

There are several named parameters that can be used with this method. Since
this module use Cache::FastMmap to manage the backing store. You should read 
that modules documentation. They are the following:

=over 4

=item -initialize

This initializes the stacks backing cache. You will not want to do this if 
your program needs to retireve items after a restart. The default is to not
initialize.

=item -pages

What the number of pages for your stacks backing cache should be. The 
default is 64.

=item -size

The size of those pages in bytes. The default is 64KB.

=item -expiration

The expiration of item with the stacks cache.

=item -filename

The name of the file that is being used. The default is 
/tmp/stack-persistent.cache.

=item Example

 $stack = Stack::Persistent->new(-filename => '/tmp/stack.cache');

=back

=item push

Push a data element onto the  named stack. 

=over 4

=item Example

 $stack->push('default', $data);

=back

=item pop

Remove a data element from the top of a named stack. Once an element has
been "popped" it is no longer avaiable within the cache.

=over 4

=item Example

 $data = $stack->pop('default');

=back

=item peek

Retrieve the data element from the top of the stack. The data element is not 
removed from the stack. To remove an element, you need to use pop().

=over 4

=item Example

 $data = $stack->peek('default');

=back

=item items

Return the number of data elements that are currently on the stack.

=over 4

=item Example

 $items1 = $stack->items('default');
 $items2 = $stack->items('worker');

=back

=item clear

Remove all data elements from the stack. Once a stack has
been "cleared" there are no data elements left within the cache.

=over 4

=item Example

 $stack->clear('default');

=back

=item dump

Dump all the backing cache for the stack. This is can be used for debugging 
purposes.

=over 4

=item Example

 $stack->dump('default');

=back

=head1 ACCESSORS

=over 4

=item handle

This accessor returns the underling handle for Cache::FastMmap. You can then
use any of methods that are available to that module.

=over 4

=item Example

 $handle = $stack->handle;
 $handle->purge();

=back

=head1 EXPORT

None by default.

=head1 SEE ALSO

 Cache::FastMmap

=head1 AUTHOR

Kevin L. Esteb, E<lt>kesteb@wsipc.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Kevin L. Esteb

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.

=cut