package TDS::Cache::Expire;
# $Id: Expire.pm,v 1.24 2001/02/06 05:02:12 tom Exp $
################################################################

=head1 NAME

TDS::Cache::Expire - キャッシュ消去

=head1 SYNOPSIS

 use TDS::Cache::Expire;

 $e = new TDS::Cache::Expire;
 $e->Do("expire");

=head1 DESCRIPTION

キャッシュの報告、エキスパイヤ、全消去を行う。

=cut

################################################################

use strict;
use vars qw(@ISA @EXPORT
	    $StampFile $DefaultCommand);

use Exporter;
use Time::Local;

use ObjectTemplate;
use DateTime::Format;
use CGI::QueryString;
use SimpleDB::Append;

use TDS::System;
use TDS::Cache;
use TDS::Cache::Daily;
use TDS::Cache::DirInfo;


=head1 STATIC VARIABLES

 $DefaultCommand   デフォルトの動作コマンド     

 $LogFile          キャッシュログファイル名

=cut

$DefaultCommand = "expire";

  
@ISA = qw(ObjectTemplate);

attributes qw(command
	      last_update
	      quiet
	      files
	      log);

################################################################
=head1 MEMBER FUNCTIONS

=cut

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

    # global variable
    $StampFile = CacheDir() . "/update.stamp";

    $self->files([]);
    
    $self->command($DefaultCommand) unless $self->command;

    $self->last_update((stat($StampFile))[9]);
    
    $self->SUPER::initialize;

}

sub Collect
{
    my $self = shift;

    # キャッシュファイル群を得る
    opendir(DIR, CacheDir()) || die CacheDir;
    my $file;
    while($file = readdir(DIR)){
	my $cache;
	if ($file =~ /\.html$/){
	    if ($file =~ /^([cr])(\d{4})(\d{2})(\d{2})(\-s)?\.html$/){
		my $reverse;
		if ($1 eq 'r'){
		    $reverse = 1;
		}
		$cache = new TDS::Cache::Daily(year=>$2,
					       month=>$3,
					       day=>$4,
					       has_secret=>$5,
					       'reverse'=>$reverse);
	    } elsif ($file =~ /^c(\d{4})(\d{2})([abc])(\-s)?\.html$/){
		require TDS::Cache::Part;
#		$cache = new TDS::Cache::Part(year=>$2, month=>$3,  day=>$4,
#		has_secret=>$5);
		$cache = new TDS::Cache::Part(year=>$1, month=>$2, part=>$3,
					      has_secret=>$4);
	    } elsif ($file =~ /recent(\-s)?\.html$/){
		require TDS::Cache::Recent;
		$cache = new TDS::Cache::Recent(has_secret=>$1);
	    } elsif ($file eq 'dictionary.html'){
		require TDS::List::Dictionary;
		$cache = new TDS::List::Dictionary;
	    } elsif ($file eq 'url.html'){
		require TDS::List::Url;
		$cache = new TDS::List::Url;
	    }
	    push(@{$self->files}, $cache)
		if ref $cache;
	}
#	$self->print "$_<br>";
    }

}
################################################################
# 各コマンドを実行

=head2 $e->Do($command);

指定したコマンドを実行する。
指定できるのは、"report", "expire", "clear"。

=cut

sub Do($;$)
{
    my ($self, $cmd) = @_;

    die "Cache is disable"
	unless $TDS::Cache::EnableCache;
    $self->Collect;
    
    $self->command($cmd) if $cmd;

    $self->print_header;
    $self->ProcessFiles;
    $self->print_footer;
}

sub UpdateStampFile
{
    my $self = shift;

    # touch stamp
    open(F, ">$StampFile") || die $StampFile;
#    print F "\n";
    close F;
#    utime($lm, $lm, $StampFile)
#	if $lm;
    chmod(0666, $StampFile)
	if $TDS::Status->mod_perl;
}    
################################################################
sub ProcessFiles ($)
{
    my $self = shift;
    my ($total_size, $remain_size) = (0, 0);

    $self->print("<table border=1>");
    $self->print(qq(<tr><th>filename<th>size<th>status));

#    print STDERR "do: ", $self->command, ": ";
    for (@{$self->files}){
	my $filename = $_->GetCacheFilename;
#	die "process: $filename, ";
	my $size = (stat($filename))[7];
	my $is_fresh = $_->IsFresh;

#	print STDERR "$filename: $is_fresh\n";
	$total_size += $size;
	$remain_size += $size;
	
	my $comment;
	my $cmd = $self->command;

	if ($cmd eq 'report'){
	    $comment = ($is_fresh) ? "fresh" : "over";
	} elsif ($cmd eq 'expire'){
	    unless ($is_fresh){
		$_->RemoveCache;
		$comment = "expired";
		$remain_size -= $size;
	    } else {
		$comment = "survived";
	    }
	} elsif ($cmd eq 'clear'){
	    $_->RemoveCache;
	    $remain_size -= $size;
	    $comment = "cleared";
	}
	$self->printf(qq(<tr><td>%s<td align="right">%s<td>%s\n),
	       $filename,
	       comma_digit($size),
	       $comment);
    }
    $self->print("</table>");
    $self->printf("<p>total size: (%s, %s)</p>",
	   comma_digit($total_size),
	   comma_digit($remain_size));
}
################################################################
# 使ってない
sub Logging ($)
{
    my $self = shift;

    # 1999/09/23 10:23:21,max,total,over_rate,files

    my $ct = ctime($^T, $TDS::System::TZ);
    chomp $ct;

    return;
    $self->log->Append(sprintf("%s, %s, %d, %d, %3.1f, %d\n",
			       $self->command,
			       $ct,
			       $self->max_size,
			       $self->total_size,
			       $self->total_size/$self->max_size*100,
			       int(@{$self->files})));
}
################################################################
# 下請け
sub print_cache_files
{
    my $self = shift;

    $self->print(qq(<table summary="cache files" border=1>));
    $self->print(qq(<tr><th>filename<th>atime<th>size));
    
    for (@{$self->files}){
	my $ct = ctime($_->{atime}, $TDS::System::TZ);
	chomp $ct;
	
	if ($self->as_plain){
	    $self->printf(qq(%s, %s, %s\n),
			  $_->{filename},
			  $ct,
			  comma_digit($_->{size}));
	} else {
	    $self->printf(qq(<tr><td><a href="%s">%s</a><td>%s<td align="right">%s\n),
			  $_->{filename},
			  $_->{filename},
			  $ct,
			  comma_digit($_->{size}),
			  );
	}
    }
    $self->print(qq(</table>));
}
# ヘッダ、フッタの表示
sub print_header ($)
{
    my $self = shift;

    $self->printf("<html><head><title>%s</title></head>
<body><h1>%s cache</h1>",

		  $self->command,
		  $self->command);
#    $self->print_status;
}
sub print_footer ($)
{
    my $self = shift;
    $self->print(qq(<hr><div><a href="index.html">[admin]</a><a href="../">[diary]</a></div></body></html>\n));
}
sub comma_digit
{
    my $num = shift;

    $num =~ s/(\d{1,3})(?=(?:\d\d\d)+(?!\d))/$1,/g;
    return $num
#    $d = reverse $d;
#    $d =~ s/(\d{3})/$1,/g;
#    $d =~ s/,$//;
#    return $_ = reverse $d;
}

sub printf
{
    my ($self, @array) = @_;
    printf @array
	unless $self->quiet;
}
sub print
{
    my ($self, @array) = @_;

    print @array
	unless $self->quiet;
}
1;
