#!/usr/bin/perl

##################################################################
# Program      : bbs.cgi(Perl)
# Date_written : 1999,09,03
# Author       : 良寛
##################################################################

require './jcode.pl';
#     ------------------------------------------------------------
#       requireは'ファイル名'で指定した、サブルーチンライブラリ
#      を、このプログラムの中に取り込む命令です。この場合、本プ
#      ログラムと同じディレクトリにある、jcode.pl（フリーソフト）
#      という日本語コード変換プログラムを取り込んで（結合して）
#      普通のサブルーチンのように使います。
#     ------------------------------------------------------------

#===　初期設定　==================================================

$max = 20;                     # 最大ログ件数
$bbs_data = "bbs.dat";         # ログ用ファイル
$sys_data = "sys.dat";         # システム用ファイル（現在ログ数）
$bbs_title = "良寛の掲示板";   # 掲示板のタイトル
$bbs_addr ="http://www.minc.ne.jp/~ryokan/cgi-bin/lecture";
#                              # 掲示板を置いてあるディレクトリ
$homepage ="http://www.minc.ne.jp/~ryokan";
#                              # 戻り先のページ
#     ------------------------------------------------------------
#      変数の初期値を設定します。トップに書いておくとメンテナンス
#      が容易です。
#      １行目の「#!/usr/bin/perl」はサーバーのＰｅｒｌのある場所
#      です。プロバイダにより少し異なりますので、プロバイダに聞い
#      て確かめてください。これは、ミンク（鹿児島のプロバイダ）の
#      場合です。
#     ------------------------------------------------------------

#===　フォームデータの受信　======================================

if ($ENV{'REQUEST_METHOD'} eq "POST") {
    read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    } 
else {
    $buffer = $ENV{'QUERY_STRING'};
}
#     ------------------------------------------------------------
#      データの送信の方法には、POSTとGETがあります。POSTかGETか
#      を知るには、環境変数$ENV{'REQUEST_METHOD'}という特殊な変
#      数を用います。
#      POSTの場合、
#          read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
#          とすると、$bufferに$ENV{'CONTENT_LENGTH'}で得られる
#          長さのデータがSTDINから代入されます。
#      GETの場合、
#          $ENV{'QUERY_STRING'}から$bufferに代入されます。
#
#      本プログラムは、POSTで送信されるようになっていますが、
#      掲示板が表示された初期段階（投稿するボタンが押される前）
#      では、GETが選択されています。
#     ------------------------------------------------------------

#===　受信データの編集　==========================================

@buffer = split(/&/, $buffer);
#     ------------------------------------------------------------
#      $bufferの内容を文字「&」で分離し、配列@bufferに代入します。
#     ------------------------------------------------------------

