File Coverage

lib/Cache/AgainstFile.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	12	14	85.7
condition	3	6	50.0
subroutine	12	12	100.0
pod	6	8	75.0
total	77	84	91.6

###############################################################################
# Purpose : Cache data structures against a file
# Author  : John Alden
# Created : 22 Apr 2005 (based on IFL::FileCache)
# CVS     : $Id: AgainstFile.pm,v 1.16 2006/05/09 09:04:29 mattheww Exp $
###############################################################################

package Cache::AgainstFile;

use strict;
use Carp;

use vars qw($VERSION);
$VERSION = sprintf"%d.%03d", q$Revision: 1.16 $ =~ /: (\d+)\.(\d+)/;

#
# API
#
sub new
{
	my ($class, $loader, $options) = @_;
	my $usage = "USAGE: $class->new(\&loader, \%options)";
	croak($usage) unless $loader && $options;
	croak($usage . ". Supplied loader is not a code reference") unless ref $loader eq 'CODE';
	croak($usage . ". Supplied options is not a hash reference") unless ref $options eq 'HASH';

	#Select backend
	my $method = $options->{Method} || croak("No cache 'Method' option");
	TRACE("Cache: method = $method");

	#Load appropriate backend class on demand
	my $backend_name = (scalar $method =~ /::/? $method : "$class\::$method"); #If no namespace, assume in the Cache::AgainstFile::Backend namespace
	die("Package name '$backend_name' doesn't look valid") unless($backend_name =~ /^[\w:]+$/);
	eval "require $backend_name";
	die("Unable to load $backend_name - $@") if($@);

	#Wire up tracing stubs
	foreach my $stub (qw(TRACE DUMP)) {
		no strict 'refs';
		local $^W = undef;
		*{$backend_name."::".$stub} = \&{$stub};
	}

	my $backend = $backend_name->new($loader, $options);
	my $self = {
		'loader' => $loader,
		'options' => $options,
		'method' => $method,
		'backend' => $backend,
	};
	bless $self, $class;
}

# Forward the methods to the backend
sub get
{
	my $self = shift;
	croak("File '$_[0]' does not exist") unless(-e $_[0]);
	return $self->{backend}->get(@_);
}

sub purge
{
	my $self = shift;
	return $self->{backend}->purge();
}

sub clear
{
	my $self = shift;
	return $self->{backend}->clear();
}

sub count
{
	my $self = shift;
	return $self->{backend}->count();
}

sub size
{
	my $self = shift;
	return $self->{backend}->size();
}

#Log::Trace stubs
sub TRACE {}
sub DUMP {}

1;

__END__