package TDS::Dynamic;
# $Id: Dynamic.pm,v 1.107 2001/02/06 05:02:07 tom Exp $
################################################################

=head1 NAME

 TDS::Dynamic - dynamic mode

=cut    

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


use strict qw(vars);
use ObjectTemplate;

use CGI::Tools;
use CGI::QueryString;
use Template;

use TDS;

use vars qw(@ISA
	    $PushAntennaString);

@ISA = qw(ObjectTemplate);

# antenna pushing on update(camma separated)
# ATTENTION: now disabled because of not confirmed security problem
$PushAntennaString = "" unless defined $PushAntennaString;

attributes qw();

################################################################
sub Do ($)
{
    my $self = shift;

    my $status = $TDS::Status;
    ################
    # check access
    $self->check_access();

    # debug
    print ContentType() . "\r\n"
	if $status->debug;

    # specified request
    {
	my $command = param('command');
	# version
	if ($command eq 'show_version'){
	    print ContentType() . "\r\n"
		if $ENV{'REQUEST_URI'};
	    print $TDS::Version;
	    exit;
	} elsif ($command eq 'show_di'){
	    DoAsDI();
	    exit;
	} elsif ($command eq 'show_id'){
	    my $header = ContentType();
	    require TDS::Cookie;
	    $header .= TDS::Cookie->AsCookieHeaders . "\r\n";
	    print $header;
	    print $TDS::Status->id->GetID(), "<br>", $TDS::Status->id->GetTimes;
	    if ($TDS::Status->is_author){
		print "<br>author";
	    }
	    exit;
	} elsif ($command eq 'title_jump'){

	    print ContentType() . "\r\n";
	    my $skelton = '<!--#macro cmd="YMD_JUMP" -->';
	    require TDS::Renderer;
	    my $skel = new TDS::Renderer;
	    $skel->skelton($skelton);
	    require TDS::Collection;
	    print $skel->AsHTML(new TDS::Collection);
	    exit;
	} elsif ($command eq 'title'){
	    $status->title_mode(1);
	    $self->PrepareAsTitle;

	}
    }
    {
	my $http_accept = $ENV{'HTTP_ACCEPT'} || '';
#	$self->Logging;
	# conditions for output DI
	if ($http_accept =~ m!text/di! ||      # text/di is accepted
	    $http_accept =~ m!text/x-di! ||
#	    $http_accept =~ m!text/plain! ||
	    param('mode') =~/^di$/i){          # specified as di in query
	    $self->DoAsDI();
	    exit;
	}
    }
    # HEAD access
    if ($ENV{'REQUEST_METHOD'} &&
	$ENV{'REQUEST_METHOD'} eq 'HEAD'){
	# in HEAD access, allow it would provide not fresh info
	# do not check real L-M, because it takes somewhat long time

	# get L-M information, but it may be NOT correct
	my $lm_str = $TDS::Status->lmo->GetLastModifiedString();

#	print "content-type: text/html\r\nLast-Modified: $lm_str\r\n\r\n";
	print ContentType() . "Last-Modified: $lm_str\r\n\r\n";
	
	exit;
    }
    # GET access
    # output http header
##    warn " start";

    my $lm = $TDS::Status->lmo->GetRealLastModified;
    my $lm_str = $TDS::Status->lmo->GetLastModifiedString;
#    warn " lmo done";

    # prepare for cache
    require TDS::Cache;
##    warn " TDS::Cache used";
    my $cache = undef;
    if ($TDS::Status->mode eq 'RECENT'){
	require TDS::Cache::Recent;
#	warn " TDS::Cache::Recent used";
	$cache = new TDS::Cache::Recent;
    } elsif ($TDS::Status->mode eq 'PART'){
	require TDS::Cache::Part;
	$cache = new TDS::Cache::Part;
    } elsif (0 && $TDS::Status->mode eq 'MONTH'){ # disabled
	require TDS::Cache::Month;
	$cache = new TDS::Cache::Month;
    }
#    warn "mode: ", $TDS::Status->mode;
#    warn "updated: ", $TDS::Status->lmo->updated;
#    warn "is fresh: ", $cache->IsFresh
#	if $cache;
##    warn " display cache start";
    if ($TDS::Cache::EnableCache &&
	!$TDS::Status->lmo->updated &&    # tdf files is not updated
	ref $cache &&
	$cache->IsFresh){
#	warn " use cache";
#	die times;
	# last-modified for http header
	my $lm = $TDS::Status->lmo->GetLastModified();
	my $lm_str = $TDS::Status->lmo->GetLastModifiedString();

##	warn " output http header";
#	my $header = "content-type: text/html\r\nLast-Modified: $lm_str\r\n";
	my $header = ContentType() . "Last-Modified: $lm_str\r\n";

	require TDS::Cookie;
	if ($TDS::Cookie::EnableCookie && !$TDS::Status->no_cookie){
	    $header .= TDS::Cookie->AsCookieHeaders();
	}
	print "$header\r\n";
	
#	warn " skelton";
	my $skelton = new Skelton(filename=>$cache->GetCacheFilename);
##	warn " Read";
	$skelton->Read;
	# set macros which needed in each access
##	warn " set macros";
	$skelton->SetMacro("COUNTER_?(ALL|TODAY)?", sub {
	    require TDS::AccessLog;
	    return undef unless $TDS::AccessLog::EnableAccessLog;

#	    warn " require Counter begin";
	    require TDS::AccessLog::Counter;
#	    warn " require Counter end";

	    my ($self, $cmd, $var) = @_;
	    my $counter = new TDS::AccessLog::Counter;
#	    warn " counter newed";
	    if ($1){
		if ($1 eq 'ALL'){
		    return $counter->All;
		} elsif ($1 eq 'TODAY'){
		    return $counter->Today;
		} else {
		    die "Illegal Command: $cmd";
		}
	    } else {
#		warn " expand";
		$var ||= $TDS::AccessLog::Counter::Template;
		Expand($var, {'all'=>$counter->All,
			      'today'=>$counter->Today,
			      'times'=>($TDS::Status->id) ? $TDS::Status->id->GetTimes : 1
			      });
	    }
	});
#	warn " other macro";
	$skelton->SetMacro("AUTHOR", sub {
	    my ($self, $cmd, $var) = @_;
	    return  ($TDS::Status->is_author) ? ',author' : '';
	});
	$skelton->SetMacro("COOKIE_TIMES", sub {
	    my ($self, $cmd, $var) = @_;
	    return $TDS::Status->id->GetTimes;
	});
	$skelton->SetMacro("COMMENT_INPUT_NAME", sub {
	    my ($self, $cmd, $var) = @_;
	    require CGI::CookieTool;
	    my $name = CGI::CookieTool::GetCookie('name');
	    return qq(<input type="text" name="name" value="$name" $var>);
	});
#	$skelton->SetMacro("COMMENT_SHOW", sub {
#	    require TDS::Comment;
#	    my $cmt = new TDS::Comment;
#	    return $cmt->AsHTML;
#	});
##	warn " set macros done";
	print $skelton->AsHTML;
##	warn " as HTML done";
    } else {
##	warn " cannot use cache";
	{
	    my $header = ContentType() . "Last-Modified: $lm_str\r\n";

	    # if it has secret part and is author's access,
	    # do NOT remain any cache
	    if ($status->has_secret && $status->is_author){
		$header .= "Cache-Control: no-cache\r\n";
	    }
	    # add cookie
	    require TDS::Cookie;
	    if ($TDS::Cookie::EnableCookie && !$TDS::Status->no_cookie){
		$header .= TDS::Cookie->AsCookieHeaders();
	    }
	    $header .= "\r\n";

	    # print header
	    print $header;
	}

        # read rendering part
	require TDS::Renderer;
	my $rend = new TDS::Renderer;
	$rend->Read;
	# read diary
	require TDS::Collection;
	my $col = new TDS::Collection;
	$col->Read;
	my $html = $rend->AsHTML($col);
	print $html;
	# cache
	if ($TDS::Cache::EnableCache &&
	    ref $cache){
	    $cache->has_secret($TDS::Status->has_secret);
	    $html =~ s/<!-- BEGIN @@@ +(AUTHOR) @@@ +-->.*<!-- END @@@ +\1 @@@ +-->/<!--#macro cmd="$1"-->/g;
	    $html =~ s/<!-- BEGIN @@@ +(COUNTER[A-Z_]*) @@@ +-->.*<!-- END @@@ \1 @@@ -->/<!--#macro cmd="$1"-->/g;
	    $html =~ s/<!-- BEGIN @@@ +(COOKIE_TIMES) @@@ +-->.*<!-- END @@@ \1 @@@ -->/<!--#macro cmd="$1"-->/g;
	    $html =~ s/<!-- BEGIN @@@ +(COMMENT[A-Z_]*) @@@ +-->.*<!-- END @@@ \1 @@@ -->/<!--#macro cmd="$1"-->/sg;
    
	    $cache->WriteCache($html);
	}
    }
    # logging
##    warn " Logging";
    $self->Logging;
    # update hina.di
    if ($status->mode eq 'RECENT' &&
	$TDS::Status->lmo->updated){
	$self->update_hina_di($TDS::Status->lmo->lm);
    }
    
    # pushing system is now underconstruction
    #my @push_antennas = qw(http://www.morito.mgmt.waseda.ac.jp/~tom/natsu3/);
    #my @push_antennas = ();
    if (0 && $TDS::Status->lmo->updated){                # has updated
	if (0 && $PushAntennaString){ # now disable
	    require  TDS::Push2Antenna;
	    my $push = new TDS::Push2Antenna(antennas=>[split(/, */, $PushAntennaString)]);
	    $push->Push($TDS::Status->lmo->lm);
	}
    }

    $self->DoneHook;
    
#    warn " Dynamic Do done";
}

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

    require TDS::Cache;
    $TDS::Cache::EnableCache = 0;

    require TDS::Tdf::Command::Classes;
    for ('DIARY', 'TIMEDIV', 'NEW', 'SUB'){
	my $base = "TDS::Tdf::Command";
	my $title_template = "${base}::${_}::TitleTemplate";
	my $title_end_template = "${base}::${_}::TitleEndTemplate";
	my $template = "${base}::${_}::Template";
	my $end_template = "${base}::${_}::EndTemplate";

	$$template = $$title_template;
	$$end_template = $$title_end_template;
    }

    $TDS::Tdf::Command::_New::MustHaveContent = 0;
