#!/usr/local/bin/perl

#--------------------------------------#
#                                      #
#                                      #
#      w c h a t . c g i - 1.00        #
#                                      #
#         powered by ssw-1.00          #
#                                      #
#                                      #
#--------------------------------------#

use ssw;
use cgis;

#  プロパティ
#  -----------------------------------------------------------------------

#チャットのタイトル
$Title="ホワイトチャット";

# 最大保持行数
$MaxLines=30;

# 戻り先のURL
$URLReturn="index.shtml";

# 表示色の名前とカラーコード
@ColorName=("黒",     "茶",    "オリーブ","青",     "紫",     "緑"     );
@ColorCode=("#000000","#800000","#808000","#000080","#800080","#008000");

# クッキー賞味期限(日)
$CExpires =120;

# ファイルロック 使用=1,不使用=0
$EnableLock=0;

# ログのパス
$LogFile="chat.log";

# 人工無脳のプロパティ

	# 名前
	$ssw::Name          = "まな";
	
	# 辞書のパス
	$ssw::MainDicPath   = "mana_m.txt";
	$ssw::RenderDicPath = "mana_r.txt";
	$ssw::GreenDicPath  = "mana_g.txt";
	
	# 体調が変化する周期(日)
	$ssw::VCondInterv   = 10;
	
	# すべてのユーザに教育を(許可する=1 許可しない=0)
	$ssw::IsAuthorized  = 1;
	
	# deck -UCPAE
	$ssw::Deck          = "UUUUC---";
	
	# 発言色
	$MunoColor          = 0;


# ここまで
#--------------------------------------------------------------------------

$URLThis="wchat.cgi";

%EventList=("OnStart"   =>1, "OnExecute" =>1, "OnLogout" =>1,
            "OnEducateExecute"=>1,
        );

$Color=0;
@ChatUpkeep=("::Name","::Color","::Next","::Text");
@MunoUpkeep=("ssw::UName","ssw::Queue","ssw::Reserved","ssw::Message",
             "ssw::PrevInput","ssw::PrevOutput","ssw::PrevTheme",
             "ssw::CurrentTheme");
@EduUpkeep =("::Key","::Theme","::Command","::Hearsay","::Opinion",
			 "ssw::Teacher","ssw::Value");

#-------------
# M A I N

cgis::get_param((@ChatUpkeep,@MunoUpkeep,@EduUpkeep));

if( exists $EventList{$Next} ){
	&{$Next};
	exit 0;
}

&OnStart;
exit 1;


#-------------------------
#   E V E N T
#

sub OnStart()
{
	%cookie=cgis::get_cookie($URLThis);
	$ssw::UName=$Name =$cookie{"name"} || "";
	$Color=$cookie{"color"} || "0";
	ssw::login;
	&FormShow;
	exit 0;
}

sub OnLogout()
{
	ssw::logout;
	print "Location: $URLReturn\n\n";
	exit 1;
}

sub OnExecute()
{
	if($Name eq "") {
		print "Content-type: text/html\n\n";
		print "<H2>名前が空欄です</H2>";
		print "戻って入力を確認してください";
		exit 0;
	}
	
	$ssw::UName=$Name;
	my $reply=ssw::reply($Text);

	#predispatch 
	if($ssw::Message =~ /color=([0-9]+)/) {$MunoColor=$1;}
	
	my $line  =&make_line($ssw::Name,cgis::enable_url $reply,$MunoColor);
	   $line .=&make_line($Name,     cgis::enable_url $Text  ,$Color);
	
	&logwrite($line);

	#postdispatch
	my $msg=$ssw::Message;
	$ssw::Message="";
	if   ($msg eq 'logout')        { &OnLogout; }
	elsif($msg eq 'educate')       { &EducateFormShow; exit 1; }
	
	&FormShow;
	
	#process queue
	if($ssw::Queue ne "") {
		logwrite(&make_line(
			$ssw::Name,
			cgis::enable_url ssw::ProcessQueue,
			$MunoColor)) or &ShowBusy;
	}
	exit 1;
}

