#!/usr/local/bin/perl print "Content-type: text/html\n\n"; require '../perl/jcode.pl'; $LOG_SIZE=100; $TITLE='おしゃべりじぇむ'; $HOMEURL='../../index.html'; $ZHNAME='おしゃべりじぇむ'; $BODY=''; $RIMNET=0; ###################################################################### # このスクリプトはm「Ｗｅｂ−新撰組」謹製zhbuilderを使用して # 作成されました。 # 無断複製、無断配布を禁じます。 # Copyright Ｗｅｂ−新撰組 08/13/1998 # http://www.web-kyoto.com/ $logfile = '../../zhchat/zhchat.dat'; $maxwrite = 98; $refsec=120; $zhagiselect=""; $zhagiunselect=""; $zhagiflag="ON"; if ($ENV{'REQUEST_METHOD'} eq "POST"){ read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } @pairs = split(/&/,$buffer); foreach (@pairs) { ($name, $value) = split(/=/, $_); if($name eq "uname"){ $form_uname=$value; } $value =~ tr/+/ /; $value =~ s/%(\w\w)/pack("C", hex($1))/eg; $value =~ s/[\n\r]//g; $FORM{$name} = $value; } if(!$FORM{'kaogif'}){ if(length($FORM{'u_kaogif'}) >= 20){ $kaogif=$FORM{'u_kaogif'}; } }else{ $kaogif = $FORM{'kaogif'}; } if((!$FORM{'uname'})||(!$kaogif)){ &enter_html; } $uname = $FORM{'uname'}; $uname =~ s/ //g; $uname =~ s/<.*>//g; &jcode'convert(*uname,'euc'); if(!$FORM{'zhagi'}){ $zhagiflag='OFF'; } if(($FORM{'refsec'}) && ($FORM{'refsec'} !~ /\D/)){ $refsec=$FORM{'refsec'}; } if($FORM{'logsize'}){ $LOG_SIZE=$FORM{'logsize'}; } if($FORM{'teach'} == 1){ $TEACH=1; &teach_html; }elsif($FORM{'teach'} == 2){ $TEACH=2; &write_dic; &teach_html; } $mess = $FORM{'mess'}; open(IN,"$logfile") || die "Cannot open infile"; @olddata=; close(IN); if($mess){ $mess =~ s/\s+/ /g; $mess =~ s/<[^>]*[^<]*>/>/g; $mess =~ s/<[^<>]*!--[^<>]*>//ig; $mess =~ s/<[^<>]*img[^<>]*>//ig; $mess =~ s/<[^<>]*image[^<>]*>//ig; $mess =~ s/<[^<>]*src[^<>]*>//ig; $mess =~ s/<[^<>]*hr[^e<>]*>//ig; $mess =~ s/<[^<>]*table[^<>]*>//ig; $mess =~ s/<[^<>]*td[^<>]*>//ig; $mess =~ s/<[^<>]*tr[^<>]*>//ig; $mess =~ s/<[^<>]*applet[^<>]*>//ig; $mess =~ s/<[^<>]*script[^<>]*>//ig; $mess =~ s/<[^<>]*face[^<>]*>//ig; $mess =~ s/<[^<>]*meta[^<>]*>//ig; $mess =~ s/<[^<>]*title[^<>]*>//ig; $mess =~ s/<[^<>]*body[^<>]*>//ig; $mess =~ s/<[^<>]*style[^<>]*>//ig; $mess =~ s/<[^<>]*embed[^<>]*>//ig; &jcode'convert(*mess,'euc'); if($RIMNET!=1){ $remote_addr = $ENV{'REMOTE_HOST'}; }else{ $remote_addr = (split(/ /,$ENV{'HTTP_FORWARDED'}))[4]; } @MONTHS=(31,28,31,30,31,30,31,31,30,31,30,31); ($min,$hour,$mday,$tmon,$tyear)=(gmtime(time))[1..5]; if($tyear > 97){ $tyear+=1900; }else{ $tyear+=2000; } # 閏年の確認 if(($year % 4 == 0)&&($year % 400 != 0)){ $MONTHS[1]=29; } $hour+=9; if($hour > 23){ $hour-=24; $mday++; if($mday > $MONTHS[$tmon]){ $mday=1; $tmon++; if($tmon > 11){ $tmon=0; $tyear++; } } } $year=tyear; $mon=$tmon+1; $line="
$uname:$mess
$remote_addr at $mon/$mday.$hour:$min.JST
\n"; if($zhagiflag eq "ON"){ &jcode'convert(*mess,'euc'); $hword=&zhagianswer($uname,$mess); &jcode'convert(*mess,'euc'); &jcode'convert(*hword,'euc'); if($hword){ $hword=~s/\$name/$uname/g; $hline="
$ZHNAME:$hword
[$ZHNAME] at $mon/$mday.$hour:$min.JST
\n"; $line=$hline . $line; --$maxwrite; } } if($#olddata > $maxwrite) { $#olddata = $maxwrite; } open(OF,">$logfile") || die "Cannot open outfile"; flock(OF,2); print OF "$line@olddata"; flock(OF,8); close(OF); if($#olddata > ($LOG_SIZE - 2)) { $#olddata = ($LOG_SIZE - 2); } }else{ if($#olddata > ($LOG_SIZE - 1)) { $#olddata = ($LOG_SIZE - 1); } } if($zhagiflag eq "OFF"){ $zhagiselect=$zhagiunselect; } print <<"EOF"; $TITLE $BODY

[HOME] [言葉を教える]