foreach $pair (@buffer) {
#     ------------------------------------------------------------
#      配列@bufferの要素を一つずつ$pairに代入します。
#     ------------------------------------------------------------

    local($name, $value) = split(/=/, $pair);
#     ------------------------------------------------------------
#      $pairの内容を文字「=」で分離し、ローカル変数$nameと$value
#      に代入します。
#      ローカル変数というのは、そのブロック内だけで有効な変数で、
#      ブロックの外で同じ変数名を用いても全く別なものになります。
#      通常、宣言しない変数はグローバル変数（全ての範囲で有効な
#      変数）になります。
#      また、当然のことですが、本プログラムが表示された時点では、
#      プログラムの実行は終了していますので、変数はクリアされて
#      います。
#     ------------------------------------------------------------
    
    $name  =~ tr/+/ /;
    $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
#     ------------------------------------------------------------
#      +をスペースに置き換え%のついた２桁のデータを１６進に変換
#      します。
#     ------------------------------------------------------------

    $value =~ s/</&lt;/ig;
    $value =~ s/>/&gt;/ig;
#     ------------------------------------------------------------
#      タグの禁止です。タグ「< >」を表示用の記号に変えます。
#      オプションのigは、大小文字にかかわらず全てと言う意味です。
#     ------------------------------------------------------------

    $value =~ s/\r\n/<br>/g;
    $value =~ s/\n/<br>/g;
    $value =~ s/\r/<br>/g;
#     ------------------------------------------------------------
#      改行復帰文字を<br>に変えます。
#     ------------------------------------------------------------

    $value =~ s/\,/&#44;/g;
#     ------------------------------------------------------------
#      半角コンマ「,」を表示用に変えます。
#     ------------------------------------------------------------
    
    &jcode'convert(*name,'sjis');
    &jcode'convert(*value,'sjis');
#     ------------------------------------------------------------
#      name、valueが付く変数すべて（$name、@name、%nameなど）を
#      sjisコードに変換します。
#     ------------------------------------------------------------

    &jcode'h2z_sjis(*value);
#     ------------------------------------------------------------
#      半角カナを全角カナに変換します。
#     ------------------------------------------------------------

    $FORM{$name} = $value;
#     ------------------------------------------------------------
#      連想配列%FORMに値を代入します。
#     ------------------------------------------------------------

}
if ($FORM{'mail'} eq "")       { $FORM{'mail'}='nodata'; }
if ($FORM{'url'}  eq "")       { $FORM{'url'} ='nodata'; }
if ($FORM{'url'}  eq "http://"){ $FORM{'url'} ='nodata'; }
if ($FORM{'title'}  eq "")     { $FORM{'title'} ='無題'; }
#     ------------------------------------------------------------
#      メールアドレス、ＵＲＬ、タイトルが入力されない場合、それ
#      ぞれnodata、nodata、無題を代入します。
#     ------------------------------------------------------------

#===　処理の振り分け　============================================

if ($FORM{'submit'} eq '投稿する'){
    &error_check;
    &store;
    &disp;
} else {
    &disp;
}
exit;
#     ------------------------------------------------------------
#      フォームの「投稿するボタン」が押されたとき、
#        &error_check（入力データのチェック）、&store（書き込み）
#        &disp（掲示板の表示）のサブルーチンを実行します。
#      そうでないとき、
#        つまりこの掲示板が始めて表示されたとき、
#        &disp（掲示板の表示）のサブルーチンを実行します。
#      exitはプログラムの終了です。なくても構いません。
#     ------------------------------------------------------------
#
#
#
#
#********************　SUBROUTINE　*******************************
#
#
#===　入力データエラーの検出　====================================

sub error_check {
    if ($FORM{'name'} eq "")    {push(@err,"名前がありません。");}
    if ($FORM{'message'} eq "") {push(@err,"本文がありません。");}
    if (@err>0) {&error;}
}
#     ------------------------------------------------------------
#      各データが空白の場合、配列@errにエラーメッセージを代入し
#      ます。
#      そして、@errの要素が0でないとき、サブルーチンerrorを実行
#      します。
#      push(配列,データ)は、配列に後ろからデータを代入します。
#     ------------------------------------------------------------

#===　表示　======================================================

