package TDS::Status;
################################################################
# TDS::Status
#
# Status.pm,v 1.66.2.1 2001/02/13 00:48:08 tom Exp
################################################################

use strict;

use CGI::QueryString;

use TDS::System;
use TDS::DirInfo;
use TDS::RequestMode;

use vars qw(@ISA $HostnameLookup);
@ISA = qw(TDS::RequestMode);

$HostnameLookup = 0 unless defined $HostnameLookup;

attributes qw(request_uri referer remote_host user_agent
	      is_cgi
	      name id start_time
	      keyword category
	      is_author is_robot has_secret no_cookie rejected
	      num_topic title_mode
	      start_year exist_years
	      is_ownerUID mod_perl
	      no_table
	      lmo data_last_modified
	      debug
	      );

#warn " status use done.";

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

##    warn " status init";

    # start time
    require DateTime::Time;
    $self->start_time(new DateTime::Time);
    $self->start_time->SetTime(time(), $TDS::System::TZ);

#    warn " keyword";
    # search keyword
    {
	require TDS::Keyword;
	$self->keyword(new TDS::Keyword);
	$self->keyword->Set(param('keyword'));
    }

#    warn " get mode";
    # request processing
    # unnamed query -> param('keywords')
    $self->GetMode;
    $self->RecentHook
	if $self->mode eq 'RECENT';
    $self->ModeCheckHook();
    
#    print STDERR "status tmp", times, "<br>\n";

    # category
    {
	require TDS::Category;
	$self->category(new TDS::Category);
	$self->category->Read;
    }
    
    # title mode
    if (param('command') eq 'title'){
	$self->title_mode(1);
    }
    
#    warn " start time";
    # start, end year
    {
	my $diary_dir = GetDiaryDir();
	$self->exist_years([]);
	if (opendir(DIR, $diary_dir)){
	    for (sort readdir(DIR)){
		next unless /^\d{4}/ && -d "$diary_dir/$_";
		push(@{$self->exist_years}, $_);
	    }
	    closedir(DIR);
	}
	# set start year that you start writing diary.
	# if no diary at all, it had set as year of now.
	$self->start_year($self->exist_years->[0] || $self->start_time->year);
    }

    # last-modified object
#    warn " lmo";
    require TDS::LastModified;
    $self->lmo(new TDS::LastModified);

    {
	# l-m of datafiles
	my $dir = TDS::DirInfo::GetStyleDir();
	my $cus_dir = TDS::DirInfo::GetCustomizeDir();
	my $data_dir = TDS::DirInfo::GetDataDir();
	
	my $lm = 0;
	require LastModified;
	for ("$dir/template.ph", "$cus_dir/customize.ph",
	     "$data_dir/url.dat", "$data_dir/term.dat",
	     "$data_dir/dictionary.dat"){
	    my $data_lm = LastModified::GetLastModified($_);
	    $lm = ($lm < $data_lm) ? $data_lm : $lm;
	}
	$self->data_last_modified($lm);
    }

    # UA
    require UserAgent;
    $self->user_agent(new UserAgent(fullname=>$ENV{'HTTP_USER_AGENT'}));
	
    # ID,Counter
    require TDS::ID;
    $self->id(new TDS::ID(remote_host=>$self->remote_host,  # no means, will be fixed
			  user_agent=>$self->user_agent->name));
	
    # debug mode
    $self->debug(param('debug'));

#    $self->is_author(1);  # debug
    # cgi?
#    warn " cgi?";
    unless ($ENV{'GATEWAY_INTERFACE'} &&
	    $ENV{'GATEWAY_INTERFACE'} =~ /CGI/){
	$self->is_ownerUID(1);
    } else {
	$self->is_cgi(1);
	# following is used only under CGI

	# RemoteHost
	{
	    my $remote_addr = $ENV{'REMOTE_ADDR'} || '';
	    my $remote_host = $ENV{'REMOTE_HOST'} ||  # if empty
		$remote_addr;                         # set remote_addr
	    if ($remote_host eq '127.0.0.1'){
		$remote_host = "localhost";           # for ppp on Win
	    }
	    if ($HostnameLookup && ($remote_host eq $remote_addr)){
		# lookup DNS (take some seconds)
		$remote_host =
		    gethostbyaddr(pack('C4',split(/\./,$remote_host)),2) ||
			$remote_addr;
	    }
#	    $remote_host = $remote_addr unless $remote_host;
	    if (1){
		$self->remote_host($remote_host);
		$self->id->remote_host($remote_host);
	    }
	}

	# request uri
	require Url;
	$self->request_uri(new Url(uri=>$ENV{'REQUEST_URI'}));
	
	# referer
	$self->referer(new Url(uri=>$ENV{'HTTP_REFERER'}));

	# user agent
	my $conf_dir = GetConfDir();
	if (open(F, "$conf_dir/user_agent.conf")){
	    my $hua_name = $self->user_agent->name;
	    
	    my $line;
	    while (<F>){
		chomp;
		next if /^\#/;
		$line .= $_;
	    }
	    close F;
	    
	    my $info = {};
	    $line =~ s/([^{]+){([^}]+)}/ua_parse($info, $1, $2)/ige;
	    my $key;
	    for $key (keys %{$info->{$hua_name}}){
		if ($key eq 'table'){
		    if ($info->{$hua_name}->{$key} eq 'no'){
			$self->no_table(1);
		    }
		} elsif ($key eq 'style'){
		    $TDS::Style::Name = $info->{$hua_name}->{$key};
		    &TDS::Style::SetStyle();
		} elsif ($key eq 'log'){
		    if ($info->{$hua_name}->{$key} eq 'no'){
			$self->is_robot(1);
		    }
		} elsif ($key eq 'cookie'){
		    if ($info->{$hua_name}->{$key} eq 'no'){
			$self->no_cookie(1);
		    }
		} elsif ($key eq 'access'){
		    if ($info->{$hua_name}->{$key} eq 'no'){
			$self->rejected($hua_name);
		    }
		}
	    }
	}
	# check whether is author's visit
	unless (param('not_author') || param('no_author')){
	    require TDS::Admin::AuthorID;	    
	    my $author_id = new TDS::Admin::AuthorID;
	    $self->is_author($author_id->IsAuthor($self->id->GetID));
	} else {
	    $self->is_author(0);
	}
	# owner check
	{
	    my $uid = (stat($ENV{'SCRIPT_FILENAME'}))[4];
	    $self->is_ownerUID($uid == $<);
	}
	# modperl check
	{
	    $self->mod_perl((exists $ENV{'GATEWAY_INTERFACE'}
			     and $ENV{'GATEWAY_INTERFACE'} =~ /CGI-Perl/));
	}
    }
    $self->SUPER::initialize;
##    warn " status init done";
#    $self->is_author(1);                # debug
}

sub RecentHook($){}

sub ModeCheckHook($){}

################################################################
sub ua_parse($$$)
{
    my ($info, $huas, $line) = @_;

#    print "parser: $huas : $line<br>";
#    $huas =~ s/ *$//;
    $huas =~ s/ *//g;
    $line =~ s/\s*//g;
    my $hua;
    for $hua (split(/, */, $huas)){
	my $pair;
	for $pair (split(/; */, $line)){
	    my ($key, $content) = split(/: */, $pair);
	    $info->{$hua}->{$key} = $content;
#	    print "$hua, $key = $content<br>";
	}
    }
}
1;


