#!/usr/bin/perl

# diary.plの公開から2年、やっぱ、Last-modifiedとContent-lengthは正義だ。
# と考え直したこにしかつひろが送る、nikki.pl(笑)。
# perl5でしか動きません。
# 動作確認済のVersion
#  5.004_04 ( FreeBSD )
#  5.005_02 ( win32 )

# ファイルの保存形式はdiary.plのときのまま。
# $some_dir/YYYY/MM/DD.htmlという日記本文だけを記述したファイルと
# 共通のヘッダ部分とフッタ部分を@filesに代入する部分を書き換えれば、
# 他のファイル保存形式でも大丈夫だと思う。

use IO::File;
use Time::Local;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use NKF;
use Fcntl qw(:DEFAULT :flock);
use File::Basename;
#require 'jcode.pl';
binmode STDOUT;

#&jcode::init ;

chdir dirname($ENV{SCRIPT_FILENAME});

# グローバルな変数達。
#
{my $fh = select(STDOUT); $| = 1; select($fh);}
# 日記ファイルより前に読むファイル。
@before = ("Head","diaryHeader");
# 日記ファイルより後に読むファイル。
#@after = ("mailMe","diaryAgents","diaryFooter","Foot");
@after = ("diaryAgents","diaryFooter","Foot");
# このプログラムの名前
$program = $ENV{'SCRIPT_NAME'};
# リクエスト形式。
$method = $ENV{'REQUEST_METHOD'};
# ログに残そう。
$log_file = "log/log.dat";
#$log_lock = "log/.lock";
$log_max = 500;
# リモートホスト
$rhost = $ENV{'REMOTE_HOST'};
$rhost = $ENV{'REMOTE_ADDR'} if ($rhost eq "");
#$rhost = substr($rhost,35);
$rhost = substr($rhost.' 'x50,0,40);
#今日の日付を得る
($sec, $min, $hour, $mday, $mon, $year) = localtime(time());
$date_now = sprintf("%02d/%02d/%02d %2d:%2d:%2d", $year, $mon + 1, $mday, $hour, $min, $sec);
# agent
$agent = $ENV{'HTTP_USER_AGENT'};
# referer
$referer = $ENV{'HTTP_REFERER'};
#$referer =~ tr/A-Z/a-z/;
#$referer =~ s/%7e/~/i;
#$referer =~ s/\?\d+$//;

# user_agent

# PATH_INFO プログラムの引数。
$PATH_INFO=$ENV{'PATH_INFO'};
#$PATH_INFO='/2000/03/20.html';
#$PATH_INFO='/1997/12/';


# @files 出力するべき、ファイルが、出力すべき 順番にはいっているリスト
# @files for TEST use;
#@files = ( 'Head','diaryHeader',
#	   '1998\10\01.html',
#	   'Foot');
$link = "test";
@files = ( @before, '1998\10\01.html' ,@after);
# @files from $PATH_INFO
if ( length( $PATH_INFO ) < 5 ){
    print "Status: 302 Moved\n";
    print "Location: /\n\n";
    print "Move To <a href=\"/\">/</a>\n";

}
@files = &get_files( $PATH_INFO );
@files = ( @before, @files, @after );

######################
## %file_dataについて
#######################
# ファイル名のhashで、そのファイルの情報リストへのリファレンス
# $file_data{ FILENAME } 
#    = [ FILEHANDLE, LAST_MODIFIED, FILE_SIZE, DESCRIPTION ]
# 
# FILEHANDLE   : ファイルハンドル
# LAST_MODIFIED: そのファイルの最終更新時刻
# FILE_SIZE    : ファイルサイズ
# DESCRIPTION  : 日記の本文ファイルの場合、日付のhtml文
#                それ以外の場合、空
#
foreach my $f ( @files ){
    $file_data{$f} = &must_open($f);
    $file_data{$f}->[3] = &make_nikki_date($f);
}
############################################
# ここが本番
#
#print $size=&get_size,"\n";
#print $time=&get_time,"\n";
$size=&get_size;
$time=&get_time;
print &make_header($time,$size ),"\n";

## HEADリクエストでなければ、本文も表示。ログにも記録。
$is_diary_file = 0;
if ( $method ne "HEAD" ){

    &make_log() unless &isRobot;

    foreach my $f ( @files ){
	if ( $file_data{$f}->[3] eq "" ){
	    if ( $is_diary_file == 1 ){
		print $link;
	    }
	    $is_diary_file=0;
	}else{
	    print $file_data{$f}->[3];
	    $is_diary_file=1;
	}
	&include( $file_data{$f}->[0] );
#    print "$f: $file_data{$f}->[0],$file_data{$f}->[1],$file_data{$f}->[2]\n";
    }
}
foreach my $f ( @files ){
    undef $file_data{$f}->[0];
}
exit;

