#! /usr/local/bin/perl # # このrobot.txtはrobot.cgiに名前を変更してからご利用ください。 ;# ;# 人工無能システム WebROBOT v3.0 (is Free.) ;# ;# 対話型インテリジェント知識ベース簡易システム ;# 「Perl書法」(アスキー出版)著者:(c)増井俊之氏 使用許諾済(1996/11/21) ;# ;# CGI組込 by www.rescue.ne.jp ;# ;# Created on: 96年3月2日 ;# Last Modified on: 98年7月19日 ;# #-------------------------------------------------------------------------- #日本語コード変換ライブラリ require './jcode.pl'; #学習辞書ファイル $dict = "./dic.dat"; #会話記録ファイル(このファイルだけv2以下との互換性はありません) $file = "./log.dat"; #作業ファイル $quest = "./quest.dat"; $nick = "./nick.dat"; #ロボット名の設定 $robot_name = 'ぴっぴっぴ〜よこちゃん'; #名称 $title = 'WebROBOT'; # 会話の最大表示域の設定(サーバに負担をかけない為にも小さくしましょう) $rescue = "20"; #標準入力(post)、その他(get) $method = "post"; #-------------------------------------------------------------------------- srand(time); ($WORD,$NAME)=(1..2); &readdic; print "Content-type: text/html\n\n"; ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); if ($sec < 10) { $sec = "0$sec"; } if ($min < 10) { $min = "0$min"; } if ($hour < 10) { $hour = "0$hour"; } $month = ($mon + 1); $date_now = "$month\/$mday $hour\:$min"; if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } if (!open(quest,$quest)) { &error(1); } $ff = ; close(quest); if ($ff eq '') { if (!open(nick,">$nick")) { &error(2); } print nick ""; close(nick); if (!open(quest,">$quest")) { &error(3); } print quest "1"; close(quest); } if ($buffer eq "") { &html; } else { &an_r; if ($cn eq "") { &first; &an_w; } else { if ($ff eq "1") { &am_check; &an_w; } else { &comu; } } &html; } exit; sub html { if (!open(DB,$file)) { &error(4); } @ines = ; close(DB); if (!open(nick,$nick)) { &error(5); } $nn = ; close(nick); print "$title\n\n"; print "\n\n"; print '' ."\n"; print "$title 会話ウインドウ:$rescue行

\n"; print "■一対一の会話システムなので、誰かが利用中は終わるまで待ってください。全角を利用し簡単な会話をしてください。\n"; print "聞いてきたことに対する答えを覚えていき、次に誰かが入力した際の返事に使われます。

\n"; if ($nn ne "") { print "■現在使用中ですが、バイバイしないでいなくなった場合もありますので時刻を見て判断してシステムリセットしてください。

\n"; } print "

\n"; if ($nn eq "") { print "名前:(現在利用者はいません)
\n"; print "\n"; } else { print "名前:$nn
\n"; print "発言:(終了にはバイバイを必ず入力)\n"; } print "
\n"; print "\n"; if ($nn eq "") { print "\n"; } else { print "\n"; } print "\n"; if ($nn ne "") { print "\n"; } print "
\n"; print "

\n"; foreach $line (@ines) { ($date,$cn,$robot) = split(/\,/,$line); if ($cn eq $robot_name) { print "$cn > $robot ($date)
\n"; } else { print "$cn > $robot ($date)
\n"; } } print "

\n"; print "


WebROBOT v3.0
\n"; print "\n"; } sub an_r { @pairs = split(/&/,$buffer); foreach $pair (@pairs) { ($ame, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s//>/g; $value =~ s/"/"/g; $value =~ s/\n//g; $value =~ s/\,//g; &jcode'convert(*value,'sjis'); $FORM{$ame} = $value; } $cn = $FORM{'robot_name'}; if ($cn eq $robot_name) { $cn = "$robot_nameの偽者"; } $robot = $FORM{'robot'}; } sub an_w { undef(@new); if (!open(DB,"$file")) { &error(6); } @lines = ; close(DB); $i = 0; foreach $line (@lines) { $i++; if ($i == $rescue) { last; } push(@new,$line); } $value = "$date_now\,$cn\,$robot\n"; unshift(@new,$value); if (!open(DB,">$file")) { &error(7); } print DB @new; close(DB); } sub first { $cn = $robot_name; $robot = '名前はなんて言うの?名前欄に名前を書いて[発言]ボタンを押してね。'; if (!open(nick,">$nick")) { &error(8); } print nick ""; close(nick); if (!open(quest,">$quest")) { &error(9); } print quest "1"; close(quest); } sub am_check { $nam = $cn; $cn = $robot_name; if ($name{$nam} eq "1") { $robot = "$namさん、また来たのね!お元気ですか?"; } else { $robot = "$namさん、はじめまして!お元気ですか?"; $name{$nam} = "1"; &writedic; } if (!open(nick,">$nick")) { &error(10); } print nick "$nam"; close(nick); if (!open(quest,">$quest")) { &error(11); } print quest "0"; close(quest); } sub comu { $_ = $robot; if (/(バイバイ|ばいばい|さよなら|さようなら|またね)/) { &an_w; if (!open(nick,">$nick")) { &error(12); } print nick ""; close(nick); if (!open(quest,">$quest")) { &error(13); } print quest "1"; close(quest); $cn = $robot_name; $robot="またね!"; &an_w; } else { &an_w; if (!open(quest,$quest)) { &error(14); } $word = ; close(quest); s/ / /g; s/!//g; s/!//g; if (s/(です|ですよ|だよ|よ|のことだよ|のことよ|のことです|のことですよ|のことだ|のこと|ことだよ|)$//) { $word{$word} = $_ if $word; } @words = split(/ /,$robot); $word = $words[rand($#words +1)]; $word =~ s/(の|は|?)$//; $cn = $robot_name; if ($word{$word}) { while (1) { $word = $word{$word}; last if rand(1) > 0.4; last unless $word{$word}; } if (rand(1) > 0.4) { $robot = "$wordね"; &an_w; } else { $robot = "$word!"; &an_w; } } else { if ($word eq "") { $robot = "なにかいってよ!"; &an_w;} else { $robot = "$wordっていわれたらなんてこたえたらいい?または$wordってなに?"; &an_w; if (!open(quest,">$quest")) { &error(15); } print quest "$word"; close(quest); &writedic; } } } } sub readdic { if (!open(dict,$dict)) { &error(16); } while () { s/\n//g; ($cat,$in,$out)=split(/:/); $word{$in} = $out if $cat == $WORD; $name{$in} = $out if $cat == $NAME; } close(dict); } sub writedic { if (!open(dict,">$dict")) { &error(17); } while (($in,$out)=each(%word)) { print dict "$WORD:$in:$out\n"; } while (($in,$out)=each(%name)) { print dict "$NAME:$in:$out\n"; } close(dict); } sub error { print "ERROR($_[0])\n"; exit; }