sub disp {
    print "Content-type: text/html\n\n";
    print "<html><head><title>$bbs_title</title></head>\n";
    print "<body bgcolor=FEF3D6 text=000000 link=0000FF ";
    print "vlink=800080 alink=FF0000>\n";
    print "<p align=center>\n";
    print "<font color=\"#008080\" ";
    print "size=6 face=\"ＭＳ ゴシック\">\n";
    print "<b>$bbs_title</b></font></p>\n";
    print "<hr>\n";
    print "<p align=right>\n";
    print "[<a href=\"$homepage\">トップにもどる</a>]</p>\n";
    print "<form action=\"bbs.cgi\" method=POST>\n";
    print "<blockquote>\n";
    print "<table border=0>\n";
    print "<tr><td><b>お名前</b></td>\n";
    print "<td><input type=text size=20 name=\"name\">";
    print "</td></tr>\n";
    print "<tr>\n";
    print "<td><b>Ｅメール</b></td>\n";
    print "<td><input type=text size=20 name=\"mail\">";
    print "</td></tr>\n";
    print "<tr><td><b>タイトル</b></td>\n";
    print "<td><input type=text size=30 name=\"title\">";
    print "</td></tr>\n";
    print "<tr><td><b>ＵＲＬ</b></td>\n";
    print "<td><input type=text size=45 name=\"url\" ";
    print "value=\"http://\"></td>\n";
    print "</tr>\n";
    print "<tr><td colspan=2><b>メッセージ</b><br>\n";
    print "<textarea name=\"message\" rows=7 cols=55>";
    print "</textarea><br>\n";
    print "<input type=submit name=\"submit\" ";
    print "value=\"投稿する\">\n";
    print "<input type=reset value=\"リセット\">\n";
    print "</form>\n";
    print "<p><font size=2>・ お名前とメッセージ欄は必須";
    print "です。<br>\n";
    print "・ 記事は最大$max件まです。古い記事から削除さ";
    print "れます。<br>\n";
    print "</font></p>\n";
    print "</td></tr>\n";
    print "</table></blockquote>\n";
    print "<hr>\n";
#     ------------------------------------------------------------
#      ここまでが、入力フォームの表示部分です。いちいちＨＴＭＬ
#      のタグを書くのは面倒ですから、FrontPage Expressなどで、
#      作成してから、ソースをコピーしてprintの中に組み込めば、
#      簡単です。
#      「"」の中で「"」を使う場合は、その前に「\」を付けます。
#     ------------------------------------------------------------
    
    if(!open (IN,"$bbs_data")){
        push(@err,'bbs_data read error');
        &error;
    }
        @lines = <IN>;
    close (IN);
#     ------------------------------------------------------------
#      ログデータ($bbs_data)を、ハンドル名INで読み込みます。読
#      み込まれたデータは、@linesの中にすべて代入されます。
#      if(!open (IN,"$bbs_data"))は、オープンしそれが不能の場合
#      に真になります。
#      つまり、
#      「ファイルをオープンするが、もし何かの原因でオープンでき
#      なかった場合にはエラー処理{ブロック}を実行する。オープン
#      できたら、@linesにログデータを代入する。」
#      という意味になります。
#     ------------------------------------------------------------

    $n = @lines;
#     ------------------------------------------------------------
#      @linesの要素数（ログ数）を$nに代入します。
#     ------------------------------------------------------------

    if (!open (SYSOUT,">$sys_data")){
        push(@err,'sys_data write error');
        &error;
    }
        flock(SYSOUT,2);
        print SYSOUT "$n\n";
        flock(SYSOUT,8);
    close (SYSOUT);
#     ------------------------------------------------------------
#      $sys_dataファイルに、現在保存されているログ数$nを書き込
#      みます。
#      flock(SYSOUT,2)は、同時に書き込む人がいた場合、ファイル
#      が壊れてしまうので、ロックをかけます。
#      flock(SYSOUT,8)は、反対にロックを解除します。
#     ------------------------------------------------------------

    @rev_lines = reverse(@lines);
#     ------------------------------------------------------------
#      @linesのデータは新着順に並んでいますが、reverse( )で逆順
#      に並べ替え、@rev_linesに代入します。
#     ------------------------------------------------------------

    $i = 1;                    # 表示ログ数の初期値
    
    foreach $line (@rev_lines){
        chop($line);
#     ------------------------------------------------------------
#      chop($line)は、$lineのデータの後ろから一文字（ここでは、
#      改行文字「\n」)を切り捨てます。このように、ファイルの一
#      人分のデータ（１レコード）は、次のレコードと「\n」で区切
#      られています。
#     ------------------------------------------------------------

        ($name,$mail,$title,$url,$message,$date) = split(/\|\|\|/,$line);
#     ------------------------------------------------------------
#      レコードとレコードは「\n」で区切られますが、１レコードの
#      中の区切り（セパレータ）は何でも設定できます。本プログラ
#      ムでは「|||」を使っています。したがって、一人分のレコー
#      ドは次のような構造になっています。
#
#       名前|||メール|||タイトル|||ＵＲＬ|||メッセージ|||日付\n
#
#      $lineを「|||」で分解し、順に$name、$mail、・・・に代入し
#      ます。
#     ------------------------------------------------------------

        print "<table border=0>\n";
        print "<tr>\n";
        print "<td><font color=\"#008040\"><b>$title</b>";
        print "</font></td>\n";
        print "<td width=3></td>\n";
        if ($mail eq 'nodata'){
            print "<td>投稿者：\n";
            print "<font color=\"#0000FF\"><b>$name</b></font>\n";
        }else{
            print "<td>投稿者：<a href=mailto:$mail>\n";
            print "<font color=\"#0000FF\">";
            print "<b>$name</b></font></a>\n";
        }
        print "投稿日：$date</td>\n";
        print "<td width=3></td>\n";
        if ($url eq 'nodata'){
            print "<td>　</td>\n";
        }else{
            print "<td><a href=\"$url\"><b>ＨＰ</b></a></td>\n";
        }
        print "</tr>\n";
        print "</table>\n";
        print "<table border=0><tr><td></td><td>\n";
        print "$message\n";
        print "</td></tr></table>\n";
        print "<hr>\n";
#     ------------------------------------------------------------
#      一人分のデータの表示です。
#     ------------------------------------------------------------

        $i++;
        if ($i > $max){
            last;
        }
#     ------------------------------------------------------------
#      $i++は、$i=$i+1 でも同じです。$iを一つカウントして、もし
#      $i>$max ならループから抜け出します。lastはループの外にジ
#      ャンプさせるという意味になります。
#     ------------------------------------------------------------

    }
    print "</body></html>\n";
}

