#!/home/local/usr/inet/bin/perl5

#==================================================================
$g_name = "TwnLounge Ver2.07";
#
# Copyright (C) 1997-1999 とほほ http://wakusei.cplaza.ne.jp/twn/
#
# 法人/個人/私用/商用を問わず、使用・改造・再配布可能です。
#==================================================================

# 履歴
# 1999/05/23 2.00 大改造版
# 1999/05/23 2.01 空行が空行として表示されないバグを修正
# 1999/05/30 2.02 utimeコマンドにパスワードチェックを追加
# 1999/05/30 2.03 メッセージ末尾の改行を削除するように修正
# 1999/05/30 2.04 「>」に加えて「＞」も引用と見なすようにした
# 1999/05/30 2.05 タイトルも検索対象になるように修正
# 1999/06/06 2.06 ロックファイルのパーミッションを755から0755に修正
# 1999/06/06 2.06 引用文の色を変更
# 1999/10/03 2.07 誤ってロックファイルを消してしまうことがあるバグを修正

# 漢字コード変換ライブラリ
require "jcode.pl";

# 日本時刻のための環境変数
$ENV{'TZ'} = "JST-9";

# グローバル変数
$g_dir = "wwwlng";
@g_wdays = ( "日", "月", "火", "水", "木", "金", "土" );
$g_return_url = "http://www.kcn.ne.jp/~blue/index.html";
$g_default_number = 50;
$g_lockdir = "../lock";
$g_lockfile = "$g_lockdir/wwwlng.loc";
$g_sendmail = '/usr/lib/sendmail';      # メール送信コマンド
$g_show_questioner = 0;
$g_passwd = "1234";
$g_search_log = "search.txt";

#
# メインルーチン
#
{
    # カレントディレクトリの移動
    chdir($g_dir);

    # フォームデータを読み込む
    if (!&readParam()) {
        &showErrorPage("データの読み込みに失敗しました。");
        exit(0);
    }

    # それぞれのページ表示にジャンプ
    if ($#ARGV == -1) {
        &showTopPage($g_default_number);        # トップ
    } elsif ($ARGV[0] eq "dir") {
        &showDirPage($ARGV[1]);                 # トピック一覧
    } elsif ($ARGV[0] eq "list") {
        &showTopicListByDays($ARGV[1]);         # トピック一覧
    } elsif ($ARGV[0] eq "print") {
        &showTopicPage($ARGV[1]);               # トピック表示
    } elsif ($ARGV[0] eq "showall") {
        &showLatelyPage($ARGV[1]);              # 全文表示
    } elsif ($ARGV[0] eq "new") {
        &showNewTopicPage();                    # 新規トピック入力
    } elsif ($ARGV[0] eq "search") {
        &showSearchPage();                      # 検索
    } elsif ($ARGV[0] eq "test") {
        &showTestPage();                        # 自己診断
    } elsif ($ARGV[0] eq "new2") {
        &appendTopic();                         # トピック追加
    } elsif ($ARGV[0] eq "append") {
        &appendMessage($ARGV[1], 1);            # 発言追加
    } elsif ($ARGV[0] eq "delete") {
        shift(@ARGV);
        &deleteTopic(@ARGV);
    } elsif ($ARGV[0] eq "utime") {
        shift(@ARGV);
        &utimeTopic(@ARGV);                     # ファイルの更新時刻を合わせる
    } else {
        &showErrorPage("URLの指定が誤っています。");
    }

    exit(0);
}

