Apache::XPP::Cache::Store::File - flatfile cache store

Apache-XPP documentation Contained in the Apache-XPP distribution.

Index

Code Index:

NAME

Top

Apache::XPP::Cache::Store::File - flatfile cache store

SYNOPSIS

Top

...

REQUIRES

Top

Apache::XPP::Cache::Store FileHandle File::stat

EXPORTS

Top

Nothing

DESCRIPTION

Top

Apache::XPP::Cache::Store::File handles the storing of data in flat file form on behalf of Apache::XPP::Cache.

METHODS

Top

new ( $name, $group, \%instance_data, \$content )

Creates a new File store object. The contents of %instance_data will be placed in the object as instance data (for Apache request object, etc.).

location ( $name, $group )

Returns the fully qualified filename to the store file for the specified name/group pair. Files are stored by their $name in the directory $group. If the directory $group does not exist, it will be created with permissions of 0777 (use the umask function to change these permissions to more desirable ones).

cachedir ( )

Returns the directory in which file caches are stored.

content ( [ \$content ] )

Sets the store object's content to $content and returns TRUE. If $content is omitted, returns the content of the store object.

is_expired ( )

Removes the store file.

mtime ( )
mtime ( $name, $group )

Returns the modification time of the specified store.

REVISION HISTORY

Top

 $Log: File.pm,v $
 Revision 1.9  2002/01/16 21:06:01  kasei
 Updated VERSION variables to 2.01

 Revision 1.8  2002/01/15 07:34:22  kasei
 From: Pierre Phaneuf <pp@ludusdesign.com>
 Subject: [Xpp-general] small warning fix
 Date: Mon, 14 Jan 2002 21:51:10 -0500
 Message-Id: <3C43991E.571FAC9E@ludusdesign.com>

 Fixes regex range warning.

 Revision 1.7  2000/09/13 21:00:52  dougw
 Small change to line 165.

 Revision 1.6  2000/09/11 20:12:23  david
 Various minor code efficiency improvements.

 Revision 1.5  2000/09/07 19:01:57  dougw
 Pod fixin's

AUTHORS

Top

Greg Williams <greg@cnation.com>

SEE ALSO

Top

perl(1). Apache::XPP Apache::XPP:Cache

Apache-XPP documentation Contained in the Apache-XPP distribution. 
# Apache::XPP::Cache::Store::File
# ---------------------------------
# $Revision: 1.9 $
# $Date: 2002/01/16 21:06:01 $
# -----------------------------------------------------


package Apache::XPP::Cache::Store::File;


use Carp;
use strict;
use File::stat;
use FileHandle;
use Data::Dumper;
use Apache::XPP::Cache::Store;
use vars qw( @ISA $debug $debuglines );

BEGIN {
	@ISA		= qw( Apache::XPP::Cache::Store );
	$Apache::XPP::Cache::Store::File::REVISION = (qw$Revision: 1.9 $)[-1];
	$Apache::XPP::Cache::Store::File::VERSION = '2.01';
	$debug		= undef;
	$debuglines	= 1;
}


sub new {
	my $proto		= shift;
	my $class		= ref($proto) || $proto;
	my $name		= shift;
	my $group		= shift;
	my $instance	= shift;
	
	my $self		= bless( { %{ ref($instance) ? $instance : {} } }, $class );
	my $filename	= $self->location( $name, $group );
	
	$self->name( $name );
	$self->group( $group );
	$self->filename( $filename );
	
	if (my $content = shift) {
		warn "file: setting content ($content) in cache object" . ($debuglines ? '' : "\n") if ($debug >= 2);
		$self->content( $content );
	}
	
	return $self;
} # END constructor new



sub location {
	my $proto		= shift;
	my $class		= ref($proto) || $proto;
	my $name		= shift;
	my $group		= shift;
	
	$name			=~ s#/#_#g;
	$group			=~ s#/#_#g;
	
	my $directory	= join('/', $proto->cachedir, $group);
	unless (-d $directory) {
		warn "file: creating directory '$directory'" . ($debuglines ? '' : "\n") if ($debug);
		if (!mkdir( $directory, 0777 )) {
			warn "Failed to create directory '$directory'! $!";
			return undef;
		}
	}
	
	return $directory . '/' . $name;
} # END method location



sub cachedir {
	my $self		= shift;
	warn "file: cachedir called" . ($debuglines ? '' : "\n") if ($debug >= 2);
	my $cachedir	= ref($self->r) ? $self->r->dir_config('XPPFileCacheDir') : '/tmp/cache';
	$cachedir = $self->r->server_root_relative($cachedir)
		unless( $cachedir =~ /^\// );
	$cachedir		=~ m#^([/.\-\w]*)$#;
	return $1;
} # END method cachedir



sub content {
	my $self		= shift;
	my $class		= ref($self) || return undef;
	my $filename	= $self->filename;
	if (my $content = shift) {
		my $fh		= new FileHandle ("> $filename");
		return undef unless ((defined $fh) && (ref($content)));
		print $fh ${ $content };
		$fh->close;
		return 1;
	} else {
		my $fh		= new FileHandle ($filename);
		return undef unless (defined $fh);
		local($/)	= undef;
		return <$fh>;
	}
} # END method content



sub is_expired {
	my $self		= shift;
	my $class		= ref($self) || return undef;
	my $filename	= $self->filename;
	unlink $filename || warn "file\t: cannot delete file ($filename): $!" . ($debuglines ? '' : "\n");
	return 1;
} # END method is_expired



sub mtime {
	my $proto	= shift;
	my $filename;
	if (my $class = ref($proto)) {
		$filename	= $proto->filename;
	} else {
		my $name	= shift;
		my $group	= shift;
		$filename	= $proto->location( $name, $group );
	}
	
	my $st = stat($filename);	# using File::stat
	unless (ref($st) && $st->can('mtime')) {
		warn "file:\tcannot stat file ($filename): $!" . ($debuglines ? '' : "\n") if ($debug);
		return undef;
	}
	return $st->mtime;
} # END method mtime


1;

__END__