#===　書き込み　==================================================

sub store {
    ($sec,$min,$hour,$day,$mon,$year,$wday) = localtime(time);
    $mon++;
    @week = ("日","月","火","水","木","金","土");
    $yobi = $week[$wday];
    $date  = "$year/$mon/$day/（$yobi）$hour:$min";
#     ------------------------------------------------------------
#      送信時の時刻を取得します。（perl4.htmlで解説済み）
#     ------------------------------------------------------------

    $data  = "$FORM{'name'}|||";
    $data .= "$FORM{'mail'}|||";
    $data .= "$FORM{'title'}|||";
    $data .= "$FORM{'url'}|||";
    $data .= "$FORM{'message'}|||";
    $data .= "$date\n";
#     ------------------------------------------------------------
#      $dataに名前、メールアドレス、タイトル、ＵＲＬ、メッセー
#      ジ、日付の順にセパレータ「|||」をはさみながら、代入しま
#      す。セパレータは恐らく使われないであろう文字列にします。
#      このようにしても、タイトルなどに偶然に「|||」が使われた
#      場合には、うまく表示されません。
#      $data .= "$date" は $data = $data + "$date" と書いても同
#      じです。
#     ------------------------------------------------------------

    if(!open (SYSIN,"$sys_data")){
        push(@err,'sys_data read error');
        &error;
    }
        $n = <SYSIN>;
    close (SYSIN);
#     ------------------------------------------------------------
#      $sys_dataから現在記録されているログ数を読み込みます。も
#      し、ファイルがオープンできない場合には@errにエラーメッセ
#      ージをpushしてから、エラーサブルーチンにジャンプします。
#      dispサブルーチンが最初実行されるので、$nにはログ数が代入
#      されているような気がしますが、「投稿する」ボタンが押され
#      る前は、プログラムの実行は終了しているので、変数はクリア
#      されています。それで、再度ログ数を読み込むのです。
#     ------------------------------------------------------------

    if ($n > $max*1.5){
        if(!open (IN,"$bbs_data")){
            push(@err,'bbs_data read error');
            &error;
        }
            @lines = <IN>;
        close (IN);
#     ------------------------------------------------------------
#      ここが少し理解し難いでしょう。
#      if ($n > $max*1.5) は、最大保存ログ数$maxの1.5倍より、現
#      在のログ数が大きかったらということになりますが、この1.5
#      倍の値がなかったとすると、ログ数が$maxを超えたらそれ以降
#      投稿のたびに全てのデータを読み込んだ後、最も古いデータを
#      １件削除して新データを追加し、全てを上書きしなおすという
#      手間が必要になります。
#      当然、アクセスに時間がかかりイライラすることになります。
#      そこで、$maxの1.5倍をリミットにして、それを超えたときだ
#      け、$max以上の過去ログを削除し保存しなおすのです。
#      そうすると、$max〜$max*1.5の間は書き換えなしで追加のみで
#      済むことになりアクセスが軽快になります。1.5の数値は適当
#      に調整してください。
#      ここは、$max*1.5を$nが超えた場合です。@linesの中に過去ロ
#      グを全て読み込みます。
#     ------------------------------------------------------------

        push(@lines,$data);
#     ------------------------------------------------------------
#      @linesに新記事を後ろから追加（push）します。
#     ------------------------------------------------------------

        @lines = reverse(@lines);
#     ------------------------------------------------------------
#      @linesのデータは新着順に並んでいますが、reverse( )で逆順
#      に並べ替え、再度@linesに代入します。
#     ------------------------------------------------------------

        $i=$max;
        foreach $line(@lines){
            push(@work,$line);
        $i--;
        if ($i < 1){ last; }
        }
#     ------------------------------------------------------------
#      @linesのデータを１件づつ取り出して$lineに代入し、@work
#      に後ろから追加します。
#      もし、ログ数が$maxになったらforeachループを抜け出します。
#     ------------------------------------------------------------

        @work = reverse(@work);
#     ------------------------------------------------------------
#      @workのデータを、reverse( )で古いデータから順に並べ替え、
#      @rev_linesに代入します。
#     ------------------------------------------------------------

        if (!open (OUT,">$bbs_data")){
            push(@err,'bbs_data write error');
            &error;
        }
            flock(OUT,2);
            print OUT @work;
            flock(OUT,8);
        close (OUT);
#     ------------------------------------------------------------
#      $max分のデータを上書き保存します。
#      flock(SYSOUT,2)は、ファイルにロックをかけます。
#      flock(SYSOUT,8)は、反対にロックを解除します。同時アクセ
#      スの際のファイル破壊防止のため。
#     ------------------------------------------------------------

    }else{
    if (!open (OUT,">>$bbs_data")){
        push(@err,'bbs_data write error');
        &error;
    }
        flock(OUT,2);
        print OUT "$data";
        flock(OUT,8);
    close (OUT);
    }
#     ------------------------------------------------------------
#      $max*1.5までは、追加書き込みだけで済みます。
#     ------------------------------------------------------------

}

