簡易チャットルーム
 
発言の更新には「ページのリフレッシュ」のところで説明しているクライアントプルを用いています。一定間隔で画面を書き換えます。初期ページ（ログイン画面）もCGIで出力するようになっています。ロックはutil.plのサブルーチンを使っていますが、ファイルロックにした場合、CGIが異常終了すると、ロックファイルが残ってしまう可能性がありますので注意してください（リカバリー処理は行っていません）。

[サンプルプログラムの実行]
 
 
chat.cgi 
#!/usr/bin/perl
#
# chat.cgi
#
# (C)1999 Kaoru Fujita
#
use lib './lib';

require 'jcode.pl';
require 'util.pl';

#
# 定数
#
# タイトル
$Title = 'チャット・サンプル・プログラム';
# CGI の仮想パス
$CGIPath = '/cgi-bin';
# プログラム名
use File::Basename;
$Program = basename($0);
# データファイルの格納位置
$DataLoc = './chatlog';
# ロックファイル
#$Lockfile = 'lockfile';
# リフレッシュレート
$Interval = 10;
# 漢字コード
$CharSet = 'EUC';
$Encoding = 'euc';
# ルーム名
%Room=  ('room1'=>'ルームＡ', 'room2'=>'ルームＢ');


#
# メインプログラム
#
parseInput($Encoding);

initProc();

# テスト用
#$in{'Action'} = 'willLogin';
#$in{'Action'} = 'updateRoom'; $in{'Room'} = 'room1';

$date = getDate();
$act = $in{'Action'};

if ($act eq 'willLogin') {
        showLoginPage();
}
elsif ($act eq 'login') {
        if ($in{'Room'} ne '') {
                loginSession($in{'Room'}, $in{'HandleName'});
        }
        else {
                showLoginPage();
        }
}
elsif ($act eq 'logout') {
        logoutSession($in{'Room'}, $in{'HandleName'});
}
elsif ($act eq 'message') {
        speakOut($in{'Room'}, $in{'HandleName'}, $in{'Message'});
}
elsif ($act eq 'updateRoom') {
        if ($in{'Room'} ne '') {
                updateRoom($in{'Room'});
        }
        else {
                noRoom();
        }
}
else {
        showInitPage();
}

exit(0);


