File Coverage

blib/lib/HTML/Mason/Cache/BaseCache.pm

Criterion	Covered	Total	%
statement	34	35	97.1
branch	16	20	80.0
condition	1	3	33.3
subroutine	5	5	100.0
pod	3	3	100.0
total	59	66	89.3

# Copyright (c) 1998-2005 by Jonathan Swartz. All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

package HTML::Mason::Cache::BaseCache;
$HTML::Mason::Cache::BaseCache::VERSION = '1.60';
use strict;
use warnings;

#
# Override to handle busy_lock and expire_if.
#
sub get
{
    my ($self, $key, %params) = @_;
    die "must specify key" unless defined($key);

    foreach my $param (keys(%params)) {
        unless ($param =~ /^(busy_lock|expire_if)$/) {
            die "unknown param '$param'";
        }
    }

    $self->_conditionally_auto_purge_on_get();

    if (my $sub = $params{expire_if}) {
        $self->expire_if($key, $sub);
    }

    my $object = $self->get_object($key) or
        return undef;

    if (Cache::BaseCache::Object_Has_Expired($object))
    {
        if ($params{busy_lock}) {
            # If busy_lock value provided, set a new "temporary"
            # expiration time that many seconds forward, and return
            # undef so that this process will start recomputing.
            my $busy_lock_time = Cache::BaseCache::Canonicalize_Expiration_Time($params{busy_lock});
            $object->set_expires_at(time + $busy_lock_time);
            $self->set_object($key, $object);
        } else {
            $self->remove($key);
        }
        return undef;
    }

    return $object->get_data( );
}

sub expire
{
    my ($self, $key) = @_;

    if (my $obj = $self->get_object($key)) {
        $obj->set_expires_at(time-1);
        $self->set_object($key, $obj);
    }
}

sub expire_if
{
    my ($self, $key, $sub) = @_;
    die "must specify subroutine" unless defined($sub) and ref($sub) eq 'CODE';

    if (my $obj = $self->get_object($key)) {
        my $retval = $sub->($obj);
        if ($retval) {
            $self->expire($key);
        }
        return $retval;
    } else {
        return 1;
    }
}


1;

__END__