$uname
これは、普通のチャットではありません。あなたの発言にネット犬"じぇむ" がお答えするので、
会話が続かないと思います。。。怒らないでください。返事を教えることなんかもできます。
 ことばをいれてW/Rボタンを押すと発言、なにも書かずに押すとデータが更新されるよ。

$ZHNAME ON $zhagiselect / リロード秒 / ログ行
$line@olddata ----データのおけつ---- EOF exit(1); sub zhagianswer { local($username,$message)=@_; local($dict1_file,$dict2_file,@matched,@namematch,@nullmatch, $i,$j,$key,$word,$wordnum,$num,$hword,$hr); $dict1_file='../../zhchat/dic1.dat'; $dict2_file='../../zhchat/dic2.dat'; $i=0;$j=0; open(IN,"$dict1_file") || die "Can not open $dict1_file\n"; while(){ ($key,$word)=split(/\%\!\%/,$_); if($message=~/$key/ig){ $matched[$i]=$word; ++$i; } if($username=~/$key/ig){ $namematch[$j]=$word; ++$j; } } close(IN); open(IN,"$dict2_file") || die "Can not open $dict2_file\n"; @nullmatch=; close(IN); srand(time); $hr=int(rand(30)); if((($i==1)&&($j > 0))&&($hr==5)){ $num=@namematch; $wordnum = rand($num); $matched[$i]=$namematch[$wordnum]; ++$i; } if(($i==0)||($hr==13)){ $num=@nullmatch; $wordnum = rand($num); $matched[$i]=$nullmatch[$wordnum]; ++$i; } $wordnum = rand($i); $hword=$matched[$wordnum]; if($message=~/辞書で引いて$/){ $hword='知るけー!　自分で調べーや!!'; } if($hword=~/\$name/){ if($username !~ /ちゃん$|さん$|さま$/){ $hword=~s/\$name/\$nameさん/g; } } chop($hword); return($hword); } sub write_dic { if(($FORM{'key'})&&($FORM{'word'})){ $key = $FORM{'key'}; $word = $FORM{'word'}; $key =~ s/\$name//g; $key_length=length($key); $word_length=length($word); if(($key_length > 4)&&($key_length <= 32)&&($word_length > 2)&&($word_length <= 128)){ &jcode'convert(*key,'euc'); &jcode'convert(*word,'euc'); $key =~ s/\s+/ /g; $key =~ s/<[^>]*[^<]*>/>/g; $key =~ s/<[^<>]*!--[^<>]*>//ig; $key =~ s/<[^<>]*img[^<>]*>//ig; $key =~ s/<[^<>]*image[^<>]*>//ig; $key =~ s/<[^<>]*src[^<>]*>//ig; $key =~ s/<[^<>]*hr[^e<>]*>//ig; $key =~ s/<[^<>]*table[^<>]*>//ig; $key =~ s/<[^<>]*td[^<>]*>//ig; $key =~ s/<[^<>]*tr[^<>]*>//ig; $key =~ s/<[^<>]*applet[^<>]*>//ig; $key =~ s/<[^<>]*script[^<>]*>//ig; $key =~ s/<[^<>]*face[^<>]*>//ig; $key =~ s/<[^<>]*meta[^<>]*>//ig; $key =~ s/<[^<>]*title[^<>]*>//ig; $key =~ s/<[^<>]*body[^<>]*>//ig; $key =~ s/<[^<>]*style[^<>]*>//ig; $key =~ s/<[^<>]*embed[^<>]*>//ig; $key =~ s/\%\!\%/％！％/g; $word =~ s/\s+/ /g; $word =~ s/<[^>]*[^<]*>/>/g; $word =~ s/<[^<>]*!--[^<>]*>//ig; $word =~ s/<[^<>]*img[^<>]*>//ig; $word =~ s/<[^<>]*image[^<>]*>//ig; $word =~ s/<[^<>]*src[^<>]*>//ig; $word =~ s/<[^<>]*hr[^e<>]*>//ig; $word =~ s/<[^<>]*table[^<>]*>//ig; $word =~ s/<[^<>]*td[^<>]*>//ig; $word =~ s/<[^<>]*tr[^<>]*>//ig; $word =~ s/<[^<>]*applet[^<>]*>//ig; $word =~ s/<[^<>]*script[^<>]*>//ig; $word =~ s/<[^<>]*face[^<>]*>//ig; $word =~ s/<[^<>]*meta[^<>]*>//ig; $word =~ s/<[^<>]*title[^<>]*>//ig; $word =~ s/<[^<>]*body[^<>]*>//ig; $word =~ s/<[^<>]*style[^<>]*>//ig; $word =~ s/<[^<>]*embed[^<>]*>//ig; $word =~ s/\%\!\%/％！％/g; open(OUT,">> ../../zhchat/dic1.dat"); flock(OUT,2); print OUT "$key\%\!\%$word\n"; flock(OUT,8); close(OUT); }else{ $TEACH=1; } }else{ $TEACH=1; } } sub teach_html{ if($TEACH==2){ $words="$key

で

$word

と答えちゃうよ〜ん"; } print <<"EOL"; 言葉を教える $BODY $ZHNAME に色々教える
[HOME] [チャットに戻る]


キーワード
へんじ

$words EOL exit(1); } sub enter_html { print <<"EOL"; $TITLEへようこそ $BODY

おしゃべりじぇむへようこそ
名前を入力して顔を選んだら、入るボタンを押して下さい。
入ってすぐにブックマークに入れておくと、次から直接チャットに行けるようになります。
なまえ かお
顔ファイルを指定

EOL exit(1); }