#
# トップページ
#
sub showTopPage #($num)
{
    local($num) = @_;
    local($dir, @dirs, $file, @files);

    &printHeader("ラウンジ(最近更新されたトピック)");
    if ($g_return_url) {
        print "<A HREF=\"$g_return_url\">[戻る]</A>\n";
    }
    print "<A HREF=\"http://www.kcn.ne.jp/~blue/cgi/wwwlng.htm\">[使用上の注意]</A>\n";
    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?new\">[新規質問]</A>\n";
    print "<A HREF=\"#folders\">[過去のフォルダ一覧]</A>\n";
    print "<HR>\n";

    if (0) {
    print "<FORM METHOD=POST TARGET=\"_blank\" ACTION=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?search\">\n";
    print "<UL>\n";
    print "<LI>ラウンジの全トピックから単語 ";
    print "<INPUT TYPE=text SIZE=10 NAME=\"WORD\"> ";
    print "を <INPUT TYPE=submit VALUE=\"検索\">\n";
    print "<LI>過去 <INPUT TYPE=text NAME=\"t1\" SIZE=3 VALUE=3>\n";
    print "日分のトピックを\n";
    print "<INPUT TYPE=button VALUE=\"一覧表\示\" ";
    print "onClick=\"window.open('http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?list+'+this.form.t1.value, '_blank')\"> / \n";
    print "<INPUT TYPE=button VALUE=\"全文表\示\" ";
    print "onClick=\"window.open('http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?showall+'+this.form.t1.value, '_blank')\">\n";
    print "</UL>\n";
    print "</FORM>\n";
    }
#---------
    print "Lounge: Created by<img src=\"http://www.kcn.ne.jp/cgi-bin/blue/imgcheck.cgi\" width=\"1\" height=\"1\">\n";
        print "<A HREF=\"http://www.wakusei.ne.jp/twn/wwwlng.cgi\">[とほほ]</A>\n";
#        print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[blue]</A>\n";

#--------
        print "<BR>これまでのまとめは「<A HREF=\"http://www.kcn.ne.jp/~blue/wwwqa.html\">Ｑ＆Ａ集</A>」にあります。\n";
        print "<BR>\n";
#--------
       print "<A HREF=\"http://www.kcn.ne.jp/~blue/\">[H.P]</A>\n";
        print "<A HREF=\"http://www.kcn.ne.jp/~blue/cgi/\">[CGI]</A>\n";
        print "<A HREF=\"http://www.kcn.ne.jp/~blue/photo/\">[PHOTO]</A>\n";
        print "<A HREF=\"http://www.kcn.ne.jp/~blue/link/\">[LINK]</A>\n";
        print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/tbbs.cgi\">[BBS]</A>\n";
        print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/hbbs.cgi\">[Travel BBS]</A>\n";
        print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/custombbs.cgi\">[落書き帳]</A>\n";
#------------

    #print "<HR>\n";
    #print "<FONT COLOR=red>現在、このラウンジは試験運用中です。";
    #print "試験運用中に書き込まれたデータはすべて消去しますので、";
    #print "ご協力くださる方は、テストデータを書き込み、試験のご協力を";
    #print "お願いいたします。</FONT>\n";
    #print "<HR>\n";

    # 最近更新されたトピックの一覧を得る
    opendir(DIR, ".");
    foreach $dir (grep { !/^\./ && -d "$_" } readdir(DIR)) {
        push(@dirs, $dir);
        opendir(DIR2, $dir) || next;
        foreach $file (grep { !/^\./ && -f "$dir/$_" } readdir(DIR2)) {
            push(@files, (stat("$dir/$file"))[9] . " $dir/$file");
        }
        closedir(DIR2);
    }
    closedir(DIR);
    @dirs = sort(@dirs);
    @files = sort { $b <=> $a } @files;
    splice(@files, $num);

    # 最近更新されたトピック一覧
    print "<P>\n";
    &printTopicList(@files);

    # フォルダ一覧
    if ($#dirs >= 0) {
        print "<P>\n";
        print "<DL>\n";
        print "<DT><A NAME=\"folders\"><FONT COLOR=red><B>過去のフォルダ一覧</B></FONT></A>\n";
        print "<DD>\n";
        foreach $dir (@dirs) {
            print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?dir+$dir\">[$dir]</A>\n";
        }
        print "</DT>\n";
        print "</DL>\n";
    }

    # フッタ
    &printFooter();
}

#
# トピック一覧
#
sub showDirPage #($dir)
{
    local($dir) = @_;
    local($file, @files);

    if ($dir =~ /(^\/|\.\.)/) {
        &showErrorPage("他のフォルダを参照することはできません。");
        exit(0);
    }

    &printHeader("ラウンジ(フォルダ$dirのトピック一覧)");

    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[戻る]</A>\n";
    print "<HR>\n";

    # ファイルの日付とファイル名の一覧を得る
    opendir(DIR, $dir);
    foreach $file (grep { !/^\./ } readdir(DIR)) {
        push(@files, (stat("$dir/$file"))[9] . " $dir/$file");
    }
    closedir(DIR);

    # フォルダのファイル一覧
    &printTopicList(@files);

    # フッタを表示する
    print "<P>\n";
    &printFooter();
}

