File Coverage

blib/lib/Cache/Scalar/WithExpiry.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	11	12	91.6
condition	7	9	77.7
subroutine	13	13	100.0
pod	6	6	100.0
total	85	88	96.5

package Cache::Scalar::WithExpiry;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.01";

use Carp ();
use Time::HiRes;

use parent 'Exporter';
our @EXPORT = qw/cache_with_expiry/;

use constant {
    TIME  => 0,
    VALUE => 1,
};

sub new {
    my ($class) = @_;
    bless [undef, undef], $class;
}

sub get {
    my ($self) = @_;

    if (defined $self->[TIME] && $self->[TIME] <= Time::HiRes::time()) {
        undef $self->[VALUE];
        undef $self->[TIME];
    }
    wantarray ? ($self->[VALUE], $self->[TIME]) : $self->[VALUE];
}

sub get_or_set {
    my ($self, $code) = @_;

    if (defined $self->get) {
        return wantarray ? ($self->[VALUE], $self->[TIME]) : $self->[VALUE];
    }
    else {
        my ($val, $expiry) = $code->();
        return $self->set($val, $expiry);
    }
}

sub set {
    my ($self, $val, $expiry) = @_;

    if (!$expiry || $expiry <= 0) {
        Carp::carp 'Expiry time is required. Value is not to be cached.';
        undef $expiry;
        undef $self->[VALUE];
        undef $self->[TIME];
    }
    else {
        $self->[TIME]  = $expiry;
        $self->[VALUE] = $val;
    }
    wantarray ? ($val, $expiry) : $val;
}

sub delete :method {
    my ($self) = @_;
    undef $self->[VALUE];
    return undef;
}

{
    my %_obj;
    sub cache_with_expiry(&) {
        my $code = shift;
        my $obj = $_obj{$code+0} ||= __PACKAGE__->new;
        $obj->get_or_set($code);
    }
}

1;
__END__