sub OnEducateExecute()
{
	if(!$Key && $Command eq "execute") {
		print "Content-type: text/html\n\n";
		print "<H2>キーが空欄です</H2>";
		print "戻って入力を確認してください";
		exit 0;
	}
	my ($msg,$line);
	if($Command eq "cancel") 
	{
		ssw::EducateCancel;
		$msg="■ 教育をキャンセルしました ■";
	}
	elsif($Command eq "banned") {
		ssw::EducateBanned;
		$msg="■ 教育を拒否しました ■< <";
	}
	else {
		ssw::writedic($Key,$Theme,$Text,$ssw::Teacher,$ssw::Value,$Hearsay);
		ssw::EducateAccept;
		$msg="■ 教育を受け付けました ■"
		#＊Opinionを受ける仕掛け
	}
	
	$line  =&make_line($ssw::Name,
		cgis::enable_url ssw::reply(""),$MunoColor);
	$line .=&make_line(">",$msg,$Color);
	
	&logwrite($line);
	&FormShow;
	exit 1;
}

#-----------------------------------------
# HTML出力器
#


sub FormShow()
{
	local *LOG;
	open(LOG,"$LogFile") or die"$LogFile not found";
	my @log=<LOG>;
	close LOG;
	
	my $color_table="";
	for my $i (0..$#ColorName) {
		$color_table .="<OPTION VALUE=\"$i\"";
		$color_table .=" SELECTED" if $i==$Color;
		$color_table .=">$ColorName[$i] ";
	}

	$cookie{name} =$Name;
	$cookie{color}=$Color;
	my $cookiestr=cgis::set_cookie($URLThis,$CExpires,\%cookie);

	my $hidden_field=cgis::set_param(@MunoUpkeep);
	print <<"END";
Set-Cookie: $cookiestr
Content-type: text/html; charset=EUC-JP;

<HTML>
 <HEAD>
  <TITLE>wchat - $Title </TITLE>
  <META HTTP-EQUIV="Pragma" CONTENT="no-cache">
 </HEAD>
<BODY MARGINWIDTH=10 LEFTMARGIN=10 RIGHTMARGIN=10 OnLoad="document.Form.elements[2].focus();">
<FORM NAME="Form" ACTION="$URLThis" METHOD=POST>
<TABLE BACKGROUND="bg.jpg" CELLPADDING=3 BORDER=3><TR><TD>
<TABLE CELLPADDING=0>
<TR><TD><FONT SIZE=-1>NAME</FONT></TD>
<TD><INPUT TYPE=TEXT NAME="::Name" VALUE="$Name" SIZE=30> 
<SELECT NAME="::Color"> $color_table </SELECT>
</TD></TR>
<TR><TD><FONT SIZE=-1>MESSAGE</FONT></TD>
<TD><INPUT TYPE=TEXT NAME="::Text" SIZE=90></TD></TR>
<TR><TD> </TD>
<TD>
<INPUT TYPE=SUBMIT VALUE="     OK      "> 
<INPUT TYPE=RESET> 
<INPUT TYPE=hidden NAME="::Next" VALUE="OnExecute">
$hidden_field

<A HREF="$URLThis?trig=Logout">■ログアウト</A><BR>

<DIV ALIGN=RIGHT><FONT SIZE=-1 COLOR=#C0FFFF> SpiritStone "W h i t e N o i s e"</FONT></DIV></TD></TR>
</TABLE></TD></TR>
</TABLE>
</FORM>
@log
<DIV ALIGN=RIGHT><FONT SIZE=-1 COLOR=#AA88FF><I>Powered by Spiritstone <A HREF="http://www.ycf.nanet.co.jp/~skato/muno/sswhite/">"W h i t e N o i s e" ver 0.01</A></FONT></I></DIV>
</BODY></HTML>
END
}