#
# トピック一覧ページ
#
sub showTopicListByDays #($days)
{
    local($days) = @_;
    local($limittime, $mtime);
    local($dir, @dirs, $file, @files);

    &printHeader("ラウンジ(過去$days日分一覧表\示)");
    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[戻る]</A>\n";
    print "<HR>\n";

    # 過去n日分のトピック一覧を得る
    $limittime = time() - ($days * 3600 * 24);
    opendir(DIR, ".");
    foreach $dir (grep { !/^\./ && -d "$_" } readdir(DIR)) {
        push(@dirs, $dir);
        opendir(DIR2, $dir) || next;
        foreach $file (grep { !/^\./ && -f "$dir/$_" } readdir(DIR2)) {
            $mtime = (stat("$dir/$file"))[9];
            if ($mtime >= $limittime) {
                push(@files, "$mtime $dir/$file");
            }
        }
        closedir(DIR2);
    }
    closedir(DIR);
    @files = sort { $b <=> $a } @files;

    # トピックの中身を表示する
    &printTopicList(@files);

    &printFooter();
}

#
# トピック表示ページ
#
sub showTopicPage #($file)
{
    local($file) = @_;

    if ($file =~ /(^\/|\.\.)/) {
        &showErrorPage("他のフォルダを参照することはできません。");
        exit(0);
    }

    open(IN, $file);
    $subject = <IN>;
    $subject =~ s/^Subject: //;
    $subject =~ s/[\r\n]+$//;
    &printHeader($subject);
    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[戻る]</A>\n";
    &printTopicContent(*IN);
    close(IN);

    print "<HR>\n";
    print "<FONT COLOR=red><B>追加発言</B></FONT>\n";
    print "<FORM METHOD=POST ACTION=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?append+$file\">\n";
    print "<NOBR>\n";
    print "■ お名前(ペンネーム可)<BR>\n";
    print "　　<INPUT TYPE=text SIZE=50 NAME=\"NAME\"><BR>\n";
    print "■ メールアドレス(省略可、半角で入力)<BR>\n";
    print "　　<INPUT TYPE=text SIZE=50 NAME=\"EMAIL\"><BR>\n";
    print "■ ホームページアドレス(省略可、半角で入力)<BR>\n";
    print "　　<INPUT TYPE=text SIZE=50 NAME=\"HPAGE\"><BR>\n";
    print "■ 発言(エラー時再送信禁止)<BR>\n";
    print "　　<INPUT TYPE=checkbox NAME=\"SOLVED\">";
    print "←解決時は質問者本人がここをチェックしてください。<BR>\n";
    print "　　<TEXTAREA ROWS=5 COLS=60 NAME=\"MESSAGE\"></TEXTAREA><BR>\n";
    print "　　<INPUT TYPE=submit VALUE=\" 送信 \">\n";
    print "<INPUT TYPE=reset VALUE=\" 取消 \">\n";
    print "</NOBR>\n";
    print "</FORM>\n";
    &printFooter();
}

#
# 全文表示ページ
#
sub showLatelyPage #($days)
{
    local($days) = @_;
    local($limittime, $mtime);
    local($dir, @dirs, $file, @files);

    &printHeader("ラウンジ(全文表\示)");
    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[戻る]</A>\n";

    # 過去n日分のトピック一覧を得る
    $limittime = time() - ($days * 3600 * 24);
    opendir(DIR, ".");
    foreach $dir (grep { !/^\./ && -d "$_" } readdir(DIR)) {
        push(@dirs, $dir);
        opendir(DIR2, $dir) || next;
        foreach $file (grep { !/^\./ && -f "$dir/$_" } readdir(DIR2)) {
            $mtime = (stat("$dir/$file"))[9];
            if ($mtime >= $limittime) {
                push(@files, "$mtime $dir/$file");
            }
        }
        closedir(DIR2);
    }
    closedir(DIR);
    @files = sort { $b <=> $a } @files;

    # トピックの中身を表示する
    foreach $file (@files) {
        $file = (split(/ /, $file))[1];
        open(IN, $file);
        $subject = <IN>;
        $subject =~ s/^Subject: //;
        $subject =~ s/[\r\n]+$//;
        $hflag = 0;
        print "<HR>\n";
        print "<H4><FONT COLOR=green>■ $subject</FONT></H4>\n";
        &printTopicContent(*IN);
        print "<HR>\n";
        print "<A HREF='http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?print+$file'>[この(↑)トピックに追加発言]</A>\n";
        close(IN);
    }

    &printFooter();
}

