# Apache::XPP::Cache
# --------------------
# $Revision: 1.9 $
# $Date: 2002/01/16 21:06:01 $
#-----------------------------

=head1 NAME

Apache::XPP::Cache - XPP Cache manegment module

=cut

package Apache::XPP::Cache;

=head1 SYNOPSIS

 use Apache::XPP::Cache;
 $cache	= Apache::XPP::Cache->new( %options );
 $cache	= Apache::XPP::Cache->is_cached( %options );

=head1 REQUIRES

Apache::XPP

=cut

use Carp;
use strict;
use vars qw( $debug $debuglines );

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

=head1 EXPORTS

Nothing

=head1 DESCRIPTION

Apache::XPP::Cache is an interface to both Store and Expire caching modules.

=head1 METHODS

=over

=cut

=item new( $name, $group, \%instance_data, [ $storetype, @store_options ], [ $expiretype, @expire_options ] )

Creates a new Cache object using the specified Store and Expire types.

=cut
{# BEGIN PRIVATE CODE BLOCK
my %cache;
sub new {
#	Apache::XPP::Cache->new( 're4sidebar', 'games', { r => $r }, [ 'File', $content ], [ 'Duration', '2h' ] );
	my $proto		= shift;
	my $class		= ref($proto) || $proto;
	my $name		= shift;
	my $group		= shift;
	my $instance	= shift;
	my $self;

	my $specifier	= unpack("%32C*", $name . $group) % 65535;
	if ($cache{ $specifier }) {
		warn "cache: using cached object (in new)" . ($debuglines ? '' : "\n") if ($debug);
		$self		= $cache{ $specifier };
	} else {
		warn "cache: creating new object (in new)" . ($debuglines ? '' : "\n") if ($debug);
		my $store		= shift;
		my $expire		= shift;

		$self			= bless( { %{ ref($instance) ? $instance : {} } }, $class );

		foreach my $part ( {Store => $store}, {Expire => $expire} ) {

			my ($label, $inputs) = %{$part};
			my $type	= shift( @{ $inputs } );
			if (my $thisclass = $class->install_module( (($label eq 'Expire') ? 'Expiry' : $label), $type )) {
				my $obj	= $thisclass->new( $name, $group, { r => $self->r }, @{ $inputs } );
				if (ref($obj)) {
					my $meth = $label . 'Type';
					$self->$meth( $type );		# StoreType/ExpireType
					$meth = $label . 'Object';
					$self->$meth( $obj );		# StoreObject/ExpireObject
				} else {
					return undef;
				}
			} else {
				carp "Specified $label type ($type) is not registered as available!";
				return undef;
			}

		}

		$cache{ $specifier }	= $self;
	}
} # END constructor new
} # END private code block for %cache

=item C<install_module> ( ('Store'|'Expiry'), $name )

Installs the $name store or expiry module, and returns the associated class name.

=cut
sub install_module {			# shamelessly snagged from DBI
	my $class	= shift;
	my $type	= shift;
	my $name	= shift;
	
	$type		= 'Expiry' unless ($type eq 'Store');
	my $mod;
	
	# already installed
	return $mod if ($mod = $Apache::XPP::installed{ $type }{ $name });
	
	# --- load the code
	$mod		= "Apache::XPP::Cache::${type}::${name}";
	eval "package Apache::XPP::Cache::_firesafe; require $mod";
	if ($@) {
		warn "require of ($mod) failed! $@";
		return undef;
	}
	
	$Apache::XPP::installed{ $type }{ $name }	= $mod;
}

sub store {
	my $self	= shift;
	return undef unless ref($self);
	return $self->{ 'StoreObject' };
} # END method store

sub expire {
	my $self	= shift;
	return undef unless ref($self);
	return $self->{ 'ExpireObject' };
} # END method expire


=item C<is_expired> (  )

Returns a true value if the current cache has expired, otherwise returns false.

=cut
sub is_expired {
	my $self	= shift;
	return undef unless ref($self);
	if ($self->expire->is_expired( $self->store )) {
		$self->store->is_expired;
		return 1;
	} else {
		return 0;
	}
} # END method is_expired

=item C<content> (  )

Returns the content of the current cache.

=cut
sub content {
	my $self	= shift;
	return ref($self) ? $self->store->content : undef;
} # END method content


=item C<r> (  )

Returns the Apache request object

=cut
*r = \&{ "Apache::XPP::r" };

=item C<AUTOLOAD> ( )

Calling $obj->meth() returns $obj->{'meth'}.
Calling $obj->meth($val) sets $obj->{'meth'} = $val.

=cut

*AUTOLOAD = \&{ "Apache::XPP::AUTOLOAD" };

1;

__END__

=back

=head1 REVISION HISTORY

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

 Revision 1.8  2000/09/15 22:02:37  dougw
 Took out $AUTOLOAD

 Revision 1.7  2000/09/15 21:35:22  dougw
 Autoload changed to use Apache::XPP's autoload. This didn't make it into
 the previous check in.

 Revision 1.6  2000/09/13 21:02:11  dougw
 David cleaned up the loop in new() so it isn't 2 identical loops. r() and
 AUTOLOAD() are now just forwarders to Apache::XPP::r and Apache::XPP::AUTOLOAD

 Revision 1.5  2000/09/07 19:03:19  dougw
 over fix

 Revision 1.4  2000/09/07 18:40:38  dougw
 Pod updates.


=head1 AUTHORS

Doug Weimer <dougw@cnation.com>
Greg Williams <greg@cnation.com>

=head1 SEE ALSO

 l<perl(1)>.
 l<Apache::XPP>

=cut