#===　エラー表示サブルーチン　====================================

sub error {
    print "Content-type: text/html\n\n";
    
    print "<html><head><title>エラー</title></head>\n";
    print "<body>\n";
    print "<center><b>ERROR</b><br>\n";
    foreach (@err){
        print "$_<br>\n";
    }
    print "</center>\n";
    print "</body></html>\n";
    exit;
}
#     ------------------------------------------------------------
#      @errに入っているエラーメッセージをひとつずつ取り出し、特
#      殊変数$_に代入（省略時は特殊変数$_が使われます。）し、表
#      示します。
#      exitで終了。
#     ------------------------------------------------------------
#
#
#
#
#
#===　テスト実行用（完成時に削除）================================

sub test {
    print "Content-type: text/html\n\n";
    
    print "<html><head><title>エラー</title></head>\n";
    print "<body>\n";
    print "\$m=$m\n";
    print "\$n=$n\n";
    print "\$max=$max\n";
    print "\$store_no=$store_no\n";
    print "@work\n";
    print "</body></html>\n";
    exit;
}
#     ------------------------------------------------------------
#      このサブルーチンは、実行テストを行ったときの変数表示用に
#      使いました。プログラムがちゃんと動けば削除することになり
#      ますが、ここでは初学者のためにあえて残骸を残しておきます。
#     ------------------------------------------------------------