#
# 新規トピック入力ページ
#
sub showNewTopicPage
{
    &printHeader("ラウンジ(新規質問)");

    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[戻る]</A>\n";
    print "<HR>\n";
    print "<FORM METHOD=POST ACTION=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?new2\">\n";
    print "■ タイトル<BR>\n";
    print "　　・「〜するには？」のような質問形式にしてください。<BR>\n";
    print "　　・「〜について」の形式は好ましくありません。<BR>\n";
    print "　　<INPUT TYPE=text SIZE=50 NAME=\"SUBJECT\"><BR>\n";
    print "<P>■ お名前<BR>\n";
    print "　　・ペンネームでもかまいません。<BR>\n";
    print "　　<INPUT TYPE=text SIZE=50 NAME=\"NAME\"><BR>\n";
    print "<P>■ メールアドレス<BR>\n";
    print "　　・例：foo\@www.xxx.zzz<BR>\n";
    print "　　・半角文字で入力してください。<BR>\n";
    print "　　・空欄でもかまいません。<BR>\n";
    print "　　<INPUT TYPE=text SIZE=50 NAME=\"EMAIL\"><BR>\n";
    if (-x $g_sendmail) {
        print "　　回答をメールで受信しますか？\n";
        print "<INPUT TYPE=radio NAME=\"REPLY\" VALUE=\"on\" CHECKED>はい\n";
        print "<INPUT TYPE=radio NAME=\"REPLY\" VALUE=\"\">いいえ<BR>\n";
    }
    print "<P>■ ホームページアドレス<BR>\n";
    print "　　・例：http://www.xxx.zzz/<BR>\n";
    print "　　・半角文字で入力してください。<BR>\n";
    print "　　・空欄でもかまいません。<BR>\n";
    print "　　<INPUT TYPE=text SIZE=50 NAME=\"HPAGE\"><BR>\n";
    print "<P>■ 質問内容<BR>\n";
    print "　　・ホームページ作成に関する質問以外はご遠慮ください。<BR>\n";
    print "　　・あまり長文にならないようにしてください。<BR>\n";
    print "　　・エラー発生時、再送信すると二重送信になることがあります。<BR>\n";
    print "　　・回答が得られたら、お礼書き込み時に[解決]チェックしてください。<BR>\n";
    print "　　<TEXTAREA ROWS=5 COLS=60 NAME=\"MESSAGE\"></TEXTAREA><BR>\n";
    print "<P>\n";
    print "　　<INPUT TYPE=submit VALUE=\" 送信 \">\n";
    print "<INPUT TYPE=reset VALUE=\" 取消 \">\n";
    print "</FORM>\n";
    &printFooter();
}

#
# 検索ページ
#
sub showSearchPage
{
    # 出力時にバッファリングしないようにする
    $| = 1;

    &printHeader("ラウンジ(検索)");
    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[戻る]</A>\n";
    print "<HR>\n";

    # キーワードが無ければ終了
    if (!$FORM{'WORD'}) {
        goto done;
    }

    # 複数のワードを分割する
    @words = split(/ +/, $FORM{'WORD'});

    # メタ文字を無効化する
    for ($i = 0; $i <= $#words; $i++) {
        $words[$i] =~ s/([\+\*\.\?\^\$\[\-\]\|\(\)\\])/\\$1/g;
    }

    # 検索キーワードをロギングする
    if (-f $g_search_log) {
        open(OUT, ">> $g_search_log");
        for ($i = 0; $i <= $#words; $i++) {
            print OUT "$words[$i]\n";
        }
        close(OUT);
    }

    # ディレクトリの一覧を得る
    opendir(DIR, ".");
    @dirs = grep { !/^\./ && (-d "$_") } readdir(DIR);
    closedir(DIR);

    print "<DL>\n";
    foreach $dir (@dirs) {
        opendir(DIR, $dir);
        @files = grep { -f "$dir/$_" } readdir(DIR);
        foreach $file (@files) {
            &printSearchResult("$dir/$file", @words);
        }
        closedir(DIR);
    }
    print "</DL>\n";

  done:
    &printFooter();
}

#
# 自己診断ページ
#
sub showTestPage
{
    &printHeader("ラウンジ(自己診断)");
    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[戻る]</A>\n";
    print "<HR>\n";
    print "OK. CGIは正常に動作しています。<BR>\n";
    if (!-x $g_sendmail) {
        print "NG. $g_sendmailがありません。<BR>\n";
    }
    if (!-d $g_lockdir) {
        print "NG. $g_lockdirがありません。<BR>\n";
    }
    if (-d $g_lockfile) {
        print "NG. $g_lockfileが残っています。削除してください。<BR>\n";
    }
    &printFooter();
}

#
# エラーページ
#
sub showErrorPage #($errmsg)
{
    local($errmsg) = @_;

    &printHeader("ラウンジ(エラー)");
    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[戻る]</A>\n";
    print "<HR>\n";
    print $errmsg;
    &printFooter();
}

