#!/usr/local/bin/perl
#----------------------------
# 人工無脳チャット for sspd-221
#
use sspd;
require './jcode.pl';
#--------------------------- ユーザ定義 -----------------------------
# CGI設定
$Title = "まなの気まぐれラグ"; # チャットのタイトル
$URLReturn = 'index.shtml'; # 戻り先URL
$LogFile = 'schat.log'; # ログ
$MaxLines = 40; # チャットの記録行数
# 人工無脳設定
$sspd::Name = 'まな'; # 名前
$sspd::DictFile[0] = 'mana1.txt'; # プライマリ辞書
$sspd::DictFile[1] = 'mana2.txt'; # セカンダリ辞書
$sspd::VCondInterv = 10; # 体調が変わる周期
$sspd::Birthtime = 976107537; # 誕生日(シリアル値)
$sspd::MaxUsers = 120; # 憶えていられるユーザ数
$sspd::FeelLong = 13600; #「久しぶり」と感じる期間（秒)
$sspd::FeelSoon = 60; #「すぐ」と感じる期間(秒)
$sspd::VClimInterv = 2; # 天候が変わる周期
#--------------------------------------------------------------------
$URLThis = "schat.cgi";
$CName = 'schat221';
$CExpires = 120;
$uselock =0;
#----------------------------
# M A I N
#
srand;
&init_form('euc');
$FName = &RemoveTag($form{'name'});
$FPhase = &RemoveTag($form{'phase'});
$FText = &RemoveTag($form{'text'});
if ($FPhase eq 'write') { &OnWrite; }
elsif($FPhase eq 'logout') { &OnLogout; }
else { &OnCreate; }
exit 0;
#----------------------------
# O N C R E A T E
#
sub OnCreate
{
$sspd::Queue[0]='$HELLO$';
&FormShow;
}
#----------------------------
# O N W R I T E
#
sub OnWrite
{
unless($FName) {
print "Content-type: text/html\n\n";
print "名前が空欄です
";
exit 0;
}
$cookie{'name'}=$FName;
&print_cookie($CName,$CExpires);
$sspd::UName =&RemoveTag($form{'name'});
$sspd::PrevKey =&RemoveTag($form{'prevkey'});
$sspd::Queue[0]=&RemoveTag($form{'queue0'});
$sspd::Queue[1]=&RemoveTag($form{'queue1'});
$line = &make_line($sspd::Name, sspd::reply $FText);
$line .= &make_line($FName,$FText);
&lock_open(LOG,"+<$LogFile");
@log=;
unshift(@log,$line);
splice(@log,$MaxLines);
seek(LOG,0,0);
print LOG @log;
truncate(LOG,tell(LOG));
close(LOG);
# dispatch
if($sspd::Message eq 'logout') { &OnLogout; }
else { &FormShow; }
exit 0;
}
#----------------------------
# O N L O G O U T
#
sub OnLogout
{
&init_cookie($CName);
&sspd::logout($cookie{'name'}) if ($cookie{'name'});
print "Location: $URLReturn\n\n";
exit 0;
}
#----------------------------
# F O R M S H O W
#
sub FormShow
{
open(LOG,"$LogFile");
@log=;
close(LOG);
&init_cookie($CName);
print <<"END_OF_QUOTE";
Content-type: text/html
$Title
戻る
@log
END_OF_QUOTE
exit 0;
}
#------------------------------------------------------------------#
#| |#
#| |#
#| S U B R O U T I N E S |#
#| |#
#| |#
#------------------------------------------------------------------#
sub make_line
{
my $name=shift;
my $text=shift;
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]);
return "$name >$text $time_stamp
\n";
}
# オープンしてロック
sub lock_open {
local(*FILE, $name) = @_;
if (!open(FILE, $name)) {
print("$nameがオープンできません。");
}
if ($uselock) {
eval("flock(FILE, 2)"); # 2=LOCK_EX
if ($@) {
# flock が使えない場合、ここに来る。
print"$@ - この環境では flock は使えません。\$uselock = 0 にしてください。";
}
}
seek(FILE, 0, 0);
}
# アンロックしてクローズ
sub unlock_close {
local(*FILE) = @_;
if ($uselock) {
eval("flock(FILE, 8)"); # 8=LOCK_UN
}
close(FILE);
}
sub init_form {
local($query, @assocarray, $assoc, $property, $value, $kanjicode, $method);
$kanjicode = $_[0];
$method = $ENV{'REQUEST_METHOD'};
$method =~ tr/A-Z/a-z/;
if ($method eq 'post') {
read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
} else {
$query = $ENV{'QUERY_STRING'};
}
@assocarray = split(/&/, $query);
foreach $assoc (@assocarray) {
($property, $value) = split(/=/, $assoc);
$value =~ tr/+/ /;
$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
$formcode=&jcode'convert(*value, $kanjicode);
$form{$property} = $value;
}
}
# 使用できない文字の置換
sub RemoveTag($) {
local($string) = @_;
$string =~ s/&/&/g;
$string =~ s/"/"/g;
$string =~ s//>/g;
$string =~ s/,/,/g; # 保存時のデータ区切りと混乱するため
$string =~ s/:/:/g; #
$string =~ s/\r\n/\n/g;
$string =~ s/\r/\n/g;
$string =~ s/\n\n/
/g;
$string =~ s/\n/
/g;
return $string;
}
# 圧縮されたクッキー文字列を展開し、%cookie に得る。
# &init_cookie('cookiename');
sub init_cookie {
local($cookiename) = @_;
local($name, $value, @pairs, $pair);
@sqpairs = split(/;\s/, $ENV{'HTTP_COOKIE'});
foreach $sqpair (@sqpairs) {
($sqname, $sqvalue) = split(/=/, $sqpair);
if ($sqname eq $cookiename) {
$sqvalue =~ s/:/; /g;
$sqvalue =~ s/_/=/g;
@pairs = split(/;\s/, $sqvalue);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$name =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
$value =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
$cookie{$name} = $value;
}
last;
}
}
}
# クッキー %cookie を圧縮し、cookiename=圧縮されたクッキー文字列を返す
# $cstr = &make_cookie('cookiename');
sub make_cookie {
local($cookiename) = @_;
local(@sqcookie, $sqstr);
local($encode) = '\%\+\;\,\=\&\_\:';
while (($name, $value) = each %cookie) {
$name =~ s/([$encode])/'%'.unpack("H2", $1)/eg;
$value =~ s/([$encode])/'%'.unpack("H2", $1)/eg;
$name =~ s/\s/\+/g;
$value =~ s/\s/\+/g;
push(@sqcookie, "${name}_${value}");
}
$sqstr = join(':', @sqcookie);
return "$cookiename=$sqstr; ";
}
# 現在から指定日数以後の日付を得る。
# Fri, 31-Dec-2010 00:00:00 GMT
# （クッキーで使用するものなので、形式は変更してはいけない）
# $datestr = get_expire_date_string($days)
sub get_expire_date_string {
local($days) = @_;
local(@month) = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
local(@week) = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" );
local($sec, $min, $hour, $day, $mon, $year, $weekday) = gmtime(time + $days * 24 * 60 * 60);
local($expiredate);
$year += 1900;
# 文字列化する
if ($hour < 10) {
$hour = "0$hour";
}
if ($min < 10) {
$min = "0$min";
}
if ($sec < 10) {
$sec = "0$sec";
}
$weekstr = $week[$weekday];
$monstr = $month[$mon];
$expiredate = "$weekstr, $day-$monstr-$year $hour:$min:$sec GMT";
return $expiredate;
}
# クッキー %cookie を出力する
# &print_cookie('cookiename', 100, 'domain')
sub print_cookie {
local($cookiename, $days, $domain) = @_;
local($cookiestr) = &make_cookie($cookiename);
local($expdate) = &get_expire_date_string($days);
print "Set-Cookie: $cookiestr;";
print " expires=$expdate;";
if ($domain) {
print " domain=$domain;";
}
print "\n";
}