package TDS::Cache::Base;
# $Id: Base.pm,v 1.20 2001/02/06 05:02:11 tom Exp $
################################################################
# TDS::Cache::Base
#
#  base class which use any cache system
#    ex. diary, list, pim.
#
################################################################

use strict;
use vars qw(@ISA @EXPORT
	    $DefaultCacheSuffix);

use Exporter;

@ISA = qw(ObjectTemplate);
@EXPORT = qw(attributes);

use Fcntl ':flock';

use ObjectTemplate;
use CGI::QueryString;

use TDS::DirInfo;
use TDS::Cache;

$DefaultCacheSuffix = "html" unless defined $DefaultCacheSuffix;

attributes qw(cache_basename cache_suffix 
	      cache_lm);

################################################################
# member functions
# whether if cache is permitted.
# return true if permitted.
# called by IsFresh()


sub initialize($)
{
    my $self = shift;

    $self->cache_suffix($DefaultCacheSuffix) unless $self->cache_suffix;
    $self->SUPER::initialize;
}


sub PermittedCaching ($)
{
    require TDS::Cache;
    return 0 if (!$TDS::Cache::EnableCache ||
		 param('keyword')          ||   # search mode
		 (param('cat') && param('cat') ne 'ALL') || #category specified
		 param('no_cache'));
    return 1;
}

# whether if cache is fresh.
# return true cache file is fresh, false or not

sub IsFresh ($)
{
    my $self = shift;

#    die if ref $self eq "TDS::Cache::Recent";
    return 0 unless $self->PermittedCaching;
    return 0 unless $self->NewerThanDatafile;
    return 1;
}
# whether if cache file is newer than correspond data file
# return ture cache is newer than data

sub NewerThanDatafile($)
{
    my $self = shift;
    
    my $data_lm = $self->GetDataFileLastModified;
    my $cache_lm = $self->GetCacheLastModified;

#    warn "cache l-m: data: $data_lm, cache: $cache_lm: ", $self->GetCacheFilename;
    return $cache_lm > $data_lm;
}
################################################################
# return filename of datafile
# MUST be overriden

sub GetDataFilename($)
{
    my $self = shift;

    # MUST BE OVERRIDEN
    die "GetDataFilename() must be overriden in ", ref $self;
}
sub GetDataFileLastModified($)
{
    my $self = shift;

    my $filename = $self->GetDataFilename;
    return 0 unless -f $filename;
    return (stat($filename))[9];
}

################################################################
# cache info
################
sub GetCacheFilename($)
{
    my $self = shift;

    return $self->create_cache_filename($self->cache_basename);
}
sub create_cache_filename ($;$)
{
    my ($self, $basename) = @_;

    $basename ||= $self->basename;
    
    require TDS::Cache::DirInfo;
    return sprintf("%s/%s.%s", TDS::Cache::DirInfo::CacheDir(),
		   $basename,
		   $self->cache_suffix);
}
sub GetCacheLastModified($)
{
    my $self = shift;
    my $cache_file = $self->GetCacheFilename;
    return 0 unless -f $cache_file;
    return $self->cache_lm if $self->cache_lm;
    return $self->cache_lm((stat($cache_file))[9]);
}
################################################################
# Reading and Writing Cache
################
sub ReadCache($)
{
    my $self = shift;

    my $filename = $self->GetCacheFilename;

    open(F, $filename) || die $filename;
    eval { flock(F, LOCK_SH); };
    my $line = join('', <F>);
    close(F);
    return $line;
}
sub WriteCache($$)
{
    my ($self, $line) = @_;

    return unless $self->PermittedCaching;
    
#    open(F, "+<" . $self->GetCacheFilename);
#    eval { flock(F, LOCK_EX) };
#    truncate(F, 0);
#    seek(F, 0, 0);
#    warn "write cache: ", $self->GetCacheFilename;
    open(F, ">" . $self->GetCacheFilename) || die $self->GetCacheFilename;
    print F $line;
    close (F);
    return $line;
}
    
################################################################
# remove cache file
sub RemoveCache ($)
{
    my $self = shift;
    my $file = $self->GetCacheFilename;
    return 0 unless -f $file;
    unlink($file) || die "can't unlink cache: $file";

    return 1;
}

    
1;