###
## PATH_INFOから、実ファイル名のリストを返却。
# PATH_INFOがファイル名のときはそのファイルを、
# PATH_INFOがディレクトリを示すときは、
# そのディレクトリ中の日記ファイルのリスト
# PATH_INFOが示すものがなければ、( 404 )を返すので、
# 404というファイルにファイルが無いときのメッセージを書いておくとよい。
#
sub get_files{
    $_ = shift;
    my @files;
    my $not_found = '404';
    s%^/%%; # 先頭の/を削除。

    if  ( m%(\d\d\d\d)/(\d\d)/(\d\d).html%){
	if ( -r $_ ){
	    $link = &make_diary_link_d($3,$2-1,$1-1900);
	    $link .= &make_diary_link_m($2-1,$1-1900);
	    @files=($_);
	}else{
	    @files=($not_found);
	}
#    }elsif  ( m%((\d\d\d\d)/(\d\d))/(\d+)\-(\d+).html%){
#	$link = &make_diary_link_m($3-1,$2-1900);
#	@files=map sprintf("%s/%02d",$1,$_).".html", ($4..$5);
	
    }elsif ( m%(\d\d\d\d)/(\d+)/?%){
	if ( -d $_ ){
	    $link = &make_diary_link_m($2-1,$1-1900);
	    s%/$%%;
	    opendir(DIR, $_) || die "can't opendir $_: $!";
	    my $dir = $_;
#	    @files = map $dir.$_,sort grep { /..\.html$/ } readdir(DIR);
	    @files = map $dir."/".$_,sort grep { /..\.html$/ } readdir(DIR);
	    closedir DIR;
	}else{
	    @files=($not_found);
	}
    }
    return @files;
}
###
## 指定ファイルハンドルを標準出力に出力する。
#
sub include{
    my $FH = shift;
    while( <$FH> ){
	print;
    }
}
###
## $timeと$sizeから、httpヘッダを作成します。
## &make_header( $time, $size )
#
sub make_header{
    my $time = shift;
    my $size = shift;
    $opt = "Last-Modified: ".&time2rfc1123( $time )."\n";
    $opt .= "Content-Length: $size\n";
    $opt .= "Content-type: text/html; charset=iso-2022-jp\n";
    $opt .="Content-Language: ja\n";
#    $opt .="Status: 200\n";
}
###
## &time2rfc1123($time)
## $timeをRFC1123形式にする。
#
sub time2rfc1123{
    my $time = shift;
    my ( $sec, $min, $hour, $mday, $mon, $year, $wday )
	= (gmtime( $time ))[0..6];
    my $date;
    $date = (qw(Sun Mon Tue Wed Thu Fri Sat))[$wday];
    $date .= ", ";
    $date .= sprintf("%02d",$mday);
    $date .= " ";
    $date .= (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$mon];
    $date .= " ";
    $date .= sprintf("%04d", 1900 + $year);
    $date .= " ";
    $date .= sprintf("%02d",$hour);
    $date .= ":";
    $date .= sprintf("%02d",$min);
    $date .= ":";
    $date .= sprintf("%02d",$sec);
    $date .= " GMT";
}

###
## 合計サイズを求める。
## $file_dataから、サイズを出力。
## $size = &get_size
#
sub get_size{
    my $size = 0;
    foreach my $f ( @files ){
	# ファイルの大きさ
	$size += $file_data{$f}->[2];
	# 日付部分の長さ
	$size += length $file_data{$f}->[3] ;
    }
    $size += length $link;
    return $size;
}
###
## 最終更新時刻(time)を求める。
## $file_dataから、timeを出力。
## $time = &get_time
#
sub get_time{
    my $time = 0;
    foreach my $f ( @files ){
	$time = ( $time >= $file_data{$f}->[1] ) ? $time : $file_data{$f}->[1];
    }
    return $time;
}

