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

n月1日(土)

を返却。 # 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 = "

"; $class .= (1900+$year)."年".($mon+1)."月$day日(".&what_day($wday).")"; $class .= "

"; &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月第2月曜 # 10月第2月曜 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 = "
"; $link .= "[".&make_href(&make_url_d(-1, @_),"前日")."]"; $link .= "[".&make_href( "/","最新")."]"; $link .= "[".&make_href(&make_url_d( 1, @_),"翌日")."]"; $link .= "
"; $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 = "
"; $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 .= "
"; $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、二番目の引数をリンク文字列と解釈して、 ## $linkをつくる。 # sub make_href{ my $uri = shift; my $link = shift; my $href; $href = "$link"; } ### ## # 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 = ; 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); }