#    eval "sub TDS::Tdf::Command::NEW::RecurseContent (){()}";
    eval q(sub TDS::Tdf::Command::NEW::RecurseContent (){
	my ($self, $params) = @_;
	$params->{subs} = undef;
	for (@{$self->{content}}){
	    if (ref $_ && $_->Name eq 'SUB'){
		$params->{subs} .= $_->{ext_attrs};
	    }
	}
	return ();
    });
}
sub DoneHook {}

# static functions
sub DoAsDI
{
    my $self = shift;
    my $lm = $TDS::Status->lmo->GetLastModified;
    my $lm_str = $TDS::Status->lmo->GetLastModifiedString();
    
    print ContentType("text/plain") . "Last-Modified: $lm_str\r\n\r\n";
    
    if (-f "hina.di"){
	open(F, "hina.di") || die;
	print <F>;
	close F;
    } else {
	require TDS::Di;	
	my $di = new TDS::Di(no_expire=>1);
	$di->SetLastModified($TDS::Status->lmo->GetLastModified());
	print $di->AsDi;
	$di->Write($TDS::Status->lmo->GetLastModified());
#	    if ($TDS::Status->is_ownerUID);
    }
}
sub Logging($)
{
    my $self = shift;

    my $status = $TDS::Status;
    require TDS::AccessLog;
    if ($TDS::AccessLog::EnableAccessLog){
	if ($status->request_uri){
	    require TDS::AccessLog::Logging;
	    my $log = new TDS::AccessLog::Logging;
	    $log->Add;

	    # update log
	    if ($TDS::AccessLog::Logging::UpdateLogFlag){
		require TDS::AccessLog::DirInfo;
		my $params = $TDS::Status->start_time->GetParams;
		#my $logfile_template = "%dir/update-%year-%0m.log";
		my $logfile_template = "%dir/update.log";	
		$params->{dir} = TDS::AccessLog::DirInfo::GetLogDir();
		my $logfile = Expand($logfile_template, $params);
		my $log_lm = (stat($logfile))[9];

		my $lm = $TDS::Status->lmo->GetLastModified;
		if ($log_lm < $lm){
		    require TDS::System;
		    require DateTime::Format;		    
		    open(F, ">>$logfile") || die $logfile;
		    print F DateTime::Format::time2str_gen($lm, $TDS::System::TZ) . "\r\n";
		    close F;
		}
	    }
	}
    }
}
################################################################
# static functions
sub check_access()
{
    # check allowing all monthly access

    my $status = $TDS::Status;
    
    require TDS::Collection;
    if (!$TDS::Collection::AllowAllMonthly &&
	$status->mode eq 'MONTH' &&
	$status->day_part eq ''){
	PrintHTTPHeader();
	print qq(<h1>Rejected</h1>
		 <p>access for all monthly is not allowed.</p>);
	exit();
    }
    if ($status->rejected){
	require TDS::AccessLog::Logging;
	my $logging = new TDS::AccessLog::Logging;
	$logging->Add;
	PrintHTTPHeader();
	print sprintf("denied by user agent: %s (%s)",
		      $status->rejected,
		      $status->user_agent->fullname);
    }
}
sub update_hina_di($$)
{
    my ($self, $lm) = @_;
    # update hina.di file(only in current access)
    my $status = $TDS::Status;
    
    require TDS::Di;
    my $di = new TDS::Di;
    my $di_file = $di->filename;
    my $to_log_flag = 0;

    unless ($status->is_ownerUID){
	if (-f $di_file){
	    my $owner_di = (stat($di_file))[4];
	    if ($owner_di != $<){
		# if owner of hina.di and cgi are different,
		# write to log/hina.di
		$to_log_flag = 1;
	    }
	} else {
	    $to_log_flag = 1;
	}
    }
    if ($to_log_flag){
	require TDS::AccessLog::DirInfo;
	$di->filename(TDS::AccessLog::DirInfo::GetLogDir() . "/hina.di");
    }
    $di->Write($lm);
}
1;
