File Coverage

blib/lib/Tie/Array/Expire.pm

Criterion	Covered	Total	%
statement	44	84	52.3
branch	5	16	31.2
condition			n/a
subroutine	10	15	66.6
pod			n/a
total	59	115	51.3

package Tie::Array::Expire;

our $DATE = '2017-06-07'; # DATE
our $VERSION = '0.001'; # VERSION

use 5.010001;
use strict;
use warnings;

use Time::HiRes 'time';

sub TIEARRAY {
    my $class = shift;
    my $expiry = shift;

    die "Please specify a positive expiry time" unless $expiry > 0;
    return bless {
        EXPIRY => $expiry,
        ARRAY => [], # each elem is [val, time]
    }, $class;
}

sub _expire_items {
    my $self = shift;

    my $time = time() - $self->{EXPIRY};
    my $i = 0;
    while (1) {
        last if $i >= @{ $self->{ARRAY} };
        if ($self->{ARRAY}[$i][1] < $time) {
            splice @{ $self->{ARRAY} }, $i, 1;
        } else {
            $i++;
        }
    }
}

sub FETCH {
    my ($self, $index) = @_;
    $self->_expire_items;
    $self->{ARRAY}[$index][0];
}

sub STORE {
    my ($self, $index, $value) = @_;
    $self->_expire_items;
    my $time = time();
    if ($index > @{ $self->{ARRAY} }) {
        for my $i ($#{ $self->{ARRAY} } .. $index-1) {
            $self->{ARRAY}[$i] = [undef, $time];
        }
    }
    $self->{ARRAY}[$index] = [$value, $time];
}

sub FETCHSIZE {
    my $self = shift;
    $self->_expire_items;
    scalar @{ $self->{ARRAY} };
}

sub STORESIZE {
    my ($self, $count) = @_;
    $self->_expire_items;
    my $time = time();
    if ($count > @{ $self->{ARRAY} }) {
        for my $i ($#{ $self->{ARRAY} } .. $count) {
            $self->{ARRAY}[$i] = [undef, $time];
        }
    } elsif ($count < @{ $self->{ARRAY} }) {
        splice @{ $self->{ARRAY} }, $count;
    }
}

# sub EXTEND this, count

# sub EXISTS this, key

# sub DELETE this, key

sub PUSH {
    my $self = shift;
    $self->_expire_items;
    my $time = time();
    push @{ $self->{ARRAY} }, map { [$_, $time] } @_;
}

sub POP {
    my $self = shift;
    $self->_expire_items;
    my $elem = pop @{ $self->{ARRAY} };
    $elem ? $elem->[0] : undef;
}

sub UNSHIFT {
    my $self = shift;
    $self->_expire_items;
    my $time = time();
    unshift @{ $self->{ARRAY} }, map { [$_, $time] } @_;
}

sub SHIFT {
    my $self = shift;
    $self->_expire_items;
    my $elem = shift @{ $self->{ARRAY} };
    $elem ? $elem->[0] : undef;
}

sub SPLICE {
    my $self   = shift;
    my $offset = shift;
    my $length = shift;
    $self->_expire_items;
    my $time = time();

    my @spliced = map { $_->[0] } splice @{ $self->{ARRAY} }, $offset, $length, map { [$_, $time] } @_;
    @spliced;
}

1;
# ABSTRACT: Array with expiring elements

__END__