#
# <IN>  なし
# <OUT> 日時(String)
#
sub getDate
{
        ($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
        $year += 1900;

        return "$year/$mon/$mday $hour:$min:$sec";
}

#
# <IN>  なし
# <OUT> なし
#
sub initProc
{
        print qq(Content-type: text/html\n\n);
}

#
# <IN>  なし
# <OUT> なし
#
sub showLoginPage
{
        print qq(<HTML>\n);
        print qq(<HEAD>\n);
        print qq(<META HTTP-EQUIV="Content-Type" CONTENT="text/html\; charset=$CharSet">\n);
        print qq(<SCRIPT LANGUAGE="JavaScript">\n);
        print qq(<!--\n);
        print qq(function changeRoom( room )\n);
        print qq({\n);
        print qq(       top.Lower.document.location = "$CGIPath/$Program?Action=updateRoom&Room="+document.Login.Room[document.Login.Room.selectedIndex].value\;\n);
        print qq(}\n);
        print qq(// -->\n);
        print qq(</SCRIPT>\n);
        print qq(</HEAD>\n);
        print qq(<BODY>\n);

        print qq(<FORM NAME="Login" ACTION="$CGIPath/$Program" METHOD="POST">\n);
        print qq(<SELECT NAME="Room" onChange="changeRoom()">\n);
        print qq(<OPTION VALUE="" SELECTED>選択してください\n);
        foreach (sort keys(%Room)) {
                print qq(<OPTION VALUE="$_">$Room{$_}\n);
        }
        print qq(</SELECT><BR>\n\n);

        print qq(<FONT SIZE="-2">ハンドル名: </FONT><INPUT TYPE="TEXT" NAME="HandleName" SIZE="24">\n);
        print qq(<INPUT TYPE="hidden" NAME="Action" VALUE="login">\n);
        print qq(<INPUT TYPE="submit" VALUE="Login">\n);
        print qq(</FORM>\n);
        print qq(</BODY>\n);
        print qq(</HTML>\n);

}

#
# <IN>  なし
# <OUT> なし
#
sub updateRoom
{
        my($room) = @_;


        my($file) = qq($DataLoc/$room.dat);
        my($modfile) = (-e $file) ? "<$file" : ">$file";
        openLock(ROOM, $modfile)
                or noRoom($room);

        my(@msg) = readMessage(ROOM);

        closeUnlock(ROOM, $file);


        print qq(<HTML>\n);
        print qq(<HEAD>\n);
        print qq(<META HTTP-EQUIV="REFRESH" CONTENT="$Interval">\n);
        print qq(<META HTTP-EQUIV="Content-Type" CONTENT="text/html\; charset=$Charset">\n);
        print qq(</HEAD>\n);
        print qq(<BODY>\n);
        print qq(<TABLE BORDER="1">\n);
        foreach (reverse @msg) {
                my($date, $name, $msg) = split(/,/);
                print qq(<TR>\n);
                print qq(<TD>$date</TD><TD>$name</TD><TD>$msg</TD>\n);
                print qq(</TR>\n);
        }
        print qq(</TABLE>\n);
        print qq(</BODY>\n);
        print qq(</HTML>\n);
}

#
# <IN>  なし
# <OUT> なし
#
sub noRoom
{
        my($room) = @_;

        print qq(<HTML>\n);
        print qq(<HEAD>\n);
        print qq(<META HTTP-EQUIV="REFRESH" CONTENT="$Interval">\n) if ($room);
        print qq(<META HTTP-EQUIV="Content-Type" CONTENT="text/html\; charset=$CharSet">\n);
        print qq(</HEAD>\n);
        print qq(<BODY>\n);
        print qq($Room{$room} がオープンできません。<BR>\n) if ($room);
        print qq(</BODY>\n);
        print qq(</HTML>\n);
}

#
# <IN>  ログイン名
# <OUT> なし
#
sub loginSession
{
        my($room, $name) = @_;

        my($file) = qq($DataLoc/$room.dat);
        my($modfile) = (-e $file) ? ">>$file" : ">$file";
        openLock(ROOM, $modfile)
                or noRoom($room);

        writeMessage(ROOM, "$date,$name,ログイン");

        closeUnlock(ROOM, $file);

print <<END_OF_LOGIN_SESSION;
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html\; charset=$CharSet">
<SCRIPT LANGUAGE="JavaScript">
<!--
function logout()
{
        top.Lower.document.location = "$CGIPath/$Program?Action=updateRoom";
        document.Say.Action.value = "logout";
        document.Say.doSubmit.click();
}
//-->
</SCRIPT>
</HEAD>
<BODY>
ルーム: $Room{$room}<BR>
<FORM NAME="Say" ACTION="$CGIPath/$Program" METHOD="POST">
<INPUT TYPE="text\" NAME="Message" SIZE="36">
<INPUT TYPE="hidden" NAME="Action" VALUE="message">
<INPUT TYPE="hidden" NAME="Room" VALUE="$room\">
<INPUT TYPE="hidden" NAME="HandleName" VALUE="$name">
<INPUT TYPE="submit" NAME="doSubmit" VALUE="発言"><BR>
<INPUT TYPE="button" VALUE="Logout" onClick="logout()">

</BODY>
</HTML>
END_OF_LOGIN_SESSION
}

#
# <IN>
# <OUT>
#
sub logoutSession
{
        my($room, $name) = @_;

        my($file) = qq($DataLoc/$room.dat);
        openLock(ROOM, ">>$file")
                or exitError("ファイル $file がオープンできません。");

        writeMessage(ROOM, "$date,$name,ログアウト");

        closeUnlock(ROOM, $file);

        &showLoginPage();

}

#
# <IN>
# <OUT>
sub speakOut
{
        local($room, $name, $msg) = @_;

        my($file) = qq($DataLoc/$room.dat);
        openLock(ROOM, ">>$file")
                or exitError("ファイル $file がオープンできません。");

        writeMessage(ROOM, "$date,$name,$msg");

        closeUnlock(ROOM, $file);

print <<END_OF_SPEAKOUT;
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=$CharSet">
<SCRIPT LANGUAGE="JavaScript">
<!--
function logout()
{
        top.Lower.document.location = "$CGIPath/$Program?Action=updateRoom";
        document.Say.Action.value = "logout";
        document.Say.doSubmit.click();
}
// -->
</SCRIPT>
</HEAD>
<BODY>
ルーム: $Room{$room}<BR>
<FORM NAME="Say" ACTION="$CGIPath/$Program" METHOD="POST">
<INPUT TYPE="text" NAME="Message" SIZE="36">
<INPUT TYPE="hidden" NAME="Action" VALUE="message">
<INPUT TYPE="hidden" NAME="Room" VALUE="$room">
<INPUT TYPE="hidden" NAME="HandleName" VALUE="$name">
<INPUT TYPE="submit" NAME="doSubmit" VALUE="発言"><BR>
<INPUT TYPE="button" VALUE="Logout" onClick="logout()">

</BODY>
</HTML>
END_OF_SPEAKOUT
}

#
# <IN>  なし
# <OUT> なし
#
sub showInitPage
{

print <<END_OF_SHOW_INIT_PAGE;
<HTML>
<HEAD>
<TITLE>$Title</TITLE>
</HEAD>
<FRAMESET ROWS="30%,*">
        <FRAME SRC="$CGIPath/$Program?Action=willLogin" NAME="Upper">
        <FRAME SRC="$CGIPath/$Program?Action=updateRoom" NAME="Lower">
</FRAMESET>
</HTML>
END_OF_SHOW_INIT_PAGE
}


sub writeMessage
{
        local($fh, $msg) = @_;

        print $fh "$msg\n";
}


sub readMessage
{
        local($fh) = @_;

        local(@msg) = <$fh>;
        $msg = <$fh>;
        return @msg;
}

#--End of chat.cgi


ファイル一覧

cgi-bin/chat.cgi
cgi-bin/lib/util.pl
cgi-bin/lib/jcode.pl