File Coverage

blib/lib/Tie/Scalar/Timeout.pm

Criterion	Covered	Total	%
statement	38	46	82.6
branch	10	14	71.4
condition	5	5	100.0
subroutine	10	10	100.0
pod			n/a
total	63	75	84.0

use 5.008;
use strict;
use warnings;

package Tie::Scalar::Timeout;
BEGIN {
  $Tie::Scalar::Timeout::VERSION = '2.101420';
}
# ABSTRACT: Scalar variables that time out
use parent 'Tie::Scalar';
use Time::Local;

sub TIESCALAR {
    my $class = shift;
    my $self  = {
        VALUE    => undef,
        EXPIRES  => '+1d',
        POLICY   => undef,
        NUM_USES => -1,
        @_,
    };
    $self->{EXPIRY_TIME}   = _expire_calc($self->{EXPIRES});
    $self->{NUM_USES_ORIG} = $self->{NUM_USES};
    return bless $self, $class;
}

sub FETCH {
    my $self = shift;

    # if num_uses isn't set or set to a negative value, it won't
    # influence the expiration process
    if (   ($self->{NUM_USES} == 0)
        || (time >= $self->{EXPIRY_TIME})) {

        # policy can be a coderef or a plain value
        return &{ $self->{POLICY} } if ref($self->{POLICY}) eq 'CODE';
        return $self->{POLICY};
    }
    $self->{NUM_USES}-- if $self->{NUM_USES} > 0;
    return $self->{VALUE};
}

sub STORE {
    my $self = shift;
    $self->{VALUE} = shift;

    # reset expiration time and number of uses
    $self->{EXPIRY_TIME} = _expire_calc($self->{EXPIRES});
    $self->{NUM_USES}    = $self->{NUM_USES_ORIG};
}

# This routine was nicked and adapted from CGI.pm. It should probably go
# into a separate module.  This internal routine creates an expires time
# exactly some number of hours from the current time.  It incorporates
# modifications from Mark Fisher.
sub _expire_calc {
    my $time = shift;
    my %mult = (
        's' => 1,
        'm' => 60,
        'h' => 60 * 60,
        'd' => 60 * 60 * 24,
        'M' => 60 * 60 * 24 * 30,
        'y' => 60 * 60 * 24 * 365
    );

    # format for time can be in any of the forms...
    # "now" -- expire immediately
    # "+180s" -- in 180 seconds
    # "+2m" -- in 2 minutes
    # "+12h" -- in 12 hours
    # "+1d"  -- in 1 day
    # "+3M"  -- in 3 months
    # "+2y"  -- in 2 years
    # "-3m"  -- 3 minutes ago(!)
    # If you don't supply one of these forms, we assume you are
    # specifying the date yourself
    my $offset;

    # if (!$time || (lc($time) eq 'now')) {
    if (lc($time) eq 'now') {
        $offset = 0;
    } elsif ($time =~ /^(\d\d?)-(\w{3})-(\d{4}) (\d\d?):(\d\d?):(\d\d?)/) {
        require Time::Local;    # don't use unless necessary
        my ($mday, $monthname, $year, $hours, $min, $sec) =
          ($1, $2, $3, $4, $5, $6);
        my $month = {
            jan => 0,
            feb => 1,
            mar => 2,
            apr => 3,
            may => 4,
            jun => 5,
            jul => 6,
            aug => 7,
            sep => 8,
            oct => 9,
            nov => 10,
            dec => 11,
        }->{ lc $monthname };
        $year -= 1900;
        return Time::Local::timelocal_nocheck($sec, $min, $hours, $mday, $month,
            $year);
    } elsif ($time =~ /^\d+/) {
        return $time;
    } elsif ($time =~ /^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
        $offset = ($mult{$2} || 1) * $1;
    } else {
        return $time;
    }
    return time + $offset;
}
1;


__END__