#
# トピック追加
#
sub appendTopic
{
    # 入力パラメータのチェック
    if ($FORM{'SUBJECT'} =~ /^[ 　\r\n]*$/) {
        &showErrorPage("タイトルが入力されていません。");
        exit(0);
    }
    if ($FORM{'NAME'} =~ /^[ 　\r\n]*$/) {
        &showErrorPage("名前が入力されていません。");
        exit(0);
    }
    if ($FORM{'MESSAGE'} =~ /^[ 　\r\n]*$/) {
        &showErrorPage("内容が入力されていません。");
        exit(0);
    }

    # ロックをかける
    if (!&fileLock()) {
        &showErrorPage("ファイルのロックに失敗しました。");
        exit(0);
    }

    # 使用されていないファイル名を探す
    if (!($file = &determineFileName())) {
        &showErrorPage("新規質問の書き込みに失敗しました。");
        goto done;
    }

    # サブジェクトを書き込む
    if (!open(OUT, "> $file")) {
        &showErrorPage("新規質問の書き込みに失敗しました。");
        goto done;
    }
    print OUT "Subject: $FORM{'SUBJECT'}\n";
    if (($FORM{'REPLY'} eq "on") && ($FORM{'EMAIL'} =~ /.*@.*/)) {
        print OUT "Reply-To: $FORM{'EMAIL'}\n";
    }
    close(OUT);

    # メッセージを追加する
    &appendMessage($file, 0);

  done:
    &fileUnlock();
}

#
# 発言追加
#
sub appendMessage #($file, $lockflag)
{
    local($file, $lockflag) = @_;

    if ($file =~ /(^\/|\.\.)/) {
        &showErrorPage("他のフォルダを参照することはできません。");
        exit(0);
    }

    # 入力パラメータのチェック
    if ($FORM{'NAME'} =~ /^[ 　\r\n]*$/) {
        &showErrorPage("名前が入力されていません。");
        exit(0);
    }
    if ($FORM{'MESSAGE'} =~ /^[ 　\r\n]*$/) {
        &showErrorPage("内容が入力されていません。");
        exit(0);
    }

    # ロックをかける
    if ($lockflag) {
        if (!&fileLock()) {
            &showErrorPage("ファイルのロックに失敗しました。");
            exit(0);
        }
    }

    # トピックに発言を追加する
    $msg = "========================================\n";
    $msg .= "From: $FORM{'NAME'}\n";
    if ($FORM{'EMAIL'} ne "") {
        $FORM{'EMAIL'} =~ s/'//g;
        $msg .= "E-Mail: $FORM{'EMAIL'}\n";
    }
    if ($FORM{'HPAGE'} ne "") {
        $FORM{'HPAGE'} =~ s/'//g;
        $msg .= "HomePage: $FORM{'HPAGE'}\n";
    }
    ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime();
    $date = sprintf("%04d/%02d/%02d(%s) %02d:%02d:%02d",
        $year + 1900, $mon + 1, $mday, $g_wdays[$wday], $hour, $min, $sec);
    $msg .= "Date: $date\n";
    if ($FORM{'SOLVED'} eq "on") {
        $msg .= "Solved: $FORM{'SOLVED'}\n";
    }
    $msg .= "\n";
    $msg .= "$FORM{'MESSAGE'}\n";
    open(OUT, ">> $file");
    $old = select(OUT); $| = 1; select($old);
    print OUT $msg;
    close(OUT);

    # 質問者にメールで知らせる
    $mailto = "";
    open(IN, "$file");
    while (<IN>) {
        if (/^Reply-To:/) {
            chop($_);
            $mailto = $_;
            $mailto =~ s/^Reply-To: //;
        }
        if (/^\t/) {
            last;
        }
    }
    if ($mailto ne "") {
        seek(IN, 0, 0);
        $msg = "To: $mailto\n";
        $msg .= "Subject: TwnLounge Report\n";
        $msg .= "\n";
        while (<IN>) {
            $_ =~ s/[\r\n]*$//;
            $_ =~ s/^\.$/. /;
            $_ =~ s/&lt;/</g;
            $_ =~ s/&gt;/>/g;
            $_ =~ s/&amp;/&/g;
            $msg .= "$_\n";
        }
        &jcode'convert(*msg, "jis");
        open(OUT, "| $g_sendmail $mailto");
        print OUT $msg;
        close(OUT);
    }
    close(IN);

    # ロックをはずす
    if ($lockflag) {
        &fileUnlock();
    }

  done:
    # ページを表示する
    print "Location: $ENV{'SCRIPT_NAME'}?print+$file\n\n";
    # &showTopicPage($file);

    return(1);
}