sub EducateFormShow()
{
	local *LOG;
	open(LOG,"$LogFile") or die"$LogFile not found";
	my @log=<LOG>;
	close LOG;
	
	$Next="OnEducateExecute";
	my $hidden_field=cgis::set_param((@ChatUpkeep,@MunoUpkeep,
                                       "ssw::Teacher","ssw::Value"));
	
	print <<"END";
Content-type: text/html; charset=EUC-JP;

<HTML><HEAD><TITLE>教えて！$Nameさん</TITLE>
<SCRIPT LANGUAGE="JavaScript">
<!--
function activate() {
	if(document.form.elements[0].value.length != 0 ||
	   document.form.elements[1].value.length != 0 ||
	   document.form.elements[2].value.length != 0 ) {
	   document.form.elements[5][1].checked=true;
	}else{
	   document.form.elements[5][0].checked=true;
	}
}
-->
</SCRIPT>
</HEAD>
<BODY MARGINWIDTH=10 LEFTMARGIN=10 RIGHTMARGIN=10>
<FORM ACTION="$URLThis" METHOD=POST>
<TABLE BGCOLOR=#FF8800 BORDER=3 CELLPADDING=5><TR><TH BGCOLOR=#FFEE66>教えて！$Nameさん</TH></TR>
<TR><TD>
<P>$ssw::Name>$ssw::PrevOutput</P>
<TABLE>
<TR><TD>キー</TD><TD><INPUT TYPE=TEXT NAME="::Key" SIZE=30 OnKeyDown="activate()"> 例：「好きな本」正規表現OK</TD></TR>
<TR><TD>主題</TD><TD><INPUT TYPE=TEXT NAME="::Theme" SIZE=30 OnKeyDown="activate()"> 例：「趣味」</TD></TR>
<TR><TD>$ssw::Nameの返答</TD><TD><INPUT TYPE=TEXT NAME="::Text" SIZE=80 OnKeyDown="activate()"></TD></TR>
<TR><TD>あなたの意見</TD><TD><INPUT TYPE=TEXT NAME="::Opinion" SIZE=80 ></TD></TR>
<TR><TD>オプション</TD><TD>
<INPUT TYPE=CHECKBOX NAME="::Hearsay" CHECKED VALUE="1">伝聞としても教える
</TD></TR>
<TR><TD>アクション</TD><TD>
<INPUT TYPE=RADIO NAME="::Command" VALUE="cancel" CHECKED>今度教えます</INPUT>
<INPUT TYPE=RADIO NAME="::Command" VALUE="execute">この内容で教える</INPUT>
<INPUT TYPE=RADIO NAME="::Command" VALUE="banned">憶えないで！</INPUT>
</TD></TR>
<TR><TD COLSPAN=2><DIV ALIGN=RIGHT>
<INPUT TYPE=RESET>
<INPUT TYPE=SUBMIT VALUE="    O K    ">
</TD></TR></TABLE>
</TD></TR></TABLE>
$hidden_field
</FORM>
@log
<DIV ALIGN=RIGHT><FONT SIZE=-1 COLOR=#AA88FF><I>Powered by Spiritstone <A HREF="http://www.ycf.nanet.co.jp/~skato/muno/sswhite/">"W h i t e N o i s e" ver 0.01</A></FONT></I></DIV>
</BODY></HTML>
END
}


sub ShowBusy()
{
	print <<"EOQ";
Content-type: text/html

<HTML><HEAD><TITLE>ホワイトチャット - $Title</TITLE>
<META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=EUC-JP">
</HEAD><BODY MARGINWIDTH=10 LEFTMARGIN=10 RIGHTMARGIN=10>
<H1>BUSY</H1>
ファイルをロックできませんでした。
しばらく待ってアクセスしなおしてください
</BODY></HTML>
EOQ
	exit 0;
}


#------------------------
# peripherals

sub make_line($$$)
{
	my $name=shift;
	my $text=shift;
	my $color=shift;
	return "" unless $text;

	my @week=("Sun","Mon","Tue","Wed","Thu","Fri","Sat");
	my @lt=localtime;
	my $time_stamp =sprintf "%04d-%02d-%02d(%s) %02d:%02d",	
		1900+$lt[5],$lt[4]+1,$lt[3],$week[$lt[6]],$lt[2],$lt[1];

	"<P><FONT COLOR=\"$ColorCode[$color]\"> $name >$text<BR></FONT><SMALL>$time_stamp</SMALL></P>\n";
}

sub logwrite($)
{
	my $str=shift;
	local *LOG;
	open(LOG,"+<$LogFile") or die "cannot open $LogFile";
	
	if($EnableLock) {
		my $count=0;
		until (flock(LOG,2)) {
			sleep .5;
			return 0 if(++$count > 10);
		}
	}
	
	my @log=<LOG>;
	unshift @log,$str;
	splice @log,$MaxLines;
	seek LOG,0,0;
	print LOG @log;
	truncate LOG,tell(LOG);
	close LOG;
	
	1;
}