#!/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 /\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]を与え、 ##