#
# 新規ファイル名を決定する
#
sub determineFileName
{
    local($sec, $min, $hour, $mday, $mon, $year);
    local($dir, @files, $file, $num);

    # ディレクトリ名(YYYYMM)を得る
    ($sec, $min, $hour, $mday, $mon, $year) = localtime();
    $dir = sprintf("%04d%02d", $year + 1900, $mon + 1);

    # ディレクトリが無ければ作成する
    if (!-d $dir) {
        mkdir($dir, 0755);
    }

    # 最新のファイル番号を得る
    $num = 0;
    opendir(DIR, $dir);
    foreach $file (readdir(DIR)) {
        if ($file =~ /^[0-9]{4}([0-9]{4}).txt$/) {
            $num = ($num < $1) ? $1 : $num;
        }
    }
    closedir(DIR);
    $num++;

    # ファイル名(YYYYMM/YYMMNNNN.txt)を返す
    return(sprintf("$dir/%02d%02d%04d.txt", $year % 100, $mon + 1, $num));
}

#
# トピックを削除する
#
sub deleteTopic #($passwd, $file)
{
    local($passwd, $file) = @_;

    # パスワードをチェックする
    if (($g_passwd eq "") || ($passwd ne $g_passwd)) {
        &showErrorPage("パスワードが違います。");
        exit(0);
    }

    if ($file =~ /(^\/|\.\.)/) {
        &showErrorPage("他のフォルダのファイルを削除することはできません。");
        exit(0);
    }

    if (!unlink($file)) {
        &showErrorPage("$fileの削除に失敗しました。");
        exit(0);
    }

    &printHeader("ラウンジ(削除)");
    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[戻る]</A>\n";
    print "<HR>\n";
    print "$file の削除が完了しました。\n";
    &printFooter();
}

#
# ファイルの更新時刻を合わせる
#
sub utimeTopic #($passwd, @dirs)
{
    local($passwd, @dirs) = @_;
    local($dir);

    # パスワードをチェックする
    if (($g_passwd eq "") || ($passwd ne $g_passwd)) {
        &showErrorPage("パスワードが違います。");
        exit(0);
    }

    foreach $dir (@dirs) {
        if ($dir =~ /(^\/|\.\.)/) {
            &showErrorPage("他のフォルダを参照することはできません。");
            exit(0);
        }
    }

    &printHeader("ラウンジ(管理者用：ファイルの時刻調整)");
    print "<A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi\">[戻る]</A>\n";
    print "<HR>\n";

    if ($dirs[0] eq "all") {
        opendir(DIR, ".");
        @dirs = grep { !/^\./ && (-d "$_") } readdir(DIR);
        closedir(DIR);
    }

    foreach $dir (@dirs) {
        opendir(DIR, $dir);
        foreach $file (grep { !/^\./ && (-f "$dir/$_") } readdir(DIR)) {
            $file = "$dir/$file";
            $date = "";
            open(IN, $file);
            while (<IN>) {
                if (/^========================================[\r\n]+$/) {
                    $hflag = 1;
                }
                if (/^[\r\n]+$/) {
                    $hflag = 0;
                }
                if ($hflag == 0) {
                    next;
                }
                if (/^Date: /) {
                    $date = $_;
                }
            }
            close(IN);
            if ($date =~ /(\d\d\d\d)\/(\d\d)\/(\d\d).*(\d\d):(\d\d):(\d\d)/) {
                $mtime = mktime($1 - 1900, $2 - 1, $3, $4, $5, $6, -9);
                if (utime($mtime, $mtime, $file)) {
                    print "$file $date OK.<BR>\n";
                } else {
                    print "$file $date NG.<BR>\n";
                }
                #$mtime = sprintf("%02d%02d%02d%02d%02d.%02d",
                #    $2, $3, $4, $5, $1 - 1900, $6);
                #print("/bin/touch -t $mtime $file<BR>\n");
                #print system("/bin/touch -t $mtime $file");
                #print "<BR>\n";
            }
        }
    }

    &printFooter();
}

#
# ヘッダを書き出す
#
sub printHeader #($title)
{
    local($title) = @_;

    print "Content-type: text/html\n";
    print "\n";
    print "<HTML>\n";
    print "<HEAD>\n";
    print "<TITLE>$title</TITLE>\n";
    print "</HEAD>\n";
    print "<BODY TEXT=black BGCOLOR=white>\n";
    print "<H2>$title</H2>\n";
}

#
# フッタを書き出す
#
sub printFooter
{
    print "<HR>\n";
    print "<DIV ALIGN=right>\n";
    print "<I><FONT FACE=\"Courier\">$g_name</FONT></I>\n";
    print "</DIV>\n";
    print "</BODY>\n";
    print "</HTML>\n";
}