###
## 年月日を与え、その日からn日{前後}の年月日と曜日を得る。
## 返値は、localtime関数の[3..6]そのままなので注意
## next_day( $n, $mday, $mon, $year );
#
sub next_day {
    my $n = shift;
    my $sec_of_day = 1 * 60 * 60 * 24;
    my $time;
    # その年月日のtimeを取得。
    $time = timelocal( 0, 0, 0, @_ );
    $time += $sec_of_day * $n;
    (localtime($time))[3..6];
}
###
## &make_nikki_date( $diary_file )
## ファイルネームから日記の日付部分を生成する。
#
sub make_nikki_date{
    my $date = shift;
    my $link = "";
    my $year;
    my $mon;
    my $day;
    if ( ( $date =~ m%(\d+)/(\d+)/(\d+).html%)
	|| ( $date =~ m%(\d+)\\(\d+)\\(\d+).html%) ){

	$link = &get_date(&next_day(0,$3,$2-1,$1-1900));

    }
    &by_jis($link);
}
###
## (localtime())[3..6]を与え、
## <h3 class={red,blue,black}>n月1日(土)</h3>を返却。
#
sub get_date{
    my $day = shift;
    my $mon = shift;
    my $year= shift;
    my $wday= shift;
    my $class = "black";
    if ($wday == 0){
	$class = "red";
    }elsif($wday == 1){
	if (isSpecialday(&next_day(-1,$day,$mon,$year))){
	    $class = "red";
	}elsif ( isHappyMonday($day,$mon,$year) ){
	    $class = "red";
	}
    }elsif($wday == 6){
	$class = "blue";
    }
    if (isSpecialday($day,$mon,$year)){
	$class = "red";
    }
    $class = "<H3 class=\"$class\">";
    $class .= (1900+$year)."年".($mon+1)."月$day日(".&what_day($wday).")";
    $class .= "</H3>";
    &make_href(&make_url_d( 0, $day, $mon, $year),$class);
#    return $class;
}
###
## とりあえず、関数にしてみた。0-6を日-土に変換する関数。
#
sub what_day{
    (qw(日 月 火 水 木 金 土))[@_];
}

###
## 祝日判定関数。
## 多分、平成になる前はうまく判定できないはず。平成元年含む。
## あと、1980年以前は確実にだめっぽい。
#
sub isSpecialday{
    my $day = shift;
    my $month = shift;
    my $year = shift;
    my $var = "0101 0211 0429 0503 0504 0505 0720 0915 1103 1123 1223";
    $year += 1900;
    $month++;
    $var .= " 03".sprintf("%02d",int(20.8431+0.242194*($year-1980)-int(($year-1980)/4)));
    $var .= " 09".sprintf("%02d",int(23.2488+0.242194*($year-1980)-int(($year-1980)/4)));
    $var .= " 0115 1010" if ( $year < 2000 );
    my $date = sprintf("%02d%02d", $month++,$day);

    index($var ,$date ) >= 0;
}
###
## ハッピーマンデー判定関数(月曜であることは確認済として)
#
sub isHappyMonday{
    my $day = shift;
    my $month = shift;
    my $year = shift;
    $year += 1900;
    # 1月第２月曜
    # 10月第２月曜
    return 0 if ( $year < 2000 );
    if ( ($month ==0 || $month == 9 ) && ( $day > 7 ) && ( $day < 15 ) ){
	return 1;
    }else{
	return 0;
    }
}
###
## オープンするファイルのファイルハンドル、最終更新、サイズのリストを返す。
## ファイルが存在しない場合には、すべて 0 が返る。
#
sub must_open {
    my $name = shift;
    my $mtime;
    my $size;
    my $F;
    if ( -e $name){
	$mtime = (stat($name))[9];
	( $size = -s $name );
	$F = IO::File->new($name) or die "Cannot open $name: $!";
    }else{
	$F = $mtime = $size = 0;
    }
    return [ $F,$mtime,$size ];
}
###
## eucをjisに変換する 
##
#
sub by_jis{
    my $value = shift;

#    $value = &jcode::jis($value ,'euc');
#    &jcode::convert(*value ,'jis',);
#    &jcode::euc2jis(\$value );
    $value = nkf("-j -E",$value);
    return $value;
}
###
## 前後日付日記へのリンクを作成する。(day_mode)
#
sub make_diary_link_d{
    my $link;
    $link = "<div class=\"diarylink\">";
    $link .= "[".&make_href(&make_url_d(-1, @_),"前日")."]";
    $link .= "[".&make_href( "/","最新")."]";
    $link .= "[".&make_href(&make_url_d( 1, @_),"翌日")."]";
    $link .= "</div>";
    $link = &by_jis($link);
}
# ($n, $day, $mon, $year) --> "/$program/$year/$mon/{$day+$n}.html"
sub make_url_d{
    my ($str,$year,$mon,$day);
    ( $day, $mon, $year ) = &next_day(@_);
    $str = sprintf("%s/%04d/%02d/%02d.html",
		   $program, 1900 + $year, $mon + 1 , $day);
#    $str = $program.join("/",&next_day(@_)).".html";
}
###
## 前後月日記へのリンクを作成する。(month_mode)
#
sub make_diary_link_m{
    my $link;
    $link = "<div class=\"diarylink\">";
    $link .= "[".&make_href(&make_url_m(-1, 15, @_ ),"前月")."]";
    $link .= "[".&make_href(&make_url_m( 0, 15, @_ ),"当月")."]";
    $link .= "[".&make_href(&make_url_m( 1, 15, @_ ),"翌月")."]";
    $link .= "</div>";
    $link = &by_jis($link);
}
# ($n, $day, $mon, $year) --> "/$program/$year/$mon/{$day+$n}.html"
sub make_url_m{
    my ($str,$year,$mon,$day);
    ( $day, $mon, $year ) = &next_month(@_);
    $str = sprintf("%s/%04d/%02d/",
		   $program, 1900 + $year, $mon + 1);
#    $str = $program.join("/",&next_day(@_)).".html";
}

