#! /usr/local/bin/perl # #ゅぃぼっとゆーてぃりてぃ Ver.1.0 #ゆいぼっと用辞書のメンテナンスを行います。 #著作権はゆいちゃっとのゆいにあります。 # #本スクリプトは、ゆいぼっとの管理人さん、または、親しい常連さん #のみにURLを秘密公開してください。 #悪意の参加者が全ての辞書登録を削除する可能性があります。 #利用にあたっては、十分にご注意ください。 require './jcodeLE.pl'; $bot_file = './yui.dat'; &decode; &search if ($mode); &html; exit; sub html { #検索実行直後のみ番号指定可にする。 $bangou='行番号指定削除' if ($mode eq 'search'); print "Content-type: text/html\n\n"; print <<"_HTML_"; BotUtility1.0 警告:初めてこのスクリプトを利用する場合は、辞書のバックアップをお願いします。
ゆいぼっと辞書のメンテナンス専用です。
発言に対する応答検索、キーワードによる削除、応答による削除を行うことができます。
モード:検索 キーワード削除 応答削除 $bangou
文字列:

_HTML_ if(($chat ne "") && $mode eq 'search'){ print "発言内容:$chat
\n"; print "$total通りの応答が可能\です。
\n"; @ans = reverse @ans; print @ans; } if($del){ print "$chatを含む、$del個の登録を削除しました。辞書トータル:$total

\n"; print "削除一覧:
\n"; print @dels; }elsif($mode =~/del/){ print "$chatの削除に失敗しました。辞書トータル:$total

\n"; } print <<'_HTML_';
こちらに使い方の説明があります。
ゅぃぼっとゆーてぃりてぃ Ver.1.0
_HTML_ }#html END sub decode { if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } @pairs = split(/&/,$buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/\n//g; $value =~ s/\r//g; &jcode'convert(*value,'sjis'); $FORM{$name} = $value; } $chat = $FORM{'chat'}; $mode = $FORM{'mode'}; }#decode END sub search{ undef (@ans); open(DB,"$bot_file") || exit; $i=0; while(){ chop; $messege=$_; ($key,$res)=split(/:#/); next if $key eq ''; $i++; if($mode eq 'del1'){#キーワード削除 $keyword = $key; }elsif($mode eq 'del2'){#応答削除 $keyword = $res; }elsif($mode eq 'del3'){#番号削除 $keyword = $i; }else{ $test=0; eval {$test=1 if $chat=~/.*$key.*/;}; if($@ ne ''){ $test=1 if (index($chat,$key) >= 0 ); } $res=$key.":#".$res.":#($i)
"; push(@ans,$res) if $test; next; } if ($chat ne $keyword){ push(@ans,"$messege\n") ; #残すリスト }else{ push(@dels,"$messege ($i)
") ; #削除リスト } }#while close(DB); $total=@ans;$del=@dels; &write if ( ($mode=~/del/) && $del); }#search END sub write{ open(DB,">$bot_file") || exit; eval 'flock(DB,2);'; seek(DB,0,0); print DB @ans; eval 'flock(DB,8);'; close(DB); }#write END __END__