#
# トピック一覧を書き出す
#
sub printTopicList #(@files)
{
    local(@files) = @_;
    local($file, $hflag, $count, $questioner, $solved, $from, $date, $subject);
    local($line);

    print "<SCRIPT><!--\n";
    print "function func() {\n";
    print "  cbs = document.f1.elements;\n";
    print "  for (i = 1; i < cbs.length; i++) {\n";
    print "    if (cbs[i].checked) {\n";
    print "      open('http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?print+' + cbs[i].name, i);\n";
    print "      cbs[i].checked = false;\n";
    print "    }\n";
    print "  }\n";
    print "}\n";
    print "// --></SCRIPT>\n";
    print "<FORM METHOD=POST NAME=\"f1\" TARGET=\"_blank\" ACTION=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?search\">\n";
    print "<UL>\n";
    print "<LI>ラウンジの全トピックから単語 ";
    print "<INPUT TYPE=text SIZE=10 NAME=\"WORD\"> ";
    print "を <INPUT TYPE=submit VALUE=\"検索\">\n";
    print "<LI>※印のトピックを\n";
    print "<INPUT TYPE=button onClick='func()' VALUE=\"全文表\示\">\n";
    print "<LI>過去 <INPUT TYPE=text NAME=\"t1\" SIZE=3 VALUE=3>\n";
    print "日分のトピックを\n";
    print "<INPUT TYPE=button VALUE=\"一覧表\示\" ";
    print "onClick=\"window.open('http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?list+'+this.form.t1.value, '_blank')\"> / \n";
    print "<INPUT TYPE=button VALUE=\"全文表\示\" ";
    print "onClick=\"window.open('http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?showall+'+this.form.t1.value, '_blank')\">\n";
    print "</UL>\n";
    print "<TABLE BORDER=1>\n";
    print "<TR>\n";
    print "<TH>※</TH>\n";
    print "<TH>最終<BR>更新日</TH>\n";
    if ($g_show_questioner) {
        print "<TH><FONT COLOR=red>質問者</FONT></TH>\n";
    }
    print "<TH><FONT COLOR=red>最終<BR>発言者</FONT></TH>\n";
    print "<TH>解<BR>決</TH>\n";
    print "<TH>タイトル</TH>\n";
    print "</TR>\n";
    $line = 0;
    foreach $file (@files) {
        $file = (split(/ /, $file))[1];
        open(IN, $file) || next;
        $hflag = 0;
        $count = 0;
        $questioner = "";
        $solved = "　";
        $from = "　";
        $date = "　";
        $subject = <IN>;
        $subject =~ s/^Subject: //;
        $subject =~ s/[\r\n]+$//;
        while (<IN>) {
            if (/^========================================[\r\n]+$/) {
                $hflag = 1;
            }
            if (/^[\r\n]+$/) {
                $hflag = 0;
            }
            if ($hflag == 0) {
                next;
            }
            if (/^From: (.*)[\r\n]+$/) {
                $from = $1;
                if (!$questioner) {
                    $questioner = $from;
                }
                $count++;
            }
            if (/^Solved:/) {
                $solved = "済";
            }
            if (/^Date: (\d+)\/(\d+)\/(\d+)/) {
                $date = "$1/$2/$3";
            }
        }
        print "<TR>\n";
        print "<TD><INPUT TYPE=checkbox NAME='$file'></TD>\n";
        print "<TD>$date</TD>\n";
        if ($g_show_questioner) {
            print "<TD><FONT COLOR=red>$questioner</FONT></TD>\n";
        }
        print "<TD><FONT COLOR=red>$from</FONT></TD>\n";
        print "<TD>$solved</TD>\n";
        print "<TD><A HREF=\"http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?print+$file\" TITLE=\"$file\">";
        print "$subject</A>($count件)</TD>\n";
        print "</TR>\n";
        close(IN);
        if ((++$line % 10) == 0) {
            print "</TABLE>\n";
            print "<P>\n";
            print "<TABLE BORDER=1>\n";
        }
    }
    print "</TABLE>\n";
    print "</FORM>\n";
}