###
## 年月を与え、その日からn月{前後}の年月を得る。
## 返値は、localtime関数の[3..6]そのままなので注意
## next_day( $n, $mday, $mon, $year );
#
sub next_month {
    my $n = shift;
    my $sec_of_day = 20 * 60 * 60 * 24;
    my $time;
    # その年月日のtimeを取得。
    $time = timelocal( 0, 0, 0, @_ );
    $time += $sec_of_day * $n;
    (localtime($time))[3..6];
}
###
## &make_href( $uri, $link)
## 一番目の引数をURI、二番目の引数をリンク文字列と解釈して、
## <a href="$uri">$link</a>をつくる。
#
sub make_href{
    my $uri = shift;
    my $link = shift;
    my $href;
    $href = "<a href=\"$uri\">$link</a>";
}
###
##
#
sub isRobot{
    $agent =~ m(
		Gulliver
		|
		griffon/
		|
		ArchitextSpider
		|
		Lycos_Spider_
		|
		Googlebot/
		|
		Scooter
		|
		Slurp
		|
		MuscatFerret
		|
		Sidewinder
		|
		user\d+\.ip3000\.com
		|
		ia_archiver
		|
		ZyBorg
		|
		trufflepig tcunning
		|
		oBot
		|
		DIIbot
		|
		xyro_
		|
		Links2Go
		|
		FAST-WebCrawler
		|
		Pribot
		|
		InterNet-Html-Searcher
		|
		TITAN
		|
		JennyBot
		|
		Mercator
		|
		gazz
		|
		moget
		|
		Merc_resh
		|
		tivraSpider
		|
		bumblebee
		|
		Jabot
		|
		DiaGem
		|
		slysearch
		|
		crawler
		|
		Jeeves
		)xi

}
###
## ログに書き込むのだ。
##
#
sub make_log{
    if($referer eq ""){
	$referer = " - ";
    }elsif($referer =~ m{sharl/(d|nikki)/wlc?.html}i){
	$referer = &make_href($referer,'WLC');
    }elsif($referer =~ m{http://popopo.haun.org/}i){
	$referer = &make_href($referer,'PPP');
    }elsif($referer =~ m{http://cgi3.tky.3web.ne.jp/(%7e|~)happyend/hina/}i){
	$referer = &make_href($referer,'TPP');
    }elsif($referer =~ m{http://na01.shonan.ne.j(p|p:80)/~gorry/hina/}){
	$referer = &make_href($referer,'SDB');
    }elsif($referer =~ m{shugai/hina/}){
	$referer = &make_href($referer,'NER');
    }elsif($referer =~ m{http://amano.haun.org/}i){
	$referer = &make_href($referer,'ANK');
    }elsif($referer =~ m{kiwamoto/hina/}){
	$referer = &make_href($referer,'A-K');
    }elsif($referer =~ m{http://tae.haun.org/hina/}i){
	$referer = &make_href($referer,'TAE');
    }elsif($referer =~ m{vincent/metababoo/}){
	$referer = &make_href($referer,'MBB');
    }elsif($referer =~ /links*.htm/){
	$referer = &make_href($referer,'LNK');
    }elsif($referer =~m{http://fulufuru.haun.org/log}i){
	$referer = &make_href($referer,'LOG');
    }elsif($referer =~m{http://fulufuru.haun.org/}i){
	$referer = &make_href($referer,' f ');
    }elsif($referer =~ m{yatagawa/cats/diary.html}){
	$referer = &make_href($referer,'CAT');
    }elsif($referer =~ m{^file://}){
	$referer = &make_href($referer,'BMK');
    }else {
	$referer = &make_href($referer,'REF');
    }
    # path_info
    $pinfo = &make_href("/nikki.pl$PATH_INFO",$PATH_INFO);
    $pinfo .= ' 'x(20-length($PATH_INFO));
    
    # 日付、 リンク元, REMOTE_HOST名, Agent
    $outstring = "$date_now $pinfo $referer $rhost $ENV{'HTTP_USER_AGENT'}";
    # file の Lock..
    # file への書き出し
    open(ACCESS, "+<$log_file");
    flock(ACCESS, LOCK_EX);
#    seek(ACCESS,0,0);
    @lines = <ACCESS>;
    
    seek(ACCESS,0,0);
    print ACCESS "$outstring\n";
    
    for($i = 0; $i < $log_max -1 && $i <= $#lines; $i++){
	print ACCESS "$lines[$i]";
    }
    
    $filesize = tell(ACCESS);
    truncate(ACCESS, $filesize);
    flock(ACCESS, LOCK_UN);
    close(ACCESS);

}