#
# トピック内容を書き出す
#
sub printTopicContent #(IN)
{
    local(*IN) = @_;

    while (<IN>) {
        s/[\r\n]+//;
        if (/^Reply-To: /) {
            next;
        } elsif ($hflag && /^From: /) {
            s/^From: //;
            print "<HR>\n";
            print "<FONT COLOR=red><B>$_</B></FONT>\n";
        } elsif ($hflag && /^E-Mail: /) {
            s/^E-Mail: //;
            print "<A HREF='mailto:$_'>[E-Mail]</A>\n";
        } elsif ($hflag && /^HomePage: /) {
            s/^HomePage: //;
            print "<A HREF='$_'>[HomePage]</A>\n";
        } elsif ($hflag && /^Date: /) {
            s/^Date: //;
            print "$_<BR>\n";
        } elsif ($hflag && /^Solved: /) {
            print "[[<FONT COLOR='#008080'>解決</FONT>]]<BR>\n";
        } elsif (/^========================================[\r\n]*$/) {
            $hflag = 1;
        } elsif ($hflag && ($_ eq "")) {
            $hflag = 0;
        } else {
            s/(http:\/\/[a-zA-Z0-9\.\/\-+#_?~&%=^\@:;]+)/<A HREF="$1">$1<\/A>/g;
            s/^((&gt;|＞).*$)/<FONT COLOR="#CC8000">$1<\/FONT>/;
            print "$_<BR>\n";
        }
    }
}

#
# 検索結果を書き出す
#
sub printSearchResult #($file)
{
    local($file, @words) = @_;
    local($subject, $wcount, $word);
    local(%wordflag, %wordtext);

    $title = "";
    $wcount = 0;
    open(IN, $file);
    $subject = <IN>;
    $subject =~ s/^Subject: //;
    $subject =~ s/[\r\n]+$//;
    seek(IN, 0, 0);
    loop: while (<IN>) {
        foreach $word (@words) {
            if ($wordflag{$word} == 1) { next; }
            if (!/$word/) { next; }
            s/[\r\n]+$//;
            $wordtext{$word} = $_;
            $wordflag{$word} = 1;
            if (($FORM{'ANDOR'} eq "or") || (++$wcount == $#words + 1)) {
                if ($subject eq "") { $subject = $file; }
                print "<P>\n";
                print "<DT><A HREF='http://www.kcn.ne.jp/cgi-bin/blue/wwwlng.cgi?print+$file'>$subject</A>\n";
                foreach $word (@words) {
                    print "<DD>$wordtext{$word}\n";
                }
                last loop;
            }
        }
    }
    close(IN);
}

#
# フォームデータを読みこむ
#
sub readParam
{
    local($query_string, @a, $x, $name, $value);

    if ($ENV{'REQUEST_METHOD'} ne "POST") {
        return(1);
    }
    if (!read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'})) {
        return(undef);
    }
    @a = split(/&/, $query_string);
    foreach $x (@a) {
        ($name, $value) = split(/=/, $x);
        $value =~ tr/+/ /;
        $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
        &jcode'convert(*value, "euc");
        &jcode'h2z_euc(*value);
        $value =~ s/&/&amp;/g;
        $value =~ s/</&lt;/g;
        $value =~ s/>/&gt;/g;
        $value =~ s/\r\n/\n/g;
        $value =~ s/\s+$//;
        &jcode'convert(*value, "sjis");
        $FORM{$name} = $value;
    }
    return(1);
}

#
# ファイルをロックする
#
sub fileLock
{
    for ($i = 1; $i <= 6; $i++) {
        if (mkdir($g_lockfile, 0755)) {
            $SIG{'PIPE'} = "sigexit";
            $SIG{'INT'} = "sigexit";
            $SIG{'HUP'} = "sigexit";
            $SIG{'QUIT'} = "sigexit";
            $SIG{'TERM'} = "sigexit";
            last;
        } elsif ($i < 6) {
            sleep(2);
        } else {
            return(undef);
        }
    }
    return(1);
}

#
# ファイルのロックを解除する
#
sub fileUnlock
{
    for ($i = 1; $i <= 4; $i++) {
        if (rmdir($g_lockfile) == 0) {
            last;
        } elsif ($i < 4) {
            sleep(1);
        } else {
            return(undef);
        }
    }
    return(1);
}

#
# プログラム中断時の処理
#
sub sigexit
{
    if (-d $g_lockfile) {
        rmdir($g_lockfile);
    }
    exit(0);
}

#
# 年/月/日 時:分:秒から、UNIX時間(1970/1/1からの秒数)を求める
#
sub mktime #($year, $mon, $mday, $hour, $min, $sec, $tz)
{
    local($year, $mon, $mday, $hour, $min, $sec, $tz) = @_;
    local(@mdays, $xtime);

    @mdays = ( 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
    $uru = int(($year - 72) / 4);
    if (((($year + 1900) % 4) == 0) && ($mon < 2)) { $uru--; }
    $xtime = $year - 70;
    $xtime = ($xtime * 365) + $mdays[$mon] + $mday + $uru;
    $xtime = ($xtime * 24) + $hour + $tz;
    $xtime = ($xtime * 60) + $min;
    $xtime = ($xtime * 60) + $sec;
    return($xtime);
}