diff -urN /non-existant-dir/.svnversion tiarra-20050322/.svnversion --- /non-existant-dir/.svnversion 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/.svnversion 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1 @@ +850 diff -urN /non-existant-dir/AUTHORS tiarra-20050322/AUTHORS --- /non-existant-dir/AUTHORS 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/AUTHORS 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,64 @@ +-*- text -*- +$Id: AUTHORS,v 1.1 2004/02/14 08:44:24 admin Exp $ +プログラム: Tiarra +メインの開発者: phonohawk + +Authors (敬称略) +=============== + +* tiarra, main/* + +phonohawk: 設計, 殆どのクラスの実装 +Topia: 幾つかのクラスの設計と実装, 多数の改良とバグ修正 + +* module/下、Auto関連 + +Topia: ほぼ全て +phonohawk: (初期バージョンのみ)設計と実装 + +* module/下、Auto以外 + +phonohawk: ほぼ全て +Topia: 幾つかのクラスの設計と実装, 多数の改良とバグ修正 + +* module/System/SendMessage.pm + +Yoichi Imai: 初期設計と実装。 +Topia: 改良 + +* bundle/IO/Socket/INET6.pm + +phonohawk + +* tiarra-conf.el + +phonohawk + +* tiarra-conf.l + +Noboruhi: tiarra-conf.elからの移植 + +* doc/*, doc-src/* + +phonohawk: ほぼ全て +other: モジュールから ./makedoc により自動生成。 + +* アーカイブの作成と配布 + +Topia (2004年10月現在) + +* bundle/ にバンドルされている外部モジュール + (IO/Socket/INET6.pm は除きます。) + +Unicode::Japanese(PurePerl): + Copyright 2001-2004 + SANO Taku (SAWATARI Mikage) and YAMASHINA Hio. + All right reserved. + +=============== +その他、多数の方々よりバグ報告や改良案等を頂き、Tiarraは改善されております。 +この場を借りて感謝の意を申し上げます。 + +- phonohawk - http://ccm.sherry.jp/ +OpenPGP public key: 1024D/1A86EF72 +Fpr: 5F3E 5B5F 535C CE27 8254 4D1A 14E7 9CA7 1A86 EF72 diff -urN /non-existant-dir/ChangeLog tiarra-20050322/ChangeLog --- /non-existant-dir/ChangeLog 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/ChangeLog 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,1999 @@ +2004-08-22 Topia + + * HACKING: + - ModuleManager/*_blacklist, Multicast/attach_for_client, + remark/IRCMessage/always-use-colon-on-last-param, + Hook の使い方を追加。 + + * tiarra: + (shutdown): + - runloop->terminate を使った shutdown を行うようにした。 + - runloop->terminate が失敗した時のために、2度以上 shutdown が + 呼ばれれば強制終了する。 + + * doc-src/conf-main.tdoc, main/Configuration.pm: + - general/messages/quit/netconf-changed-{re,dis}connect を追加。 + + * main/IrcIO.pm: + (disconnect): + - runloop->unregister_receive_socket を呼ぶ。 + + * main/IRCMessage.pm: + (serialize): + - remark/always-use-colon-on-last-param 追加。最後のパラメータの + シリアライズ時に必ずコロンを使うようにする。 + 主にクライアント対策用。 + + * main/ModuleManager.pm: + (add_to_blacklist, remove_from_blacklist, check_blacklist, _set_blacklist): + - blacklist の実装。 + (_clear_module_cache, get_modules): + - blacklist を除いた、使用可能モジュールのキャッシュを作る。 + (terminate): + - mod_timestamp にあるモジュールも destruct/_unload する。 + (check_timestamp_update): + - 共通ルーチンとしてメソッドにした。 + (update_modules): + - blacklist 関連処理と、設定は変更されていないがアップデート + されていて、前回ロード失敗しているモジュールの再試行を追加した。 + (reload_modules_if_modified, _unload): + - blacklist 関連処理の追加。 + + * main/Multicast.pm: + (_NOTICE_from_server): + - 追加。 MODE で代用していると、メッセージとして global nick + のみが送られてきたときに、改変してしまう。 + ($server_sent): + - NOTICE と PRIVMSG を _NOTICE_from_server へ変更。 + (attach_for_client): + - 追加。multi-server-mode のときのみ attach する。 + + * main/RunLoop.pm: + - set-current-nick フックを追加した。 + (_new): + - 一時変数として $conf を追加して見やすくする。 + - terminated_networks, terminating を追加。 + (network): + - networks, disconnected_networks, terminated_networks の各 + ジャンルを順に検索して、最初に見つかったものとジャンル名を返す。 + (set_current_nick): + - set-current-nick フックを呼ぶようにした。 + (_conf, _conf_{general,networks,messages}): + - Configuration::shared_conf->... の短縮形として追加。 + (_cleanup_closed_link): + - unregister_receive_socket を使うようにした。 + - state として reconnecting/terminating/finalizing を受け入れる。 + (_action_{part_and_join,message_for_each}): + - Multicast::attach_for_client を使うようにした。 + (update_networks): + - ->_conf* を使うようにした。 + - state として reconnecting/finalizing を使う。 + (terminate_server): + - 追加。 quit し、 conf 変更がない限り自動再接続しない。 + - state として terminating を使う。 + (reconnect_server): + - 何らかのジャンルにあるネットワークを再接続する。 + (disconnect_server): + - セレクタからの削除は IO->disconnect に任せる。 + (close_client): + - ERROR を送信してクライアントを切断する。 + ({,un}install_socket): + - ->{,un}register_receive_socket を使うようにした。 + ({,un}register_receive_socket): + - 追加。 ->{receive_selector}->{add,remove} を呼ぶだけ。 + (run): + - ->_conf* を使うようにした。 + - ->{,un}register_receive_socket を使うようにした。 + - 終了処理中はクライアントからの接続を受けても即切断する。 + - 終了処理を追加。また、 400 回以上ループを回ったら強制終了する。 + (terminate): + - 全てのサーバ・クライアントを切断する。 + - 終了処理フラグを立てる。 + (apply_filters): + - エラーメッセージを表示するときに、再帰を防ぐために一時的に + ブラックリストに入れる。 + - 処理がまわってきているということはブラックリストにないという + ことなので、そのまま解除しても大丈夫なはず。 + (_apply_filters): + - バージョン管理もしているし、いらないコメントを削除する。 + (notify_msg): + - ->_conf* を使うようにした。 + + * main/TiarraDoc.pm: + (_makeconf): + - 空行のときはインデントしないようにした。 + + * main/Configuration/Preprocessor.pm: + - 解説コメントが間違っているので訂正。 + + * main/IrcIO/Client.pm: + (new): + - runloop->register_receive_socket を呼ぶようにした。 + (username, client_host): + - 追加。プロパティ取得専用。 + (do_namreply): + - ->inform_joinning_channels の中の names 関連処理だけ分けた。 + (inform_joinning_channels): + - ->do_namreply を使うようにした。 + + * main/IrcIO/Server.pm: + - RunLoop 用の ->state を追加。 + (connect): + - runloop->register_receive_socket を呼ぶようにした。 + (quit): + - quit メッセージを送信する。 + + * module/Skelton.pm: + (message_io_hook): + - 過去から現在進行へ修正。 + + * module/Auto/Utils.pm: + (sendto_channel_closure): + - Multicast::attach_for_client を使うようにした。 + + * module/Client/Cache.pm: + - network が存在しないのはあまり特別な事態ではなくなったので、 + debug 時でさえも表示しないようにした。 + + * module/Client/Eval.pm: + - 無意味なリスト生成をやめて、配列をそのまま使うようにした。 + + * module/Client/Rehash.pm: + - 追加。 nick と names による rehash を行う。 + + * module/Log/Channel.pm: + - Log::Writer フレームワークを使うようにした。 + - always-flush 設定を追加。 + - 現在、 dir の都合によりプロトコルを混ぜることはできません。 + + * module/Log/Writer.pm: + - 追加。ログ記録に必要なメソッド(reserve, flush)に限った + マルチプロトコル対応可能なフレームワーク。 + + * module/Log/Writer/Base.pm: + - Log::Writer のプロトコルプラグインのベースクラス。 + + * module/Log/Writer/File.pm: + - Log::Writer の File プロトコルプラグイン。 + - fallback として動作するため、プロトコルを省略したときも + (そして他の fallback によってハンドルされなかったときも) + このプロトコルで処理する。 + - ないディレクトリは勝手に作るので注意。 + + * module/System/Error.pm: + - 追加。 ERROR メッセージをクライアントに送る前に NOTICE に埋め込む。 + - デフォルトオンです。機構的に以前からの conf は救済できません(^^;; + + * module/System/Shutdown.pm: + - シャットダウンメッセージを受け入れるようにした。 + + * module/System/NotifyIcon/Win32.pm: + - iconfile と hide-console-on-load 設定を追加。 + - 他の雑多な機能は 128 文字対応が全然動いてくれない上に、 + 実装自体も全然進んでいないので見送りです。 + + * module/Tools/FileCache.pm: + - use Carp を追加。 + - shared で __PACKAGE__ を使うようにした。 + + * module/Tools/FileCache/EachFile.pm: + - ->{add,del}_refcount を ->{add_ref,release} に変更。 + 内部 API だから影響はないはず。 + +2004-07-29 Topia + + * main/ModuleManager.pm: + - ->notify_error(...) を ->notify_error->(...) と間違えていた + ので修正。 + (reload_modules_if_modified): + - USED に対してメッセージは出しても実際にはリロードして + いなかったので修正。 + (_unload): + - 自分でシンボルテーブルをクリアする代わりに、 Symbol::delete_package を + 使うようにした。ただしサブパッケージは退避している。 + + * main/Timer.pm: + (reset): + - 追加。現在の時刻を元に fire_time を設定しなおす。 + + * main/Module/Use.pm: + (import): + - @USE にそのまま設定する代わりに push をするようにした。 + + * module/Client/Eval.pm: + - いくつか関数を追加。 + (conf, module_manager, module, shutdown, reload) + + * module/System/NotifyIcon/Win32.pm: + - 追加。タスクバーの通知領域にアイコンを表示し、コンソールの + 表示・非表示、 conf リロード、終了などができる。 + +2004-07-24 Topia + + * HACKING: + - Auto::Utils::sendto_channel_closure の説明を追加。 + - remark の説明をいくつか追加。 + - Emacs で自動的に text-mode になるようにした。 + (Local variables) + + * Makefile: + - 間違っているコメントを削除した(etags/update もするし)。 + - ターゲット名を clean に変えた。 + - clean の一行目だけでも sh で通るようにした。 + + * main/ControlPort.pm: + - SelfLoader が動作しない例の一つだった。修正もれ。 + コメントアウトして対処した。 + + * module/Auto/Utils.pm: + - いくつか説明コメントを修正。 + (sendto_channel_closure): + - $sender が省略されれば自分で調査して送信する。 + ($sendto, $command) だけで呼べるようになった。 + - シングルサーバモード時の処理をしていなかったので修正。 + +2004-07-09 phonohawk + + * module/Auto/Reply.pm, + module/User/ServerOper.pm, + module/User/Vanish.pm: + typoの訂正。動作に変更は無い。 + +2004-07-08 Topia + + * main/Configuration.pm: + - include されたファイルの更新も感知するようにした。 + + * main/Mask.pm: + (_split): + - $mask が未定義の時に warning がでるのを防止した。 + + * main/ModuleManager.pm: + (reload_modules_if_modified): + - エラー通知に notify_error を使うようにした。 + + * main/ReloadTrigger.pm: + - Configuration::Hook/reloaded について追記。 + + * main/Timer.pm: + - notify_error の発行対象にしているパッケージの間違いを修正。 + + * main/Configuration/Preprocessor.pm: + - ->included_files を追加。 + + * main/IrcIO/Client.pm: + (_receive_while_logging_in): + - $network が未定義(未接続)の時にエラーがでていたので修正。 + (inform_joinning_channels): + - 固定チャンネルの mask は一致した分を全部飲み込むように変更。 + #*@ircnet,#*@ircnet:* のようなことが出来るようになるはず。 + + * module/System/Reload.pm: + - conf-reloaded-notify を追加。 + +2004-06-19 Topia + + * doc-src/conf-main.tdoc: + - ./tiarra --make-password のことを書き加えた。 + + * main/Timer.pm: + - code 中で die が起こっても abort しないようにした。 + + * module/Channel/Mode/Oper/Grant.pm: + - $myself が undef でないかチェックするようにした。 + + * module/Client/Cotton.pm: + - 追加。いくつかの Cotton の不具合を回避する(予定)。 + - 今は network rejoin 時の自動 part を無視する。 + + * module/Client/Eval.pm: + - runloop に括弧を付け(て関数形式に認識させ)るのを + 忘れていたので修正。 + + * module/Client/GetVersion.pm: + - 追加。クライアントの接続時に CTCP Version を発行して + クライアントのバージョンを取得する。 + +2004-06-09 Topia + + * main/IrcIO/Server.pm: + (_receive_while_logging_in): + - PING に対応した。 + - RPL_WELCOME / NOTICE / PRIVMSG 以外で無視することになった場合、 + 警告を出す。 + +2004-06-04 Topia + + * main/IRCMessage.pm: + - MAX_PARAMS(= 14) 定数を追加した。 + (params): + - 呼び出し時に未定義なら強制的に初期化するようにした。 + (n_params): + - params を使用するようにした。 + (_parse): + - $this->push を使用するようにした。 + (length, push, pop): + - 追加した。 + + * main/IrcIO/Client.pm: + (_receive_while_logging_in): + - シングルサーバモード時にサーバから RPL_ISUPPORT が提供されていれば、 + それを送信するようにした。 + + * module/Client/Cache.pm: + - MODE キャッシュ、 WHO キャッシュともに、取得中フラグに有効期限を + つけるようにした。デフォルトで 5 分、 conf では指定できない。 + - 念のため RPL_ENDOFWHO もハンドリング。 + + * module/Client/Eval.pm: + - メッセージを再構築して、 : をつけなくても良いようにした。 + もちろん ::shutdown を実行するには /eval :::shutdown と + しなければならない(笑)。 + - $err を初期化して warning が出ないようにした。 + (network, runloop): + - eval 内部からよく使いそうなものを function 化した。 + + * module/System/Raw.pm: + - 配列の最後の要素は (n_params - 1) なので修正して warning が + でないようにした。 + +2004-06-04 phonohawk + + * main/Unicode/Japanese.pm: + Unicode::Japanese 0.22に更新。 + +2004-05-26 phonohawk + + * main/Unicode/Japanese.pm: + Unicode::Japanese 0.21に更新。 + +2004-05-09 phonohawk + + * main/IrcIO.pm (receive): + サーバーやクライアントから空行を送られた場合に、エラーが出る問題を修正。 + +2004-05-09 Topia + + * main/Multicast.pm: + (nick_p): + - 省略可能な nicklen を引数に追加した。 + (channel_p): + - 省略可能な chantypes を引数に追加した。 + + * main/IrcIO/Server.pm: + - isupport を remark からインスタンス変数に変更した。 + (nick_p, channel_p): + - 追加した。 ISUPPORT として NICKLEN, CHANTYPES が指定されていた + 場合にそれを使って検査する。 + (_set_to_next_nick): + - 簡略化した。 + +2004-05-08 Topia + + * HACKING: + - typo を修正した。 + - IrcIO::Server->remark に isupport と uid を追加した。 + - ChannelInfo->remark に creation-time を追加した。 + + * main/Multicast.pm: + - $server_sent, $client_sent: RPL_CREATIONTIME へ対応した。 + - $client_sent: admin コマンドを追加した。 + + * main/NumericReply.pm: + - RPL_BOUNCE を RPL_REDIR に変更。 RPL_BOUNCE はエイリアスとして + そのまま残すようにした。 + - RPL_CREATIONTIME を追加した。 + - RPL_TOPICWHOTIME を RPL_TOPIC_WHO_TIME に変更した。 + RPL_TOPICWHOTIME はエイリアスとしてそのまま残すようにした。 + - irc2.11 なものをいくつか追加した。 + + RPL_HELLO(020) + + RPL_YOURID(042) + + RPL_SAVENICK(043) + + RPL_REOPLIST(344) + + RPL_ENDOFREOPLIST(345) + + * main/IrcIO/Server.pm: + - RPL_{CREATIONTIME,ISUPPORT,YOURID} に対応した。 + (_receive_while_logging_in): + - RPL_HELLO 対策を追加した。 + (modify_nick): + - 第二引数で nicklen を指定できるようにした。 + (_set_to_next_nick): + - ISUPPORT に NICKLEN が含まれていれば、それを使うようにした。 + + * module/Client/Cache.pm: + (_send_mode_cache): + - creation-time が存在すれば、それも返すようにした。 + +2004-04-18 Topia + + * HACKING: + - BulletinBoard と remark についてを追記。 + - こまかい修正。 + + * main/IrcIO/Client.pm, module/Client/Cache.pm: + - __PACKAGE__ がダブルクォートの中では展開されないことを + 忘れていたので修正。 + + * module/Channel/Rejoin.pm: + - 自分自身がいないチャンネル(そもそもふつうはこんなことには + ならないのだが)の rejoin 判定時に error が起きるのを修正。 + +2004-04-18 phonohawk + + * main/ControlPort.pm (ControlPort::Session::main): + 誤字修正。 NOTIFT => NOTIFY + +2004-04-07 phonohawk + + * main/IrcIO/Server.pm (new): + $this->{channels}のキーを、小文字に変換しておく。 + + 大文字小文字に一貫性の無いチャンネル名をクライアントに送る、 + EFnetやFreenet(IRC)のようなircdに接続していると、しばしば + Tiarraは混乱する。この問題を回避するため、チャンネル名同士の + 比較は一旦小文字に変換した上で行うようにする。 + + (channel): + 大文字小文字を無視してチャンネルを探索するように変更。 + $server->channel($name)のようにしてChannelInfoを得ている + 場合には、何ら変更は必要無い。 + + チャンネル名 => ChannelInfoのハッシュを返す、$server->channels + を使っている場合は、そのキーが小文字に変換されている事に注意しなければ + ならない。 + + * main/Multicast.pm (lc, uc): 追加 + IRC方式で大文字と小文字の変換を行う。IRC方式とは、[]\がそれぞれ{}|の + 大文字であると定義されている方式である。 + + * main/Mask.pm (compile): 追加 + マスクからコンパイル済み正規表現を生成する部分を、独立した関数にした。 + 大量のマッチングを高速に行う場合は、Mask::の関数を何度も呼ぶ代わりに + マスクを一度だけコンパイルする事を考えた方が良い。 + Mask.pm内でコンパイル済みマスクはキャッシュしているが、それでも速度は違う。 + + +2004-04-01 Topia + + * module/Client/Cache.pm: + - single-server-mode 時の不具合をいろいろ修正。 + - mode/who に共通な一部のコードを関数リファレンスの形でまとめた。 + +2004-04-01 phonohawk + + * tiarra: + confファイルが読み込まれる前に::printmsgを実行するとdieする問題を回避。 + そのような場合には、文字コード変換を行わない。 + +2004-03-27 Topia + + * tiarra: + - quiet モード時に STDIN を閉じないと握りっぱなしになって + (sshd が落ちないなどの)不具合が発生するようなので閉じる。 + - STDERR を何かにリダイレクトするのは、とりあえずは保留。 + +2004-03-27 phonohawk + + * main/LinedINETSocket.pm (recvbuf): + 追加。通信終了後に改行が付かなかった行の内容を取り出すために使う。 + + * main/RunLoop.pm (run): + select前フックは、タイマーの次回発動時刻を計算する前に呼ぶ。 + フック内でタイマーの状態を変更しても問題を起こさないため。 + + * main/Timer.pm (time_to_fire): + 引数を指定した場合、タイマーの発動時刻を変更できるように。 + + * module/Tools/HTTPClient.pm: + 追加。 + HTTP/1.0専用のhttpクライアント。手抜き。 + +2004-03-19 Topia + + * main/IrcIO.pm, main/LinedINETSocket.pm: + - IO::Handle 1.21 において、 LEN が存在しないと croak がでる bug + の回避。 + + * main/ModuleManager.pm: + - モジュールの destruct を呼ぶ際に、 $show_msg でなく + RunLoop->shared_loop->notify_error を使うように。 + + * main/IrcIO/Client.pm: + (inform_joinning_channels): + - フックの引数を変更。 + - フックコール中にエラーが発生しても + 最低限すべてのチャンネル情報だけは送信するように。 + + * module/Client/Cache.pm: + - IrcIO::Client::Hook/channel-info を使用して、 + 知っているチャンネルモードを強制的に先行して送るようにした。 + + * module/Log/Recent.pm: + (IrcIO::Client::Hook/channel-info): + - 引数変更に同期。 + - クライアントオプション no-recent-logs をみるようにした。 + +2004-03-13 phonohawk + + * main/Hook.pm (Hook::call, HookTarget::call_hooks): + フック関数に引数を渡せるように変更。 + + * main/RunLoop.pm: + Hook.pmで一般化したためにコメントアウトしてあったフック関連のコードを削除。 + + * main/IrcIO/Client.pm (inform_joinning_channels): + チャンネル情報一つ転送される度に呼ばれるフック channel-info を定義。 + このフックには引数としてIrcIO::Client自身とチャンネル名が渡される。 + フッククラスは同ファイルで定義されるIrcIO::Client::Hook。 + + * module/Log/Recent/pm: + クライアントに送られるチャンネルと同じ順番でログも送るように変更。 + この動作はIrcIO::Clientのフックを利用している。 + + * main/RunLoop.pm (run): + Tiarra暴走検出のコードにバグがあったので修正。 + 0秒selectに2秒以上の間隔が開いた場合にはカウンタをリセットする意図があったと思うが + 2秒*以下*の間隔でリセットしていた。 + ついでなので警告の閾値も300まで引き上げ。 + +2004-03-09 Topia + + * module/Client/Cache.pm: + - destruct において、呼ぶメソッドを勘違いしていたのを修正。 + +2004-03-08 phonohawk + + * module/Unicode/Japanese.pm: + UniJP 0.20に置換え。 + +2004-03-07 Topia + + * tiarra: + - untaint を行うようにした。 + + * main/Configuration.pm: + - 呼び出す関数名を間違えていた bug を修正。 + + * main/Mask.pm: + - untaint を行うようにした。 + + * main/Multicast.pm: + - ERR_NOTONCHANNEL, ERR_NOSUCHCHANNEL を *_sent に追加。 + + * main/IrcIO/Server.pm: + - nick 変更の prefix category を nick::system にした。 + - _START_WHOIS_REPLY を呼ぶときに defined check をしてない bug + を修正。 + + * module/Client/Cache.pm: + - destruct を追加。 + - ChannelInfo につける remark にパッケージ名をつけて、 + 他のモジュールとかぶらないようにした。 + + * module/Client/Eval.pm: + - untaint を行うようにした。 + - 複数行の出力をちゃんと処理するようにした。 + +2004-02-23 Topia + + * module/Debug/RawLog.pm: + - 追加。生の IRC メッセージ(のようなもの?)を ::printmsg を使って + 表示する。 + + * main/IrcIO/Client.pm: + - RunLoop を Runloop と typo していたのを修正。 + + * main/IrcIO/Server.pm: + (_received_after_logged_in, _set_to_next_nick): + - sysmsg_prefix を使うようにした。 + (_RPL_CHANNELMODEIS): + - 存在しないチャンネルが対象だったときにエラーがでるという + どうしようもないミスを修正。 + + * main/RunLoop.pm: + (_multi_server_mode_changed): + - sysmsg_prefix を使うようにした。 + + * makedoc: + - sample.conf を出力するようにした。 + - 全体にわたってモジュール名のソートを行うようにした。 + - block 構文への暫定対応。 + - #key:value という *コメント* をきちんと認識していなかったのを fix + - グループ名に説明が定義されていなかったときに警告を出すようにした。 + + * tiarra: + - --enable-debug 時にも、 couldn't connect 関連のメッセージなら + スタックトレースを省略するようにした。 + + * sample.conf: + - TiarraDoc を使用するようになった。 + + * doc/module-toc.html, doc/module/*.html: + - regen. + + * doc-src/conf-main.tdoc: + - general/omit-sysmsg-prefix-when-possible 削除。 + - general/sysmsg-prefix-use-masks ブロック追加。 + - 書かれていなかった networks/multi-server-mode の解説を + sample.conf から持ってきて追加。 + - typo したままだった networks/channel-network-separator の + コメントを sample.conf に従って修正。 + - ircnet/host を irc.nara.wide.ad.jp に変更。 + いまは停止しているのだが、復活を願うということで。 + + * doc-src/module-group.tdoc: + - Channel の最後が typo していたのを修正。 + - Client, CTCP, Debug を追加。 + とはいえ Debug はまだ cvs repo. には存在していないが…。 + + * doc-src/sample.conf.in: + - RCS Tag 'Id' を追加。 + + * main/Configuration.pm: + - general/omit-sysmsg-prefix-when-possible のデフォルト値を消して、 + general/sysmsg-prefix-use-masks のデフォルトブロックを追加。 + (_complete_table_with_defaults): + - _complete_{table,block}_with_defaults に分割。 + (_complete_table_with_defaults): + - Block を使った実装に変更。 + - Configuration::Block->table の追加が必須。 + (_complete_block_with_defaults): + - block(hash_ref) と array_ref のデフォルト値に対応。 + + * main/ModuleManager.pm: + (update_modules): + - %loaded_mods に古いモジュールが無かった場合は無視するようにした。 + (_unload): + - デバッグモード時でも、同じモジュールからの 11 以上の export は表示しない。 + + * main/Multicast.pm: + - $server_sent, $client_sent: NumericReply 化。 + ERR_TOOMANYCHANNELS と RPL_WHOISCHANNELS を追加。 + (_NJOIN_from_server, _RPL_NAMREPLY): + - /[@+]/ が変数展開されているようなので /[\@+]/ に変更。 + (_WHOIS_from_client): + - RunLoop->shared_loop->sysmsg_prefix を使用するようにした。 + (_{attach,detach}_RPL_WHOISCHANNELS): + - 追加。 WHOIS で表示されるチャンネル名に network をつける。 + + * main/RunLoop.pm: + - sysmsg_prefix を追加。 + (_action_one_message, _action_message_for_each, notify_msg): + - RunLoop->shared_loop->sysmsg_prefix を使用するようにした。 + + * main/TiarraDoc.pm: + (_makeconf): + - block への暫定対応。 + + * main/Configuration/Block.pm: + - ->table を追加。 + (eval_code): + - original の typo を修正。 + + * main/IrcIO/Client.pm: + - RunLoop->shared_loop->sysmsg_prefix を使用するようにした。 + (inform_joinning_channels): + - 暫定的に networks/fixed-channels ブロックに channel の mask を + 書くことで、送信順を指定できるようにしたが、 conf エントリ名が + 気に入らないため、名前が決まるまでは sample.conf に + 書かないことにする。 + + * main/IrcIO/Server.pm: + - ->server_hostname を追加。 RPL_WELCOME(001) で送られてきた + サーバ名を保持する。 + - サーバで nick 変更が起こったときに、以前の nick も表示するようにした。 + + * module/Auto/Reply.pm: + - 返答時に mask をチェックするようにした。 + + * module/Channel/Freeze.pm: + - RunLoop->shared_loop->sysmsg_prefix を使用するようにした。 + - 不要になった use Configuration; を削除。 + + * module/Client/Cache.pm: + - RunLoop->shared_loop->sysmsg_prefix を使用するようにした。 + - WHO キャッシュ送信時において、 Multicast::global_to_local を + 使って nick を変換していなかった bug を修正。 + - 不要になった use Configuration; を削除。 + + * module/Client/Eval.pm: + - RunLoop->shared_loop->sysmsg_prefix を使用するようにした。 + - 無用な remark('fill-prefix-when-sending-to-client') をなくした。 + + * module/Log/Recent.pm: + - no-recent-logs クライアントオプションを追加。 + - RunLoop->shared_loop->sysmsg_prefix を使用するようにした。 + - 不要になった use Configuration; を削除。 + + * module/System/Pong.pm: + - NumericReply 化。 ERR_NOORIGIN を返せるようにした。 + - PING もここで破棄するようにした。 + (message_arrived): + - $sender->server_hostname を使用して正確なホスト名に返す。 + + * module/System/Raw.pm: + - RunLoop->shared_loop->sysmsg_prefix を使用するようにした。 + - NumericReply 化。 NOTICE の代わりに ERR_NEEDMOREPARAMS を返す。 + - 不要になった use Configuration; を削除。 + + * module/User/Ignore.pm: + - sample conf の mask に例示用ドメインを使用するようにした。 + + * module/Auto/Alias.pm, module/Auto/Answer.pm, + module/Auto/ChannelWithoutOper.pm, module/Auto/Joined.pm, + module/Auto/MesMail.pm, module/Auto/Oper.pm, + module/Auto/Random.pm, module/Auto/Reply.pm, + module/Auto/Response.pm, module/CTCP/*.pm, + module/Channel/*.pm, module/Channel/Join/Invite.pm, + module/Channel/Join/Kicked.pm, module/Channel/Mode/*.pm, + module/Channel/Mode/Oper/Grant.pm, module/Log/Recent.pm, + module/System/Macro.pm, module/System/Pong.pm, + module/System/Raw.pm, module/System/RemoteControl.pm, + module/System/Shutdown.pm, module/User/Filter.pm, + module/User/ServerOper.pm, module/User/Vanish.pm, + module/User/Away/Client.pm, module/User/Away/Nick.pm, + module/User/Nick/Detached.pm: + - TiarraDoc 化。 sample.conf から取ってきて一部まずいところは + 変更している。 + +2004-02-21 phonohawk + + * module/Channel/Freeze.pm: + freezeコマンドの引数は、これまでは完全なチャンネル名であったが、 + これはマスクに変更。その時にJOINしている全てのチャンネルの中から + マスクに一致した全てのチャンネルを凍結する。 + + * sample.conf, doc-src/conf-main.tdoc: + 設定 general/omit-sysmsg-prefix-when-possible 追加。 + これが1である時、sysmsg-prefixはチャンネルに対してのメッセージ + でなければ省略する。デフォルトは1。 + + * main/Configuration.pm: + general/omit-sysmsg-prefix-when-possible のデフォルト値を追加。 + + * main/Multicast.pm, main/RunLoop.pm, + main/IrcIO/Client.pm, module/Channel/Freeze.pm, + main/Log/Recent.pm, module/System/Raw.pm: + omit-sysmsg-prefix-when-possibleを反映。 + +2004-02-15 Topia + + * module/Client/Cache.pm: + - message_io_hook を追加。サーバとの通信を監視して、 + MODE や WHO を発行(して返答をもらっている)途中かどうかを + 記憶しておくように。 + - message_io_hook で記憶した情報を使って、 + (ほかのクライアントなどによって)サーバに情報を問い合わせている + 途中の時も、メッセージを破棄するようにした。 + 2つ以上のクライアントが同時につながったときに効果が出るはず。 + テストには LimeChat を 3 つ同時に接続させたが、 + サーバへの問い合わせは各チャンネルにつき1回までに抑えられていた。 + - クライアントに伝達される必要のあるメッセージではないので、 + RunLoop->shared_loop->notify_warn() if ::debug_mode; から + ::debug_printmsg(); に変更。 + - WHO キャッシュにおいて、 + データ不足であきらめたときのメッセージ表示をやめた。 + +2004-02-14 Topia + + * 全般: + (a) NumericReply を使うようにした。 + (b) general/sysmsg-prefix を使うようにした。 + + * doc-src/conf-main.tdoc, sample.conf: + - sysmsg-prefix を追加。 + + * sample.conf: + - Client::Eval と Client::Cache を追加。 + + * main/ChannelInfo.pm: + - mode_string method を追加。 + + * main/Configuration.pm: + - general/sysmsg-prefix のデフォルト値を追加。 + + * main/IRCMessage.pm: + - clone(deep => 1) を追加。 + - s/unvalid/invalid/; fix typo. + - $this->[PARAMS] がそもそも未定義なときは、 + n_params は中身なし配列の長さ(=0)を返すようにした。 + + * main/ModuleManager.pm: + - module の reload の時に、一時的に $this->{modules} の + 該当箇所に undef を入れて実行されないようにした。 + (main/RunLoop.pm の変更とセットです。) + + * main/Multicast.pm: (b) + - シングルサーバモードで、どこのネットワークにも + 繋がっていないときは、デフォルトネットワークに + $networks->default を使うようにした。 + + * main/NumericReply.pm: + - irc2.10.3p5+hemp2 に合わせた。 + ISUPPORT は使用する設定。 + - fetch_number(名前から番号), fetch_name(番号から名前) + のそれぞれを得る関数を追加した。 + + * main/PersonInChannel.pm: + - priv_symbol method (privilege symbol) を追加。 + has_[ov] の状態によって、 @, +, 空文字列のどれかを返す。 + + * main/PersonalInfo.pm: + - AWAY を追加。できるだけ更新しますが、 + 性質上情報の正確さは保証できません。 + + * main/RunLoop.pm: (b) + - single-server-mode 時に、切断・接続のアナウンスの + 送信先チャンネル名からネットワーク名をはずすようにした。 + - サーバへの接続処理時に、 couldn't connect to 以外の + エラーメッセージ表示には notify_error を使うようにした。 + - クライアントからの接続処理時は、エラーメッセージ表示に + notify_msg を使うようにした。 + - apply_filters で、 modules_list の中に undef が出てきたら、 + それを無視するようにした。 + (main/ModuleManager.pm の変更も参照。) + + * main/IrcIO/Client.pm: (a)(b) + - credit を RPL_YOURHOST でなく MOTD として表示するようにした。 + - RPL_YOURHOST では、 Tiarra のバージョンを表示する。 + + * main/IrcIO/Server.pm: (a) + - _RPL_* の処理を NumericReply::fetch_name を使ってまとめた。 + - _START_WHOIS_REPLY, _RPL_ENDOFWHOIS, _RPL_AWAY を追加。 + - _RPL_WHOREPLY + + 空白を含む realname に関するバグを修正。 + + away 情報を記憶するようにした。 + + server hop 情報を network の 'server-hops' remark に保存。 + - _RPL_CHANNELMODEIS で、 switches と parameters の情報は + この reply で得られると決めつけて、クリア処理を行う。 + + * module/Channel/Freeze.pm: (b) + + * module/Channel/Rejoin.pm: (a) + - ChannelInfo->mode_string を使用するようにした。 + + * module/Channel/Join/Connect.pm: + - コンマの直後にスペースがあった場合、削除する処理が、 + 最初の一つに対してしか実行されていなかったのを修正…(^^;;; + + * module/Client/Cache.pm: + - 追加。いまのところ MODE キャッシュと、 WHO キャッシュを実装。 + + * module/Client/Eval.pm: + - 追加。クライアントからのコマンドしか受け付けないが、 + その代わりすべてのコマンドを実行できる。 + 事実上 IRC パスワードがわかれば Tiarra が動いているホスト上で + 動作しているアカウントの権限で何でもできる、 + ということに注意すること。 + + * module/Log/Recent.pm: (b) + - network name が不正な場合は、 notify_warn で警告して、 + エラーなしに抜けるようにした。 + + * module/System/Pong.pm: + - prefix がついているのは不自然だったので、削った。 + + * module/System/Raw.pm: (b) + + * module/Tools/LinedDB.pm: + - ファイルが存在しない場合に、 + 更新チェック部分でエラーが発生していたのを修正。 + +2004-02-04 phonohawk + + * main/IrcIO.pm, main/IrcIO/*.pm, main/Module.pm: + notification_of_message_ioを削除。 + + * main/Module.pm (message_io_hook): + 追加。これはnotification_of_message_ioの代わりに呼ばれる。 + このメソッドはメッセージを改変する事が出来る。詳しくはコメントに。 + + * main/IrcIO.pm (send_message, receive): + 各モジュールのmessage_io_hookを呼ぶ。 + + * main/RunLoop.pm (apply_filters): + 追加。モジュールによるメッセージフィルタリングの一般形。 + +2004-01-27 phonohawk + + * main/NumericReply.pm: 追加 + ニューメリックリプライをシンボルとして定義するクラス。 + useで全シンボルをエクスポート。 + + * main/IrcIO.pm: + CRが無く、LFだけで終わっているメッセージも受け入れる。 + +2004-01-23 Topia + + * tiarra: $0 自体が symlink だったときに、@INC に symlink 先の + main/module を含めるようにした。 + カレントディレクトリ・$0 のディレクトリは常に含むようにした。 + (make_password): --make-password=password を可能にした。 + +2004-01-23 phonohawk + + * tiarra: 起動時オプション --make-password 追加。 + make-passwordの機能をtiarra本体に移した。 + + * make-password: 削除 + +2004-01-20 phonohawk + + * main/Unicode/Japanese.pm: + 同梱のUniJPを0.18から0.19に。JISの問題は解決。 + +2004-01-14 phonohawk + + * main/Mask.pm: + マスクから作った正規表現をqrでコンパイルする際、 + iフラグを付け忘れて大文字小文字の区別が*されていた*ので修正。 + + * main/IRCMessage.pm (_parse): + 空文字列については文字コード変換処理を明示的に省略する。 + Unicode::JapaneseにはISO-2022-JP→UTF-8変換において空文字列を"\x00"にしてしまう問題あり。 + +2003-11-17 Topia + + * tiarra: enhancement. + パッケージ用にいくつかのバージョン変数を追加した。 + + * module/Log/Channel.pm: enhancement/need reload. + + デフォルトのログファイルパーミッションを 644 から 600 にした。 + ディレクトリ作成時のパーミッションを指定できるようにした。(dir-mode) + デフォルトは 700 。 + + * tiarra: enhancement. + + --dumpversion を追加した。 + パッケージ作成時にバージョン情報を得るため等に使う予定。 + +2003-11-09 Topia + + * module/System/Reload.pm (message_arrived): bugfix/need reload. + + Timer を使って遅延処理することによって、reload command での + 自分自身のリロードを可能にした。 + + * main/RunLoop.pm (run): bugfix(single-server-mode)/need reboot. + + single-server-mode 時の、クライアントから送られて来た + PRIVMSG/NOTICE のブロードキャストで、 network-suffix 付きの + チャンネルに送信してしまっていた。 + +2003-11-09 phonohawk + + * tiarra (help): + メッセージ中のstdinとstderrの間違いを修正。 + +2003-11-08 Topia + + * make-password: enhancement. + + パスワードの入力に、 Term::ReadLine を使用するようにした。 + + * module/Log/Recent.pm (client_attached): bugfix(single-server-mode)/need reload. + + single-server-mode 時に、送信チャンネル名から network-suffix + をはずす。 + + * main/RunLoop.pm (run): bugfix(single-server-mode)/need reboot. + + single-server-mode 時に、クライアントから送られて来るメッセージに + network-suffix を付けるようにした。 + +2003-10-25 phonohawk + + * main/IRCMessage.pm (serialize): + 最後のパラメータが空文字列だった場合、コロンを残さない為に + シリアライズ後のパラメタが減ってしまう問題を解決。 + + * main/IrcIO/Server.pm (_receive_while_logging_in): + サーバーがERRORを返した時、その内容でdieするように。 + +2003-10-24 phonohawk + + * main/Configuration/Block.pm: + $block->foo_bar('block') とした時、戻り値が常にブロックとなる。 + 未定義であれば空のブロックを、既定義かつ値がブロックであれば + そのブロックを、既定義かつ値がブロックでなければキーと値のペアを + 一つだけ含むブロックを生成して返す。 + +2003-10-19 Topia + + * HACKING: + モジュール作成者向けのドキュメントを書いた。 + まだ、Timer / Hook / Socket I/O 関連の記述がない。 + + * module/Skelton.pm: + 新規モジュールのスケルトン。中身のほとんどは main/Module.pm と同一。 + + * module/Auto/Alias.pm (message_arrived): + 返り値がおかしかったのを修正。 + +2003-10-19 phonohawk + + * main/IrcIO/Server.pm + (person_if_exists): + 追加。指定されたnickを持つ人物が居れば、そのPersonalInfoを返す。 + (_RPL_WHOREPLY): + サーバー名とnickの位置を間違えていたので修正。 + +2003-10-16 phonohawk + + * module/System/Raw.pm: + 追加。Tiarraに改変されない生のメッセージをサーバーに送るためのモジュール。 + + * main/RunLoop.pm (update_networks): + confからサーバー名を削除する事でサーバーから切断した時に、 + そのサーバーで入っていた全てのチャンネルに対するPARTを全クライアントへ送る。 + +2003-10-14 Topia + + * main/Multicast.pm (distribute_to_servers): + hijack_forward_to_server を適用(nickで使う) + + * main/RunLoop.pm (_multi_server_mode_changed): + nick 変更を追加。 + + * main/IrcIO/Server.pm (_receive_while_logging_in): + single-server-mode 時の NICK 処理を追加。 + + * main/IrcIO/Server.pm (_receive_after_logged_in): + single-server-mode 時の NICK 処理に RunLoop/set_current_nick を追加。 + 437 での if 条件であほなミスをしていたので修正。 + +2003-10-12 phonohawk + + * main/IRCMessage.pm (serialize): + 最後のパラメータがコロンを含んでいる時に、間違った文字列化をする問題を解決。 + +2003-09-28 phonohawk + + * tiarra-conf.el: + mmm-modeがインストールされていて、(require 'mmm-mode)または + (require 'mmm-auto)されている場合に、tiarra-conf用の設定を + 行った後、それを有効にする。 + + mmm-modeのサイトは次のURLに。 + http://mmm-mode.sourceforge.net/ + + * main/PersonalInfo.pm (remark): + 追加。 + これを保存するためのhashは、必要になった時まで作られない。 + +2003-09-26 Topia + + * tiarra: + --debug 時に warn と die に長いスタックトレースを表示する。 + + * main/ChannelInfo.pm: + topic_who と topic_time を追加。 + エラーメッセージのミスを修正。 + + * main/Multicast.pm: + RPL_TOPICWHOTIME の追加。 + hijack_local_to_global 時のフォールバック条件を訂正。 + + * main/IrcIO/Client.pm: + 431 No nickname given の実装。 + multi-server-mode でないときには nick 関連の特殊処理をしないように。 + RPL_TOPICWHOTIME の実装。 + + * main/IrcIO/Server.pm: + 437 nick/channel is temporarily unavailable に対応。 + multi-server-mode でないときには nick 関連の特殊処理をしないように。 + RPL_TOPICWHOTIME の実装。 + 9文字以上のnickが来たときに、可能な限り必要以上短くしないように。 + +2003-09-25 Topia + + * tiarra: + --version と --debug の実装。 + ::debug_printmsg(...), ::debug_mode を使用できます。 + ::printmsg への autoflash 指定を追加。 + + * main/ModuleManager.pm: + (update_modules): $this->{modules} の再構成を、アンロード前に移動。 + notification_of_message_io の呼び出しでエラーが発生するのを回避。 + (_load): デバッグモード時に UNIVERSAL::isa が嘘を付いた場合、 + 標準出力に出力する。 + (_unload): + no strict の場所を変更。 + シンボルテーブル内に存在する関数のうち、 + 自分自身が定義した訳ではない関数は undef しないようにした。 + デバッグモードなら、 undef したスカラ・配列・シンボルテーブル・関数、 + undef しなかった関数、に付いてそれぞれ標準出力に出力する。 + + * module/Channel/Join/Connect.pm: + コンマの直後にあるスペースは削除するようにした。 + TiarraDoc を追加。 + + * module/Tools/FileCache.pm: + destruct メソッドを実装。 + RCSタグを標準のものにした。 + + * module/Tools/GroupDB.pm: + Module::Use が抜けていたので追加。 + RCSタグを標準のものにした。 + + * sample.conf: + Channel::Join::Connect の ブロックを TiarraDoc から再生成。 + 指定項目の変化はありません。 + +2003-09-24 phonohawk + + * main/Multicast.pm (nick_p): + 「|」を含むnickをnickと認識していなかったので修正。 + + * module/Log/Recent.pm: + configのcommandを小文字で書くとログが取られない問題を解決。 + +2003-09-23 phonohawk + + * main/ModuleManager.pm: + use Module::Useされたサブモジュールが破棄される時に、 + そのパッケージの destruct メソッドを引数無しで呼ぶ。 + + * main/Mask.pm: + メモリを食い過ぎるので、コンパイル済み正規表現の + キャッシュ保存数を150個に減少。 + + * main/PersonalInfo.pm: + メソッドinfoに引数として真偽値を渡した時、 + それが真であればnickとnameとhostの配列を返す。 + wantarrayにすると互換性が失われるため。 + + * main/PersonalInfo.pm: + 動作速度向上のため、AUTOLOADを廃止。 + + * module/Log/Channel.pm: + configのcommandを小文字で書くとログが取られない問題を解決。 + +2003-09-20 phonohawk + + * main/ChannelInfo.pm, main/IRCMessage.pm, + main/PersonInChannel.pm, main/PersonalInfo.pm, + main/Configuration/Block.pm: + これらのクラスはオブジェクトが大量に作られるので、 + メモリの節約のためにインスタンス型を配列に変更。 + + * main/IrcIO.pm: + メソッド remarks を remark のエイリアスに。 + $io->remark(foo => undef); のように明示的にundefを設定すると + その註釈を削除。 + + * IrcIO/Server.pm: + remarkをIrcIO.pmに移動したので、こちらは削除。 + + * main/L10N.pm: + * main/LocalChannelManager.pm: + 未完成であり、まだ使われてもいないが、存在しても害は無い。 + それぞれ多言語メッセージとTiarra内部チャンネルを扱う。 + + * main/Mask.pm: + マスク文字列から変換した正規表現のコンパイル結果をキャッシュとして保存するように。 + 大量のマスクを扱う条件下で動作が非常に重くなる問題を回避する。 + ベンチマークの結果では、62.5%のマッチング速度の向上が見られた。 + +2003-08-18 Topia + + * main/Multicast.pm: + ${server,client}_sent に ENDOFWHO を追加。 + これで LimeChat などのクライアントで、 + アドレスコピーなどの機能が使えない症状が無くなった。 + $client_sent の numeric reply にコメントを補完。 + +2003-08-12 phonohawk + + * main/FunctionalVariable.pm: + 追加。与えられた任意のハンドラを変数にtieする。 + 通常のtieとの違いは、ハンドラを変数毎に関数リファで指定する点。 + + * main/Hook.pm: + フックの一般的な定義。このファイルはクラスHookとクラスHookTargetを定義する。 + + * main/Configuration.pm: + リロードした時、フック`reloaded'を呼ぶ。 + + * main/Multicast.pm: + シングルサーバーモード対応。 + forward_to_serverやlocal_to_globalを動的スコープのフラグで乗っ取る等、 + 最早スパゲティどころではない。ジャングル。 + + * main/RunLoop.pm: + シングルサーバーモード対応。 + このモードでは、同時に接続出来るサーバーの数が一つに限定され、 + チャンネル名等にネットワーク名が付加されなくなる。 + + * main/IrcIO/Client.pm: + _inform_joinning_channelsをプライベートメソッドでなくした。 + 新しいメソッド名はinform_joinning_channels。 + +2003-08-04 phonohawk + + * makedoc: + 追加。このスクリプトはdoc-src下のファイルとmodule下のモジュール、 + main下のモジュールを読み、tdoc形式で書かれたドキュメントを認識し、 + sample.confおよびdoc下のhtmlドキュメントを生成する。 + tdocについてはdoc-src/READMEを参照。 + 尚、各モジュールへのtdocの記述が完了していない為、 + 完全なsample.confは生成出来ない。完了するまではsample.confでなく + sample.conf.tmpに書き出す。 + + * doc-src/README: 追加。tdocについての説明。 + + * doc-src/conf-main.tdoc: 追加。generalやnetworksのドキュメント。 + + * doc-src/contents.html: 追加。htmlドキュメントのテンプレート。 + + * doc-src/module-group.tdoc: 追加。モジュールの分類情報。 + + * doc-src/module-toc.html: 追加。モジュールの目次のhtmlテンプレート。 + + * doc-src/sample.conf.in: 追加。sample.confのテンプレート。 + + * main/Template.pm: 追加。テンプレートを扱うクラス。 + + * main/TiarraDoc.pm: 追加。tdocパーサ。 + + * module/System/PrivTranslator.pm + * module/User/Ignore.pm: tdoc追加。 + +2003-07-31 Topia + + * 全般: + ・インデントの変更 + ・コメントの整備 + ・mask で使うチャンネル名をネットワーク付きに修正(a) + ・不要な use のクリーンアップ(b) + ・不要な変数のクリーンアップ(c) + + * Auto/Oper.pm: + (a) + + * Auto/Random.pm: + (a)(b) + + * Auto/Reply.pm: + (a)(b)(c) + + * Auto/MesMail.pm: + (b)(c) + + * Auto/Alias.pm: + (c) + + * Auto/Response.pm: + (a)(c) + + * Auto/Utils.pm: + get_ch_name -> (get_raw_ch_name): ネットワーク名無しの(server 的に raw な)チャンネル名 or undef を得る。 + (get_full_ch_name): ネットワーク名付きのチャンネル名 or undef を得る。 + (generate_reply_closures): 返り値に $get_full_ch_name を追加。 + 中身としては、$msg->param(place) 以上の意味は無いが、値の指定場所は一ヶ所にした方が良い。 + + * Tools/DateConvert.pm: + use_posix を import/unimport を使って再実装した。 + + * Tools/FileCache/EachFile.pm: + (can_remove): 実装。 + (AUTOLOAD): eval して関数コールするのではなく、その場でメソッドを定義して飛ぶようにした。 + + * Tools/FileCache.pm: + (main_loop): refcount を使ったチェックの代わりに、 can_remove を使ったチェックにした。 + + * Tools/HashDB.pm: + Module::Use を追加。 + + * Tools/HashTools.pm: + (get_array): 見付からなかった場合に () を返していたが、 undef を返すべきなので修正。 + (replace_recursive): こっかの補完処理を修正 + (_format): regexp の修正( %. -> %(.) )。バグでした。 + + * Tools/MailSend/EachServer.pm + ::printmsg -> RunLoop->shared->notify_warn 。 + LinedINETSocket を生成するときに $E_MAIL_EOL を使っていなかった。修正。 + MessageID の作られ方をコメントとして記述。 + + * Tools/MailSend.pm + (b) + + * Mask.pm: + s/exclude/include/ 。無意味な三項演算子を消した。 + + * sample.conf: + mask 関連を修正。 + +2003-07-28 phonohawk + + * main/IrcIO/Server.pm (person_list): + 追加。覚えている全てのPersonalInfoのリストを返す。 + +2003-07-26 phonohawk + + * tiarra: + 起動時に`-Dfoo'や`-Dfoo=bar'を指定すると、confに`@define foo'や + `@define foo bar'が書かれているものと見做す。 + + * module/Configuration/Preprocessor.pm + (initial_define): + @defineの初期設定の為の静的メソッド。 + + (_eval_at): + @ifdef文、@ifndef文を処理可能に。 + +2003-07-24 Topia + + * tiarra, make-password: + require 5.6.0 は古いバージョンだと解釈されないようなので require 5.006 に。 + lib, module を tiarra からの相対パスで解釈するように。 + + * main/Multicast.pm: + 352(WHOREPLY)のチャンネル名にネットワーク名をアタッチするようにした。 + +2003-07-23 phonohawk + + * main/InstantCapsule.pm: + SelfLoader使用中止。SelfLoaderでDESTROYが定義されると + カプセル内にDESTROYを定義出来なくなってしまう。 + + * module/User/Vanish.pm: + コマンド「/VANISHDEBUG 1」でメッセージの改変される様子が見えるように。 + 現在残っている妙な不具合の原因が解り次第削除。 + +2003-07-22 phonohawk + + * module/Channel/Freeze.pm + (freeze): + カンマで区切られた複数のチャンネル名を認識。 + + (defrost): + 凍結していないチャンネルをdefrostするとエラーが起こる問題を解決。 + チャンネル名をマスクとして扱うように変更。 + +2003-07-20 phonohawk + + * main/IrcIO/Server.pm (_PART): + PART受信時、入っているどのチャンネルにも最早その人物が + 居なくなった場合は、その人物についてのPersonalInfoを削除する。 + +2003-07-19 phonohawk + + * main/ChannelInfo.pm (remark): + remarks()のエイリアスとしてremark()を使用可能に。 + + * main/Timer.pm (interval): + 明示的にundefを渡す事で、リピート終了可能に。 + uninstallすれば一緒なので大した意味は無い。 + + * main/IrcIO/Server.pm (_TOPIC): + TOPICメッセージを受信した時、古いトピックを'old-topic'として註釈を付ける。 + +2003-07-17 phonohawk + + * tiarra-conf.el (tiarra-conf-jump-to-block): + ブロック名を入力し、その位置へジャンプするコマンド。 + デフォルトでは C-c C-. 及び C-c . に割当てられている。 + +2003-07-16 phonohawk + + * tiarra-conf.el (tiarra-conf-next-token): + 追加。カレントバッファの現在のカーソル位置の次にあるトークンを返す。 + カーソルはそのトークンの終わりの位置へ移動する。 + + * tiarra-conf.el + (tiarra-conf-next-block), + (tiarra-conf-prev-block): + 追加。それぞれ現在のカーソル位置の次や前にあるブロックへカーソルを飛ばす。 + プリプロセッサ指令があると変な動作をするバグ有り。 + nextは M-n に、prevは M-p に割当てた。 + +2003-07-10 phonohawk + + * module/Channel/Freeze.pm: + 追加。特定のチャンネルのNOTICEやPRIVMSGの中継を + 一時的に中断するためのモジュール。 + 発言を見たくないがPARTはしたくない、といった場合に有効。 + +2003-07-03 phonohawk + + * main/Configuration/Block.pm (get): + $config->foo('random')のような呼出しを可能に。 + 複数の定義があればランダムに一つ選んで返す。 + + * main/IrcIO/Server.pm (new, reload_config, connect): + 切断された後に再接続すると、以前のNICKが引継がれるように。 + + * module/Auto/Oper.pm: + 複数の応答が定義されていれば、ランダムに一つ選んで発言する。省略も可能。 + + * module/Auto/Utils.pm + (sendto_channel_closure, generate_reply_closures): + 作成されたクロージャに、発言内容としてundefを渡した場合、 + 何もせずに処理を終える。 + +2003-06-21 phonohawk + + * tiarra: + ActivePerlで起動時に出ていた警告を出ないように変更。 + SIGHUPのハンドラをインストールする際の警告だった。 + +2003-06-19 phonohawk + + * Multicast.pm (attach,detach) : + チャンネル/nickとネットワーク名の区切り文字として、二文字以上の文字列も使用可能に。 + つまり、今後は区切り文字として「空白を含まない1文字以上の任意の文字列」を使う事が出来ます。 + +2003-06-06 phonohawk + + * PersonInChannel.pm (remark) : + 明示的に二番目の引数にundefを渡すと、その註釈が削除される。 + + * RunLoop.pm (update_networks) : + 同一ホストへの複数の接続には、それぞれ時間差を設ける。 + + * RunLoop.pm (run) : + 既に始動時刻が過ぎているタイマーが存在すると、タイムアウト無期限のselectを行なうバグを修正。 + + * Configuration/Block.pm (eval_code) : + %CODE{...}EDOC%ブロックを、パッケージConfiguration::Implanted内で実行する。 + + * Configuration/Preprocessor.pm (_eval_pre) : + %PRE{...}ERP%ブロックを、パッケージConfiguration::Implanted内で実行する。 + + * IrcIO/Server.pm (reload_config) : + general/nickを、それぞれのネットワーク設定ブロックのnickでオーバーライド可能に。 + +2003-06-04 Topia + + * RunLoop.pm (run) : can_read を先に処理する。少しでも send で切断された状況をなくすため。 + 意味があるのかは不明だが、実害は無いはず。 + + * IrcIO.pm (send) : 接続チェックの対象に $this->{sock}->connected も追加。 + これが接続されてない状態で書き込もうとすると perl 自体がエラー落ちすることがあるらしい。 + +2003-06-04 phonohawk + + * tiarra (ipv6_enabled) : IPv6が有効かどうかを真偽値で返す。 + + * IrcIO.pm: 閉じられたソケットに対して書き込みを行なう可能性のある問題を(多分)解決。 + + * CTCP.pm, ControlPort.pm, Crypt.pm, ExternalSocket.pm, + InstantCapsule.pm, LinedINETSocket.pm: これらは一度も使われない可能性があるため、SelfLoaderを用いて遅延ロード。 + + * ChannelInfo.pm, PersonalInfo.pm: DESTROY時にエラーが起こる問題を解決。 + +2003-05-27 phonohawk + + * RunLoop.pm: + (notify_warn): 追加。全クライアントとコンソールに警告文を出力する。 + (run): 経過時間ゼロ秒のselectを連続で100回以上検出すると、10秒ごとに、CPU時間を食い潰している可能性を警告する。 + + * ControlPort.pm: + ソケットの作成に失敗した時に出たエラーが表示されなかったのを修正。 + + * ExternalSocket.pm: + WantToWriteが返した真偽値によらず、常に「書き込みが必要」として処理していた問題を解決。 + +2003-05-26 phonohawk + + * Timer.pm (new): + AtとAfter(又はInterval)が、両方とも指定されていなければcroakする。 + + * Configuration/Preprocessor.pm: + elseifやelseの解釈が正しくなかったのを修正。 + %PREの評価結果がundefになった時に警告が出ていたのを修正。 + @if文や@elsif文の評価結果がエラーになった時、そのエラー内容を表示していなかったので修正。 + +2003-05-24 phonohawk + + * IO/Socket/INET6.pm: 追加。 + IO::Socket::INETをIPv6に移植。Socket6.pmが必要。 + + * RunLoop.pm, IrcIO/Server.pm: IPv6対応。 + general/tiarra-ip-versionに'v6'を指定する事で、IPv6でのリスニングを行なう。 + また、サーバーには最初にIPv6での接続を試みてからIPv4にフォールバックする。 + 詳細はsample.confに。 + +2003-05-23 Topia + + * sample.conf: Auto::Random の説明中の 確立 を 確率 に修正した。 + + * Auto/Reply.pm: 追加。 + + * Auto/Alias.pm (message_arrived/remove): #(count) を使用可能にした。 + value が省略された場合はキーごと削除するようにした。 + + * Tools/HashDB.pm: 追加。 + + * Tools/HashTools.pm: Tools/GroupDB.pm, Tools/HashDB.pm の共通部分を取り出したモジュール。 + + * Tools/GroupDB.pm: キー名にコロンを使用可能にした。使用不能な半角スペースが来た場合は拒否する。 + コメントを修正し、詳細にした。 + 無視する行を指定するクロージャを引数に取れるようになった。省略された場合は # で始まる行を無視する。(従来) + del_value は削除出来た値の数を返すようになった。また、 value が未指定ならキーごと削除する。 + +2003-05-21 phonohawk + + * tiarra-conf.l: 追加。 + Noboruhiさんによるxyzzy用tiarra.conf編集モード。 + インストール方法はtiarra-conf.l内に記述されています。 + +2003-05-17 Topia + + * Auto/Utils.pm: sendto_channel_closure 関数追加。 + NOTICE/PRIVMSG の処理は面倒なので、これを自動的に処理する。 + sendto_channel_closure, generate_reply_closures に使用方法のコメントを追加。 + +2003-05-15 phonohawk + + * conf: + general/control-socket-nameを定義すると、外部プログラムからtiarraをコントロールする為の + UNIXドメインソケットを作成する。詳しくはsample.confに。 + + * ControlPort.pm: 追加。外部コントロール用。 + + * IRCMessage.pm: dieメッセージのtypoを修正。 + + * IrcIO.pm,LinedINETSocket.pm: sendの代わりにsyswriteを使う。 + + * Module.pm: メソッドcontrol_requested追加 + + * ModuleManager.pm: メソッドget追加 + + * RunLoop.pm: ControlPortを起動する為のコードを追加。 + + * Log/Channel.pm: "ID: synchronize"で外部からのログの同期を可能に。 + +2003-04-29 phonohawk + + * IrcIO/Server.pm: ログイン時、サーバーから送られてきたニューメリックリプライ以外のメッセージを無視する。 + ログイン前にNOTICEを送るようなサーバーに繋げられない問題を解決。 + + * RunLoop.pm: IrcIO->pop_queueがdieした時のメッセージを表示せずに捨てていたのを修正。 + + * Channel/Join/Kicked.pm: 追加。チャンネルから蹴られた時に、自動JOINするモジュール。 + + * IrcIO/Server.pm: 自分がチャンネルから蹴られた場合、そのチャンネル情報を消さずに + ChannelInfoに'kicked-out' => 1というremarkを付ける。 + + * RunLoop.pm: サーバーへの再接続時、+kされたチャンネルへの再JOINに失敗していたのを修正。 + +2003-04-25 phonohawk + + * main/Configuration.pm: general/client-allowedが省略された場合、 + 間違った値をデフォルト値として設定していたので修正。 + + * main/Configuration.pm: channel-network-separatorが未定義だった場合に + 正しくデフォルト値を設定しないミスがあったので修正。 + + * Configuration.pm: networksのnameで列挙されたネットワーク名に対応する + ブロックの定義が無かった場合、適切なエラーメッセージを出さずに処理を止めていたので修正。 + +2003-04-18 phonohawk + + * tiarra: SIGHUPを受信した時の動作を変更。 + これまではシャットダウンしていたが、以後は設定をリロードする。 + + * ChannelInfo.pm (fullname): 追加 + + * RunLoop.pm: 各ネットワークの設定を変更した後リロードすると、 + そのネットワークとの接続を一旦切ってから繋ぎ直す。 + + * IrcIO/Server.pm (config): 追加。 + コンストラクタの引数をネットワーク名のみに変更。 + + * IrcIO.pm (server_p,client_p): 追加。 + それぞれIrcIO::Serverであれば1を返すメソッドと + IrcIO::Clientであれば1を返すメソッド。 + +2003-04-13 phonohawk + + * User/Vanish.pm: 追加 + 特定のチャンネルでの特定の人物の存在をクライアントに隠すモジュール。 + JOINやPART、QUIT等を消去する。 + + * IrcIO/Server.pm (channels_list): 追加 + + * RunLoop.pm (networks_list,channel): 追加 + + * ChannelInfo.pm (AUTOLOAD): ハッシュマップの操作コマンドとして'keys'と'values'を追加。 + +2003-04-10 phonohawk + + * RunLoop.pm: 切断に気付かない場合があるので、3分毎に各サーバーにPINGを発行する。 + PING自動発行後にサーバーから来た最初のPONGは破棄される。 + + * IrcIO/Server.pm: メソッドremark追加。使い方は他のクラスのremarkと同じ。 + + * LinedINETSocket.pm: メソッドconnectの動作をconnectとattachの二つに分けた。 + これにより予め開かれたIO::Socket::INETに対してLinedINETSocketの機能を適用可能。 + +2003-04-05 phonohawk + + * Auto/Joined.pm: 追加。 + 特定のチャンネルに誰かがJOINする度に特定の発言を行なうモジュール。 + チャンネル移転通知以外に使うのはやめた方が良い。 + +2003-03-28 Topia + + * sample.conf (Auto/Random.pm): mention mask property. + + * Auto/Random.pm: use array_or_all on mask. + + * Auto/Alias.pm: use array_or_all on modifier. + + * Mask.pm: add array_or_(all|all_chan), (all|all_chan)_mask. + for not known maskmode, use Tiarra mode; and do warn. + +2003-03-23 phonohawk + + * IrcIO/Server.pm: general/bind-addrでサーバーへの接続時のローカルアドレスを指定可能に。 + また、各ネットワーク設定でbind-addrはオーバーライドできる。 + +2003-03-23 Topia + + * tiarra: ソースの判別部分自体が展開されていた…ので修正。 + + * ChangeLog: Id/Author/Date/RevisionのRCSタグを末尾に追加した。 + + * tiarra: ChangeLogからDateとRevisionを読んでバージョン情報に付加するようにした。 + +2003-03-23 phonohawk + + * User/Filter.pm: 追加。特定のユーザーの発言にフィルタをかけるモジュール。 + +2003-03-23 Topia + + * CTCP/Version.pm: add perl version infomation. + + * CTCP/ClientInfo.pm: separate ' ' instead of '/'. (ref. TAGGED DATA) + + * CTCP/{ClientInfo|Ping|Time|UserInfo|Version}.pm>: reply to channel CTCP. + + * CTCP.pm: fix wrong-quote dequoting. + + * sample.conf (Channel/Join/Invite.pm): add Channel/Join/Invite.pm sample configuration. + + * NEWS: add. news for non-developer. please write major changes, and so on. + if developer, see ChangeLog and check NEWS, please :-) + + * Channel/Join/Invite.pm: add. + + * Auto/Utils.pm (get_ch_name): add. + (generate_reply_closures): + add param ch_place(6th). default:0. + place of channel name in msg->params. + $get_ch_name closure return static string. + + * Auto/Response.pm: use register_extcallbacks. + generate_reply_closures's 3rd param(use_alias) to undef.(use default) + + * Auto/AliasDB/CallbackUtils.pm: add register_extcallbacks. + (for regist insecure callbacks) + +2003-03-19 Topia + + * sample.conf: change sample configuration. + + * Auto/Random.pm: can use multiple random datas. + +2003-03-17 Topia + + * Tools/MailSend/EachServer.pm (clean): fix cleaning code. + (DESTROY): unnesessary; remove. + + * sample.conf: mention Auto::Random/(mask|count-query|count-format), and format change. + mention Auto::Response's DB format. + + * sample.conf (Auto/Alias.pm): s/#(message)/#(value)/ at sample config. sorry. + + * Tools/FileCache.pm, Tools/FileCache/EachFile.pm: add. Tools::LinedDB based cached file i/o. + + * Tools/LinedDB.pm: add. line based i/o framework. + + * Tools/GroupDB.pm (add_group): add $this->synchronize. + + * Log/DateTime.pm: this module is obsolete. remove. + + * Log/Channel.pm, Log/Recent.pm: use Tools::DateConvert instead Log::DateTime. + + * Auto/Response.pm: add callback: read_file/file_lines. + add mask check in database 'mask' entry. + + * Auto/Random.pm: use Tools::FileCache. + add count query. + + * Auto/AliasDB/CallbackUtils.pm: add #(read_file:fpath:mode:charset). + add #(file_lines:fpath:mode:charset). + (register_callback): $reg_callback accept scalar function name. + +2003-03-15 phonohawk + + * BulletinBoard.pm: + ・AUTOLOAD経由で値を設定可能に。 + ・メソッドkeys()を追加。 + + * CTCP.pm: 追加。CTCPエンコード/デコードを行なうモジュール。 + + * IrcIO.pm: メソッドremark()追加。 + + * CTCP/ClientInfo.pm, + CTCP/Ping.pm, + CTCP/Time.pm, + CTCP/UserInfo.pm, + CTCP/Version.pm : 追加。 + +2003-03-10 phonohawk + + * IrcIO/Server.pm: ネットワーク毎の設定でin-encoding,out-encodingを定義する事により + 文字エンコーディングの設定をオーバーライド可能に。 + +2003-03-09 Topia + + * Auto/Response.pm: plum でのキー名が response だったのを勘違いして reply にしていた。 + (りんりんさんバグレポートありがとうございます) + +2003-03-09 phonohawk + + * Configuration/Block.pm: %CODE{ }EDOC%の解釈でメモリリークを起こす不具合を回避。 + +2003-03-09 Topia + + * Auto/AliasDB/CallbackUtils.pm: register_RandomNickConvertでメッセージがIrcIO::Client + 発信だった場合に登録しないようにした。 (りんりんさんバグレポートありがとうございます) + +2003-03-08 phonohawk + + * IrcIO/Server.pm: オプションnetworks/always-notify-new-nickが設定されていたら + nickを変更する度に、変更したサーバーの新しいグローバルnickをNOTICEで通知する。 + + * IrcIO/Client.pm: ログイン時に本名として渡された$key=value;key=value...$のオプションを + パースする部分を書き直し。$ key =value ;key = value$のような設定でも + 期待された通りに解釈する。 + また、メソッドoption追加。このようにして渡されたオプションを取得する。 + + * tiarra, Configuration.pm, Configuration/Preprocessor.pm: + 起動時にオプション--configを省略された場合の動作を変更。 + ターミナル上から起動した場合は従来のようにデフォルトのファイル名であるtiarra.confを読むが、 + 標準入力がターミナルに接続されていなかった場合、つまりパイプ経由でリダイレクトされている場合は + tiarra.confでなく標準入力から設定を読む。この場合は設定のリロードは不可能となる。 + 例: cat tiarra.conf | sed -e 's/Tiarra/arraiT/g' | ./tiarra --quiet + + * Configuration/Block.pm: + %CODE{ ... }EDOC%で挟まれた部分を、値の取得時に毎回評価する。 + +2003-03-04 Topia + + * Tools/MailSend/EachServer.pm: RunLoop::Hookを使用するように変更。 + ループをなるべく回すように変更。flushはclose時とDATA時に行うことにした。 + フェイルセーフの為に5sec間隔のTimerも使うことにする。 + + * Tools/GroupDB.pm: fpathで指定されたファイルが存在しないときにエラーとなるのを修正。 + + * Auto/Alias.pm: 配列の参照を渡すべきところを配列を渡してしまっていた。修正。 + + * LinedINETSocket.pm: ExternalSocketのuninstall等も必要かも知れないので + DESTROYを復活させる。 + +2003-03-04 phonohawk + + * ExternalSocket.pm: read/write/want_to_writeで、callerをチェックする位置を変更。 + + * Configuration/Block.pm: 文字コードの再解釈に失敗する不具合を解決。 + + * RunLoop.pm: クラスRunLoop::Hook追加。 + RunLoopのループが一回実行される度に呼ばれるフック。 + 呼ばれるタイミングとしてはselect実行直前または直後。どちらかを選択可能。 + 詳しくはRunLoop::Hookの先頭のコメントを参照の事。 + +2003-03-04 Topia + + * Auto/MesMail.pm: Tools/MailSend.pmを使うように修正。 + + * Tools/MailSend/EachServer.pm: 新規追加。SMTPサーバ毎に具体的なメール送信を行う。 + POP before SMTPの場合はexpireまで待って、そうでない場合はすぐにオブジェクトを破棄する。 + + * Tools/MailSend.pm: 新規追加。メール送信を行う。 + 複数のサーバと同時に通信するためにTools/MailSend/EachServer.pmを管理している。 + + * Auto/Response.pm: rateを使えるようにした。 + +2003-03-03 phonohawk + + * Configuration/Block.pm: ブロック内ブロックを扱えるように。 + + * Configuration/LexicalAnalyzer.pm: 新規追加。confの字句解析器。 + + * Configuration/Parser.pm: 新規追加。confの構文解析器。 + + * Configuration.pm: パーサを書き直し。上記二つのクラス、及びプリプロセッサを使用。 + +2003-03-02 Topia + + * Auto/Response.pm: 新規追加。plumのauto/response.plmの動作をする。 + + * Auto/AliasDB/CallbackUtils.pm: 存在してはいけないuninstallがあったので削除。 + + * Auto/Utils.pm: コールバックを追加できる引数の追加。 + + * Tools/GroupDB.pm: regexpを利用できるようにする引数の追加。 + find_groups/find_groups_with_primaryの追加。 + + * Channel/Mode/Oper/Grant.pm: Auto/Oper.pmとmask処理を統一した。 + + * sample.conf: maskの説明が変わってしまうので書き換えた。 + + * sample.conf: '-*- tiarra-conf -*-' を一行目に追加した。Auto/MesMailのエントリ追加。 + + * Auto/MesMail.pm: 新規追加。伝言をメールとして送信する。メール送信部分は分けられてTools下に + 行く可能性もある。 + + * Auto/Utils.pm: AliasDBの変更に同期。'(nick|user|host).now'はAliasDB内部に移動している。 + + * Auto/Oper.pm: AliasDBの変更に同期。Mask::match_deep_chanを使用するように。 + + * Auto/Alias.pm: AliasDBはオートフラッシュなのでデストラクタを消した。 + + * Auto/AliasDB/CallbackUtils.pm: RandomAliasConvert, JoinedListConvertを追加。 + MessageReplaceにmessage_replace_lastを追加。 + + * Auto/AliasDB.pm: GroupDBを使用するように変更。関数名を一部変更した。 + confでprivateとreadonlyなキーの指定が出来る。readonlyはまだ対応モジュールが存在しない。 + + * Tools/GroupDB.pm: 新規追加。AliasDBから独立させた。 + +2003-03-02 phonohawk + + * Configuration/Preprocessor.pm: 新規追加。 + confファイルのプリプロセッサとして使用する。 + +2003-03-01 phonohawk + + * ConfigBlock.pm: 削除。Configuration::Blockに移動。 + + * InstantCapsule.pm: 新規追加。 + フィールドとメソッドを持つオブジェクトを一時的に生成するクラス。 + サンプルコードはInstantCapsule.pm内にあります。 + +2003-02-27 Topia + + * Mask.pm: チャンネルとユーザのマスクをconfで切替え可能にした。 + sample.confにも説明を追加している。 + + * Mask.pm: mask_chanで[+-]を使用可能にした。+channelは++channelまたは + -+channelと表記する必要がある。 + _split_with_chanのsplit処理を_splitに委託した。 + + * Mask.pm: channelを含めたmaskを処理する関数を追加した。 + mask_chan, mask_deep_chanはstrの次にchanが追加されているだけで仕様は同じ。 + mask_array_chanはstr_masks, chan_masks, str, chanと言う引数になっている。 + 次にcommitされる予定のAuto::Oper辺りがサンプルコードになるはず。 + +2003-02-26 Topia + + * Multicast.pm: channel_pを追加した。 + nick_pに文字数チェック(length != 0)とdetachの処理を追加した。 + + * LinedINETSocket.pm: デストラクタを実行するより前にsocketが開放されているようだ。 + デストラクタをコメントアウトした。 + + * LinedINETSocket.pm: 新規追加。行単位のキューを使用した入出力を行う。 + +2003-02-26 phonohawk + + * ExternalSocket.pm: 新規追加。 + + * RunLoop.pm: RunLoopが任意のソケットを監視出来るように。 + ソケットの監視にはExternalSocketを用いる。使い方はExternalSocket.pmにある。 + + * Timer.pm: uninstallした時はrunloopにundefを代入する。 + +2003-02-20 phonohawk + + * Module.pm (notification_of_message_io) : 新規追加。 + サーバーやクライアントと実際に送受信したメッセージが通知されるメソッド。デバッグ用。 + + * IrcIO/(Client/Server).pm : notification_of_message_ioを呼ぶための修正。 + + * IrcIO/Client.pm : 複数のクライアントを接続している際、 + NICKの変更が他のクライアントへ伝わっていなかったので修正。 + +2003-02-19 phonohawk + + * tiarra-conf.el: 新規追加。confファイルのEmacs用モード。試作品。 + このファイルが置かれている場所をload-pathに追加し、次のようなautoloadを実行すれば良い。 + (autoload 'tiarra-conf-mode "tiarra-conf" "tiarra.conf editing mode" t) + +2003-02-17 phonohawk + + * Configuration.pm: + ・@includeで他のファイルをインクルード可能に。 + 但し一つのファイルを複数回@includeする事は出来ない。 + ・ブロックの{}の位置をある程度自由に。 + ・ブロックの中身が空で良ければ{}を省略可能に。 + sample.confに詳しい説明があります。 + + * IrcIO/Client.pm: $key=value;key=value;...$形式の本名でログインすると、 + 特定のクライアントの間においてのみconfで設定された項目をオーバーライドする。 + 現在有効なキーはencodingで、これはクライアントとの通信に用いる文字コードである。 + 例: + $encoding=euc$ この本名でログインした場合、EUC-JPで通信を行なう。 + +2003-02-17 Topia + + * System/RemoteControl.pm: 複数行のmaskを使えるようにした。 + + * Mask.pm: コメント中の例が間違っていたので修正。 + + * Mask.pm: 正規表現マッチと+-機能のオン/オフを可能にした。 + comma-separeted mask arrayを渡せる関数を追加した。 + 単純にmask arrayを渡せる関数を追加した。 + wild cardを正規表現にするmake_regexを別関数として独立させた。 + + * Auto/Utils.pm: $get_ch_nameでparam(0)が無い場合undefを返すようにした。 + +2003-02-15 phonohawk + + * RunLoop.pm: Time::HiResがインストールされている環境では + Timerの精度がミリ秒に上がる。入っていなければ秒のまま。 + + * PersonInChannel.pm: メソッドremark,delete-remark追加。 + 註釈を付ける事が出来る。 + + * Multicast.pm: attach/detachでエラーチェックを行なう。 + +2003-02-13 Topia + + * Auto/AliasDB/CallbackUtils.pm: MessageReplace callback を追加しました。 + #(message_replace:[split_regexp]:[place]) です。placeはzero originとなっています。 + ex. test alias -> #(message_replace: :1) -> alias + また、この変更でregister_stdcallbacksの引数が$ch_name -> $msgとなり、 + その変更をAuto/AliasDB.pm, Auto/Utils.pmに反映させています。 + + * Auto/Answer.pm: 返答に$reply_anywhereを使うようにした。 + + * Auto/Random.pm: オートリロードと追加/削除の返答を追加しています。 + + * Auto/Alias.pm: Auto/AliasDB.pmに追加と削除を移しています。 + 追加/削除出来た場合に返答できるようにしました。 + + * Auto/Utils.pm: 返り値に、$reply_anywhere + (場合によってチャンネルに返したりprivで返したりする)を追加しました。 + $reply_as_privがextra_replacesを付けられるようにしました。 + reply_with_stdcallbacksを使用するようにしました。 + reply_with_stdcallbacksはrandomやdate、randomnick、randomselectなどのcallbackを + 登録します。 + user.now, host.now などのエイリアスを追加するようにしました。 + + * Auto/AliasDB.pm: Auto/Alias.pmから追加と削除機能を移しました。 + オートリロードするようにしました。 + 渡されたエイリアスからキーを見つけ出せなかった場合、callbackを呼ぶようにしました。 + #(name;%s さん) などの表記をサポートしました。 + サブフォーマット中に対応する括弧を含めます。 + #(namesuf;#(name)%s)のような表記ができます。 + + * Auto/AliasDB/CallbackUtils.pm: AliasDBのCallback機能を使った標準的な拡張です。 + + * Tools/DateConvert.pm: 新規追加。plumの&'dateに相当。 + + * System/Pong.pm: xchat対策に、pingの代わりにpongを消滅させるようにした。 + +2003-02-13 phonohawk + + * Multicast.pm: nick_pでのnicklen制限をやめた。 + +2003-02-12 phonohawk + + * RunLoop.pm: $(network)/userでgeneral/userをオーバーライド可能に。 + + * System/RemoteControl.pm: 新規追加 + + * これ以前のログは書いていません。 + +# Id: $Id: ChangeLog,v 1.158 2004/08/22 11:28:41 topia Exp $ +# Author: $Author: topia $ +# Date: $Date: 2004/08/22 11:28:41 $ +# Revision: $Revision: 1.158 $ diff -urN /non-existant-dir/ChangeLog.svn tiarra-20050322/ChangeLog.svn --- /non-existant-dir/ChangeLog.svn 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/ChangeLog.svn 2005-03-23 09:19:10.000000000 +0900 @@ -0,0 +1,5645 @@ +------------------------------------------------------------------------ +r850 | topia | 2005-03-22 01:56:03 +0900 (Tue, 22 Mar 2005) | 1 line +Changed paths: + M /trunk/all.conf + M /trunk/doc/module/Client.html + M /trunk/doc/module/Log.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen. +------------------------------------------------------------------------ +r849 | topia | 2005-03-22 01:54:09 +0900 (Tue, 22 Mar 2005) | 2 lines +Changed paths: + M /trunk/module/Client/PatchworkMessage.pm + +* mark as obsolete. + +------------------------------------------------------------------------ +r848 | topia | 2005-03-22 01:50:41 +0900 (Tue, 22 Mar 2005) | 2 lines +Changed paths: + A /trunk/module/Client/Conservative.pm + +* add. + +------------------------------------------------------------------------ +r847 | topia | 2005-03-21 19:38:56 +0900 (Mon, 21 Mar 2005) | 2 lines +Changed paths: + M /trunk/main/Module.pm + +* get rid of RunLoop use for flymake on-the-fly syntax checking. + +------------------------------------------------------------------------ +r846 | topia | 2005-03-20 21:12:30 +0900 (Sun, 20 Mar 2005) | 4 lines +Changed paths: + M /trunk/doc-src/conf-main.tdoc + +* cosmetic tweaks. + +* we really want commented out networks/default. + +------------------------------------------------------------------------ +r845 | topia | 2005-03-20 18:19:41 +0900 (Sun, 20 Mar 2005) | 3 lines +Changed paths: + M /trunk/main/Tiarra/SharedMixin.pm + +* small cleanup. + +* use ->can for fetch closure. +------------------------------------------------------------------------ +r844 | topia | 2005-03-20 18:19:15 +0900 (Sun, 20 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* fix mis-spell. +------------------------------------------------------------------------ +r842 | topia | 2005-03-15 23:01:50 +0900 (Tue, 15 Mar 2005) | 2 lines +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode/CP932JIS.pm + +* fix infinite loop. + +------------------------------------------------------------------------ +r841 | topia | 2005-03-12 22:32:45 +0900 (Sat, 12 Mar 2005) | 3 lines +Changed paths: + M /trunk/main/Tiarra/IRC/Message.pm + +* more explain about 'we want clone raw_params on Tiarra::IRC::Message->clone'. + +* fix ->purge_raw_params. +------------------------------------------------------------------------ +r840 | topia | 2005-03-12 21:40:04 +0900 (Sat, 12 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode/CP932JIS.pm + +* re-fix escape sequence of encode to jis. +------------------------------------------------------------------------ +r839 | topia | 2005-03-12 21:33:58 +0900 (Sat, 12 Mar 2005) | 7 lines +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode/CP932JIS.pm + +* fix bug on encode halfwidth katakana. + +* fix package name. + +* add DEBUG(). + +* cosmetic fixes. +------------------------------------------------------------------------ +r838 | topia | 2005-03-12 18:29:24 +0900 (Sat, 12 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/IRC/Message.pm + +* we want clone raw_params on Tiarra::IRC::Message->clone. +------------------------------------------------------------------------ +r837 | topia | 2005-03-12 18:24:24 +0900 (Sat, 12 Mar 2005) | 3 lines +Changed paths: + M /trunk/module/Log/Raw.pm + +* disable debugging feature. + +* fix bug of raw encoding check order. +------------------------------------------------------------------------ +r836 | topia | 2005-03-12 18:10:48 +0900 (Sat, 12 Mar 2005) | 1 line +Changed paths: + M /trunk/module/Log/Raw.pm + +* add temporary feature to debug. +------------------------------------------------------------------------ +r835 | topia | 2005-03-09 21:24:03 +0900 (Wed, 09 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode/CP932JIS.pm + +* use CP932 for decode ascii. +------------------------------------------------------------------------ +r834 | topia | 2005-03-08 11:20:53 +0900 (Tue, 08 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/IRC/Message.pm + +* use Tiarra::Encoding->from_to. +------------------------------------------------------------------------ +r833 | topia | 2005-03-08 11:19:59 +0900 (Tue, 08 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding.pm + +* add ->from_to. +------------------------------------------------------------------------ +r832 | topia | 2005-03-08 11:19:34 +0900 (Tue, 08 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode.pm + +* remove binary. +------------------------------------------------------------------------ +r831 | topia | 2005-03-08 09:55:20 +0900 (Tue, 08 Mar 2005) | 1 line +Changed paths: + M /trunk/module/Log/Raw.pm + +* fix use charset bug. +------------------------------------------------------------------------ +r830 | topia | 2005-03-08 09:28:45 +0900 (Tue, 08 Mar 2005) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* add ->{in,out}_encoding. +------------------------------------------------------------------------ +r829 | topia | 2005-03-08 09:23:12 +0900 (Tue, 08 Mar 2005) | 3 lines +Changed paths: + M /trunk/module/Log/Raw.pm + +* use $io->out_encoding. + +* add config->charset. +------------------------------------------------------------------------ +r828 | topia | 2005-03-08 09:05:02 +0900 (Tue, 08 Mar 2005) | 1 line +Changed paths: + M /trunk/module/Log/Raw.pm + +* add server_name to log format. +------------------------------------------------------------------------ +r826 | topia | 2005-03-08 07:32:39 +0900 (Tue, 08 Mar 2005) | 2 lines +Changed paths: + M /trunk/module/Client/Cotton.pm + +* fix Tiarra::Utils old-style using. + +------------------------------------------------------------------------ +r825 | topia | 2005-03-08 07:22:59 +0900 (Tue, 08 Mar 2005) | 2 lines +Changed paths: + M /trunk/main/Tiarra/TerminateManager.pm + +* remove Tiarra::Utils require. + +------------------------------------------------------------------------ +r824 | topia | 2005-03-08 07:20:55 +0900 (Tue, 08 Mar 2005) | 2 lines +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* (utils): fix from old commit. + +------------------------------------------------------------------------ +r823 | topia | 2005-03-08 03:06:12 +0900 (Tue, 08 Mar 2005) | 1 line +Changed paths: + M /trunk/all.conf + M /trunk/doc/module/Log.html + M /trunk/doc/module-toc.html + +* regen docs. +------------------------------------------------------------------------ +r822 | topia | 2005-03-08 03:05:42 +0900 (Tue, 08 Mar 2005) | 2 lines +Changed paths: + M /trunk/module/Debug/RawLog.pm + +* fix wrong encoding(iso-2022-jp to euc-jp). + +------------------------------------------------------------------------ +r821 | topia | 2005-03-08 02:58:37 +0900 (Tue, 08 Mar 2005) | 5 lines +Changed paths: + A /trunk/run (from /trunk/run-subr:817) + A /trunk/run-main (from /trunk/run:817) + A /trunk/run-subr + +* add LAZY_EXECUTE feature. + +* rename run-subr to run, run to run-main. + +* make run-subr symlink to run for compatible issue. +------------------------------------------------------------------------ +r817 | topia | 2005-03-08 02:09:18 +0900 (Tue, 08 Mar 2005) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Utils/CallWrapper.pm + M /trunk/main/Tiarra/Utils/Core.pm + M /trunk/main/Tiarra/Utils.pm + +* add pod. + +* cosmetic tweaks. +------------------------------------------------------------------------ +r816 | topia | 2005-03-08 02:07:18 +0900 (Tue, 08 Mar 2005) | 1 line +Changed paths: + A /trunk/module/Log/Raw.pm + +* add. +------------------------------------------------------------------------ +r815 | topia | 2005-03-07 17:30:45 +0900 (Mon, 07 Mar 2005) | 6 lines +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* add pod. + +* use List::Util::first. + +* compact use lines. + +------------------------------------------------------------------------ +r814 | topia | 2005-03-07 12:29:36 +0900 (Mon, 07 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/SharedMixin.pm + +* initialize subroutine rewrite with re-require safe way. +------------------------------------------------------------------------ +r813 | topia | 2005-03-07 11:40:33 +0900 (Mon, 07 Mar 2005) | 5 lines +Changed paths: + M /trunk/main/Tiarra/IRC/Message.pm + +* add ->_n_raw_params, ->have_raw_params. + +* cosmetic tweaks. + +* (encoding_params): fix already purged error condition. +------------------------------------------------------------------------ +r812 | topia | 2005-03-07 04:00:42 +0900 (Mon, 07 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode.pm + +* add 'binary' charset. +------------------------------------------------------------------------ +r811 | topia | 2005-03-07 03:59:11 +0900 (Mon, 07 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* permit '0' for nick_p. +------------------------------------------------------------------------ +r810 | topia | 2005-03-07 03:58:14 +0900 (Mon, 07 Mar 2005) | 4 lines +Changed paths: + M /trunk/main/RunLoop.pm + +* (apply_filters): better error handling. + +* ($RunLoop::Hook::HOOK_TARGET_DEFAULT): + - call tie on un-initialized only (re-entrant safe). +------------------------------------------------------------------------ +r809 | topia | 2005-03-05 05:28:20 +0900 (Sat, 05 Mar 2005) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode/CP932JIS.pm + +* maybe support JIS X 0212-1990. + +* add 2212 -> ff0d. +------------------------------------------------------------------------ +r808 | topia | 2005-03-02 08:59:13 +0900 (Wed, 02 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode/CP932JIS.pm + +* add fullwidth reverse soldius conversion. +------------------------------------------------------------------------ +r807 | topia | 2005-03-02 07:18:41 +0900 (Wed, 02 Mar 2005) | 1 line +Changed paths: + A /trunk/main/Tiarra/Encoding/Encode/CP932JIS.pm (from /trunk/main/Tiarra/Encoding/Encode/IRCJIS.pm:806) + D /trunk/main/Tiarra/Encoding/Encode/IRCJIS.pm + M /trunk/main/Tiarra/Encoding/Encode.pm + +* irc-jis renamed to cp932-jis. +------------------------------------------------------------------------ +r806 | topia | 2005-03-02 00:43:01 +0900 (Wed, 02 Mar 2005) | 3 lines +Changed paths: + A /trunk/main/Tiarra/Encoding/Encode + A /trunk/main/Tiarra/Encoding/Encode/IRCJIS.pm + M /trunk/main/Tiarra/Encoding/Encode.pm + +* add Tiarra::Encoding::Encode::IRCJIS. + +* use Tiarra::Encoding::Encode::IRCJIS (as optional). +------------------------------------------------------------------------ +r805 | topia | 2005-03-01 09:58:18 +0900 (Tue, 01 Mar 2005) | 2 lines +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode.pm + +* do force-stringify to avoid bug old encode. + +------------------------------------------------------------------------ +r804 | topia | 2005-03-01 09:31:10 +0900 (Tue, 01 Mar 2005) | 2 lines +Changed paths: + M /trunk/module/System/Pong.pm + +* whitespace fixes. + +------------------------------------------------------------------------ +r803 | topia | 2005-03-01 07:41:29 +0900 (Tue, 01 Mar 2005) | 11 lines +Changed paths: + M /trunk/main/Configuration/Block.pm + M /trunk/main/ControlPort.pm + M /trunk/main/Tiarra/IRC/Message.pm + M /trunk/main/TiarraDoc.pm + M /trunk/makedoc + M /trunk/module/Log/Channel.pm + M /trunk/module/Log/ChannelList.pm + M /trunk/module/System/NotifyIcon/Win32.pm + M /trunk/module/Tools/GroupDB.pm + M /trunk/module/Tools/HashDB.pm + M /trunk/module/Tools/LinedDB.pm + M /trunk/module/Tools/MailSend/EachServer.pm + M /trunk/tiarra + +* change Unicode::Japanese to Tiarra::Encoding. + +* tiarra (get_env): add enum to Bundle Modules, and show encoding default driver. + +* main/Tiarra/IRC/Message.pm: + - (serialize): unijp hack is moved to Tiarra::Encoding::UniJP. + - (encoding_params): auto-guess encoding is moved to Tiarra::Encoding. + +* module/Tools/MailSend/EachServer.pm: + - (add_encoded_word): use Tiarra::Encoding's mime encoding. + - drop MIME::Base64 require and perl_(en|de)code_base64 function. +------------------------------------------------------------------------ +r802 | topia | 2005-03-01 05:05:06 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode.pm + +* fix conv params bug. +------------------------------------------------------------------------ +r801 | topia | 2005-03-01 05:01:19 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/module/Auto/AliasDB.pm + M /trunk/module/Auto/Random.pm + +* kill unnecessary unijp require. +------------------------------------------------------------------------ +r800 | topia | 2005-03-01 04:59:18 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode.pm + +* fix typo on last commit. +------------------------------------------------------------------------ +r799 | topia | 2005-03-01 04:52:47 +0900 (Tue, 01 Mar 2005) | 5 lines +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode.pm + +* set MIME::Base64's eol to null string. + +* use Tiarra::OptionalModules to check MIME::Base64. + +* cosmetic changes. +------------------------------------------------------------------------ +r798 | topia | 2005-03-01 04:48:36 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/OptionalModules.pm + +* add MIME::Base64. +------------------------------------------------------------------------ +r797 | topia | 2005-03-01 04:32:47 +0900 (Tue, 01 Mar 2005) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Encoding/UniJP.pm + +* use _init. + +* mark h2z* and z2h* to force return $this. +------------------------------------------------------------------------ +r796 | topia | 2005-03-01 04:31:56 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode.pm + +* check $enc defined. +------------------------------------------------------------------------ +r795 | topia | 2005-03-01 04:31:09 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding.pm + +* call ->_init when we can. +------------------------------------------------------------------------ +r794 | topia | 2005-03-01 04:07:41 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Configuration/Parser.pm + M /trunk/main/Configuration.pm + M /trunk/main/RunLoop.pm + M /trunk/main/Template.pm + +* kill unnecessary unijp require. +------------------------------------------------------------------------ +r793 | topia | 2005-03-01 04:06:01 +0900 (Tue, 01 Mar 2005) | 3 lines +Changed paths: + M /trunk/main/Tiarra/OptionalModules.pm + +* add Encode. + +* rewrite ->check with require instead of use $_ (). +------------------------------------------------------------------------ +r792 | topia | 2005-03-01 03:53:52 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode.pm + M /trunk/main/Tiarra/Encoding/UniJP.pm + +* more unijp conformance: ->getcode return unknown. +------------------------------------------------------------------------ +r791 | topia | 2005-03-01 03:42:28 +0900 (Tue, 01 Mar 2005) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode.pm + +* @encodings to @codes on ->set. + +* warn and ignore when _find_canon_encs found unsupported encoding. +------------------------------------------------------------------------ +r790 | topia | 2005-03-01 03:40:53 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* fix typo. +------------------------------------------------------------------------ +r789 | topia | 2005-03-01 03:26:16 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Encoding/Encode.pm + M /trunk/main/Tiarra/Encoding/UniJP.pm + +* add comma seperated guess-list feature for ->set. +------------------------------------------------------------------------ +r788 | topia | 2005-03-01 03:15:02 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* fix buggy socket closing. +------------------------------------------------------------------------ +r787 | topia | 2005-03-01 03:12:45 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* pass errno to callback. +------------------------------------------------------------------------ +r786 | topia | 2005-03-01 03:10:21 +0900 (Tue, 01 Mar 2005) | 1 line +Changed paths: + A /trunk/main/Tiarra/Encoding + A /trunk/main/Tiarra/Encoding/Encode.pm + A /trunk/main/Tiarra/Encoding/UniJP.pm + A /trunk/main/Tiarra/Encoding.pm + +* add Tiarra::Encoding for Unicode::Japanese compatible Encoding convertion layer. +------------------------------------------------------------------------ +r785 | topia | 2005-02-28 04:31:31 +0900 (Mon, 28 Feb 2005) | 3 lines +Changed paths: + M /trunk/main/Tiarra/IRC/Message.pm + +* use ->define_proxy for nick, name, host method. + +* fix to avoid unijp bug. +------------------------------------------------------------------------ +r784 | topia | 2005-02-27 15:55:47 +0900 (Sun, 27 Feb 2005) | 1 line +Changed paths: + M /trunk/module/Tools/GroupDB.pm + +* add ->find_group_with_hash, ->find_groups_with_hash. +------------------------------------------------------------------------ +r783 | topia | 2005-02-27 15:54:53 +0900 (Sun, 27 Feb 2005) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* add comment to explain connection flow. +------------------------------------------------------------------------ +r782 | topia | 2005-02-27 15:53:50 +0900 (Sun, 27 Feb 2005) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* add REOPLIST to attach_translator. +------------------------------------------------------------------------ +r781 | topia | 2005-02-27 15:53:03 +0900 (Sun, 27 Feb 2005) | 3 lines +Changed paths: + M /trunk/main/PersonalInfo.pm + +* use Tiarra::IRC::Prefix. + +* cosmetic changes. +------------------------------------------------------------------------ +r780 | topia | 2005-02-25 00:02:10 +0900 (Fri, 25 Feb 2005) | 11 lines +Changed paths: + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/LinedINETSocket.pm + M /trunk/main/RunLoop.pm + M /trunk/main/Tiarra/Socket/Buffered.pm + +* add ->_config_changed($init). + +* comment out client finalize (move to IrcIO::Client). + +* add IrcIO::Client->disconnect. + +* support disconnect errno. + +* add disconnect callback to LinedINETSocket->new. + +* handle read/write error and exception. +------------------------------------------------------------------------ +r779 | topia | 2005-02-24 23:48:44 +0900 (Thu, 24 Feb 2005) | 1 line +Changed paths: + M /trunk/main/ExternalSocket.pm + +* make exception optional. +------------------------------------------------------------------------ +r778 | topia | 2005-02-24 23:44:35 +0900 (Thu, 24 Feb 2005) | 1 line +Changed paths: + M /trunk/main/ExternalSocket.pm + +* add exception handler. +------------------------------------------------------------------------ +r777 | topia | 2005-02-24 18:37:24 +0900 (Thu, 24 Feb 2005) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* avoid compatibility bug. +------------------------------------------------------------------------ +r776 | topia | 2005-02-24 18:34:43 +0900 (Thu, 24 Feb 2005) | 1 line +Changed paths: + M /trunk/module/Tools/GroupDB.pm + +* drop backward compatibility of scalar-ref. +------------------------------------------------------------------------ +r775 | topia | 2005-02-24 18:14:53 +0900 (Thu, 24 Feb 2005) | 1 line +Changed paths: + M /trunk/module/Auto/AliasDB.pm + +* passing data type more simply. +------------------------------------------------------------------------ +r774 | topia | 2005-02-24 15:40:36 +0900 (Thu, 24 Feb 2005) | 5 lines +Changed paths: + M /trunk/main/Tiarra/IRC/Message.pm + +* revert ->raw_prefix add. + +* avoid bug on unijp: 'not check stringifiable on ->set'. + +* ->prefix re-return Tiarra::IRC::Prefix! +------------------------------------------------------------------------ +r773 | topia | 2005-02-24 14:42:42 +0900 (Thu, 24 Feb 2005) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + +* add comment. +------------------------------------------------------------------------ +r772 | topia | 2005-02-24 14:41:34 +0900 (Thu, 24 Feb 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/IRC/Message.pm + +* add ->raw_prefix. +------------------------------------------------------------------------ +r771 | topia | 2005-02-24 14:41:03 +0900 (Thu, 24 Feb 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/IRC/Prefix.pm + +* add overload to string. +------------------------------------------------------------------------ +r770 | topia | 2005-02-24 14:19:49 +0900 (Thu, 24 Feb 2005) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + +* proxy to Tiarra::IRC::Message (from IRCMessage). +------------------------------------------------------------------------ +r769 | topia | 2005-02-24 14:19:00 +0900 (Thu, 24 Feb 2005) | 3 lines +Changed paths: + A /trunk/main/Tiarra/IRC + A /trunk/main/Tiarra/IRC/Message.pm (from /trunk/main/IRCMessage.pm:768) + A /trunk/main/Tiarra/IRC/Prefix.pm + +* rename IRCMessage to Tiarra::IRC::Message. + +* split prefix function to Tiarra::IRC::Prefix. +------------------------------------------------------------------------ +r768 | topia | 2005-02-24 11:10:33 +0900 (Thu, 24 Feb 2005) | 1 line +Changed paths: + M /trunk/all.conf + M /trunk/doc/module/Auto.html + M /trunk/sample.conf + +* regen. +------------------------------------------------------------------------ +r767 | topia | 2005-02-24 11:08:34 +0900 (Thu, 24 Feb 2005) | 2 lines +Changed paths: + M /trunk/module/Auto/Reply.pm + +* fix documentation bug. + +------------------------------------------------------------------------ +r766 | topia | 2005-02-24 00:41:13 +0900 (Thu, 24 Feb 2005) | 13 lines +Changed paths: + M /trunk/module/Tools/GroupDB.pm + +* add and use ->_match for universal value match. + +* add and use ->_check_primary_key_dups. + +* add ->_del_group. + +* ->_cleanup do remove empty group. + +* (concat_string_to_key): use Tool::Hash->manipulate_keyname. + +* mark old interfaces to obsolete. + +* cosmetic fixes. +------------------------------------------------------------------------ +r765 | topia | 2005-02-23 23:02:45 +0900 (Wed, 23 Feb 2005) | 6 lines +Changed paths: + M /trunk/module/Tools/Hash.pm + +* add ->manipulate_keyname. + +* change ->clone(deep => 1) don't copy parent information. + +* call closure without parent on with_session. + +------------------------------------------------------------------------ +r764 | topia | 2005-02-23 19:04:16 +0900 (Wed, 23 Feb 2005) | 7 lines +Changed paths: + M /trunk/module/Tools/Hash.pm + +* use enum.pm. + +* add ->clone(deep => 1). + +* add proxy ->queue_cleanup, and cleanup proxy generating code. + +* add del_key alias and use ->queue_cleanup on delete values. +------------------------------------------------------------------------ +r763 | topia | 2005-02-23 18:53:12 +0900 (Wed, 23 Feb 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils/CallWrapper.pm + +* ignore error ensure-cleaner. +------------------------------------------------------------------------ +r762 | topia | 2005-02-22 05:05:25 +0900 (Tue, 22 Feb 2005) | 2 lines +Changed paths: + A /trunk/all.conf + A /trunk/doc-src/all.conf.in + M /trunk/doc-src/sample.conf.in + M /trunk/main/TiarraDoc.pm + M /trunk/makedoc + M /trunk/module/Auto/Oper.pm + M /trunk/module/CTCP/ClientInfo.pm + M /trunk/module/CTCP/Ping.pm + M /trunk/module/CTCP/Time.pm + M /trunk/module/CTCP/UserInfo.pm + M /trunk/module/CTCP/Version.pm + M /trunk/module/Channel/Join/Connect.pm + M /trunk/module/Channel/Join/Invite.pm + M /trunk/module/Channel/Join/Kicked.pm + M /trunk/module/Channel/Mode/Get.pm + M /trunk/module/Channel/Mode/Oper/Grant.pm + M /trunk/module/Channel/Mode/Set.pm + M /trunk/module/Channel/Rejoin.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Client/Cotton.pm + M /trunk/module/Client/GetVersion.pm + M /trunk/module/Client/PatchworkMessage.pm + M /trunk/module/Log/Channel.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/System/NotifyIcon/Win32.pm + M /trunk/module/System/PrivTranslator.pm + M /trunk/module/User/Away/Client.pm + M /trunk/module/User/Away/Nick.pm + M /trunk/module/User/Nick/Detached.pm + M /trunk/sample.conf + +* new configuration file: all.conf. + - get rid of non-essential modules to all.conf. +------------------------------------------------------------------------ +r761 | topia | 2005-02-22 03:30:05 +0900 (Tue, 22 Feb 2005) | 2 lines +Changed paths: + M /trunk/module/Log/Logger.pm + +* fix with null part message. + +------------------------------------------------------------------------ +r760 | topia | 2005-02-22 03:29:36 +0900 (Tue, 22 Feb 2005) | 2 lines +Changed paths: + M /trunk/main/Tiarra/Utils/CallWrapper.pm + +* fix with real_(die|warn). + +------------------------------------------------------------------------ +r759 | topia | 2005-02-18 20:30:55 +0900 (Fri, 18 Feb 2005) | 2 lines +Changed paths: + M /trunk/module/Channel/Mode/Oper/Grant.pm + +* rewrite logic. + +------------------------------------------------------------------------ +r757 | topia | 2005-02-17 09:34:44 +0900 (Thu, 17 Feb 2005) | 1 line +Changed paths: + M /trunk/main/TiarraDoc.pm + +* whitespace fixes. +------------------------------------------------------------------------ +r756 | topia | 2005-02-17 09:34:20 +0900 (Thu, 17 Feb 2005) | 1 line +Changed paths: + M /trunk/makedoc + +* whitespace fixes. +------------------------------------------------------------------------ +r755 | topia | 2005-02-17 09:20:48 +0900 (Thu, 17 Feb 2005) | 1 line +Changed paths: + M /trunk/doc/module/Channel.html + M /trunk/sample.conf + +* regen docmentation. +------------------------------------------------------------------------ +r754 | topia | 2005-02-17 09:19:01 +0900 (Thu, 17 Feb 2005) | 6 lines +Changed paths: + M /trunk/module/Channel/Mode/Oper/Grant.pm + +* support random interval. + +* change wait configuration example and comment. + +* whitespace fixes. + +------------------------------------------------------------------------ +r753 | topia | 2005-02-16 19:22:29 +0900 (Wed, 16 Feb 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils/DefineHelper.pm + +* deprecation by enum.pm. +------------------------------------------------------------------------ +r752 | topia | 2005-02-16 19:19:01 +0900 (Wed, 16 Feb 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/DefineEnumMixin.pm + +* deprecation by enum.pm. +------------------------------------------------------------------------ +r751 | topia | 2005-02-16 19:17:38 +0900 (Wed, 16 Feb 2005) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* cosmetic fixes. +------------------------------------------------------------------------ +r750 | topia | 2005-02-16 19:16:23 +0900 (Wed, 16 Feb 2005) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + +* do carp only on MAX_PARAMS exceeded message parsing. +------------------------------------------------------------------------ +r749 | topia | 2005-02-16 10:21:44 +0900 (Wed, 16 Feb 2005) | 1 line +Changed paths: + M /trunk/main/IrcIO.pm + +* add raw_param purging on read. +------------------------------------------------------------------------ +r748 | topia | 2005-02-16 10:16:53 +0900 (Wed, 16 Feb 2005) | 3 lines +Changed paths: + M /trunk/main/IRCMessage.pm + +* add raw_param handling. + +* use carp for exceeded maximum param, instead of croak. +------------------------------------------------------------------------ +r747 | topia | 2005-02-16 10:14:01 +0900 (Wed, 16 Feb 2005) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* ISUPPORT first-param used for nick. +------------------------------------------------------------------------ +r744 | topia | 2005-02-15 03:57:24 +0900 (Tue, 15 Feb 2005) | 3 lines +Changed paths: + M /trunk/doc-src/conf-main.tdoc + M /trunk/main/Configuration.pm + M /trunk/main/IrcIO/Server.pm + +* add nick-fix-mode. + +* fix ignore on connecting's handling. +------------------------------------------------------------------------ +r740 | topia | 2005-01-22 03:05:55 +0900 (Sat, 22 Jan 2005) | 2 lines +Changed paths: + M /trunk/main/Module/Use.pm + +* can load without ModuleManager. + +------------------------------------------------------------------------ +r739 | topia | 2005-01-13 11:21:47 +0900 (Thu, 13 Jan 2005) | 1 line +Changed paths: + M /trunk/tiarra + +* switch to Cwd & chdir, instead of File::chdir. +------------------------------------------------------------------------ +r738 | topia | 2005-01-07 12:11:32 +0900 (Fri, 07 Jan 2005) | 1 line +Changed paths: + M /trunk/module/Log/Writer/File.pm + +* fix harmful my. +------------------------------------------------------------------------ +r735 | topia | 2004-12-29 17:28:35 +0900 (Wed, 29 Dec 2004) | 2 lines +Changed paths: + M /trunk/tiarra + +* fix error. + +------------------------------------------------------------------------ +r734 | topia | 2004-12-29 17:27:38 +0900 (Wed, 29 Dec 2004) | 2 lines +Changed paths: + M /trunk/tiarra + +* make File::chdir to optional. + +------------------------------------------------------------------------ +r733 | topia | 2004-12-29 16:59:30 +0900 (Wed, 29 Dec 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + M /trunk/main/Tiarra/Socket.pm + +* add and use Tiarra::Socket->{errno,errmsg}. +------------------------------------------------------------------------ +r732 | topia | 2004-12-29 16:57:57 +0900 (Wed, 29 Dec 2004) | 1 line +Changed paths: + M /trunk/module/Log/Writer.pm + +* remove unnecessary 'use'. +------------------------------------------------------------------------ +r731 | topia | 2004-12-29 16:50:54 +0900 (Wed, 29 Dec 2004) | 2 lines +Changed paths: + M /trunk/INSTALL + +* small fixes. + +------------------------------------------------------------------------ +r730 | topia | 2004-12-29 16:50:04 +0900 (Wed, 29 Dec 2004) | 2 lines +Changed paths: + M /trunk/tiarra + +* fix svnversion call correctly(use File::chdir). + +------------------------------------------------------------------------ +r729 | topia | 2004-12-29 16:49:14 +0900 (Wed, 29 Dec 2004) | 2 lines +Changed paths: + M /trunk/tiarra + +* add sigusr1 signal handler(reload conf only). + +------------------------------------------------------------------------ +r728 | topia | 2004-11-29 22:40:55 +0900 (Mon, 29 Nov 2004) | 1 line +Changed paths: + A /trunk/bundle/enum.pm + +* add enum-1.16. +------------------------------------------------------------------------ +r726 | topia | 2004-11-27 14:14:12 +0900 (Sat, 27 Nov 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Win32Errno.pm + +* get rid of unnecessary Tiarra::Utils use. +------------------------------------------------------------------------ +r725 | topia | 2004-11-27 14:13:32 +0900 (Sat, 27 Nov 2004) | 1 line +Changed paths: + M /trunk/doc/module/Auto.html + M /trunk/doc/module/Client.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen. +------------------------------------------------------------------------ +r724 | topia | 2004-11-27 14:12:39 +0900 (Sat, 27 Nov 2004) | 4 lines +Changed paths: + M /trunk/module/Client/ProtectMyself.pm + +* fix module name. + +* remove unnecessary RunLoop use. + +------------------------------------------------------------------------ +r723 | topia | 2004-11-26 08:34:22 +0900 (Fri, 26 Nov 2004) | 2 lines +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* add pod. + +------------------------------------------------------------------------ +r722 | topia | 2004-11-24 09:15:13 +0900 (Wed, 24 Nov 2004) | 1 line +Changed paths: + M /trunk/module/Client/GetVersion.pm + +* mention to Client::Guess. +------------------------------------------------------------------------ +r721 | topia | 2004-11-24 09:12:25 +0900 (Wed, 24 Nov 2004) | 1 line +Changed paths: + M /trunk/module/Client/PatchworkMessage.pm + +* mention to Client::GetVersion. +------------------------------------------------------------------------ +r720 | topia | 2004-11-24 09:03:51 +0900 (Wed, 24 Nov 2004) | 3 lines +Changed paths: + M /trunk/module/Client/PatchworkMessage.pm + +* enabled by default. + +* use utils->cond_yesno to check config. +------------------------------------------------------------------------ +r719 | topia | 2004-11-16 15:39:29 +0900 (Tue, 16 Nov 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* get rid of unnecessary Config.pm requisition. +------------------------------------------------------------------------ +r718 | topia | 2004-11-15 20:42:54 +0900 (Mon, 15 Nov 2004) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + +* sync new ->define_array_attr_translate_accessor interface. +------------------------------------------------------------------------ +r717 | topia | 2004-11-15 20:41:54 +0900 (Mon, 15 Nov 2004) | 2 lines +Changed paths: + M /trunk/main/Tiarra/Utils/DefineHelper.pm + +* ->define_{array_,}attr_translate_accessor interface change. + (string to closure->($from, $to)) +------------------------------------------------------------------------ +r716 | topia | 2004-11-15 18:38:48 +0900 (Mon, 15 Nov 2004) | 16 lines +Changed paths: + M /trunk/main/IRCMessage.pm + +* modify constants. + - fix MAX_PARAMS for RFC compliance [15]. + - add MAX_MIDDLES [14]. + +* use Tiarra::Utils new style. + - use ->define_array_attr_translate_accessor for command. + - use ->define_array_attr_notify_accessor for nick, name, host, prefix. + +* rewrite prefix processor for RFC compliance. + - support nick@host style prefix parsing and serializing. + - sync nick, name, host and prefix truly. + +* rewrite message processor for RFC compliance. + - check param nums on serializing. + - handling 2nd format on params of RFC2812 / 2.3.1 Message format in ABNF. + > 14( SPACE middle ) [ SPACE [ ":" ] trailing ] +------------------------------------------------------------------------ +r715 | topia | 2004-11-15 18:18:40 +0900 (Mon, 15 Nov 2004) | 5 lines +Changed paths: + M /trunk/main/Tiarra/Utils/DefineHelper.pm + +* add define_{array_,}attr_{translate,notify}_accessor. + +* split _define_{array_,}attr_common. + +* use ->get_caller on ->get_package. +------------------------------------------------------------------------ +r714 | topia | 2004-11-06 05:23:07 +0900 (Sat, 06 Nov 2004) | 1 line +Changed paths: + M /trunk/module/Auto/Calc.pm + +* add export function. +------------------------------------------------------------------------ +r713 | topia | 2004-11-01 00:39:28 +0900 (Mon, 01 Nov 2004) | 1 line +Changed paths: + M /trunk/module/Log/Writer/Base.pm + M /trunk/module/Log/Writer/File.pm + M /trunk/module/Log/Writer.pm + +* new style Log::Writer loader. +------------------------------------------------------------------------ +r712 | topia | 2004-10-31 23:35:07 +0900 (Sun, 31 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/ModuleManager.pm + +* update depth only if increase. + +* call destruct on reload even if it isn't tiarra module. +------------------------------------------------------------------------ +r711 | topia | 2004-10-31 17:53:20 +0900 (Sun, 31 Oct 2004) | 1 line +Changed paths: + M /trunk/module/Log/Channel.pm + +* fallsafe if writer_is_not_defined. +------------------------------------------------------------------------ +r710 | topia | 2004-10-31 17:18:15 +0900 (Sun, 31 Oct 2004) | 1 line +Changed paths: + M /trunk/module/Log/Writer/Base.pm + +* cache notify for 30 sec. +------------------------------------------------------------------------ +r709 | topia | 2004-10-26 07:50:05 +0900 (Tue, 26 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* cosmetic fixes. + +* return $default even if $default not defined. +------------------------------------------------------------------------ +r708 | topia | 2004-10-26 07:44:15 +0900 (Tue, 26 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* ignore case of cond_yesno. +------------------------------------------------------------------------ +r707 | topia | 2004-10-26 05:45:15 +0900 (Tue, 26 Oct 2004) | 5 lines +Changed paths: + M /trunk/module/Tools/Hash.pm + +* sync Tiarra::Utils interface change. + +* add ->equals, but very expensive function (of speed). + +* add ->add_hash. +------------------------------------------------------------------------ +r706 | topia | 2004-10-26 05:42:19 +0900 (Tue, 26 Oct 2004) | 1 line +Changed paths: + M /trunk/module/Auto/AliasDB.pm + +* cleanup duplicate code; do proxy. +------------------------------------------------------------------------ +r705 | topia | 2004-10-26 05:34:02 +0900 (Tue, 26 Oct 2004) | 2 lines +Changed paths: + M /trunk/tiarra + +* add --show-env. + +------------------------------------------------------------------------ +r703 | topia | 2004-10-26 05:20:51 +0900 (Tue, 26 Oct 2004) | 13 lines +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* add $genre param to ->interrupt. + +* use ->interrupt('timeout') for timeout timer. + +* message case tweaks. + +* ->_connect_error_try_next's param change to ($errno, $msg). + +* rename ->_connect_error_try_next to _connect_warn_try_next. + +* ->new(retry => ...) is changed to ->new(retry_int => ...). + +* add retry_count to ->new. +------------------------------------------------------------------------ +r702 | topia | 2004-10-26 05:16:31 +0900 (Tue, 26 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* add ->to_ordinal_number. +------------------------------------------------------------------------ +r701 | topia | 2004-10-26 03:31:14 +0900 (Tue, 26 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* add msg param to ->sock_errno_to_msg. +------------------------------------------------------------------------ +r700 | topia | 2004-10-26 03:02:06 +0900 (Tue, 26 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* failsafe for connect successful. + +* use ->_warn instead of warn. +------------------------------------------------------------------------ +r699 | topia | 2004-10-25 02:51:27 +0900 (Mon, 25 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* fix place of remove connecting flag, for finalize cleanup. +------------------------------------------------------------------------ +r698 | topia | 2004-10-25 02:37:17 +0900 (Mon, 25 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Win32Errno.pm + +* fix YAML validity. +------------------------------------------------------------------------ +r697 | topia | 2004-10-24 21:50:25 +0900 (Sun, 24 Oct 2004) | 9 lines +Changed paths: + M /trunk/main/RunLoop.pm + M /trunk/main/Tiarra/Socket/Connect.pm + A /trunk/main/Tiarra/Socket/Win32Errno.pm + M /trunk/main/Tiarra/Socket.pm + +* add Tiarra::Socket::Win32Errno(on demand loading). + +* move Tiarra::Socket::Connect->_errno_to_msg() to Tiarra::Socket->sock_errnoto_msg(). + +* add Tiarra::Socket->exception. + +* add Tiarra::Socket->_is_winsock. + +* support win32 non-blocking connection. +------------------------------------------------------------------------ +r696 | topia | 2004-10-24 10:28:36 +0900 (Sun, 24 Oct 2004) | 4 lines +Changed paths: + M /trunk/main/Tiarra/OptionalModules.pm + +* add ->check, and use AUTOLOAD. + +* add ->{all,repr}_modules, ->check_all. + +------------------------------------------------------------------------ +r695 | topia | 2004-10-24 10:21:14 +0900 (Sun, 24 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* fix bug on wrong case (do require, not Require!). +------------------------------------------------------------------------ +r694 | topia | 2004-10-24 10:16:29 +0900 (Sun, 24 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* use sock->sockopt(SO_ERROR) to get error message. +------------------------------------------------------------------------ +r693 | topia | 2004-10-24 09:46:47 +0900 (Sun, 24 Oct 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* fix typo. +------------------------------------------------------------------------ +r692 | topia | 2004-10-24 09:42:37 +0900 (Sun, 24 Oct 2004) | 6 lines +Changed paths: + M /trunk/main/RunLoop.pm + +* fix bug on sockets_to_cleanup. + - should refer sock(IO::Socket), instead of socket(Tiarra::Socket). + +* use shutdown instead of close after accept on terminating. + + +------------------------------------------------------------------------ +r691 | topia | 2004-10-24 09:31:02 +0900 (Sun, 24 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* use attach/detach for set sock. + +* add ->_errno_to_msg(errno) for generate error message with/without ActivePerl. +------------------------------------------------------------------------ +r690 | topia | 2004-10-24 09:25:44 +0900 (Sun, 24 Oct 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* ignore cleanup sockets on unknown (readable|writable) socket warning. +------------------------------------------------------------------------ +r689 | topia | 2004-10-23 20:43:42 +0900 (Sat, 23 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* increase verbosity on error. +------------------------------------------------------------------------ +r688 | topia | 2004-10-23 19:58:50 +0900 (Sat, 23 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* add select check. +------------------------------------------------------------------------ +r687 | topia | 2004-10-23 19:37:52 +0900 (Sat, 23 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* fix error process. +------------------------------------------------------------------------ +r686 | topia | 2004-10-23 19:35:19 +0900 (Sat, 23 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* add sockerror check. +------------------------------------------------------------------------ +r685 | topia | 2004-10-23 04:55:25 +0900 (Sat, 23 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* rename ->config_or_default to ->config_local_or_general. +------------------------------------------------------------------------ +r683 | topia | 2004-10-19 19:24:44 +0900 (Tue, 19 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* connect socket even if non-block failed. + +* use saddr-resolve. +------------------------------------------------------------------------ +r682 | topia | 2004-10-19 19:21:43 +0900 (Tue, 19 Oct 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* get rid of non-necessary module require. +------------------------------------------------------------------------ +r681 | topia | 2004-10-19 06:02:08 +0900 (Tue, 19 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* fix bug on repr_destination/port. +------------------------------------------------------------------------ +r680 | topia | 2004-10-19 06:01:16 +0900 (Tue, 19 Oct 2004) | 5 lines +Changed paths: + M /trunk/main/Tiarra/Resolver.pm + +* add saddr(sockaddr struct) resolve. + +* return entry straightly on without-thread mode. + +* use 0 as port of getaddrinfo. +------------------------------------------------------------------------ +r679 | topia | 2004-10-19 04:50:05 +0900 (Tue, 19 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* use connector->current_{addr,type}. +------------------------------------------------------------------------ +r678 | topia | 2004-10-19 04:39:10 +0900 (Tue, 19 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* add and use ->current_{addr,port,type}. +------------------------------------------------------------------------ +r677 | topia | 2004-10-19 04:32:37 +0900 (Tue, 19 Oct 2004) | 1 line +Changed paths: + M /trunk/AUTHORS + A /trunk/module/System/SendMessage.pm + +* add System::SendMessage. +------------------------------------------------------------------------ +r676 | topia | 2004-10-19 04:31:28 +0900 (Tue, 19 Oct 2004) | 11 lines +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + M /trunk/main/Tiarra/Socket.pm + +* connector->type_name -> socket->repr_type. + +* add socket->probe_type_by_addr. + +* make socket->probe_type_by_addr to return lower name. + +* rewrite socket->repr_destination, and use ->repr_type. + +* rewrite connector->_connect_stage with ->probe_type_by_addr. + +* add fogotten non-Blocking option on connector. +------------------------------------------------------------------------ +r675 | topia | 2004-10-18 19:38:51 +0900 (Mon, 18 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Utils/CallWrapper.pm + M /trunk/main/Tiarra/Utils.pm + +* ->to_str check wantarray. + +* fix bug of dropping false value. +------------------------------------------------------------------------ +r674 | topia | 2004-10-18 12:59:18 +0900 (Mon, 18 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* fix bug on _try_connect_{ipv6,unix} error. +------------------------------------------------------------------------ +r673 | topia | 2004-10-18 03:12:40 +0900 (Mon, 18 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* add ->shutdown. +------------------------------------------------------------------------ +r672 | topia | 2004-10-18 01:19:42 +0900 (Mon, 18 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* mention for Win32/select implementation. +------------------------------------------------------------------------ +r671 | topia | 2004-10-18 01:13:55 +0900 (Mon, 18 Oct 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* fix typo. +------------------------------------------------------------------------ +r670 | topia | 2004-10-18 01:10:50 +0900 (Mon, 18 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/ExternalSocket.pm + +* improve caller_check. + +* little fixes. +------------------------------------------------------------------------ +r669 | topia | 2004-10-18 01:05:38 +0900 (Mon, 18 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Buffered.pm + M /trunk/main/Tiarra/Socket/Connect.pm + M /trunk/main/Tiarra/Socket.pm + +* add and use Tiarra::Socket->close. +------------------------------------------------------------------------ +r668 | topia | 2004-10-18 01:01:12 +0900 (Mon, 18 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Socket/Connect.pm + +* use Tiarra::OptionalModules. + +* add Unix Domain Socket support. +------------------------------------------------------------------------ +r667 | topia | 2004-10-18 00:56:40 +0900 (Mon, 18 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/RunLoop.pm + +* use Tiarra::OptionalModules. + +* add comment, improve error messages. +------------------------------------------------------------------------ +r666 | topia | 2004-10-18 00:43:41 +0900 (Mon, 18 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO.pm + M /trunk/main/LinedINETSocket.pm + +* remove unnecessary module require. +------------------------------------------------------------------------ +r665 | topia | 2004-10-18 00:42:11 +0900 (Mon, 18 Oct 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* use Tiarra::OptionalModules. +------------------------------------------------------------------------ +r664 | topia | 2004-10-18 00:41:42 +0900 (Mon, 18 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + A /trunk/main/Tiarra/OptionalModules.pm + M /trunk/main/Tiarra/Resolver.pm + M /trunk/main/Tiarra/SessionMixin.pm + +* add and use Tiarra::OptionalModules. +------------------------------------------------------------------------ +r663 | topia | 2004-10-15 21:14:05 +0900 (Fri, 15 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/LinedINETSocket.pm + +* use Tiarra::Socket::Lined. + +* ->attach also call ->install(for backward compat.). +------------------------------------------------------------------------ +r662 | topia | 2004-10-15 21:11:15 +0900 (Fri, 15 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/ControlPort.pm + +* pertially rewritten. + +* use Tiarra::Socket::Lined. +------------------------------------------------------------------------ +r661 | topia | 2004-10-15 21:09:10 +0900 (Fri, 15 Oct 2004) | 1 line +Changed paths: + A /trunk/main/Tiarra/Socket/Lined.pm + +* add. +------------------------------------------------------------------------ +r660 | topia | 2004-10-15 21:08:45 +0900 (Fri, 15 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket/Buffered.pm + +* not check $this->sock defineded on shutdown(totally people won't happy with this check). +------------------------------------------------------------------------ +r659 | topia | 2004-10-15 21:06:57 +0900 (Fri, 15 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* return $this on attach/detach. +------------------------------------------------------------------------ +r658 | topia | 2004-10-15 21:05:35 +0900 (Fri, 15 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Hook.pm + +* add ->name for Hook. +------------------------------------------------------------------------ +r657 | topia | 2004-10-15 17:26:35 +0900 (Fri, 15 Oct 2004) | 1 line +Changed paths: + M /trunk/module/Log/Writer/Base.pm + +* use get_first_defined as first_defined. +------------------------------------------------------------------------ +r656 | topia | 2004-10-15 01:29:12 +0900 (Fri, 15 Oct 2004) | 1 line +Changed paths: + M /trunk/module/Client/ProtectMyself.pm + M /trunk/module/Tools/HashDB.pm + +* use new Tiarra::Utils entry point (utils->). +------------------------------------------------------------------------ +r655 | topia | 2004-10-15 01:00:17 +0900 (Fri, 15 Oct 2004) | 1 line +Changed paths: + M /trunk/main/ExternalSocket.pm + M /trunk/main/Hook.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/IrcIO.pm + M /trunk/main/LinedINETSocket.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/RunLoop.pm + M /trunk/main/Tiarra/Socket/Buffered.pm + M /trunk/main/Tiarra/Socket/Connect.pm + M /trunk/main/Tiarra/Socket.pm + M /trunk/main/Tiarra/WrapMainLoop.pm + M /trunk/main/Timer.pm + +* use new Tiarra::Utils entry point (utils->). +------------------------------------------------------------------------ +r654 | topia | 2004-10-15 00:49:51 +0900 (Fri, 15 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* add utils entry point. +------------------------------------------------------------------------ +r653 | topia | 2004-10-08 23:46:07 +0900 (Fri, 08 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* fix typo of detach. +------------------------------------------------------------------------ +r652 | topia | 2004-10-08 19:21:52 +0900 (Fri, 08 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* show connection warning as error message. +------------------------------------------------------------------------ +r651 | topia | 2004-10-08 19:20:53 +0900 (Fri, 08 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* avoid double error message (we don't use timeout). +------------------------------------------------------------------------ +r650 | topia | 2004-10-08 19:00:48 +0900 (Fri, 08 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* fix error on non-thread perl. +------------------------------------------------------------------------ +r649 | topia | 2004-10-08 18:07:28 +0900 (Fri, 08 Oct 2004) | 1 line +Changed paths: + M /trunk/module/Log/Writer/File.pm + +* untaint filename. +------------------------------------------------------------------------ +r648 | topia | 2004-10-08 11:44:19 +0900 (Fri, 08 Oct 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* fix temporary terminate wait value(10) to 400. +------------------------------------------------------------------------ +r647 | topia | 2004-10-08 11:40:44 +0900 (Fri, 08 Oct 2004) | 1 line +Changed paths: + M /trunk/main/ExternalSocket.pm + +* fix bug. +------------------------------------------------------------------------ +r646 | topia | 2004-10-08 11:38:43 +0900 (Fri, 08 Oct 2004) | 1 line +Changed paths: + M /trunk/main/ExternalSocket.pm + +* fix typo. +------------------------------------------------------------------------ +r645 | topia | 2004-10-08 11:05:28 +0900 (Fri, 08 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/Tiarra/SessionMixin.pm + +* remove Thread::Queue require. + +* rename session_{start,finish} -> __session_{start,finish}. +------------------------------------------------------------------------ +r644 | topia | 2004-10-08 11:04:12 +0900 (Fri, 08 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/ExternalSocket.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/IrcIO.pm + M /trunk/main/LinedINETSocket.pm + M /trunk/main/RunLoop.pm + A /trunk/main/Tiarra/Socket + A /trunk/main/Tiarra/Socket/Buffered.pm + A /trunk/main/Tiarra/Socket/Connect.pm (from /trunk/main/Tiarra/Socket.pm:633) + M /trunk/main/Tiarra/Socket.pm + +* new socket framework! + +* TerminateManager to tiarra. +------------------------------------------------------------------------ +r643 | topia | 2004-10-08 08:58:03 +0900 (Fri, 08 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Hook.pm + +* cosmetic fixes. +------------------------------------------------------------------------ +r642 | topia | 2004-10-08 08:56:33 +0900 (Fri, 08 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/WrapMainLoop.pm + +* lazy load RunLoop, Timer (to avoid perl(?) cleanup bug). +------------------------------------------------------------------------ +r641 | topia | 2004-10-08 08:52:40 +0900 (Fri, 08 Oct 2004) | 3 lines +Changed paths: + M /trunk/tiarra + +* more earlier Tiarra::Resolver load. + +* call TerminateManager on exit. +------------------------------------------------------------------------ +r640 | topia | 2004-10-07 21:11:13 +0900 (Thu, 07 Oct 2004) | 1 line +Changed paths: + A /trunk/INSTALL + +* add. +------------------------------------------------------------------------ +r639 | topia | 2004-10-07 21:09:39 +0900 (Thu, 07 Oct 2004) | 3 lines +Changed paths: + M /trunk/AUTHORS + +* cosmetic changes. + +* mention bundle/*. +------------------------------------------------------------------------ +r638 | topia | 2004-10-07 21:08:27 +0900 (Thu, 07 Oct 2004) | 1 line +Changed paths: + M /trunk/LICENSE + +* change comment to ordinary line. +------------------------------------------------------------------------ +r637 | topia | 2004-10-07 20:58:12 +0900 (Thu, 07 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/WrapMainLoop.pm + +* add ->name. +------------------------------------------------------------------------ +r636 | topia | 2004-10-07 20:57:42 +0900 (Thu, 07 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Utils/DefineHelper.pm + +* get rid of SharedMixin comment, to Tiarra::Utils::Core. + +* add too_many_args error on _generate_attr_closure. +------------------------------------------------------------------------ +r635 | topia | 2004-10-07 20:56:02 +0900 (Thu, 07 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils/CallWrapper.pm + +* fix bug on s/shift/$msg/g; +------------------------------------------------------------------------ +r634 | topia | 2004-10-07 20:55:27 +0900 (Thu, 07 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* fix bug on passing caller level to get_caller. +------------------------------------------------------------------------ +r633 | topia | 2004-10-04 07:18:29 +0900 (Mon, 04 Oct 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* suppress one callstack. +------------------------------------------------------------------------ +r632 | topia | 2004-10-04 07:17:33 +0900 (Mon, 04 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* add {terminated,finalized} to _connect_interrupted state. + +* check ->{connector} defined. +------------------------------------------------------------------------ +r631 | topia | 2004-10-04 07:15:19 +0900 (Mon, 04 Oct 2004) | 5 lines +Changed paths: + M /trunk/main/Tiarra/DefineEnumMixin.pm + M /trunk/main/Tiarra/SharedMixin.pm + A /trunk/main/Tiarra/Utils + A /trunk/main/Tiarra/Utils/CallWrapper.pm + A /trunk/main/Tiarra/Utils/Core.pm + A /trunk/main/Tiarra/Utils/DefineHelper.pm + M /trunk/main/Tiarra/Utils.pm + +* Tiarra::Utils splitting. + +* sync Tiarra::Utils splitting. + +* add Tiarra::Utils::DefineHelper->{get_caller,do_with_define_exportlevel}. +------------------------------------------------------------------------ +r630 | topia | 2004-10-03 22:22:52 +0900 (Sun, 03 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/SessionMixin.pm + +* remove debugging message from with_session errmsg. +------------------------------------------------------------------------ +r629 | topia | 2004-10-03 22:18:03 +0900 (Sun, 03 Oct 2004) | 9 lines +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* remove unnecessary comment. + +* add Tiarra::Socket->probe_type_by_class. + +* euc-jp-ize. + +* fix bug on accept ->addr. + +* add interrupt subject callback (experimental feature, may change in future). +------------------------------------------------------------------------ +r628 | topia | 2004-10-03 22:03:53 +0900 (Sun, 03 Oct 2004) | 4 lines +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* change ->do_with_ensure semantics. + - cannot tell error status to ensure. + +* fix bug default handler on do_with_errmsg. +------------------------------------------------------------------------ +r627 | topia | 2004-10-03 01:36:35 +0900 (Sun, 03 Oct 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* re-tweak server replied check regex. +------------------------------------------------------------------------ +r626 | topia | 2004-10-03 01:33:38 +0900 (Sun, 03 Oct 2004) | 1 line +Changed paths: + M /trunk/module/Tools/HashDB.pm + +* fix typo. +------------------------------------------------------------------------ +r625 | topia | 2004-10-03 01:29:47 +0900 (Sun, 03 Oct 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* add Server replied to ignore die callstack. +------------------------------------------------------------------------ +r624 | topia | 2004-10-03 01:28:37 +0900 (Sun, 03 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* change Server replied warn to printmsg, and tweak message. +------------------------------------------------------------------------ +r623 | topia | 2004-10-02 21:02:35 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* fix bug in server_addr. +------------------------------------------------------------------------ +r622 | topia | 2004-10-02 19:46:01 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* fix debug retry timer. +------------------------------------------------------------------------ +r621 | topia | 2004-10-02 19:41:45 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* fix typo. +------------------------------------------------------------------------ +r620 | topia | 2004-10-02 19:40:02 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* can't understand bug, pass $connector to _attach. +------------------------------------------------------------------------ +r619 | topia | 2004-10-02 19:36:30 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* fast initialization default network. +------------------------------------------------------------------------ +r617 | topia | 2004-10-02 19:29:44 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* fix bug on connection interrupted. +------------------------------------------------------------------------ +r616 | topia | 2004-10-02 19:24:15 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* fix portability. +------------------------------------------------------------------------ +r615 | topia | 2004-10-02 19:22:34 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* supply error-message on internal error. +------------------------------------------------------------------------ +r614 | topia | 2004-10-02 19:20:54 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* show connect_error detail. +------------------------------------------------------------------------ +r613 | topia | 2004-10-02 19:20:26 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* supply msg to all connect_error. +------------------------------------------------------------------------ +r612 | topia | 2004-10-02 19:15:10 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Socket.pm + +* fix typo. +------------------------------------------------------------------------ +r611 | topia | 2004-10-02 19:10:27 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/RunLoop.pm + M /trunk/main/Tiarra/Resolver.pm + A /trunk/main/Tiarra/Socket.pm + +* new Socket/RunLoop framework! +------------------------------------------------------------------------ +r610 | topia | 2004-10-02 19:03:10 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/module/Tools/HashDB.pm + +* check $this->time defined. +------------------------------------------------------------------------ +r609 | topia | 2004-10-02 19:01:46 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/module/Tools/HashDB.pm + +* omit with_session in _load. +------------------------------------------------------------------------ +r608 | topia | 2004-10-02 17:36:12 +0900 (Sat, 02 Oct 2004) | 7 lines +Changed paths: + M /trunk/main/Tiarra/SessionMixin.pm + M /trunk/module/Tools/GroupDB.pm + +* add Tiarra::SessionMixin->{session_name}. + +* use utils->do_with_errmsg. + +* fix warn on Tools::GroupDB->primary_key undefined. + +* Tools::GroupDB->find_groups accept (pure-scalar|scalar ref|others). +------------------------------------------------------------------------ +r607 | topia | 2004-10-02 17:31:58 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/module/Client/Eval.pm + M /trunk/module/System/Reload.pm + +* use ReloadTrigger->_install_reload_timer. +------------------------------------------------------------------------ +r606 | topia | 2004-10-02 17:31:19 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/ReloadTrigger.pm + +* add ->_install_reload_timer. +------------------------------------------------------------------------ +r605 | topia | 2004-10-02 17:30:42 +0900 (Sat, 02 Oct 2004) | 5 lines +Changed paths: + M /trunk/main/Hook.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/Timer.pm + +* add ->{name}. + +* use utils->do_with_errmsg. + +* get rid of symtable-fetch eval. +------------------------------------------------------------------------ +r604 | topia | 2004-10-02 17:12:22 +0900 (Sat, 02 Oct 2004) | 7 lines +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* add simple_caller_formatter, sighandler_or_default, _add_lf, do_with_errmsg. + +* rename _wantarrays_to_types to _wantarray_to_type, and using wantarray. + +* do_with_ensure use sighandler_or_default. bugs: + - new: die ensure handler isn't called many time in tiarra. + - old: very long callstack with debug-mode. +------------------------------------------------------------------------ +r603 | topia | 2004-10-02 07:35:15 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Resolver.pm + +* fix typo, add AI_NUMERICHOST. +------------------------------------------------------------------------ +r602 | topia | 2004-10-02 07:32:22 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Resolver.pm + +* define dummy with closure. +------------------------------------------------------------------------ +r601 | topia | 2004-10-02 07:27:30 +0900 (Sat, 02 Oct 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Resolver.pm + +* try AI_NUMERICHOST for fast resolve. +------------------------------------------------------------------------ +r600 | topia | 2004-10-01 21:51:44 +0900 (Fri, 01 Oct 2004) | 3 lines +Changed paths: + M /trunk/main/Multicast.pm + +* check logged_in on forward_to_server. + +* use runloop->networks_list. +------------------------------------------------------------------------ +r599 | topia | 2004-10-01 20:33:43 +0900 (Fri, 01 Oct 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* add fatal exit. +------------------------------------------------------------------------ +r598 | topia | 2004-09-28 10:44:59 +0900 (Tue, 28 Sep 2004) | 2 lines +Changed paths: + A /trunk/main/Tiarra/ModifiedFlagMixin.pm + A /trunk/main/Tiarra/SessionMixin.pm + M /trunk/module/Auto/Alias.pm + M /trunk/module/Auto/AliasDB.pm + M /trunk/module/Tools/GroupDB.pm + A /trunk/module/Tools/Hash.pm + M /trunk/module/Tools/HashDB.pm + +* new alias, groupdb, hashdb framework! + - maybe has many bug, should check before merge. +------------------------------------------------------------------------ +r597 | topia | 2004-09-28 10:41:53 +0900 (Tue, 28 Sep 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* call TerminateManager->terminate('main') on force exit. +------------------------------------------------------------------------ +r596 | topia | 2004-09-27 17:12:28 +0900 (Mon, 27 Sep 2004) | 3 lines +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* migration ->_generate_attr_closure. + +* add define_attr_enum_accessor. +------------------------------------------------------------------------ +r595 | topia | 2004-09-25 23:37:24 +0900 (Sat, 25 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* ->get_first_defined return ()[empty-array] if nothing defined value. +------------------------------------------------------------------------ +r594 | topia | 2004-09-25 23:24:21 +0900 (Sat, 25 Sep 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* use multi-threaded resolver. +------------------------------------------------------------------------ +r593 | topia | 2004-09-25 23:11:14 +0900 (Sat, 25 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* fix return-value handling on do_with_ensure. +------------------------------------------------------------------------ +r592 | topia | 2004-09-25 23:10:27 +0900 (Sat, 25 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Resolver.pm + +* rename ANSWER_NXDOMAIN -> ANSWER_NOT_FOUND. +------------------------------------------------------------------------ +r591 | topia | 2004-09-25 23:07:53 +0900 (Sat, 25 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Timer.pm + +* add ->name (default caller information). +------------------------------------------------------------------------ +r590 | topia | 2004-09-24 08:26:51 +0900 (Fri, 24 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Client/Eval.pm + +* disable die-handler override to get rid of un-necessary error message. +------------------------------------------------------------------------ +r589 | topia | 2004-09-24 08:24:47 +0900 (Fri, 24 Sep 2004) | 3 lines +Changed paths: + M /trunk/main/Tiarra/SharedMixin.pm + +* add no warnings for fastest call. + +* add ->_shared_init(...). +------------------------------------------------------------------------ +r588 | topia | 2004-09-23 13:18:46 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* do croak instead of die. +------------------------------------------------------------------------ +r587 | topia | 2004-09-23 07:14:06 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Resolver.pm + +* add dummy definition NI_NAMEREQD on disabled ipv6. +------------------------------------------------------------------------ +r586 | topia | 2004-09-23 06:38:05 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Resolver.pm + +* fix ipv6 support (second). +------------------------------------------------------------------------ +r585 | topia | 2004-09-23 06:33:40 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Resolver.pm + +* fix ipv6 support. +------------------------------------------------------------------------ +r584 | topia | 2004-09-23 06:15:48 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Log/Writer.pm + +* fix typo & require bug. +------------------------------------------------------------------------ +r583 | topia | 2004-09-23 06:12:26 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + M /trunk/module/System/Shutdown.pm + +* fix typo & forget require. +------------------------------------------------------------------------ +r582 | topia | 2004-09-23 05:55:56 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Resolver.pm + +* fix typo. +------------------------------------------------------------------------ +r581 | topia | 2004-09-23 05:55:16 +0900 (Thu, 23 Sep 2004) | 3 lines +Changed paths: + M /trunk/module/Log/Writer.pm + +* use Tiarra::WrapMainLoop. + +* use Tiarra::Utils. +------------------------------------------------------------------------ +r580 | topia | 2004-09-23 05:53:26 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Auto/Calc.pm + M /trunk/module/Auto/Random.pm + M /trunk/module/Auto/Reply.pm + M /trunk/module/Client/Eval.pm + +* use $reply_*->([arrayref], ...). +------------------------------------------------------------------------ +r579 | topia | 2004-09-23 05:49:41 +0900 (Thu, 23 Sep 2004) | 3 lines +Changed paths: + M /trunk/tiarra + +* do fast initialization Tiarra::Resolver(for minimal ithreads). + +* change svn version check order(.svnversion -> svnversion). +------------------------------------------------------------------------ +r578 | topia | 2004-09-23 01:23:35 +0900 (Thu, 23 Sep 2004) | 7 lines +Changed paths: + M /trunk/main/IrcIO/Client.pm + A /trunk/main/Tiarra/Resolver.pm + +* add Tiarra::Resolver (async, maybe support ipv6 resolver). + +* paranoid check for Client FQDN. + +* check client_{host,addr} mask for allowed_host. + +* add IrcIO::Client->client_host_repr.(representation with host(addr)). +------------------------------------------------------------------------ +r577 | topia | 2004-09-23 01:19:29 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + A /trunk/main/Tiarra/WrapMainLoop.pm + +* add mainloop wrapper. +------------------------------------------------------------------------ +r576 | topia | 2004-09-23 01:18:42 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + A /trunk/main/Tiarra/TerminateManager.pm + +* add Tiarra::TerminateManager. +------------------------------------------------------------------------ +r575 | topia | 2004-09-23 01:17:39 +0900 (Thu, 23 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* define_{array_,}_attr_accessor return lvalue. +------------------------------------------------------------------------ +r574 | topia | 2004-09-21 21:34:36 +0900 (Tue, 21 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Auto/Utils.pm + +* permit array ref to closures. +------------------------------------------------------------------------ +r573 | topia | 2004-09-21 19:20:18 +0900 (Tue, 21 Sep 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* move *_enabled functions into BEGIN block. +------------------------------------------------------------------------ +r572 | topia | 2004-09-21 19:18:52 +0900 (Tue, 21 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Timer.pm + +* use Tiarra::Utils->define_attr_accessor. +------------------------------------------------------------------------ +r571 | topia | 2004-09-21 19:17:30 +0900 (Tue, 21 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Configuration.pm + +* style/whitespace fix. +------------------------------------------------------------------------ +r570 | topia | 2004-09-21 19:12:50 +0900 (Tue, 21 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* support ->define_{,array_}attr_accessor(undef). +------------------------------------------------------------------------ +r569 | topia | 2004-09-20 21:51:00 +0900 (Mon, 20 Sep 2004) | 1 line +Changed paths: + M /trunk/NEWS + +* fix typo (network -> networks). +------------------------------------------------------------------------ +r568 | topia | 2004-09-20 21:40:29 +0900 (Mon, 20 Sep 2004) | 1 line +Changed paths: + M /trunk/doc-src/conf-main.tdoc + +* mention network/fixed-channels. +------------------------------------------------------------------------ +r567 | topia | 2004-09-20 07:55:59 +0900 (Mon, 20 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* pass retval, error to ensure closure. +------------------------------------------------------------------------ +r566 | topia | 2004-09-19 20:35:52 +0900 (Sun, 19 Sep 2004) | 5 lines +Changed paths: + M /trunk/main/Configuration/Block.pm + M /trunk/main/IRCMessage.pm + M /trunk/main/PersonInChannel.pm + M /trunk/main/PersonalInfo.pm + +* use Tiarra::DefineEnumMixin. + +* use Tiarra::Utils->define_array_attr_*. + +* IRCMessage: use anon{hash,array} instead of temporary my variable. +------------------------------------------------------------------------ +r565 | topia | 2004-09-19 20:32:50 +0900 (Sun, 19 Sep 2004) | 3 lines +Changed paths: + A /trunk/main/Tiarra/DefineEnumMixin.pm + M /trunk/main/Tiarra/Utils.pm + +* add $ExportLevel variable to be able to write define_*s' wrapper function. + +* add Tiarra::DefineEnumMixin for shorthand. +------------------------------------------------------------------------ +r564 | topia | 2004-09-19 19:02:44 +0900 (Sun, 19 Sep 2004) | 9 lines +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* add _parse_{array_,}_attr_define to split common functionality. + +* add define_array_attr_{accessor,getter,setter}. + +* add define_{proxy,enum}. + +* add call_with_wantarray. + +* add do_with_ensure. +------------------------------------------------------------------------ +r563 | topia | 2004-09-15 22:05:59 +0900 (Wed, 15 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Client/ProtectMyself.pm + +* use AliasDB->stdreplace. +------------------------------------------------------------------------ +r562 | topia | 2004-09-15 14:54:52 +0900 (Wed, 15 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Auto/AliasDB.pm + +* make callable with package(class method). +------------------------------------------------------------------------ +r561 | topia | 2004-09-15 14:52:20 +0900 (Wed, 15 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Auto/AliasDB/CallbackUtils.pm + +* check parameter defined for use these. +------------------------------------------------------------------------ +r560 | topia | 2004-09-15 14:50:41 +0900 (Wed, 15 Sep 2004) | 1 line +Changed paths: + M /trunk/main/ModuleManager.pm + +* check and use dependency depth for reload. +------------------------------------------------------------------------ +r559 | topia | 2004-09-15 09:37:43 +0900 (Wed, 15 Sep 2004) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + +* clone params/remarks little deep. +------------------------------------------------------------------------ +r558 | topia | 2004-09-15 09:28:58 +0900 (Wed, 15 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Client/ProtectMyself.pm + +* do deep clone for params. +------------------------------------------------------------------------ +r557 | topia | 2004-09-14 10:29:05 +0900 (Tue, 14 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Client/ProtectMyself.pm + +* fix clone bug. +------------------------------------------------------------------------ +r556 | topia | 2004-09-13 09:24:49 +0900 (Mon, 13 Sep 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO.pm + M /trunk/main/LinedINETSocket.pm + +* clear sendbuf/recvbuf on disconnect. +------------------------------------------------------------------------ +r554 | topia | 2004-09-13 08:33:38 +0900 (Mon, 13 Sep 2004) | 1 line +Changed paths: + M /trunk/tiarra + M /trunk/tools/upload.sh + +* add .svnversion handling. +------------------------------------------------------------------------ +r553 | topia | 2004-09-13 08:18:17 +0900 (Mon, 13 Sep 2004) | 2 lines +Changed paths: + M /trunk/tiarra + +* check length of $svnversion, instead of checking exit status. + - ...why exit status on Win32/ActivePerl 5.8.4 is -1 ? +------------------------------------------------------------------------ +r552 | topia | 2004-09-13 08:09:29 +0900 (Mon, 13 Sep 2004) | 3 lines +Changed paths: + A /trunk/bundle + A /trunk/bundle/Unicode + A /trunk/bundle/Unicode/Japanese.pm (from /trunk/main/Unicode/Japanese.pm:550) + D /trunk/main/Unicode + M /trunk/tiarra + +* main/Unicode/Japanese.pm to bundle/. + +* add bundle to @INC last. +------------------------------------------------------------------------ +r551 | topia | 2004-09-13 08:08:25 +0900 (Mon, 13 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Log/Logger.pm + +* add part message to part log. +------------------------------------------------------------------------ +r550 | topia | 2004-09-13 07:49:13 +0900 (Mon, 13 Sep 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* check '$io->sock is defined' on find_io_with_socket. +------------------------------------------------------------------------ +r549 | topia | 2004-09-13 06:58:03 +0900 (Mon, 13 Sep 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* check svnversion return value. +------------------------------------------------------------------------ +r548 | topia | 2004-09-12 10:47:50 +0900 (Sun, 12 Sep 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* add svnversion for fetch version. +------------------------------------------------------------------------ +r547 | topia | 2004-09-12 02:48:03 +0900 (Sun, 12 Sep 2004) | 1 line +Changed paths: + M /trunk/HACKING + +* describe Tiarra::{SharedMixin,Utils,ShorthandConfMixin}. +------------------------------------------------------------------------ +r546 | topia | 2004-09-12 02:15:05 +0900 (Sun, 12 Sep 2004) | 19 lines +Changed paths: + M /trunk/main/Configuration.pm + M /trunk/main/ExternalSocket.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/IrcIO.pm + M /trunk/main/LinedINETSocket.pm + M /trunk/main/Module.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/RunLoop.pm + M /trunk/main/Tiarra/SharedMixin.pm + M /trunk/main/Tiarra/Utils.pm + M /trunk/module/Client/Cotton.pm + A /trunk/module/Client/ProtectMyself.pm + M /trunk/module/Log/Writer/Base.pm + M /trunk/module/Log/Writer/File.pm + M /trunk/module/Log/Writer.pm + M /trunk/module/Tools/FileCache/EachFile.pm + M /trunk/module/Tools/HTTPClient.pm + +* Tiarra::SharedMixin->import gets shared-function names, and sync modules. + +* Tiarra::Utils: + - add _this from Tiarra::SharedMixin. + - add define_{function,attr_{accessor,getter,setter}}. + - add get_package. + +* use Tiarra::Utils->define_attr_*, ->cond_yesno. + +* IrcIO::Server->_receive_after_logged_in: set $msg->remark('message-send-by-others'). + +* add IrcIO->length. + +* add Client::ProtectMyself. + +* Tools::HTTPClient: + - fix typo. + - use CRLF as End-of-Line. + - pass $path instead of url(HTTP/1.0 maybe use this...). +------------------------------------------------------------------------ +r545 | topia | 2004-09-11 18:14:00 +0900 (Sat, 11 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/Utils.pm + +* add ->cond_yesno($str, $default). +------------------------------------------------------------------------ +r544 | topia | 2004-09-11 17:28:32 +0900 (Sat, 11 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Client/Guess.pm + +* use SharedMixin. +------------------------------------------------------------------------ +r543 | topia | 2004-09-11 17:27:55 +0900 (Sat, 11 Sep 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* sync new style. +------------------------------------------------------------------------ +r542 | topia | 2004-09-11 17:26:06 +0900 (Sat, 11 Sep 2004) | 30 lines +Changed paths: + M /trunk/main/BulletinBoard.pm + M /trunk/main/Configuration.pm + M /trunk/main/Hook.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/IrcIO.pm + M /trunk/main/LocalChannelManager.pm + M /trunk/main/Module.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/RunLoop.pm + A /trunk/main/Tiarra/ShorthandConfMixin.pm + A /trunk/main/Tiarra/Utils.pm + +* can call with package->[class or singleton object method]. + +* can use _runloop, _mod_manager, _conf* family. + +* get rid of some package->shared. + - But RunLoop->notify_*,terminate should call as class method... + - Also ModuleManager->timestamp. + - Maybe these modules need seperate... + +* add Configuration->find_module_conf($modname, 'block'). + +* Configuration->_complete_*_with_defaults change to class method, overrideable. + +* add IrcIO::Client->option_or_default, IrcIO::Client->option_or_default_multiple. + +* add IrcIO::Server->config_or_default. + +* add RPL_HELLO to ignore while logging in(for 2.11). + +* add runloop to constructor params. + - IrcIO + - ModuleManager + +* add config to RunLoop constructor params. + +* get rid of un-necessary string-eval(use symbolic reference). + +* remove unnessessary use. + +* whitespace fixes. +------------------------------------------------------------------------ +r541 | topia | 2004-09-10 17:30:26 +0900 (Fri, 10 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Client/PatchworkMessage.pm + +* add X-Chat(not tested). +------------------------------------------------------------------------ +r540 | topia | 2004-09-10 17:29:31 +0900 (Fri, 10 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Auto/Alias.pm + M /trunk/module/Auto/Calc.pm + M /trunk/module/Auto/ChannelWithoutOper.pm + M /trunk/module/Auto/Joined.pm + M /trunk/module/Auto/Oper.pm + M /trunk/module/Auto/Random.pm + M /trunk/module/Auto/Reply.pm + M /trunk/module/Auto/Response.pm + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Channel/Join/Connect.pm + M /trunk/module/Channel/Mode/Get.pm + M /trunk/module/Channel/Mode/Oper/Grant.pm + M /trunk/module/Channel/Rejoin.pm + M /trunk/module/Defence.pm + M /trunk/module/Log/Channel.pm + M /trunk/module/Log/ChannelList.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/System/Macro.pm + M /trunk/module/System/NotifyIcon/Win32.pm + M /trunk/module/User/Kick.pm + M /trunk/module/User/ServerOper.pm + +* update to new constructor. +------------------------------------------------------------------------ +r539 | topia | 2004-09-10 17:16:13 +0900 (Fri, 10 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Tools/FileCache.pm + +* can class->[all methods]. +------------------------------------------------------------------------ +r538 | topia | 2004-09-10 15:56:08 +0900 (Fri, 10 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/SharedMixin.pm + +* can call ->shared with argument for only initialize!(bad design...). +------------------------------------------------------------------------ +r537 | topia | 2004-09-10 00:23:49 +0900 (Fri, 10 Sep 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* add threads::shared for thread modules. +------------------------------------------------------------------------ +r536 | topia | 2004-09-07 19:28:13 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Auto/AliasDB.pm + +* use __PACKAGE__. +------------------------------------------------------------------------ +r535 | topia | 2004-09-07 19:21:22 +0900 (Tue, 07 Sep 2004) | 3 lines +Changed paths: + M /trunk/module/Auto/AliasDB.pm + M /trunk/module/Tools/MailSend.pm + +* use Tiarra::SharedMixin; + +* fix ->setfile broken. +------------------------------------------------------------------------ +r534 | topia | 2004-09-07 19:20:27 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/SharedMixin.pm + +* whitespace tweak. +------------------------------------------------------------------------ +r533 | topia | 2004-09-07 19:13:14 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Auto/AliasDB/CallbackUtils.pm + M /trunk/module/Auto/AliasDB.pm + M /trunk/module/Auto/CacheManager.pm + M /trunk/module/System/Inflate.pm + M /trunk/module/Tools/FileCache.pm + +* use Tiarra::SharedMixin. +------------------------------------------------------------------------ +r532 | topia | 2004-09-07 19:05:57 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/main/BulletinBoard.pm + M /trunk/main/Configuration.pm + M /trunk/main/LocalChannelManager.pm + M /trunk/main/ModuleManager.pm + +* use Tiarra::SharedMixin. +------------------------------------------------------------------------ +r531 | topia | 2004-09-07 18:59:22 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* use Tiarra::SharedMixin. +------------------------------------------------------------------------ +r530 | topia | 2004-09-07 18:58:49 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Tiarra/SharedMixin.pm + +* add usage comment. +------------------------------------------------------------------------ +r529 | topia | 2004-09-07 18:47:43 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Log/Writer.pm + +* use Tiarra::SharedMixin. +------------------------------------------------------------------------ +r528 | topia | 2004-09-07 18:46:51 +0900 (Tue, 07 Sep 2004) | 2 lines +Changed paths: + M /trunk/module/Log/Writer/Base.pm + M /trunk/module/Log/Writer/File.pm + +* fix parent->register_as_* bug. + - these call should be after definitions. +------------------------------------------------------------------------ +r527 | topia | 2004-09-07 18:44:58 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + A /trunk/main/Tiarra + A /trunk/main/Tiarra/SharedMixin.pm + +* add. shared instance mix-in. +------------------------------------------------------------------------ +r526 | topia | 2004-09-07 12:49:28 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Configuration/LexicalAnalyzer.pm + +* fix typo(contenxt -> context). +------------------------------------------------------------------------ +r525 | topia | 2004-09-07 12:47:24 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/module/Skelton.pm + +* ->message_arrived: message variable rename to msg. +------------------------------------------------------------------------ +r524 | topia | 2004-09-07 12:02:46 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* use runloop->default_network. +------------------------------------------------------------------------ +r523 | topia | 2004-09-07 12:01:45 +0900 (Tue, 07 Sep 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* add ->default_network. +------------------------------------------------------------------------ +r522 | topia | 2004-09-07 11:59:12 +0900 (Tue, 07 Sep 2004) | 3 lines +Changed paths: + M /trunk/main/IRCMessage.pm + +* use Time::HiRes::time if possible. + +* call _parse_prefix on prefix update. +------------------------------------------------------------------------ +r521 | topia | 2004-09-07 11:58:46 +0900 (Tue, 07 Sep 2004) | 7 lines +Changed paths: + M /trunk/tiarra + +* split main to function; do exit main(). + +* add follow_symlink. + +* add threads and Time::HiRes to optional module check. + +* tweak check_changelog(follow symlink, kill $line temporary variable; use $_). +------------------------------------------------------------------------ +r519 | topia | 2004-09-05 08:22:26 +0900 (Sun, 05 Sep 2004) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + +* add ->time (creation). +------------------------------------------------------------------------ +r518 | topia | 2004-09-05 07:58:15 +0900 (Sun, 05 Sep 2004) | 2 lines +Changed paths: + M /trunk/module/System/NotifyIcon/Win32.pm + +* enable trying Win32::API(temporary). + - don't work >= 64 chars tooltip. +------------------------------------------------------------------------ +r517 | topia | 2004-08-28 19:27:36 +0900 (Sat, 28 Aug 2004) | 1 line +Changed paths: + M /trunk/module/System/Reload.pm + +* cosmetic fixes. +------------------------------------------------------------------------ +r516 | topia | 2004-08-28 19:13:54 +0900 (Sat, 28 Aug 2004) | 1 line +Changed paths: + M /trunk/common/run-script/rc-onces/remove-log.sh + M /trunk/run + +* add append_spec to REDIR_STD{OUT,ERR}. +------------------------------------------------------------------------ +r515 | topia | 2004-08-28 13:01:05 +0900 (Sat, 28 Aug 2004) | 1 line +Changed paths: + M /trunk/run + +* cosmetic fix. +------------------------------------------------------------------------ +r514 | topia | 2004-08-28 12:44:54 +0900 (Sat, 28 Aug 2004) | 1 line +Changed paths: + M /trunk/doc/module/Client.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen. +------------------------------------------------------------------------ +r513 | topia | 2004-08-28 12:42:34 +0900 (Sat, 28 Aug 2004) | 3 lines +Changed paths: + M /trunk/main/NumericReply.pm + +* add 'require Exporter'. + +* small style change. +------------------------------------------------------------------------ +r512 | topia | 2004-08-28 12:41:13 +0900 (Sat, 28 Aug 2004) | 3 lines +Changed paths: + A /trunk/module/Client/PatchworkMessage.pm (from /trunk/module/Client/WoolChat.pm:506) + D /trunk/module/Client/WoolChat.pm + +* rename Client::WoolChat -> Client::PatchworkMessage. + +* use Client::Guess. +------------------------------------------------------------------------ +r511 | topia | 2004-08-27 22:54:44 +0900 (Fri, 27 Aug 2004) | 1 line +Changed paths: + M /trunk/doc/module/System.html + M /trunk/sample.conf + +* regen. +------------------------------------------------------------------------ +r510 | topia | 2004-08-27 22:20:04 +0900 (Fri, 27 Aug 2004) | 3 lines +Changed paths: + M /trunk/module/System/Reload.pm + +* add broadcast-command. + +* use Mask::match. +------------------------------------------------------------------------ +r509 | topia | 2004-08-23 13:15:37 +0900 (Mon, 23 Aug 2004) | 5 lines +Changed paths: + M /trunk/module/Client/Guess.pm + +* add CHOCOA/Liece/madoka/Riece. + +* rename version -> ver, platver -> plat_ver, and friends. + +* assume xchat/{arch,cpu_speed}. cpu_speed is not recommended. +------------------------------------------------------------------------ +r508 | topia | 2004-08-23 09:59:52 +0900 (Mon, 23 Aug 2004) | 1 line +Changed paths: + A /trunk/module/Client/Guess.pm + +* add. guess clients type. +------------------------------------------------------------------------ +r507 | topia | 2004-08-22 20:56:38 +0900 (Sun, 22 Aug 2004) | 1 line +Changed paths: + M /trunk/doc/module/Client.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen doc. +------------------------------------------------------------------------ +r506 | topia | 2004-08-22 20:48:46 +0900 (Sun, 22 Aug 2004) | 1 line +Changed paths: + A /trunk/module/Client/WoolChat.pm + +* initial import of Client::WoolChat. +------------------------------------------------------------------------ +r505 | topia | 2004-08-22 20:37:47 +0900 (Sun, 22 Aug 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r501 | topia | 2004-08-22 20:22:09 +0900 (Sun, 22 Aug 2004) | 1 line +Changed paths: + M /trunk/HACKING + M /trunk/main/IRCMessage.pm + +* add IRCMessage/remark/always-use-colon-on-last-param. +------------------------------------------------------------------------ +r500 | topia | 2004-08-22 18:42:55 +0900 (Sun, 22 Aug 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* add version to default quit msg. +------------------------------------------------------------------------ +r499 | topia | 2004-08-22 18:24:21 +0900 (Sun, 22 Aug 2004) | 5 lines +Changed paths: + M /trunk/doc/module/Client.html + M /trunk/module/Client/Rehash.pm + M /trunk/sample.conf + M /trunk/tiarra + +* call module_manager->terminate on force exit. + +* detail explain on rehash-nick. + +* regen doc. +------------------------------------------------------------------------ +r498 | topia | 2004-08-22 16:08:05 +0900 (Sun, 22 Aug 2004) | 1 line +Changed paths: + M /trunk/doc/module/System.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen doc. +------------------------------------------------------------------------ +r497 | topia | 2004-08-22 16:07:17 +0900 (Sun, 22 Aug 2004) | 1 line +Changed paths: + M /trunk/makedoc + +* set stdout_charset to utf-8. +------------------------------------------------------------------------ +r496 | topia | 2004-08-22 16:06:32 +0900 (Sun, 22 Aug 2004) | 1 line +Changed paths: + M /trunk/main/TiarraDoc.pm + +* (_makeconf): get rid of indent on blank line. +------------------------------------------------------------------------ +r495 | topia | 2004-08-22 16:01:36 +0900 (Sun, 22 Aug 2004) | 39 lines +Changed paths: + M /trunk/doc-src/conf-main.tdoc + M /trunk/main/Configuration.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/IrcIO.pm + M /trunk/main/RunLoop.pm + +* add conf entries and these default values. + - general/messages/quit/netconf-changed-{re,dis}connect. + +* add and use runloop->{,un}register_receive_socket(@socks). + - register on IO / unregister on IO->disconnect. + - unregister on RunLoop on accidental disconnection. + +* add IrcIO::Server->state. + - store (next) state of network. + +* add and use Configuration::shared_conf->... shorthands. + - runloop->_conf. + - runloop->_conf_{general,networks,messages}. + +* add runloop->{terminated_networks}. + +* rename wrong englishes. + - runloop->{do_terminate} to runloop->{terminating}. + - runloop->exit_client to runloop->close_client. + - runloop->exit_server to runloop->terminate_server. + +* runloop->network become to search all networks genre. + - on wantarray, also return genre to find out this. + +* runloop->_cleanup_closed_link: guess state reconnecting/terminating/finalizing. + - on reconnecting: move to disconnected_networks. + - on terminating: move to terminated_networks. + - on finalizing: remove network. + +* runloop->terminate_server: set state to terminating and send quit. + +* add runloop->reconnect_server. + - reconnect to {terminated,disconnected}_network. + +* count terminating loop rounds. + - exit force on >= 400. + +* get rid of jumbo comment out(=pod, =cut). + - we've using SCM(CVS, Subversion, and so on); use this to see past source. +------------------------------------------------------------------------ +r494 | topia | 2004-08-22 15:21:46 +0900 (Sun, 22 Aug 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + +* get rid of network not found warnings(on debug); these are not special case. +------------------------------------------------------------------------ +r493 | topia | 2004-08-22 15:16:37 +0900 (Sun, 22 Aug 2004) | 1 line +Changed paths: + A /trunk/module/System/Error.pm + +* add System::Error. +------------------------------------------------------------------------ +r492 | topia | 2004-08-22 15:07:27 +0900 (Sun, 22 Aug 2004) | 2 lines +Changed paths: + M /trunk/module/Skelton.pm + +(message_io_hook) +* change participle(past -> present) on comment. +------------------------------------------------------------------------ +r491 | topia | 2004-08-21 21:36:07 +0900 (Sat, 21 Aug 2004) | 3 lines +Changed paths: + M /trunk/HACKING + +* explain ModuleManager(blacklist) / Hook(general). + +* add RunLoop->shared_loop->{attach_for_client,terminate}. +------------------------------------------------------------------------ +r488 | topia | 2004-08-21 20:41:35 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/run + M /trunk/run-subr + +* fix set dir location. +------------------------------------------------------------------------ +r486 | topia | 2004-08-21 18:56:12 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/.tiarrarc + M /trunk/run + +* add tiarraarg. +------------------------------------------------------------------------ +r485 | topia | 2004-08-21 18:34:55 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/main/Configuration/Preprocessor.pm + +* fix wrong exception statements of define description. +------------------------------------------------------------------------ +r484 | topia | 2004-08-21 18:13:54 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/module/Log/Channel.pm + +* fix undefined error on $writer->register. +------------------------------------------------------------------------ +r483 | topia | 2004-08-21 17:27:08 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/doc/module/Auto.html + M /trunk/doc/module/CTCP.html + M /trunk/doc/module/Channel.html + M /trunk/doc/module/Client.html + M /trunk/doc/module/Debug.html + M /trunk/doc/module/Log.html + M /trunk/doc/module/System.html + M /trunk/doc/module/User.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen documents. +------------------------------------------------------------------------ +r482 | topia | 2004-08-21 16:16:52 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/module/Log/Channel.pm + A /trunk/module/Log/Writer + A /trunk/module/Log/Writer/Base.pm + A /trunk/module/Log/Writer/File.pm + A /trunk/module/Log/Writer.pm + +* add and use Log::Writer structure. +------------------------------------------------------------------------ +r481 | topia | 2004-08-21 14:42:57 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/main/ModuleManager.pm + M /trunk/main/RunLoop.pm + M /trunk/module/System/Shutdown.pm + M /trunk/tiarra + +* implement RunLoop->shared_loop->terminate($msg)! +------------------------------------------------------------------------ +r480 | topia | 2004-08-21 14:41:05 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/module/Client/Eval.pm + +* clean-up params join. +------------------------------------------------------------------------ +r479 | topia | 2004-08-21 08:55:47 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/.tiarrarc + M /trunk/AUTHORS + M /trunk/ChangeLog + M /trunk/HACKING + M /trunk/LICENSE + M /trunk/NEWS + M /trunk/common/run-script/add-rc-once.sh + M /trunk/common/run-script/rc-onces/remove-log.sh + M /trunk/doc/default.css + M /trunk/doc/module/Auto.html + M /trunk/doc/module/CTCP.html + M /trunk/doc/module/Channel.html + M /trunk/doc/module/Client.html + M /trunk/doc/module/Debug.html + M /trunk/doc/module/Log.html + M /trunk/doc/module/System.html + M /trunk/doc/module/User.html + M /trunk/doc/module-toc.html + M /trunk/doc-src/README + M /trunk/doc-src/conf-main.tdoc + M /trunk/doc-src/contents.html + M /trunk/doc-src/module-group.tdoc + M /trunk/doc-src/module-toc.html + M /trunk/doc-src/sample.conf.in + M /trunk/filelist.cgi + M /trunk/filelist.cgi.txt + M /trunk/main/BulletinBoard.pm + M /trunk/main/CTCP.pm + M /trunk/main/ChannelInfo.pm + M /trunk/main/Configuration/Block.pm + M /trunk/main/Configuration/LexicalAnalyzer.pm + M /trunk/main/Configuration/Parser.pm + M /trunk/main/Configuration/Preprocessor.pm + M /trunk/main/Configuration.pm + M /trunk/main/ControlPort.pm + M /trunk/main/Crypt.pm + M /trunk/main/Exception.pm + M /trunk/main/ExternalSocket.pm + M /trunk/main/FunctionalVariable.pm + M /trunk/main/Hook.pm + M /trunk/main/IRCMessage.pm + M /trunk/main/InstantCapsule.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/IrcIO.pm + M /trunk/main/Iterator/ArrayIterator.pm + M /trunk/main/Iterator/BackwardIterator.pm + M /trunk/main/Iterator/BidirectionalIterator.pm + M /trunk/main/Iterator/ForwardIterator.pm + M /trunk/main/Iterator/RandomAccessIterator.pm + M /trunk/main/Iterator/RoundIterator.pm + M /trunk/main/Iterator.pm + M /trunk/main/L10N.pm + M /trunk/main/LinedINETSocket.pm + M /trunk/main/LocalChannelManager.pm + M /trunk/main/Mask.pm + M /trunk/main/Module/Use.pm + M /trunk/main/Module.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/Multicast.pm + M /trunk/main/NumericReply.pm + M /trunk/main/PersonInChannel.pm + M /trunk/main/PersonalInfo.pm + M /trunk/main/ReloadTrigger.pm + M /trunk/main/RunLoop.pm + M /trunk/main/Template.pm + M /trunk/main/TiarraDoc.pm + M /trunk/main/Timer.pm + M /trunk/makedoc + M /trunk/module/Auto/Alias.pm + M /trunk/module/Auto/AliasDB/CallbackUtils.pm + M /trunk/module/Auto/AliasDB.pm + M /trunk/module/Auto/Answer.pm + M /trunk/module/Auto/CacheManager.pm + M /trunk/module/Auto/Calc.pm + M /trunk/module/Auto/ChannelWithoutOper.pm + M /trunk/module/Auto/Joined.pm + M /trunk/module/Auto/MesMail.pm + M /trunk/module/Auto/Oper.pm + M /trunk/module/Auto/Random.pm + M /trunk/module/Auto/Reply.pm + M /trunk/module/Auto/Response.pm + M /trunk/module/Auto/Utils.pm + M /trunk/module/CTCP/ClientInfo.pm + M /trunk/module/CTCP/Ping.pm + M /trunk/module/CTCP/Time.pm + M /trunk/module/CTCP/UserInfo.pm + M /trunk/module/CTCP/Version.pm + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Channel/Join/Connect.pm + M /trunk/module/Channel/Join/Invite.pm + M /trunk/module/Channel/Join/Kicked.pm + M /trunk/module/Channel/Mode/Get.pm + M /trunk/module/Channel/Mode/Oper/Grant.pm + M /trunk/module/Channel/Mode/Set.pm + M /trunk/module/Channel/Rejoin.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Client/Cotton.pm + M /trunk/module/Client/Eval.pm + M /trunk/module/Client/GetVersion.pm + M /trunk/module/Client/Rehash.pm + M /trunk/module/Client/ShowNick.pm + M /trunk/module/Debug/AliasTest.pm + M /trunk/module/Debug/RawLog.pm + M /trunk/module/Defence/Buffer.pm + M /trunk/module/Defence/ChannelConf.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence/Logger.pm + M /trunk/module/Defence/RSA.pm + M /trunk/module/Defence/Whistle.pm + M /trunk/module/Defence/genkey.pl + M /trunk/module/Defence.pm + M /trunk/module/Log/Channel.pm + M /trunk/module/Log/ChannelList.pm + M /trunk/module/Log/Logger.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/Skelton.pm + M /trunk/module/System/Inflate/Gzip.pm + M /trunk/module/System/Inflate/Zlib.pm + M /trunk/module/System/Inflate.pm + M /trunk/module/System/Macro.pm + M /trunk/module/System/NotifyIcon/Win32.pm + M /trunk/module/System/Pong.pm + M /trunk/module/System/PrivTranslator.pm + M /trunk/module/System/Raw.pm + M /trunk/module/System/Reload.pm + M /trunk/module/System/RemoteControl.pm + M /trunk/module/System/Shutdown.pm + M /trunk/module/Tools/DateConvert.pm + M /trunk/module/Tools/FileCache/EachFile.pm + M /trunk/module/Tools/FileCache.pm + M /trunk/module/Tools/GroupDB.pm + M /trunk/module/Tools/HTTPClient.pm + M /trunk/module/Tools/HashDB.pm + M /trunk/module/Tools/HashTools.pm + M /trunk/module/Tools/LinedDB.pm + M /trunk/module/Tools/MailSend/EachServer.pm + M /trunk/module/Tools/MailSend.pm + M /trunk/module/User/Away/Client.pm + M /trunk/module/User/Away/Nick.pm + M /trunk/module/User/Filter.pm + M /trunk/module/User/Ignore.pm + M /trunk/module/User/Kick.pm + M /trunk/module/User/Nick/Detached.pm + M /trunk/module/User/ServerOper.pm + M /trunk/module/User/Vanish.pm + M /trunk/run + M /trunk/run-subr + M /trunk/runtiarra.perl + M /trunk/sample.conf + M /trunk/status/merged-tag + M /trunk/test/dateconvert-test.perl + M /trunk/test/inflate-test.perl + M /trunk/tiarra + M /trunk/tiarra-conf.el + M /trunk/tiarra-conf.l + M /trunk/tools/archive.perl + M /trunk/tools/ezpack.config + M /trunk/tools/merge.sh + M /trunk/tools/update.sh + M /trunk/web/archive/archives.list + M /trunk/web/index.html.ja.utf8.tmpl + M /trunk/web/index.rdf.ja.utf8.tmpl + +* set correct svn:eol-style. +------------------------------------------------------------------------ +r476 | topia | 2004-08-21 08:38:11 +0900 (Sat, 21 Aug 2004) | 7 lines +Changed paths: + M /trunk/module/Tools/FileCache/EachFile.pm + M /trunk/module/Tools/FileCache.pm + +* fix header comment. + +* add 'use Carp'. + +* funcname change; inspired by foobar2000 service structure. + - add_refcount -> add_ref. + - del_refcount -> release. +------------------------------------------------------------------------ +r475 | topia | 2004-08-21 08:26:11 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/module/Auto/Calc.pm + +* revert very restrict permission. +------------------------------------------------------------------------ +r474 | topia | 2004-08-21 08:23:32 +0900 (Sat, 21 Aug 2004) | 2 lines +Changed paths: + M /trunk/main/Multicast.pm + +* add _NOTICE_from_server, and use this on NOTICE or PRIVMSG. + * fix wrong g2l on NOTICE/PRIVMSG's message. +------------------------------------------------------------------------ +r473 | topia | 2004-08-21 08:19:30 +0900 (Sat, 21 Aug 2004) | 1 line +Changed paths: + M /trunk/main/ModuleManager.pm + +* add _clear_module_cache call. +------------------------------------------------------------------------ +r472 | topia | 2004-08-10 05:57:26 +0900 (Tue, 10 Aug 2004) | 1 line +Changed paths: + M /trunk/module/Client/Rehash.pm + +* add svn:keywords +------------------------------------------------------------------------ +r471 | topia | 2004-08-10 05:52:38 +0900 (Tue, 10 Aug 2004) | 1 line +Changed paths: + A /trunk/module/Client/Rehash.pm + +* add. +------------------------------------------------------------------------ +r468 | topia | 2004-08-10 04:29:44 +0900 (Tue, 10 Aug 2004) | 1 line +Changed paths: + A /trunk/.tiarrarc + M /trunk/run + +* move some site-specific variable to .tiarrarc. +------------------------------------------------------------------------ +r467 | topia | 2004-08-10 04:29:05 +0900 (Tue, 10 Aug 2004) | 3 lines +Changed paths: + M /trunk/run + +* add REDIR_STDIN. + +* use eval to make command line. +------------------------------------------------------------------------ +r466 | topia | 2004-08-10 04:27:25 +0900 (Tue, 10 Aug 2004) | 1 line +Changed paths: + M /trunk/run + M /trunk/run-subr + +* add once-load rc filename. +------------------------------------------------------------------------ +r465 | topia | 2004-08-10 03:41:41 +0900 (Tue, 10 Aug 2004) | 1 line +Changed paths: + M /trunk/doc/module/Auto.html + M /trunk/doc/module/Client.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen. +------------------------------------------------------------------------ +r464 | topia | 2004-08-09 18:31:46 +0900 (Mon, 09 Aug 2004) | 1 line +Changed paths: + M /trunk/run + +* add daemon mode. +------------------------------------------------------------------------ +r463 | topia | 2004-08-09 13:50:26 +0900 (Mon, 09 Aug 2004) | 1 line +Changed paths: + M /trunk/module/Client/ShowNick.pm + +* minor fix. +------------------------------------------------------------------------ +r462 | topia | 2004-08-09 13:49:11 +0900 (Mon, 09 Aug 2004) | 3 lines +Changed paths: + M /trunk/main/ModuleManager.pm + +* use undef on module-reload. + +* do clear_module_cache on post module-reload. +------------------------------------------------------------------------ +r461 | topia | 2004-08-08 02:44:32 +0900 (Sun, 08 Aug 2004) | 1 line +Changed paths: + M /trunk/module/Auto/Utils.pm + +* use Multicast::attach_for_client. +------------------------------------------------------------------------ +r460 | topia | 2004-08-08 00:56:12 +0900 (Sun, 08 Aug 2004) | 1 line +Changed paths: + M /trunk/run + M /trunk/run-subr + +* fix DEBUG check. +------------------------------------------------------------------------ +r459 | topia | 2004-08-08 00:26:58 +0900 (Sun, 08 Aug 2004) | 3 lines +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* add ->username, ->client_host. + +* split do_namreply from inform_joinning_channels/$send_channelinfo. +------------------------------------------------------------------------ +r458 | topia | 2004-08-08 00:25:26 +0900 (Sun, 08 Aug 2004) | 3 lines +Changed paths: + M /trunk/main/RunLoop.pm + +* use Multicast::attach_for_client. + +* use Module blacklist on apply_filters' error notify. +------------------------------------------------------------------------ +r457 | topia | 2004-08-07 23:33:14 +0900 (Sat, 07 Aug 2004) | 3 lines +Changed paths: + M /trunk/run + M /trunk/run-subr + +* add svn:keywords and Id keyword. + +* add copyright. +------------------------------------------------------------------------ +r456 | topia | 2004-08-07 23:30:39 +0900 (Sat, 07 Aug 2004) | 1 line +Changed paths: + M /trunk/run + A /trunk/run-subr + +* rewrite run script. +------------------------------------------------------------------------ +r455 | topia | 2004-08-07 23:05:45 +0900 (Sat, 07 Aug 2004) | 1 line +Changed paths: + M /trunk/HACKING + +* whitespace fix. +------------------------------------------------------------------------ +r454 | topia | 2004-08-07 20:01:07 +0900 (Sat, 07 Aug 2004) | 1 line +Changed paths: + M /trunk/main/ModuleManager.pm + +* implement blacklist. +------------------------------------------------------------------------ +r453 | topia | 2004-08-07 19:57:46 +0900 (Sat, 07 Aug 2004) | 1 line +Changed paths: + M /trunk/main/Timer.pm + +* fix whitespace. +------------------------------------------------------------------------ +r452 | topia | 2004-08-07 18:08:55 +0900 (Sat, 07 Aug 2004) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* add attach_for_client($str, $network_name). +------------------------------------------------------------------------ +r451 | topia | 2004-08-06 13:09:54 +0900 (Fri, 06 Aug 2004) | 5 lines +Changed paths: + M /trunk/module/Auto/Calc.pm + +* add function and configuration. + - add timeout (alarm). + - add signal-format. + - add init. + - add permit-sub. +------------------------------------------------------------------------ +r449 | topia | 2004-08-01 10:45:23 +0900 (Sun, 01 Aug 2004) | 3 lines +Changed paths: + M /trunk/main/RunLoop.pm + +* add set-current-nick hook. + +* kill $mods(ModuleManager->shared_manager->get_modules) temporary variable. +------------------------------------------------------------------------ +r448 | topia | 2004-07-29 21:03:20 +0900 (Thu, 29 Jul 2004) | 1 line +Changed paths: + M /trunk/doc/module/Auto.html + M /trunk/doc/module/CTCP.html + M /trunk/doc/module/Channel.html + M /trunk/doc/module/Client.html + M /trunk/doc/module/Debug.html + M /trunk/doc/module/Log.html + M /trunk/doc/module/System.html + M /trunk/doc/module/User.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen. +------------------------------------------------------------------------ +r447 | topia | 2004-07-29 21:02:26 +0900 (Thu, 29 Jul 2004) | 3 lines +Changed paths: + M /trunk + M /trunk/Makefile + M /trunk/doc-src/README + M /trunk/doc-src/conf-main.tdoc + M /trunk/doc-src/contents.html + M /trunk/doc-src/module-group.tdoc + M /trunk/doc-src/module-toc.html + M /trunk/doc-src/sample.conf.in + M /trunk/filelist.cgi + M /trunk/filelist.cgi.txt + M /trunk/main/BulletinBoard.pm + M /trunk/main/CTCP.pm + M /trunk/main/ChannelInfo.pm + M /trunk/main/Configuration/Block.pm + M /trunk/main/Configuration/LexicalAnalyzer.pm + M /trunk/main/Configuration/Parser.pm + M /trunk/main/Configuration/Preprocessor.pm + M /trunk/main/Configuration.pm + M /trunk/main/ControlPort.pm + M /trunk/main/Crypt.pm + M /trunk/main/Exception.pm + M /trunk/main/ExternalSocket.pm + M /trunk/main/FunctionalVariable.pm + M /trunk/main/Hook.pm + M /trunk/main/IRCMessage.pm + M /trunk/main/InstantCapsule.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/IrcIO.pm + M /trunk/main/Iterator/ArrayIterator.pm + M /trunk/main/Iterator/BackwardIterator.pm + M /trunk/main/Iterator/BidirectionalIterator.pm + M /trunk/main/Iterator/ForwardIterator.pm + M /trunk/main/Iterator/RandomAccessIterator.pm + M /trunk/main/Iterator/RoundIterator.pm + M /trunk/main/Iterator.pm + M /trunk/main/L10N.pm + M /trunk/main/LinedINETSocket.pm + M /trunk/main/LocalChannelManager.pm + M /trunk/main/Mask.pm + M /trunk/main/Module/Use.pm + M /trunk/main/Module.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/Multicast.pm + M /trunk/main/NumericReply.pm + M /trunk/main/PersonInChannel.pm + M /trunk/main/PersonalInfo.pm + M /trunk/main/ReloadTrigger.pm + M /trunk/main/RunLoop.pm + M /trunk/main/Template.pm + M /trunk/main/TiarraDoc.pm + M /trunk/main/Timer.pm + M /trunk/main/Unicode/Japanese.pm + M /trunk/makedoc + M /trunk/module/Auto/Alias.pm + M /trunk/module/Auto/AliasDB/CallbackUtils.pm + M /trunk/module/Auto/AliasDB.pm + M /trunk/module/Auto/Answer.pm + M /trunk/module/Auto/CacheManager.pm + M /trunk/module/Auto/Calc.pm + M /trunk/module/Auto/ChannelWithoutOper.pm + M /trunk/module/Auto/Joined.pm + M /trunk/module/Auto/MesMail.pm + M /trunk/module/Auto/Oper.pm + M /trunk/module/Auto/Random.pm + M /trunk/module/Auto/Reply.pm + M /trunk/module/Auto/Response.pm + M /trunk/module/Auto/Utils.pm + M /trunk/module/CTCP/ClientInfo.pm + M /trunk/module/CTCP/Ping.pm + M /trunk/module/CTCP/Time.pm + M /trunk/module/CTCP/UserInfo.pm + M /trunk/module/CTCP/Version.pm + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Channel/Join/Connect.pm + M /trunk/module/Channel/Join/Invite.pm + M /trunk/module/Channel/Join/Kicked.pm + M /trunk/module/Channel/Mode/Get.pm + M /trunk/module/Channel/Mode/Oper/Grant.pm + M /trunk/module/Channel/Mode/Set.pm + M /trunk/module/Channel/Rejoin.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Client/Cotton.pm + M /trunk/module/Client/Eval.pm + M /trunk/module/Client/GetVersion.pm + M /trunk/module/Client/ShowNick.pm + M /trunk/module/Debug/AliasTest.pm + M /trunk/module/Debug/RawLog.pm + M /trunk/module/Defence/ChannelConf.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence/Logger.pm + M /trunk/module/Defence/RSA.pm + M /trunk/module/Defence/Whistle.pm + M /trunk/module/Defence.pm + M /trunk/module/Log/Channel.pm + M /trunk/module/Log/ChannelList.pm + M /trunk/module/Log/Logger.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/Skelton.pm + M /trunk/module/System/Inflate/Gzip.pm + M /trunk/module/System/Inflate/Zlib.pm + M /trunk/module/System/Inflate.pm + M /trunk/module/System/Macro.pm + M /trunk/module/System/Pong.pm + M /trunk/module/System/PrivTranslator.pm + M /trunk/module/System/Raw.pm + M /trunk/module/System/Reload.pm + M /trunk/module/System/RemoteControl.pm + M /trunk/module/System/Shutdown.pm + M /trunk/module/Tools/DateConvert.pm + M /trunk/module/Tools/FileCache/EachFile.pm + M /trunk/module/Tools/FileCache.pm + M /trunk/module/Tools/GroupDB.pm + M /trunk/module/Tools/HTTPClient.pm + M /trunk/module/Tools/HashDB.pm + M /trunk/module/Tools/HashTools.pm + M /trunk/module/Tools/LinedDB.pm + M /trunk/module/Tools/MailSend/EachServer.pm + M /trunk/module/Tools/MailSend.pm + M /trunk/module/User/Away/Client.pm + M /trunk/module/User/Away/Nick.pm + M /trunk/module/User/Filter.pm + M /trunk/module/User/Ignore.pm + M /trunk/module/User/Kick.pm + M /trunk/module/User/Nick/Detached.pm + M /trunk/module/User/ServerOper.pm + M /trunk/module/User/Vanish.pm + M /trunk/run + M /trunk/runtiarra.perl + M /trunk/test/dateconvert-test.perl + M /trunk/test/inflate-test.perl + M /trunk/tiarra + M /trunk/tiarra-conf.el + M /trunk/tiarra-conf.l + M /trunk/tools/archive.perl + M /trunk/tools/ezpack.config + M /trunk/tools/merge.sh + M /trunk/tools/update.sh + M /trunk/tools/upload.sh + M /trunk/web/archive + M /trunk/web/index.html.ja.utf8.tmpl + M /trunk/web/index.rdf.ja.utf8.tmpl + +* set keywords/ignore. + +* edit keywords line. +------------------------------------------------------------------------ +r444 | topia | 2004-07-29 17:51:06 +0900 (Thu, 29 Jul 2004) | 1 line +Changed paths: + M /trunk/doc/module/System.html + M /trunk/sample.conf + +* regen. +------------------------------------------------------------------------ +r443 | topia | 2004-07-29 16:48:42 +0900 (Thu, 29 Jul 2004) | 1 line +Changed paths: + M /trunk/module/System/NotifyIcon/Win32.pm + +* add hide-console-on-load config entry. +------------------------------------------------------------------------ +r442 | topia | 2004-07-29 16:36:07 +0900 (Thu, 29 Jul 2004) | 1 line +Changed paths: + M /trunk/module/System/NotifyIcon/Win32.pm + +* can specify icon path. +------------------------------------------------------------------------ +r440 | topia | 2004-07-29 15:40:48 +0900 (Thu, 29 Jul 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/HACKING + M /trunk/Makefile + M /trunk/NEWS + M /trunk/main/ControlPort.pm + M /trunk/main/Module/Use.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/Timer.pm + M /trunk/module/Auto/Utils.pm + M /trunk/module/Client/Eval.pm + A /trunk/module/Defence/Buffer.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + M /trunk/module/System/NotifyIcon/Win32.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r433 | topia | 2004-07-29 14:22:28 +0900 (Thu, 29 Jul 2004) | 1 line +Changed paths: + M /trunk/doc/module/Auto.html + M /trunk/doc/module/System.html + M /trunk/doc/module/User.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen. +------------------------------------------------------------------------ +r432 | topia | 2004-07-29 14:20:14 +0900 (Thu, 29 Jul 2004) | 1 line +Changed paths: + A /trunk/module/System/NotifyIcon + A /trunk/module/System/NotifyIcon/Win32.pm + +* add. +------------------------------------------------------------------------ +r431 | topia | 2004-07-28 19:20:27 +0900 (Wed, 28 Jul 2004) | 1 line +Changed paths: + M /trunk/module/Tools/FileCache.pm + +* use __PACKAGE__ instead of raw package name. +------------------------------------------------------------------------ +r430 | topia | 2004-07-28 19:19:17 +0900 (Wed, 28 Jul 2004) | 1 line +Changed paths: + M /trunk/module/Client/Eval.pm + +* add some useful functions. +------------------------------------------------------------------------ +r429 | topia | 2004-07-28 19:18:27 +0900 (Wed, 28 Jul 2004) | 1 line +Changed paths: + M /trunk/main/Module/Use.pm + +* use push instead of set for @pkg::USE. +------------------------------------------------------------------------ +r428 | topia | 2004-07-28 19:14:16 +0900 (Wed, 28 Jul 2004) | 5 lines +Changed paths: + M /trunk/main/ModuleManager.pm + +* fix typo (->notify_error->(...) => ->notify_error(...)). + +* use Symbol::delete_package to ->_unload. + +* fix used-module marking bug on reload-module. +------------------------------------------------------------------------ +r427 | topia | 2004-07-28 19:09:15 +0900 (Wed, 28 Jul 2004) | 1 line +Changed paths: + M /trunk/main/Timer.pm + +* add ->reset to re-calculate fire_time from now time. +------------------------------------------------------------------------ +r426 | topia | 2004-07-24 02:27:57 +0900 (Sat, 24 Jul 2004) | 7 lines +Changed paths: + M /trunk/module/Auto/Utils.pm + +* fix comment to describe function/arg. + +* be able to sendto_channel_closure($sendto, $command)! + - auto sending with broadcast_to_clients. + - auto examine sender network. + +* fix bug on single_server_mode. +------------------------------------------------------------------------ +r425 | topia | 2004-07-24 02:17:20 +0900 (Sat, 24 Jul 2004) | 5 lines +Changed paths: + M /trunk/HACKING + +* add Auto::Utils::sendto_channel_closure(...). + +* mention about remark(overview). + +* mention that IrcIO::Server->remark didn't cleared on reconnect. +------------------------------------------------------------------------ +r424 | topia | 2004-07-23 23:42:00 +0900 (Fri, 23 Jul 2004) | 1 line +Changed paths: + M /trunk/main/ControlPort.pm + +* disable SelfLoader. +------------------------------------------------------------------------ +r423 | topia | 2004-07-22 02:06:10 +0900 (Thu, 22 Jul 2004) | 1 line +Changed paths: + M /trunk/run + +* add PERL/PERLARG. +------------------------------------------------------------------------ +r422 | topia | 2004-07-22 02:01:20 +0900 (Thu, 22 Jul 2004) | 1 line +Changed paths: + A /trunk/run + +* test run script. +------------------------------------------------------------------------ +r414 | topia | 2004-07-09 23:40:52 +0900 (Fri, 09 Jul 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/module/Auto/Reply.pm + M /trunk/module/Defence.pm + M /trunk/module/User/ServerOper.pm + M /trunk/module/User/Vanish.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r411 | topia | 2004-07-09 00:17:00 +0900 (Fri, 09 Jul 2004) | 1 line +Changed paths: + M /trunk/doc/module/System.html + M /trunk/sample.conf + +* regen document. +------------------------------------------------------------------------ +r409 | topia | 2004-07-09 00:14:03 +0900 (Fri, 09 Jul 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/Configuration/Preprocessor.pm + M /trunk/main/Configuration.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/Mask.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/ReloadTrigger.pm + M /trunk/main/Timer.pm + M /trunk/module/System/Reload.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r406 | topia | 2004-07-08 23:52:25 +0900 (Thu, 08 Jul 2004) | 3 lines +Changed paths: + M /trunk/main/Configuration/Preprocessor.pm + M /trunk/main/Configuration.pm + +* add Configuration::Preprocessor->included_files. + +* check updates of all included files. +------------------------------------------------------------------------ +r405 | topia | 2004-07-08 23:51:01 +0900 (Thu, 08 Jul 2004) | 1 line +Changed paths: + M /trunk/main/ModuleManager.pm + +* use notify_error on error reload_modules_if_modified/reload-process. +------------------------------------------------------------------------ +r404 | topia | 2004-07-08 23:49:22 +0900 (Thu, 08 Jul 2004) | 1 line +Changed paths: + M /trunk/main/ReloadTrigger.pm + +* mention Configuration::Hook/reloaded. +------------------------------------------------------------------------ +r403 | topia | 2004-07-08 23:48:47 +0900 (Thu, 08 Jul 2004) | 1 line +Changed paths: + M /trunk/main/Timer.pm + +* fix typo on notify_error. +------------------------------------------------------------------------ +r402 | topia | 2004-07-08 23:48:11 +0900 (Thu, 08 Jul 2004) | 1 line +Changed paths: + M /trunk/module/System/Reload.pm + +* add conf-reloaded-notify. +------------------------------------------------------------------------ +r401 | topia | 2004-06-24 01:22:57 +0900 (Thu, 24 Jun 2004) | 1 line +Changed paths: + M /trunk/main/Mask.pm + +* defined check on _split. +------------------------------------------------------------------------ +r400 | topia | 2004-06-20 05:19:23 +0900 (Sun, 20 Jun 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* do not last for send all-matching channels. +------------------------------------------------------------------------ +r399 | topia | 2004-06-20 05:07:57 +0900 (Sun, 20 Jun 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* check defined of default network. +------------------------------------------------------------------------ +r398 | topia | 2004-06-19 18:36:45 +0900 (Sat, 19 Jun 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/doc-src/conf-main.tdoc + M /trunk/main/Timer.pm + M /trunk/module/Channel/Mode/Oper/Grant.pm + M /trunk/module/Client/Cotton.pm + M /trunk/module/Client/Eval.pm + M /trunk/module/Client/GetVersion.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r394 | topia | 2004-06-19 18:22:51 +0900 (Sat, 19 Jun 2004) | 1 line +Changed paths: + M /trunk/doc/module/Client.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen doc. +------------------------------------------------------------------------ +r393 | topia | 2004-06-19 18:05:20 +0900 (Sat, 19 Jun 2004) | 1 line +Changed paths: + M /trunk/doc-src/conf-main.tdoc + +* mension ./tiarra --make-password. +------------------------------------------------------------------------ +r392 | topia | 2004-06-19 18:02:02 +0900 (Sat, 19 Jun 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cotton.pm + +* remove no-cotton client option. +------------------------------------------------------------------------ +r391 | topia | 2004-06-19 17:58:04 +0900 (Sat, 19 Jun 2004) | 3 lines +Changed paths: + A /trunk/module/Client/Cotton.pm + +* add. work-arounds for Cotton(or Unknown?) client. + - stop auto-part after rejoin. + +------------------------------------------------------------------------ +r390 | topia | 2004-06-19 17:56:00 +0900 (Sat, 19 Jun 2004) | 1 line +Changed paths: + A /trunk/module/Client/GetVersion.pm + +* add. get clients' CTCP Version value. +------------------------------------------------------------------------ +r389 | topia | 2004-06-19 14:59:11 +0900 (Sat, 19 Jun 2004) | 1 line +Changed paths: + M /trunk/module/Client/Eval.pm + +* need paren to seems to be function call for perl. +------------------------------------------------------------------------ +r388 | topia | 2004-06-17 15:51:06 +0900 (Thu, 17 Jun 2004) | 1 line +Changed paths: + M /trunk/main/Timer.pm + +* stop abort from Exception on Timer->{code}. +------------------------------------------------------------------------ +r386 | topia | 2004-06-09 18:28:03 +0900 (Wed, 09 Jun 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/IrcIO/Server.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r383 | topia | 2004-06-09 17:48:01 +0900 (Wed, 09 Jun 2004) | 5 lines +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* add ignore warning. + +* add full-ignore to NOTICE/PRIVMSG. + +* add reply for PING. +------------------------------------------------------------------------ +r381 | topia | 2004-06-04 21:57:52 +0900 (Fri, 04 Jun 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/IRCMessage.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/Unicode/Japanese.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Client/Eval.pm + M /trunk/module/System/Raw.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r378 | topia | 2004-06-04 21:14:02 +0900 (Fri, 04 Jun 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* send RPL_ISUPPORT on single-server-mode and server gave it. +------------------------------------------------------------------------ +r377 | topia | 2004-06-04 21:07:15 +0900 (Fri, 04 Jun 2004) | 13 lines +Changed paths: + M /trunk/main/IRCMessage.pm + +* add MAX_PARAMS constant. + +(_parse) +* use $this->push. + +(params) +* force-initialize of undefined. + +(n_params) +* use $this->params. + +(push, pop) +* add. +------------------------------------------------------------------------ +r376 | topia | 2004-06-04 19:38:51 +0900 (Fri, 04 Jun 2004) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + +* add ->length([serialize_param]). +------------------------------------------------------------------------ +r375 | topia | 2004-06-03 14:00:00 +0900 (Thu, 03 Jun 2004) | 3 lines +Changed paths: + M /trunk/module/Client/Eval.pm + +* reparse command line. + +* set $err to null string for disable warning. +------------------------------------------------------------------------ +r374 | topia | 2004-06-03 13:36:51 +0900 (Thu, 03 Jun 2004) | 2 lines +Changed paths: + M /trunk/module/System/Raw.pm + +* last index of $msg->params is ($msg->n_params - 1). + use .. ($msg->n_params - 1) instead of .. $msg->n_params. +------------------------------------------------------------------------ +r373 | topia | 2004-06-03 11:55:44 +0900 (Thu, 03 Jun 2004) | 1 line +Changed paths: + M /trunk/module/Channel/Mode/Oper/Grant.pm + +* check defined $myself. +------------------------------------------------------------------------ +r372 | topia | 2004-06-01 18:21:10 +0900 (Tue, 01 Jun 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + M /trunk/main/Multicast.pm + +* cosmetic fixes(comment, empty-line). +------------------------------------------------------------------------ +r371 | topia | 2004-06-01 18:19:24 +0900 (Tue, 01 Jun 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + M /trunk/main/Multicast.pm + A /trunk/module/Client/ShowNick.pm + +* move sending notice connected network feature to module/Client/ShowNick.pm. +------------------------------------------------------------------------ +r370 | topia | 2004-06-01 18:17:57 +0900 (Tue, 01 Jun 2004) | 3 lines +Changed paths: + M /trunk/module/Client/Eval.pm + +* add useful functions(network, runloop). + - can s/RunLoop->shared_loop/runloop/g; + - can s/RunLoop->shared_loop->network/network/g; +------------------------------------------------------------------------ +r369 | topia | 2004-06-01 04:57:26 +0900 (Tue, 01 Jun 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + M /trunk/main/Multicast.pm + +* check multi-server-mode before force nickname show (for whois, client attach). +------------------------------------------------------------------------ +r368 | topia | 2004-06-01 02:05:02 +0900 (Tue, 01 Jun 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + +* add cache expire-feature. +------------------------------------------------------------------------ +r367 | topia | 2004-06-01 01:41:30 +0900 (Tue, 01 Jun 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + M /trunk/runtiarra.perl + M /trunk/tools/upload.sh + +* add RPL_ENDOFWHO. +------------------------------------------------------------------------ +r365 | topia | 2004-05-26 16:03:34 +0900 (Wed, 26 May 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/Unicode/Japanese.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r362 | topia | 2004-05-09 21:53:07 +0900 (Sun, 09 May 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IrcIO.pm + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r358 | topia | 2004-05-09 13:08:47 +0900 (Sun, 09 May 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IrcIO/Server.pm + M /trunk/main/Multicast.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r355 | topia | 2004-05-09 13:00:23 +0900 (Sun, 09 May 2004) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* re-add removed '+' (from default chantypes). +------------------------------------------------------------------------ +r354 | topia | 2004-05-09 12:48:53 +0900 (Sun, 09 May 2004) | 7 lines +Changed paths: + M /trunk/main/IrcIO/Server.pm + M /trunk/main/Multicast.pm + +* move IrcIO::Server->remark('isupport') to instance variable ->{isupport}. + +* add IrcIO::Server->{nick,channel}_p. + +* add optional param(nicklen) for Multicast::nick_p. + +* add optional param(chantypes) for Multicast::channel_p. +------------------------------------------------------------------------ +r351 | topia | 2004-05-08 17:14:30 +0900 (Sat, 08 May 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IrcIO/Server.pm + M /trunk/main/Multicast.pm + M /trunk/main/NumericReply.pm + M /trunk/module/Client/Cache.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r348 | topia | 2004-05-08 16:28:37 +0900 (Sat, 08 May 2004) | 1 line +Changed paths: + M /trunk/HACKING + +* mention IrcIO::Server->remark(isupport, uid). +------------------------------------------------------------------------ +r347 | topia | 2004-05-08 16:24:20 +0900 (Sat, 08 May 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* add RPL_YOURID support. +------------------------------------------------------------------------ +r346 | topia | 2004-05-08 15:56:43 +0900 (Sat, 08 May 2004) | 4 lines +Changed paths: + M /trunk/main/NumericReply.pm + +* add irc2.11 NumericReply (RPL_{YOURID,SAVENICK,REOPLIST,ENDOFREOPLIST}). + +* rename and add alias (RPL_TOPICWHOTIME -> RPL_TOPIC_WHO_TIME). + +------------------------------------------------------------------------ +r345 | topia | 2004-05-08 15:45:07 +0900 (Sat, 08 May 2004) | 7 lines +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* add RPL_HELLO on _receive_while_logging_in (for irc2.11). + +* add RPL_ISUPPORT code. + +* able to specify nicklen for modify_nick. + +* _set_to_next_nick use ISUPORT->NICKLEN, if server provide. +------------------------------------------------------------------------ +r344 | topia | 2004-05-08 15:32:56 +0900 (Sat, 08 May 2004) | 5 lines +Changed paths: + M /trunk/main/NumericReply.pm + +* add comment(hemp). + +* add RPL_REDIR to compatibility. + +* add RPL_HELLO to irc2.11. +------------------------------------------------------------------------ +r343 | topia | 2004-05-08 05:09:42 +0900 (Sat, 08 May 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + M /trunk/module/Client/Cache.pm + +* change remark name (creation_time -> creation-time). +------------------------------------------------------------------------ +r342 | topia | 2004-05-08 05:07:58 +0900 (Sat, 08 May 2004) | 1 line +Changed paths: + M /trunk/HACKING + +* mention ChannelInfo->remark('creation-time'). +------------------------------------------------------------------------ +r341 | topia | 2004-05-08 05:04:58 +0900 (Sat, 08 May 2004) | 1 line +Changed paths: + M /trunk/HACKING + +* fix typo. +------------------------------------------------------------------------ +r340 | topia | 2004-05-07 19:13:16 +0900 (Fri, 07 May 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + M /trunk/main/Multicast.pm + M /trunk/main/NumericReply.pm + M /trunk/module/Client/Cache.pm + +* support RPL_CREATIONTIME (maybe work). +------------------------------------------------------------------------ +r338 | topia | 2004-04-18 16:45:12 +0900 (Sun, 18 Apr 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IrcIO/Client.pm + M /trunk/module/Channel/Rejoin.pm + M /trunk/module/Client/Cache.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r335 | topia | 2004-04-18 15:38:55 +0900 (Sun, 18 Apr 2004) | 1 line +Changed paths: + M /trunk/HACKING + +* mention remark, BulletinBoard, and cosmetic changes. +------------------------------------------------------------------------ +r334 | topia | 2004-04-18 15:38:15 +0900 (Sun, 18 Apr 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Log/Channel.pm + M /trunk/module/Log/ChannelList.pm + +* make __PACKAGE__ to work. +------------------------------------------------------------------------ +r333 | topia | 2004-04-18 15:02:17 +0900 (Sun, 18 Apr 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/ControlPort.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r329 | topia | 2004-04-07 20:52:55 +0900 (Wed, 07 Apr 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IrcIO/Server.pm + M /trunk/main/Mask.pm + M /trunk/main/Multicast.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r326 | topia | 2004-04-06 02:09:59 +0900 (Tue, 06 Apr 2004) | 1 line +Changed paths: + M /trunk/module/Channel/Rejoin.pm + +* protect for undefined $myself(what happen!?). +------------------------------------------------------------------------ +r323 | topia | 2004-04-01 18:45:44 +0900 (Thu, 01 Apr 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/module/Client/Cache.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r320 | topia | 2004-04-01 12:22:08 +0900 (Thu, 01 Apr 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r317 | topia | 2004-03-29 19:32:26 +0900 (Mon, 29 Mar 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + +* fix bug on single-server-mode. +------------------------------------------------------------------------ +r315 | topia | 2004-03-27 19:43:23 +0900 (Sat, 27 Mar 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/LinedINETSocket.pm + M /trunk/main/RunLoop.pm + M /trunk/main/Timer.pm + A /trunk/module/Tools/HTTPClient.pm (from /vendor/20040327-194317/module/Tools/HTTPClient.pm:314) + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r314 | topia | 2004-03-27 19:43:09 +0900 (Sat, 27 Mar 2004) | 2 lines +Changed paths: + A /vendor/20040327-194317 (from /vendor/current:313) + +Tag vendor/current as vendor/20040327-194317. + +------------------------------------------------------------------------ +r313 | topia | 2004-03-27 19:43:07 +0900 (Sat, 27 Mar 2004) | 2 lines +Changed paths: + M /vendor/current/ChangeLog + M /vendor/current/main/LinedINETSocket.pm + M /vendor/current/main/RunLoop.pm + M /vendor/current/main/Timer.pm + A /vendor/current/module/Tools/HTTPClient.pm + M /vendor/current/tiarra + +Load temp-20040327-194317.18428 into vendor/current. + +------------------------------------------------------------------------ +r312 | topia | 2004-03-27 19:32:24 +0900 (Sat, 27 Mar 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* fix wrong comment. +------------------------------------------------------------------------ +r311 | topia | 2004-03-27 19:22:18 +0900 (Sat, 27 Mar 2004) | 3 lines +Changed paths: + M /trunk/tiarra + +* also close STDIN with quiet-mode. + +* move handle closing into after configuration reading. +------------------------------------------------------------------------ +r309 | topia | 2004-03-19 22:23:39 +0900 (Fri, 19 Mar 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO.pm + M /trunk/main/LinedINETSocket.pm + M /trunk/main/ModuleManager.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Log/Recent.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r306 | topia | 2004-03-19 21:59:19 +0900 (Fri, 19 Mar 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + +* implement force mode sending(and ignore request). +------------------------------------------------------------------------ +r305 | topia | 2004-03-19 21:56:54 +0900 (Fri, 19 Mar 2004) | 2 lines +Changed paths: + M /trunk/main/IrcIO.pm + M /trunk/main/LinedINETSocket.pm + +* IO::Handle->syswrite(buf) -> (buf, length). + (bug on $IO::Handle::VERSION eq '1.21') +------------------------------------------------------------------------ +r304 | topia | 2004-03-15 05:51:45 +0900 (Mon, 15 Mar 2004) | 1 line +Changed paths: + M /trunk/module/Log/Recent.pm + +* use $client->option('no-recent-logs') on channel-info Hook. +------------------------------------------------------------------------ +r303 | topia | 2004-03-15 04:38:21 +0900 (Mon, 15 Mar 2004) | 3 lines +Changed paths: + M /trunk/main/IrcIO/Client.pm + M /trunk/module/Log/Recent.pm + +* modify channel-info Hook Parameter. + +* safe to die in hook scripts. +------------------------------------------------------------------------ +r302 | topia | 2004-03-15 04:36:24 +0900 (Mon, 15 Mar 2004) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* add ADMIN to client_sent. +------------------------------------------------------------------------ +r301 | topia | 2004-03-15 04:35:58 +0900 (Mon, 15 Mar 2004) | 1 line +Changed paths: + M /trunk/main/ModuleManager.pm + +* use RunLoop->shared_loop->notify_error to show error. +------------------------------------------------------------------------ +r300 | topia | 2004-03-14 01:50:57 +0900 (Sun, 14 Mar 2004) | 1 line +Changed paths: + A /trunk/doc/module + A /trunk/doc/module/Auto.html + A /trunk/doc/module/CTCP.html + A /trunk/doc/module/Channel.html + A /trunk/doc/module/Client.html + A /trunk/doc/module/Debug.html + A /trunk/doc/module/Log.html + A /trunk/doc/module/System.html + A /trunk/doc/module/User.html + A /trunk/doc/module-toc.html + A /trunk/sample.conf + +* generate docs. +------------------------------------------------------------------------ +r299 | topia | 2004-03-14 01:49:35 +0900 (Sun, 14 Mar 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/Makefile + D /trunk/doc/module + D /trunk/doc/module-toc.html + M /trunk/main/Hook.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/RunLoop.pm + M /trunk/module/Log/Recent.pm + D /trunk/sample.conf + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r290 | topia | 2004-03-09 16:57:32 +0900 (Tue, 09 Mar 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/module/Client/Cache.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r286 | topia | 2004-03-09 16:14:15 +0900 (Tue, 09 Mar 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/Unicode/Japanese.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r283 | topia | 2004-03-07 22:42:30 +0900 (Sun, 07 Mar 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + +* fix bug on ->destruct(). +------------------------------------------------------------------------ +r282 | topia | 2004-03-07 19:41:05 +0900 (Sun, 07 Mar 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/Configuration.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/Mask.pm + M /trunk/main/Multicast.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Client/Eval.pm + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r278 | topia | 2004-02-27 02:40:53 +0900 (Fri, 27 Feb 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* nick notices' category change to 'nick::system'. +------------------------------------------------------------------------ +r277 | topia | 2004-02-27 02:35:43 +0900 (Fri, 27 Feb 2004) | 1 line +Changed paths: + M /trunk/main/Unicode/Japanese.pm + +* untaint. +------------------------------------------------------------------------ +r276 | topia | 2004-02-27 02:34:19 +0900 (Fri, 27 Feb 2004) | 1 line +Changed paths: + M /trunk/main/Mask.pm + +* untaint. +------------------------------------------------------------------------ +r275 | topia | 2004-02-27 02:33:13 +0900 (Fri, 27 Feb 2004) | 3 lines +Changed paths: + M /trunk/main/Configuration.pm + +* fix typo on function name... + +* style fix. +------------------------------------------------------------------------ +r274 | topia | 2004-02-27 02:31:21 +0900 (Fri, 27 Feb 2004) | 3 lines +Changed paths: + M /trunk/module/Client/Eval.pm + +* do untaint.(this module is DANGEROUS; be already warned :D) + +* handle multiline. +------------------------------------------------------------------------ +r273 | topia | 2004-02-27 02:24:04 +0900 (Fri, 27 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Auto/MesMail.pm + +* style fix at constructor. +------------------------------------------------------------------------ +r272 | topia | 2004-02-27 02:23:30 +0900 (Fri, 27 Feb 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* untaint on load-path. +------------------------------------------------------------------------ +r271 | topia | 2004-02-26 09:24:54 +0900 (Thu, 26 Feb 2004) | 5 lines +Changed paths: + M /trunk/module/Client/Cache.pm + +* add prefix to channel state remarks. + +* add destruct to clean channel state remarks. + +* remove remark('fill-prefix-when-sending-to-client'). +------------------------------------------------------------------------ +r270 | topia | 2004-02-26 09:22:32 +0900 (Thu, 26 Feb 2004) | 3 lines +Changed paths: + M /trunk/module/Log/ChannelList.pm + +* add copyright. + +* remove un-necessary timer instance variable. +------------------------------------------------------------------------ +r269 | topia | 2004-02-26 09:21:44 +0900 (Thu, 26 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Skelton.pm + +* change Skelton->new() to safe for future change. +------------------------------------------------------------------------ +r268 | topia | 2004-02-24 19:35:19 +0900 (Tue, 24 Feb 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* fix undefined error on whois to not found user in person list. +------------------------------------------------------------------------ +r267 | topia | 2004-02-24 12:22:34 +0900 (Tue, 24 Feb 2004) | 1 line +Changed paths: + A /trunk/module/Log/ChannelList.pm + +* add Log::ChannelList. +------------------------------------------------------------------------ +r266 | topia | 2004-02-24 12:21:59 +0900 (Tue, 24 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Log/Channel.pm + +* use __PACKAGE__. +------------------------------------------------------------------------ +r265 | topia | 2004-02-23 17:29:20 +0900 (Mon, 23 Feb 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/module/Debug/RawLog.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r262 | topia | 2004-02-23 17:12:44 +0900 (Mon, 23 Feb 2004) | 2 lines +Changed paths: + M /trunk/main/Multicast.pm + +* ${server,client}_sent. + - add ERR_{NOTONCHANNEL,NOSUCHCHANNEL} (_gen_{detach,attach}_translator(1)). +------------------------------------------------------------------------ +r261 | topia | 2004-02-23 17:10:49 +0900 (Mon, 23 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Debug/RawLog.pm + +* describe 'logname' client-option. +------------------------------------------------------------------------ +r259 | topia | 2004-02-23 15:24:16 +0900 (Mon, 23 Feb 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IrcIO/Server.pm + M /trunk/main/RunLoop.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r256 | topia | 2004-02-23 15:12:52 +0900 (Mon, 23 Feb 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r253 | topia | 2004-02-23 14:38:51 +0900 (Mon, 23 Feb 2004) | 3 lines +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* fix typo on package name. + +* change notice prefix. +------------------------------------------------------------------------ +r252 | topia | 2004-02-23 14:33:09 +0900 (Mon, 23 Feb 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* use sysmsg_prefix on _multi_server_mode_changed. +------------------------------------------------------------------------ +r251 | topia | 2004-02-23 14:32:04 +0900 (Mon, 23 Feb 2004) | 3 lines +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* use sysmsg_prefix on nick changed notice / set_to_next_nick notice. + +* fix bug on getting _RPL_CHANNELMODEIS for not-joinned channel. +------------------------------------------------------------------------ +r249 | topia | 2004-02-23 11:54:35 +0900 (Mon, 23 Feb 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/doc-src/conf-main.tdoc + M /trunk/doc-src/module-group.tdoc + M /trunk/doc-src/sample.conf.in + M /trunk/main/Configuration/Block.pm + M /trunk/main/Configuration.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/Multicast.pm + M /trunk/main/RunLoop.pm + M /trunk/main/TiarraDoc.pm + M /trunk/makedoc + M /trunk/module/Auto/Alias.pm + M /trunk/module/Auto/Answer.pm + M /trunk/module/Auto/ChannelWithoutOper.pm + M /trunk/module/Auto/Joined.pm + M /trunk/module/Auto/Oper.pm + M /trunk/module/Auto/Random.pm + M /trunk/module/CTCP/ClientInfo.pm + M /trunk/module/CTCP/Ping.pm + M /trunk/module/CTCP/Time.pm + M /trunk/module/CTCP/UserInfo.pm + M /trunk/module/CTCP/Version.pm + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Channel/Join/Kicked.pm + M /trunk/module/Channel/Mode/Get.pm + M /trunk/module/Channel/Mode/Oper/Grant.pm + M /trunk/module/Channel/Mode/Set.pm + M /trunk/module/Channel/Rejoin.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Client/Eval.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/System/Macro.pm + M /trunk/module/System/Pong.pm + M /trunk/module/System/Raw.pm + M /trunk/module/System/RemoteControl.pm + M /trunk/module/System/Shutdown.pm + M /trunk/module/User/Away/Client.pm + M /trunk/module/User/Away/Nick.pm + M /trunk/module/User/Filter.pm + M /trunk/module/User/Ignore.pm + M /trunk/module/User/Nick/Detached.pm + M /trunk/module/User/ServerOper.pm + M /trunk/module/User/Vanish.pm + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r245 | topia | 2004-02-23 09:54:14 +0900 (Mon, 23 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Client/Eval.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/System/Pong.pm + M /trunk/module/System/Raw.pm + +* remove unnecessary 'use Configuration;'. +------------------------------------------------------------------------ +r244 | topia | 2004-02-23 08:27:48 +0900 (Mon, 23 Feb 2004) | 1 line +Changed paths: + M /trunk/doc-src/sample.conf.in + +* add RCS Tag(id). +------------------------------------------------------------------------ +r243 | topia | 2004-02-22 15:12:05 +0900 (Sun, 22 Feb 2004) | 1 line +Changed paths: + M /trunk/main/ModuleManager.pm + +* fix bareword. +------------------------------------------------------------------------ +r242 | topia | 2004-02-22 14:39:29 +0900 (Sun, 22 Feb 2004) | 1 line +Changed paths: + M /trunk/doc/module/Auto.html + A /trunk/doc/module/CTCP.html + M /trunk/doc/module/Channel.html + M /trunk/doc/module/Log.html + M /trunk/doc/module/System.html + M /trunk/doc/module/User.html + M /trunk/doc/module-toc.html + M /trunk/sample.conf + +* regen. +------------------------------------------------------------------------ +r241 | topia | 2004-02-22 14:38:38 +0900 (Sun, 22 Feb 2004) | 9 lines +Changed paths: + M /trunk/doc-src/conf-main.tdoc + M /trunk/doc-src/module-group.tdoc + M /trunk/makedoc + M /trunk/module/Auto/Alias.pm + M /trunk/module/Auto/Answer.pm + M /trunk/module/Auto/ChannelWithoutOper.pm + M /trunk/module/Auto/Joined.pm + M /trunk/module/Auto/MesMail.pm + M /trunk/module/Auto/Oper.pm + M /trunk/module/Auto/Random.pm + M /trunk/module/Auto/Reply.pm + M /trunk/module/Auto/Response.pm + M /trunk/module/CTCP/ClientInfo.pm + M /trunk/module/CTCP/Ping.pm + M /trunk/module/CTCP/Time.pm + M /trunk/module/CTCP/UserInfo.pm + M /trunk/module/CTCP/Version.pm + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Channel/Join/Invite.pm + M /trunk/module/Channel/Join/Kicked.pm + M /trunk/module/Channel/Mode/Get.pm + M /trunk/module/Channel/Mode/Oper/Grant.pm + M /trunk/module/Channel/Mode/Set.pm + M /trunk/module/Channel/Rejoin.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/System/Macro.pm + M /trunk/module/System/Pong.pm + M /trunk/module/System/RemoteControl.pm + M /trunk/module/System/Shutdown.pm + M /trunk/module/User/Away/Client.pm + M /trunk/module/User/Away/Nick.pm + M /trunk/module/User/Filter.pm + M /trunk/module/User/Ignore.pm + M /trunk/module/User/Nick/Detached.pm + M /trunk/module/User/ServerOper.pm + M /trunk/module/User/Vanish.pm + +* makedoc: change to generate sample.conf. + +* doc-src/conf-main.tdoc: + - add networks/multi-server-mode. + - change ircnet/host to irc.nara.wide.ad.jp. + +* doc-src/module-group.tdoc: add CTCP group. + +* TiarraDoc-ize. +------------------------------------------------------------------------ +r240 | topia | 2004-02-22 12:54:22 +0900 (Sun, 22 Feb 2004) | 3 lines +Changed paths: + M /trunk/doc-src/conf-main.tdoc + +* remove general/omit-sysmsg-prefix-when-possible. + +* add general/sysmsg-prefix-use-masks block. +------------------------------------------------------------------------ +r239 | topia | 2004-02-22 12:51:54 +0900 (Sun, 22 Feb 2004) | 1 line +Changed paths: + M /trunk/main/TiarraDoc.pm + M /trunk/makedoc + +* permit blank to value. +------------------------------------------------------------------------ +r236 | topia | 2004-02-22 12:24:11 +0900 (Sun, 22 Feb 2004) | 1 line +Changed paths: + A /trunk/doc/module/Auto.html + A /trunk/doc/module/Channel.html + A /trunk/doc/module/Client.html + A /trunk/doc/module/Debug.html + A /trunk/doc/module/Log.html + M /trunk/doc/module/System.html + M /trunk/doc/module-toc.html + +* regen. +------------------------------------------------------------------------ +r235 | topia | 2004-02-22 12:23:18 +0900 (Sun, 22 Feb 2004) | 1 line +Changed paths: + M /trunk/makedoc + +* implement block(very tiny). +------------------------------------------------------------------------ +r234 | topia | 2004-02-22 12:22:47 +0900 (Sun, 22 Feb 2004) | 1 line +Changed paths: + M /trunk/main/TiarraDoc.pm + +* implement block(tiny). +------------------------------------------------------------------------ +r233 | topia | 2004-02-22 12:08:50 +0900 (Sun, 22 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Auto/Reply.pm + +* add mask check and TiarraDoc. +------------------------------------------------------------------------ +r230 | topia | 2004-02-22 11:56:04 +0900 (Sun, 22 Feb 2004) | 3 lines +Changed paths: + M /trunk/doc-src/module-group.tdoc + +* fix Channel group's lastline(=pod -> =cut). + +* add Client/Debug group. +------------------------------------------------------------------------ +r229 | topia | 2004-02-22 11:54:35 +0900 (Sun, 22 Feb 2004) | 3 lines +Changed paths: + M /trunk/makedoc + +* add sort. + +* warning on group don't have description. +------------------------------------------------------------------------ +r228 | topia | 2004-02-22 11:10:05 +0900 (Sun, 22 Feb 2004) | 5 lines +Changed paths: + M /trunk/main/IrcIO/Client.pm + M /trunk/main/Multicast.pm + M /trunk/main/RunLoop.pm + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Client/Eval.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/System/Pong.pm + M /trunk/module/System/Raw.pm + +* main/RunLoop.pm (sysmsg_prefix): add. + +* use RunLoop->shared_loop->sysmsg_prefix(...); + +* module/Systen/Raw.pm (message_arrived): NumericReply-ize, use ERR_NEEDMOREPARAMS. +------------------------------------------------------------------------ +r227 | topia | 2004-02-22 11:05:34 +0900 (Sun, 22 Feb 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* don't show stack dump on 'couldn't connect' error. +------------------------------------------------------------------------ +r226 | topia | 2004-02-22 11:03:32 +0900 (Sun, 22 Feb 2004) | 3 lines +Changed paths: + M /trunk/main/ModuleManager.pm + +* fix error on not-constracted module unloading. + +* omit too many not-unload subroutines debug message. +------------------------------------------------------------------------ +r225 | topia | 2004-02-22 11:01:50 +0900 (Sun, 22 Feb 2004) | 7 lines +Changed paths: + M /trunk/main/Configuration.pm + +* add general/sysmsg-prefix-use-masks default value(block). + +* remove general/omit-sysmsg-prefix-when-possible. + +* split _complete_{table,block}_with_defaults. + +* support array_ref/hash_ref(to Configuration::Block) in _complete_block_with_defaults. +------------------------------------------------------------------------ +r224 | topia | 2004-02-22 11:00:54 +0900 (Sun, 22 Feb 2004) | 3 lines +Changed paths: + M /trunk/main/Configuration/Block.pm + +* add table method. + +* fix typo(original). +------------------------------------------------------------------------ +r223 | topia | 2004-02-21 23:50:12 +0900 (Sat, 21 Feb 2004) | 5 lines +Changed paths: + M /trunk/module/System/Pong.pm + +* NumericReply-ize. + +* do not pass server's or client's PING/PONG each other. + +* fix messages. +------------------------------------------------------------------------ +r222 | topia | 2004-02-21 23:46:35 +0900 (Sat, 21 Feb 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* use server_hostname to send ping. +------------------------------------------------------------------------ +r221 | topia | 2004-02-21 23:46:04 +0900 (Sat, 21 Feb 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* add server_hostname. +------------------------------------------------------------------------ +r220 | topia | 2004-02-21 23:42:56 +0900 (Sat, 21 Feb 2004) | 1 line +Changed paths: + M /trunk/module/System/Raw.pm + +* add TiarraDoc. +------------------------------------------------------------------------ +r219 | topia | 2004-02-21 23:42:08 +0900 (Sat, 21 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Debug/RawLog.pm + +* add resolve-numeric function. +------------------------------------------------------------------------ +r218 | topia | 2004-02-21 23:41:31 +0900 (Sat, 21 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + +* [bugfix] WHOREPLY do not global_to_local for nick. +------------------------------------------------------------------------ +r217 | topia | 2004-02-21 23:40:32 +0900 (Sat, 21 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Client/Eval.pm + +* remove unnecessary remark('fill-prefix-sending-to-client'). +------------------------------------------------------------------------ +r216 | topia | 2004-02-21 23:39:04 +0900 (Sat, 21 Feb 2004) | 7 lines +Changed paths: + M /trunk/main/Multicast.pm + +* NumericReply-ize. + +* escape [@+](to [\@+]). + +* add _{attach,detach}_RPL_WHOISCHANNELS. + +* add ERR_TOOMANYCHANNELS to attach/detach(1) target. +------------------------------------------------------------------------ +r215 | topia | 2004-02-21 23:34:51 +0900 (Sat, 21 Feb 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/doc/module/System.html + M /trunk/doc/module-toc.html + M /trunk/doc-src/conf-main.tdoc + M /trunk/main/Configuration.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/Multicast.pm + M /trunk/main/RunLoop.pm + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Defence/ChannelConf.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + A /trunk/module/Defence/Logger.pm (from /vendor/20040221-052750/module/Defence/Logger.pm:214) + A /trunk/module/Defence/RSA.pm (from /vendor/20040221-052750/module/Defence/RSA.pm:214) + A /trunk/module/Defence/genkey.pl (from /vendor/20040221-052750/module/Defence/genkey.pl:214) + M /trunk/module/Defence.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/System/Raw.pm + M /trunk/sample.conf + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r212 | topia | 2004-02-19 21:55:04 +0900 (Thu, 19 Feb 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* implement fixed-channels feature. +------------------------------------------------------------------------ +r211 | topia | 2004-02-19 21:54:20 +0900 (Thu, 19 Feb 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* change nick change(on server) message. +------------------------------------------------------------------------ +r208 | topia | 2004-02-15 19:28:33 +0900 (Sun, 15 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Log/Recent.pm + +* add client option 'no-recent-logs'. +------------------------------------------------------------------------ +r207 | topia | 2004-02-15 09:39:32 +0900 (Sun, 15 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Client/Eval.pm + +* use sysmsg-prefix. +------------------------------------------------------------------------ +r206 | topia | 2004-02-15 09:22:06 +0900 (Sun, 15 Feb 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/module/Client/Cache.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r201 | topia | 2004-02-15 07:27:53 +0900 (Sun, 15 Feb 2004) | 4 lines +Changed paths: + M /trunk/module/Client/Cache.pm + +* remove who cache debug message. + +* change 'RunLoop->shared_loop->notify_warn() if ::debug_mode;' + to '::debug_printmsg();'. +------------------------------------------------------------------------ +r200 | topia | 2004-02-15 07:09:27 +0900 (Sun, 15 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + +* protect from parallel who/mode call. +------------------------------------------------------------------------ +r199 | topia | 2004-02-15 04:32:33 +0900 (Sun, 15 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + M /trunk/module/Client/Eval.pm + +* remove svn:eol-style. +------------------------------------------------------------------------ +r198 | topia | 2004-02-15 01:42:19 +0900 (Sun, 15 Feb 2004) | 1 line +Changed paths: + D /trunk/COPYING + A /trunk/LICENSE (from /vendor/20040215-014107/LICENSE:197) + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r197 | topia | 2004-02-15 01:41:56 +0900 (Sun, 15 Feb 2004) | 2 lines +Changed paths: + A /vendor/20040215-014107 (from /vendor/current:196) + +Tag vendor/current as vendor/20040215-014107. + +------------------------------------------------------------------------ +r196 | topia | 2004-02-15 01:41:54 +0900 (Sun, 15 Feb 2004) | 2 lines +Changed paths: + D /vendor/current/COPYING + A /vendor/current/LICENSE + M /vendor/current/tiarra + +Load temp-20040215-014107.18766 into vendor/current. + +------------------------------------------------------------------------ +r195 | topia | 2004-02-14 21:18:04 +0900 (Sat, 14 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r192 | topia | 2004-02-14 21:14:25 +0900 (Sat, 14 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + +* fix to work Client::Cache on xchat. +------------------------------------------------------------------------ +r190 | topia | 2004-02-14 20:52:20 +0900 (Sat, 14 Feb 2004) | 1 line +Changed paths: + A /trunk/AUTHORS (from /vendor/20040214-204918/AUTHORS:189) + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/doc-src/conf-main.tdoc + M /trunk/main/ChannelInfo.pm + M /trunk/main/Configuration.pm + M /trunk/main/IRCMessage.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/Multicast.pm + M /trunk/main/NumericReply.pm + M /trunk/main/PersonInChannel.pm + M /trunk/main/PersonalInfo.pm + M /trunk/main/RunLoop.pm + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Channel/Join/Connect.pm + M /trunk/module/Channel/Rejoin.pm + M /trunk/module/Client/Cache.pm + M /trunk/module/Client/Eval.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/System/Pong.pm + M /trunk/module/System/Raw.pm + M /trunk/sample.conf + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r189 | topia | 2004-02-14 20:49:19 +0900 (Sat, 14 Feb 2004) | 2 lines +Changed paths: + A /vendor/20040214-204918 (from /vendor/current:188) + +Tag vendor/current as vendor/20040214-204918. + +------------------------------------------------------------------------ +r188 | topia | 2004-02-14 20:49:15 +0900 (Sat, 14 Feb 2004) | 2 lines +Changed paths: + A /vendor/current/AUTHORS + M /vendor/current/ChangeLog + M /vendor/current/NEWS + M /vendor/current/doc-src/conf-main.tdoc + M /vendor/current/main/ChannelInfo.pm + M /vendor/current/main/Configuration.pm + M /vendor/current/main/IRCMessage.pm + M /vendor/current/main/IrcIO/Client.pm + M /vendor/current/main/IrcIO/Server.pm + M /vendor/current/main/ModuleManager.pm + M /vendor/current/main/Multicast.pm + M /vendor/current/main/NumericReply.pm + M /vendor/current/main/PersonInChannel.pm + M /vendor/current/main/PersonalInfo.pm + M /vendor/current/main/RunLoop.pm + M /vendor/current/module/Channel/Freeze.pm + M /vendor/current/module/Channel/Join/Connect.pm + M /vendor/current/module/Channel/Rejoin.pm + A /vendor/current/module/Client + A /vendor/current/module/Client/Cache.pm + A /vendor/current/module/Client/Eval.pm + M /vendor/current/module/Log/Recent.pm + M /vendor/current/module/System/Pong.pm + M /vendor/current/module/System/Raw.pm + M /vendor/current/module/Tools/LinedDB.pm + M /vendor/current/sample.conf + +Load temp-20040214-204918.29036 into vendor/current. + +------------------------------------------------------------------------ +r187 | topia | 2004-02-14 07:04:47 +0900 (Sat, 14 Feb 2004) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* NumericReply-ize. +------------------------------------------------------------------------ +r186 | topia | 2004-02-14 07:02:55 +0900 (Sat, 14 Feb 2004) | 1 line +Changed paths: + M /trunk/main/NumericReply.pm + +* correct RPL_INFOSTART(375->373). +------------------------------------------------------------------------ +r185 | topia | 2004-02-14 06:47:07 +0900 (Sat, 14 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Client/Cache.pm + +* TiarraDoc small fix. +------------------------------------------------------------------------ +r184 | topia | 2004-02-14 06:03:01 +0900 (Sat, 14 Feb 2004) | 1 line +Changed paths: + M /trunk/main/ModuleManager.pm + +* (reload_modules_if_modified): temoprary disable module on reload. +------------------------------------------------------------------------ +r183 | topia | 2004-02-14 06:01:34 +0900 (Sat, 14 Feb 2004) | 3 lines +Changed paths: + M /trunk/module/Debug/RawLog.pm + +* (message_io_hook): add ignore-ping function. + +* config: invert default config value on enable-*. +------------------------------------------------------------------------ +r182 | topia | 2004-02-14 05:58:40 +0900 (Sat, 14 Feb 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* (apply_filters): ignore undefined $mod. +------------------------------------------------------------------------ +r181 | topia | 2004-02-13 13:48:11 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Log/Recent.pm + +* fix errorness network_name handling. +------------------------------------------------------------------------ +r180 | topia | 2004-02-13 13:46:15 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Auto/Calc.pm + +* add functions. +------------------------------------------------------------------------ +r179 | topia | 2004-02-13 13:45:34 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Debug/RawLog.pm + +* add TiarraDoc. +------------------------------------------------------------------------ +r177 | topia | 2004-02-13 13:40:35 +0900 (Fri, 13 Feb 2004) | 3 lines +Changed paths: + A /trunk/module/Client/Cache.pm + +* add Client::Cache. + - MODE reply cache. + - WHO reply cache. +------------------------------------------------------------------------ +r176 | topia | 2004-02-13 13:36:24 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + +* fix typo (unvalid -> invalid). +------------------------------------------------------------------------ +r175 | topia | 2004-02-13 13:35:17 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + M /trunk/main/ChannelInfo.pm + +* add ->mode_string. +------------------------------------------------------------------------ +r174 | topia | 2004-02-13 13:27:38 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + M /trunk/module/System/Pong.pm + +* remove unnecessary prefix on pong. +------------------------------------------------------------------------ +r173 | topia | 2004-02-13 13:26:33 +0900 (Fri, 13 Feb 2004) | 3 lines +Changed paths: + M /trunk/module/Channel/Rejoin.pm + +* NumericReply-ize. + +* use ChannelInfo->mode_string. +------------------------------------------------------------------------ +r172 | topia | 2004-02-13 13:23:33 +0900 (Fri, 13 Feb 2004) | 9 lines +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* NumericReply-ize. + +* add away handling. + +* fix realname handling on _RPL_WHOREPLY. + +* add server-hops on _RPL_WHOREPLY. + +* clear switches on _RPL_CHANNELMODEIS. +------------------------------------------------------------------------ +r171 | topia | 2004-02-13 13:16:27 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + M /trunk/main/PersonInChannel.pm + +* add ->priv_symbol. +------------------------------------------------------------------------ +r170 | topia | 2004-02-13 13:15:19 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + M /trunk/main/PersonalInfo.pm + +* add AWAY. +------------------------------------------------------------------------ +r169 | topia | 2004-02-13 13:13:52 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + +* add ->clone(deep => 1). +------------------------------------------------------------------------ +r168 | topia | 2004-02-13 13:11:32 +0900 (Fri, 13 Feb 2004) | 3 lines +Changed paths: + M /trunk/main/NumericReply.pm + +* sync irc2.10.3p5+hemp2. + +* add fetch_{number,name}. +------------------------------------------------------------------------ +r167 | topia | 2004-02-13 13:03:31 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + D /trunk/module/Client/DataCache.pm + +* temporary remove to fix wrong commit. +------------------------------------------------------------------------ +r166 | topia | 2004-02-13 12:55:57 +0900 (Fri, 13 Feb 2004) | 1 line +Changed paths: + A /trunk/module/Client + A /trunk/module/Client/DataCache.pm + A /trunk/module/Client/Eval.pm + +* add Client::Eval; +------------------------------------------------------------------------ +r165 | topia | 2004-02-12 13:22:38 +0900 (Thu, 12 Feb 2004) | 1 line +Changed paths: + M /trunk/module/Debug/RawLog.pm + +* sync message_io_hook. +------------------------------------------------------------------------ +r164 | topia | 2004-02-09 22:10:05 +0900 (Mon, 09 Feb 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/IrcIO.pm + M /trunk/main/Module.pm + M /trunk/main/RunLoop.pm + M /trunk/module/Skelton.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r161 | topia | 2004-01-28 00:58:46 +0900 (Wed, 28 Jan 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* remove -t... +------------------------------------------------------------------------ +r160 | topia | 2004-01-28 00:42:16 +0900 (Wed, 28 Jan 2004) | 3 lines +Changed paths: + M /trunk/main/NumericReply.pm + +* change sub defining. + +* little change to sync for hemp2. +------------------------------------------------------------------------ +r159 | topia | 2004-01-27 23:27:24 +0900 (Tue, 27 Jan 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/IrcIO.pm + A /trunk/main/NumericReply.pm (from /vendor/20040127-232738/main/NumericReply.pm:158) + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r158 | topia | 2004-01-27 23:27:11 +0900 (Tue, 27 Jan 2004) | 2 lines +Changed paths: + A /vendor/20040127-232738 (from /vendor/current:157) + +Tag vendor/current as vendor/20040127-232738. + +------------------------------------------------------------------------ +r157 | topia | 2004-01-27 23:27:09 +0900 (Tue, 27 Jan 2004) | 2 lines +Changed paths: + M /vendor/current/ChangeLog + M /vendor/current/NEWS + M /vendor/current/main/IrcIO.pm + A /vendor/current/main/NumericReply.pm + +Load temp-20040127-232738.1066 into vendor/current. + +------------------------------------------------------------------------ +r156 | topia | 2004-01-26 22:14:14 +0900 (Mon, 26 Jan 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* enable taint warning. +------------------------------------------------------------------------ +r154 | topia | 2004-01-23 04:22:45 +0900 (Fri, 23 Jan 2004) | 1 line +Changed paths: + M /trunk/module/Tools/LinedDB.pm + +* fix bug in file not found. +------------------------------------------------------------------------ +r152 | topia | 2004-01-23 04:20:52 +0900 (Fri, 23 Jan 2004) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* whitespace fix. +------------------------------------------------------------------------ +r150 | topia | 2004-01-23 04:13:36 +0900 (Fri, 23 Jan 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r147 | topia | 2004-01-23 04:03:34 +0900 (Fri, 23 Jan 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* fix on relative $0. +------------------------------------------------------------------------ +r146 | topia | 2004-01-23 03:28:42 +0900 (Fri, 23 Jan 2004) | 1 line +Changed paths: + M /trunk/tiarra + +* add pwd and symlink resolved directory to @INC. +------------------------------------------------------------------------ +r145 | topia | 2004-01-23 02:50:20 +0900 (Fri, 23 Jan 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r142 | topia | 2004-01-23 02:39:08 +0900 (Fri, 23 Jan 2004) | 1 line +Changed paths: + D /trunk/make-password + M /trunk/tiarra + +* move make-password into tiarra --make-password. +------------------------------------------------------------------------ +r141 | topia | 2004-01-20 19:22:53 +0900 (Tue, 20 Jan 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/Unicode/Japanese.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r137 | topia | 2004-01-15 11:46:23 +0900 (Thu, 15 Jan 2004) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IRCMessage.pm + M /trunk/main/Mask.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + A /trunk/module/Defence/Whistle.pm (from /vendor/20040115-113653/module/Defence/Whistle.pm:135) + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r133 | topia | 2004-01-15 04:23:30 +0900 (Thu, 15 Jan 2004) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* use general/sysmsg-prefix. +------------------------------------------------------------------------ +r131 | topia | 2004-01-14 15:05:23 +0900 (Wed, 14 Jan 2004) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* use general/sysmsg-prefix. +------------------------------------------------------------------------ +r130 | topia | 2004-01-10 06:16:19 +0900 (Sat, 10 Jan 2004) | 1 line +Changed paths: + M /trunk/module/System/Raw.pm + +* use general/sysmsg-prefix. +------------------------------------------------------------------------ +r129 | topia | 2004-01-10 06:08:47 +0900 (Sat, 10 Jan 2004) | 3 lines +Changed paths: + M /trunk/doc-src/conf-main.tdoc + M /trunk/main/Configuration.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/RunLoop.pm + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Log/Recent.pm + M /trunk/sample.conf + +* add general/sysmsg-prefix. + +* use general/sysmsg-prefix. +------------------------------------------------------------------------ +r128 | topia | 2004-01-10 06:06:18 +0900 (Sat, 10 Jan 2004) | 1 line +Changed paths: + M /trunk/module/Log/Recent.pm + +* fix spell miss. +------------------------------------------------------------------------ +r127 | topia | 2004-01-10 05:47:19 +0900 (Sat, 10 Jan 2004) | 1 line +Changed paths: + M /trunk/module/Auto/AliasDB.pm + M /trunk/module/Log/Channel.pm + +* remove local RCS tag. +------------------------------------------------------------------------ +r126 | topia | 2004-01-10 04:53:55 +0900 (Sat, 10 Jan 2004) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* add local_nick notify on whois my-localnick. +------------------------------------------------------------------------ +r125 | topia | 2003-12-29 13:07:39 +0900 (Mon, 29 Dec 2003) | 1 line +Changed paths: + M /trunk/main/IRCMessage.pm + +* fix error in params not found. +------------------------------------------------------------------------ +r124 | topia | 2003-12-29 13:05:47 +0900 (Mon, 29 Dec 2003) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* fix channel name in broken/revive network announce on single-server-mode. +------------------------------------------------------------------------ +r123 | topia | 2003-12-25 22:02:55 +0900 (Thu, 25 Dec 2003) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* message changed. +------------------------------------------------------------------------ +r122 | topia | 2003-12-25 22:01:21 +0900 (Thu, 25 Dec 2003) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* show nickname notify in all network on {whois,who} local_nick. +------------------------------------------------------------------------ +r121 | topia | 2003-12-25 21:59:51 +0900 (Thu, 25 Dec 2003) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* use notify_error instead of print. +------------------------------------------------------------------------ +r120 | topia | 2003-12-25 21:32:11 +0900 (Thu, 25 Dec 2003) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* show network status at client connecting. +------------------------------------------------------------------------ +r119 | topia | 2003-11-26 13:12:08 +0900 (Wed, 26 Nov 2003) | 1 line +Changed paths: + D /trunk/main/IO + +* remove unnecessary IO::Socket::INET6. +------------------------------------------------------------------------ +r118 | topia | 2003-11-26 02:09:22 +0900 (Wed, 26 Nov 2003) | 1 line +Changed paths: + M /trunk/module/Auto/Calc.pm + +* fix wrong untainting. +------------------------------------------------------------------------ +r117 | topia | 2003-11-21 05:07:50 +0900 (Fri, 21 Nov 2003) | 2 lines +Changed paths: + M /trunk/module/Channel/Join/Connect.pm + +* bugfix. + now accept "channel: channel, channel, channel". thanks mio. +------------------------------------------------------------------------ +r116 | topia | 2003-11-17 10:28:27 +0900 (Mon, 17 Nov 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r112 | topia | 2003-11-17 04:05:39 +0900 (Mon, 17 Nov 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/module/Log/Channel.pm + M /trunk/sample.conf + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r108 | topia | 2003-11-09 18:05:27 +0900 (Sun, 09 Nov 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/RunLoop.pm + M /trunk/module/System/Reload.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r104 | topia | 2003-11-09 16:54:56 +0900 (Sun, 09 Nov 2003) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* forth try to fix channel name handling on single-server-mode. +------------------------------------------------------------------------ +r102 | topia | 2003-11-09 16:36:55 +0900 (Sun, 09 Nov 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r99 | topia | 2003-11-08 18:41:21 +0900 (Sat, 08 Nov 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/make-password + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r96 | topia | 2003-11-08 15:13:52 +0900 (Sat, 08 Nov 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/RunLoop.pm + M /trunk/module/Log/Recent.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r92 | topia | 2003-11-08 05:55:32 +0900 (Sat, 08 Nov 2003) | 1 line +Changed paths: + M /trunk/module/Log/Recent.pm + +* third try to fix channel name handling on single-server-mode. +------------------------------------------------------------------------ +r91 | topia | 2003-11-08 05:08:47 +0900 (Sat, 08 Nov 2003) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* second try to fix channel name handling on single-server-mode. +------------------------------------------------------------------------ +r90 | topia | 2003-11-08 04:53:23 +0900 (Sat, 08 Nov 2003) | 1 line +Changed paths: + M /trunk/main/RunLoop.pm + +* first try to fix channel name handling on single-server-mode. +------------------------------------------------------------------------ +r88 | topia | 2003-10-25 02:03:21 +0900 (Sat, 25 Oct 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/Configuration/Block.pm + M /trunk/main/IRCMessage.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r83 | topia | 2003-10-19 21:32:35 +0900 (Sun, 19 Oct 2003) | 1 line +Changed paths: + M /trunk/module/Channel/Freeze.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r80 | topia | 2003-10-19 21:30:53 +0900 (Sun, 19 Oct 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + A /trunk/HACKING (from /vendor/20031019-213114/HACKING:79) + M /trunk/module/Auto/Alias.pm + A /trunk/module/Skelton.pm (from /vendor/20031019-213114/module/Skelton.pm:79) + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r79 | topia | 2003-10-19 21:30:45 +0900 (Sun, 19 Oct 2003) | 2 lines +Changed paths: + A /vendor/20031019-213114 (from /vendor/current:78) + +Tag vendor/current as vendor/20031019-213114. + +------------------------------------------------------------------------ +r78 | topia | 2003-10-19 21:30:42 +0900 (Sun, 19 Oct 2003) | 2 lines +Changed paths: + M /vendor/current/ChangeLog + A /vendor/current/HACKING + M /vendor/current/module/Auto/Alias.pm + A /vendor/current/module/Skelton.pm + +Load temp-20031019-213114.10716 into vendor/current. + +------------------------------------------------------------------------ +r76 | topia | 2003-10-19 19:42:19 +0900 (Sun, 19 Oct 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IrcIO/Server.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r73 | topia | 2003-10-19 05:12:00 +0900 (Sun, 19 Oct 2003) | 1 line +Changed paths: + M /trunk/module/Auto/Alias.pm + +* (message_arrived) fix wrong return value. +------------------------------------------------------------------------ +r72 | topia | 2003-10-16 01:25:43 +0900 (Thu, 16 Oct 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/RunLoop.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + A /trunk/module/System/Raw.pm (from /vendor/20031016-012443/module/System/Raw.pm:71) + M /trunk/sample.conf + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r70 | topia | 2003-10-16 01:24:37 +0900 (Thu, 16 Oct 2003) | 2 lines +Changed paths: + A /vendor/20031016-012443 (from /vendor/current:69) + +Tag vendor/current as vendor/20031016-012443. + +------------------------------------------------------------------------ +r69 | topia | 2003-10-16 01:24:34 +0900 (Thu, 16 Oct 2003) | 2 lines +Changed paths: + M /vendor/current/ChangeLog + M /vendor/current/NEWS + M /vendor/current/main/RunLoop.pm + M /vendor/current/module/Defence/Command.pm + M /vendor/current/module/Defence/Distinction.pm + M /vendor/current/module/Defence.pm + A /vendor/current/module/System/Raw.pm + M /vendor/current/sample.conf + +Load temp-20031016-012443.16808 into vendor/current. + +------------------------------------------------------------------------ +r68 | topia | 2003-10-14 13:49:17 +0900 (Tue, 14 Oct 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/IrcIO/Server.pm + M /trunk/main/Multicast.pm + M /trunk/main/RunLoop.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r63 | topia | 2003-10-14 13:20:46 +0900 (Tue, 14 Oct 2003) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/RunLoop.pm + +* more nick handling on single-server-mode. +------------------------------------------------------------------------ +r62 | topia | 2003-10-14 12:46:30 +0900 (Tue, 14 Oct 2003) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* add hijack of distribute_to_servers. +------------------------------------------------------------------------ +r61 | topia | 2003-10-14 11:46:50 +0900 (Tue, 14 Oct 2003) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* bad call of Multicast::nick_p. +------------------------------------------------------------------------ +r58 | topia | 2003-10-14 10:34:19 +0900 (Tue, 14 Oct 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IRCMessage.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + +* re-commit ok files. +------------------------------------------------------------------------ +r56 | topia | 2003-10-14 10:33:17 +0900 (Tue, 14 Oct 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IRCMessage.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + M /trunk/web/archive/archives.list + M /trunk/web/index.html.ja.euc-jp.1.head + M /trunk/web/index.html.ja.euc-jp.2.head + M /trunk/web/index.html.ja.euc-jp.common.body + M /trunk/web/index.html.ja.euc-jp.common.head + M /trunk/web/index.html.ja.euc-jp.common.tail + M /trunk/web/index.html.ja.euc-jp.head + M /trunk/web/index.html.ja.euc-jp.tail + +* revert bad commit. +------------------------------------------------------------------------ +r55 | topia | 2003-10-14 10:28:29 +0900 (Tue, 14 Oct 2003) | 1 line +Changed paths: + M /trunk/Makefile + M /trunk/doc/module/System.html + M /trunk/doc/module/User.html + M /trunk/main/LinedINETSocket.pm + M /trunk/module/Auto/Calc.pm + M /trunk/runtiarra.perl + +* remove unused -w. +------------------------------------------------------------------------ +r53 | topia | 2003-10-14 10:25:40 +0900 (Tue, 14 Oct 2003) | 1 line +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* fix mistaken on nick_p calling. +------------------------------------------------------------------------ +r51 | topia | 2003-10-12 21:09:37 +0900 (Sun, 12 Oct 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/IRCMessage.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + +* merge from vendor repository. +------------------------------------------------------------------------ +r46 | topia | 2003-09-28 23:13:21 +0900 (Sun, 28 Sep 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/PersonalInfo.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Distinction.pm + M /trunk/module/Defence.pm + M /trunk/status/merged-tag + M /trunk/tiarra-conf.el + +* merge from vendor repository. +------------------------------------------------------------------------ +r43 | topia | 2003-09-26 21:14:55 +0900 (Fri, 26 Sep 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/main/ChannelInfo.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/Multicast.pm + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from vendor repository. +------------------------------------------------------------------------ +r41 | topia | 2003-09-26 21:13:47 +0900 (Fri, 26 Sep 2003) | 5 lines +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* implement "437 nick/channel is temporarily unavailable". + +* kill unnecessary shorten nickname. + +* whitespace fix. +------------------------------------------------------------------------ +r40 | topia | 2003-09-26 21:11:48 +0900 (Fri, 26 Sep 2003) | 3 lines +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* implement "431 No nickname given". + +* change $ch->topic undefined value. +------------------------------------------------------------------------ +r39 | topia | 2003-09-26 21:10:01 +0900 (Fri, 26 Sep 2003) | 1 line +Changed paths: + M /trunk/main/Multicast.pm + +* whitespace fix. +------------------------------------------------------------------------ +r38 | topia | 2003-09-26 21:09:13 +0900 (Fri, 26 Sep 2003) | 3 lines +Changed paths: + M /trunk/main/ChannelInfo.pm + +* fix merge miss. + +* whitespace fix. +------------------------------------------------------------------------ +r37 | topia | 2003-09-26 21:08:27 +0900 (Fri, 26 Sep 2003) | 1 line +Changed paths: + M /trunk/tiarra + +* provide more debug information on --debug. +------------------------------------------------------------------------ +r26 | topia | 2003-09-26 02:58:38 +0900 (Fri, 26 Sep 2003) | 1 line +Changed paths: + M /trunk/ChangeLog + M /trunk/NEWS + M /trunk/main/ModuleManager.pm + M /trunk/module/Channel/Join/Connect.pm + M /trunk/module/Tools/FileCache.pm + M /trunk/module/Tools/GroupDB.pm + M /trunk/sample.conf + M /trunk/status/merged-tag + M /trunk/tiarra + +* merge from main repository. +------------------------------------------------------------------------ +r16 | topia | 2003-09-25 02:56:15 +0900 (Thu, 25 Sep 2003) | 1 line +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* whitespace fixes. +------------------------------------------------------------------------ +r15 | topia | 2003-09-25 02:53:57 +0900 (Thu, 25 Sep 2003) | 1 line +Changed paths: + M /trunk/module/Tools/GroupDB.pm + +* add Module::Use. +------------------------------------------------------------------------ +r14 | topia | 2003-09-25 02:53:03 +0900 (Thu, 25 Sep 2003) | 1 line +Changed paths: + M /trunk/module/Tools/FileCache.pm + +* add destruct function. +------------------------------------------------------------------------ +r13 | topia | 2003-09-25 02:52:33 +0900 (Thu, 25 Sep 2003) | 1 line +Changed paths: + M /trunk/module/Auto/Calc.pm + +* use "no strict;" instead of "no strict 'all';". this import flag is invalid. +------------------------------------------------------------------------ +r11 | topia | 2003-09-25 02:48:05 +0900 (Thu, 25 Sep 2003) | 7 lines +Changed paths: + M /trunk/main/ModuleManager.pm + +* whitespace fix. + +* $this->{modules} reconstruct before unload modules. + +* use ::debug_printmsg. + +* remove function if it defined in this file only. +------------------------------------------------------------------------ +r10 | topia | 2003-09-25 02:44:52 +0900 (Thu, 25 Sep 2003) | 1 line +Changed paths: + M /trunk/tiarra + +* implement debug option. +------------------------------------------------------------------------ +r6 | topia | 2003-09-24 01:48:33 +0900 (Wed, 24 Sep 2003) | 1 line +Changed paths: + M /trunk/Makefile + M /trunk/doc/module/System.html + M /trunk/doc/module-toc.html + A /trunk/filelist.cgi + A /trunk/filelist.cgi.txt + M /trunk/main/ChannelInfo.pm + M /trunk/main/IRCMessage.pm + M /trunk/main/IrcIO/Client.pm + M /trunk/main/IrcIO/Server.pm + M /trunk/main/ModuleManager.pm + M /trunk/main/Multicast.pm + M /trunk/make-password + M /trunk/makedoc + M /trunk/module/Auto/AliasDB/CallbackUtils.pm + M /trunk/module/Auto/AliasDB.pm + M /trunk/module/Auto/Answer.pm + A /trunk/module/Auto/Calc.pm + M /trunk/module/Channel/Join/Connect.pm + A /trunk/module/Debug + A /trunk/module/Debug/AliasTest.pm + A /trunk/module/Debug/RawLog.pm + A /trunk/module/System/Inflate + A /trunk/module/System/Inflate/Gzip.pm + A /trunk/module/System/Inflate/Zlib.pm + A /trunk/module/System/Inflate.pm + M /trunk/module/System/Reload.pm + A /trunk/runtiarra.perl + M /trunk/sample.conf + A /trunk/test + A /trunk/test/dateconvert-test.perl + A /trunk/test/inflate-test.perl + M /trunk/tiarra + +* sync my repository version. +------------------------------------------------------------------------ +r5 | topia | 2003-09-24 01:01:09 +0900 (Wed, 24 Sep 2003) | 1 line +Changed paths: + A /trunk (from /vendor/current:4) + +* use latest vendor drop as trunk. +------------------------------------------------------------------------ +r3 | topia | 2003-09-24 00:56:30 +0900 (Wed, 24 Sep 2003) | 2 lines +Changed paths: + A /vendor/current/COPYING + A /vendor/current/ChangeLog + A /vendor/current/Makefile + A /vendor/current/NEWS + A /vendor/current/doc + A /vendor/current/doc/default.css + A /vendor/current/doc/module + A /vendor/current/doc/module/System.html + A /vendor/current/doc/module/User.html + A /vendor/current/doc/module-toc.html + A /vendor/current/doc-src + A /vendor/current/doc-src/README + A /vendor/current/doc-src/conf-main.tdoc + A /vendor/current/doc-src/contents.html + A /vendor/current/doc-src/module-group.tdoc + A /vendor/current/doc-src/module-toc.html + A /vendor/current/doc-src/sample.conf.in + A /vendor/current/main + A /vendor/current/main/BulletinBoard.pm + A /vendor/current/main/CTCP.pm + A /vendor/current/main/ChannelInfo.pm + A /vendor/current/main/Configuration + A /vendor/current/main/Configuration/Block.pm + A /vendor/current/main/Configuration/LexicalAnalyzer.pm + A /vendor/current/main/Configuration/Parser.pm + A /vendor/current/main/Configuration/Preprocessor.pm + A /vendor/current/main/Configuration.pm + A /vendor/current/main/ControlPort.pm + A /vendor/current/main/Crypt.pm + A /vendor/current/main/Exception.pm + A /vendor/current/main/ExternalSocket.pm + A /vendor/current/main/FunctionalVariable.pm + A /vendor/current/main/Hook.pm + A /vendor/current/main/IO + A /vendor/current/main/IO/Socket + A /vendor/current/main/IO/Socket/INET6.pm + A /vendor/current/main/IRCMessage.pm + A /vendor/current/main/InstantCapsule.pm + A /vendor/current/main/IrcIO + A /vendor/current/main/IrcIO/Client.pm + A /vendor/current/main/IrcIO/Server.pm + A /vendor/current/main/IrcIO.pm + A /vendor/current/main/Iterator + A /vendor/current/main/Iterator/ArrayIterator.pm + A /vendor/current/main/Iterator/BackwardIterator.pm + A /vendor/current/main/Iterator/BidirectionalIterator.pm + A /vendor/current/main/Iterator/ForwardIterator.pm + A /vendor/current/main/Iterator/RandomAccessIterator.pm + A /vendor/current/main/Iterator/RoundIterator.pm + A /vendor/current/main/Iterator.pm + A /vendor/current/main/L10N.pm + A /vendor/current/main/LinedINETSocket.pm + A /vendor/current/main/LocalChannelManager.pm + A /vendor/current/main/Mask.pm + A /vendor/current/main/Module + A /vendor/current/main/Module/Use.pm + A /vendor/current/main/Module.pm + A /vendor/current/main/ModuleManager.pm + A /vendor/current/main/Multicast.pm + A /vendor/current/main/PersonInChannel.pm + A /vendor/current/main/PersonalInfo.pm + A /vendor/current/main/ReloadTrigger.pm + A /vendor/current/main/RunLoop.pm + A /vendor/current/main/Template.pm + A /vendor/current/main/TiarraDoc.pm + A /vendor/current/main/Timer.pm + A /vendor/current/main/Unicode + A /vendor/current/main/Unicode/Japanese.pm + A /vendor/current/make-password + A /vendor/current/makedoc + A /vendor/current/module + A /vendor/current/module/Auto + A /vendor/current/module/Auto/Alias.pm + A /vendor/current/module/Auto/AliasDB + A /vendor/current/module/Auto/AliasDB/CallbackUtils.pm + A /vendor/current/module/Auto/AliasDB.pm + A /vendor/current/module/Auto/Answer.pm + A /vendor/current/module/Auto/CacheManager.pm + A /vendor/current/module/Auto/ChannelWithoutOper.pm + A /vendor/current/module/Auto/Joined.pm + A /vendor/current/module/Auto/MesMail.pm + A /vendor/current/module/Auto/Oper.pm + A /vendor/current/module/Auto/Random.pm + A /vendor/current/module/Auto/Reply.pm + A /vendor/current/module/Auto/Response.pm + A /vendor/current/module/Auto/Utils.pm + A /vendor/current/module/CTCP + A /vendor/current/module/CTCP/ClientInfo.pm + A /vendor/current/module/CTCP/Ping.pm + A /vendor/current/module/CTCP/Time.pm + A /vendor/current/module/CTCP/UserInfo.pm + A /vendor/current/module/CTCP/Version.pm + A /vendor/current/module/Channel + A /vendor/current/module/Channel/Freeze.pm + A /vendor/current/module/Channel/Join + A /vendor/current/module/Channel/Join/Connect.pm + A /vendor/current/module/Channel/Join/Invite.pm + A /vendor/current/module/Channel/Join/Kicked.pm + A /vendor/current/module/Channel/Mode + A /vendor/current/module/Channel/Mode/Get.pm + A /vendor/current/module/Channel/Mode/Oper + A /vendor/current/module/Channel/Mode/Oper/Grant.pm + A /vendor/current/module/Channel/Mode/Set.pm + A /vendor/current/module/Channel/Rejoin.pm + A /vendor/current/module/Defence + A /vendor/current/module/Defence/ChannelConf.pm + A /vendor/current/module/Defence/Command.pm + A /vendor/current/module/Defence/Distinction.pm + A /vendor/current/module/Defence.pm + A /vendor/current/module/Log + A /vendor/current/module/Log/Channel.pm + A /vendor/current/module/Log/Logger.pm + A /vendor/current/module/Log/Recent.pm + A /vendor/current/module/System + A /vendor/current/module/System/Macro.pm + A /vendor/current/module/System/Pong.pm + A /vendor/current/module/System/PrivTranslator.pm + A /vendor/current/module/System/Reload.pm + A /vendor/current/module/System/RemoteControl.pm + A /vendor/current/module/System/Shutdown.pm + A /vendor/current/module/Tools + A /vendor/current/module/Tools/DateConvert.pm + A /vendor/current/module/Tools/FileCache + A /vendor/current/module/Tools/FileCache/EachFile.pm + A /vendor/current/module/Tools/FileCache.pm + A /vendor/current/module/Tools/GroupDB.pm + A /vendor/current/module/Tools/HashDB.pm + A /vendor/current/module/Tools/HashTools.pm + A /vendor/current/module/Tools/LinedDB.pm + A /vendor/current/module/Tools/MailSend + A /vendor/current/module/Tools/MailSend/EachServer.pm + A /vendor/current/module/Tools/MailSend.pm + A /vendor/current/module/User + A /vendor/current/module/User/Away + A /vendor/current/module/User/Away/Client.pm + A /vendor/current/module/User/Away/Nick.pm + A /vendor/current/module/User/Filter.pm + A /vendor/current/module/User/Ignore.pm + A /vendor/current/module/User/Kick.pm + A /vendor/current/module/User/Nick + A /vendor/current/module/User/Nick/Detached.pm + A /vendor/current/module/User/ServerOper.pm + A /vendor/current/module/User/Vanish.pm + A /vendor/current/sample.conf + A /vendor/current/tiarra + A /vendor/current/tiarra-conf.el + A /vendor/current/tiarra-conf.l + +Load temp-20030924-005641.17303 into vendor/current. + +------------------------------------------------------------------------ diff -urN /non-existant-dir/HACKING tiarra-20050322/HACKING --- /non-existant-dir/HACKING 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/HACKING 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,186 @@ +モジュールについて + +* モジュールの新規作成 +module/Skelton.pm にモジュールのスケルトンがありますので、 +これをコピーして不要な関数を削除すれば、作ることが出来ます。 + +* 注意すべき事項 + - Tiarra はシングルスレッドです。時間がかかる処理をそのままやってはいけません。 + Timer や Hook, ソケット入出力なら ExternalSocket を使って少しずつ処理してください。 + - conf の変更が起きると、モジュールはインスタンスごと再初期化されます。 + 設定変更後にも必要なデータは、適切なオブジェクトの remark か、 BulletinBoard に + 書いてください。 + +* 良く使うモジュール/関数 + - Tiarra::SharedMixin(main/Tiarra/SharedMixin.pm) + インポートするだけで ->shared を簡単に実現する mixin です。 + ->_new(...) がインスタンス初期化に呼ばれ、 ->_initialize(...) が + (->shared を利用する文を含む)初期化用に呼ばれます。 ->_initialize は定義しなくても OK です。 + + $class_or_this->_this $class_or_this がただのパッケージ名だったとしても、 + ->shared を呼び出してインスタンス化します。 + クラスメソッド (package->func(...)) を簡単に実装したいときに + 使えます。 + - Tiarra::Utils(main/Tiarra/Utils.pm) + このモジュールの関数はすべて package->func(...) または package->shared->func(...) で呼んで + ください。 + + define_function($code, $funcname, ...) + 呼び出し元パッケージに $code で指定された関数を $funcname という + 名前で追加します。 + + define_attr_accessor($class_method, $name, ...) + 呼び出し元パッケージに $name で指定された属性アクセサ(値の取得設定 + ともに可能なもの)を定義します。 + $class_method には、この関数を package->name(...) でアクセスできる + ようにするかを指定します。 + $name には無名配列を指定することもでき、その場合は[関数名, 属性名] + と解釈されます。 + + define_attr_getter($class_method, $name, ...) + 呼び出し元パッケージに $name で指定された属性取得関数を定義します。 + 引数の意味は define_attr_accessor と同じです。 + + define_attr_setter($class_method, $name, ...) + 呼び出し元パッケージに $name で指定された属性設定関数を定義します。 + 引数の意味は define_attr_accessor と同じです。 + + get_packag($level) 呼び出し元のパッケージ名を取得します。 + $level が省略された場合は 0 で、この値は呼び出し元の呼び出し元(通常 + 欲しいと思われる値)を返します。 + + cond_yesno($str, $default) + $str を yes か no か評価します。他には true と false を受け付け + ます。 $str が未定義だった場合は $default (または 0)を返します。 + + to_str($value, ...) 任意の値を文字化します。特に undef/ininitialized なエラーを無視して + 文字化します。 + + get_first_defined($value, ...) + 引数の中で一番最初に定義されていたものを返します。 + (with defined_or: $a // $b // $c // ...) + - Tiarra::ShorthandConfMixin(main/Tiarra/ShorthandConfMixin.pm) + _runloop を定義した状態でインポートすると、 _conf, _conf_general, _conf_networks, + _conf_messages を定義します。 + - Mask(main/Mask.pm) + 汎用に使えるマスクマッチング関数群が実装してあります。 + 良く使う形は + Mask::match_deep_chan([$this->config->mask('all')], $msg->prefix, $channel_name_with_network) + Mask::match_deep([$this->config->keyword('all')], $keyword) + だと思います。 + + - ModuleManager(main/ModuleManager.pm) + ここで紹介する関数は、全て ModuleManager->shared_manager->function(...) と呼んで下さい。 + + add_to_blacklist($modname) + $modname で指定されたモジュールをブラックリストに入れる。 + ブラックリストに入れられたモジュールは、リロードするか削除される + まで呼び出されない。成功したら正を返す。 + + remove_from_blacklist($modname) + $modname で指定されたモジュールをブラックリストから削除する。 + 成功したら正を返す。 + + check_blacklist($modname) $modname で指定されたモジュールがブラックリストに入っていれば + 正を返す。 + + + - Multicast(main/Multicast.pm) + + detach($str) 文字列 $str からネットワーク名を外す。 + 戻り値: (セパレータ前の文字列,ネットワーク名,ネットワーク名が明示されたかどうか) + ただしスカラーコンテクストではセパレータ前の文字列のみを返す。 + + attach($str, $network_name) + $str にネットワーク名を付ける。 + $strはChannelInfoのオブジェクトでも良い。 + $network_nameは省略可能。IrcIO::Serverのオブジェクトでも良い。 + + attach_for_client($str, $network_name) + クライアント向けに、 multi-server-mode でなければ attach しない。 + + nick_p($str) 文字列 $str が nick name として許される形式なら 1 を返す。 + ネットワーク名は付けたままでも構わない。処理前に detach される。 + + channel_p($str) 文字列 $str が channel name として許される形式なら 1 を返す。 + ネットワーク名は付けたままでも構わない。処理前に detach される。 + + - RunLoop(main/RunLoop.pm) + ここで紹介する関数は、全て RunLoop->shared_loop->function(...) と呼んで下さい。 + + channel($str) チャンネルを探す。 + ネットワーク名付きのチャンネル名が引数です。 + 無ければ undef を返します。 + + broadcast_to_clients(@messages) + メッセージを全てのクライアントに送信する。 + + notify_msg($str) 全てのクライアントと、 STDOUT にメッセージを通知します。 + + notify_error($str) notify_msg を使ってエラーを通知します。 + + notify_warn($str) notify_msg を使って警告を通知します。 + + terminate($message) サーバとクライアントを切断して終了します。 + + - main(tiarra) + + ::printmsg() STDOUT にのみメッセージを通知します。 + + ::debug_printmsg() デバッグモードの時のみメッセージを通知します。 + + ::debug_mode() デバッグモードなら 1 を返します。 + + ::ipv6_enabled() IPv6 が有効なら 1 を返します。 + + - BulletinBoard(main/BulletinBoard.pm) + ここで紹介する関数は、全て BulletinBoard->shared->function(...) と呼んで下さい。 + + set($key, $value) 掲示板に $key という名前で値 $value をセットします。 + $key を __PACKAGE__."/key" という名前にすれば + 被りにくいと思います。 + + get($key) $key でセットした値を得ます。 + + keys BulletinBoard が保持しているテーブルを返します。 + この内容を変更すると、当然 BulletinBoard の内容も変わります。 + + - Auto::Utils(module/Auto/Utils.pm) + + generate_reply_closures(...) + 一般的な自動反応をするのに有用なクロージャを生成する。 + + sendto_channel_closure(...) + チャンネル等に PRIVMSG / NOTICE を送るクロージャを生成する。 + 一般的な使い方は Skelton.pm に書いておきました。 + +* remark のあるオブジェクト + remark とは、オブジェクトに関連づけられた、自由に使える key/value pair です。 + remark 機能の存在するオブジェクトと、(あるなら)広く使われている既定の remark を挙げます。 + - IrcIO::Client + - IrcIO::Server + 再接続時には remark はクリアされません。 + + 情報取得系 + * server_hops 自分のつながっている server と、あるサーバの hop 数の対応を + (情報が得られたときに)記録しています。 + * isupport RPL_ISUPPORT が送ってくる情報を記録しています。 + RPL_ISUPPORT の詳細は http://www.irc.org/tech_docs/005.html 等を + 参照してください。 + 対応していないサーバでは remark は存在しません。 + * uid RPL_YOURID が送ってくる情報を記録しています。 + 対応していないサーバでは remark は存在しません。 + - IRCMessage + + 情報取得系 + * affected-channels NICK や QUIT などの全チャンネルに波及するメッセージのときに + 影響を受けたチャンネルが設定されていることがあります。 + * old-topic TOPIC 時に一つ前のトピックが設定されています。 + + 動作設定系 + * fill-prefix-when-sending-to-client + クライアントに送信するときに prefix (Tiarra が 001(RPL_WELCOME) + で返したもの) を補完します。 + * do-not-send-to-clients このメッセージを(ほかのモジュールで処理する可能性があるために + 残すけれど)クライアントには送信しないようにします。 + * do-not-send-to-servers do-not-send-to-clients と同じような理由で、サーバに送信しない + ようにします。 + * always-use-colon-on-last-param + シリアライズするとき、最終パラメータに常にコロンを使用する + ようにします。 + - ChannelInfo + + 情報取得系 + * kicked-out そのチャンネルから蹴り出されている(すでにそのチャンネルに + いない)かどうか。 + * switches-are-known チャンネルモードを取得済みかどうか。 + * creation-time RPL_CREATIONTIME が返した値。 + - PersonInChannel + - PersonalInfo + +* Hook + - 基本的な使い方: + use SomePackage::Hook; + my $hook = SomePackage::Hook->new(sub{ + my $hook = shift; + # do something + })->install('someplace'); + - Hook のあるパッケージ、 Hook 名と簡単な説明 + + RunLoop + * before-select select 前 + * after-select select 後 + * set-current-nick set_current_nick が呼ばれたとき + + Configuration + * reloaded conf が再読込されたとき + + IrcIO::Client + * channel-info($client, $ch_name, $network, $ch) + 接続時に Join しているチャンネルごとに呼ばれる。 + チャンネル情報とともに recent log を送ったりする場合に使える。 + +Local variables: +mode: text +End: diff -urN /non-existant-dir/INSTALL tiarra-20050322/INSTALL --- /non-existant-dir/INSTALL 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/INSTALL 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,65 @@ +-*- text -*- +$Id: INSTALL 731 2004-12-29 07:50:32Z topia $ + +必要なもの +========== +* Perl: + 5.6.0 以上。 + +あるとよいもの +============== +* IO::Socket::INET6 または Socket6: + インストールすると IPv6 のサポートが追加されます。 +* Unicode::Japanese: + 特に XS モジュールをインストールすると性能が改善されます。 +* ithreads: + 5.8.0 以上で ithreads を有効にした場合に、 DNS 解決時の性能低下がなくなります。 +* Win32::GUI: + System::NotifyIcon:Win32 を使う場合に必須です。 + +手順 +==== +1. 必要なものをインストールしたら、 sample.conf をファイル名を変えてコピーします。 + $ cp sample.conf foo.conf + +2. コピーした conf ファイルを編集します。 + $ vi foo.conf + 最低でも main, network, そして network/name で指定したネットワークのブロック + (指定してないブロックは無視されるので書き換えていなくても大丈夫です) + を書き換えてください。 + 自動 Join 設定は Channel::Join::Connect に、ログ取り設定は Log::Channel にあります。 + 使うときはブロックの先頭の - を + に変えるのを忘れずに。 + +3. 起動します。 + $ ./tiarra --config=foo.conf --quiet + (これで起動しないときは perl ./tiarra ... で試す) + +TIPS +==== +* ログファイルなどのパスは起動時のディレクトリからの相対になります。 + (絶対指定も可能です) + たとえば: + | tiarra/test/tiarra.conf + | tiarra/tiarra + | tiarra/main/... + | tiarra/... + なディレクトリ構成の時に + $ cd tiarra/test + $ ../tiarra --config=tiarra.conf + とすれば、 + | tiarra/test/log/others/... + | tiarra/test/log/priv/... + といった感じになります。 + +* --config を省略した場合は、標準入力か tiarra.conf を読みます。 + +* シンボリックリンクを張った場合でも問題なく運用できます。 + たとえば: + | /home/foo/tiarra/test/tiarra -> /usr/share/tiarra/tiarra + | /usr/share/tiarra/main/... + | /usr/share/tiarra/... + という構成( -> はシンボリックリンク)でも問題ありません。 + その場合、 + | /home/foo/tiarra/test/module/Auto/Reply.pm + などを置いた場合は /usr/share/tiarra/module/Auto/Reply.pm より + 優先されます。 diff -urN /non-existant-dir/LICENSE tiarra-20050322/LICENSE --- /non-existant-dir/LICENSE 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/LICENSE 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,2 @@ +This is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. diff -urN /non-existant-dir/NEWS tiarra-20050322/NEWS --- /non-existant-dir/NEWS 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/NEWS 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,292 @@ +2004-08-22 Topia + + * Client::Rehash + - 追加。クライアントの nick と names を訂正する。 + + * System::Error + - 追加。クライアントに送信するときに ERROR メッセージを + NOTICE に埋め込む。 + - このモジュールはデフォルトオンです。アップデートの際は忘れずに + 追加するようにしてください。 + + * Log::Channel + - Log::Writer フレームワークを使うようにしました。 + - file system full 等で書き込みに失敗しても、出来る限りログを + 保持します。 + +2004-07-29 Topia + + * System::NotifyIcon::Win32 + - 追加。タスクバーの通知領域にアイコンを表示し、コンソールの + 表示・非表示、 conf リロード、終了などができます。 + +2004-07-09 Topia + + * System::Reload + - conf-reloaded-notify を追加。(デフォルトで有効) + conf ファイルが再読込された場合に通知します。 + +2004-06-19 Topia + + * Client::Cotton + - 追加。いくつかの Cotton の不具合を回避する(予定)。 + 今は network rejoin 時の自動 part を無視します。 + Client::GetVersion と組み合わせると良いと思います。 + + * Client::GetVersion + - 追加。クライアントの接続時に CTCP Version を発行して + クライアントのバージョンを取得します。 + +2004-06-04 Topia + + * 全般 + - 今回の変更は RPL_ISUPPORT のクライアントへの送信が必要なければ、 + 再起動する必要はありません。 + 再起動せずにリロードしてもエラーが起こることはないと思います。 + - 書き忘れていましたが Unicode::Japanese 0.21 (の PurePerl) にて + SI/SO な jis への対応が行われています。(2004-05-26 の update) + +2004-03-07 Topia + + * 全般 + - taint check モードで動作するようになりました(多分)。 + +2004-02-23 Topia + + * Debug::RawLog + - 追加。生の IRC メッセージ(のようなもの?)を ::printmsg を使って + 表示する。 + + * sample.conf + - 順序が変わっています。注意してください。 + - general/omit-sysmsg-prefix-when-possible 削除。 + - general/sysmsg-prefix-use-masks ブロック追加。 + + * Log::Recent + - no-client-logs クライアントオプションが追加されました。 + クライアントオプションの使い方は、 + realname 部分に $no-client-logs=1$ を指定します。 + 複数ある場合は $no-client-logs=1;a=1;...$ のように指定できます。 + + * 全般 + - クライアントとの接続時にチャンネルの送出順を指定する patch を + 暫定的に取り込みました。 networks に fixed-channels ブロックを + 作り、中に channel をキー名としてマスクを列挙します。 + 例: + fixed-channels { + channel: #てすとちゃんねる@ircnet + channel: #てすと@localserver + channel: *@localserver + channel: *@localserver:*.jp + } + マッチしなかったチャンネルについては最後にまとめて + (順番がごちゃごちゃになって)送られてきます。 + conf の設定場所は暫定です。変わる可能性があるので注意してください。 + - doc/ 以下に HTML でのドキュメントが生成されていますが、 + まだ未調整な部分も多くあるので、正確な記述は sample.conf を参照してください。 + +2004-02-21 phonohawk + + * Channel::Freeze + freezeコマンドの引数は、これまでは完全なチャンネル名であったが、 + これはマスクに変更。その時にJOINしている全てのチャンネルの中から + マスクに一致した全てのチャンネルを凍結する。 + + * 設定 general/omit-sysmsg-prefix-when-possible 追加。 + これが1である時、sysmsg-prefixはチャンネルに対してのメッセージ + でなければ省略する。デフォルトは1。 + +2004-02-15 Topia + + * Client::Cache + - 昨日の分だけでは Excess Flood/Max SendQ Exceeded 対策として + 不十分だったので、アップデートを推奨します。 + - 2つ以上のクライアントが同時に同じ動作をする場合に、 + 今回の変更で効果が出ます。 + 長すぎず短すぎずの絶妙な差で同じ動作をされた場合には + 効きませんが、滅多にそんなことはない(と思いたい)です。 + +2004-02-14 Topia + + * Log::Recent, System::Raw, Channel::Freeze, Channel::Rejoin + - これらのモジュールのうち一つでも組み込んでいる場合は、 + リロードする前に Tiarra を再起動させてください。 + 新たに入った機能を使っています。 + + * Client::Cache + - 新規追加。クライアントからの問い合わせのうち、 + Tiarra が情報を持っていて、 + サーバに問い合わせる必要がないものをキャッシュとして返します。 + - いまのところ MODE キャッシュと、 WHO キャッシュを実装していて、 + どちらも、クライアントからの最初の問い合わせのときにのみ + キャッシュを使います。 + - LimeChat(1.18 で WHO 機能を切れるようになりましたが) や、 + X-Chat などのクライアントを使用されている場合は、 + 組み込むと便利です。 + + * Client::Eval + - 追加。クライアントからのコマンドしか受け付けませんが、 + その代わりすべてのコマンドを実行できます。 + 事実上 IRC パスワードがわかれば Tiarra が動いているホスト上で + 動作しているアカウントの権限で何でもできる、 + ということに注意してください。 + - 意味がわからなければ組み込まないことを推奨します。 + 必要な時だけ組み込んで、すぐはずす、というのも良いかもしれません。 + +2004-01-27 phonohawk + + * 行の終わりにCRLFでなくLFを付けるようなクライアントでも + 正しく動作するようになりました。 + +2004-01-23 phonohawk + + * tiarra: 起動時オプション --make-password 追加。 + make-passwordの機能をtiarra本体に移した。 + + * make-password: 削除 + +2003-11-17 Topia + + * Log::Channel + mode のデフォルトが 644 から 600 に変更されました。 + mode をコメントアウトしている場合は注意してください。 + dir-mode が追加され、デフォルトが 700 です。 + これも、必要に応じて 755 を指定するようにしてください。 + +2003-11-09 Topia + + * System::Reload + 自分自身がリロードできないバグの修正。 + kill -HUP pid は出来るので、これを使ってリロードしてください。 + + * single-server-mode の bugfix です。 + single-server-mode を使う予定が無い場合は再起動は不要です。 + single-server-mode を使っている方は、アップデートして再起動して下さい。 + +2003-11-08 Topia + + * single-server-mode の bugfix です。 + single-server-mode を使う予定が無い場合は再起動は不要です。 + single-server-mode を使っている方は、アップデートして再起動して下さい。 + +2003-10-16 phonohawk + + * System::Raw + 追加。Tiarraに改変されない生のメッセージをサーバーに送るためのモジュール。 + +2003-10-14 Topia + + * single-server-mode の bugfix です。 + single-server-mode を使う予定が無い場合は再起動は不要です。 + +2003-09-28 phonohawk + + * tiarra-conf.el: + mmm-modeがインストールされていて、(require 'mmm-mode)または + (require 'mmm-auto)されている場合に、tiarra-conf用の設定を + 行った後、それを有効にする。 + + mmm-modeのサイトは次のURLに。 + http://mmm-mode.sourceforge.net/ + +2003-09-25 Topia + + * このバージョン以前の Tiarra には、 + モジュールのアンロードをすると原因不明のエラーが起こるバグがあります。 + また、アップグレードの際には再起動が必要です。 + +2003-08-12 phonohawk + + * シングルサーバーモードを実装。 + networks/multi-server-modeを0に設定すると、シングルサーバーモードになります。 + この状態では同時に接続出来るサーバーの数が一つに制限され、クライアントから見た + チャンネル名にネットワーク名が付かなくなります。 + +2003-07-31 Topia + + * mask のチャンネル名にネットワーク名を必要とするように修正した。 + 影響を受けるモジュールは + - Auto::Oper + - Auto::Random + - Auto::Reply + - Auto::MesMail + - Auto::Alias + - Auto::Response + です。変更よろしくお願いします。(^^;; + +2003-07-10 phonohawk + + * Channel::Freeze + 追加。特定のチャンネルのNOTICEやPRIVMSGの中継を + 一時的に中断するためのモジュール。 + 発言を見たくないがPARTはしたくない、といった場合に有効。 + +003-07-03 phonohawk + + * Auto::Oper + 複数の応答が定義されていれば、ランダムに一つ選んで発言する。省略も可能。 + +2003-06-06 phonohawk + + * general/nickを、それぞれのネットワーク設定ブロックのnickでオーバーライド可能に。 + +2003-05-27 phonohawk + + * Tiarra本体の誤動作によりCPU時間を食い潰している可能性を検出して警告する。 + +2003-05-24 phonohawk + + * IPv6対応 + general/tiarra-ip-versionに'v6'を指定する事で、IPv6でのリスニングを行なう。 + また、サーバーには最初にIPv6での接続を試みてからIPv4にフォールバックする。 + 詳細はsample.confに。 + +2003-05-23 Topia + + * Auto/Reply.pm: 追加。 + plum の auto/reply.plm に相当する。 + + * Auto/Alias.pm: キーを指定しての値削除、削除した個数の表示が可能になったため、 + サンプルの removed-format が変更されています。好みに合わせて変更してください。 + +2003-05-21 phonohawk + + * tiarra-conf.l: 追加。 + Noboruhiさんによるxyzzy用tiarra.conf編集モード。 + インストール方法はtiarra-conf.l内に記述されています。 + +2003-04-29 phonohawk + + * Channel/Join/Kicked.pm: 追加。チャンネルから蹴られた時に、自動JOINするモジュール。 + +2003-04-13 phonohawk + + * User/Vanish.pm: 追加 + 特定のチャンネルでの特定の人物の存在をクライアントに隠すモジュール。 + JOINやPART、QUIT等を消去する。 + +2003-04-05 phonohawk + + * モジュール Auto::Joined 追加。 + 特定のチャンネルに誰かがJOINする度に特定の発言を行なうモジュール。 + チャンネル移転通知以外に使うのはやめた方が良い。 + +2003-03-28 Topia + + * sample.conf (Auto/Random.pm): 設定に mask プロパティが抜けていました。 + Auto/Random.pm を使っていた方は、 sample.conf にしたがって適当なところに追加してください。 + +2003-03-23 phonohawk + + * User/Filter.pm: 新規追加。 特定の人物の発言にフィルタをかける。 + + * general/bind-addrでサーバーへの接続時のローカル側アドレスを指定可能になりました。 + +2003-03-23 Topia + + * Channel/Join/Invite.pm: 新規追加。 Invite されたチャンネルに Join する。 + +2003-03-19 Topia + + * Auto/Random.pm: 設定ファイルの形式がかなり変わっています。 + sample.conf を参照して書き換えをお願いします。 diff -urN /non-existant-dir/all.conf tiarra-20050322/all.conf --- /non-existant-dir/all.conf 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/all.conf 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,1464 @@ +# -*- tiarra-conf -*- +# ----------------------------------------------------------------------------- +# $Id: all.conf.in 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# tiarra.conf サンプル +# このファイルにはすべてのブロックの解説があります。 +# 必要なブロックがあればここからコピーしていってください。 +# ----------------------------------------------------------------------------- + +# ----------------------------------------------------------------------------- +# generalブロック +# +# tiarra.conf自身の文字コードやユーザー情報などを指定するブロックです。 +# ----------------------------------------------------------------------------- +general { + # tiarra.conf自身の文字コード + # コード名はjis,sjis,euc,utf8,utf16,utf32等。(この値はUnicode::Japaneseにそのまま渡されます) + # autoが指定された、または省略された場合は自動判別します。 + conf-encoding: euc + + # ユーザー情報 + # 省略不能です。 + nick: tiarra + user: tiarra + name: Tiarra the "Aeon" + + # どのようなユーザーモードでログインするか。+iwや+iのように指定する。 + # 省略された場合はユーザーモードを特に設定しない。 + #user-mode: +i + + # Tiarraへの接続を許可するホスト名を表わすマスク。 + # 制限をしないのであれば"*"を指定するか省略する。 + client-allowed: * + + # Tiarraが開くポート。ここに指定したポートへクライアントに接続させる。 + # 省略されたらポートを開かない。 + tiarra-port: 6667 + + # Tiarraがポートtiarra-portを開く際、IPv6とIPv4のどちらでリスニングを行なうか。 + # 'v4'または'v6'で指定します。デフォルトは'v4'です。 + # IPv6を使うためにはSocket6.pmが利用可能である必要があります。 + #tiarra-ip-version: v4 + + # Tiarraがポートtiarra-portを開く際のローカルアドレス。 + # 意味が分からなければ省略して下さい。 + # デフォルトは、IPv4のはINADDR_ANY、IPv6のはin6addr_anyになります。 + #tiarra-ipv4-bind-addr: 0.0.0.0 + #tiarra-ipv6-bind-addr: ::0 + + # Tiarraにクライアントが接続する際に要求するパスワードをcryptした文字列。 + # 空の文字列が指定されたり省略された場合はパスワードを要求しない。 + # crypt は ./tiarra --make-password で行えます。 + tiarra-password: xl7cflIcH9AwE + + # 外部プログラムからtiarraをコントロールする為のUNIXドメインソケットの名前。 + # 例えば"foo"を指定した場合、ソケット/tmp/tiarra-control/fooが作られる。 + # 省略された場合はこの機能を無効とする。 + # また、非UNIX環境ではそもそもUNIXドメインソケットが利用可能でないため、 + # そのような場合にもこの機能は無効となる。 + #control-socket-name: test + + # IRCサーバーから送られる文字のコードと、IRCサーバーへ送る文字のコード + # どちらも省略された場合はjis。 + server-in-encoding: jis + server-out-encoding: jis + + # クライアントから受け取る文字のコードと、クライアントへ伝える文字のコード + # どちらも省略された場合はjis。 + client-in-encoding: jis + client-out-encoding: jis + + # Tiarraは標準出力に様々なメッセージを出力するが、その文字コードを指定する。省略時にはeucとなる。 + # ただしtiarra.confのパースが完了するまでは文字コードの変換は行なわれない(つまりこの設定が有効にならない)ことに注意して下さい。 + stdout-encoding: euc + + # Tiarraはエラーメッセージを標準出力に出力するが、その時に接続しているクライアントがあればクライアントにもNOTICEで送る事が出来る。 + # この値を1にすると、その機能が有効になる。省略するか0を指定するとこの機能は無効になる。 + notice-error-messages: 1 + + # Tiarraでチャンネルとユーザーのマスクを指定するときの形式。 + # plum形式とTiarra形式が選択できます。 + #----------------- + # plum形式: (channelには+や-は使えない。channelは省略すると*とみなす。) + # + syntax: user[ channel[ channel[ ...]]] + # + # mask: +*!*@*.example.com #{example}@ircnet +{example3}@ircnet + # mask: -*!*@*.example.com #{example2}@2ch,+{example4}@2ch + # mask: -*!*@* + #----------------- + # Tiarra形式: (channelにも+や-を使える。) + # + syntax: channel user + # + # mask: #{example}@ircnet,-#{example2}@2ch +*!*@*.example.com + # mask: ++{example3}@ircnet,-+{example4}@2ch +*!*@*.example.com # +で始まるチャンネル。 + # mask: * -*!*@* + #----------------- + # となります。 この二つはまったく同じマスクを表しています。 + + # この値をplumにすると、plum形式、省略するかtiarraを指定すると、Tiarra形式になります。 + chanmask-mode: tiarra + + # サーバーに接続する際、ローカル側のどのアドレスにバインドするか。 + # 意味が分からなければ省略して下さい。 + # デフォルトは、IPv4のはINADDR_ANY、IPv6のはin6addr_anyになります。 + #ipv4-bind-addr: 0.0.0.0 + #ipv6-bind-addr: ::0 + + # tiarra が、 001 や 002 や、 recent log を送信するときなどに使う prefix + # を指定します。 hostname や fqdn っぽいものを指定すると良いかもしれません。 + # デフォルトは tiarra です。普通変える必要はありません。 + #sysmsg-prefix: tiarra + + sysmsg-prefix-use-masks { + # sysmsg-prefix を使用する場所を指定する。 + + # システムメッセージ(NumericReply など)。デフォルトは * です。 + # ふつうこれを変更する必要はありません。 + system: * + + # 個人宛メッセージ(Notice,Privmsg の中で)。デフォルトはなし。 + #priv: + + # チャンネル宛メッセージ(Notice,Privmsg の中で)。デフォルトは * です。 + # Ziciz などのクライアントを接続する場合は、 + # -*::log を指定しておくといいかもしれません。 + channel: * + } + + # Tiarra が nick 変更時の衝突等を処理するモードを指定します。 + # 0: Tiarra が接続時と同様に自動処理します。 + # 1: クライアントにそのまま投げます。 + # 複数のクライアントが nick 重複を処理する場合は非常に危険です。 + # (設定不足の IRC クライアントが複数つながっている場合も含みます) + # 2: 対応するエラーメッセージ付きの NOTICE に変換して、 + # クライアントに投げます。 + # multi-server-mode 時のデフォルトは 0 、 single-server-mode 時のデフォルトは 1 です。 + #nick-fix-mode: 0 + + messages { + # Tiarra が使用する、いくつかのメッセージを指定する。 + + quit { + # ネットワーク設定が変更され、再接続する場合の切断メッセージ + netconf-changed-reconnect: Server Configuration changed; reconnect + + # ネットワーク設定が変更され、切断する場合の切断メッセージ + netconf-changed-disconnect: Server Configuration changed; disconnect + } + } +} + +# ----------------------------------------------------------------------------- +# networksブロック +# +# Tiarraから接続するIRCネットワークの名称です。 +# 一つも定義しなかった場合やこのブロックを省略した場合は、 +# "main"というネットワークが一つだけ指定されたものと見做します。 +# ----------------------------------------------------------------------------- +networks { + # 複数のサーバーへの接続を可能にするかどうか。1(オン)と0(オフ)で指定。 + # これを1にすると、次のnameを複数個定義する事が可能になり、 + # 複数のサーバーに同時に接続出来るようになります。 + # その一方、これを1にしている時は、チャンネル名にネットワーク名が付加される等、 + # IRCの大部分のメッセージがTiarraによる改変を受けます。 + # これを0にしている間は、次のnameを複数個定義する事は出来なくなります。 + # マルチサーバーモードの設定を起動中に変えると、クライアントから見たチャンネル名が + # 変更になる為、全クライアントが一時的に全てのチャンネルからpartしたように見え、 + # その直後にjoinし直したように見えます。 + # デフォルトでは1です。 + multi-server-mode: 1 + + # 接続するIRCネットワークに名前を付けます。この名前は後で使用します。 + # 複数のネットワークに接続したい場合は多重定義して下さい。 + name: ircnet + name: 2ch + + # 通常Tiarraではチャンネル名を「#Tiarra@ircnet」のように表現します。 + # これはネットワークircnet内の#Tiarraというチャンネルを表わします。 + # @以降は省略可能ですが、省略された場合のデフォルトのネットワーク名をここで指定します。 + # 省略した場合は最も始めに定義されたnameがデフォルトになります。 + # (そしてnameが一つも無かった場合はmainがデフォルトになります) + #default: ircnet + + # 上に述べた通り、デフォルトではTiarraはチャンネル名とネットワーク名を@で区切ります。 + # この区切り文字は任意の文字に変更する事が出来ます。省略された場合は@になります。 + channel-network-separator: @ + + # 接続先のサーバーから切断された時に、joinしていたそのサーバーのチャンネルをどうするか。 + # 1. "part-and-join"の場合は、切断されるとクライアントにはチャンネルからpartしたように見せ掛け、 + # 再接続に成功すると再びjoinしたように見せ掛ける。最も負荷が高い。(これはplumに似た動作である) + # 2. "one-message"の場合は、切断されるとクライアントに宛ててTiarraがNOTICEでその旨を報告する。 + # 再接続に成功すると再びNOTICEで報告する。JOINやPARTはしないので、 + # クライアントからはまだそのチャンネルに残っているかのように見える。 + # 3. "message-for-each"の場合は、切断されるとクライアントに宛ててTiarraが + # 到達不能になった全てのチャンネルにNOTICEでその旨を報告する。 + # 再接続に成功すると再びNOTICEで報告する。JOINやPARTはしない。 + # デフォルトはpart-and-joinです。 + action-when-disconnected: message-for-each + + # NICKを変更する度に、変更したサーバーでの新しいNICKをNOTICEで常に通知するかどうか。 + # 1なら必ず通知し、0なら変更後のnickがローカルnick(クライアントが見る事の出来るnick)と違っている場合のみ通知する。 + # デフォルトは0です。 + always-notify-new-nick: 0 + + fixed-channels { + # Tiarra がクライアント接続時にチャンネル情報を送る順番を指定する。 + # マッチしなかったチャンネルについては最後にまとめて + # (順番がごちゃごちゃになって)送られてきます。 + channel: #てすとちゃんねる@ircnet + channel: #てすと@localserver + channel: *@localserver + channel: *@localserver:*.jp + } +} + +# ----------------------------------------------------------------------------- +# 各ネットワークの設定 +# +# networksブロックで定義した全てのネットワークについて、 +# そのアドレス、ポート、(必要なら)パスワードを定義します。 +# ----------------------------------------------------------------------------- +ircnet { + # サーバーのホストとポート。省略不可。 + host: irc.nara.wide.ad.jp + port: 6663 + + # general/userで設定したユーザ名を使わずに、各ネットワークで独自のユーザ名を使用する事も可能。 + # 省略されたら当然、general/userで設定したものが使われる。 + #user: hoge + + # general/nameで設定した本名(建前上)を使わずに、各ネットワークで独自の本名を使用可能。 + #name: hoge + + # このサーバーの要求するパスワード。省略可能。 + #password: hoge + + # general/setver-in/out-encodingで設定したエンコーディングを使わずに、 + # 各ネットワークで独自のエンコーディングを使用する事も可能。 + # 省略されたら当然、generalで設定したものが使われる。 + #in-encoding: jis + #out-encoding: jis + + # general/(ipv4|ipv6)bind-addrで設定したローカルアドレスを使わずに、 + # 各ネットワークで独自のbind_addrを使用する事も可能。 + # 省略されたらgeneralで設定したものが使われる。 + #ipv4-bind-addr: 0.0.0.0 + #ipv6-bind-addr: ::0 +} + +2ch { + host: irc.2ch.net + port: 6667 +} + +# ----------------------------------------------------------------------------- +# 必須の設定は以上です。以下はモジュール(プラグイン)の設定です。 +# ----------------------------------------------------------------------------- + +# +または-で始まる行はモジュール設定行と見做されます。 +# +で記述されたモジュールが使用され、-で記述されたモジュールは使用されません。 +# +や-の後の空白は幾つあっても無視されます。 + +# メッセージが各モジュールを通過する順番は、このconfファイルで記述された +# 順番の通りになります。ログを取るモジュールなどはconfでも後の方に +# 記述した方が良いということになります。 + +# モジュール名はperlのそれと同じようにディレクトリ区切り文字を「::」としたパスで表現されます。 +# 例えばモジュールChannel::Auto::Operの実体はファイルmodule/Channel/Auto/Oper.pm +# でなければならず、そのpackage宣言もChannel::Auto::Operでなければなりません。 +# Tiarraモジュールの名称は、perl標準モジュール群やmain/下の.pmファイルと重複しないように +# 気を付けて下さい。Tiarraはモジュールが本当にModuleのサブクラスかどうかをチェックするので +# 例えばIO::Socket::INETといったモジュールを置いても誤動作はしませんが、 +# そのようなモジュールはロード時にエラーを出して使用中止になります。 + +# 一つのモジュールを複数回定義して、何度も同じモジュールをメッセージが通過するようには出来ません。 + +# 幾つかのモジュールはパラメータとしてチャンネル名を必要とします。 +# ここで指定するチャンネル名は、ネットワーク名も含めた文字列でなければなりません。 +# 「#チャンネル」では駄目で「#チャンネル@ネットワーク」などとする必要があります。 + +# マスクの書式: +# ['+' / '-'] ( <マスク文字列> / "re:" 正規表現 ) +# これはカンマで幾つでも継ぐ事が出来ます。"\,"でカンマそのものを表します。 +# 先頭が+なら、それに続く部分にマッチするものが選ばれ、-なら除外されます。省略されたら+と見做されます。 +# マスク文字列とは"*"で0文字以上の任意の文字列を、"?"で1文字の任意の文字列を表す文字列です。 +# 例: +# tiarra* これはtiarraで始まる文字列を表す。 +# +*!*tiarra@*.jp,-re:\d これは*!*tiarra@*.jpにマッチして、かつ文字列中に数字を含まないものを表す。 + + +- Auto::Alias { + # ユーザエイリアス情報の管理を行ないます。 + + # エイリアスは基本的にname,userの二つのフィールドから成っており、 + # それぞれユーザー名、ユーザーマスクを表します。 + + # エイリアス定義ファイルのパスと、そのエンコーディング。 + # このファイルは次のようなフォーマットである。 + # 1. それぞれの行は「<キー>: <値>」の形式である。 + # 2. 空の行で、各ユーザーを区切る。 + # 3. <値>はカンマで区切られて複数の値とされる。 + # + # エイリアス定義ファイルの例: + # + # name: sample + # user: *!*sample@*.sample.net + # + # name: sample2,[sample2] + # user: *!sample2@*.sample.net,*!sample2@*.sample2.net + # + alias: alias.txt + alias-encoding: euc + + # この発言をした人のエイリアスが登録されていれば、それをprivで送る。 + confirm: エイリアス確認 + + # 「 user *!*user@*.user.net」のようにして情報を追加。 + # 発言をした人のエイリアスが未登録だった場合は、userのみ受け付けて新規追加とする。 + add: エイリアス追加 + + # 「 name ユーザー」のようにして情報を削除。 + # userを全て削除されたエイリアスは他の情報(name等)も含めて消滅する。 + remove: エイリアス削除 + + # メッセージが追加されたときの反応を指定します。 + # ランダムなメッセージを発言する際のフォーマットを指定します。 + # エイリアス置換が有効です。#(nick.now)、#(channel)は + # それぞれ相手のnick、チャンネル名に置換されます。 + # #(key)、#(value)は、追加されたキーと値に置換されます。 + added-format: #(name|nick.now): エイリアス #(key) に #(value) を追加しました。 + add-failed-format: #(name|nick.now): エイリアス #(key) の追加に失敗しました。 + + # メッセージが削除されたときの反応を指定します。 + # added-formatで指定できるものと同じです。 + removed-format: #(name|nick.now): エイリアス #(key) から #(value) を削除しました。 + remove-failed-format: #(name|nick.now): エイリアス #(key) からの削除に失敗しました。 + + # エイリアスの追加や削除が許されている人。省略された場合は「*!*@*」と見做される。 + modifier: *!*@* +} + +- Auto::Answer { + # 特定の発言に反応して対応する発言をする。 + + # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + + # 反応する発言と、それに対する返事を定義します。 + # エイリアス置換が有効です。#(nick.now)と$(channel)はそれぞれ + # 相手の現在のnickとチャンネル名に置換されます。 + # + # 書式: <反応する発言のマスク> <それに対する返事> + # 例: + #reply: こんにちは* こんにちは、#(name|nick.now)さん。 + # この例では誰かが「こんにちは」で始まる発言をすると、 + # 発言した人のエイリアスを参照して「こんにちは、○○さん。」のように発言します。 +} + +- Auto::Calc { + # Perlの式を計算させるモジュール。 + + # 反応する発言を指定します。 + request: 計算 + + # 使用を許可する人&チャンネルのマスク。 + # 例はTiarraモード時。 [default: なし] + mask: * +*!*@* + # [plum-mode] mask: +*!*@* + + # 結果が未定義だったときに置き換えられる文字列。省略されると undef 。 + #undef: (未定義) + + # 正常に計算できたときのフォーマット + # method: 計算式, result: 結果, error: エラー, signal: シグナル + reply-format: #(method): #(result) + + # エラーが起きたときのフォーマット + # method: 計算式, result: 結果, error: エラー, signal: シグナル + error-format: #(method): エラーです。(#(error)) + + # シグナルが発生したときのフォーマット + #signal-format: #(method): シグナルです。(#(signal)) + + # signal-$SIGNALNAME-format 形式。 + # $SIGNALNAME には現状 alarm/sigfpe があります。 + # 該当がなければ signal-format にフォールバックします。 + + # いくつかの例を挙げます。 + #signal-alarm-format: #(method): 時間切れです。 + #signal-sigfpe-format: $(method): 浮動小数点計算例外です。 + + # タイムアウトする秒数を指定します。 alarm に渡されます。 + # 再帰を止めるのに使えますが、どうもメモリリークしていそうな雰囲気です。 + timeout: 1 + + # サブルーチン定義を許可するかどうかを指定する。 + # 再帰定義が可能なので、許可する場合はこのモジュール専用の + # Tiarra を動かすことをお勧めします。 + permit-sub: 0 + + # 初期化する発言を指定します。 + # このモジュールでは現状変数や関数定義などを行えます。 + # このコマンドが発行されるとそれらをクリアします。 + init: 計算初期化 + + # 初期化を許可する人&チャンネルのマスク。 + # 例はTiarraモード時。 [default: なし] + init-mask: * +*!*@* + # [plum-mode] mask: +*!*@* + + # 再初期化したときの発言を指定します。 + init-format: 初期化しました。 +} + +- Auto::ChannelWithoutOper { + # チャンネルオペレータ権限がなくなってしまったときに発言する。 + + # +で始まらない特定のチャンネルで、+aモードでも+rモードでもないのに + # 誰もチャンネルオペレータ権限を持っていない状態になっている時、 + # そこに誰かがJOINする度に特定のメッセージを発言するモジュールです。 + + # 書式: <チャンネル名> <メッセージ> + #channel: #IRC談話室@ircnet なると消失しました。 +} + +- Auto::Joined { + # 特定のチャンネルに誰かがJOINする度に特定のメッセージを発言する。 + + # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + + # 発言を行なうチャンネルと、その内容を定義します。 + # #(nick.now)と$(channel)は、それぞれ相手の現在のnickとチャンネル名に置換されます。 + # + # 書式: <チャンネル名> <発言内容> + #channel: #チャンネル@ircnet 「#ちゃんねる」に移転しました。 +} + +- Auto::MesMail { + # 伝言をメールとして送信する。 + + # メールアドレスはエイリアスの mail を参照します。 + + # Fromアドレス。[default: OSのユーザ名] + from: example1@example.jp + + # 送信用のキーワード [default: mesmail_send] + send: 速達伝言 + + # 使用を許可する人&チャンネルのマスク。 + # 例はTiarraモード時。 [default: なし] + mask: * +*!*@* + # [plum-mode] mask: +*!*@* + + # maskで拒否されたときのメッセージ [default: なし] + deny: 伝言したくない。 + + # 一度に送れる宛先の量 [default: 無制限] + max-send-address: 5 + + # 宛先を探すエイリアスエントリ [default: なし] + alias-key: name + alias-key: nick + + # 宛先の人を判別出来なかったときのメッセージ [default: なし] + unknown: #(who)さんと言うのは誰ですか? + + # メールの日付形式 + date: %H:%M:%S + + # エイリアスは見付かったけれどメールアドレスが登録されていなかったときのメッセージ。 [default: なし] + #none-address: #(who)さんはアドレスを登録していません。 + + # SMTPのホスト [default: localhost] + #smtphost: localhost + + # SMTPのポート [default: smtp(25)] + #smtpport: 25 + + # SMTPで自ホストのFQDN [default: localhost] + #smtpfqdn: localhost + + # 送信するメールの既定件名(エイリアス使用不可) [default: Message from IRC] + #subject: Message from IRC + + # 送信するメールの本文 [default: #(date) << #(from.name|from.nick|from.nick.now) >> #(message)] + #format: #(date)に#(from.name|from.nick|from.nick.now)さんから#(message)という伝言です。 + + # 送信したときのメッセージ。 [default: なし] + accept: #(who)さんに#(message)と伝言しておきました。 + + # ---- POP before SMTP の指定 ---- + # POP before SMTPを使う。 [default: no] + #use-pop3: yes + + # POP before SMTPのタイムアウト時間(分)。分からない場合は指定しなくて良い。 [default: 0] + #pop3-expire: 4 + + # POPのホスト。 [default: localhost] + #pop3host: localhost + + # POPのポート。 [default: pop(110)] + #pop3port: 110 + + # POPのユーザ [default: OSのユーザ名] + #pop3user: example1 + + # POPのパスワード [default: 空パスワード('')] + #pop3pass: test-password + + # ---- エラーメッセージの設定 ---- + + # 一般エラー。 + # error-[state] と言う形式で詳細エラーメッセージを指定できる。 + # [state]は、 + # * mailfrom(メールの送信者を指定しようとしてエラー) + # * rcptto(メールの送信先を指定しようとしてエラー) + # * norcptto(メールの送信先が全部無くなった) + # * data(メールの中身を送信しようとしてエラー) + # * finish(メールの中身を送信したらエラー) + # がある。特に欲しくなければerror-[state]は指定しなくても構わない。 + # メッセージを出したくないなら中身の無いエントリを指定すれば良い。 + # error-[state]が指定されてない場合は代わりに error を使う。 [default: 未定義] + + #error-rcptto: + #error-norcptto: #(who)さんには送れませんでした。送信できるメールアドレスがありません。 + #error-data: メールが送信できません。DATAコマンドに失敗しました。#(line;サーバ応答:%s|;) + #error: メール送信エラーです。#(line;サーバ応答:%s|;)#(state; on %s|;) + + # 致命的なエラー。メールに個別なエラーではないので送信者(のprefix)毎に1メッセージ送られる。 + # fatalerror-[state] + # [state]: + # * first(接続エラー) + # * helo(SMTPセッションを開始出来ない) + # がある。特に欲しくなければfatalerror-[state]は指定しなくても構わない。 + # メッセージを出したくないなら中身の無いエントリを指定すれば良い。 + # fatalerror-[state]が指定されてない場合は代わりに fatalerror を使う。 [default: 未定義] + + #fatalerror-first: SMTPサーバに接続できません。 + #fatalerror: SMTPセッションで致命的なエラーがありました。#(line; サーバ応答:%s|;)#(state; on %s|;) +} + +- Auto::Oper { + # 特定の文字列を発言した人を+oする。 + + # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + + # +oを要求する文字列(マスク)を指定します。 + request: なると寄越せ + + # チャンネルオペレータ権限を要求した人と要求されたチャンネルが + # ここで指定したマスクに一致しなかった場合は + # denyで指定した文字列を発言し、+oをやめます。 + # 省略された場合は誰にも+oしません。 + # 書式は「チャンネル 発言者」です。 + # マッチングのアルゴリズムは次の通りです。 + # 1. チャンネル名にマッチするmask定義を全て集める + # 2. 集まった定義の発言者マスクを、定義された順にカンマで結合する + # 3. そのようにして生成されたマスクで発言者のマッチングを行ない、結果を+o可能性とする。 + # 例1: + # mask: *@2ch* *!*@* + # mask: #*@ircnet* *!*@*.hoge.jp + # この例ではネットワーク 2ch の全てのチャンネルで誰にでも +o し、 + # ネットワーク ircnet の # で始まる全てのチャンネルでホスト名 *.hoge.jp の人に+oします。 + # #*@ircnetだと「#hoge@ircnet:*.jp」などにマッチしなくなります。 + # 例2: + # mask: #hoge@ircnet -*!*@*,+*!*@*.hoge.jp + # mask: * +*!*@* + # 基本的に全てのチャンネルで誰にでも +o するが、例外的に#hoge@ircnetでは + # ホスト名 *.hoge.jp の人にしか +o しない。 + # この順序を上下逆にすると、全てのチャンネルで全ての人を +o する事になります。 + # 何故なら最初の* +*!*@*が全ての人にマッチするからです。 + mask: * *!*@* + + # +oを要求した人を実際に+oする時、ここで指定した発言をしてから+oします。 + # #(name|nick)のようなエイリアス置換を行います。 + # エイリアス以外でも、#(nick.now)を相手のnickに、#(channel)を + # そのチャンネル名にそれぞれ置換します。 + message: 了解 + + # +oを要求されたが+oすべき相手ではなかった場合の発言。 + # 省略されたら何も喋りません。 + deny: 断わる + + # +oを要求されたが相手は既にチャンネルオペレータ権限を持っていた場合の発言。 + # 省略されたらdenyに設定されたものを使います。 + oper: 既に@を持っている + + # +oを要求されたが自分はチャンネルオペレータ権限を持っていなかった場合の発言。 + # 省略されたらdenyに設定されたものを使います。 + not-oper: @が無い + + # チャンネルに対してでなく自分に対して+oの要求を行なった場合の発言。 + # 省略されたらdenyに設定されたものを使います。 + private: チャンネルで要求せよ + + # チャンネルの外から+oを要求された場合の発言。+nチャンネルでは起こりません。 + # 省略されたらdenyに設定されたものを使います。 + out: チャンネルに入っていない +} + +- Auto::Random { + # 特定の発言に反応してランダムな発言をします。 + + # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + + # 使用するブロックの定義。 + blocks: wimikuji + + wimikuji { + # ランダムに発言するメッセージの書かれたファイルと、その文字コードを指定します。 + # ファイルの中では一行に一つのメッセージを書いて下さい。 + file: random.txt + file-encoding: euc + + # 反応する発言を表すマスクを指定します。 + request: ゐみくじ + + # メッセージの登録数を返答するキーワードを指定します。 + count-query: ゐみくじ登録数 + + # メッセージの登録数を返答するときの反応を指定します。 + # formatで指定できるものと同じです。#(count)は登録数になります。 + count-format: ゐみくじは#(count)件登録されています。 + + # ランダムなメッセージを発言する際のフォーマットを指定します。 + # エイリアス置換が有効です。#(message)、#(nick.now)、#(channel)は + # それぞれメッセージ内容、相手のnick、チャンネル名に置換されます。 + # 何も登録されていないときのために、#(message|;無登録)のように指定すると良いでしょう。 + format: #(name|nick.now)の運命は#(message) + + # 反応する人のマスク。 + mask: * *!*@* + # plum: mask: *!*@* + + # メッセージが追加されたときの反応を指定します。 + # formatで指定できるものと同じです。#(message)は追加されたメッセージになります。 + added-format: #(name|nick.now): ゐみくじ #(message) を追加しました。 + + # メッセージが削除されたときの反応を指定します。 + # formatで指定できるものと同じです。#(message)は削除されたメッセージになります。 + removed-format: #(name|nick.now): ゐみくじ #(message) を削除しました。 + + # 発言に反応する確率を指定します。百分率です。省略された場合は100と見做されます。 + rate: 100 + + # メッセージを追加するキーワードを指定します。 + # ここで指定したキーワードを発言すると、新しいメッセージを追加します。 + # 実際の追加方法は「 <追加するメッセージ>」です。 + add: ゐみくじ追加 + + # メッセージを削除するキーワードを指定します。 + # 実際の削除方法は「 <削除するキーワード>」です。 + remove: ゐみくじ削除 + + # addとremoveを許可する人。省略された場合は誰も変更できません。 + modifier: * *!*@* + # plum: modifier: *!*@* + } +} + +- Auto::Reply { + # 特定の発言に反応して発言をします。 + + # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + + # 使用するブロックの定義。 + blocks: std + + std { + # データファイルと文字コードを指定します。 + # ファイルの中では一行に一つの"反応:メッセージ"を書いて下さい。 + file: reply.txt + file-encoding: euc + + # 反応チェックを行うキーワードを指定します。 + # 実際の指定方法は、「 <チェックしたい発言>」です。 + request: 反応チェック + + # request に反応するときのフォーマットを指定します。 + # #(key) がキーワード、 #(message) が発言に置換されます。 + reply-format: 「#(key)」という発言に「#(message)」と反応します。 + + # request に反応する最大個数を指定します。 + # あまり大きな値を指定すると、アタックが可能になったり、ログが流れて邪魔なので注意してください。 + max-reply: 5 + + # メッセージの登録数を返答するキーワードを指定します。 + count-query: 反応登録数 + + # メッセージの登録数を返答するときの反応を指定します。 + # formatで指定できるものと同じです。#(count)は登録数になります。 + count-format: 反応は#(count)件登録されています。 + + # 反応する人のマスク。 + mask: * *!*@* + # plum: mask: *!*@* + + # 反応が追加されたときの反応を指定します。 + # formatで指定できるものと同じです。#(message)は追加されたメッセージになります。 + added-format: #(name|nick.now): #(key) に対する反応 #(message) を追加しました。 + + # メッセージが削除されたときの反応を指定します。 + # formatで指定できるものと同じです。#(message)は削除されたメッセージになります。 + removed-format: #(name|nick.now): #(key) #(message;に対する反応 %s|;) を #(count) 件削除しました。 + + # 発言に反応する確率を指定します。百分率です。省略された場合は100と見做されます。 + rate: 100 + + # メッセージを追加するキーワードを指定します。 + # ここで指定したキーワードを発言すると、新しいメッセージを追加します。 + # 実際の追加方法は「 <追加するメッセージ>」です。 + add: 反応追加 + + # メッセージを削除するキーワードを指定します。 + # 実際の削除方法は「 <削除するキーワード>」です。 + remove: 反応削除 + + # addとremoveを許可する人。省略された場合は「* *!*@*」と見做します。 + modifier: * *!*@* + + # 正規表現拡張を許可するか。省略された場合は禁止します。 + use-re: 1 + } +} + +- Auto::Response { + # データファイルの指定にしたがって反応する。 + + # 大量の反応データを定義するのに向いています。 + + # データファイルのフォーマット + # | pattern: re:^(こん(に)?ちは) + # | rate: 90 + # | mask: * *!*@* + # | #plum: mask: *!*@* + # | response: こんにちは。 + # | response: いらっしゃいませ。 + # | + # | pattern: おやすみ + # | rate: 20 + # | response: おやすみなさい。 + # patternは一行しか書けません。(手抜き + # maskもrateも省略できます。省略した場合はmaskは全員、rateは100となります。 + # responseは複数書いておけばランダムに選択されます。 + + # データファイル + file: response.txt + + # 文字コード + charset: euc + + # 使用を許可する人&チャンネルのマスク。 + mask: * *!*@* + # plum: mask: +*!*@* +} + +- CTCP::ClientInfo { + # CTCP CLIENTINFOに応答する。 + + # CTCP::Versionのintervalと同じ。 + interval: 3 +} + +- CTCP::Ping { + # CTCP PINGに応答する。 + + # CTCP::Versionのintervalと同じ。 + interval: 3 +} + +- CTCP::Time { + # CTCP TIMEに応答する。 + + # CTCP::Versionのintervalと同じ。 + interval: 3 +} + +- CTCP::UserInfo { + # CTCP USERINFOに応答する。 + + # CTCP::Versionのintervalと同じ。 + interval: 3 + + # USERINFOとして返すメッセージ。 + message: テスト +} + ++ CTCP::Version { + # CTCP VERSIONに応答する。 + + # 連続したCTCPリクエストに対する応答の間隔。単位は秒。 + # 例えば3秒に設定した場合、一度応答してから3秒間は + # CTCPに一切応答しなくなる。デフォルトは3。 + # + # なお、CTCP受信時刻の記録は、全てのCTCPモジュールで共有される。 + # 例えばCTCP VERSIONを送った直後にCTCP CLIENTINFOを送ったとしても、 + # CTCP::ClientInfoのintervalで設定された時間を過ぎていなければ + # 後者は応答しない。 + interval: 3 +} + +- Channel::Freeze { + # 特定のチャンネルの発言を、一時的に受信するのをやめる。 + + # ログを取っているなら、ログには記録される。 + + # チャンネルの凍結に用いるコマンド名。 + # 省略時は freeze であり、/freeze #channel@network のように使う。 + # チャンネル名を省略すると、現在フリーズされているチャンネルのリストを表示する。 + freeze-command: freeze + + # 凍結解除に用いるコマンド名。 + # 省略時は defrost であり、/defrost #channel@network のように使う。 + defrost-command: defrost + + # 凍結しているチャンネルが存在する時、一定時間毎にその旨を報告する事も可能。 + # この機能は凍結した事を忘れないようにする為にある。 + # 単位は分、デフォルトはゼロ(報告しない)。 + reminder-interval: 30 +} + +- Channel::Join::Connect { + # サーバーに初めて接続した時、指定したチャンネルに入るモジュール。 + + # 書式: <チャンネル1>[,<チャンネル2>,...] [<チャンネル1のキー>,...] + # コンマの直後のスペースは無視されます。 + # + # 例: + # 「#aaaaa@ircnet」に「aaaaa」というキーで入る。 + #channel: #aaaaa@ircnet aaaaa + # + # 「#aaaaa@ircnet」、「#bbbbb@ircnet:*.jp」、「#ccccc@ircnet」、「#ddddd@ircnet」の4つのチャンネルに入る。 + #channel: #aaaaa@ircnet,#bbbbb@ircnet:*.jp, #ccccc@ircnet + #channel: #ddddd@ircnet +} + +- Channel::Join::Invite { + # 招待されたらそのチャンネルに入る。 + + # 許可するユーザ/チャンネルのマスク。 + mask: * *!*@* + # plum: *!*@* + + # 招待されたチャンネルに流すメッセージのフォーマット。 + #message: こんばんわ〜。 +} + +- Channel::Join::Kicked { + # 特定のチャンネルからkickされた時に、自動で入りなおす。 + + # 対象となるチャンネル名のマスク + channel: * +} + +- Channel::Mode::Get { + # チャンネルにJOINした時、そのチャンネルのモードを取得します。 + + # Channel::Mode::Set等が正しく動くためには + # チャンネルのモードをTiarraが把握しておく必要があります。 + # 自動的にモードを取得するクライアントであれば必要ありませんが、 + # そうでなければこのモジュールを使うべきです。 + + # 設定項目は無し。 +} + +- Channel::Mode::Oper::Grant { + # 特定のチャンネルに特定の人間がjoinした時に、自分がチャンネルオペレータ権限を持っていれば+oする。 + + # splitからの復帰などで+o対象の人が一度に大量に入って来ても+oは少しずつ実行します。 + # Excess Floodにはならない筈ですが、本格的な防衛BOTに使える程の物ではありません。 + + # 対象の人間がjoinしてから実際に+oするまで何秒待つか。 + # 省略されたら待ちません。 + # 5-10 のように指定されると、その値の中でランダムに待ちます。 + wait: 2-5 + + # チャンネルと人間のマスクを定義。Auto::Operと同様。 + #mask: * example!~example@*.example.ne.jp +} + +- Channel::Mode::Set { + # チャンネルを作成した時に自動的にモードを設定するモジュール。 + + # 書式は<チャンネル名にマッチするマスク> <設定するモード>[,<設定するモード>,...]です。 + # #IRC談話室@ircnetなら+t+nを、それ以外なら+nを設定する例。 + #channel: #IRC談話室@ircnet +t + #channel: * +n + # LimeChat 標準設定を模倣する設定例。 + #channel: * +sn +} + +- Channel::Rejoin { + # チャンネルオペレータ権限を無くしたとき、一人ならjoinし直す。 + + # +チャンネルや+aされているチャンネル以外でチャンネルオペレータ権限を持たずに + # 一人きりになった時、そのチャンネルの@を復活させるために自動的にjoinし直すモジュール。 + # トピック、モード、banリスト等のあらゆるチャンネル属性をも保存します。 + + # +b,+I,+eリストの復旧を行なうかどうか。 + # あまりに長いリストを取得するとMax Send-Q Exceedで落とされるかも知れません。 + save-lists: 1 +} + +- Client::Cache { + # データをキャッシュしてサーバに問い合わせないようにする + + # キャッシュを使用しても、使われるのは接続後最初の一度だけです。 + # 二度目からは通常通りにサーバに問い合わせます。 + # また、クライアントオプションの no-cache を指定すれば動きません。 + + # mode キャッシュを使用するか + use-mode-cache: 1 + + # who キャッシュを使用するか + use-who-cache: 1 +} + ++ Client::Conservative { + # サーバが送信するような IRC メッセージを作成するようにする + + # サーバが実際に送信しているようなメッセージにあわせるようにします。 + # 多くのクライアントの設計ミスを回避でき(ると思われ)ます。 +} + +- Client::Cotton { + # Cotton の行うおかしな動作のいくつかを無視する + + # 該当クライアントのオプション client-type に cotton や unknown と指定するか、 + # Client::GetVersion を利用してクライアントのバージョンを取得するように + # してください。 + + # part shield (rejoin 時に自動で行われる part の無視)を使用するか + use-part-shield: 1 +} + +- Client::Eval { + # クライアントから Perl 式を実行できるようにする。 + + # eval を実行するコマンド名。省略されるとコマンドを追加しません。 + # この時コマンドはTiarraが握り潰すので、IRCプロトコル上で定義された + # コマンド名を設定すべきではありません。 + command: eval +} + ++ Client::GetVersion { + # クライアントに CTCP Version を発行してバージョン情報を得る + + # オプションはいまのところありません。 + # (開発者向け情報: 取得した情報は remark の client-version に設定され、 + # Client::Guess から使用されます。) +} + +- Client::PatchworkMessage { + # IRC メッセージにちょっと変更を加えて、クライアントのバグを抑制する + + # 特に注意書きがない場合はデフォルトで有効です。 + # また、 Client::GetVersion も同時に入れておくと便利です。 + # とりあえず obsolete です。このモジュールで実装されていた機能は + # Client::Conservative によって実現できます。 + # Client::Conservative で実装してはいけないようなものがあった場合のみ + # このモジュールで対処します。 + + # WoolChat: + # 対応しているメッセージ: + # NICK(コロンが必須) + # 説明: + # NICK は接続直後にも発行されるため、 Client::GetVersion での判別まで + # 待てません。該当クライアントのオプション client-type に woolchat と + # 指定してください。実名欄に $client-type=woolchat$ と書けば OK です。 + enable-woolchat: 1 + + # X-Chat: + # 対応しているメッセージ: + # RPL_WHOISUSER(コロンが必須) + # 説明: + # WHOIS の realname にスペースが入っていないと最初の一文字が削られます。 + enable-xchat: 1 +} + +- Client::ProtectMyself { + # 意図せず自分のニックが変わってしまうのを防止する + + # {nick,part,quit,join}-format: それぞれのメッセージのフォーマットを指定します。 + # {nick,user,host,prefix}.now などはどこでも使えます。 + # そのほかには + # target : 表示するチャンネル(またはニック)。 + # nick.new : nick-format のみ。新しいニック。 + # message : part と quit 。メッセージ。 + + nick-format: Nick changed #(nick.now) -> #(nick.new) + part-format: Part #(nick.now) (#(message)) from #(target) + quit-format: Quit #(nick.now) (#(message)) + join-format: Join #(nick.now) (#(prefix.now)) to #(target) +} + +- Client::Rehash { + # 全チャンネル分の names の内部キャッシュをクライアントに送信する。 + + # もともとはクライアントの再初期化目的に作ったのですが、 names を送信しても + # 更新されないクライアントが多いので、主に multi-server-mode な Tiarra の + # 下にさらに Tiarra をつないでいる人向けにします。 + + # names でニックリストを更新してくれるクライアント: + # Tiarra + # してくれないクライアント: (括弧内は確認したバージョンまたは注釈) + # LimeChat(1.18) + + # nick rehash に使うコマンドを指定します。 + # 第二パラメータとして現在クライアントが認識している nick を指定してください。 + command-nick: rehash-nick + + # names rehash に使うコマンドを指定します。 + command-names: rehash-names + + # チャンネルとチャンネルの間のウェイトを指定します。 + interval: 2 +} + +- Client::ShowNick { + # show network + +} + +- Debug::RawLog { + # 標準出力にクライアントやサーバとの通信をダンプする。 + + # 0 または省略で表示しない。 1 で表示する。 + # クライアントオプションの logname によって、ダンプに使う名前を指定できます。 + + # サーバからの入力 + enable-server-in: 1 + + # サーバへの出力 + enable-server-out: 1 + + # クライアントからの入力 + enable-client-in: 0 + + # クライアントへの出力 + enable-client-out: 0 + + # PING/PONG を無視する + ignore-ping: 1 + + # NumericReply の名前を解決して表示する(ちゃんとした dump では無くなります) + resolve-numeric: 1 +} + +- Log::Channel { + # チャンネルやprivのログを取るモジュール。 + + # Log系のモジュールでは、以下のように日付や時刻の置換が行なわれる。 + # %% : % + # %Y : 年(4桁) + # %m : 月(2桁) + # %d : 日(2桁) + # %H : 時間(2桁) + # %M : 分(2桁) + # %S : 秒(2桁) + + # ログを保存するディレクトリ。Tiarraが起動した位置からの相対パス。~指定は使えない。 + directory: log + + # ログファイルの文字コード。省略されたらjis。 + charset: sjis + + # 各行のヘッダのフォーマット。省略されたら'%H:%M'。 + header: %H:%M:%S + + # ファイル名のフォーマット。省略されたら'%Y.%m.%d.txt' + filename: %Y.%m.%d.txt + + # ログファイルのモード(8進数)。省略されたら600 + mode: 600 + + # ログディレクトリのモード(8進数)。省略されたら700 + dir-mode: 700 + + # ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。 + command: privmsg,join,part,kick,invite,mode,nick,quit,kill,topic,notice + + # PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。 + distinguish-myself: 1 + + # 各ログファイルを開きっぱなしにするかどうか。 + # このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが + # ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを + # 別々のファイルにログを取るような場合には使うべきではありません。 + # 万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・ + # 新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が + # あります。limit の詳細については OS 等のドキュメントを参照してください。 + #keep-file-open: 1 + + # keep-file-open 時に各行ごとに flush するかどうか。 + # open/close の負荷は気になるが、ログは失いたくない人向け。 + # keep-file-open が有効でないなら無視され(1になり)ます。 + #always-flush: 0 + + # keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく + # 一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても + # 最近の発言はまだ書き込まれていない可能性がある。 + # syncを設定すると、即座にログをディスクに書き込むためのコマンドが追加される。 + # 省略された場合はコマンドを追加しない。 + sync: sync + + # 各チャンネルの設定。チャンネル名の部分はマスクである。 + # 個人宛てに送られたPRIVMSGやNOTICEはチャンネル名"priv"として検索される。 + # 記述された順序で検索されるので、全てのチャンネルにマッチする"*"などは最後に書かなければならない。 + # 指定されたディレクトリが存在しなかったら、Log::Channelはそれを勝手に作る。 + # フォーマットは次の通り。 + # channel: <ディレクトリ名> (<チャンネル名> / 'priv') + # 例: + # filename: %Y.%m.%d.txt + # channel: IRCDanwasitu #IRC談話室@ircnet + # channel: others * + # この例では、#IRC談話室@ircnetのログはIRCDanwasitu/%Y.%m.%d.txtに、 + # それ以外(privも含む)のログはothers/%Y.%m.%d.txtに保存される。 + channel: priv priv + channel: others * +} + +- Log::ChannelList { + # チャンネルリストをテンプレートに沿って HTML 化します。 + + # list コマンドが実行された際に動作します。 + + # 出力したいファイル名、ネットワーク名、使う設定のブロックを指定します。。 + networks: ircnet.html ircnet ircnet + + + ircnet { + # テンプレートファイルを指定します。 + template: channellist.html.tmpl + + # 出力とテンプレートファイルの文字コードを指定します。 + charset: euc + + # 取得を開始/終了した時刻のフォーマットを指定します。 + fetch-starttime: %Y年%m月%d日 %H時%M分(日本時間) + fetch-endtime: %Y年%m月%d日 %H時%M分(日本時間) + + # 表示するチャンネルの mask を指定します。 + mask: * + mask: -re:^\&(AUTH|SERVICES|LOCAL|HASH|SERVERS|NUMERICS|CHANNEL|KILLS|NOTICES|ERRORS) + + # 出力するファイルのモードを指定します。 + mode: 644 + } +} + +- Log::Raw { + # サーバとの生の通信を保存する + + # Log系のモジュールでは、以下のように日付や時刻の置換が行なわれる。 + # %% : % + # %Y : 年(4桁) + # %m : 月(2桁) + # %d : 日(2桁) + # %H : 時間(2桁) + # %M : 分(2桁) + # %S : 秒(2桁) + + # ログを保存するディレクトリ。Tiarraが起動した位置からの相対パス。~指定は使えない。 + directory: rawlog + + # 各行のヘッダのフォーマット。省略されたら'%H:%M'。 + header: %H:%M:%S + + # ファイル名のフォーマット。省略されたら'%Y.%m.%d.txt' + filename: %Y-%m-%d.txt + + # ログファイルのモード(8進数)。省略されたら600 + mode: 600 + + # ログディレクトリのモード(8進数)。省略されたら700 + dir-mode: 700 + + # 使っている文字コードがよくわからなかったときの文字コード。省略されたらutf8。 + # たぶんこの指定が生きることはないと思いますが……。 + charset: jis + + # NumericReply の名前を解決して表示する(ちゃんとした dump では無くなります) + resolve-numeric: 1 + + # ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。 + command: *,-ping,-pong + + # 各ログファイルを開きっぱなしにするかどうか。 + # このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが + # ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを + # 別々のファイルにログを取るような場合には使うべきではありません。 + # 万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・ + # 新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が + # あります。limit の詳細については OS 等のドキュメントを参照してください。 + #keep-file-open: 1 + + # keep-file-open 時に各行ごとに flush するかどうか。 + # open/close の負荷は気になるが、ログは失いたくない人向け。 + # keep-file-open が有効でないなら無視され(1になり)ます。 + #always-flush: 0 + + # keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく + # 一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても + # 最近の発言はまだ書き込まれていない可能性がある。 + # syncを設定すると、即座にログをディスクに書き込むためのコマンドが追加される。 + # 省略された場合はコマンドを追加しない。 + sync: sync + + # 各サーバの設定。サーバ名の部分はマスクである。 + # 記述された順序で検索されるので、全てのサーバにマッチする"*"などは最後に書かなければならない。 + # 指定されたディレクトリが存在しなかったら、勝手に作られる。 + # フォーマットは次の通り。 + # channel: <ディレクトリ名> <サーバ名マスク> + # 例: + # filename: %Y-%m-%d.txt + # server: ircnet ircnet + # server: others * + # この例では、ircnetのログはircnet/%Y.%m.%d.txtに、 + # それ以外のログはothers/%Y.%m.%d.txtに保存される。 + server: ircnet ircnet + server: others * +} + +- Log::Recent { + # クライアントを接続した時に、保存しておいた最近のメッセージを送る。 + + # クライアントオプションの no-recent-logs が指定されていれば送信しません。 + + # 各行のヘッダのフォーマット。省略されたら'%H:%M'。 + header: %H:%M:%S + + # ログをチャンネル毎に何行まで保存するか。省略されたら10。 + line: 15 + + # PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。 + distinguish-myself: 1 + + # どのメッセージを保存するか。省略されたら保存可能な全てのメッセージを保存する。 + command: privmsg,notice,topic,join,part,quit,kill +} + ++ System::Error { + # サーバーからのERRORメッセージをNOTICEに埋め込む + + # これをoffにするとクライアントにERRORメッセージがそのまま送られます。 + # クライアントとの間ではERRORメッセージは主に切断警告に使われており、 + # そのまま流してしまうとクライアントが混乱する可能性があります。 + # 設定項目はありません。 + + # このモジュールを回避してERRORメッセージをクライアントに送りたい場合は、 + # remarkのsend-error-as-is-to-clientを指定してください。 +} + +- System::Macro { + # 新規にコマンドを追加し、そのコマンドが使われた時に特定の動作をまとめて実行します。 + + # 書式: <コマンド> <動作> + # コマンド"switch"を追加して、それが使われると + # #a@ircnet,#b@ircnet,#c@ircnetにjoinして、 + # #d@ircnet,#e@ircnet,#f@ircnetからpartする例。 + #macro: switch join #a@ircnet,#b@ircnet,#c@ircnet + #macro: switch part #d@ircnet,#e@ircnet,#f@ircnet +} + +- System::NotifyIcon::Win32 { + # タスクトレイにアイコンを表示する。 + + # タスクトレイにアイコンを表示します。 + # クリックすると表示非表示を切り替えることができ、右クリックすると + # Reload と Exit ができるコンテキストメニューを表示します。 + # 多少反応が鈍いかもしれませんがちょっと待てば出てくると思います。 + + # Win32::GUI を必要とします。 + # コンテキストメニューは表示している間処理をブロックしています。 + + # Win32 イベントループを処理する最大間隔を指定します。 + #interval: 2 + + # 通知領域に表示するアイコンを指定します。 + # Win32::GUI の制限でちゃんとしたアイコンファイルしか指定できません。 + iconfile: guiperl.ico + + # モジュールが読み込まれたときにコンソールウィンドウを隠すかどうかを + # 指定します。 + hide-console-on-load: 1 +} + ++ System::Pong { + # サーバーからのPINGメッセージに対し、自動的にPONGを返す。 + + # これをoffにするとクライアントが自らPINGに応答せざるを得なくなりますが、 + # クライアントからのPONGメッセージはデフォルトのサーバーへ送られるので + # デフォルト以外のサーバーからはPing Timeoutで落とされるなど + # 全く良い事がありません。 + # 設定項目はありません。 +} + +- System::PrivTranslator { + # クライアントからの個人的なprivが相手に届かなくなる現象を回避する。 + + # このモジュールは個人宛てのprivmsgの送信者のnickにネットワーク名を付加します。 + # 設定項目はありません。 +} + +- System::Raw { + # マスクで指定したサーバーにIRCメッセージを加工せずに直接送る。 + + # 例えばQUITを送る事で一時的な切断が可能。 + + # この機能を利用するためのコマンド名。デフォルトは「raw」。 + # 「/raw ircnet quit」のようにして使う。 + # 一つ目のパラメータは送り先のネットワーク名。ワイルドカード使用可能。 + # CHOCOA の場合、 raw がクライアントで使われてしまうので、 + # コマンド名を変えるか、 /raw raw ircnet quit のようにする必要がある。 + command: raw +} + ++ System::Reload { + # confファイルやモジュールの更新をリロードするコマンドを追加する。 + + # リロードを実行するコマンド名。省略されるとコマンドを追加しません。 + # 例えば"load"を設定すると、"/load"と発言しようとした時にリロードを実行します。 + # この時コマンドはTiarraが握り潰すので、IRCプロトコル上で定義された + # コマンド名を設定すべきではありません。 + command: load + + # command と同じですが、サーバにもブロードキャストします。 + #broadcast-command: load-all + + # confファイルをリロードしたときに通知します。 + # モジュールの設定が変更されていた場合は、ここでの設定にかかわらず、 + # モジュールごとに表示されます。1または省略された場合は通知します。 + conf-reloaded-notify: 1 +} + +- System::RemoteControl { + # 特定の発言が送られてきたとき、それに反応してIRCコマンドを実行します。 + + # 実行を許可する人間を表すマスク。 + #mask: *!*example@example.net + + # 構文: + + # は反応するbotのnickを表すマスク。 + # はサーバーに向けて発行するIRCメッセージ。 + # + # 例: + # + hoge NICK [hoge] + # hogeというBOTが[hoge]にnickを変更する。 +} + +- System::Shutdown { + # Tiarraを終了させる。 + + # クライアントから特定のコマンドが実行された時や、 + # 誰かから個人的に(privで)特定の発言が送られた時に + # Tiarra を終了させます。 + + # 追加するコマンド。省略された場合はコマンドでのシャットダウンは無効になります。 + #command: shutdown + + # Tiarraをシャットダウンさせるprivの発言。 + # 省略された場合はprivでのシャットダウンは無効になります。 + # パラメータとして shutdown メッセージを指定できます。 + #message: shutdown + + # privでのシャットダウンを許可する人。 + # 省略された場合はprivでのシャットダウンは無効になります。 + # 複数のマスクを指定した場合は、一つでもマッチするものがあればシャットダウンします。 + #mask: example!example@*.example.jp +} + +- User::Away::Client { + # クライアントが一つも接続されていない時にAWAYを設定します。 + + # どのようなAWAYメッセージを設定するか。省略された場合はAWAYを設定しません。 + #away: 居ない。 +} + +- User::Away::Nick { + # ニックネーム変更に応じて AWAY を設定します。 + + # ニックネームを変更したときに、そのニックネームに対応するAWAYが + # 設定されていれば、そのAWAYを設定します。そうでなければAWAYを取り消します。 + + # 書式: <設定するAWAYメッセージ> + # + # nickをhoge_zzzに変更すると、「寝ている」というAWAYを設定する。 + # hoge_workまたはhoge_zzzに変更した場合は、「仕事中」というAWAYを設定する。 + # それ以外のnickに変更した場合はAWAYを取り消す。 + # 後者は正規表現を利用して「away: re:hoge_(work|zzz) 仕事中」としても良い。 + #away: hoge_zzz 寝ている + #away: hoge_work,hoge_zzz 仕事中 +} + +- User::Filter { + # 指定された人物からのPRIVMSGやNOTICEを書き換える。 + + # 人物のマスクと、置換パターンを定義。 + # 置換パターン中の#(message)は、発言内容に置換されます。 + # 人物が複数のマスクに一致する場合は、最初に一致したものが使われます。 + pattern: *!*@* #(message) +} + +- User::Ignore { + # 指定された人間からのPRIVMSGやNOTICEを破棄してクライアントへ送らないようにするモジュール。 + + # 対象となるコマンドのマスク。省略時には"privmsg,notice"が設定されている。 + # ただしprivmsgとnotice以外を破棄してしまうと、(Tiarraは平気でも)クライアントが混乱する。 + command: privmsg,notice + + # maskは複数定義可能。定義された順番でマッチングが行なわれます。 + mask: example!*@*.example.net +} + +- User::Nick::Detached { + # クライアントが接続されていない時に、特定のnickに変更します。 + + # クライアントが接続されていない時のnick。 + # このnickが既に使われていたら、適当に変更が加えられて使用されます。 + # クライアントが再び接続されると、切断前のローカルnickに戻ります。 + detached: PHO_d +} + +- User::ServerOper { + # 特定のネットワークに接続した時、OPERコマンドを発行します。 + + # 書式: <ネットワーク名> <オペレータ名> <オペレータパスワード> + # + # ネットワーク"local"に接続した時、オペレータ名oper、 + # オペレータパスワードoper-passでOPERコマンドを発行する例。 + #oper: local oper oper-pass +} + +- User::Vanish { + # 指定された人物の存在を、様々なメッセージから消去する。 + + # 対象となった人物の発行したJOIN、PART、INVITE、QUIT、NICKは消去され、NAMESの返すネームリストからも消える。 + # また、対象となった人物のNJOINも消去される。 + + # Vanish対象が発行したMODEを消去するかどうか。デフォルトで0。 + # 消去するとは云え、本当にMODEそのものを消してしまうのではなく、 + # そのユーザーの代わりに"HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH"がMODEを実行した事にする。 + drop-mode-by-target: 1 + + # Vanish対象を対象とするMODE +o/-o/+v/-vを消去するかどうか。デフォルトで1。 + drop-mode-switch-for-target: 1 + + # Vanish対象が発行したKICKを消去するかどうか。デフォルトで0。 + # 本当に消すのではなく、"HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH"がKICKを実行した事にする。 + drop-kick-by-target: 1 + + # Vanish対象を対象とするKICKを消去するかどうか。デフォルトで0。 + drop-kick-for-target: 0 + + # Vanish対象が発行したTOPICを消去するかどうか。デフォルトで0。 + # 本当に消すのでは無いが、他の設定と同じ。 + drop-topic-by-target: 1 + + # チャンネルとVanish対象の定義。 + # 特定のチャンネルでのみ対象とする、といった事が可能。 + # また、privの場合は「#___priv___@ネットワーク名」という文字列をチャンネル名の代わりとしてマッチングを行なう。 + # 書式: mask: <チャンネルのマスク> <ユーザーのマスク> + mask: #example@example example!exapmle@example.com +} + ＜ゃ/non-existant-dir/bundle/Unicode/Japanese.pmtiarra-20050322/bundle/Unicode/Japanese.pm障 diff -urN /non-existant-dir/bundle/enum.pm tiarra-20050322/bundle/enum.pm --- /non-existant-dir/bundle/enum.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/bundle/enum.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,387 @@ +package enum; +use strict; +no strict 'refs'; # Let's just make this very clear right off + +use Carp; +use vars qw($VERSION); +$VERSION = do { my @r = (q$Revision: 1.16 $ =~ /\d+/g); sprintf '%d.%03d'.'%02d' x ($#r-1), @r}; + +my $Ident = '[^\W_0-9]\w*'; + +sub ENUM () { 1 } +sub BITMASK () { 2 } + +sub import { + my $class = shift; + @_ or return; # Ignore 'use enum;' + my $pkg = caller() . '::'; + my $prefix = ''; # default no prefix + my $index = 0; # default start index + my $mode = ENUM; # default to enum + + ## Pragmas should be as fast as they can be, so we inline some + ## pieces. + foreach (@_) { + ## Plain tag is most common case + if (/^$Ident$/o) { + my $n = $index; + + if ($mode == ENUM) { + $index++; + } + elsif ($mode == BITMASK) { + $index ||= 1; + $index *= 2; + if ( $index & ($index - 1) ) { + croak ( + "$index is not a valid single bitmask " + . " (Maybe you overflowed your system's max int value?)" + ); + } + } + else { + confess qq(Can't Happen: mode $mode invalid); + } + + *{"$pkg$prefix$_"} = sub () { $n }; + } + + ## Index change + elsif (/^($Ident)=(-?)(.+)$/o) { + my $name= $1; + my $neg = $2; + $index = $3; + + ## Convert non-decimal numerics to decimal + if ($index =~ /^0x[\da-f]+$/i) { ## Hex + $index = hex $index; + } + elsif ($index =~ /^0\d/) { ## Octal + $index = oct $index; + } + elsif ($index !~ /[^\d_]/) { ## 123_456 notation + $index =~ s/_//g; + } + + ## Force numeric context, but only in numeric context + if ($index =~ /\D/) { + $index = "$neg$index"; + } + else { + $index = "$neg$index"; + $index += 0; + } + + my $n = $index; + + if ($mode == BITMASK) { + ($index & ($index - 1)) + and croak "$index is not a valid single bitmask"; + $index *= 2; + } + elsif ($mode == ENUM) { + $index++; + } + else { + confess qq(Can't Happen: mode $mode invalid); + } + + *{"$pkg$prefix$name"} = sub () { $n }; + } + + ## Prefix/option change + elsif (/^([A-Z]*):($Ident)?(=?)(-?)(.*)/) { + ## Option change + if ($1) { + if ($1 eq 'ENUM') { $mode = ENUM; $index = 0 } + elsif ($1 eq 'BITMASK') { $mode = BITMASK; $index = 1 } + else { croak qq(Invalid enum option '$1') } + } + + my $neg = $4; + + ## Index change too? + if ($3) { + if (length $5) { + $index = $5; + + ## Convert non-decimal numerics to decimal + if ($index =~ /^0x[\da-f]+$/i) { ## Hex + $index = hex $index; + } + elsif ($index =~ /^0\d/) { ## Oct + $index = oct $index; + } + elsif ($index !~ /[^\d_]/) { ## 123_456 notation + $index =~ s/_//g; + } + + ## Force numeric context, but only in numeric context + if ($index =~ /\D/) { + $index = "$neg$index"; + } + else { + $index = "$neg$index"; + $index += 0; + } + + ## Bitmask mode must check index changes + if ($mode == BITMASK) { + ($index & ($index - 1)) + and croak "$index is not a valid single bitmask"; + } + } + else { + croak qq(No index value defined after "="); + } + } + + ## Incase it's a null prefix + $prefix = defined $2 ? $2 : ''; + } + + ## A..Z case magic lists + elsif (/^($Ident)\.\.($Ident)$/o) { + ## Almost never used, so check last + foreach my $name ("$1" .. "$2") { + my $n = $index; + + if ($mode == BITMASK) { + ($index & ($index - 1)) + and croak "$index is not a valid single bitmask"; + $index *= 2; + } + elsif ($mode == ENUM) { + $index++; + } + else { + confess qq(Can't Happen: mode $mode invalid); + } + + *{"$pkg$prefix$name"} = sub () { $n }; + } + } + + else { + croak qq(Can't define "$_" as enum type (name contains invalid characters)); + } + } +} + +1; + +__END__ + + +=head1 NAME + +enum - C style enumerated types and bitmask flags in Perl + +=head1 SYNOPSIS + + use enum qw(Sun Mon Tue Wed Thu Fri Sat); + # Sun == 0, Mon == 1, etc + + use enum qw(Forty=40 FortyOne Five=5 Six Seven); + # Yes, you can change the start indexs at any time as in C + + use enum qw(:Prefix_ One Two Three); + ## Creates Prefix_One, Prefix_Two, Prefix_Three + + use enum qw(:Letters_ A..Z); + ## Creates Letters_A, Letters_B, Letters_C, ... + + use enum qw( + :Months_=0 Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec + :Days_=0 Sun Mon Tue Wed Thu Fri Sat + :Letters_=20 A..Z + ); + ## Prefixes can be changed mid list and can have index changes too + + use enum qw(BITMASK:LOCK_ SH EX NB UN); + ## Creates bitmask constants for LOCK_SH == 1, LOCK_EX == 2, + ## LOCK_NB == 4, and LOCK_UN == 8. + ## NOTE: This example is only valid on FreeBSD-2.2.5 however, so don't + ## actually do this. Import from Fnctl instead. + +=head1 DESCRIPTION + +Defines a set of symbolic constants with ordered numeric values ala B B types. + +Now capable of creating creating ordered bitmask constants as well. See the B +section for details. + +What are they good for? Typical uses would be for giving mnemonic names to indexes of +arrays. Such arrays might be a list of months, days, or a return value index from +a function such as localtime(): + + use enum qw( + :Months_=0 Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec + :Days_=0 Sun Mon Tue Wed Thu Fri Sat + :LC_=0 Sec Min Hour MDay Mon Year WDay YDay Isdst + ); + + if ((localtime)[LC_Mon] == Months_Jan) { + print "It's January!\n"; + } + if ((localtime)[LC_WDay] == Days_Fri) { + print "It's Friday!\n"; + } + +This not only reads easier, but can also be typo-checked at compile time when +run under B. That is, if you misspell B as B, +you'll generate a compile error. + +=head1 BITMASKS, bitwise operations, and bitmask option values + +The B option allows the easy creation of bitmask constants such as +functions like flock() and sysopen() use. These are also very useful for your +own code as they allow you to efficiently store many true/false options within +a single integer. + + use enum qw(BITMASK: MY_ FOO BAR CAT DOG); + + my $foo = 0; + $foo |= MY_FOO; + $foo |= MY_DOG; + + if ($foo & MY_DOG) { + print "foo has the MY_DOG option set\n"; + } + if ($foo & (MY_BAR | MY_DOG)) { + print "foo has either the MY_BAR or MY_DOG option set\n" + } + + $foo ^= MY_DOG; ## Turn MY_DOG option off (set its bit to false) + +When using bitmasks, remember that you must use the bitwise operators, B<|>, B<&>, B<^>, +and B<~>. If you try to do an operation like C<$foo += MY_DOG;> and the B bit +has already been set, you'll end up setting other bits you probably didn't want to set. +You'll find the documentation for these operators in the B manpage. + +You can set a starting index for bitmasks just as you can for normal B values, +but if the given index isn't a power of 2 it won't resolve to a single bit and therefor +will generate a compile error. Because of this, whenever you set the B +directive, the index is automatically set to 1. If you wish to go back to normal B +mode, use the B directive. Similarly to the B directive, the B +directive resets the index to 0. Here's an example: + + use enum qw( + BITMASK:BITS_ FOO BAR CAT DOG + ENUM: FALSE TRUE + ENUM: NO YES + BITMASK: ONE TWO FOUR EIGHT SIX_TEEN + ); + +In this case, B equal 1, 2, 4 and +8 respectively. B equal 0 and 1. B also equal +0 and 1. And B equal, you guessed it, 1, +2, 4, 8, and 16. + +=head1 BUGS + +Enum names can not be the same as method, function, or constant names. This +is probably a Good Thing[tm]. + +No way (that I know of) to cause compile time errors when one of these enum names get +redefined. IMHO, there is absolutely no time when redefining a sub is a Good Thing[tm], +and should be taken out of the language, or at least have a pragma that can cause it +to be a compile time error. + +Enumerated types are package scoped just like constants, not block scoped as some +other pragma modules are. + +It supports A..Z nonsense. Can anyone give me a Real World[tm] reason why anyone would +ever use this feature...? + +=head1 HISTORY + + $Log: enum.pm,v $ + Revision 1.16 1999/05/27 16:00:35 byron + + + Fixed bug that caused bitwise operators to treat enum types as strings + instead of numbers. + + Revision 1.15 1999/05/27 15:51:27 byron + + + Add support for negative values. + + Added stricter hex value checks. + + Revision 1.14 1999/05/13 15:58:18 byron + + + Fixed bug in hex index code that broke on 0xA. + + Revision 1.13 1999/05/13 10:52:30 byron + + + Fixed auto-index bugs in new non-decimal numeric support. + + Revision 1.12 1999/05/13 10:00:45 byron + + + Added support for non-decimal numeric representations ala 0x123, 0644, and + 123_456. + + First version committed to CVS. + + + Revision 1.11 1998/07/18 17:53:05 byron + -Added BITMASK and ENUM directives. + -Revamped documentation. + + Revision 1.10 1998/06/12 20:12:50 byron + -Removed test code + -Released to CPAN + + Revision 1.9 1998/06/12 00:21:00 byron + -Fixed -w warning when a null tag is used + + Revision 1.8 1998/06/11 23:04:53 byron + -Fixed documentation bugs + -Moved A..Z case to last as it's not going to be used + as much as the other cases. + + Revision 1.7 1998/06/10 12:25:04 byron + -Changed interface to match original design by Tom Phoenix + as implemented in an early version of enum.pm by Benjamin Holzman. + -Changed tag syntax to not require the 'PREFIX' string of Tom's + interface. + -Allow multiple prefix tags to be used at any point. + -Allowed index value changes from tags. + + Revision 1.6 1998/06/10 03:37:57 byron + -Fixed superfulous -w warning + + Revision 1.4 1998/06/10 01:07:03 byron + -Changed behaver to closer resemble C enum types + -Changed docs to match new behaver + +=head1 AUTHOR + +Zenin + +aka Byron Brummer . + +Based off of the B module by Tom Phoenix. + +Original implementation of an interface of Tom Phoenix's +design by Benjamin Holzman, for which we borrow the basic +parse algorithm layout. + +=head1 COPYRIGHT + +Copyright 1998 (c) Byron Brummer. +Copyright 1998 (c) OMIX, Inc. + +Permission to use, modify, and redistribute this module granted under +the same terms as B. + +=head1 SEE ALSO + +constant(3), perl(1). + +=cut diff -urN /non-existant-dir/doc/default.css tiarra-20050322/doc/default.css --- /non-existant-dir/doc/default.css 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc/default.css 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,86 @@ +/* $Id: default.css,v 1.1 2003/08/04 09:29:21 admin Exp $ */ + +body { + background-color: #ffac6a; + color: #000000; + font-style: normal; + font-size: 14px; + text-align: left; + text-indent: 0px; + padding: 20px 30px; + margin: 0px; +} + +/* general */ +a { + text-decoration: underline; +} +a:link { + color: #c70800; +} +a:visited { + color: #a25a4e; +} +a:active { + text-decoration: none; +} +a:hover { + font-weight: bold; + text-decoration: underline; +} + +/* toc-group */ +.toc-group { + font-size: 18px; +} + +.toc-group .group-description { + font-size: 14px; +} + +.toc-group .toc-individual { + font-size: 16px; +} + +.toc-group .toc-individual .module-description { + font-size: 12px; +} + +/* doc-element */ +.element { + /* border-style: double; + border-width: 3px; */ + border-color: #ffffff; + padding: 7px; +} + +.element .element-name { + font-size: 24px; + font-style: bold; +} + +.element .description { + font-style: bold; +} + +.element .doc-content { + margin: 5px 0 0 0; +} + +.element .comment { + font-size: 12px; + + /*border-style: solid; + border-width: 2px;*/ + margin: 10px 0 0 0; +} + +.element .key { + color: #880000; + font-size: 16px; +} + +.element .value { + color: #880000; + font-size: 16px; +} \ ＜ゃ絨障壕障 diff -urN /non-existant-dir/doc/module/Auto.html tiarra-20050322/doc/module/Auto.html --- /non-existant-dir/doc/module/Auto.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc/module/Auto.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,662 @@ + + + + + + + Auto + + + + + +
+ Auto::Alias ユーザエイリアス情報の管理を行ないます。 +
+

+エイリアスは基本的にname,userの二つのフィールドから成っており、
+それぞれユーザー名、ユーザーマスクを表します。
+

+

+ エイリアス定義ファイルのパスと、そのエンコーディング。
+ このファイルは次のようなフォーマットである。
+ 1. それぞれの行は「<キー>: <値>」の形式である。
+ 2. 空の行で、各ユーザーを区切る。
+ 3. <値>はカンマで区切られて複数の値とされる。
+
+ エイリアス定義ファイルの例:
+
+ name: sample
+ user: *!*sample@*.sample.net
+
+ name: sample2,[sample2]
+ user: *!sample2@*.sample.net,*!sample2@*.sample2.net
+
+

+alias:alias.txt
+alias-encoding:euc
+

+この発言をした人のエイリアスが登録されていれば、それをprivで送る。
+

+confirm:エイリアス確認
+

+「 user *!*user@*.user.net」のようにして情報を追加。
+発言をした人のエイリアスが未登録だった場合は、userのみ受け付けて新規追加とする。
+

+add:エイリアス追加
+

+「 name ユーザー」のようにして情報を削除。
+userを全て削除されたエイリアスは他の情報(name等)も含めて消滅する。
+

+remove:エイリアス削除
+

+メッセージが追加されたときの反応を指定します。
+ランダムなメッセージを発言する際のフォーマットを指定します。
+エイリアス置換が有効です。#(nick.now)、#(channel)は
+それぞれ相手のnick、チャンネル名に置換されます。
+#(key)、#(value)は、追加されたキーと値に置換されます。
+

+added-format:#(name|nick.now): エイリアス #(key) に #(value) を追加しました。
+add-failed-format:#(name|nick.now): エイリアス #(key) の追加に失敗しました。
+

+メッセージが削除されたときの反応を指定します。
+added-formatで指定できるものと同じです。
+

+removed-format:#(name|nick.now): エイリアス #(key) から #(value) を削除しました。
+remove-failed-format:#(name|nick.now): エイリアス #(key) からの削除に失敗しました。
+

+エイリアスの追加や削除が許されている人。省略された場合は「*!*@*」と見做される。
+

+modifier:*!*@*
+ +
+
+ + +
+ + +
+ Auto::Answer 特定の発言に反応して対応する発言をする。 +
+

+Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。
+

+

+ 反応する発言と、それに対する返事を定義します。
+ エイリアス置換が有効です。#(nick.now)と$(channel)はそれぞれ
+ 相手の現在のnickとチャンネル名に置換されます。
+
+ 書式: <反応する発言のマスク> <それに対する返事>
+ 例:
+

+reply:こんにちは* こんにちは、#(name|nick.now)さん。
+

+この例では誰かが「こんにちは」で始まる発言をすると、
+発言した人のエイリアスを参照して「こんにちは、○○さん。」のように発言します。
+

+ +
+
+ + +
+ + +
+ Auto::Calc Perlの式を計算させるモジュール。 +
+

+反応する発言を指定します。
+

+request:計算
+

+使用を許可する人&チャンネルのマスク。
+例はTiarraモード時。 [default: なし]
+

+mask:* +*!*@*
+

+[plum-mode] mask: +*!*@*
+

+

+結果が未定義だったときに置き換えられる文字列。省略されると undef 。
+

+undef:(未定義)
+

+正常に計算できたときのフォーマット
+method: 計算式, result: 結果, error: エラー, signal: シグナル
+

+reply-format:#(method): #(result)
+

+エラーが起きたときのフォーマット
+method: 計算式, result: 結果, error: エラー, signal: シグナル
+

+error-format:#(method): エラーです。(#(error))
+

+シグナルが発生したときのフォーマット
+

+signal-format:#(method): シグナルです。(#(signal))
+

+signal-$SIGNALNAME-format 形式。
+$SIGNALNAME には現状 alarm/sigfpe があります。
+該当がなければ signal-format にフォールバックします。
+

+

+いくつかの例を挙げます。
+

+signal-alarm-format:#(method): 時間切れです。
+signal-sigfpe-format:$(method): 浮動小数点計算例外です。
+

+タイムアウトする秒数を指定します。 alarm に渡されます。
+再帰を止めるのに使えますが、どうもメモリリークしていそうな雰囲気です。
+

+timeout:1
+

+サブルーチン定義を許可するかどうかを指定する。
+再帰定義が可能なので、許可する場合はこのモジュール専用の
+Tiarra を動かすことをお勧めします。
+

+permit-sub:0
+

+初期化する発言を指定します。
+このモジュールでは現状変数や関数定義などを行えます。
+このコマンドが発行されるとそれらをクリアします。
+

+init:計算初期化
+

+初期化を許可する人&チャンネルのマスク。
+例はTiarraモード時。 [default: なし]
+

+init-mask:* +*!*@*
+

+[plum-mode] mask: +*!*@*
+

+

+再初期化したときの発言を指定します。
+

+init-format:初期化しました。
+ +
+
+ + +
+ + +
+ Auto::ChannelWithoutOper チャンネルオペレータ権限がなくなってしまったときに発言する。 +
+

++で始まらない特定のチャンネルで、+aモードでも+rモードでもないのに
+誰もチャンネルオペレータ権限を持っていない状態になっている時、
+そこに誰かがJOINする度に特定のメッセージを発言するモジュールです。
+

+

+書式: <チャンネル名> <メッセージ>
+

+channel:#IRC談話室@ircnet なると消失しました。
+ +
+
+ + +
+ + +
+ Auto::Joined 特定のチャンネルに誰かがJOINする度に特定のメッセージを発言する。 +
+

+Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。
+

+

+ 発言を行なうチャンネルと、その内容を定義します。
+ #(nick.now)と$(channel)は、それぞれ相手の現在のnickとチャンネル名に置換されます。
+
+ 書式: <チャンネル名> <発言内容>
+

+channel:#チャンネル@ircnet 「#ちゃんねる」に移転しました。
+ +
+
+ + +
+ + +
+ Auto::MesMail 伝言をメールとして送信する。 +
+

+メールアドレスはエイリアスの mail を参照します。
+

+

+Fromアドレス。[default: OSのユーザ名]
+

+from:example1@example.jp
+

+送信用のキーワード [default: mesmail_send]
+

+send:速達伝言
+

+使用を許可する人&チャンネルのマスク。
+例はTiarraモード時。 [default: なし]
+

+mask:* +*!*@*
+

+[plum-mode] mask: +*!*@*
+

+

+maskで拒否されたときのメッセージ [default: なし]
+

+deny:伝言したくない。
+

+一度に送れる宛先の量 [default: 無制限]
+

+max-send-address:5
+

+宛先を探すエイリアスエントリ [default: なし]
+

+alias-key:name
+alias-key:nick
+

+宛先の人を判別出来なかったときのメッセージ [default: なし]
+

+unknown:#(who)さんと言うのは誰ですか?
+

+メールの日付形式
+

+date:%H:%M:%S
+

+エイリアスは見付かったけれどメールアドレスが登録されていなかったときのメッセージ。 [default: なし]
+

+none-address:#(who)さんはアドレスを登録していません。
+

+SMTPのホスト [default: localhost]
+

+smtphost:localhost
+

+SMTPのポート [default: smtp(25)]
+

+smtpport:25
+

+SMTPで自ホストのFQDN [default: localhost]
+

+smtpfqdn:localhost
+

+送信するメールの既定件名(エイリアス使用不可) [default: Message from IRC]
+

+subject:Message from IRC
+

+送信するメールの本文 [default: #(date) << #(from.name|from.nick|from.nick.now) >> #(message)]
+

+format:#(date)に#(from.name|from.nick|from.nick.now)さんから#(message)という伝言です。
+

+送信したときのメッセージ。 [default: なし]
+

+accept:#(who)さんに#(message)と伝言しておきました。
+

+---- POP before SMTP の指定 ----
+POP before SMTPを使う。 [default: no]
+

+use-pop3:yes
+

+POP before SMTPのタイムアウト時間(分)。分からない場合は指定しなくて良い。 [default: 0]
+

+pop3-expire:4
+

+POPのホスト。 [default: localhost]
+

+pop3host:localhost
+

+POPのポート。 [default: pop(110)]
+

+pop3port:110
+

+POPのユーザ [default: OSのユーザ名]
+

+pop3user:example1
+

+POPのパスワード [default: 空パスワード('')]
+

+pop3pass:test-password
+

+---- エラーメッセージの設定 ----
+

+

+一般エラー。
+error-[state] と言う形式で詳細エラーメッセージを指定できる。
+[state]は、
+   * mailfrom(メールの送信者を指定しようとしてエラー)
+   * rcptto(メールの送信先を指定しようとしてエラー)
+   * norcptto(メールの送信先が全部無くなった)
+   * data(メールの中身を送信しようとしてエラー)
+   * finish(メールの中身を送信したらエラー)
+がある。特に欲しくなければerror-[state]は指定しなくても構わない。
+メッセージを出したくないなら中身の無いエントリを指定すれば良い。
+error-[state]が指定されてない場合は代わりに error を使う。 [default: 未定義]
+

+error-rcptto:
+error-norcptto:#(who)さんには送れませんでした。送信できるメールアドレスがありません。
+error-data:メールが送信できません。DATAコマンドに失敗しました。#(line;サーバ応答:%s|;)
+error:メール送信エラーです。#(line;サーバ応答:%s|;)#(state; on %s|;)
+

+致命的なエラー。メールに個別なエラーではないので送信者(のprefix)毎に1メッセージ送られる。
+fatalerror-[state]
+[state]:
+   * first(接続エラー)
+   * helo(SMTPセッションを開始出来ない)
+がある。特に欲しくなければfatalerror-[state]は指定しなくても構わない。
+メッセージを出したくないなら中身の無いエントリを指定すれば良い。
+fatalerror-[state]が指定されてない場合は代わりに fatalerror を使う。 [default: 未定義]
+

+fatalerror-first:SMTPサーバに接続できません。
+fatalerror:SMTPセッションで致命的なエラーがありました。#(line; サーバ応答:%s|;)#(state; on %s|;)
+ +
+
+ + +
+ + +
+ Auto::Oper 特定の文字列を発言した人を+oする。 +
+

+Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。
+

+

++oを要求する文字列(マスク)を指定します。
+

+request:なると寄越せ
+

+チャンネルオペレータ権限を要求した人と要求されたチャンネルが
+ここで指定したマスクに一致しなかった場合は
+denyで指定した文字列を発言し、+oをやめます。
+省略された場合は誰にも+oしません。
+書式は「チャンネル 発言者」です。
+マッチングのアルゴリズムは次の通りです。
+1. チャンネル名にマッチするmask定義を全て集める
+2. 集まった定義の発言者マスクを、定義された順にカンマで結合する
+3. そのようにして生成されたマスクで発言者のマッチングを行ない、結果を+o可能性とする。
+例1:
+mask: *@2ch* *!*@*
+mask: #*@ircnet* *!*@*.hoge.jp
+この例ではネットワーク 2ch の全てのチャンネルで誰にでも +o し、
+ネットワーク ircnet の # で始まる全てのチャンネルでホスト名 *.hoge.jp の人に+oします。
+#*@ircnetだと「#hoge@ircnet:*.jp」などにマッチしなくなります。
+例2:
+mask: #hoge@ircnet -*!*@*,+*!*@*.hoge.jp
+mask: * +*!*@*
+基本的に全てのチャンネルで誰にでも +o するが、例外的に#hoge@ircnetでは
+ホスト名 *.hoge.jp の人にしか +o しない。
+この順序を上下逆にすると、全てのチャンネルで全ての人を +o する事になります。
+何故なら最初の* +*!*@*が全ての人にマッチするからです。
+

+mask:* *!*@*
+

++oを要求した人を実際に+oする時、ここで指定した発言をしてから+oします。
+#(name|nick)のようなエイリアス置換を行います。
+エイリアス以外でも、#(nick.now)を相手のnickに、#(channel)を
+そのチャンネル名にそれぞれ置換します。
+

+message:了解
+

++oを要求されたが+oすべき相手ではなかった場合の発言。
+省略されたら何も喋りません。
+

+deny:断わる
+

++oを要求されたが相手は既にチャンネルオペレータ権限を持っていた場合の発言。
+省略されたらdenyに設定されたものを使います。
+

+oper:既に@を持っている
+

++oを要求されたが自分はチャンネルオペレータ権限を持っていなかった場合の発言。
+省略されたらdenyに設定されたものを使います。
+

+not-oper:@が無い
+

+チャンネルに対してでなく自分に対して+oの要求を行なった場合の発言。
+省略されたらdenyに設定されたものを使います。
+

+private:チャンネルで要求せよ
+

+チャンネルの外から+oを要求された場合の発言。+nチャンネルでは起こりません。
+省略されたらdenyに設定されたものを使います。
+

+out:チャンネルに入っていない
+ +
+
+ + +
+ + +
+ Auto::Random 特定の発言に反応してランダムな発言をします。 +
+

+Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。
+

+

+使用するブロックの定義。
+

+blocks:wimikuji
+wimikuji +
+

+ランダムに発言するメッセージの書かれたファイルと、その文字コードを指定します。
+ファイルの中では一行に一つのメッセージを書いて下さい。
+

+file:random.txt
+file-encoding:euc
+

+反応する発言を表すマスクを指定します。
+

+request:ゐみくじ
+

+メッセージの登録数を返答するキーワードを指定します。
+

+count-query:ゐみくじ登録数
+

+メッセージの登録数を返答するときの反応を指定します。
+formatで指定できるものと同じです。#(count)は登録数になります。
+

+count-format:ゐみくじは#(count)件登録されています。
+

+ランダムなメッセージを発言する際のフォーマットを指定します。
+エイリアス置換が有効です。#(message)、#(nick.now)、#(channel)は
+それぞれメッセージ内容、相手のnick、チャンネル名に置換されます。
+何も登録されていないときのために、#(message|;無登録)のように指定すると良いでしょう。
+

+format:#(name|nick.now)の運命は#(message)
+

+反応する人のマスク。
+

+mask:* *!*@*
+

+plum: mask: *!*@*
+

+

+メッセージが追加されたときの反応を指定します。
+formatで指定できるものと同じです。#(message)は追加されたメッセージになります。
+

+added-format:#(name|nick.now): ゐみくじ #(message) を追加しました。
+

+メッセージが削除されたときの反応を指定します。
+formatで指定できるものと同じです。#(message)は削除されたメッセージになります。
+

+removed-format:#(name|nick.now): ゐみくじ #(message) を削除しました。
+

+発言に反応する確率を指定します。百分率です。省略された場合は100と見做されます。
+

+rate:100
+

+メッセージを追加するキーワードを指定します。
+ここで指定したキーワードを発言すると、新しいメッセージを追加します。
+実際の追加方法は「 <追加するメッセージ>」です。
+

+add:ゐみくじ追加
+

+メッセージを削除するキーワードを指定します。
+実際の削除方法は「 <削除するキーワード>」です。
+

+remove:ゐみくじ削除
+

+addとremoveを許可する人。省略された場合は誰も変更できません。
+

+modifier:* *!*@*
+

+plum: modifier: *!*@*
+

+
+ +
+
+ + +
+ + +
+ Auto::Reply 特定の発言に反応して発言をします。 +
+

+Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。
+

+

+使用するブロックの定義。
+

+blocks:std
+std +
+

+データファイルと文字コードを指定します。
+ファイルの中では一行に一つの"反応:メッセージ"を書いて下さい。
+

+file:reply.txt
+file-encoding:euc
+

+反応チェックを行うキーワードを指定します。
+実際の指定方法は、「 <チェックしたい発言>」です。
+

+request:反応チェック
+

+request に反応するときのフォーマットを指定します。
+#(key) がキーワード、 #(message) が発言に置換されます。
+

+reply-format:「#(key)」という発言に「#(message)」と反応します。
+

+request に反応する最大個数を指定します。
+あまり大きな値を指定すると、アタックが可能になったり、ログが流れて邪魔なので注意してください。
+

+max-reply:5
+

+メッセージの登録数を返答するキーワードを指定します。
+

+count-query:反応登録数
+

+メッセージの登録数を返答するときの反応を指定します。
+formatで指定できるものと同じです。#(count)は登録数になります。
+

+count-format:反応は#(count)件登録されています。
+

+反応する人のマスク。
+

+mask:* *!*@*
+

+plum: mask: *!*@*
+

+

+反応が追加されたときの反応を指定します。
+formatで指定できるものと同じです。#(message)は追加されたメッセージになります。
+

+added-format:#(name|nick.now): #(key) に対する反応 #(message) を追加しました。
+

+メッセージが削除されたときの反応を指定します。
+formatで指定できるものと同じです。#(message)は削除されたメッセージになります。
+

+removed-format:#(name|nick.now): #(key) #(message;に対する反応 %s|;) を #(count) 件削除しました。
+

+発言に反応する確率を指定します。百分率です。省略された場合は100と見做されます。
+

+rate:100
+

+メッセージを追加するキーワードを指定します。
+ここで指定したキーワードを発言すると、新しいメッセージを追加します。
+実際の追加方法は「 <追加するメッセージ>」です。
+

+add:反応追加
+

+メッセージを削除するキーワードを指定します。
+実際の削除方法は「 <削除するキーワード>」です。
+

+remove:反応削除
+

+addとremoveを許可する人。省略された場合は「* *!*@*」と見做します。
+

+modifier:* *!*@*
+

+正規表現拡張を許可するか。省略された場合は禁止します。
+

+use-re:1
+
+ +
+
+ + +
+ + +
+ Auto::Response データファイルの指定にしたがって反応する。 +
+

+大量の反応データを定義するのに向いています。
+

+

+データファイルのフォーマット
+| pattern: re:^(こん(に)?ちは)
+| rate: 90
+| mask: * *!*@*
+| #plum: mask: *!*@*
+| response: こんにちは。
+| response: いらっしゃいませ。
+|
+| pattern: おやすみ
+| rate: 20
+| response: おやすみなさい。
+patternは一行しか書けません。(手抜き
+maskもrateも省略できます。省略した場合はmaskは全員、rateは100となります。
+responseは複数書いておけばランダムに選択されます。
+

+

+データファイル
+

+file:response.txt
+

+文字コード
+

+charset:euc
+

+使用を許可する人&チャンネルのマスク。
+

+mask:* *!*@*
+

+plum: mask: +*!*@*
+

+ +
+
+ + + + + + diff -urN /non-existant-dir/doc/module/CTCP.html tiarra-20050322/doc/module/CTCP.html --- /non-existant-dir/doc/module/CTCP.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc/module/CTCP.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,101 @@ + + + + + + + CTCP + + + + + +
+ CTCP::ClientInfo CTCP CLIENTINFOに応答する。 +
+

+CTCP::Versionのintervalと同じ。
+

+interval:3
+ +
+
+ + +
+ + +
+ CTCP::Ping CTCP PINGに応答する。 +
+

+CTCP::Versionのintervalと同じ。
+

+interval:3
+ +
+
+ + +
+ + +
+ CTCP::Time CTCP TIMEに応答する。 +
+

+CTCP::Versionのintervalと同じ。
+

+interval:3
+ +
+
+ + +
+ + +
+ CTCP::UserInfo CTCP USERINFOに応答する。 +
+

+CTCP::Versionのintervalと同じ。
+

+interval:3
+

+USERINFOとして返すメッセージ。
+

+message:テスト
+ +
+
+ + +
+ + +
+ CTCP::Version CTCP VERSIONに応答する。 +
+

+ 連続したCTCPリクエストに対する応答の間隔。単位は秒。
+ 例えば3秒に設定した場合、一度応答してから3秒間は
+ CTCPに一切応答しなくなる。デフォルトは3。
+
+ なお、CTCP受信時刻の記録は、全てのCTCPモジュールで共有される。
+ 例えばCTCP VERSIONを送った直後にCTCP CLIENTINFOを送ったとしても、
+ CTCP::ClientInfoのintervalで設定された時間を過ぎていなければ
+ 後者は応答しない。
+

+interval:3
+ +
+
+ + + + + + diff -urN /non-existant-dir/doc/module/Channel.html tiarra-20050322/doc/module/Channel.html --- /non-existant-dir/doc/module/Channel.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc/module/Channel.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,195 @@ + + + + + + + Channel + + + + + +
+ Channel::Freeze 特定のチャンネルの発言を、一時的に受信するのをやめる。 +
+

+ログを取っているなら、ログには記録される。
+

+

+チャンネルの凍結に用いるコマンド名。
+省略時は freeze であり、/freeze #channel@network のように使う。
+チャンネル名を省略すると、現在フリーズされているチャンネルのリストを表示する。
+

+freeze-command:freeze
+

+凍結解除に用いるコマンド名。
+省略時は defrost であり、/defrost #channel@network のように使う。
+

+defrost-command:defrost
+

+凍結しているチャンネルが存在する時、一定時間毎にその旨を報告する事も可能。
+この機能は凍結した事を忘れないようにする為にある。
+単位は分、デフォルトはゼロ(報告しない)。
+

+reminder-interval:30
+ +
+
+ + +
+ + +
+ Channel::Join::Connect サーバーに初めて接続した時、指定したチャンネルに入るモジュール。 +
+

+ 書式: <チャンネル1>[,<チャンネル2>,...] [<チャンネル1のキー>,...]
+     コンマの直後のスペースは無視されます。
+
+ 例:
+   「#aaaaa@ircnet」に「aaaaa」というキーで入る。
+

+channel:#aaaaa@ircnet aaaaa
+

+
+   「#aaaaa@ircnet」、「#bbbbb@ircnet:*.jp」、「#ccccc@ircnet」、「#ddddd@ircnet」の4つのチャンネルに入る。
+

+channel:#aaaaa@ircnet,#bbbbb@ircnet:*.jp, #ccccc@ircnet
+channel:#ddddd@ircnet
+ +
+
+ + +
+ + +
+ Channel::Join::Invite 招待されたらそのチャンネルに入る。 +
+

+許可するユーザ/チャンネルのマスク。
+

+mask:* *!*@*
+

+plum: *!*@*
+

+

+招待されたチャンネルに流すメッセージのフォーマット。
+

+message:こんばんわ〜。
+ +
+
+ + +
+ + +
+ Channel::Join::Kicked 特定のチャンネルからkickされた時に、自動で入りなおす。 +
+

+対象となるチャンネル名のマスク
+

+channel:*
+ +
+
+ + +
+ + +
+ Channel::Mode::Get チャンネルにJOINした時、そのチャンネルのモードを取得します。 +
+

+Channel::Mode::Set等が正しく動くためには
+チャンネルのモードをTiarraが把握しておく必要があります。
+自動的にモードを取得するクライアントであれば必要ありませんが、
+そうでなければこのモジュールを使うべきです。
+

+

+設定項目は無し。
+

+ +
+
+ + +
+ + +
+ Channel::Mode::Oper::Grant 特定のチャンネルに特定の人間がjoinした時に、自分がチャンネルオペレータ権限を持っていれば+oする。 +
+

+splitからの復帰などで+o対象の人が一度に大量に入って来ても+oは少しずつ実行します。
+Excess Floodにはならない筈ですが、本格的な防衛BOTに使える程の物ではありません。
+

+

+対象の人間がjoinしてから実際に+oするまで何秒待つか。
+省略されたら待ちません。
+5-10 のように指定されると、その値の中でランダムに待ちます。
+

+wait:2-5
+

+チャンネルと人間のマスクを定義。Auto::Operと同様。
+

+mask:* example!~example@*.example.ne.jp
+ +
+
+ + +
+ + +
+ Channel::Mode::Set チャンネルを作成した時に自動的にモードを設定するモジュール。 +
+

+書式は<チャンネル名にマッチするマスク> <設定するモード>[,<設定するモード>,...]です。
+#IRC談話室@ircnetなら+t+nを、それ以外なら+nを設定する例。
+

+channel:#IRC談話室@ircnet +t
+channel:* +n
+

+LimeChat 標準設定を模倣する設定例。
+

+channel:* +sn
+ +
+
+ + +
+ + +
+ Channel::Rejoin チャンネルオペレータ権限を無くしたとき、一人ならjoinし直す。 +
+

++チャンネルや+aされているチャンネル以外でチャンネルオペレータ権限を持たずに
+一人きりになった時、そのチャンネルの@を復活させるために自動的にjoinし直すモジュール。
+トピック、モード、banリスト等のあらゆるチャンネル属性をも保存します。
+

+

++b,+I,+eリストの復旧を行なうかどうか。
+あまりに長いリストを取得するとMax Send-Q Exceedで落とされるかも知れません。
+

+save-lists:1
+ +
+
+ + + + + + diff -urN /non-existant-dir/doc/module/Client.html tiarra-20050322/doc/module/Client.html --- /non-existant-dir/doc/module/Client.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc/module/Client.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,213 @@ + + + + + + + Client + + + + + +
+ Client::Cache データをキャッシュしてサーバに問い合わせないようにする +
+

+キャッシュを使用しても、使われるのは接続後最初の一度だけです。
+二度目からは通常通りにサーバに問い合わせます。
+また、クライアントオプションの no-cache を指定すれば動きません。
+

+

+mode キャッシュを使用するか
+

+use-mode-cache:1
+

+who キャッシュを使用するか
+

+use-who-cache:1
+ +
+
+ + +
+ + +
+ Client::Conservative サーバが送信するような IRC メッセージを作成するようにする +
+

+サーバが実際に送信しているようなメッセージにあわせるようにします。
+多くのクライアントの設計ミスを回避でき(ると思われ)ます。
+

+ +
+
+ + +
+ + +
+ Client::Cotton Cotton の行うおかしな動作のいくつかを無視する +
+

+該当クライアントのオプション client-type に cotton や unknown と指定するか、
+Client::GetVersion を利用してクライアントのバージョンを取得するように
+してください。
+

+

+part shield (rejoin 時に自動で行われる part の無視)を使用するか
+

+use-part-shield:1
+ +
+
+ + +
+ + +
+ Client::Eval クライアントから Perl 式を実行できるようにする。 +
+

+eval を実行するコマンド名。省略されるとコマンドを追加しません。
+この時コマンドはTiarraが握り潰すので、IRCプロトコル上で定義された
+コマンド名を設定すべきではありません。
+

+command:eval
+ +
+
+ + +
+ + +
+ Client::GetVersion クライアントに CTCP Version を発行してバージョン情報を得る +
+

+オプションはいまのところありません。
+(開発者向け情報: 取得した情報は remark の client-version に設定され、
+                 Client::Guess から使用されます。)
+

+ +
+
+ + +
+ + +
+ Client::PatchworkMessage IRC メッセージにちょっと変更を加えて、クライアントのバグを抑制する +
+

+特に注意書きがない場合はデフォルトで有効です。
+また、 Client::GetVersion も同時に入れておくと便利です。
+とりあえず obsolete です。このモジュールで実装されていた機能は
+Client::Conservative によって実現できます。
+Client::Conservative で実装してはいけないようなものがあった場合のみ
+このモジュールで対処します。
+

+

+WoolChat:
+ 対応しているメッセージ:
+  NICK(コロンが必須)
+ 説明:
+  NICK は接続直後にも発行されるため、 Client::GetVersion での判別まで
+  待てません。該当クライアントのオプション client-type に woolchat と
+  指定してください。実名欄に $client-type=woolchat$ と書けば OK です。
+

+enable-woolchat:1
+

+X-Chat:
+ 対応しているメッセージ:
+  RPL_WHOISUSER(コロンが必須)
+ 説明:
+  WHOIS の realname にスペースが入っていないと最初の一文字が削られます。
+

+enable-xchat:1
+ +
+
+ + +
+ + +
+ Client::ProtectMyself 意図せず自分のニックが変わってしまうのを防止する +
+

+{nick,part,quit,join}-format: それぞれのメッセージのフォーマットを指定します。
+{nick,user,host,prefix}.now などはどこでも使えます。
+そのほかには
+ target : 表示するチャンネル(またはニック)。
+ nick.new : nick-format のみ。新しいニック。
+ message : part と quit 。メッセージ。
+

+nick-format:Nick changed #(nick.now) -> #(nick.new)
+part-format:Part #(nick.now) (#(message)) from #(target)
+quit-format:Quit #(nick.now) (#(message))
+join-format:Join #(nick.now) (#(prefix.now)) to #(target)
+ +
+
+ + +
+ + +
+ Client::Rehash 全チャンネル分の names の内部キャッシュをクライアントに送信する。 +
+

+もともとはクライアントの再初期化目的に作ったのですが、 names を送信しても
+更新されないクライアントが多いので、主に multi-server-mode な Tiarra の
+下にさらに Tiarra をつないでいる人向けにします。
+

+

+names でニックリストを更新してくれるクライアント:
+  Tiarra
+してくれないクライアント: (括弧内は確認したバージョンまたは注釈)
+  LimeChat(1.18)
+

+

+nick rehash に使うコマンドを指定します。
+第二パラメータとして現在クライアントが認識している nick を指定してください。
+

+command-nick:rehash-nick
+

+names rehash に使うコマンドを指定します。
+

+command-names:rehash-names
+

+チャンネルとチャンネルの間のウェイトを指定します。
+

+interval:2
+ +
+
+ + +
+ + +
+ Client::ShowNick show network +
+ +
+
+ + + + + + diff -urN /non-existant-dir/doc/module/Debug.html tiarra-20050322/doc/module/Debug.html --- /non-existant-dir/doc/module/Debug.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc/module/Debug.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,54 @@ + + + + + + + Debug + + + + + +
+ Debug::RawLog 標準出力にクライアントやサーバとの通信をダンプする。 +
+

+0 または省略で表示しない。 1 で表示する。
+クライアントオプションの logname によって、ダンプに使う名前を指定できます。
+

+

+サーバからの入力
+

+enable-server-in:1
+

+サーバへの出力
+

+enable-server-out:1
+

+クライアントからの入力
+

+enable-client-in:0
+

+クライアントへの出力
+

+enable-client-out:0
+

+PING/PONG を無視する
+

+ignore-ping:1
+

+NumericReply の名前を解決して表示する(ちゃんとした dump では無くなります)
+

+resolve-numeric:1
+ +
+
+ + + + + + diff -urN /non-existant-dir/doc/module/Log.html tiarra-20050322/doc/module/Log.html --- /non-existant-dir/doc/module/Log.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc/module/Log.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,274 @@ + + + + + + + Log + + + + + +
+ Log::Channel チャンネルやprivのログを取るモジュール。 +
+

+Log系のモジュールでは、以下のように日付や時刻の置換が行なわれる。
+%% : %
+%Y : 年(4桁)
+%m : 月(2桁)
+%d : 日(2桁)
+%H : 時間(2桁)
+%M : 分(2桁)
+%S : 秒(2桁)
+

+

+ログを保存するディレクトリ。Tiarraが起動した位置からの相対パス。~指定は使えない。
+

+directory:log
+

+ログファイルの文字コード。省略されたらjis。
+

+charset:sjis
+

+各行のヘッダのフォーマット。省略されたら'%H:%M'。
+

+header:%H:%M:%S
+

+ファイル名のフォーマット。省略されたら'%Y.%m.%d.txt'
+

+filename:%Y.%m.%d.txt
+

+ログファイルのモード(8進数)。省略されたら600
+

+mode:600
+

+ログディレクトリのモード(8進数)。省略されたら700
+

+dir-mode:700
+

+ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。
+

+command:privmsg,join,part,kick,invite,mode,nick,quit,kill,topic,notice
+

+PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。
+

+distinguish-myself:1
+

+各ログファイルを開きっぱなしにするかどうか。
+このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが
+ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを
+別々のファイルにログを取るような場合には使うべきではありません。
+万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・
+新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が
+あります。limit の詳細については OS 等のドキュメントを参照してください。
+

+keep-file-open:1
+

+keep-file-open 時に各行ごとに flush するかどうか。
+open/close の負荷は気になるが、ログは失いたくない人向け。
+keep-file-open が有効でないなら無視され(1になり)ます。
+

+always-flush:0
+

+keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく
+一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても
+最近の発言はまだ書き込まれていない可能性がある。
+syncを設定すると、即座にログをディスクに書き込むためのコマンドが追加される。
+省略された場合はコマンドを追加しない。
+

+sync:sync
+

+各チャンネルの設定。チャンネル名の部分はマスクである。
+個人宛てに送られたPRIVMSGやNOTICEはチャンネル名"priv"として検索される。
+記述された順序で検索されるので、全てのチャンネルにマッチする"*"などは最後に書かなければならない。
+指定されたディレクトリが存在しなかったら、Log::Channelはそれを勝手に作る。
+フォーマットは次の通り。
+channel: <ディレクトリ名> (<チャンネル名> / 'priv')
+例:
+filename: %Y.%m.%d.txt
+channel: IRCDanwasitu #IRC談話室@ircnet
+channel: others *
+この例では、#IRC談話室@ircnetのログはIRCDanwasitu/%Y.%m.%d.txtに、
+それ以外(privも含む)のログはothers/%Y.%m.%d.txtに保存される。
+

+channel:priv priv
+channel:others *
+ +
+
+ + +
+ + +
+ Log::ChannelList チャンネルリストをテンプレートに沿って HTML 化します。 +
+

+list コマンドが実行された際に動作します。
+

+

+出力したいファイル名、ネットワーク名、使う設定のブロックを指定します。。
+

+networks:ircnet.html ircnet ircnet
+ircnet +
+

+テンプレートファイルを指定します。
+

+template:channellist.html.tmpl
+

+出力とテンプレートファイルの文字コードを指定します。
+

+charset:euc
+

+取得を開始/終了した時刻のフォーマットを指定します。
+

+fetch-starttime:%Y年%m月%d日 %H時%M分(日本時間)
+fetch-endtime:%Y年%m月%d日 %H時%M分(日本時間)
+

+表示するチャンネルの mask を指定します。
+

+mask:*
+mask:-re:^\&(AUTH|SERVICES|LOCAL|HASH|SERVERS|NUMERICS|CHANNEL|KILLS|NOTICES|ERRORS)
+

+出力するファイルのモードを指定します。
+

+mode:644
+
+ +
+
+ + +
+ + +
+ Log::Raw サーバとの生の通信を保存する +
+

+Log系のモジュールでは、以下のように日付や時刻の置換が行なわれる。
+%% : %
+%Y : 年(4桁)
+%m : 月(2桁)
+%d : 日(2桁)
+%H : 時間(2桁)
+%M : 分(2桁)
+%S : 秒(2桁)
+

+

+ログを保存するディレクトリ。Tiarraが起動した位置からの相対パス。~指定は使えない。
+

+directory:rawlog
+

+各行のヘッダのフォーマット。省略されたら'%H:%M'。
+

+header:%H:%M:%S
+

+ファイル名のフォーマット。省略されたら'%Y.%m.%d.txt'
+

+filename:%Y-%m-%d.txt
+

+ログファイルのモード(8進数)。省略されたら600
+

+mode:600
+

+ログディレクトリのモード(8進数)。省略されたら700
+

+dir-mode:700
+

+使っている文字コードがよくわからなかったときの文字コード。省略されたらutf8。
+たぶんこの指定が生きることはないと思いますが……。
+

+charset:jis
+

+NumericReply の名前を解決して表示する(ちゃんとした dump では無くなります)
+

+resolve-numeric:1
+

+ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。
+

+command:*,-ping,-pong
+

+各ログファイルを開きっぱなしにするかどうか。
+このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが
+ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを
+別々のファイルにログを取るような場合には使うべきではありません。
+万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・
+新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が
+あります。limit の詳細については OS 等のドキュメントを参照してください。
+

+keep-file-open:1
+

+keep-file-open 時に各行ごとに flush するかどうか。
+open/close の負荷は気になるが、ログは失いたくない人向け。
+keep-file-open が有効でないなら無視され(1になり)ます。
+

+always-flush:0
+

+keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく
+一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても
+最近の発言はまだ書き込まれていない可能性がある。
+syncを設定すると、即座にログをディスクに書き込むためのコマンドが追加される。
+省略された場合はコマンドを追加しない。
+

+sync:sync
+

+各サーバの設定。サーバ名の部分はマスクである。
+記述された順序で検索されるので、全てのサーバにマッチする"*"などは最後に書かなければならない。
+指定されたディレクトリが存在しなかったら、勝手に作られる。
+フォーマットは次の通り。
+channel: <ディレクトリ名> <サーバ名マスク>
+例:
+filename: %Y-%m-%d.txt
+server: ircnet ircnet
+server: others *
+この例では、ircnetのログはircnet/%Y.%m.%d.txtに、
+それ以外のログはothers/%Y.%m.%d.txtに保存される。
+

+server:ircnet ircnet
+server:others *
+ +
+
+ + +
+ + +
+ Log::Recent クライアントを接続した時に、保存しておいた最近のメッセージを送る。 +
+

+クライアントオプションの no-recent-logs が指定されていれば送信しません。
+

+

+各行のヘッダのフォーマット。省略されたら'%H:%M'。
+

+header:%H:%M:%S
+

+ログをチャンネル毎に何行まで保存するか。省略されたら10。
+

+line:15
+

+PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。
+

+distinguish-myself:1
+

+どのメッセージを保存するか。省略されたら保存可能な全てのメッセージを保存する。
+

+command:privmsg,notice,topic,join,part,quit,kill
+ +
+
+ + + + + + diff -urN /non-existant-dir/doc/module/System.html tiarra-20050322/doc/module/System.html --- /non-existant-dir/doc/module/System.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc/module/System.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,229 @@ + + + + + + + System + + + + + +
+ System::Error サーバーからのERRORメッセージをNOTICEに埋め込む +
+

+これをoffにするとクライアントにERRORメッセージがそのまま送られます。
+クライアントとの間ではERRORメッセージは主に切断警告に使われており、
+そのまま流してしまうとクライアントが混乱する可能性があります。
+  設定項目はありません。
+

+

+このモジュールを回避してERRORメッセージをクライアントに送りたい場合は、
+remarkのsend-error-as-is-to-clientを指定してください。
+

+ +
+
+ + +
+ + +
+ System::Macro 新規にコマンドを追加し、そのコマンドが使われた時に特定の動作をまとめて実行します。 +
+

+書式: <コマンド> <動作>
+コマンド"switch"を追加して、それが使われると
+#a@ircnet,#b@ircnet,#c@ircnetにjoinして、
+#d@ircnet,#e@ircnet,#f@ircnetからpartする例。
+

+macro:switch join #a@ircnet,#b@ircnet,#c@ircnet
+macro:switch part #d@ircnet,#e@ircnet,#f@ircnet
+ +
+
+ + +
+ + +
+ System::NotifyIcon::Win32 タスクトレイにアイコンを表示する。 +
+

+タスクトレイにアイコンを表示します。
+クリックすると表示非表示を切り替えることができ、右クリックすると
+Reload と Exit ができるコンテキストメニューを表示します。
+多少反応が鈍いかもしれませんがちょっと待てば出てくると思います。
+

+

+Win32::GUI を必要とします。
+コンテキストメニューは表示している間処理をブロックしています。
+

+

+Win32 イベントループを処理する最大間隔を指定します。
+

+interval:2
+

+通知領域に表示するアイコンを指定します。
+Win32::GUI の制限でちゃんとしたアイコンファイルしか指定できません。
+

+iconfile:guiperl.ico
+

+モジュールが読み込まれたときにコンソールウィンドウを隠すかどうかを
+指定します。
+

+hide-console-on-load:1
+ +
+
+ + +
+ + +
+ System::Pong サーバーからのPINGメッセージに対し、自動的にPONGを返す。 +
+

+これをoffにするとクライアントが自らPINGに応答せざるを得なくなりますが、
+クライアントからのPONGメッセージはデフォルトのサーバーへ送られるので
+デフォルト以外のサーバーからはPing Timeoutで落とされるなど
+全く良い事がありません。
+  設定項目はありません。
+

+ +
+
+ + +
+ + +
+ System::PrivTranslator クライアントからの個人的なprivが相手に届かなくなる現象を回避する。 +
+

+このモジュールは個人宛てのprivmsgの送信者のnickにネットワーク名を付加します。
+設定項目はありません。
+

+ +
+
+ + +
+ + +
+ System::Raw マスクで指定したサーバーにIRCメッセージを加工せずに直接送る。 +
+

+例えばQUITを送る事で一時的な切断が可能。
+

+

+この機能を利用するためのコマンド名。デフォルトは「raw」。
+「/raw ircnet quit」のようにして使う。
+一つ目のパラメータは送り先のネットワーク名。ワイルドカード使用可能。
+CHOCOA の場合、 raw がクライアントで使われてしまうので、
+コマンド名を変えるか、 /raw raw ircnet quit のようにする必要がある。
+

+command:raw
+ +
+
+ + +
+ + +
+ System::Reload confファイルやモジュールの更新をリロードするコマンドを追加する。 +
+

+リロードを実行するコマンド名。省略されるとコマンドを追加しません。
+例えば"load"を設定すると、"/load"と発言しようとした時にリロードを実行します。
+この時コマンドはTiarraが握り潰すので、IRCプロトコル上で定義された
+コマンド名を設定すべきではありません。
+

+command:load
+

+command と同じですが、サーバにもブロードキャストします。
+

+broadcast-command:load-all
+

+confファイルをリロードしたときに通知します。
+モジュールの設定が変更されていた場合は、ここでの設定にかかわらず、
+モジュールごとに表示されます。1または省略された場合は通知します。
+

+conf-reloaded-notify:1
+ +
+
+ + +
+ + +
+ System::RemoteControl 特定の発言が送られてきたとき、それに反応してIRCコマンドを実行します。 +
+

+実行を許可する人間を表すマスク。
+

+mask:*!*example@example.net
+

+ 構文: +
+ は反応するbotのnickを表すマスク。
+ はサーバーに向けて発行するIRCメッセージ。
+
+ 例:
+ + hoge NICK [hoge]
+ hogeというBOTが[hoge]にnickを変更する。
+

+ +
+
+ + +
+ + +
+ System::Shutdown Tiarraを終了させる。 +
+

+クライアントから特定のコマンドが実行された時や、
+誰かから個人的に(privで)特定の発言が送られた時に
+Tiarra を終了させます。
+

+

+追加するコマンド。省略された場合はコマンドでのシャットダウンは無効になります。
+

+command:shutdown
+

+Tiarraをシャットダウンさせるprivの発言。
+省略された場合はprivでのシャットダウンは無効になります。
+パラメータとして shutdown メッセージを指定できます。
+

+message:shutdown
+

+privでのシャットダウンを許可する人。
+省略された場合はprivでのシャットダウンは無効になります。
+複数のマスクを指定した場合は、一つでもマッチするものがあればシャットダウンします。
+

+mask:example!example@*.example.jp
+ +
+
+ + + + + + diff -urN /non-existant-dir/doc/module/User.html tiarra-20050322/doc/module/User.html --- /non-existant-dir/doc/module/User.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc/module/User.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,173 @@ + + + + + + + User + + + + + +
+ User::Away::Client クライアントが一つも接続されていない時にAWAYを設定します。 +
+

+どのようなAWAYメッセージを設定するか。省略された場合はAWAYを設定しません。
+

+away:居ない。
+ +
+
+ + +
+ + +
+ User::Away::Nick ニックネーム変更に応じて AWAY を設定します。 +
+

+ニックネームを変更したときに、そのニックネームに対応するAWAYが
+設定されていれば、そのAWAYを設定します。そうでなければAWAYを取り消します。
+

+

+ 書式: <設定するAWAYメッセージ>
+
+ nickをhoge_zzzに変更すると、「寝ている」というAWAYを設定する。
+ hoge_workまたはhoge_zzzに変更した場合は、「仕事中」というAWAYを設定する。
+ それ以外のnickに変更した場合はAWAYを取り消す。
+ 後者は正規表現を利用して「away: re:hoge_(work|zzz) 仕事中」としても良い。
+

+away:hoge_zzz 寝ている
+away:hoge_work,hoge_zzz 仕事中
+ +
+
+ + +
+ + +
+ User::Filter 指定された人物からのPRIVMSGやNOTICEを書き換える。 +
+

+人物のマスクと、置換パターンを定義。
+置換パターン中の#(message)は、発言内容に置換されます。
+人物が複数のマスクに一致する場合は、最初に一致したものが使われます。
+

+pattern:*!*@* #(message)
+ +
+
+ + +
+ + +
+ User::Ignore 指定された人間からのPRIVMSGやNOTICEを破棄してクライアントへ送らないようにするモジュール。 +
+

+対象となるコマンドのマスク。省略時には"privmsg,notice"が設定されている。
+ただしprivmsgとnotice以外を破棄してしまうと、(Tiarraは平気でも)クライアントが混乱する。
+

+command:privmsg,notice
+

+maskは複数定義可能。定義された順番でマッチングが行なわれます。
+

+mask:example!*@*.example.net
+ +
+
+ + +
+ + +
+ User::Nick::Detached クライアントが接続されていない時に、特定のnickに変更します。 +
+

+クライアントが接続されていない時のnick。
+このnickが既に使われていたら、適当に変更が加えられて使用されます。
+クライアントが再び接続されると、切断前のローカルnickに戻ります。
+

+detached:PHO_d
+ +
+
+ + +
+ + +
+ User::ServerOper 特定のネットワークに接続した時、OPERコマンドを発行します。 +
+

+ 書式: <ネットワーク名> <オペレータ名> <オペレータパスワード>
+
+ ネットワーク"local"に接続した時、オペレータ名oper、
+ オペレータパスワードoper-passでOPERコマンドを発行する例。
+

+oper:local oper oper-pass
+ +
+
+ + +
+ + +
+ User::Vanish 指定された人物の存在を、様々なメッセージから消去する。 +
+

+対象となった人物の発行したJOIN、PART、INVITE、QUIT、NICKは消去され、NAMESの返すネームリストからも消える。
+また、対象となった人物のNJOINも消去される。
+

+

+Vanish対象が発行したMODEを消去するかどうか。デフォルトで0。
+消去するとは云え、本当にMODEそのものを消してしまうのではなく、
+そのユーザーの代わりに"HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH"がMODEを実行した事にする。
+

+drop-mode-by-target:1
+

+Vanish対象を対象とするMODE +o/-o/+v/-vを消去するかどうか。デフォルトで1。
+

+drop-mode-switch-for-target:1
+

+Vanish対象が発行したKICKを消去するかどうか。デフォルトで0。
+本当に消すのではなく、"HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH"がKICKを実行した事にする。
+

+drop-kick-by-target:1
+

+Vanish対象を対象とするKICKを消去するかどうか。デフォルトで0。
+

+drop-kick-for-target:0
+

+Vanish対象が発行したTOPICを消去するかどうか。デフォルトで0。
+本当に消すのでは無いが、他の設定と同じ。
+

+drop-topic-by-target:1
+

+チャンネルとVanish対象の定義。
+特定のチャンネルでのみ対象とする、といった事が可能。
+また、privの場合は「#___priv___@ネットワーク名」という文字列をチャンネル名の代わりとしてマッチングを行なう。
+書式: mask: <チャンネルのマスク> <ユーザーのマスク>
+

+mask:#example@example example!exapmle@example.com
+ +
+
+ + + + + + diff -urN /non-existant-dir/doc/module-toc.html tiarra-20050322/doc/module-toc.html --- /non-existant-dir/doc/module-toc.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc/module-toc.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,187 @@ + + + + + + + モジュール + + + + +

モジュール

+ +

[ここにモジュール全般についての説明を入れる]

+ +
    + +
  • + Auto 自動反応 +
      + +
    • Auto::Alias ユーザエイリアス情報の管理を行ないます。
      • + +
    • Auto::Answer 特定の発言に反応して対応する発言をする。
      • + +
    • Auto::Calc Perlの式を計算させるモジュール。
      • + +
    • Auto::ChannelWithoutOper チャンネルオペレータ権限がなくなってしまったときに発言する。
      • + +
    • Auto::Joined 特定のチャンネルに誰かがJOINする度に特定のメッセージを発言する。
      • + +
    • Auto::MesMail 伝言をメールとして送信する。
      • + +
    • Auto::Oper 特定の文字列を発言した人を+oする。
      • + +
    • Auto::Random 特定の発言に反応してランダムな発言をします。
      • + +
    • Auto::Reply 特定の発言に反応して発言をします。
      • + +
    • Auto::Response データファイルの指定にしたがって反応する。
      • + +
    +
    • + +
  • + CTCP CTCP 関連 + +
    • + +
  • + Channel チャンネルに対する操作 +
      + +
    • Channel::Freeze 特定のチャンネルの発言を、一時的に受信するのをやめる。
      • + +
    • Channel::Join::Connect サーバーに初めて接続した時、指定したチャンネルに入るモジュール。
      • + +
    • Channel::Join::Invite 招待されたらそのチャンネルに入る。
      • + +
    • Channel::Join::Kicked 特定のチャンネルからkickされた時に、自動で入りなおす。
      • + +
    • Channel::Mode::Get チャンネルにJOINした時、そのチャンネルのモードを取得します。
      • + +
    • Channel::Mode::Oper::Grant 特定のチャンネルに特定の人間がjoinした時に、自分がチャンネルオペレータ権限を持っていれば+oする。
      • + +
    • Channel::Mode::Set チャンネルを作成した時に自動的にモードを設定するモジュール。
      • + +
    • Channel::Rejoin チャンネルオペレータ権限を無くしたとき、一人ならjoinし直す。
      • + +
    +
    • + +
  • + Client クライアントとの入出力 +
      + +
    • Client::Cache データをキャッシュしてサーバに問い合わせないようにする
      • + +
    • Client::Conservative サーバが送信するような IRC メッセージを作成するようにする
      • + +
    • Client::Cotton Cotton の行うおかしな動作のいくつかを無視する
      • + +
    • Client::Eval クライアントから Perl 式を実行できるようにする。
      • + +
    • Client::GetVersion クライアントに CTCP Version を発行してバージョン情報を得る
      • + +
    • Client::PatchworkMessage IRC メッセージにちょっと変更を加えて、クライアントのバグを抑制する
      • + +
    • Client::ProtectMyself 意図せず自分のニックが変わってしまうのを防止する
      • + +
    • Client::Rehash 全チャンネル分の names の内部キャッシュをクライアントに送信する。
      • + +
    • Client::ShowNick show network
      • + +
    +
    • + +
  • + Debug Tiarraや、Tiarraモジュールのデバッグ用 +
      + +
    • Debug::RawLog 標準出力にクライアントやサーバとの通信をダンプする。
      • + +
    +
    • + +
  • + Log ログの記録 +
      + +
    • Log::Channel チャンネルやprivのログを取るモジュール。
      • + +
    • Log::ChannelList チャンネルリストをテンプレートに沿って HTML 化します。
      • + +
    • Log::Raw サーバとの生の通信を保存する
      • + +
    • Log::Recent クライアントを接続した時に、保存しておいた最近のメッセージを送る。
      • + +
    +
    • + +
  • + System Tiarra自身の動作に関するもの +
      + +
    • System::Error サーバーからのERRORメッセージをNOTICEに埋め込む
      • + +
    • System::Macro 新規にコマンドを追加し、そのコマンドが使われた時に特定の動作をまとめて実行します。
      • + +
    • System::NotifyIcon::Win32 タスクトレイにアイコンを表示する。
      • + +
    • System::Pong サーバーからのPINGメッセージに対し、自動的にPONGを返す。
      • + +
    • System::PrivTranslator クライアントからの個人的なprivが相手に届かなくなる現象を回避する。
      • + +
    • System::Raw マスクで指定したサーバーにIRCメッセージを加工せずに直接送る。
      • + +
    • System::Reload confファイルやモジュールの更新をリロードするコマンドを追加する。
      • + +
    • System::RemoteControl 特定の発言が送られてきたとき、それに反応してIRCコマンドを実行します。
      • + +
    • System::Shutdown Tiarraを終了させる。
      • + +
    +
    • + +
  • + User 特定の人間に対する動作や自分自身についての動作 +
      + +
    • User::Away::Client クライアントが一つも接続されていない時にAWAYを設定します。
      • + +
    • User::Away::Nick ニックネーム変更に応じて AWAY を設定します。
      • + +
    • User::Filter 指定された人物からのPRIVMSGやNOTICEを書き換える。
      • + +
    • User::Ignore 指定された人間からのPRIVMSGやNOTICEを破棄してクライアントへ送らないようにするモジュール。
      • + +
    • User::Nick::Detached クライアントが接続されていない時に、特定のnickに変更します。
      • + +
    • User::ServerOper 特定のネットワークに接続した時、OPERコマンドを発行します。
      • + +
    • User::Vanish 指定された人物の存在を、様々なメッセージから消去する。
      • + +
    +
    • + +
+ +

[ここにも適当になんか入れとく]

+ + + diff -urN /non-existant-dir/doc-src/README tiarra-20050322/doc-src/README --- /non-existant-dir/doc-src/README 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc-src/README 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,115 @@ +-*- mode: outline; mode: auto-fill; -*- + +* tdoc形式について + +次のような形式を持つ=podと=cutに囲まれた範囲が、TiarraDoc(tdoc)として +認識されます。 + +=pod +ヘッダのキー: ヘッダの値 +ヘッダのキー: ヘッダの値 +... + +内容 +=cut + +このように、"キー: 値"の行が一つ以上続き、その後に空行が来るような形を +していないpodはtdocパーサによって無視されます。 + +tdocデータはファイル内の何処にあっても構いませんが、そのtdocが説明する +パッケージ内の範囲に無ければなりません。つまり、複数のパッケージを持 +つ*.pmファイルの中では、パッケージFooについてのtdocはパッケージFoo内に +置く必要があります。 +tdocパーサはperlのpackage文を認識し、どのパッケージについての説明であ +るかを判断します。 + +tdocデータはsample.confの生成とhtmlドキュメントの生成の両方に使われま +す。また、将来これ以外の使い方がされる可能性もあります。 + +** ヘッダ + +ヘッダに記述すべき内容は、通常のモジュール(module下のもの)、内部モジュー +ル(main下のもの)、そしてドキュメント生成元データ(doc-src下の*.tdoc)そ +れぞれに於て異なります。 + +*** 通常のモジュールのヘッダ(module下のもの) + +通常のモジュールは、ヘッダとして"info"と"default"を持ちます。 +infoはモジュールの簡単な説明(一行)、defaultは値として"on"または"off"を +持つ真偽値で、それぞれsample.conf内でデフォルトで"+"になっているか"-" +になっているかを示します。 + +例(System::Reload): + +=pod +info: confファイルやモジュールの更新をリロードするコマンドを追加する。 +default: on + +# リロードを実行するコマンド名。省略されるとコマンドを追加しません。 +# 例えば"load"を設定すると、"/load"と発言しようとした時にリロードを実行します。 +# この時コマンドはTiarraが握り潰すので、IRCプロトコル上で定義された +# コマンド名を設定すべきではありません。 +command: load +=cut + +*** 内部モジュール(main下のもの) + +未定 + +*** ドキュメント生成元データ(doc-src下の*.tdoc) + +未定 + + +** 内容 + +ドキュメント内容もヘッダと同じように、通常モジュール、内部モジュール、 +ドキュメント生成元データのそれぞれに於て異ります。 + +*** 通常モジュール + +通常モジュールは、"#"で始まる行と"key: value"の形そしている行、そして +"-key: value"の形をしている行の三種類の形式で記述します。 +空の行やこれらの形を持たない行は、パーサによって無視されます。 + +"#"で始まる行は、後述する"key: value"の説明の為にあります。 +連続する"#"行はtdocパーサによって一つに纏められ、先頭の空白が削除され +た後にsample.conf、htmlの各形式に整形されます。 +纏められた"#"行の先頭に共通する空白は全て削除されますが、共通*しない* +空白は残されます。 + +例: +# foo +# bar +# baz + +以上の三行は纏められ、先頭の空白が削除される。sample.confでの整形結果 +は結果は次の通り。 + +# foo +# bar +# baz + +例: +# foo +# bar +# baz + +以上の三行は纏められ、全ての行に存在する空白が削除される。結果は次の通 +り。 + +# foo +# bar +# baz + +"key: value"形式の行は、そのモジュールの設定項目を表します。 +同様に、"-key: value"形式の行は、そのモジュールの設定項目ではあっても、 +sample.confではデフォルトでコメントアウトされている項目を表します。 + +*** 内部モジュール(main下のもの) + +未定 + +*** ドキュメント生成元データ(doc-src下の*.tdoc) + +未定 diff -urN /non-existant-dir/doc-src/all.conf.in tiarra-20050322/doc-src/all.conf.in --- /non-existant-dir/doc-src/all.conf.in 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc-src/all.conf.in 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,73 @@ +# -*- tiarra-conf -*- +# ----------------------------------------------------------------------------- +# $Id: all.conf.in 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# tiarra.conf サンプル +# このファイルにはすべてのブロックの解説があります。 +# 必要なブロックがあればここからコピーしていってください。 +# ----------------------------------------------------------------------------- + +# ----------------------------------------------------------------------------- +# generalブロック +# +# tiarra.conf自身の文字コードやユーザー情報などを指定するブロックです。 +# ----------------------------------------------------------------------------- +<&general> + +# ----------------------------------------------------------------------------- +# networksブロック +# +# Tiarraから接続するIRCネットワークの名称です。 +# 一つも定義しなかった場合やこのブロックを省略した場合は、 +# "main"というネットワークが一つだけ指定されたものと見做します。 +# ----------------------------------------------------------------------------- +<&networks> + +# ----------------------------------------------------------------------------- +# 各ネットワークの設定 +# +# networksブロックで定義した全てのネットワークについて、 +# そのアドレス、ポート、(必要なら)パスワードを定義します。 +# ----------------------------------------------------------------------------- +<&ircnet> + +<&2ch> + +# ----------------------------------------------------------------------------- +# 必須の設定は以上です。以下はモジュール(プラグイン)の設定です。 +# ----------------------------------------------------------------------------- + +# +または-で始まる行はモジュール設定行と見做されます。 +# +で記述されたモジュールが使用され、-で記述されたモジュールは使用されません。 +# +や-の後の空白は幾つあっても無視されます。 + +# メッセージが各モジュールを通過する順番は、このconfファイルで記述された +# 順番の通りになります。ログを取るモジュールなどはconfでも後の方に +# 記述した方が良いということになります。 + +# モジュール名はperlのそれと同じようにディレクトリ区切り文字を「::」としたパスで表現されます。 +# 例えばモジュールChannel::Auto::Operの実体はファイルmodule/Channel/Auto/Oper.pm +# でなければならず、そのpackage宣言もChannel::Auto::Operでなければなりません。 +# Tiarraモジュールの名称は、perl標準モジュール群やmain/下の.pmファイルと重複しないように +# 気を付けて下さい。Tiarraはモジュールが本当にModuleのサブクラスかどうかをチェックするので +# 例えばIO::Socket::INETといったモジュールを置いても誤動作はしませんが、 +# そのようなモジュールはロード時にエラーを出して使用中止になります。 + +# 一つのモジュールを複数回定義して、何度も同じモジュールをメッセージが通過するようには出来ません。 + +# 幾つかのモジュールはパラメータとしてチャンネル名を必要とします。 +# ここで指定するチャンネル名は、ネットワーク名も含めた文字列でなければなりません。 +# 「#チャンネル」では駄目で「#チャンネル@ネットワーク」などとする必要があります。 + +# マスクの書式: +# ['+' / '-'] ( <マスク文字列> / "re:" 正規表現 ) +# これはカンマで幾つでも継ぐ事が出来ます。"\,"でカンマそのものを表します。 +# 先頭が+なら、それに続く部分にマッチするものが選ばれ、-なら除外されます。省略されたら+と見做されます。 +# マスク文字列とは"*"で0文字以上の任意の文字列を、"?"で1文字の任意の文字列を表す文字列です。 +# 例: +# tiarra* これはtiarraで始まる文字列を表す。 +# +*!*tiarra@*.jp,-re:\d これは*!*tiarra@*.jpにマッチして、かつ文字列中に数字を含まないものを表す。 + + +<&module> + diff -urN /non-existant-dir/doc-src/conf-main.tdoc tiarra-20050322/doc-src/conf-main.tdoc --- /non-existant-dir/doc-src/conf-main.tdoc 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc-src/conf-main.tdoc 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,257 @@ +-*- outline -*- +$Id: conf-main.tdoc 846 2005-03-20 12:12:30Z topia $ + +perlのソースに使うpodパーサを流用しているので、package文と=pod〜=cutで書く必要があります。 +ヘッダのinfo-is-ommitedとno-switchはどちらも値を真に定義しなければなりません。 + +* general +package general; +=pod +info: conf自身の文字コードやユーザー情報などを指定する +info-is-omitted: 1 +no-switch: 1 + +# tiarra.conf自身の文字コード +# コード名はjis,sjis,euc,utf8,utf16,utf32等。(この値はUnicode::Japaneseにそのまま渡されます) +# autoが指定された、または省略された場合は自動判別します。 +conf-encoding: euc + +# ユーザー情報 +# 省略不能です。 +nick: tiarra +user: tiarra +name: Tiarra the "Aeon" + +# どのようなユーザーモードでログインするか。+iwや+iのように指定する。 +# 省略された場合はユーザーモードを特に設定しない。 +-user-mode: +i + +# Tiarraへの接続を許可するホスト名を表わすマスク。 +# 制限をしないのであれば"*"を指定するか省略する。 +client-allowed: * + +# Tiarraが開くポート。ここに指定したポートへクライアントに接続させる。 +# 省略されたらポートを開かない。 +tiarra-port: 6667 + +# Tiarraがポートtiarra-portを開く際、IPv6とIPv4のどちらでリスニングを行なうか。 +# 'v4'または'v6'で指定します。デフォルトは'v4'です。 +# IPv6を使うためにはSocket6.pmが利用可能である必要があります。 +-tiarra-ip-version: v4 + +# Tiarraがポートtiarra-portを開く際のローカルアドレス。 +# 意味が分からなければ省略して下さい。 +# デフォルトは、IPv4のはINADDR_ANY、IPv6のはin6addr_anyになります。 +-tiarra-ipv4-bind-addr: 0.0.0.0 +-tiarra-ipv6-bind-addr: ::0 + +# Tiarraにクライアントが接続する際に要求するパスワードをcryptした文字列。 +# 空の文字列が指定されたり省略された場合はパスワードを要求しない。 +# crypt は ./tiarra --make-password で行えます。 +tiarra-password: xl7cflIcH9AwE + +# 外部プログラムからtiarraをコントロールする為のUNIXドメインソケットの名前。 +# 例えば"foo"を指定した場合、ソケット/tmp/tiarra-control/fooが作られる。 +# 省略された場合はこの機能を無効とする。 +# また、非UNIX環境ではそもそもUNIXドメインソケットが利用可能でないため、 +# そのような場合にもこの機能は無効となる。 +-control-socket-name: test + +# IRCサーバーから送られる文字のコードと、IRCサーバーへ送る文字のコード +# どちらも省略された場合はjis。 +server-in-encoding: jis +server-out-encoding: jis + +# クライアントから受け取る文字のコードと、クライアントへ伝える文字のコード +# どちらも省略された場合はjis。 +client-in-encoding: jis +client-out-encoding: jis + +# Tiarraは標準出力に様々なメッセージを出力するが、その文字コードを指定する。省略時にはeucとなる。 +# ただしtiarra.confのパースが完了するまでは文字コードの変換は行なわれない(つまりこの設定が有効にならない)ことに注意して下さい。 +stdout-encoding: euc + +# Tiarraはエラーメッセージを標準出力に出力するが、その時に接続しているクライアントがあればクライアントにもNOTICEで送る事が出来る。 +# この値を1にすると、その機能が有効になる。省略するか0を指定するとこの機能は無効になる。 +notice-error-messages: 1 + +# Tiarraでチャンネルとユーザーのマスクを指定するときの形式。 +# plum形式とTiarra形式が選択できます。 +#----------------- +# plum形式: (channelには+や-は使えない。channelは省略すると*とみなす。) +# + syntax: user[ channel[ channel[ ...]]] +# +# mask: +*!*@*.example.com #{example}@ircnet +{example3}@ircnet +# mask: -*!*@*.example.com #{example2}@2ch,+{example4}@2ch +# mask: -*!*@* +#----------------- +# Tiarra形式: (channelにも+や-を使える。) +# + syntax: channel user +# +# mask: #{example}@ircnet,-#{example2}@2ch +*!*@*.example.com +# mask: ++{example3}@ircnet,-+{example4}@2ch +*!*@*.example.com # +で始まるチャンネル。 +# mask: * -*!*@* +#----------------- +# となります。 この二つはまったく同じマスクを表しています。 + +# この値をplumにすると、plum形式、省略するかtiarraを指定すると、Tiarra形式になります。 +chanmask-mode: tiarra + +# サーバーに接続する際、ローカル側のどのアドレスにバインドするか。 +# 意味が分からなければ省略して下さい。 +# デフォルトは、IPv4のはINADDR_ANY、IPv6のはin6addr_anyになります。 +-ipv4-bind-addr: 0.0.0.0 +-ipv6-bind-addr: ::0 + +# tiarra が、 001 や 002 や、 recent log を送信するときなどに使う prefix +# を指定します。 hostname や fqdn っぽいものを指定すると良いかもしれません。 +# デフォルトは tiarra です。普通変える必要はありません。 +-sysmsg-prefix: tiarra + +sysmsg-prefix-use-masks { + # sysmsg-prefix を使用する場所を指定する。 + + # システムメッセージ(NumericReply など)。デフォルトは * です。 + # ふつうこれを変更する必要はありません。 + system: * + + # 個人宛メッセージ(Notice,Privmsg の中で)。デフォルトはなし。 + -priv: + + # チャンネル宛メッセージ(Notice,Privmsg の中で)。デフォルトは * です。 + # Ziciz などのクライアントを接続する場合は、 + # -*::log を指定しておくといいかもしれません。 + channel: * +} + +# Tiarra が nick 変更時の衝突等を処理するモードを指定します。 +# 0: Tiarra が接続時と同様に自動処理します。 +# 1: クライアントにそのまま投げます。 +# 複数のクライアントが nick 重複を処理する場合は非常に危険です。 +# (設定不足の IRC クライアントが複数つながっている場合も含みます) +# 2: 対応するエラーメッセージ付きの NOTICE に変換して、 +# クライアントに投げます。 +# multi-server-mode 時のデフォルトは 0 、 single-server-mode 時のデフォルトは 1 です。 +-nick-fix-mode: 0 + +messages { + # Tiarra が使用する、いくつかのメッセージを指定する。 + + quit { + # ネットワーク設定が変更され、再接続する場合の切断メッセージ + netconf-changed-reconnect: Server Configuration changed; reconnect + + # ネットワーク設定が変更され、切断する場合の切断メッセージ + netconf-changed-disconnect: Server Configuration changed; disconnect + } +} +=cut + +* networks +package networks; +=pod +info: Tiarraから接続するネットワークの定義、その他 +info-is-omitted: 1 +no-switch: 1 + +# 複数のサーバーへの接続を可能にするかどうか。1(オン)と0(オフ)で指定。 +# これを1にすると、次のnameを複数個定義する事が可能になり、 +# 複数のサーバーに同時に接続出来るようになります。 +# その一方、これを1にしている時は、チャンネル名にネットワーク名が付加される等、 +# IRCの大部分のメッセージがTiarraによる改変を受けます。 +# これを0にしている間は、次のnameを複数個定義する事は出来なくなります。 +# マルチサーバーモードの設定を起動中に変えると、クライアントから見たチャンネル名が +# 変更になる為、全クライアントが一時的に全てのチャンネルからpartしたように見え、 +# その直後にjoinし直したように見えます。 +# デフォルトでは1です。 +multi-server-mode: 1 + +# 接続するIRCネットワークに名前を付けます。この名前は後で使用します。 +# 複数のネットワークに接続したい場合は多重定義して下さい。 +name: ircnet +name: 2ch + +# 通常Tiarraではチャンネル名を「#Tiarra@ircnet」のように表現します。 +# これはネットワークircnet内の#Tiarraというチャンネルを表わします。 +# @以降は省略可能ですが、省略された場合のデフォルトのネットワーク名をここで指定します。 +# 省略した場合は最も始めに定義されたnameがデフォルトになります。 +# (そしてnameが一つも無かった場合はmainがデフォルトになります) +-default: ircnet + +# 上に述べた通り、デフォルトではTiarraはチャンネル名とネットワーク名を@で区切ります。 +# この区切り文字は任意の文字に変更する事が出来ます。省略された場合は@になります。 +channel-network-separator: @ + +# 接続先のサーバーから切断された時に、joinしていたそのサーバーのチャンネルをどうするか。 +# 1. "part-and-join"の場合は、切断されるとクライアントにはチャンネルからpartしたように見せ掛け、 +# 再接続に成功すると再びjoinしたように見せ掛ける。最も負荷が高い。(これはplumに似た動作である) +# 2. "one-message"の場合は、切断されるとクライアントに宛ててTiarraがNOTICEでその旨を報告する。 +# 再接続に成功すると再びNOTICEで報告する。JOINやPARTはしないので、 +# クライアントからはまだそのチャンネルに残っているかのように見える。 +# 3. "message-for-each"の場合は、切断されるとクライアントに宛ててTiarraが +# 到達不能になった全てのチャンネルにNOTICEでその旨を報告する。 +# 再接続に成功すると再びNOTICEで報告する。JOINやPARTはしない。 +# デフォルトはpart-and-joinです。 +action-when-disconnected: message-for-each + +# NICKを変更する度に、変更したサーバーでの新しいNICKをNOTICEで常に通知するかどうか。 +# 1なら必ず通知し、0なら変更後のnickがローカルnick(クライアントが見る事の出来るnick)と違っている場合のみ通知する。 +# デフォルトは0です。 +always-notify-new-nick: 0 + +fixed-channels { + # Tiarra がクライアント接続時にチャンネル情報を送る順番を指定する。 + # マッチしなかったチャンネルについては最後にまとめて + # (順番がごちゃごちゃになって)送られてきます。 + channel: #てすとちゃんねる@ircnet + channel: #てすと@localserver + channel: *@localserver + channel: *@localserver:*.jp +} +=cut + + +* ircnet +package ircnet; +=pod +info: ネットワーク定義例 (IRCnet) +info-is-omitted: 1 +no-switch: 1 + +# サーバーのホストとポート。省略不可。 +host: irc.nara.wide.ad.jp +port: 6663 + +# general/userで設定したユーザ名を使わずに、各ネットワークで独自のユーザ名を使用する事も可能。 +# 省略されたら当然、general/userで設定したものが使われる。 +-user: hoge + +# general/nameで設定した本名(建前上)を使わずに、各ネットワークで独自の本名を使用可能。 +-name: hoge + +# このサーバーの要求するパスワード。省略可能。 +-password: hoge + +# general/setver-in/out-encodingで設定したエンコーディングを使わずに、 +# 各ネットワークで独自のエンコーディングを使用する事も可能。 +# 省略されたら当然、generalで設定したものが使われる。 +-in-encoding: jis +-out-encoding: jis + +# general/(ipv4|ipv6)bind-addrで設定したローカルアドレスを使わずに、 +# 各ネットワークで独自のbind_addrを使用する事も可能。 +# 省略されたらgeneralで設定したものが使われる。 +-ipv4-bind-addr: 0.0.0.0 +-ipv6-bind-addr: ::0 +=cut + +* 2ch +package 2ch; +=pod +info: ネットワーク定義例 (2ch) +info-is-omitted: 1 +no-switch: 1 + +host: irc.2ch.net +port: 6667 +=cut diff -urN /non-existant-dir/doc-src/contents.html tiarra-20050322/doc-src/contents.html --- /non-existant-dir/doc-src/contents.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc-src/contents.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,28 @@ + + + + + + + <&group-name> + + + + + +
+ <&content-name> <&description> +
+ <&content> +
+
+ + +
+ + + + + diff -urN /non-existant-dir/doc-src/module-group.tdoc tiarra-20050322/doc-src/module-group.tdoc --- /non-existant-dir/doc-src/module-group.tdoc 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc-src/module-group.tdoc 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,56 @@ +-*- outline -*- +$Id: module-group.tdoc 479 2004-08-20 23:55:47Z topia $ + +各モジュールの分類名(= グループ名)と、その説明。 +グループ名とは、モジュール名のm/^(.+?)::/で与えられる部分を指す。 + +この分類表で定義されていないモジュールは、グループ `UNCLASSIFIED' に属するものと見做される。 + +* Auto +package Auto; +=pod +description: 自動反応 +=cut + +* Channel +package Channel; +=pod +description: チャンネルに対する操作 +=cut + +* Client +package Client; +=pod +description: クライアントとの入出力 +=cut + +* CTCP +package CTCP; +=pod +description: CTCP 関連 +=cut + +* Debug +package Debug; +=pod +description: Tiarraや、Tiarraモジュールのデバッグ用 +=cut + +* Log +package Log; +=pod +description: ログの記録 +=cut + +* System +package System; +=pod +description: Tiarra自身の動作に関するもの +=cut + +* User +package User; +=pod +description: 特定の人間に対する動作や自分自身についての動作 +=cut + diff -urN /non-existant-dir/doc-src/module-toc.html tiarra-20050322/doc-src/module-toc.html --- /non-existant-dir/doc-src/module-toc.html 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc-src/module-toc.html 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,34 @@ + + + + + + + モジュール + + + + +

モジュール

+ +

[ここにモジュール全般についての説明を入れる]

+ + + +

[ここにも適当になんか入れとく]

+ + + diff -urN /non-existant-dir/doc-src/sample.conf.in tiarra-20050322/doc-src/sample.conf.in --- /non-existant-dir/doc-src/sample.conf.in 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/doc-src/sample.conf.in 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,114 @@ +# -*- tiarra-conf -*- +# ----------------------------------------------------------------------------- +# $Id: sample.conf.in 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# tiarra.conf サンプル +# +# tiarraは起動時に全ての設定をこのファイルから取得します。 +# このファイルの文字コードは任意ですが、改行コードはLFもしくはCRLFでなければなりません。 +# +# 半角の#で始まる行はコメントとして無視されます。 +# 行の途中に#を置いた場合はコメントにはなりません。 +# +# 設定行は「設定名 : 値」の形式で指定されます。 +# 行の先頭及び末尾、コロンの前後の空白は無視されます。 +# +# 特に指定が無い場合、同じ設定を二度以上繰り返した時は最初に定義された設定が有効になります。 +# +# ブロックごと省略した場合は、そのブロックの全ての値が省略されたものとみなします。 +# ただし省略不可能な設定もありますので御注意下さい。 +# +# 「@include foo.conf」という行があると、foo.confがその場所に +# 挿入されたかのように処理します。 +# +# {}記号の位置には、それなりの自由度があります。 +# 次の例は全て有効です。 +# block { +# foo: bar +# } +# +# block {} +# +# block +# {} +# +# 次の例は全て無効です。 +# block {foo: bar} +# +# block +# {foo: bar} +# +# block { +# foo: bar} +# +# block +# {foo: bar +# } +# ----------------------------------------------------------------------------- + +# ----------------------------------------------------------------------------- +# generalブロック +# +# tiarra.conf自身の文字コードやユーザー情報などを指定するブロックです。 +# ----------------------------------------------------------------------------- +<&general> + +# ----------------------------------------------------------------------------- +# networksブロック +# +# Tiarraから接続するIRCネットワークの名称です。 +# 一つも定義しなかった場合やこのブロックを省略した場合は、 +# "main"というネットワークが一つだけ指定されたものと見做します。 +# ----------------------------------------------------------------------------- +<&networks> + +# ----------------------------------------------------------------------------- +# 各ネットワークの設定 +# +# networksブロックで定義した全てのネットワークについて、 +# そのアドレス、ポート、(必要なら)パスワードを定義します。 +# ----------------------------------------------------------------------------- +<&ircnet> + +<&2ch> + +# ----------------------------------------------------------------------------- +# 必須の設定は以上です。以下はモジュール(プラグイン)の設定です。 +# ----------------------------------------------------------------------------- + +# +または-で始まる行はモジュール設定行と見做されます。 +# +で記述されたモジュールが使用され、-で記述されたモジュールは使用されません。 +# +や-の後の空白は幾つあっても無視されます。 + +# メッセージが各モジュールを通過する順番は、このconfファイルで記述された +# 順番の通りになります。ログを取るモジュールなどはconfでも後の方に +# 記述した方が良いということになります。 + +# モジュール名はperlのそれと同じようにディレクトリ区切り文字を「::」としたパスで表現されます。 +# 例えばモジュールChannel::Auto::Operの実体はファイルmodule/Channel/Auto/Oper.pm +# でなければならず、そのpackage宣言もChannel::Auto::Operでなければなりません。 +# Tiarraモジュールの名称は、perl標準モジュール群やmain/下の.pmファイルと重複しないように +# 気を付けて下さい。Tiarraはモジュールが本当にModuleのサブクラスかどうかをチェックするので +# 例えばIO::Socket::INETといったモジュールを置いても誤動作はしませんが、 +# そのようなモジュールはロード時にエラーを出して使用中止になります。 + +# 一つのモジュールを複数回定義して、何度も同じモジュールをメッセージが通過するようには出来ません。 + +# 幾つかのモジュールはパラメータとしてチャンネル名を必要とします。 +# ここで指定するチャンネル名は、ネットワーク名も含めた文字列でなければなりません。 +# 「#チャンネル」では駄目で「#チャンネル@ネットワーク」などとする必要があります。 + +# マスクの書式: +# ['+' / '-'] ( <マスク文字列> / "re:" 正規表現 ) +# これはカンマで幾つでも継ぐ事が出来ます。"\,"でカンマそのものを表します。 +# 先頭が+なら、それに続く部分にマッチするものが選ばれ、-なら除外されます。省略されたら+と見做されます。 +# マスク文字列とは"*"で0文字以上の任意の文字列を、"?"で1文字の任意の文字列を表す文字列です。 +# 例: +# tiarra* これはtiarraで始まる文字列を表す。 +# +*!*tiarra@*.jp,-re:\d これは*!*tiarra@*.jpにマッチして、かつ文字列中に数字を含まないものを表す。 + +# このファイルには重要と思われるいくつかのモジュールしかありません。 +# そのほかのモジュールについては、 all.conf から設定をコピーしてきてください。 + +<&module> + diff -urN /non-existant-dir/main/BulletinBoard.pm tiarra-20050322/main/BulletinBoard.pm --- /non-existant-dir/main/BulletinBoard.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/BulletinBoard.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,55 @@ +# ----------------------------------------------------------------------------- +# $Id: BulletinBoard.pm 542 2004-09-11 08:26:06Z topia $ +# ----------------------------------------------------------------------------- +# モジュール間の情報伝達に使われるクラス。 +# インスタンスは共有される。 +# ----------------------------------------------------------------------------- +package BulletinBoard; +use strict; +use warnings; +our $AUTOLOAD; +use Tiarra::SharedMixin; +our $_shared_instance; + +sub _new { + my $class = shift; + my $obj = { + table => {}, + }; + bless $obj,$class; +} + +sub set { + my ($class_or_this,$key,$value) = @_; + my $this = $class_or_this->_this; + $this->{table}->{$key} = $value; + $this; +} + +sub get { + my ($class_or_this,$key) = @_; + my $this = $class_or_this->_this; + $this->{table}->{$key}; +} + +sub keys { + keys %{shift->_this->{table}}; +} + +sub AUTOLOAD { + # $board->foo_bar => $board->get('foo-bar') + # $board->foo_bar('foo') => $board->set('foo-bar','foo'); + my ($class_or_this,$newvalue) = @_; + my $this = $class_or_this->_this; + (my $key = $AUTOLOAD) =~ s/.+?:://g; + $key =~ s/_/-/g; + + if (defined $newvalue) { + $this->set($key,$newvalue); + } + else { + $this->get($key); + } +} + +1; diff -urN /non-existant-dir/main/CTCP.pm tiarra-20050322/main/CTCP.pm --- /non-existant-dir/main/CTCP.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/CTCP.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,119 @@ +# ----------------------------------------------------------------------------- +# $Id: CTCP.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# IRCMessage中からCTCPメッセージを取り出したり、CTCPメッセージを持つIRCMessageを作ったり。 +# ----------------------------------------------------------------------------- +package CTCP; +use strict; +use warnings; +use Carp; +use UNIVERSAL; +use IRCMessage; + +use SelfLoader; +1; +__DATA__ + +sub extract { + # PRIVMSGかNOTICEであるIRCMessageにCTCPメッセージが埋め込まれていたら、それを取り出して返す。 + # '\x01CTCP VERSION\x01\x01CTCP USERINFO\x01'のように一つのメッセージ中に複数のCTCPメッセージが含まれていた場合は、 + # スカラーコンテクストなら最初に見付かったものだけを返し、配列コンテクストなら見付かったもの全てを返す。 + # CTCPメッセージを取り出せなかった場合は、undef(スカラー)または空配列(配列)を返す。 + my $msg = shift; + + if (!defined $msg) { + croak "CTCP::extract, Arg[0] is undef.\n"; + } + if (!UNIVERSAL::isa($msg,'IRCMessage')) { + croak "CTCP::extract, Arg[0] is bad ref: ".ref($msg)."\n"; + } + + my $low_level_dequote = sub { + my ($symbol) = @_; + + if ($symbol eq '0') { + return "\x00"; + } elsif ($symbol eq 'n') { + return "\x0a"; + } elsif ($symbol eq 'r') { + return "\x0d"; + } elsif ($symbol eq "\x10") { + return "\x10"; + } else { + # error, but return. + return $symbol; + } + }; + + my $ctcp_level_dequote = sub { + my ($symbol) = @_; + + if ($symbol eq 'a') { + return "\x01"; + } elsif ($symbol eq "\x5c") { + return "\x5c"; + } else { + # error, but return. + return $symbol; + } + }; + + my @result; + if ($msg->command eq 'PRIVMSG' || $msg->command eq 'NOTICE') { + @result = map { + # 2nd Level + s/\x10(.)/$low_level_dequote->($1)/eg; + + # 1st Level + s/\x5c(.)/$ctcp_level_dequote->($1)/eg; + + $_; + } ($msg->param(1) =~ m/\x01(.*)\x01/g); + } + + if (wantarray) { + @result; + } + else { + $result[0]; + } +} + +sub make { + # CTCPメッセージを含むIRCMessageを作って返す。 + # + # $message: 含めるCTCPメッセージ + # $target : 作るIRCMessageの最初のパラメータ。nickやチャンネル名を入れる。 + # $command: PRIVMSGとNOTICEのうち、どちらのコマンドで作るか。省略された場合はNOTICEになる。 + my ($message,$target,$command) = @_; + + if (!defined $target) { + croak "CTCP::make, Arg[1] is undef.\n"; + } + if (!defined $command) { + $command = 'NOTICE'; + } + + my $result = IRCMessage->new( + Command => $command, + Params => [$target, + do { + $_ = $message; + + # 1st Level + s/\x5c/\x5c\x5c/g; + s/\x01/\x5ca/g; + + # 2nd Level + s/\x10/\x10\x10/g; + s/\x00/\x100/g; + s/\x0a/\x10n/g; + s/\x0d/\x10r/g; + + "\x01$_\x01"; + }]); + + $result; +} + +1; diff -urN /non-existant-dir/main/ChannelInfo.pm tiarra-20050322/main/ChannelInfo.pm --- /non-existant-dir/main/ChannelInfo.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/ChannelInfo.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,218 @@ +# ----------------------------------------------------------------------------- +# $Id: ChannelInfo.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# チャンネル情報を保持 +# ----------------------------------------------------------------------------- +package ChannelInfo; +use strict; +use warnings; +use Carp; +use PersonInChannel; +use Multicast; +our $AUTOLOAD; + +sub new { + # nameに鯖名まで付けないように注意。#channel@ircnetはNG。 + my ($class,$name,$network_name) = @_; + my $obj = { + name => $name, + network_name => $network_name, + topic => '', + topic_who => undef, + topic_time => undef, + names => undef, # hash; nick => PersonInChannel + switches => undef, # hash; aやsなどのチャンネルモード。キーがaやsで、値は常に1。 + parameters => undef, # hash; lやkなどのチャンネルモード。 + banlist => undef, # array; +bリスト。知らなければ空。 + exceptionlist => undef, # array; +eリスト。知らなければ空。 + invitelist => undef, # array; +Iリスト。知らなければ空。 + remarks => undef, # hash; Tiarraが内部的に使用する備考。 + }; + + unless (defined $name) { + croak "ChannelInfo->new requires name parameter.\n"; + } + + bless $obj,$class; +} + +sub equals { + # チャンネル名とサーバーが同じなら真。 + my ($this,$ch) = @_; + defined $ch && $this->name eq $ch->name && + $this->network_name eq $ch->network_name; +} + +sub fullname { + # サーバー名を付けて返す。 + my $this = shift; + scalar Multicast::attach($this->name,$this->network_name); +} + +sub mode_string { + # RPL_CHANNELMODEIS の形式で返す。 + my $this = shift; + + my $str = '+'; + my @param; + my ($checker, %hash); + + # switches + $checker = sub { + my $key = shift; + if ($hash{$key}) { + $str .= $key; + delete $hash{$key} + } + }; + + %hash = %{$this->switches}; + map { + $checker->($_); + } split //, 'spmtinaqr'; + map { + $checker->($_); + } keys %hash; + + # parameters + %hash = %{$this->parameters}; + $checker = sub { + my $key = shift; + if ($hash{$key}) { + $str .= $key; + push(@param, $hash{$key}); + delete $hash{$key} + } + }; + map { + $checker->($_); + } split //, 'lk'; + map { + $checker->($_); + } keys %hash; + + return ($str, @param); +} + +my $types = { + topic => 'scalar', + topic_who => 'scalar', + topic_time => 'scalar', + names => 'hash', + switches => 'hash', + parameters => 'hash', + banlist => 'array', + exceptionlist => 'array', + invitelist => 'array', + remarks => 'hash', +}; +sub remarks; +*remark = \&remarks; # remarkはremarksのエイリアス。 +sub AUTOLOAD { + my ($this,@args) = @_; + (my $key = $AUTOLOAD) =~ s/^.+?:://g; + + if ($key eq 'DESTROY') { + return; + } + + if ($key eq 'name' || $key eq 'network_name') { + return $this->{$key}; + } + + my $type = $types->{$key}; + if (!defined($type)) { + croak "ChannelInfo doesn't have the parameter $key\n"; + } + + if ($type eq 'scalar') { + # $info->topic; + # $info->topic('NEW-TOPIC'); + if (defined $args[0]) { + $this->{$key} = $args[0]; + } + return $this->{$key}; + } + elsif ($type eq 'hash') { + # $info->names; + # $info->names('saitama'); + # $info->names('saitama',$person); + # $info->names('saitama',undef,'delete'); + # $info->names(undef,undef,'clear'); + # $info->names(undef,undef,'size'); + # $info->names(undef,undef,'keys'); + # $info->names(undef,undef,'values'); + my $hash = $this->{$key}; + + if (!defined $args[0] && !defined $args[2]) { + # HASH*を返す。 + $this->{$key} = $hash = {} if !$hash; + return $hash; + } + + if (defined $args[1]) { + $this->{$key} = $hash = {} if !$hash; + $hash->{$args[0]} = $args[1]; + } + if (defined $args[2]) { + if ($args[2] eq 'delete') { + delete $hash->{$args[0]} if $hash; + } + elsif ($args[2] eq 'clear') { + $this->{$key} = undef; + } + elsif ($args[2] eq 'size') { + return $hash ? scalar(keys %$hash) : 0; + } + elsif ($args[2] eq 'keys') { + return $hash ? keys %$hash : (); + } + elsif ($args[2] eq 'values') { + return $hash ? values %$hash : (); + } + else { + croak '[hash]->([key],[value],'.$args[2].") is invalid\n"; + } + } + return ($hash and $args[0]) ? $hash->{$args[0]} : undef; + } + elsif ($type eq 'array') { + # $info->banlist; + # $info->banlist('set','a!*@*','b!*@*','c!*@*'); + # $info->banlist('add','*!*@*.hoge.net'); + # $info->banlist('delete','*!*@*.hoge.net'); + my $array = $this->{$key}; + if (@args == 0) { + # ARRAY*を返す。 + $this->{$key} = $array = [] if !$array; + return $array; + } + + if ($args[0] eq 'set') { + $this->{$key} = $array = [] if !$array; + @$array = @args[1 .. $#args]; + } + elsif ($args[0] eq 'add') { + croak "'add' requires a value to add\n" unless defined $args[1]; + $this->{$key} = $array = [] if !$array; + push @$array,$args[1]; + } + elsif ($args[0] eq 'delete') { + croak "'delete' requires a value to remove\n" unless defined $args[1]; + if ($array) { + for (my $i = 0; $i < @$array; $i++) { + if ($array->[$i] eq $args[1]) { + splice @$array,$i,1; + $i--; + } + } + } + } + else { + croak "invalid command '".$args[0]."'\n"; + } + return $this; + } +} + +1; diff -urN /non-existant-dir/main/Configuration/Block.pm tiarra-20050322/main/Configuration/Block.pm --- /non-existant-dir/main/Configuration/Block.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Configuration/Block.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,262 @@ +# ----------------------------------------------------------------------------- +# $Id: Block.pm 803 2005-02-28 22:41:29Z topia $ +# ----------------------------------------------------------------------------- +package Configuration::Block; +use strict; +use warnings; +use vars qw($AUTOLOAD); +use UNIVERSAL; +use Tiarra::Encoding; +use Tiarra::DefineEnumMixin qw(BLOCK_NAME TABLE); +use Tiarra::Utils; +# 値を取得するにはgetメソッドを用いる他、エントリ名をそのままメソッドとして呼ぶ事も出来ます。 +# +# $block->hoge; +# これでパラメータhogeの値を返す。hogeが未定義ならundef値を返す。 +# hogeの値が一つだけだったらそれを返すが、複数の値が存在したらその先頭の値だけを返す。 +# 値もブロックだったら、そのブロックを返す。 +# +# $block->hoge('all'); +# パラメータhogeの全ての値を配列で返す。hogeが未定義なら空の配列を返す。 +# 値が一つしか無ければ値が一つの配列を返す。 +# +# $block->foo_bar; +# $block->foo_bar('all'); +# パラメータ"foo-bar"の値を返す。"foo_bar"ではない！ +# +# $block->foo('random'); +# パラメータfooに複数の定義があれば、そのうちの一つをランダムに返す。 +# 一つも無ければundefを返す。 +# +# $block->foo_bar('block'); +# $block->get('foo-bar', 'block'); +# パラメータ"foo-bar"の値が未定義である場合、undef値の代わりに +# 空のConfiguration::Blockを返す。 +# 定義されている場合、その値がブロックであればそれを返すが、 +# そうでなければ "foo-bar: その値" の要素を持ったブロックを生成し、それを返す。 +# +# $block->get('foo_bar'); +# $block->get('foo_bar','all'); +# パラメータ"foo_bar"の値を返す。 +# +# 以上の事から、Configuration::Blockはnew,block_name,table,set,get, +# reinterpret-encoding,AUTOLOADといった属性はget()でしか読めない。 +# また、属性名にアンダースコアを持つ属性もget()でしか読めない。 + +sub new { + my ($class,$block_name) = @_; + my $obj = bless [] => $class; + $obj->[BLOCK_NAME] = $block_name; + $obj->[TABLE] = {}; # ラベル -> 値(配列リファもしくはスカラー) + $obj; +} + +Tiarra::Utils->define_array_attr_accessor(0, qw(block_name table)); + +sub equals { + # 二つのConfiguration::Blockが完全に等価なら1を返す。 + my ($this,$that) = @_; + # ブロック名 + if ($this->[BLOCK_NAME] ne $that->[BLOCK_NAME]) { + return undef; + } + # キーの数 + my @this_keys = keys %{$this->[TABLE]}; + my @that_keys = keys %{$that->[TABLE]}; + if (@this_keys != @that_keys) { + return undef; + } + # 各要素 + my $size = @this_keys; + for (my $i = 0; $i < $size; $i++) { + # キー + if ($this_keys[$i] ne $that_keys[$i]) { + return undef; + } + # 値の型 + my $this_value = $this->[TABLE]->{$this_keys[$i]}; + my $that_value = $that->[TABLE]->{$that_keys[$i]}; + if (ref($this_value) ne ref($that_value)) { + return undef; + } + # 値 + if (ref($this_value) eq 'ARRAY') { + # 配列なので要素数と全要素を比較。 + if (@$this_value != @$that_value) { + return undef; + } + my $valsize = @$this_value; + for (my $j = 0; $j < $valsize; $j++) { + if ($this_value->[$j] ne $that_value->[$j]) { + return undef; + } + } + } + elsif (UNIVERSAL::isa($this_value,'Configuration::Block')) { + # ブロックなので再帰的に比較。 + return $this_value->equals($that_value); + } + else { + if ($this_value ne $that_value) { + return undef; + } + } + } + return 1; +} + +sub eval_code { + # 渡された文字列中の、全ての%CODE{ ... }EDOC%を評価して返す。 + my ($this,$str) = @_; + + if (ref($str)) { + return $str; # 文字列でなかったらそのまま返す。 + } + + my $eval = sub { + my $script = shift; + no strict; no warnings; + my $result = eval "package Configuration::Implanted; $script"; + use warnings; use strict; + if ($@) { + die "\%CODE{ }EDOC\% interpretation error.\n". + "block: ".$this->[BLOCK_NAME]."\n". + "original: $str\n". + "$@\n"; + } + $result; + }; + (my $evaluated = $str) =~ s/\%CODE{(.*?)}EDOC\%/$eval->($1)/eg; + $evaluated; +} + +sub get { + my ($this,$key,$option) = @_; + + unless (exists $this->[TABLE]->{$key}) { + # そのような値は定義されていない。 + if ($option && $option eq 'all') { + return (); + } + elsif ($option and $option eq 'block') { + return Configuration::Block->new($key); + } + else { + return undef; + } + } + + my $value = $this->[TABLE]->{$key}; + if ($option && $option eq 'all') { + if (ref($value) eq 'ARRAY') { + return map { + $this->eval_code($_); + } @{$value}; # 配列リファなら逆参照して返す。 + } + else { + return $this->eval_code($value); + } + } + elsif ($option && $option eq 'random') { + if (ref($value) eq 'ARRAY') { + # 配列リファならランダムに選んで返す + return $this->eval_code( + $value->[int(rand(0xffffffff)) % @$value]); + } + else { + return $this->eval_code($value); + } + } + elsif ($option and $option eq 'block') { + if (ref($value) and UNIVERSAL::isa($value, 'Configuration::Block')) { + return $value; + } + else { + my $tmp_block = Configuration::Block->new($key); + $tmp_block->set($key, $value); + return $tmp_block; + } + } + else { + if (ref($value) eq 'ARRAY') { + return $this->eval_code($value->[0]); # 配列リファなら先頭の値を返す。 + } + else { + return $this->eval_code($value); + } + } +} + +sub set { + # 古い値があれば上書きする。 + my ($this,$key,$value) = @_; + $this->[TABLE]->{$key} = $value; + $this; +} + +sub add { + # 古い値があればそれに追加する。 + my ($this,$key,$value) = @_; + if (defined $this->[TABLE]->{$key}) { + # 定義済み。 + if (ref($this->[TABLE]->{$key}) eq 'ARRAY') { + # 既に複数の値を持っているのでただ追加する。 + push @{$this->[TABLE]->{$key}},$value; + } + else { + # 配列に変更する。 + $this->[TABLE]->{$key} = [$this->[TABLE]->{$key},$value]; + } + } + else { + # 定義済みでない。 + $this->[TABLE]->{$key} = $value; + } +} + +sub reinterpret_encoding { + # このブロックの全ての要素を指定された文字エンコーディングで再解釈する。 + # 再解釈後はUTF-8になる。 + my ($this,$encoding) = @_; + + my $unicode = Tiarra::Encoding->new; + my $newtable = {}; + while (my ($key,$value) = each %{$this->[TABLE]}) { + my $newkey = $unicode->set($key,$encoding)->utf8; + my $newvalue = do { + if (ref($value) eq 'ARRAY') { + # 配列なので中身を全てコード変換。 + my @newarray = map { + $unicode->set($_,$encoding)->utf8; + } @$value; + \@newarray; + } + elsif (UNIVERSAL::isa($value,'Configuration::Block')) { + # ブロックなので再帰的にコード変換。 + $value->reinterpret_encoding($encoding); + } + else { + $unicode->set($value,$encoding)->utf8; + } + }; + $newtable->{$newkey} = $newvalue; + } + + $this->[TABLE] = $newtable; + $this; +} + +sub AUTOLOAD { + my ($this,$option) = @_; + + if ($AUTOLOAD =~ /::DESTROY$/) { + # DESTROYは伝達させない。 + return; + } + + (my $key = $AUTOLOAD) =~ s/.+?:://g; + $key =~ s/_/-/g; + return $this->get($key,$option); +} + +1; diff -urN /non-existant-dir/main/Configuration/LexicalAnalyzer.pm tiarra-20050322/main/Configuration/LexicalAnalyzer.pm --- /non-existant-dir/main/Configuration/LexicalAnalyzer.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Configuration/LexicalAnalyzer.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,180 @@ +# ----------------------------------------------------------------------------- +# $Id: LexicalAnalyzer.pm 526 2004-09-07 03:49:28Z topia $ +# ----------------------------------------------------------------------------- +# confファイルの字句解析器。 +# 文脈に応じてトークンを解析していく。 +# ----------------------------------------------------------------------------- +package Configuration::LexicalAnalyzer; +use strict; +use warnings; + +sub new { + # $body: 解析させる内容 + my ($class,$body) = @_; + my $this = { + body => $body, # トークンが解析される度に、解析されたトークンが消されていく。 + linecount => 0, # 現在どの行を解析しているか？この情報はエラー時にしか使われない。 + rollbackcount => 0, # 現在何行を読み過ぎているか？ + }; + bless $this; +} + +sub linecount { + shift->{linecount}; +} + +sub next { + # 次のトークンを得る。もう残っていなければundefを返す。 + # $context: 'outside' | 'block' + # + # outside: 今、ブロックの外側に居る事を示す。 + # block: 今、ブロック内に居る事を示す。 + # + # 戻り値: (トークン,タイプ) + # タイプとしては次のようなものがある。 + # 'label' => ブロックのラベル + # 'blockstart' => ブロックの始まり + # 'blockend' => ブロックの終わり + # 'pair' => キーと値のペア + my ($this,$context) = @_; + + my $method = "_context_$context"; + if ($this->can($method)) { + my ($token,$type) = eval { + $this->$method; + }; if ($@) { + die "Exception in analyzing token: line $this->{linecount}\n$@\n"; + } + ($token,$type); + } + else { + die "Illegal context: $context\n"; + } +} + +sub _context_outside { + my $this = shift; + + my $labelchar = qr{[^\s{}]}; # ブロック名として許される文字 + my $label = qr{^(?:(?:\+|\-)\s+)?$labelchar+}; # ブロックのラベル + + my $blockstart = qr|^{|; # ブロックの開始 + + my $line = $this->_nextline; + if (defined $line) { + my ($token,$type) = do { + if ($line =~ s/($label)//) { + ($1,'label'); + } + elsif ($line =~ s/($blockstart)//) { + ($1,'blockstart'); + } + else { + # 不正なトークン。 + die "Syntax error: $line\n"; + } + }; + # 必要なら残りの部分をロールバック + $this->rollback($line); + ($token,$type); + } + else { + undef; + } +} + +sub _context_block { + my $this = shift; + + my $keychar = qr{[^\s{}:]}; # キーとして許される文字 + my $pair = qr{^$keychar+\s*:.*$}; # キーと値のペア + + my $labelchar = qr{[^\s{}:]}; # ブロック内ブロックのラベルとして許される文字 + my $label = qr{^$labelchar+}; # ブロックのラベル + + my $blockstart = qr|^{|; # ブロックの開始 + my $blockend = qr|^}|; # ブロックの終了 + + my $line = $this->_nextline; + if (defined $line) { + my ($token,$type) = do { + if ($line =~ s/($pair)//) { + ($1,'pair'); + } + elsif ($line =~ s/($label)//) { + ($1,'label'); + } + elsif ($line =~ s/($blockstart)//) { + ($1,'blockstart'); + } + elsif ($line =~ s/($blockend)//) { + ($1,'blockend'); + } + else { + # 不正なトークン。 + die "Syntax error: $line\n"; + } + }; + # 必要なら残りの部分をロールバック + $this->rollback($line); + ($token,$type); + } + else { + undef; + } +} + +sub _nextline { + my $this = shift; + + while (1) { + if ($this->{body} eq '') { + # もう行が無い。 + return undef; + } + + # とりあえず先頭一行を取得。 + $this->{body} =~ s/^(.*?)(?:\n|$)//s; + my $line = $1; + + if (defined $line) { + # まだ行が残ってる。 + # 最初と最後の空白を除去。 + if ($this->{rollbackcount} > 0) { + # 読み過ぎているのでカウントしない。 + $this->{rollbackcount}--; + } + else { + $this->{linecount}++; + } + $line =~ s/^\s*|\s*$//g; + + # 空の行やコメント行なら飛ばして次へ。 + if ($line eq '' || $line =~ m/^#/) { + next; + } + else { + return $line; + } + } + else { + # もう行が無い。 + return undef; + } + } +} + +sub rollback { + my ($this,$line) = @_; + + # 最初と最後の空白を除去。 + $line =~ s/^\s*|\s*$//g; + + # まだ中身が残っていればカウンタごと書き戻す。 + if ($line ne '') { + $this->{body} = "$line\n$this->{body}"; + $this->{rollbackcount}++; + } +} + +1; diff -urN /non-existant-dir/main/Configuration/Parser.pm tiarra-20050322/main/Configuration/Parser.pm --- /non-existant-dir/main/Configuration/Parser.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Configuration/Parser.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,126 @@ +# ----------------------------------------------------------------------------- +# $Id: Parser.pm 794 2005-02-28 19:07:41Z topia $ +# ----------------------------------------------------------------------------- +# confファイルの構文解析を行なうクラス。 +# このクラスはConfiguration::LexicalAnalyzerを用いて字句解析を行ないます。 +# +# このクラスは文字コードを全く変換せずに結果を返します。 +# また、ブロック名については完全に無頓着です。 +# ----------------------------------------------------------------------------- +package Configuration::Parser; +use strict; +use warnings; +use Carp; +use Configuration::LexicalAnalyzer; +use Configuration::Block; + +sub new { + # $body: 解析する内容 + my ($class,$body) = @_; + my $this = { + lex => Configuration::LexicalAnalyzer->new($body), + + parsed => [], # Configuration::Block (現れた順番に並ぶ。) + }; + bless $this,$class; + + eval { + $this->_parse; + }; if ($@) { + die "(line ".$this->{lex}->linecount.") $@\n"; + } + $this; +} + +sub parsed { + shift->{parsed}; +} + +sub _parse { + my $this = shift; + + # block := LABEL BLOCKSTART blockcontent BLOCKEND + # blockcontent := pair | block + + while (1) { + my $block = $this->_parse_block('outside'); + if (defined $block) { + push @{$this->{parsed}},$block; + } + else { + last; + } + } + + $this; +} + +sub _parse_block { + my ($this,$context) = @_; + + my ($token,$type); + # block := LABEL BLOCKSTART blockcontent BLOCKEND + + ($token,$type) = $this->{lex}->next($context); + if (!defined $token) { + return undef; # もうブロックが無い。 + } + elsif ($type ne 'label') { + die "Semantics error: label of block is needed here.\n$token\n"; + } + my $block = Configuration::Block->new($token); + + ($token,$type) = $this->{lex}->next($context); + if (!defined $token || $type ne 'blockstart') { + $token = '' if !defined $token; + die "Semantics error: '{' is needed here.\n$token\n"; + } + + $this->_parse_blockcontent($block); + + ($token,$type) = $this->{lex}->next('block'); + if (!defined $token || $type ne 'blockend') { + $token = '' if !defined $token; + die "Semantics error: '}' is needed here.\n$token\n"; + } + + $block; +} + +sub _parse_blockcontent { + my ($this,$block) = @_; + + my ($token,$type); + # blockcontent := (pair | block)* + + while (1) { + ($token,$type) = $this->{lex}->next('block'); + if (!defined $token) { + die "Semantics error: pair, label or blockend is needed here.\n"; + } + elsif ($type eq 'pair') { + $token =~ m/^(.+?)\s*:\s*(.+)$/; + $block->add($1,$2); + } + elsif ($type eq 'label') { + # 読み過ぎたので戻す。 + $this->{lex}->rollback($token); + + # ブロックをパース。 + my $newblock = $this->_parse_block('block'); + $block->set($newblock->block_name,$newblock); + } + elsif ($type eq 'blockend') { + # 読み過ぎたので戻す。 + $this->{lex}->rollback($token); + + # ここで終わり。 + last; + } + else { + die "Semantics error: pair, label or blockend is needed here.\n$token\n"; + } + } +} + +1; diff -urN /non-existant-dir/main/Configuration/Preprocessor.pm tiarra-20050322/main/Configuration/Preprocessor.pm --- /non-existant-dir/main/Configuration/Preprocessor.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Configuration/Preprocessor.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,343 @@ +# ----------------------------------------------------------------------------- +# $Id: Preprocessor.pm 485 2004-08-21 09:34:55Z topia $ +# ----------------------------------------------------------------------------- +# tiarraのconfファイルのプリプロセッサです。 +# このクラスは次のような機能を持ちます。 +# +# ・"%PRE{"と"}ERP%"に挟まれた部分をperlの文として評価し、結果をその場所に挿入する。 +# +# ・@include ファイル名 +# このような行を、そのファイルの中身と置き換える。 +# +# ・@define 文字列A 文字列B +# このような行の後からは、ファイル中の文字列Aを全て文字列Bに置き換える。 +# 置換される場所はどこであっても構わない。例えば次のような定義は有効である。 +# @define DEBUG 1 +# @if 'DEBUG' == '1' +# debug: a +# @endif +# 例外は@undef, @ifdef, @ifndef文。これらの文に対しては置換が行なわれない。 +# +# ・@undef 文字列A +# @defineで定義した置換を、次の行からキャンセルする。 +# +# ・@if 式 +# ・@elsif +# 式をperlの文として評価し、結果が真なら@elsif、@else、@endifまでを有効な行とみなす。 +# if-elsif-else-endif構文は幾らでも入れ子にする事が出来る。 +# +# ・@else +# ・@endif +# 説明は不要であろう。 +# +# ・@ifdef 文字列 +# ・@ifndef 文字列 +# その文字列が@defineされていたら、若しくはされていなかったら。 +# +# ・@message 文字列 +# 標準出力にその文字列を出す。但し文字コードの変換は一切行われないので +# ASCII文字以外を出すのはやめた方が良い。 +# +# ----------------------------------------------------------------------------- +# 先に%PRE{ }ERP%が評価され、次に@文が評価される。 +# %PRE{ }ERP%は複数の行に渡っても良い。 +# ----------------------------------------------------------------------------- +package Configuration::Preprocessor; +use strict; +use warnings; +use Carp; +use IO::File; +use UNIVERSAL; +our %initial_definition; + +sub preprocess { + # IO::Handleまたはファイル名を一つ取り、プリプロセスの結果を返す。 + my $handle = shift; + + Configuration::Preprocessor + ->new + ->execute($handle); +} + +sub new { + my ($class,$filename) = @_; + my $this = { + included => {}, # ファイルパス => 1 (多重includeのチェックに使われる。) + consts => {%initial_definition}, # @defineされたマクロ名 => 中身 + }; + bless $this,$class; +} + +sub included_files { + my ($this) = shift; + return keys(%{$this->{included}}); +} + +sub initial_define { + my ($key, $value) = @_; + $initial_definition{$key} = $value; +} + +sub defined_p { + my ($this, $key) = @_; + defined $this->{consts}{$key}; +} + +sub execute { + my ($this,$filename) = @_; + + my $result = eval { + $this->_execute($filename); + }; + if ($@) { + my $fname = do { + if (ref($filename) && UNIVERSAL::isa($filename,'IO::Handle')) { + "HANDLE(".$filename->fileno.")"; + } + else { + $filename; + } + }; + die "Exception in preprocessing $fname:\n$@\n"; + } + + $result; +} + +sub _execute { + my ($this,$filepath) = @_; + + my $handle = do { + if (!defined $filepath) { + croak "Configuration::Preprocessor->_execute, Arg[1] was undef.\n"; + } + elsif (ref($filepath) && UNIVERSAL::isa($filepath,'IO::Handle')) { + # IO::Handleだった。 + # 重複チェックは不可能。 + $filepath; + } + else { + if (exists $this->{included}->{$filepath}) { + die "$filepath has already loaded or included before.\n"; + } + else { + $this->{included}->{$filepath} = 1; + } + + my $fh = IO::File->new($filepath,'r'); + if (!defined $fh) { + die "Couldn't open $filepath to read.\n"; + } + $fh; + } + }; + + # ファイルを先頭から最後まで読む。 + my $body = ''; + foreach (<$handle>) { + tr/\r\n//d; + $body .= "$_\n"; + } + undef $handle; + + # %PRE{ }ERP% 置換 + $body = $this->_eval_pre($body); + + # 一行ずつ読んで@指令を処理。 + $body = $this->_eval_at($body); + + $body; +} + +sub _eval_pre { + my ($this,$body) = @_; + + my $evaluate = sub { + my $script = shift; + no strict; no warnings; + my $result = eval "package Configuration::Implanted; $script"; + use warnings; use strict; + if ($@) { + my $short = substr $script,0,50; + $short =~ tr/\n//d; + $short =~ s/^\s*|\s*$//g; + die "Exception in evaluating %PRE{ }ERP% block\nlike '$short'\n$@\n"; + } + defined $result ? $result : ''; + }; + $body =~ s/\%PRE{(.+?)}ERP\%/$evaluate->($1)/seg; + $body; +} + +sub _eval_at { + my ($this,$body) = @_; + + my @ifstack = (); # 次にif,elsif,else,endifが来るまでの動作(真なら残し、偽なら消す) + + my $result = ''; + foreach my $line (split /\n/,$body) { + # この行が@undef,@ifdef,@ifndef文でないなら、@defineされた全ての置換を実行。 + if ($line !~ m/^\s*\@\s*(?:undef|ifdef|ifndef)\s+/) { + while (my ($key,$value) = each %{$this->{consts}}) { + $line =~ s/\Q$key\E/$value/g; + } + } + + if (@ifstack > 0) { + # if文のブロック内である。 + my $action = $ifstack[@ifstack - 1]; + + if ($line =~ m/^\s*\@\s*(?:if|elsif|ifdef|ifndef|else|endif)/) { + # 状態が変わる可能性がある。 + # とりあえず何もしない。 + } + else { + # 状態は変わらない。 + # 捨てる必要があるなら捨てて次へ。 + if (!$action) { + next; + } + } + } + + if ($line =~ m/^\s*\@/) { + # @で始まっている。 + # とりあえず先頭の@を取って最初と最後の\sがあれば消す。 + $line =~ s/^\s*\@\s*|\s*$//g; + + # ifdefとifndefはif文に書換える + if ($line =~ m/^ifdef\s+(.+)$/) { + $line = q{if $this->defined_p(q@}.$1.q{@)}; + } + elsif ($line =~ m/^ifndef\s+(.+)$/) { + $line = q{if !$this->defined_p(q@}.$1.q{@)}; + } + + if ($line =~ m/^include\s+(.+)$/) { + $result .= $this->execute($1); + } + elsif ($line =~ m/^define\s+(.+?)(?:\s+(.+))?$/) { + my $key = $1; + my $value = (defined $2 ? $2 : ''); + + if (defined $this->{consts}->{$key}) { + die "$key has already been \@defined before.\n"; + } + $this->{consts}->{$key} = $value; + } + elsif ($line =~ m/^undef\s+(.+)$/) { + if (!defined $this->{consts}->{$1}) { + die "$1 has not been \@defined.\n"; + } + delete $this->{consts}->{$1}; + } + elsif ($line =~ m/^message\s+(.+)$/) { + print "$1\n"; + } + elsif ($line =~ m/^if\s+(.+)$/) { + if (@ifstack > 0 && !$ifstack[@ifstack - 2]) { + # 下のフレームが存在し、一つ下のフレームのアクションが'消す'なら、無条件に消す。 + push @ifstack,0; + } + else { + # 評価結果が真なら、次にif,elsif,else,endifが出てくるまで残す。偽ならそれらが出るまで消す。 + my $cond_evaluated = eval(defined $1 ? $1 : ''); + if ($@) { + die "Exception in evaluating: \@$line\n$@\n"; + } + push @ifstack,$cond_evaluated; + } + } + elsif ($line =~ m/^elsif\s+(.+)$/) { + # elsifは新たにifフレームを追加する事はせず、現在のフレームに上書きする。 + # + # 現在のフレームのアクションが'残す'だった場合... + # if,elsif,else,endifが出てくるまで無条件に消す。 + # + # '消す'だった場合... + # 真ならif,elsif,else,endifが出てくるまで残す。偽ならそれらが出るまで消す。 + # + # 但し、現在のフレームがトップレベルでなかった場合で、 + # その下のレベルのアクションが'消す'だった場合は、無条件に消す。 + if (@ifstack > 1 && !$ifstack[@ifstack - 2]) { + pop @ifstack; + push @ifstack,0; + } + else { + if (@ifstack > 0) { + if ($ifstack[@ifstack - 1]) { + pop @ifstack; + push @ifstack,0; + } + else { + my $cond_evaluated = eval(defined $1 ? $1 : ''); + if ($@) { + die "Exception in evaluating: \@$line\n$@\n"; + } + pop @ifstack; + push @ifstack,$cond_evaluated; + } + } + else { + die "\@elsif without \@if block.\n"; + } + } + } + elsif ($line =~ m/^else$/) { + # elseは新たにifフレームを追加することはせず、現在のフレームに上書きする。 + # + # 現在のフレームのアクションが'残す'だった場合... + # if,elsif,else,endifが出てくるまで無条件に消す。 + # + # '消す'だった場合... + # if,elsif,else,endifが出てくるまで無条件に残す。 + # + # 但し、現在のフレームがトップレベルでなかった場合で、 + # その下のレベルのアクションが'消す'だった場合は、無条件に消す。 + if (@ifstack > 1 && !$ifstack[@ifstack - 2]) { + pop @ifstack; + push @ifstack,0; + } + else { + if (@ifstack > 0) { + if ($ifstack[@ifstack - 1]) { + pop @ifstack; + push @ifstack,0; + } + else { + pop @ifstack; + push @ifstack,1; + } + } + else { + die "\@else without \@if block.\n"; + } + } + } + elsif ($line =~ m/^endif$/) { + if (@ifstack > 0) { + # このifブロックを終了する。 + pop @ifstack; + } + else { + die "\@endif without \@if block.\n"; + } + } + else { + die "Invalid @ command: \@$line\n"; + } + } + else { + $result .= "$line\n"; + } + } + + # 最終的に@ifstackが空になっていないという事は、@ifブロックが終わっていないという事。 + if (@ifstack > 0) { + die "There's \@if block which is not terminated.\n" + } + + $result; +} + +1; diff -urN /non-existant-dir/main/Configuration.pm tiarra-20050322/main/Configuration.pm --- /non-existant-dir/main/Configuration.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Configuration.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,358 @@ +# ----------------------------------------------------------------------------- +# $Id: Configuration.pm 794 2005-02-28 19:07:41Z topia $ +# ----------------------------------------------------------------------------- +# このクラスはフック`reloaded'を用意します。 +# フック`reloaded'は、設定ファイルがリロードされた時に呼ばれます。 +# ----------------------------------------------------------------------------- +package Configuration; +# Configuration及びConfiguration::BlockはUTF-8バイト列でデータを保持します。 +use strict; +use warnings; +use UNIVERSAL; +use Carp; +use Configuration::Preprocessor; +use Configuration::Parser; +use Configuration::Block; +use Hook; +our @ISA = 'HookTarget'; +our $AUTOLOAD; +use Tiarra::SharedMixin qw(shared shared_conf); +our $_shared_instance; +# 値を取得するにはgetメソッドを用いる他、エントリ名をそのままメソッドとして呼ぶ事も出来ます。 +# +# $conf->hoge; +# ブロックhogeを返す。hogeが未定義ならundef値を返す。 + +sub _new { + my ($class) = @_; + my $obj = { + conf_file => '', # confファイルへのパス + time_on_load => 0, # 最後にloadが実行された時刻。 + blocks => {}, # 汎用ブロック名 -> Configuration::Block ここにモジュール設定は入らない。 + modules => [], # +で指定されたモジュールのConfiguration::Block + included_files => [], # include されたすべてのファイル(面倒なので conf_file を含む) + }; + bless $obj,$class; + $obj; +} + +sub get { + my ($class_or_this,$block_name) = @_; + my $this = $class_or_this->_this; + # 汎用ブロックを検索 + + if (!defined $block_name) { + carp "Configuration->get, Arg[0] is undef.\n"; + } + + $this->{blocks}->{$block_name}; +} + +sub find_module_conf { + my ($class_or_this,$module_name,$option) = @_; + my $this = $class_or_this->_this; + # モジュールの設定を検索 + foreach my $conf (@{$this->{modules}}) { + return $conf if $conf->block_name eq $module_name; + } + if ($option eq 'block') { + Configuration::Block->new($module_name); + } else { + undef; + } +} + +sub get_list_of_modules { + # confで指定された順番で、+とされた全てのモジュールの + # Configuration::Blockを持つ配列を指すリファレンスを返す。 + shift->_this->{modules}; +} + +sub check_if_updated { + # 最後にloadを実行してからconfファイルが更新されたか。 + # 一度もloadしていなければ必ず1を返す。 + # ファイル名が保存されていなければ必ず0を返す。 + my $this = shift->_this; + if ($this->{time_on_load} == 0) { + 1; + } else { + if (defined $this->{conf_file}) { + #$this->{time_on_load} < (stat $this->{conf_file})[9]; + foreach (@{$this->{included_files}}) { + return 1 if ($this->{time_on_load} < (stat $_)[9]); + } + 0; + } else { + 0; + } + } +} + +sub load { + # confファイルを読む。ファイルへのパスを省略すると、 + # 前回のload時に指定されたパスからリロードする。 + # ファイル名の代わりにIO::Handleのオブジェクトを渡しても良い。 + # その場合はリロードは不可能になる。 + my ($class_or_this,$conf_file) = @_; + my $this = $class_or_this->_this; + my $this_is_reload = !defined $conf_file; + + if (defined $conf_file) { + if (ref($conf_file) && UNIVERSAL::isa($conf_file,'IO::Handle')) { + # IO::Handleだった場合は保存しておけない。 + $this->{conf_file} = undef; + } else { + # ファイル名なので保存しておく。 + $this->{conf_file} = $conf_file; + } + } else { + if (defined $this->{conf_file}) { + $conf_file = $this->{conf_file}; + } else { + croak "Configuration->load, Arg[1] was omitted or undef, but no file names were saved yet.\n"; + } + } + + $this->{time_on_load} = time; + + # プリプロセスしてからパース + my $preprocessor = Configuration::Preprocessor->new; + my $body = $preprocessor->execute($conf_file); + my $parser = Configuration::Parser->new($body); + my $parsed = $parser->parsed; + + # 定義されていない値はデフォルト値で埋める。 + $this->_complete_table_with_defaults($parsed); + + # general->conf-encodingを見て文字コードをUTF-8に変換 + my $conf_encoding = do { + my $result; + foreach my $block (@$parsed) { + if ($block->block_name eq 'general') { + $result = $block->conf_encoding; + last; + } + } + $result; + }; + foreach my $block (@$parsed) { + $block->reinterpret_encoding($conf_encoding); + } + + # とりあえずモジュールのブロックとそうでないものに分ける。 + my $blocks = {}; + my $modules = []; + foreach my $block (@$parsed) { + my $blockname = $block->block_name; + + if ($blockname =~ m/^-/) { + # -ブロックなので捨てる。 + next; + } elsif ($blockname =~ m/^\+/) { + # +ブロックなので+を消して登録 + $blockname =~ s/^\+\s*//; + $block->block_name($blockname); + + push @$modules,$block; + } else { + # 普通のブロック。 + $blocks->{$blockname} = $block; + } + } + + $this->_check_required_definitions($blocks); # 省略不可能な定義を調べ、もし有ればdieする。 + $this->_check_duplicated_modules($modules); # 同じモジュールが複数回定義されていたらdieする。 + + # ここまでdieせずに来れたという事は、何もエラーが出なかったという事。 + # $thisに登録する事で確定する。 + $this->{blocks} = $blocks; + $this->{modules} = $modules; + $this->{included_files} = [$preprocessor->included_files] + if (defined $this->{conf_file}); # リロード可能な場合は include_files を登録する。 + + # リロードした場合はフックを呼ぶ。 + if ($this_is_reload) { + $this->call_hooks('reloaded'); + } +} + + +# デフォルト値のテーブル。 +my $defaults = { + general => { + 'conf-encoding' => 'auto', + 'server-in-encoding' => 'jis', + 'server-out-encoding' => 'jis', + 'client-in-encoding' => 'jis', + 'client-out-encoding' => 'jis', + 'stdout-encoding' => 'euc', + 'sysmsg-prefix' => 'tiarra', + 'sysmsg-prefix-use-masks' => { + 'system' => '*', + 'priv' => '', + 'channel' => '*', + }, + # nick-fix-mode のデフォルト値も後で別処理。 + 'messages' => { + 'quit' => { + 'netconf-changed-reconnect' => + 'Server Configuration changed; reconnect', + 'netconf-changed-disconnect' => + 'Server Configuration changed; disconnect', + } + }, + }, + networks => { + 'name' => 'main', + # defaultのデフォルト値は特殊なので後で別処理。 + 'multi-server-mode' => 1, + 'channel-network-separator' => '@', + 'action-when-disconnected' => 'part-and-join', + }, +}; +sub _complete_table_with_defaults { + my ($this, $blocks) = @_; + + my $root_block = Configuration::Block->new('ROOT'); + map { + $root_block->set($_->block_name, $_); + } @$blocks; + $this->_complete_block_with_defaults($root_block, $defaults); + + my $general = $root_block->general; + if (!defined $general->nick_fix_mode) { + $general->set('nick-fix-mode', do { + if ($general->multi_server_mode) { + 0; + } else { + 1; + } + }); + } + + # networksのdefaultだけは別処理。 + my $networks = $root_block->networks; + if (!defined $networks->default) { + $networks->set('default',$networks->name); + } + + @$blocks = values(%{$root_block->table}); + $blocks; +} + +sub _complete_block_with_defaults { + my ($this, $blocks, $defaults) = @_; + + while (my ($default_block_name,$default_block) = each %$defaults) { + # このブロックは存在しているか？ + unless (defined $blocks->get($default_block_name)) { + # ブロックごと省略されていたので空のブロックを定義。 + $blocks->set($default_block_name, + Configuration::Block->new($default_block_name)); + } + + my $block = $blocks->get($default_block_name); + my $must_check_child = {}; + while (my ($default_key,$default_value) = each %{$default_block}) { + if ((!ref($default_value)) || + (ref($default_value) eq 'ARRAY')) { + # この値は存在しているか？ + if (!defined $block->get($default_key)) { + # 値が省略されていたので値を定義。 + $block->set($default_key,$default_value); + } + } elsif (ref($default_value) eq 'HASH') { + $must_check_child->{$default_key} = $default_value; + } + } + if (values %$must_check_child) { + $this->_complete_block_with_defaults($block, $must_check_child); + } + } +} + +my $required = { + general => ['nick','user','name'], + # [ネットワーク名]のhost,portは別処理。 +}; +my $required_in_each_networks = ['host','port']; +sub _check_required_definitions { + my ($this,$blocks) = @_; + if (!defined $blocks) { + $blocks = $this->{blocks}; + } + + my $error = sub { + my ($block_name,$key) = @_; + die "Required definition '$key' in block '$block_name' was not found.\n"; + }; + + # $requiredで定義されているものに関してチェックを行なう。 + while (my ($required_block_name,$required_keys) = each %{$required}) { + foreach my $required_key (@{$required_keys}) { + unless ($blocks->{$required_block_name}->get($required_key)) { + # 必要だとされているのに定義が無かった。 + $error->($required_block_name,$required_key); + } + } + } + + # 各ネットワークのhostとportをチェック。 + my @network_names = $blocks->{networks}->name('all'); + foreach my $network_name (@network_names) { + foreach my $required_key (@{$required_in_each_networks}) { + my $block = $blocks->{$network_name}; + if (!defined $block) { + die "Block $network_name was not found. It was enumerated in networks/name.\n"; + } + if (!defined $blocks->{$network_name}->get($required_key)) { + # 必要だとされているのに定義が無かった。 + $error->($network_name,$required_key); + } + } + } +} + +sub _check_duplicated_modules { + my ($this,$modules) = @_; + if (!defined $modules) { + $modules = $this->{modules}; + } + + my $modnames = {}; + foreach my $block (@$modules) { + my $modname = $block->block_name; + if (defined $modnames->{$modname}) { + die "Module $modname has multiple definitions. Only one is allowed.\n"; + } + $modnames->{$modname} = 1; + } +} + +sub AUTOLOAD { + my $this = shift; + if ($AUTOLOAD =~ /::DESTROY$/) { + # DESTROYは伝達させない。 + return; + } + + (my $key = $AUTOLOAD) =~ s/.+?:://g; + return $this->get($key); +} + +# ----------------------------------------------------------------------------- +package Configuration::Hook; +use FunctionalVariable; +use base 'Hook'; + +our $HOOK_TARGET_NAME = 'Configuration'; +our @HOOK_NAME_CANDIDATES = 'reloaded'; +our $HOOK_TARGET_DEFAULT; +FunctionalVariable::tie( + \$HOOK_TARGET_DEFAULT, + FETCH => sub { + Configuration->shared; + }, + ); + +1; diff -urN /non-existant-dir/main/ControlPort.pm tiarra-20050322/main/ControlPort.pm --- /non-existant-dir/main/ControlPort.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/ControlPort.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,359 @@ +# ----------------------------------------------------------------------------- +# $Id: ControlPort.pm 803 2005-02-28 22:41:29Z topia $ +# ----------------------------------------------------------------------------- +=pod + << NOTIFY Log::Channel TIARRACONTROL/1.0 + << Sender: LogManager + << ID: synchronize + + >> TIARRACONTROL/1.0 204 No Content + ---------------------------------------- + << GET :: TIARRACONTROL/1.0 + << Sender: Foo + << ID: get-realname + << Reference0: ircnet + << Charset: UTF-8 + + >> TIARRACONTROL/1.0 200 OK + >> Value: (ネットワークircnetでの本名) + >> Charset: UTF-8 +=cut +# ----------------------------------------------------------------------------- +package ControlPort; +use strict; +use warnings; +use Carp; +use IO::Dir; +use ExternalSocket; +use Tiarra::Encoding; +use RunLoop; + +# 複数のパッケージを混在させてるとSelfLoaderが使えない…？ +#use SelfLoader; +#1; +#__DATA__ + +sub TIARRA_CONTROL_ROOT () { '/tmp/tiarra-control'; } + +sub new { + my ($class,$sockname) = @_; + + # IO::Socket::UNIXをuseする。失敗したらdie。 + eval q{ + use IO::Socket::UNIX; + }; if ($@) { + # 使えない。 + die "Tiarra control socket is not available for this environment.\n"; + } + + my $this = { + sockname => $sockname, + filename => TIARRA_CONTROL_ROOT.'/'.$sockname, + server_sock => undef, # ExternalSocket + clients => [], # ControlPort::Session + session_handle_hook => undef, # RunLoop::Hook + }; + bless $this,$class; + $this->open; + + $this; +} + +sub open { + my $this = shift; + my $filename = $this->{filename}; + + # ディレクトリ/tmp/tiarra-controlが無ければ作る。 + if (!-d TIARRA_CONTROL_ROOT) { + mkdir TIARRA_CONTROL_ROOT or die 'Couldn\'t make directory '.TIARRA_CONTROL_ROOT; + } + + # リスニング用ソケットを開く。 + my $sock = IO::Socket::UNIX->new( + Type => &SOCK_STREAM, + Local => $filename, + Listen => 1); + if (!defined $sock) { + die "Couldn't make socket $filename: $!"; + } + # パーミッションを700に。 + chmod 0700, $filename; + $this->{server_sock} = + ExternalSocket->new( + Socket => $sock, + Read => sub { + my $server = shift->sock; + my $client = $server->accept; + if (defined $client) { + push @{$this->{clients}},ControlPort::Session->new($client); + } + }, + Write => sub{}, + WantToWrite => sub{undef})->install; + + # セッションハンドル用のフックをかける。 + $this->{session_handle_hook} = + RunLoop::Hook->new( + 'ControlPort Session Handler', + sub { + # セッション処理 + foreach my $client (@{$this->{clients}}) { + $client->main; + } + # 終了したセッションを削除 + @{$this->{clients}} = grep { + $_->is_alive; + } @{$this->{clients}}; + })->install; + + $this; +} + +sub DESTROY { + my $this = shift; + + # 切断 + if (defined $this->{server_sock}) { + eval { + $this->{server_sock}->disconnect; + }; + } + + # このソケットファイルを削除 + unlink $this->{filename}; + + # ディレクトリにソケットが一つも無くなったら、このディレクトリも消える。 + rmdir TIARRA_CONTROL_ROOT; + + $this; +} + +package ControlPort::Session; +use strict; +use warnings; +use Tiarra::Socket::Lined; +use base qw(Tiarra::Socket::Lined); + +sub new { + # $sock: IO::Socket + my ($class,$sock) = @_; + my $this = $class->SUPER::new(name => 'ControlPort::Session'); + $this->{method} = undef; # GETまたはNOTIFY + $this->{module} = undef; # Log::Channelなど。'::'はメインプログラムを表す。 + $this->{header} = undef; # {key => value} + $this->{input_is_frost} = 0; # これ以上の入力を無視するか？ + bless $this,$class; + $this->attach($sock); + $this->install; +} + +sub main { + my $this = shift; + + while (defined($_ = $this->pop_queue)) { + s/^\s*|\s*$//g; + my $line = $_; + + if ($this->{input_is_frost}) { + last; + } + + if (defined $this->{header}) { + # $this->{header}が存在するということは、最初のリクエスト行はもう受け取った。 + if ($line eq '') { + # 空の行だ。リクエスト終わり。 + $this->respond; + } + else { + if ($line =~ m/^(.+?)\s*:\s*(.+)$/) { + $this->{header}{$1} = $2; + } + else { + $this->reply(401,'Bad Request'); + } + } + } + else { + if ($line =~ m|^(.+?)\s+(.+?)\s+TIARRACONTROL/(\d+)\.(\d+)$|) { + $this->{method} = $1; + $this->{module} = $2; + if (!{GET => 1,NOTIFY => 1}->{$this->{method}}) { + $this->reply(501,'Method Not Implemented'); + } + my $version = "$3.$4"; + if ($version > 1.0) { + $this->reply(401,'Bad Request'); + } + $this->{header} = {}; + } + else { + $this->reply(401,'Bad Request'); + } + } + } +} + +sub reply { + # $code: 204など + # $str: No Contentなど + # $header: {key => value} 省略可。文字コードはUTF-8。SenderとCharsetは不要。 + my ($this,$code,$str,$header) = @_; + + $this->append_line("TIARRACONTROL/1.0 $code $str"); + $this->append_line('Sender: Tiarra #'.&::version); + my $unijp = Tiarra::Encoding->new; + if (defined $header) { + while (my ($key,$value) = each %$header) { + $this->append_line($unijp->set("$key: $value")->conv($this->charset)); + } + } + $this->append_line('Charset: '.$this->long_charset); + $this->append_line(''); + $this->disconnect_after_writing; +} + +sub charset { + # リクエストで受け取ったCharsetから、Unicode::Japaneseエンコーディング名を返す。 + my $this = shift; + + if (!defined $this->{header}) { + return 'utf8'; + } + + my $charset = $this->{header}->{Charset}; + if (!defined $charset) { + return 'utf8'; + } + + my $charset_table = { + 'Shift_JIS' => 'sjis', + 'EUC-JP' => 'euc', + 'ISO-2022-JP' => 'jis', + 'UTF-8' => 'utf8', + }; + $charset_table->{$charset} || 'utf8'; +} + +sub long_charset { + my $this = shift; + + my $table = { + 'sjis' => 'Shift_JIS', + 'euc' => 'EUC-JP', + 'jis' => 'ISO-2022-JP', + 'utf8' => 'UTF-8', + }; + $table->{$this->charset} || 'UTF-8'; +} + +sub is_alive { + shift->connected; +} + +sub respond { + my $this = shift; + + my $req = ControlPort::Request->new($this->{method},$this->{module}); + my $charset = $this->charset; + my $unijp = Tiarra::Encoding->new; + while (my ($key,$value) = each %{$this->{header}}) { + next if $key eq 'Charset'; + $req->$key($unijp->set($value,$charset)->utf8); + } + + my $rep = eval { + if ($req->module eq '::') { + # モジュール"::"はメインプログラムを表す。 + # 後で。 + die qq{Controlling '::' is not supported yet.\n}; + } + else { + # このようなモジュールは存在するか？ + my $mod = ModuleManager->shared->get($req->module); + if (defined $mod) { + my $reply = $mod->control_requested($req); + if (!defined $reply) { + die $this->{module}."->control_requested returned undef.\n"; + } + elsif (!$reply->isa('ControlPort::Reply')) { + die $this->{module}."->control_requested returned bad ref: ".ref($reply)."\n"; + } + else { + $reply; + } + } + else { + die qq{Module $this->{module} doesn't exist.\n}; + } + } + }; + if ($@) { + (my $detail = $@) =~ s/\n//g; + $this->reply(500,'Internal Server Error',{Detail => $detail}); + } + else { + $this->reply($rep->code,$rep->status,$rep->table); + } +} + +package ControlPort::Packet; +use strict; +use warnings; +our $AUTOLOAD; +use Tiarra::Utils (); +Tiarra::Utils->define_attr_getter(0, qw(table)); + +sub new { + my $class = shift; + my $this = { + table => {}, # {key => value} + }; + bless $this,$class; +} + +sub AUTOLOAD { + my ($this,$value) = @_; + if ($AUTOLOAD =~ /::DESTROY$/) { + return; + } + + (my $key = $AUTOLOAD) =~ s/.+?:://g; + if (defined $value) { + $this->{table}{$key} = $value; + } + $this->{table}{$key}; +} + +package ControlPort::Request; +use strict; +use warnings; +use base qw(ControlPort::Packet); +use Tiarra::Utils (); +Tiarra::Utils->define_attr_getter(0, qw(method module)); + +sub new { + my ($class,$method,$module) = @_; + my $this = $class->SUPER::new; + $this->{method} = $method; + $this->{module} = $module; + $this; +} + +package ControlPort::Reply; +use strict; +use warnings; +use base qw(ControlPort::Packet); +use Tiarra::Utils (); +Tiarra::Utils->define_attr_getter(0, qw(code status)); + +sub new { + # $code: 204など + # $status: No Contentなど + my ($class,$code,$status) = @_; + my $this = $class->SUPER::new; + $this->{code} = $code; + $this->{status} = $status; + $this; +} + +1; diff -urN /non-existant-dir/main/Crypt.pm tiarra-20050322/main/Crypt.pm --- /non-existant-dir/main/Crypt.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Crypt.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,50 @@ +# ----------------------------------------------------------------------------- +# $Id: Crypt.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# 与えられた、またはランダムに決定されたsaltを用いて文字列をcryptする機能、 +# そして文字列をcryptして得られた文字列を、予めcryptされた文字列と +# 比較する機能を持つ。 +# ----------------------------------------------------------------------------- +package Crypt; +use strict; +use warnings; + +use SelfLoader; +1; +__DATA__ + +sub encrypt { + # saltは省略可能。省略されるとランダムに作られる。 + my ($str,$salt) = @_; + $salt = gen_salt() unless defined $salt; + + return crypt($str,$salt); +} + +sub check { + # encryptedのsaltでrawをcrypt()してみて、一致したかどうかを真偽値で返す。 + my ($raw,$encrypted) = @_; + + return crypt($raw,substr($encrypted,0,2)) eq $encrypted; +} + +sub gen_salt { + my $salt = ''; + + srand; + for (0 .. 1) { + my $n = int(rand(63)); + if ($n < 12) { + $salt .= chr($n + 46); # ./0-9 + } + elsif ($n < 38) { + $salt .= chr($n + 65 - 12); # A-Z + } + elsif ($n < 64) { + $salt .= chr($n + 97 - 38); # a-z + } + } + $salt; +} + +1 diff -urN /non-existant-dir/main/Exception.pm tiarra-20050322/main/Exception.pm --- /non-existant-dir/main/Exception.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Exception.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,36 @@ +# ----------------------------------------------------------------------------- +# $Id: Exception.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +package Exception; +use strict; +use warnings; +use overload + '""' => \&_ope_tostring; + +sub new { + my ($class,$msg) = @_; + my $this = { + msg => $msg, + stacktrace => undef, # 後で書く。caller辿るの面倒。 + }; + bless $this,$class; +} + +sub message { + shift->{msg}; +} + +sub throw { + die shift; +} + +sub _ope_tostring { + my ($this) = @_; + ref($this).(defined $this->{msg} ? " : $this->{msg}" : ''); +} + +# ----------------------------------------------------------------------------- +package QueueIsEmptyException; +use base qw(Exception); + +1; diff -urN /non-existant-dir/main/ExternalSocket.pm tiarra-20050322/main/ExternalSocket.pm --- /non-existant-dir/main/ExternalSocket.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/ExternalSocket.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,170 @@ +# ----------------------------------------------------------------------------- +# $Id: ExternalSocket.pm 779 2005-02-24 14:48:44Z topia $ +# ----------------------------------------------------------------------------- +# RunLoopは任意のソケットを監視する事が出来るが、その登録の為にこのクラスを用いる。 +# ----------------------------------------------------------------------------- +# my $esock = ExternalSocket->new( +# Socket => IO::Socket::INET->new(...), # IO::Socket型のオブジェクト +# Read => sub { +# # ソケットが読み込み可能になった時に呼ばれるクロージャ。 +# # ExternalSocketのオブジェクト自身を一つだけ引数に呼ばれる。 +# my $sock = shift->sock; +# ... +# }, +# Write => sub { +# # ソケットが書き込み可能になった時に呼ばれるクロージャ。 +# my $sock = shift->sock; +# ... +# }, +# WantToWrite => sub { +# # ソケットに書き込む必要があるかどうかをRunLoopが知る為に呼ばれるクロージャ。 +# # 引数はReadやWriteと同じだが、真偽値を返さなければならない。 +# undef; +# }, +# Exception => sub { +# # ソケットに例外が発生したときに呼ばれるクロージャ。 +# # 省略可能。 +# my $this = shift; +# ::printmsg($this->errmsg('foo socket error')); +# $this->disconnect; +# }, +# )->install; +# +# $esock->uninstall; +# ----------------------------------------------------------------------------- +package ExternalSocket; +use strict; +use warnings; +use UNIVERSAL; +use Carp; +use Tiarra::Utils; +use Tiarra::Socket; +use base qw(Tiarra::Socket); +utils->define_attr_getter(0, qw(name)); + +use SelfLoader; +SelfLoader->load_stubs; +1; +__DATA__ + +sub socket { + shift->sock(@_); +} + +sub new { + my ($class,%opts) = @_; + + $class->_increment_caller('external-socket', \%opts); + my $this = $class->SUPER::new(%opts); + $this->{read} = undef; + $this->{write} = undef; + $this->{wanttowrite} = undef; + $this->{exception} = undef; + my $this_func = $class . '->new'; + + if (defined $opts{Socket}) { + if (ref $opts{Socket} && + UNIVERSAL::isa($opts{Socket},'IO::Socket')) { + $this->attach($opts{Socket}); + } + else { + croak "$this_func, Arg{Socket} was illegal object: ".ref($opts{Socket})."\n"; + } + } + else { + croak "$this_func, Arg{Socket} not exists\n"; + } + + foreach my $key (qw/Read Write WantToWrite Exception/) { + if (defined $opts{$key}) { + if (ref($opts{$key}) eq 'CODE') { + $this->{lc $key} = $opts{$key}; + } + else { + croak "$this_func, Arg{$key} was illegal reference: ".ref($args{$key})."\n"; + } + } + elsif ($key ne 'Exception') { + # Exception is optional + croak "$this_func, Arg{$key} not exists\n"; + } + } + + if (defined $opts{Name}) { + $this->name($opts{Name}); + } + + $this; +} + +sub install { + # RunLoopにインストールする。 + # 引数を省略した場合はデフォルトのRunLoopにインストールする。 + my ($this,$runloop) = @_; + + if ($this->installed) { + croak "This " . ref($this) . + " has been already installed to RunLoop\n"; + } + + $runloop = RunLoop->shared unless defined $runloop; + $this->{runloop} = $runloop; + $this->SUPER::install; +} + +sub uninstall { + # インストールしたRunLoopから、このソケットをアンインストールする。 + my $this = shift; + + if (!$this->installed) { + # インストールされていない。 + croak "This " . ref($this) . " hasn't been installed yet\n"; + } + + $this->SUPER::uninstall; +} + +sub __check_caller { + my $this = shift; + my $caller_pkg = utils->get_package(1); + if (!$caller_pkg->isa('RunLoop')) { + croak "Only RunLoop may call method read/write/want_to_write of " . + ref($this) . "\n"; + } +} + +sub read { + # Readを実行する。RunLoopのみがこのメソッドを呼べる。 + my $this = shift; + + $this->__check_caller; + $this->{read}->($this); + $this; +} + +sub write { + # Writeを実行する。 + my $this = shift; + + $this->__check_caller; + $this->{write}->($this); + $this; +} + +sub want_to_write { + # WantToWriteを実行する。 + my $this = shift; + + $this->__check_caller; + $this->{wanttowrite}->($this); +} + +sub exception { + # Exceptionを実行する。 + my $this = shift; + + $this->__check_caller; + $this->{exception}->($this) if defined $this->{exception}; +} + +1; diff -urN /non-existant-dir/main/FunctionalVariable.pm tiarra-20050322/main/FunctionalVariable.pm --- /non-existant-dir/main/FunctionalVariable.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/FunctionalVariable.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,98 @@ +# ----------------------------------------------------------------------------- +# $Id: FunctionalVariable.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# FunctionalVariableは、与えられた任意の関数リファレンスを呼ぶように +# 変数に処理関数をtieする事が出来ます。Tie::Scalarとの違いは、処理関数を +# コンパイル時ではなく、生成時に決められる事です。 +# ----------------------------------------------------------------------------- +# 使い方: +# +# スカラー変数に割り当てる場合: +# my $foo; +# FunctionalVariable::tie( +# \$foo, +# FETCH => sub { +# # FETCHは省略可能 +# return 500; +# }, +# STORE => sub { +# # STOREも省略可能 +# print shift; +# }, +# ); +# print "$foo\n"; # "500\n"を出力 +# $foo = 10; # "10"を出力 +# ----------------------------------------------------------------------------- +# 内部動作: +# +# FunctionalVariable::tieを実行すると、その変数にはFunctionalVariable型の +# オブジェクトがtieされる。FunctionalVariable::FETCHその他は、tie実行時に +# 指定された関数に実際の処理を委譲する。 +# ----------------------------------------------------------------------------- +package FunctionalVariable; +use strict; +use warnings; +use Carp; + +sub tie { + # $variable: tieする変数への参照 + # @functions: 関数群 + my ($variable, @functions) = @_; + + # @functionsの検査 + my $functions = eval { + my $funcs = {@functions}; + while (my ($key, $value) = each %$funcs) { + if (ref($value) ne 'CODE') { + die "FunctionalVariable->tie, Arg[1]{$key} is not a function ref.\n"; + } + } + $funcs; + }; if ($@) { + croak $@; + } + + my $this = { + variable => $variable, + type => ref($variable), + functions => $functions, + }; + + if ($this->{type} eq 'SCALAR') { + tie $$variable, 'FunctionalVariable', $this; + } + elsif ($this->{type} eq '') { + croak "FunctionalVariable->tie, Arg[0] was not a ref.\n"; + } + else { + croak "FunctionalVariable->tie, Arg[0] was bad ref: $this->{type}\n"; + } +} + +sub TIESCALAR { + my ($class, $this) = @_; + bless $this => $class; +} + +sub FETCH { + my ($this) = @_; + my $f = $this->{functions}{'FETCH'}; + if (defined $f) { + $f->(); + } + else { + # FETCHが定義されていないのなら、undefでも返す他無い。 + undef; + } +} + +sub STORE { + my ($this, $value) = @_; + my $f = $this->{functions}{'STORE'}; + if (defined $f) { + $f->($value); + } + # STOREが定義されていないのなら、何もしない。 +} + +1; diff -urN /non-existant-dir/main/Hook.pm tiarra-20050322/main/Hook.pm --- /non-existant-dir/main/Hook.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Hook.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,244 @@ +# ----------------------------------------------------------------------------- +# $Id: Hook.pm 658 2004-10-15 12:05:35Z topia $ +# ----------------------------------------------------------------------------- +# Hook: あらゆるフックのベースクラス +# HookTarget: あらゆるフック先のベースクラス +# ----------------------------------------------------------------------------- +# Hookの使い方: +# +# パッケージ変数 $HOOK_TARGET_NAME, @HOOK_NAME_CANDIDATES, +# $HOOK_NAME_DEFAULT, $HOOK_TARGET_DEFAULT を定義する +# 各変数の意味は次の通り +# +# $HOOK_TARGET_NAME: +# このフックをかける先のパッケージ名。 +# +# @HOOK_NAME_CANDIDATES: +# フック名として許される名前の候補。 +# +# $HOOK_NAME_DEFAULT: +# フック名が省略された場合のデフォルト値。 +# これは省略可能で、省略した場合はフック名の候補の個数が +# 2つ以上である場合に限り、フック名の省略が不可能になる。 +# +# $HOOK_TARGET_DEFAULT: +# フックを掛ける対象のオブジェクトが省略された場合のデフォルト値。 +# これは省略可能で、省略した場合はinstall時にターゲットの省略が出来なくなる。 +# +# これらの変数を定義し、Hookを@ISAに入れたパッケージを作る。 +# ----------------------------------------------------------------------------- +# HookTargetの使い方: +# +# HookTargetを@ISAに入れたクラスを作る。コンストラクタでの配慮は不要。 +# $obj->call_hooks($hook_name)で、インストールされた全てのフックを呼ぶ。 +# $obj->call_hooks($hook_name, $foo, $bar, $baz)のように任意の個数の引数を +# 渡す事が可能で、その場合はそれらを引数としてフック関数が呼ばれる。 +# +# 現在の実装では、HookTargetはオブジェクトをハッシュで持つクラスでのみ使用可能。 +# また、`installed-hooks'と云うキーを勝手に使う。 +# ----------------------------------------------------------------------------- +package Hook; +use strict; +use warnings; +use Carp; +use UNIVERSAL; +use Tiarra::Utils; +utils->define_attr_getter(0, qw(name)); + +sub new { + my $class = shift; + #my ($class, $code) = @_; + my $name = shift; + my $code = shift; + if (!defined $name) { + croak $class."->new, Arg[0] was undef.\n"; + } + if (ref($name) eq 'CODE' && !defined($code)) { + $code = $name; + $name = utils->simple_caller_formatter($class.' registered'); + } + + my $this = { + target => undef, + target_package_name => undef, + hook_name => undef, + + name => $name, + code => $code, + }; + + if (ref($code) ne 'CODE') { + croak $class."->new, Arg[0] was bad type.\n"; + } + + do { + no strict; + no warnings; + + local %symtable = %{$class.'::'}; + if (defined ${$symtable{HOOK_TARGET_NAME}}) { + $this->{target_package_name} = ${$symtable{HOOK_TARGET_NAME}}; + } + else { + croak "${class}->new, \$${class}::HOOK_TARGET_NAME undefined.\n"; + } + + if (@{$symtable{HOOK_NAME_CANDIDATES}} == 0) { + croak "${class}->new, \@${class}::HOOK_NAME_CANDIDATES undefined.\n"; + } + }; + + bless $this, $class; +} + +sub install { + my ($this, $hook_name, $target) = @_; + + if (defined $this->{target}) { + croak ref($this)."->install, this hook is already installed.\n"; + } + + do { + no strict; + + my %symtable = %{ref($this).'::'}; + if (!defined $hook_name) { + # @HOOK_NAME_CANDIDATESの個数は1つか？ + # それとも$HOOK_NAME_DEFAULTは定義されているか？ + if (@{$symtable{HOOK_NAME_CANDIDATES}} == 1) { + $hook_name = $symtable{HOOK_NAME_CANDIDATES}->[0]; + } + elsif (defined ${$symtable{HOOK_NAME_DEFAULT}}) { + $hook_name = ${$symtable{HOOK_NAME_DEFAULT}}; + } + else { + croak ref($this)."->install, you can't omit the hook name.\n"; + } + } + + # $hook_nameは本当にフック名として許されているか？ + if (!{map {$_ => 1} @{$symtable{HOOK_NAME_CANDIDATES}}}->{$hook_name}) { + croak ref($this)."->install, hook `$hook_name' is not available.\n"; + } + + if (!defined $target) { + # $HOOK_TARGET_DEFAULTは定義されているか？ + if (defined ${$symtable{HOOK_TARGET_DEFAULT}}) { + $target = ${$symtable{HOOK_TARGET_DEFAULT}}; + } + else { + croak ref($this)."->install, you can't omit the hook target.\n"; + } + } + }; + + # $targetは本当にHookTargetを継承したオブジェクトか？ + if (!UNIVERSAL::isa($target, 'HookTarget')) { + croak ref($this)."->install, target is not a subclass of HookTarget: ". + ref($target)."\n"; + } + + # $targetは本当に$HOOK_TARGET_NAMEのオブジェクトか？ + if (!UNIVERSAL::isa($target, $this->{target_package_name})) { + croak ref($this)."->install, target is not a subclass of $this->{target_package_name}: ". + ref($target)."\n"; + } + + $this->{target} = $target; + $this->{hook_name} = $hook_name; + $target->install_hook($hook_name, $this); + + $this; +} + +sub uninstall { + my $this = shift; + + $this->{target}->uninstall_hook($this->{hook_name}, $this); + $this->{target} = undef; + $this->{hook_name} = undef; + + $this; +} + +sub call { + my ($this, @args) = @_; + + my ($caller_pkg) = caller(2); + if ($caller_pkg->isa(ref $this->{target})) { + utils->do_with_errmsg("Hook: $this->{target}/$this->{hook_name}($this->{name})", + sub { + $this->{code}->($this, @args); + }); + } + else { + croak "Only ${\ref($this->{target})} can call ${\ref($this)}->call\n". + "$caller_pkg is not allowed to do so.\n"; + } +} + +# ----------------------------------------------------------------------------- +package HookTarget; + +sub _get_hooks_hash { + my $this = shift; + my $ih = $this->{'installed-hooks'}; + if (defined $ih) { + $ih; + } + else { + $this->{'installed-hooks'} = {}; + } +} + +sub _get_hooks_array { + my ($this, $hook_name) = @_; + my $installed_hooks = $this->_get_hooks_hash; + my $ar = $installed_hooks->{$hook_name}; + if (defined $ar) { + $ar; + } + else { + $installed_hooks->{$hook_name} = []; + } +} + +sub install_hook { + my ($this, $hook_name, $hook) = @_; + my $array = $this->_get_hooks_array($hook_name); + + push @$array, $hook; + $this; +} + +sub uninstall_hook { + my ($this, $hook_name, $hook) = @_; + my $array = $this->_get_hooks_array($hook_name); + + @$array = grep { + $_ != $hook; + } @$array; + $this; +} + +sub call_hooks { + my ($this, $hook_name, @args) = @_; + my $array = $this->_get_hooks_array($hook_name); + + foreach my $hook (@$array) { + eval { + $hook->call(@args); + }; if ($@) { + my $msg = ref($this)."->call_hooks, exception occured:\n". + " Hook: ".$hook->name."\n". + "$@"; + if (require RunLoop) { + RunLoop->notify_error($msg); + } else { + die $msg; + } + } + } +} + +1; diff -urN /non-existant-dir/main/IRCMessage.pm tiarra-20050322/main/IRCMessage.pm --- /non-existant-dir/main/IRCMessage.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/IRCMessage.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,37 @@ +# ----------------------------------------------------------------------------- +# $Id: IRCMessage.pm 773 2005-02-24 05:42:42Z topia $ +# ----------------------------------------------------------------------------- +# IRCMessageはIRCのメッセージを表わすクラスです。実際のメッセージはUTF-8で保持します。 +# 生のメッセージのパース、シリアライズ、そしてメッセージの生成をサポートします。 +# パースとシリアライズには文字コードを指定して下さい。コードを変換します。 +# LineとEncoding以外の手段でインスタンスを生成する際は、 +# パラメータとしてUTF-8の値を渡して下さい。 +# インターフェースは同一です。 +# ----------------------------------------------------------------------------- +# 生成方法一覧 +# +# $msg = new IRCMessage(Line => ':foo!~foo@hogehoge.net PRIVMSG #hoge :hoge', +# Encoding => 'jis'); +# print $msg->command; # 'PRIVMSG'を表示 +# +# $msg = new IRCMessage(Server => 'irc.hogehoge.net', # ServerはPrefixでも良い。 +# Command => '366', +# Params => ['hoge','#hoge','End of /NAMES list.']); +# print $msg->serialize('jis'); # ":irc.hogehoge.net 366 hoge #hoge :End of /NAMES list."を表示 +# +# $msg = new IRCMessage(Nick => 'foo', +# User => '~bar', +# Host => 'hogehoge.net', # 以上３つのパラメータの代わりにPrefix => 'foo!~bar@hogehoge.net'でも良い。 +# Command => 'NICK', +# Params => 'huga', # Paramsは要素が一つだけならスカラー値でも良い。(この時、ParamsでなくParamでも良い。) +# Remarks => {'saitama' => 'SAITAMA'}, # 備考欄。シリアライズには影響しない。 +# print $msg->serialize('jis'); # ":foo!~bar@hogehoge.net NICK :huga"を表示 +# +# $msg = new IRCMessage(Command => 'NOTICE', +# Params => ['foo','hugahuga']); +# print $msg->serialize('jis'); # "NOTICE foo :hugahuga"を表示 +# +package IRCMessage; +use base qw(Tiarra::IRC::Message); + +1; diff -urN /non-existant-dir/main/InstantCapsule.pm tiarra-20050322/main/InstantCapsule.pm --- /non-existant-dir/main/InstantCapsule.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/InstantCapsule.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,140 @@ +# ----------------------------------------------------------------------------- +# $Id: InstantCapsule.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# フィールドとメソッドを持つオブジェクトを一時的に生成するためのクラス。 +# 生成時にメソッドの実体をクロージャで渡します。 +# AUTOLOADやtieを使用しているため、動作速度は通常のクラスより遅い可能性があります。 +# +# my $capsule = InstantCapsule->new( +# Fields => { +# # 現時点ではハッシュ型オブジェクトのみ対応。 +# # 配列型やグロブ型のオブジェクトは非対応です。 +# foo => 10, +# bar => undef, +# baz => 'string', +# }, +# Methods => { +# # メソッド名newはInstantCapsuleが予約している。 +# +# printfoo => sub { +# # メソッドに渡される最初の引数はInstantCapsule自身。 +# my $this = shift; +# print $this->{foo},"\n"; +# }, +# +# setbar => sub { +# # 二つ目以降の引数は、このメソッド呼び出しに用いられたものがそのまま渡される。 +# my ($this,$value) = @_; +# $this->{bar} = $value; +# } +# +# DESTROY => sub { +# print "DESTROY called.\n"; +# } +# }); +# +# $capsule->printfoo; +# $capsule->setbar(5); +# undef $capsule; # ここでDESTROYが呼ばれる。 +# ----------------------------------------------------------------------------- +package InstantCapsule; +use strict; +use warnings; +use Carp; +use UNIVERSAL; +use vars qw($AUTOLOAD); + +sub new { + my ($class,%args) = @_; + my $this = { + fields => $args{Fields}, + methods => $args{Methods}, + }; + + if (!defined $this->{fields}) { + croak "InstantCapsule->new, Arg[Fields] not defined.\n"; + } + elsif (!ref($this->{fields}) || !UNIVERSAL::isa($this->{fields},'HASH')) { + croak "InstantCapsule->new, Arg[Fields] is bad type.\n"; + } + + if (!defined $this->{methods}) { + croak "InstantCapsule->new, Arg[Methods] not defined.\n"; + } + elsif (!ref($this->{methods}) || !UNIVERSAL::isa($this->{methods},'HASH')) { + croak "InstantCapsule->new, Arg[Methods] is bad type.\n"; + } + + # methods内をチェック。 + while (my ($name,$code) = each %{$this->{methods}}) { + if (eval qq{defined \&${class}::${name}}) { + croak "InstantCapsule->new, method $name is reserved for InstantCapsule itself.\n"; + } + if (!ref($code) || ref($code) ne 'CODE') { + croak "InstantCapsule->new, method $name is not a valid CODE value.\n"; + } + } + + my $obj = {}; + tie %$obj,$class,$this; # こうしておかないとフィールドが参照出来ない。 + bless $obj,$class; # こうしておかないとAUTOLOADが使えない。 +} + +sub TIEHASH { + my ($class,$tie) = @_; + bless $tie,$class; +} + +sub FETCH { + my ($this,$key) = @_; + $this->{fields}->{$key}; +} + +sub STORE { + my ($this,$key,$value) = @_; + $this->{fields}->{$key} = $value; +} + +sub DELETE { + my ($this,$key) = @_; + delete $this->{fields}->{$key}; +} + +sub EXISTS { + my ($this,$key) = @_; + exists $this->{fields}->{$key}; +} + +sub CLEAR { + my $this = shift; + %{$this->{fields}} = (); +} + +sub FIRSTKEY { + my $this = shift; + values %{$this->{fields}}; # reset iterator + each %{$this->{fields}}; +} + +sub NEXTKEY { + my $this = shift; + each %{$this->{fields}}; +} + +sub AUTOLOAD { + my ($obj,@args) = @_; + my $this = tied %$obj; + (my $method = $AUTOLOAD) =~ s/.+?:://g; + + if (defined $this->{methods}->{$method}) { + $this->{methods}->{$method}->($obj,@args); + } + else { + # DESTROYだけは無くても構わない。 + if ($method ne 'DESTROY') { + croak "InstantCapsule->AUTOLOAD, method $method is not defined.\n"; + } + } +} + +1; diff -urN /non-existant-dir/main/IrcIO/Client.pm tiarra-20050322/main/IrcIO/Client.pm --- /non-existant-dir/main/IrcIO/Client.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/IrcIO/Client.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,620 @@ +# ----------------------------------------------------------------------------- +# $Id: Client.pm 790 2005-02-28 18:40:53Z topia $ +# ----------------------------------------------------------------------------- +# IrcIO::Clientはクライアントからの接続を受け、 +# IRCメッセージをやり取りするクラスです。 +# ----------------------------------------------------------------------------- +package IrcIO::Client; +use strict; +use warnings; +use Carp; +use IrcIO; +use base qw(IrcIO); +use Crypt; +use Multicast; +use Mask; +use LocalChannelManager; +use NumericReply; +use Tiarra::Resolver; +use Tiarra::Socket; +use Tiarra::Utils; +utils->define_attr_getter(0, qw(logging_in username), + qw(client_host client_addr client_host_repr)); + + +# 複数のパッケージを混在させてるとSelfLoaderが使えない…？ +#use SelfLoader; +#SelfLoader->load_stubs; # このクラスには親クラスがあるから。(SelfLoaderのpodを参照) +#1; +#__DATA__ + +sub new { + my ($class,$runloop,$sock) = @_; + my $this = $class->SUPER::new($runloop); + $this->attach($sock); + $this->{pass_received} = ''; # クライアントから受け取ったパスワード + $this->{nick} = ''; # ログイン時にクライアントから受け取ったnick。変更されない。 + $this->{username} = ''; # 同username + $this->{logging_in} = 1; # ログイン中なら1 + $this->{options} = {}; # クライアントが接続時に$key=value$で指定したオプション。 + my $addr = $sock->peerhost; + $this->{client_host} = $this->{client_addr} = $addr; + Tiarra::Resolver->paranoid_check($addr, sub { + $this->accept(@_); + }); + $this; +} + +sub accept { + my ($this, $paranoid_ok, $host, $entry) = @_; + + $this->{client_host} = $paranoid_ok ? $host : $this->{client_addr}; + $this->{client_host_repr} = Tiarra::Socket->repr_destination( + host => $this->{client_host}, + addr => $this->{client_addr}); + + # このホストからの接続は許可されているか？ + my $allowed_host = $this->_conf_general->client_allowed; + if (defined $allowed_host) { + unless (Mask::match($allowed_host,$this->{client_host}) || + Mask::match($allowed_host,$this->{client_addr})) { + # マッチしないのでdie。 + die "One client at ".$this->{client_host_repr}." connected to me, but the host is not allowed.\n"; + } + } + ::printmsg("One client at ".$this->{client_host_repr}." connected to me."); + $this->install; + $this; +} + +sub disconnect { + my ($this, $genre, $errno, @params) = @_; + + $this->SUPER::disconnect($genre, $errno, @params); + if (defined $errno) { + ::printmsg($this->sock_errno_to_msg( + $errno, + "Disconnected Client from ".$this->{client_host_repr}.": $genre error")); + } else { + ::printmsg("Disconnected Client from ".$this->{client_host_repr}."."); + } +} + +sub fullname { + # このクライアントをtiarraから見たnick!username@userhostの形式で表現する。 + my ($this,$type) = @_; + if (defined $type && $type eq 'error') { + $this->_runloop->current_nick.'['.$this->{username}.'@'.$this->{client_host}.']'; + } + else { + $this->_runloop->current_nick.'!'.$this->{username}.'@'.$this->{client_host}; + } +} + +sub fullname_from_client { + # このクライアントをクライアントから見たnick!username@userhostの形式で表現する。 + # この関数が返すnickは初めに受け取ったものである点に注意。 + my $this = shift; + $this->{nick}.'!'.$this->{username}.'@'.$this->{client_host}; +} + +sub parse_realname { + my ($this,$realname) = @_; + return if !defined $realname; + # $key=value;key=value;...$ + # + # 以下は全て有効で、同じ意味である。 + # $ foo = bar; key= value$ + # $ foo=bar;key=value $ + # $foo =bar;key= value $ + + my $key = qr{[^=]+?}; # キーとして許されるパターン + my $value = qr{[^;]*?}; # 値として許されるパターン + my $lastpair = qr{$key\s*=\s*$value}; + my $pair = qr{$lastpair\s*;}; + + my $line = qr{^\$(?:\s*($pair)\s*)*\s*($lastpair)\s*\$$}; + if (my @pairs = ($realname =~ m/$line/g)) { + %{$this->{options}} = map { + m/^\s*($key)\s*=\s*($value)\s*;?$/; + } grep { + defined; + } @pairs; + } +} + +sub option { + # ログイン時に$key=value$で指定されたオプションを取得する。 + # 指定されたキーに対する値が存在しなかった場合はundefを返す。 + my ($this,$key) = @_; + if (defined $key) { + $this->{options}->{$key}; + } + else { + croak "IrcIO::Client->option, Arg[1] was undef."; + } +} + +sub option_or_default { + my ($this, $base, $config_prefix, $option_prefix, $default) = @_; + my $value; + + utils->get_first_defined( + $this->option(utils->to_str($option_prefix).$base), + $this->_conf_general->get(utils->to_str($option_prefix).$base), + $default); +} + +sub option_or_default_multiple { + my ($this, $base, $types, $config_prefix) = @_; + + return utils->get_first_defined( + (map { + $this->option(join('',utils->to_str($_, $base))); + } @$types), + (map { + $this->_conf_general->get( + join('',utils->to_str($config_prefix, $_, $base))); + } @$types)); +} + +sub send_message { + my ($this,$msg) = @_; + + # 各モジュールに通知 + #$this->_runloop->notify_modules('notification_of_message_io',$msg,$this,'out'); + + $this->SUPER::send_message( + $msg, + $this->option_or_default_multiple('encoding', ['out-', ''], 'client-')); +} + +sub read { + my ($this) = shift; + $this->SUPER::read( + $this->option_or_default_multiple('encoding', ['in-', ''], 'client-')); + + # 接続が切れたら、各モジュールへ通知 + if (!$this->connected) { + $this->_runloop->notify_modules('client_detached',$this); + } +} + +sub pop_queue { + my $this = shift; + my $msg = $this->SUPER::pop_queue; + + # クライアントがログイン中なら、ログインを受け付ける。 + if (defined $msg) { + # 各モジュールに通知 + #$this->_runloop->notify_modules('notification_of_message_io',$msg,$this,'in'); + + # ログイン作業中か？ + if ($this->{logging_in}) { + return $this->_receive_while_logging_in($msg); + } + else { + return $this->_receive_after_logged_in($msg); + } + } + return $msg; +} + +sub _receive_while_logging_in { + my ($this,$msg) = @_; + + # NICK及びUSERを受け取った時点でそのログインの正当性を確認し、作業を終了する。 + my $command = $msg->command; + if ($command eq 'PASS') { + $this->{pass_received} = $msg->params->[0]; + } + elsif ($command eq 'NICK') { + $this->{nick} = $msg->params->[0]; + } + elsif ($command eq 'USER') { + $this->{username} = $msg->param(0); + $this->parse_realname($msg->param(3)); + } + elsif ($command eq 'PING') { + $this->send_message( + new IRCMessage( + Command => 'PONG', + Param => $msg->param(0))); + } + elsif ($command eq 'QUIT') { + $this->send_message( + IRCMessage->new( + Command => 'ERROR', + Param => 'Closing Link: ['.$this->fullname_from_client.'] ()')); + $this->disconnect_after_writing; + } + + if ($this->{nick} ne '' && $this->{username} ne '') { + # general/tiarra-passwordを取得 + my $valid_password = $this->_conf_general->tiarra_password; + my $prefix = $this->_runloop->sysmsg_prefix('system'); + if (defined $valid_password && $valid_password ne '' && + ! Crypt::check($this->{pass_received},$valid_password)) { + # パスワードが正しくない。 + ::printmsg("Refused login of ".$this->fullname_from_client." because of bad password."); + + $this->send_message( + new IRCMessage(Prefix => $prefix, + Command => ERR_PASSWDMISMATCH, + Params => [$this->{nick},'Password incorrect'])); + $this->send_message( + new IRCMessage(Command => 'ERROR', + Param => 'Closing Link: ['.$this->fullname_from_client.'] (Bad Password)')); + $this->disconnect_after_writing; + } + else { + # パスワードが正しいか、指定されていない。 + ::printmsg('Accepted login of '.$this->fullname_from_client.'.'); + if ((my $n_options = keys %{$this->{options}}) > 0) { + # オプションが指定されていたら表示する。 + my $options = join ' ; ',map { + "$_ = $this->{options}->{$_}"; + } keys %{$this->{options}}; + ::printmsg('Given option'.($n_options == 1 ? '' : 's').': '.$options); + } + $this->{logging_in} = 0; + + $this->send_message( + new IRCMessage(Prefix => $prefix, + Command => RPL_WELCOME, + Params => [$this->{nick},'Welcome to the Internet Relay Network '.$this->fullname_from_client])); + + my $current_nick = $this->_runloop->current_nick; + if ($this->{nick} ne $current_nick) { + # クライアントが送ってきたnickとローカルのnickが食い違っているので正しいnickを教える。 + $this->send_message( + new IRCMessage(Prefix => $this->fullname_from_client, + Command => 'NICK', + Param => $current_nick)); + } + + my $send_message = sub { + my ($command, @params) = @_; + $this->send_message( + new IRCMessage( + Prefix => $prefix, + Command => $command, + Params => [$current_nick, + @params], + )); + }; + + map { + # ローカルnickとグローバルnickが食い違っていたらその旨を伝える。 + my $network_name = $_->network_name; + my $global_nick = $_->current_nick; + if ($global_nick ne $current_nick) { + $this->send_message( + new IRCMessage( + Prefix => $this->_runloop->sysmsg_prefix(qw(priv system)), + Command => 'NOTICE', + Params => [$current_nick, + "*** Your global nick in $network_name is currently '$global_nick'."])); + } + } values %{$this->_runloop->networks}; + + $send_message->(RPL_YOURHOST, "Your host is $prefix, running version ".::version()); + if (!$this->_runloop->multi_server_mode_p) { + # single server mode + my $network = ($this->_runloop->networks_list)[0]; + + if (defined $network) { + # send isupport + my $msg_tmpl = IRCMessage->new( + Prefix => $prefix, + Command => RPL_ISUPPORT, + Params => [$current_nick], + ); + # last param is reserved for 'are supported...' + # and first param for nick + my $max_params = IRCMessage->MAX_PARAMS - 2; + my @params = (); + my $length = 0; + my $flush_msg = sub { + if (@params) { + my $msg = $msg_tmpl->clone; + $msg->push(@params); + $msg->push('are supported by this server'); + $this->send_message($msg); + } + @params = (); + $length = 0; + }; + foreach my $key (keys %{$network->isupport}) { + my $value = $network->isupport->{$key}; + my $str = length($value) ? ($key.'='.$value) : $key; + $length += length($str) + 1; # $str and space + # 余裕を見て400バイトを越えたら行を分ける。 + if ($length >= 400 || scalar(@params) >= $max_params) { + $flush_msg->(); + $length = length($str); + } + push(@params, $str); + } + $flush_msg->(); + } + } + $send_message->(RPL_MOTDSTART, "- $prefix Message of the Day -"); + foreach my $line (main::get_credit()) { + $send_message->(RPL_MOTD, "- ".$line); + } + $send_message->(RPL_ENDOFMOTD, "End of MOTD command."); + + # joinしている全てのチャンネルの情報をクライアント送る。 + $this->inform_joinning_channels; + + # 各モジュールにクライアント追加の通知を出す。 + $this->_runloop->notify_modules('client_attached',$this); + } + } + # ログイン作業中にクライアントから受け取ったいかなるメッセージもサーバーには送らない。 + return undef; +} + +sub _receive_after_logged_in { + my ($this,$msg) = @_; + + # ログイン中でない。 + my $command = $msg->command; + + if ($command eq 'NICK') { + if (defined $msg->params) { + # 形式が正しい限りNICKには常に成功して、RunLoopのカレントnickが変更になる。 + # ただしネットワーク名が明示されていた場合はカレントを変更しない。 + my ($nick,undef,$specified) = Multicast::detach($msg->params->[0]); + if (Multicast::nick_p($nick)) { + unless ($specified) { + #$this->send_message( + # new IRCMessage( + # Prefix => $this->fullname, + # Command => 'NICK', + # Param => $msg->params->[0])); + if ($this->_runloop->multi_server_mode_p) { + $this->_runloop->broadcast_to_clients( + IRCMessage->new( + Command => 'NICK', + Param => $msg->param(0), + Remarks => {'fill-prefix-when-sending-to-client' => 1})); + + $this->_runloop->set_current_nick($msg->params->[0]); + } + } + } else { + $this->send_message( + new IRCMessage( + Prefix => $this->_runloop->sysmsg_prefix('system'), + Command => ERR_ERRONEOUSNICKNAME, + Params => [$this->_runloop->current_nick, + $msg->params->[0], + 'Erroneous nickname'])); + # これは鯖に送らない。 + $msg = undef; + } + } else { + $this->send_message( + new IRCMessage( + Prefix => $this->_runloop->sysmsg_prefix('system'), + Command => ERR_NONICKNAMEGIVEN, + Params => [$this->_runloop->current_nick, + 'No nickname given'])); + # これは鯖に送らない。 + $msg = undef; + } + } + elsif ($command eq 'QUIT') { + my $quit_message = $msg->param(0); + $quit_message = '' unless defined $quit_message; + + $this->send_message( + new IRCMessage(Command => 'ERROR', + Param => 'Closing Link: '.$this->fullname('error').' ('.$quit_message.')')); + $this->disconnect_after_writing; + + # 接続が切れた事にする。 + $this->_runloop->notify_modules('client_detached',$this); + + # これは鯖に送らない。 + $msg = undef; + } + else { + $msg = LocalChannelManager->shared + ->message_arrived($msg, $this); + } + return $msg; +} + +sub do_namreply { + my ($this, $ch, $network, $max_length, $flush_func) = @_; + + $max_length = 400 if !defined $max_length; + croak('$ch is not specified') if !defined $ch; + croak('$network is not specified') if !defined $network; + croak('$flush_func is not specified') if !defined $flush_func; + my $global_to_local = sub { + Multicast::global_to_local(shift, $network); + }; + my $ch_property_char = do { + if ($ch->switches('s')) { + '@'; + } + elsif ($ch->switches('p')) { + '*'; + } + else { + '='; + } + }; + # 余裕を見てnickの列挙部が $max_length(デフォルト:400) バイトを越えたら行を分ける。 + my $nick_enumeration = ''; + my $flush_enum_buffer = sub { + if ($nick_enumeration ne '') { + $flush_func->( + IRCMessage->new( + Prefix => $this->fullname, + Command => RPL_NAMREPLY, + Params => [$this->_runloop->current_nick, + $ch_property_char, + Multicast::attach_for_client($ch->name, $network->network_name), + $nick_enumeration])); + $nick_enumeration = ''; + } + }; + my $append_to_enum_buffer = sub { + my $nick_to_append = shift; + if ($nick_enumeration eq '') { + $nick_enumeration = $nick_to_append; + } + else { + $nick_enumeration .= ' '.$nick_to_append; + } + }; + map { + my $person = $_; + my $mode_char = do { + if ($person->has_o) { + '@'; + } + elsif ($person->has_v) { + '+'; + } + else { + ''; + } + }; + $append_to_enum_buffer->($mode_char . $global_to_local->($person->person->nick)); + if (length($nick_enumeration) > $max_length) { + $flush_enum_buffer->(); + } + } values %{$ch->names}; + $flush_enum_buffer->(); + + undef; +} + +sub inform_joinning_channels { + my $this = shift; + my $local_nick = $this->_runloop->current_nick; + + my $send_channelinfo = sub { + my ($network, $ch) = @_; + my $ch_name = Multicast::attach_for_client($ch->name, $network->network_name); + + # まずJOIN + $this->send_message( + IRCMessage->new( + Prefix => $this->fullname, + Command => 'JOIN', + Param => $ch_name)); + # 次にRPL_TOPIC(あれば) + if ($ch->topic ne '') { + $this->send_message( + IRCMessage->new( + Prefix => $this->fullname, + Command => RPL_TOPIC, + Params => [$local_nick,$ch_name,$ch->topic])); + } + # 次にRPL_TOPICWHOTIME(あれば) + if (defined($ch->topic_who)) { + $this->send_message( + IRCMessage->new( + Prefix => $this->fullname, + Command => RPL_TOPICWHOTIME, + Params => [$local_nick,$ch_name,$ch->topic_who,$ch->topic_time])); + } + # 次にRPL_NAMREPLY + my $flush_namreply = sub { + my $msg = shift; + $this->send_message($msg); + }; + $this->do_namreply($ch, $network, undef, $flush_namreply); + # 最後にRPL_ENDOFNAMES + $this->send_message( + IRCMessage->new( + Prefix => $this->fullname, + Command => RPL_ENDOFNAMES, + Params => [$local_nick,$ch_name,'End of NAMES list'])); + + # channel-infoフックの引数は (IrcIO::Client, 送信用チャンネル名, ネットワーク, ChannelInfo) + eval { + IrcIO::Client::HookTarget->shared->call( + 'channel-info', $this, $ch_name, $network, $ch); + }; if ($@) { + # エラーメッセージは表示するが、送信処理は続ける + $this->_runloop->notify_error(__PACKAGE__." hook call error: $@"); + } + }; + + my %channels = map { + my $network = $_; + map { + my $ch = $_; + (Multicast::attach($ch->name, $network->network_name) => + [$network, $ch]); + } values %{$network->channels}; + } values %{$this->_runloop->networks}; + + # Mask を使って、マッチしたものを出力 + foreach ($this->_conf_networks-> + fixed_channels('block')->channel('all')) { + my $mask = $_; + foreach (keys %channels) { + my $ch_name = $_; + if (Mask::match($mask, $ch_name)) { + $send_channelinfo->(@{$channels{$ch_name}}); + delete $channels{$ch_name}; + } + } + } + + # のこりを出力 + foreach (values %channels) { + $send_channelinfo->(@$_); + } +} + +# ----------------------------------------------------------------------------- +# クライアントにチャンネル情報(JOIN,TOPIC,NAMES等)を渡した直後に呼ばれるフック。 +# チャンネル名(multi server modeならネットワーク名付き)を引数として、 +# チャンネル一つにつき一度ずつ呼ばれる。 +# +# my $hook = IrcIO::Client::Hook->new(sub { +# my $hook_itself = shift; +# # 何らかの処理を行なう。 +# })->install('channel-info'); # チャンネル情報転送時にこのフックを呼ぶ。 +# ----------------------------------------------------------------------------- +package IrcIO::Client::Hook; +use FunctionalVariable; +use base 'Hook'; + +our $HOOK_TARGET_NAME = 'IrcIO::Client::HookTarget'; +our @HOOK_NAME_CANDIDATES = qw/channel-info/; +our $HOOK_NAME_DEFAULT = 'channel-info'; +our $HOOK_TARGET_DEFAULT; +FunctionalVariable::tie( + \$HOOK_TARGET_DEFAULT, + FETCH => sub { + IrcIO::Client::HookTarget->shared; + }, + ); + +# ----------------------------------------------------------------------------- +package IrcIO::Client::HookTarget; +use Hook; +our @ISA = 'HookTarget'; +use Tiarra::SharedMixin; + +sub _new { + return bless {} => shift; +} + +sub call { + my ($this, $name, @args) = @_; + $this->call_hooks($name, @args); +} + +1; diff -urN /non-existant-dir/main/IrcIO/Server.pm tiarra-20050322/main/IrcIO/Server.pm --- /non-existant-dir/main/IrcIO/Server.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/IrcIO/Server.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,1364 @@ +# ----------------------------------------------------------------------------- +# $Id: Server.pm 830 2005-03-08 00:28:45Z topia $ +# ----------------------------------------------------------------------------- +# IrcIO::ServerはIRCサーバーに接続し、IRCメッセージをやり取りするクラスです。 +# このクラスはサーバーからメッセージを受け取ってチャンネル情報や現在のnickなどを保持しますが、 +# 受け取ったメッセージをモジュールに通したり各クライアントに転送したりはしません。 +# それはRunLoopの役目です。 +# ----------------------------------------------------------------------------- +package IrcIO::Server; +use strict; +use warnings; +use IrcIO; +use base qw(IrcIO); +use Carp; +use ChannelInfo; +use PersonalInfo; +use PersonInChannel; +use UNIVERSAL; +use Multicast; +use NumericReply; +use Tiarra::Utils; +use Tiarra::Socket::Connect; +use Tiarra::Resolver; +utils->define_attr_getter(0, + qw(network_name current_nick logged_in), + qw(server_hostname isupport config), + [qw(host server_host)]); +utils->define_attr_accessor(0, qw(state finalizing)); +utils->define_attr_enum_accessor('state', 'eq', + qw(connecting finalizing terminating), + qw(terminated finalized connected), + qw(reconnecting)); + + +sub out_encoding { shift->config_local_or_general('out-encoding', 'server-') } +sub in_encoding { shift->config_local_or_general('in-encoding', 'server-') } + +sub new { + my ($class,$runloop,$network_name) = @_; + my $this = $class->SUPER::new( + $runloop, + name => "network/$network_name"); + $this->{network_name} = $network_name; + $this->{current_nick} = ''; # 現在使用中のnick。ログインしていなければ空。 + $this->{server_hostname} = ''; # サーバが主張している hostname。こちらもログインしてなければ空。 + + $this->{logged_in} = 0; # このサーバーへのログインに成功しているかどうか。 + $this->{new_connection} = 1; + + $this->{receiving_namreply} = {}; # RPL_NAMREPLYを受け取ると<チャンネル名,1>になり、RPL_ENDOFNAMESを受け取るとそのチャンネルの要素が消える。 + $this->{receiving_banlist} = {}; # 同上。RPL_BANLIST + $this->{receiving_exceptlist} = {}; # 同上。RPL_EXCEPTLIST + $this->{receiving_invitelist} = {}; # 同上、RPL_INVITELIST + + $this->{channels} = {}; # 小文字チャンネル名 => ChannelInfo + $this->{people} = {}; # nick => PersonalInfo + $this->{isupport} = {}; # isupport + + $this->{connecting} = undef; + $this->{finalizing} = undef; + $this->state('initializing'); + + $this->reconnect; +} + +sub connecting { defined shift->{connecting}; } + +sub _connect_interrupted { + my $this = shift; + $this->state_terminating || $this->state_finalizing || + $this->state_terminated || $this->state_finalized; +} + +sub _gen_msg { + my ($this, $msg) = @_; + + $this->name.': '.$msg; +} + +sub die { + my ($this, $msg) = @_; + CORE::die($this->_gen_msg($msg)); +} + +sub warn { + my ($this, $msg) = @_; + CORE::warn($this->_gen_msg($msg)); +} + +sub printmsg { + my ($this, $msg) = @_; + +# if (defined $this->{last_msg} && +# $this->{last_msg}->[0] eq $msg && +# $this->{last_msg}->[1] <= (time - 10)) { +# # repeated +# return +# } +# $this->{last_msg} = [$msg, time]; + ::printmsg($this->_gen_msg($msg)); +} + +sub nick_p { + my ($this, $nick) = @_; + + Multicast::nick_p($nick, $this->isupport->{NICKLEN}); +} + +sub channel_p { + my ($this, $name) = @_; + + Multicast::channel_p($name, $this->isupport->{CHANTYPES}); +} + +sub channels { + # {小文字チャンネル名 => ChannelInfo}のハッシュリファを返す。 + # @options(省略可能): + # 'even-if-kicked-out': 既に自分が蹴り出されてゐるチャンネルも返す。この動作は高速である。 + my ($this, @options) = @_; + if (defined $options[0] && $options[0] eq 'even-if-kicked-out') { + $this->{channels}; + } + else { + # kicked-outフラグが立つてゐないチャンネルのみ返す。 + my %result; + while (my ($name, $ch) = each %{$this->{channels}}) { + if (!$ch->remark('kicked-out')) { + $result{$name} = $ch; + } + } + \%result; + } +} + +sub channels_list { + # @options(省略可能): + # 'even-if-kicked-out': 既に自分が蹴り出されてゐるチャンネルも返す。この動作は高速である。 + my ($this, @options) = @_; + if (defined $options[0] && $options[0] eq 'even-if-kicked-out') { + values %{$this->{channels}}; + } + else { + # kicked-outフラグが立つてゐないチャンネルのみ返す。 + grep { + !$_->remarks('kicked-out'); + } values %{$this->{channels}}; + } +} + +sub person_list { + values %{shift->{people}}; +} + +sub fullname { + $_[0]->{current_nick}.'!'.$_[0]->{user_shortname}.'@'.$_[0]->{server_host}; +} + +sub config_local_or_general { + my ($this, $base, $general_prefix, $local_prefix, $default) = @_; + + foreach ([$this->config, $local_prefix], + [$this->_conf_general, $general_prefix]) { + my ($conf, $prefix) = @$_; + $prefix = '' unless defined $prefix; + my $value = $conf->get("$prefix$base"); + if (defined $value) { + return $value; + } + } + return $default; +} + +sub reload_config { + my $this = shift; + my $conf = $this->{config} = $this->_conf->get($this->{network_name}); + $this->{server_host} = $conf->host; + $this->{server_port} = $conf->port; + $this->{server_password} = $conf->password; + $this->{initial_nick} = $this->config_local_or_general('nick'); # ログイン時に設定するnick。 + $this->{user_shortname} = $this->config_local_or_general('user'); + $this->{user_realname} = $this->config_local_or_general('name'); + $this->{prefer_socket_types} = [qw(ipv6 ipv4)]; +} + +sub destination { + my $this = shift; + Tiarra::Socket->repr_destination( + host => $this->{server_host}, + addr => $this->{server_addr}, + port => $this->{server_port}, + type => $this->{proto}); +} + +sub person_if_exists { + my ($this, $nick) = @_; + $this->{people}{$nick}; +} + +sub person { + # nick以外は全て省略可能。 + # 未知のnickが指定された場合は新規に追加する。 + my ($this,$nick,$username,$userhost,$realname,$server) = @_; + return if !defined $nick; + + my $info = $this->{people}->{$nick}; + if (!defined($info)) { + $info = $this->{people}->{$nick} = + new PersonalInfo(Nick => $nick, + UserName => $username, + UserHost => $userhost, + RealName => $realname, + Server => $server); + } + else { + $info->username($username); + $info->userhost($userhost); + $info->realname($realname); + $info->server($server); + } + $info; +} + +sub channel { + my $this = $_[0]; + my $channel_name = Multicast::lc($_[1]); + $this->{channels}->{$channel_name}; +} + +sub _queue_retry { + my $this = shift; + + $this->state_reconnecting(1); + + $this->_cleanup if defined $this->{timer}; + $this->{connecting} = undef; + $this->{timer} = Timer->new( + Name => $this->_gen_msg('retry timer'), + After => 15, + Code => sub { + $this->{timer} = undef; + return if $this->finalizing; + $this->reconnect; + })->install; +} + +sub reconnect { + my $this = shift; + $this->reload_config; + $this->connect; +} + +# connect --(resolve)--> stage_1 --> (queueing) --> try_next --> +# each connect method +# ok -> attach +# err -> _connect_error + +sub connect { + my $this = shift; + #return if $this->connected; + croak 'connected!' if $this->connected; + croak 'connecting!' if $this->connecting; + $this->finalizing(undef); + + # 初期化すべきフィールドを初期化 + $this->{nick_retry} = 0; + $this->{logged_in} = undef; + $this->state_connecting(1); + my $conn_stat = $this->{connection_status} = { + start => time, + tried => [], + }; + + Tiarra::Resolver->resolve('addr', $this->{server_host}, sub { + $this->_connect_stage_1(@_); + }); + $this; +} + +sub _connect_stage_1 { + my ($this, $entry) = @_; + + my %addrs_by_types; + my $server_port = $this->{server_port}; + + return if $this->finalizing; + + if ($entry->answer_status eq $entry->ANSWER_OK) { + foreach my $addr (@{$entry->answer_data}) { + if ($addr =~ m/^(?:\d+\.){3}\d+$/) { + push (@{$addrs_by_types{ipv4}}, $addr); + } elsif ($addr =~ m/^[0-9a-fA-F:]+$/) { + push (@{$addrs_by_types{ipv6}}, $addr); + } else { + $this->die("unsupported addr type: $addr"); + } + } + } else { + $this->printmsg("Couldn't resolve hostname: $this->{server_host}"); + $this->_queue_retry; + return; + } + + foreach my $sock_type (@{$this->{prefer_socket_types}}) { + my $struct; + push (@{$this->{connection_queue}}, + map { + $struct = { + type => $sock_type, + addr => $_, + host => $entry->query_data, + port => $server_port, + }; + } @{$addrs_by_types{$sock_type}}); + } + $this->_connect_try_next; +} + +sub _connect_try_next { + my $this = shift; + + return if $this->finalizing; + my $trying = + $this->{connecting} = shift @{$this->{connection_queue}}; + if (defined $trying) { + my $methodname = '_try_connect_' . $this->{connecting}->{type}; + $this->$methodname($trying); + } else { + $this->printmsg("Couldn't connect to any host"); + $this->_queue_retry; + return; + } +} + +sub _try_connect_ipv4 { + my ($this, $conn_struct) = @_; + + my %additional; + my $ipv4_bind_addr = + $this->config_local_or_general('ipv4-bind-addr') || + $this->config_local_or_general('bind-addr'); # 下は過去互換性の為に残す。 + if (defined $ipv4_bind_addr) { + $additional{bind_addr} = $ipv4_bind_addr; + } + $this->_try_connect_socket($conn_struct, %additional); +} + +sub _try_connect_ipv6 { + my ($this, $conn_struct) = @_; + + my %additional; + my $ipv6_bind_addr = $this->config_local_or_general('ipv6-bind-addr'); + if (defined $ipv6_bind_addr) { + $additional{bind_addr} = $ipv6_bind_addr; + } + + $this->_try_connect_socket($conn_struct, %additional); +} + +sub _try_connect_socket { + my ($this, $conn_struct, %additional) = @_; + + $this->{connector} = Tiarra::Socket::Connect->new( + host => $conn_struct->{host}, + addr => $conn_struct->{addr}, + port => $conn_struct->{port}, + callback => sub { + my ($subject, $socket, $obj) = @_; + + if ($subject eq 'sock') { + $this->attach($socket); + } elsif ($subject eq 'error') { + $this->_connect_error($obj); + } elsif ($subject eq 'warn') { + $this->_connect_warn($obj); + } + }, + %additional); + $this; +} + +sub attach { + my ($this, $connector) = @_; + + $this->SUPER::attach($connector->sock); + $this->{connecting} = undef; + $this->{server_addr} = $connector->current_addr; + $this->{proto} = $connector->current_type; + $this->state_connected(1); + + $this->_send_connection_messages; + + $this->{connector} = undef; + $this->printmsg("Opened connection to ". $this->destination ."."); + $this->install; + $this; +} + +sub _connect_error { + my ($this, $msg) = @_; + + # avoid double error message (we don't use timeout) + #$this->printmsg("Couldn't connect to ".$this->destination.": $msg\n"); + $this->_connect_try_next; +} + +sub _connect_warn { + my ($this, $msg) = @_; + + $this->printmsg("$msg\n"); +} + +sub _send_connection_messages { + my $this = shift; + # (PASS) -> NICK -> USERの順に送信し、中に入る。 + # NICKが成功したかどうかは接続後のreceiveメソッドが判断する。 + my $server_password = $this->{server_password}; + if (defined $server_password && $server_password ne '') { + $this->send_message(new IRCMessage( + Command => 'PASS', + Param => $this->{server_password})); + } + if (!defined $this->{current_nick} || $this->{current_nick} eq '') { + $this->{current_nick} = $this->{initial_nick}; + } + $this->send_message(new IRCMessage( + Command => 'NICK', + Param => $this->{current_nick})); + + # +iなどの文字列からユーザーモード値を算出する。 + my $usermode = 0; + if (my $usermode_str = $this->_conf_general->user_mode) { + if ($usermode_str =~ /^\+/) { + foreach my $c (split //,substr($usermode_str,1)) { + if ($c eq 'w') { + $usermode |= (1 << 2); + } + elsif ($c eq 'i') { + $usermode |= (1 << 3); + } + } + } + } + $this->send_message(new IRCMessage( + Command => 'USER', + Params => [$this->{user_shortname}, + $usermode, + '*', + $this->{user_realname}])); +} + +sub terminate { + my ($this, $msg) = @_; + + $this->_interrupt($msg, 'terminating'); +} + +sub finalize { + my ($this, $msg) = @_; + + $this->_interrupt($msg, 'finalizing'); + $this->finalizing(1); +} + +sub _interrupt { + my ($this, $msg, $state) = @_; + + if ($this->logged_in) { + $this->state($state); + $this->quit($msg); + } elsif ($this->state_connecting || $this->state_reconnecting) { + $this->state($state); + $this->_cleanup; + } else { + if (!$this->state_connected) { + $this->warn('_interrupt/unexpected state: '.$this->state) + if &::debug_mode; + } + $this->state($state); + $this->disconnect; + } +} + +sub disconnect { + my ($this, $genre, $errno, @params) = @_; + + $this->_cleanup; + $this->SUPER::disconnect($genre, $errno, @params); + if (defined $errno) { + $this->printmsg($this->sock_errno_to_msg( + $errno, + "Disconnected from ".$this->destination.": $genre error")); + } else { + $this->printmsg("Disconnected from ".$this->destination."."); + } + if ($this->state_reconnecting || $this->state_connected) { + $this->state_reconnecting(1); + $this->reload_config; + $this->_queue_retry; + } + $this->{logged_in} = undef; +} + +sub _cleanup { + my ($this, $mode) = @_; + + $this->{connecting} = undef; + if (defined $this->{connector}) { + $this->{connector}->interrupt; + $this->{connector} = undef; + } + if (defined $this->{timer}) { + $this->{timer}->uninstall; + $this->{timer} = undef; + } + if ($this->state_terminating) { + $this->state_terminated(1); + } elsif ($this->state_finalizing) { + $this->state_finalized(1); + } +} + +sub quit { + my ($this, $msg) = @_; + return $this->send_message( + IRCMessage->new( + Command => 'QUIT', + Param => $msg)); +} + +sub send_message { + my ($this,$msg) = @_; + + if (!defined $msg) { + croak "IrcIO::Server->send_message, Arg[1] was undef.\n"; + } + elsif (!ref($msg)) { + croak "IrcIO::Server->send_message, Arg[1] was not ref.\n"; + } + elsif (!UNIVERSAL::isa($msg, 'IRCMessage')) { + croak "IrcIO::Server->send_message, Arg[1] was bad ref: ".ref($msg)."\n"; + } + + # 各モジュールへ通知 + #$this->_runloop->notify_modules('notification_of_message_io',$msg,$this,'out'); + + $this->SUPER::send_message( + $msg, + $this->out_encoding); +} + +sub read { + my $this = shift; + $this->SUPER::read($this->in_encoding); + + # 接続が切れたら、各モジュールとRunLoopへ通知 + if (!$this->connected) { + $this->_runloop->notify_modules('disconnected_from_server',$this); + $this->_runloop->disconnected_server($this); + } +} + +sub pop_queue { + my ($this) = shift; + my $msg = $this->SUPER::pop_queue; + + # このメソッドはログインしていなければログインするが、 + # パスワードが違うなどで何度やり直してもログイン出来る見込みが無ければ + # 接続を切ってからdieします。 + if (defined $msg) { + # ログイン作業中か？ + if ($this->logged_in) { + # ログイン作業中でない。 + return $this->_receive_after_logged_in($msg); + } + else { + return $this->_receive_while_logging_in($msg); + } + } + return $msg; +} + +sub _receive_while_logging_in { + my ($this,$first_msg) = @_; + + # まだログイン作業中であるのなら、ログインに成功したかどうかを + # 最初に受け取った行が001(成功)か433(nick重複)かそれ以外かで判断する。 + my $reply = $first_msg->command; + if ($reply eq RPL_WELCOME) { + # 成功した。 + $this->{current_nick} = $first_msg->param(0); + $this->{server_hostname} = $first_msg->prefix; + if (!$this->_runloop->multi_server_mode_p && + $this->_runloop->current_nick ne $this->{current_nick}) { + $this->_runloop->broadcast_to_clients( + IRCMessage->new( + Command => 'NICK', + Param => $first_msg->param(0), + Remarks => {'fill-prefix-when-sending-to-client' => 1 + })); + + $this->_runloop->set_current_nick($first_msg->param(0)); + } + $this->{logged_in} = 1; + $this->person($this->{current_nick}, + $this->{user_shortname}, + $this->{user_realname}); + + $this->printmsg("Logged-in successfuly into ".$this->destination."."); + + # 各モジュールにサーバー追加の通知を行なう。 + $this->_runloop->notify_modules('connected_to_server',$this,$this->{new_connection}); + # 再接続だった場合の処理 + if (!$this->{new_connection}) { + $this->_runloop->reconnected_server($this); + } + $this->{new_connection} = undef; + } + elsif ($reply eq ERR_NICKNAMEINUSE) { + # nick重複。 + $this->_set_to_next_nick($first_msg->param(1)); + return; # 何も返さない→クライアントにはこの結果を知らせない。 + } + elsif ($reply eq ERR_UNAVAILRESOURCE) { + # nick/channel is temporarily unavailable(この場合は nick) + $this->_set_to_next_nick($first_msg->param(1)); + return; # 何も返さない→クライアントにはこの結果を知らせない。 + } + elsif (grep { $_ eq $reply } qw(NOTICE PRIVMSG)) { + # NOTICE / PRIVMSG + return; # 何もしない + } + elsif ($reply eq 'PING') { + $this->send_message( + new IRCMessage( + Command => 'PONG', + Param => $first_msg->param(0))); + } + else { + # それ以外。手の打ちようがないのでconnectionごと切断してしまう。 + # 但し、エラーニューメリックリプライでもERRORでもなければ無視する。 + if ($reply =~ /^[0-3]\d+/) { + $this->printmsg("Server replied $reply, ignored.\n".$first_msg->serialize."\n"); + return; + } elsif ($reply eq 'ERROR' or $reply !~ m/^\d+/) { + $this->disconnect; + $this->die("Server replied $reply.\n".$first_msg->serialize."\n"); + } + else { + $this->printmsg("Server replied $reply, ignored.\n".$first_msg->serialize."\n"); + return; + } + } + return $first_msg; +} + +sub _receive_after_logged_in { + my ($this,$msg) = @_; + + $this->person($msg->nick,$msg->name,$msg->host); # nameとhostを覚えておく。 + + if (defined $msg->nick && + $msg->nick ne $this->current_nick) { + $msg->remark('message-send-by-other', 1); + } + + if ($msg->command eq 'NICK') { + # nickを変えたのが自分なら、それをクライアントには伝えない。 + my $current_nick = $this->{current_nick}; + if ($msg->nick eq $current_nick) { + $this->{current_nick} = $msg->param(0); + + if ($this->_runloop->multi_server_mode_p) { + # ここで消してしまうとプラグインにすらNICKが行かなくなる。 + # 消す代わりに"do-not-send-to-clients => 1"という註釈を付ける。 + $msg->remark('do-not-send-to-clients',1); + + # ローカルnickと違っていれば、その旨を通知する。 + # 但し、networks/always-notify-new-nickが設定されていれば常に通知する。 + my $local_nick = $this->_runloop->current_nick; + if ($this->_conf_networks->always_notify_new_nick || + $this->{current_nick} ne $local_nick) { + + my $old_nick = $msg->nick; + $this->_runloop->broadcast_to_clients( + IRCMessage->new( + Prefix => $this->_runloop->sysmsg_prefix(qw(priv nick::system)), + Command => 'NOTICE', + Params => [$local_nick, + "*** Your global nick in ". + $this->{network_name}." changed ". + "$old_nick -> ". + $this->{current_nick}."."])); + } + } else { + $this->_runloop->set_current_nick($msg->param(0)); + } + } + $this->_NICK($msg); + } + elsif ($msg->command eq ERR_NICKNAMEINUSE) { + # nickが既に使用中 + return $this->_handle_fix_nick($msg); + } + elsif ($msg->command eq ERR_UNAVAILRESOURCE) { + # nick/channel temporary unavaliable + if (Multicast::nick_p($msg->param(1))) { + return $this->_handle_fix_nick($msg); + } + } + elsif ($msg->command eq 'JOIN') { + $this->_JOIN($msg); + } + elsif ($msg->command eq 'KICK') { + $this->_KICK($msg); + } + elsif ($msg->command eq 'MODE') { + $this->_MODE($msg); + } + elsif ($msg->command eq 'NJOIN') { + $this->_NJOIN($msg); + } + elsif ($msg->command eq 'PART') { + $this->_PART($msg); + } + elsif ($msg->command eq 'QUIT' || $msg->command eq 'KILL') { + # QUITとKILLは同じように扱う。 + $this->_QUIT($msg); + } + elsif ($msg->command eq 'TOPIC') { + $this->_TOPIC($msg); + } + else { + my $name = NumericReply::fetch_name($msg->command); + if (defined $name) { + foreach ( + map("RPL_$_", + qw(CHANNELMODEIS NOTOPIC TOPIC TOPICWHOTIME + CREATIONTIME WHOREPLY NAMREPLY ENDOFNAMES + WHOISUSER WHOISSERVER AWAY ENDOFWHOIS + ISUPPORT YOURID), + map({("${_}LIST", "ENDOF${_}LIST");} + qw(INVITE EXCEPT BAN)), + )) { + if ($name eq $_) { + no strict 'refs'; + my $funcname = "_$_"; + &$funcname($this, $msg); # $this->$funcname($msg) + last; + } + } + } + } + return $msg; +} + +sub _KICK { + my ($this,$msg) = @_; + my @ch_names = split(/,/,$msg->param(0)); + my @nicks = split(/,/,$msg->param(1)); + my $kick = sub { + my ($ch,$nick_to_kick) = @_; + if ($nick_to_kick eq $this->{current_nick}) { + # KICKされたのが自分だった + $ch->remarks('kicked-out','1'); + } + else { + $ch->names($nick_to_kick,undef,'delete'); + } + }; + if (@ch_names == @nicks) { + # チャンネル名とnickが1対1で対応 + map { + my ($ch_name,$nick) = ($ch_names[$_],$nicks[$_]); + my $ch = $this->channel($ch_name); + if (defined $ch) { + #$ch->names($nick,undef,'delete'); + $kick->($ch,$nick); + } + } 0 .. $#ch_names; + } + elsif (@ch_names == 1) { + # 一つのチャンネルから1人以上をkick + my $ch = $this->channel($ch_names[0]); + if (defined $ch) { + map { + #$ch->names($_,undef,'delete'); + $kick->($ch,$_); + } @nicks; + } + } +} + +sub _MODE { + my ($this,$msg) = @_; + if ($msg->param(0) eq $this->{current_nick}) { + # MODEの対象が自分なのでここでは無視。 + return; + } + + my $ch = $this->channel($msg->param(0)); + if (defined $ch) { + my $n_params = @{$msg->params}; + + my $plus = 0; # 現在評価中のモードが+なのか-なのか。 + my $mode_char_pos = 1; # 現在評価中のmode characterの位置。 + my $mode_param_offset = 0; # $mode_char_posから幾つの追加パラメタを拾ったか。 + + my $fetch_param = sub { + $mode_param_offset++; + return $msg->param($mode_char_pos + $mode_param_offset); + }; + + for (;$mode_char_pos < $n_params;$mode_char_pos += $mode_param_offset + 1) { + $mode_param_offset = 0; # これは毎回リセットする。 + foreach my $c (split //,$msg->param($mode_char_pos)) { + my $add_or_delete = ($plus ? 'add' : 'delete'); + my $undef_or_delete = ($plus ? undef : 'delete'); + if ($c eq '+') { + $plus = 1; + } + elsif ($c eq '-') { + $plus = 0; + } + elsif (index('aimnpqrst',$c) != -1) { + $ch->switches($c,1,$undef_or_delete); + } + elsif ($c eq 'b') { + $ch->banlist($add_or_delete,&$fetch_param); + } + elsif ($c eq 'e') { + $ch->exceptionlist($add_or_delete,&$fetch_param); + } + elsif ($c eq 'I') { + $ch->invitelist($add_or_delete,&$fetch_param); + } + elsif ($c eq 'k') { + $ch->parameters('k',&$fetch_param,$undef_or_delete); + } + elsif ($c eq 'l') { + $ch->parameters('l',($plus ? &$fetch_param : undef),$undef_or_delete); + } + elsif ($c eq 'o' || $c eq 'O') { + # oとOは同一視 + eval { + $ch->names(&$fetch_param)->has_o($plus); + }; + } + elsif ($c eq 'v') { + eval { + $ch->names(&$fetch_param)->has_v($plus); + }; + } + } + } + } +} + +sub _JOIN { + my ($this,$msg) = @_; + + map { + m/^([^\x07]+)(?:\x07(.*))?/; + my ($ch_name,$mode) = ($1,(defined $2 ? $2 : '')); + + my $ch = $this->channel($ch_name); + if (defined $ch) { + # 知っているチャンネル。もしkickedフラグが立っていたらクリア。 + $ch->remarks('kicked-out',undef,'delete'); + } + else { + # 知らないチャンネル。 + $ch = ChannelInfo->new($ch_name,$this->{network_name}); + $this->{channels}{Multicast::lc($ch_name)} = $ch; + } + $ch->names($msg->nick, + new PersonInChannel( + $this->person($msg->nick,$msg->name,$msg->host), + index($mode,"o") != -1 || index($mode,"O") != -1, # oもOも今は同一視 + index($mode,"v") != -1)); + } split(/,/,$msg->param(0)); +} + +sub _NJOIN { + my ($this,$msg) = @_; + my $ch_name = $msg->param(0); + my $ch = $this->channel($ch_name); + unless (defined $ch) { + # 知らないチャンネル。 + $ch = ChannelInfo->new($ch_name,$this->{network_name}); + $this->{channels}{Multicast::lc($ch_name)} = $ch; + } + map { + m/^([@+]*)(.+)$/; + my ($mode,$nick) = ($1,$2); + + $ch->names($nick, + new PersonInChannel( + $this->person($nick), + index($mode,"@") != -1, # 今は@と@@を同一視。 + index($mode,"+") != -1)); + } split(/,/,$msg->param(1)); +} + +sub _PART { + my ($this,$msg) = @_; + map { + my $ch_name = $_; + my $ch = $this->channel($ch_name); + if (defined $ch) { + if ($msg->nick eq $this->{current_nick}) { + # PARTしたのが自分だった + delete $this->{channels}->{Multicast::lc($ch_name)}; + } + else { + $ch->names($msg->nick,undef,'delete'); + } + } + } split(/,/,$msg->param(0)); + + # 全チャンネルを走査し、このnickを持つ人物が一人も居なくなつてゐたらpeopleからも消す。 + my $alive; + foreach my $ch (values %{$this->{channels}}) { + if (defined $ch->names($msg->nick)) { + $alive = 1; + } + } + if (!$alive) { + delete $this->{people}{$msg->nick}; + } +} + +sub _NICK { + my ($this,$msg) = @_; + # PersonalInfoとChannelInfoがnickを持っているので書き換える。 + my ($old,$new) = ($msg->nick,$msg->param(0)); + + if (!defined $this->{people}->{$old}) { + return; + } + + $this->{people}->{$old}->nick($new); + $this->{people}->{$new} = $this->{people}->{$old}; + delete $this->{people}->{$old}; + + my @channels = grep { + defined $_->names($old); + } values %{$this->{channels}}; + + # このNICKが影響を及ぼした全チャンネル名のリストを + # "affected-channels"として註釈を付ける。 + my @affected = map { + my $ch = $_; + $ch->names($new,$ch->names($old)); + $ch->names($old,undef,'delete'); + $ch->name; + } @channels; + $msg->remark('affected-channels',\@affected); +} + +sub _QUIT { + my ($this,$msg) = @_; + # people及びchannelsから削除する。 + delete $this->{people}->{$msg->nick}; + + my @channels = grep { + defined $_->names($msg->nick); + } values %{$this->{channels}}; + + # このNICKが影響を及ぼした全チャンネル名のリストを + # "affected-channels"として註釈を付ける。 + my @affected = map { + my $ch = $_; + $ch->names($msg->nick,undef,'delete'); + $ch->name; + } @channels; + $msg->remark('affected-channels',\@affected); +} + +sub _TOPIC { + my ($this,$msg) = @_; + my $ch = $this->channel($msg->param(0)); + if (defined $ch) { + # 古いトピックを"old-topic"として註釈を付ける。 + $msg->remark('old-topic', $ch->topic); + $ch->topic($msg->param(1)); + + # topic_who と topic_time を指定する + $ch->topic_who($msg->prefix); + $ch->topic_time(time); + } +} + +sub _RPL_NAMREPLY { + my ($this,$msg) = @_; + my $ch = $this->channel($msg->param(2)); + return unless defined $ch; + + my $receiving_namreply = $this->{receiving_namreply}->{$msg->param(2)}; + unless (defined $receiving_namreply && + $receiving_namreply == 1) { + # NAMESを初期化 + $ch->names(undef,undef,'clear'); + # NAMREPLY受信中フラグを立てる + $this->{receiving_namreply}->{$msg->param(2)} = 1; + } + + if (defined $ch) { + # @なら+s,*なら+p、=ならそのどちらでもない事が確定している。 + my $ch_property = $msg->param(1); + if ($ch_property eq '@') { + $ch->switches('s',1); + $ch->switches('p',undef,'delete'); + } + elsif ($ch_property eq '*') { + $ch->switches('s',undef,'delete'); + $ch->switches('p',1); + } + else { + $ch->switches('s',undef,'delete'); + $ch->switches('p',undef,'delete'); + } + + my @people = map { + m/^([@\+]{0,2})(.+)$/; + my ($mode,$nick) = ($1,$2); + + $ch->names($nick, + new PersonInChannel( + $this->person($nick), + index($mode,"@") != -1, + index($mode,"+") != -1)); + } split(/ /,$msg->param(3)); + } +} + +sub _RPL_ENDOFNAMES { + my ($this,$msg) = @_; + delete $this->{receiving_namreply}->{$msg->param(1)}; +} + +sub _RPL_WHOISUSER { + my ($this,$msg) = @_; + my $p = $this->{people}->{$msg->param(1)}; + if (defined $p) { + $p->username($msg->param(2)); + $p->userhost($msg->param(3)); + $p->realname($msg->param(5)); + $this->_START_WHOIS_REPLY($p); + } +} + +sub _START_WHOIS_REPLY { + my ($this,$p) = @_; + $p->remark('wait-rpl_away', 1); +} + +sub _RPL_ENDOFWHOIS { + my ($this,$msg) = @_; + my $p = $this->{people}->{$msg->param(1)}; + if (defined $p) { + if ($p->remark('wait-rpl_away')) { + $p->remark('wait-rpl_away', 0); + $p->away(''); + } + } +} + +sub _RPL_AWAY { + my ($this,$msg) = @_; + my $p = $this->{people}->{$msg->param(1)}; + if (defined $p) { + $p->remark('wait-rpl_away', 0); + $p->away($msg->param(2)); + } +} + +sub _RPL_WHOISSERVER { + my ($this,$msg) = @_; + my $p = $this->{people}->{$msg->param(1)}; + if (defined $p) { + $p->server($msg->param(2)); + } +} + +sub _RPL_NOTOPIC { + my ($this,$msg) = @_; + my $ch = $this->channel($msg->param(1)); + if (defined $ch) { + $ch->topic(''); + } +} + +sub _RPL_TOPIC { + my ($this,$msg) = @_; + my $ch = $this->channel($msg->param(1)); + if (defined $ch) { + $ch->topic($msg->param(2)); + } +} + +sub _RPL_TOPICWHOTIME { + my ($this,$msg) = @_; + my $ch = $this->channel($msg->param(1)); + if (defined $ch) { + $ch->topic_who($msg->param(2)); + $ch->topic_time($msg->param(3)); + } +} + +sub _RPL_CREATIONTIME { + my ($this,$msg) = @_; + my $ch = $this->channel($msg->param(1)); + if (defined $ch) { + $ch->remark('creation-time', $msg->param(2)); + } +} + +sub _RPL_INVITELIST { + my ($this,$msg) = @_; + my $ch = $this->channel($msg->param(1)); + + my $receiving_invitelist = $this->{receiving_invitelist}->{$msg->param(1)}; + if (defined $receiving_invitelist && + $receiving_invitelist == 1) { + # +Iリストを初期化 + $ch->invitelist(undef,undef,'clear'); + # INVITELIST受信中フラグを立てる + $this->{receiving_invitelist}->{$msg->param(1)} = 1; + } + + if (defined $ch) { + # 重複防止のため、一旦deleteしてからadd。 + $ch->invitelist('delete',$msg->param(2)); + $ch->invitelist('add',$msg->param(2)); + } +} + +sub _RPL_ENDOFINVITELIST { + my ($this,$msg) = @_; + delete $this->{receiving_invitelist}->{$msg->param(1)}; +} + +sub _RPL_EXCEPTLIST { + my ($this,$msg) = @_; + my $ch = $this->channel($msg->param(1)); + + my $receiving_exceptlist = $this->{receiving_exceptlist}->{$msg->param(1)}; + if (defined $receiving_exceptlist && + $receiving_exceptlist == 1) { + # +eリストを初期化 + $ch->exceptionlist(undef,undef,'clear'); + # EXCEPTLIST受信中フラグを立てる + $this->{receiving_exceptlist}->{$msg->param(1)} = 1; + } + + if (defined $ch) { + # 重複防止のため、一旦deleteしてからadd。 + $ch->exceptionlist('delete',$msg->param(2)); + $ch->exceptionlist('add',$msg->param(2)); + } +} + +sub _RPL_ENDOFEXCEPTLIST { + my ($this,$msg) = @_; + delete $this->{receiving_exceptlist}->{$msg->param(1)}; +} + +sub _RPL_BANLIST { + my ($this,$msg) = @_; + my $ch = $this->channel($msg->param(1)); + + my $receiving_banlist = $this->{receiving_banlist}->{$msg->param(1)}; + if (defined $receiving_banlist && + $receiving_banlist == 1) { + # +bリストを初期化 + $ch->banlist(undef,undef,'clear'); + # BANLIST受信中フラグを立てる + $this->{receiving_banlist}->{$msg->param(1)} = 1; + } + + if (defined $ch) { + # 重複防止のため、一旦deleteしてからadd。 + $ch->banlist('delete',$msg->param(2)); + $ch->banlist('add',$msg->param(2)); + } +} + +sub _RPL_ENDOFBANLIST { + my ($this,$msg) = @_; + delete $this->{receiving_banlist}->{$msg->param(1)}; +} + +sub _RPL_WHOREPLY { + my ($this,$msg) = @_; + my $p = $this->{people}->{$msg->param(5)}; + if (defined $p) { + $p->username($msg->param(2)); + $p->userhost($msg->param(3)); + $p->server($msg->param(4)); + $p->realname((split / /,$msg->param(7),2)[1]); + if ($msg->param(6) =~ /^G/) { + $p->away('Gone.'); + } else { + $p->away(''); + } + my $hops = $this->remark('server-hops') || {}; + $hops->{$p->server} = (split / /,$msg->param(7),2)[0]; + $this->remark('server-hops', $hops); + } + + #use Data::Dumper; + #open(LOG,"> log.txt"); + #print LOG "------- people --------\n"; + #print LOG Dumper($this->{people}),"\n"; + #print LOG "------- channels --------\n"; + #print LOG Dumper($this->{channels}),"\n"; + #close(LOG); +} + +sub _RPL_CHANNELMODEIS { + my ($this,$msg) = @_; + # 既知のチャンネルなら、そのチャンネルに + # switches-are-known => 1という備考を付ける。 + my $ch = $this->channel($msg->param(1)); + if (defined $ch) { + $ch->remarks('switches-are-known',1); + + # switches と parameters は必ず得られると仮定して、クリア処理を行う + $ch->switches(undef, undef, 'clear'); + $ch->parameters(undef, undef, 'clear'); + } + + # 鯖がMODEを実行したことにして、_MODEに処理を代行させる。 + my @args = @{$msg->params}; + @args = @args[1 .. $#args]; + + $this->_MODE( + new IRCMessage(Prefix => $msg->prefix, + Command => 'MODE', + Params => \@args)); +} + +sub _RPL_ISUPPORT { + # 歴史的な理由で、 RPL_ISUPPORT(005) は + # RPL_BOUNCE(005) として使われていることがある。 + my ($this,$msg) = @_; + if ($msg->n_params >= 2 && # nick + [params] + 'are supported by this server' + $msg->param($msg->n_params - 1) =~ /supported/i) { + foreach my $param ((@{$msg->params})[1...($msg->n_params - 2)]) { + my ($negate, $key, $value) = $param =~ /^(-)?([[:alnum:]]+)(?:=(.+))?$/; + if (!defined $negate) { + # empty value + $value = '' unless defined $value; + $this->{isupport}->{$key} = $value; + } elsif (!defined $value) { + # negate a previously specified parameter + delete $this->{isupport}->{$key}; + } else { + # inconsistency param + carp("inconsistency RPL_ISUPPORT param: $param"); + } + } + } +} + +sub _RPL_YOURID { + my ($this,$msg) = @_; + + $this->remark('uid', $msg->param(1)); +} + +sub _handle_fix_nick { + my ($this, $type, $msg) = @_; + # 接続時以外のnick重複を処理します。 + my $mode = $this->config_local_or_general('nick-fix-mode'); + + if ($mode == 0) { + # 常に Tiarra が処理します。 + + $this->_set_to_next_nick($msg->param(1)); + return undef; + } elsif ($mode == 1) { + # クライアントにそのまま投げます。 + # 複数のクライアントが nick 重複を処理する場合は非常に危険です。 + # (設定不足の IRC クライアントが複数つながっている場合も含みます) + return $msg; + } elsif ($mode == 2) { + # 対応するエラーメッセージ付きの NOTICE に変換して、 + # クライアントに投げます。 + + my $new_msg = IRCMessage->new( + Prefix => $this->_runloop->sysmsg_prefix(qw(priv nick::system)), + Command => 'NOTICE', + Params => [$this->_runloop->current_nick, + ''], + ); + if ($msg->command eq ERR_NICKNAMEINUSE) { + $new_msg->param(1, 'Nickname is already in use: ' . + $msg->param(1)); + } elsif ($msg->command eq ERR_UNAVAILRESOURCE) { + $new_msg->param(1, 'Nick/channel is temporarily unavailable: ' . + $msg->param(1)); + } else { + return $msg; + } + return $new_msg; + } +} + +sub _set_to_next_nick { + my ($this,$failed_nick) = @_; + # failed_nickの次のnickを試します。nick重複でログインに失敗した時に使います。 + my $next_nick = modify_nick($failed_nick, $this->isupport->{NICKLEN}); + + my $msg_for_user = "Nick $failed_nick was already in use in the ".$this->network_name.". Trying ".$next_nick."..."; + $this->send_message( + new IRCMessage( + Command => 'NICK', + Param => $next_nick)); + $this->_runloop->broadcast_to_clients( + new IRCMessage( + Prefix => $this->_runloop->sysmsg_prefix(qw(priv nick::system)), + Command => 'NOTICE', + Params => [$this->_runloop->current_nick,$msg_for_user])); + $this->printmsg($msg_for_user); +} + +sub modify_nick { + my $nick = shift; + my $nicklen = shift || 9; + + if ($nick =~ /^(.*\D)?(\d+)$/) { + # 最後の数文字が数字だったら、それをインクリメント + my $base = $1; + my $next_num = $2 + 1; + if (($next_num - 1) eq $next_num) { + # 桁あふれしているので数字部分を全部消す。 + $nick = $base; + } elsif (length($base . $next_num) <= $nicklen) { + # $nicklen 文字以内に収まるのでこれで試す。 + $nick = $base . $next_num; + } + else { + # 収まらないので $nicklen 文字に縮める。 + $nick = substr($base,0,$nicklen - length($next_num)) . $next_num; + } + } + elsif ($nick =~ /_$/ && length($nick) >= $nicklen) { + # 最後の文字が_で、それ以上_を付けられない場合、それを0に。 + $nick =~ s/_$/0/; + } + else { + # 最後に_を付ける。 + if (length($nick) >= $nicklen) { + $nick =~ s/.$/_/; + } + else { + $nick .= '_'; + } + } + return $nick; +} + +1; diff -urN /non-existant-dir/main/IrcIO.pm tiarra-20050322/main/IrcIO.pm --- /non-existant-dir/main/IrcIO.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/IrcIO.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,140 @@ +# ----------------------------------------------------------------------------- +# $Id: IrcIO.pm 749 2005-02-16 01:21:44Z topia $ +# ----------------------------------------------------------------------------- +# IrcIOはIRCサーバー又はクライアントと接続し、IRCメッセージをやり取りする抽象クラスです。 +# ----------------------------------------------------------------------------- +package IrcIO; +use strict; +use warnings; +use Carp; +use Configuration; +use IRCMessage; +use Exception; +use Tiarra::ShorthandConfMixin; +use Tiarra::Utils; +use Tiarra::Socket::Buffered; +use base qw(Tiarra::Socket::Buffered); +utils->define_attr_getter(0, [qw(_runloop runloop)]); + +sub new { + my ($class, $runloop, %opts) = @_; + carp 'runloop is not specified!' unless defined $runloop; + $class->_increment_caller('ircio', \%opts); + my $this = $class->SUPER::new(runloop => $runloop, %opts); + $this->{recv_queue} = []; + $this->{remarks} = {}; + $this; +} + +sub server_p { + shift->isa('IrcIO::Server'); +} + +sub client_p { + shift->isa('IrcIO::Client'); +} + +*remarks = \&remark; +sub remark { + my ($this,$key,$newvalue) = @_; + if (!defined $key) { + croak "IrcIO->remark, Arg[1] is undef.\n"; + } + elsif (defined $newvalue) { + $this->{remarks}->{$key} = $newvalue; + } + elsif (@_ >= 3) { + delete $this->{remarks}{$key}; + } + $this->{remarks}->{$key}; +} + +sub send_message { + my ($this,$msg,$encoding) = @_; + # データを送るように予約する。ソケットの送信の準備が整っていなくてもブロックしない。 + + # msgは生の文字列でも良いしIRCMessageのインスタンスでも良い。 + # 生の文字列を渡す時には、末尾にCRLFを付けてはならない。 + # また、生の文字列については文字コードの変換が行なわれない。 + my $data_to_send = ''; + if (ref($msg) eq '') { + # deprecated. + # FIXME: warnすべきだろうか。 + $data_to_send = "$msg\x0d\x0a"; + } + elsif ($msg->isa('IRCMessage')) { + # message_io_hook + my $filtered = $this->_runloop->apply_filters( + [$msg], 'message_io_hook', $this, 'out'); + foreach (@$filtered) { + $data_to_send .= $_->serialize($encoding)."\x0d\x0a"; + } + #$data_to_send = $msg->serialize($encoding)."\x0d\x0a"; + } + else { + die "IrcIO::send_message : parameter msg was invalid; $msg\n"; + } + + if ($this->connected) { + $this->append($data_to_send); + } + else { + die "IrcIO::send_message : socket is not connected.\n"; + } +} + +sub read { + my ($this,$encoding) = @_; + # このメソッドはIRCメッセージを一行ずつ受け取り、IRCMessageのインスタンスをキューに溜めます。 + # ソケットに読めるデータが来ていなかった場合、このメソッドは読めるようになるまで + # 操作をブロックします。それがまずい場合は予めselectで読める事を確認しておいて下さい。 + # このメソッドを実行したことで始めてソケットが閉じられた事が分かった場合は、 + # メソッド実行後からはconnectedメソッドが偽を返すようになります。 + + $this->SUPER::read; + + while (1) { + # CRLFまたはLFが行の終わり。 + my $newline_pos = index($this->recvbuf,"\x0a"); + if ($newline_pos == -1) { + # 一行分のデータが届いていない。 + last; + } + + my $current_line = substr($this->recvbuf,0,$newline_pos); + $this->recvbuf(substr($this->recvbuf,$newline_pos+1)); + + # CRLFだった場合、末尾にCRが付いているので取る。 + $current_line =~ s/\x0d$//; + + if (CORE::length($current_line) == 0) { + # 空行はスキップ + next; + } + + # message_io_hook + my $msg = IRCMessage->new( + Line => $current_line, Encoding => $encoding); + my $filtered = $this->_runloop->apply_filters( + [$msg], 'message_io_hook', $this, 'in'); + + foreach (@$filtered) { + $_->purge_raw_params; + push @{$this->{recv_queue}}, $_; + } + } +} + +sub pop_queue { + # このメソッドは受信キュー内の最も古いものを取り出します。 + # キューが空ならQueueIsEmptyExceptionを投げます。 + my ($this) = @_; + if (@{$this->{recv_queue}} == 0) { + QueueIsEmptyException->new->throw; + } + else { + return shift @{$this->{recv_queue}}; + } +} + +1; diff -urN /non-existant-dir/main/Iterator/ArrayIterator.pm tiarra-20050322/main/Iterator/ArrayIterator.pm --- /non-existant-dir/main/Iterator/ArrayIterator.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Iterator/ArrayIterator.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,79 @@ +# ----------------------------------------------------------------------------- +# Iterator::ArrayIterator +# ----------------------------------------------------------------------------- +# $Id: ArrayIterator.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# このクラスは配列の値を順番に指すイテレータです。 +# ランダムアクセス可能ですが、巡回は出来ません。 +# +# 情報源としての配列そのものは、このイテレータは保持しません。 +# その代わりに配列への参照を保持します。 +# つまり、このイテレータを使用中に情報源の配列が変化すると +# イテレータの状態も変化します。 +# ----------------------------------------------------------------------------- +package Iterator::ArrayIterator; +use strict; +use warnings; +use base qw(Iterator::RandomAccessIterator); + +sub new { + my ($class,$src_array) = @_; + my $obj = { + source => $src_array, + current_index => 0, # 作られた時にはイテレータは先頭の要素を指している。 + }; + bless $obj,$class; +} + +sub _increment { + my $this = shift; + if (exists $this->{source}->[$this->{current_index}]) { + # 今回はまだ要素が残っている。インクリメントしても要素があるか、または初めてundefになる。 + $this->{current_index}++; + } + else { + # 今回で既にundefを指している。これ以上進めない。 + die "Iterator::ArrayIterator::increment : operation ++ failed. no more elements in this iterator.\n"; + } + $this; +} + +sub _decrement { + my $this = shift; + if ($this->{current_index} > -1) { + $this->{current_index}--; + } + else { + die "Iterator::ArrayIterator::decrement : operation -- failed. iterator pointed at element indexed -1.\n"; + } + $this; +} + +sub _addition { + my ($this,$value) = @_; + my $result = ref($this)->new($this->{source}); + $result->{current_index} = $this->{current_index} + $value; + return $result; +} + +sub _subtract { + my ($this,$value) = @_; + return $this->_addition(-$value); +} + +sub _add_to { + my ($this,$value) = @_; + $this->{current_index} += $value; + return $this; +} + +sub _sub_from { + my ($this,$value) = @_; + return $this->_add_to(-$value); +} + +sub get { + $_[0]->{source}->[$_[0]->{current_index}]; +} + +1; diff -urN /non-existant-dir/main/Iterator/BackwardIterator.pm tiarra-20050322/main/Iterator/BackwardIterator.pm --- /non-existant-dir/main/Iterator/BackwardIterator.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Iterator/BackwardIterator.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,23 @@ +# ----------------------------------------------------------------------------- +# Iterator::BackwardIterator +# ----------------------------------------------------------------------------- +# $Id: BackwardIterator.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# これらのクラスはそれぞれの操作が行なえる事を示すために用いられる抽象クラスです。 +# インスタンスを生成する事は出来ません。 +# ----------------------------------------------------------------------------- +package Iterator::BackwardIterator; +use strict; +use warnings; +use base qw(Iterator); +use overload + '--' => \&_ope_decrement; + +sub _ope_decrement { + $_[0]->_decrement; +} +sub _decrement { + die "BackwardIterator has to override decrement().\n"; +} + +1; diff -urN /non-existant-dir/main/Iterator/BidirectionalIterator.pm tiarra-20050322/main/Iterator/BidirectionalIterator.pm --- /non-existant-dir/main/Iterator/BidirectionalIterator.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Iterator/BidirectionalIterator.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,13 @@ +# ----------------------------------------------------------------------------- +# Iterator::BidirectionalIterator +# ----------------------------------------------------------------------------- +# $Id: BidirectionalIterator.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# これらのクラスはそれぞれの操作が行なえる事を示すために用いられる抽象クラスです。 +# インスタンスを生成する事は出来ません。 +# ----------------------------------------------------------------------------- +package Iterator::BidirectionalIterator; +use strict; +use warnings; +use base qw(Iterator::ForwardIterator Iterator::BackwardIterator); +1; diff -urN /non-existant-dir/main/Iterator/ForwardIterator.pm tiarra-20050322/main/Iterator/ForwardIterator.pm --- /non-existant-dir/main/Iterator/ForwardIterator.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Iterator/ForwardIterator.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,23 @@ +# ----------------------------------------------------------------------------- +# Iterator::ForwardIterator +# ----------------------------------------------------------------------------- +# $Id: ForwardIterator.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# これらのクラスはそれぞれの操作が行なえる事を示すために用いられる抽象クラスです。 +# インスタンスを生成する事は出来ません。 +# ----------------------------------------------------------------------------- +package Iterator::ForwardIterator; +use strict; +use warnings; +use base qw(Iterator); +use overload + '++' => \&_ope_increment; + +sub _ope_increment { + $_[0]->_increment; +} +sub _increment { + die "ForwardIterator has to override _increment().\n"; +} + +1; diff -urN /non-existant-dir/main/Iterator/RandomAccessIterator.pm tiarra-20050322/main/Iterator/RandomAccessIterator.pm --- /non-existant-dir/main/Iterator/RandomAccessIterator.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Iterator/RandomAccessIterator.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,58 @@ +# ----------------------------------------------------------------------------- +# Iterator::RandomAccessIterator +# ----------------------------------------------------------------------------- +# $Id: RandomAccessIterator.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# これらのクラスはそれぞれの操作が行なえる事を示すために用いられる抽象クラスです。 +# インスタンスを生成する事は出来ません。 +# ----------------------------------------------------------------------------- +package Iterator::RandomAccessIterator; +use strict; +use warnings; +use base qw(Iterator::BidirectionalIterator); +use overload + '+' => \&_ope_addition, + '-' => \&_ope_subtract, + '+=' => \&_ope_add_to, + '-=' => \&_ope_sub_from; + +sub _ope_addition { + my ($this,$value) = @_; + $this->_addition($value); +} +sub _addition { + die "RandomAccessIterator has to implement addition().\n"; +} + +sub _ope_subtract { + my ($this,$value,$inverted) = @_; + if ($inverted) { + # $ite - 1はサポートされているが、1 - $iteはサポートされていない。 + die "Iterator::RandomAccessIterator : statement 'n - \$ite' is invalid.\n"; + } + else { + $this->_subtract($value); + } +} +sub subtract { + die "RandomAccessIterator has to implement subtract().\n"; +} + +sub _ope_add_to { + my ($this,$value) = @_; + $this->_add_to($value); +} +sub _add_to { + die "RandomAccessIterator has to implement add_to().\n"; +} + +sub _ope_sub_from { + my ($this,$value) = @_; + $this->_sub_from($value); +} +sub _sub_from { + die "RandomAccessIterator has to implement sub_from().\n"; +} + +1; + diff -urN /non-existant-dir/main/Iterator/RoundIterator.pm tiarra-20050322/main/Iterator/RoundIterator.pm --- /non-existant-dir/main/Iterator/RoundIterator.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Iterator/RoundIterator.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,11 @@ +# ----------------------------------------------------------------------------- +# Iterator::RoundIterator; +# ----------------------------------------------------------------------------- +# $Id: RoundIterator.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# これらのクラスはそれぞれの操作が行なえる事を示すために用いられる抽象クラスです。 +# インスタンスを生成する事は出来ません。 +# ----------------------------------------------------------------------------- +package Iterator::RoundIterator; +1; + diff -urN /non-existant-dir/main/Iterator.pm tiarra-20050322/main/Iterator.pm --- /non-existant-dir/main/Iterator.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Iterator.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,47 @@ +# ----------------------------------------------------------------------------- +# Iterator for the perl +# ----------------------------------------------------------------------------- +# $Id: Iterator.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# STLに似せて作られたイテレータです。 +# イテレータは次の操作が可能です。 +# ----------------------------------------------------------------------------- +# $ite->get +# イテレータが現在指している値を返します。 +# 例えば$iteが現在IO::Fileのオブジェクトを指している場合、 +# $ite->get->close;のような操作が可能です。 +# +# この値取得メソッドは、そのイテレータが既に終端に達していた場合、 +# つまりもう返すべき値が無くなっている場合はundefを返します。 +# (ただし後述するようにイテレータがRoundIteratorだった場合は、 +# 要素が一つも無かった場合を除いて決してundefを返しません。 +# ----------------------------------------------------------------------------- +# $ite++ +# $ite-- +# それぞれイテレータに次と前の値を指させます。 +# ただし前者はForwardIterator、後者はBackwardIteratorを +# それぞれインプリメントしていなければ使えません。(無理に使おうとすると実行時エラーになります) +# 両方の操作が出来るイテレータはBidirectionalIteratorをインプリメントしています。 +# 既に先端または終端に来ており$ite->get()がundefを返すような状態のイテレータに対し +# これらの操作を行なって限界からさらに外れようとした場合、そのイテレータが +# RoundIteratorを実装していた場合は逆の位置へ行きますが、そうでない場合はdieします。 +# +# $ite + 1 +# $ite - 2 +# それぞれこのイテレータの次の値と前の前の値を指すイテレータを生成して返します。 +# ただしこれらはRandomAccessIteratorをインプリメントしていなければ使えません。 +# これらの操作によって限界を突破した場合は、RoundIteratorを実装していれば +# 反対側へ行きますが、そうでなければdieします。 +# ----------------------------------------------------------------------------- +# このクラスは全てのイテレータを表わす抽象クラスです。 +# インスタンスを生成する事は出来ません。 +# ----------------------------------------------------------------------------- +package Iterator; +use strict; +use warnings; + +sub get { + die "Iterator has to override get().\n"; +} + +1; diff -urN /non-existant-dir/main/L10N.pm tiarra-20050322/main/L10N.pm --- /non-existant-dir/main/L10N.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/L10N.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,121 @@ +# ----------------------------------------------------------------------------- +# $Id: L10N.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# メッセージのローカライズを行う為のクラス。 +# このクラスはTiarraの他のクラスに依存しません。 +# ----------------------------------------------------------------------------- +# 使い方: +# +# ----------------------------------------------------------------------------- +package L10N; +use strict; +use warnings; +use Carp; +# 指定された言語が見付からない場合に、優先して選ばれる言語。 +our $secondary_language = 'en'; + +# {パッケージ名 => L10N} +our %instances; +sub _instance { + my $this = shift; + if (ref $this) { + # そのまま + $this; + } + else { + # 二つ前のcallerのパッケージに対してのインスタンスを返す。 + my ($pkg) = caller(1); + my $in = $instances{$pkg}; + if (!defined $in) { + $in = $instances{$pkg} = L10N->new($pkg); + } + $in; + } +} + +# 言語名省略時に選ばれる言語 +our $default_language = 'ja'; +sub default_language { + if (@_ == 0) { + $default_language; + } + elsif (@_ == 1) { + $default_language = $_[0]; + } + else { + $default_language = $_[1]; + } +} + +sub instance { + my $this = _instance(shift); +} + +*reg = \®ister; +sub register { + my ($this, %args) = @_; + $this = _instance($this); + + while (my ($key, $value) = each %args) { + $this->{messages}{$key} = $value; + } + $this; +} + +sub new { + my ($class, $pkg_name) = @_; + my $this = { + pkg_name => $pkg_name, + messages => {}, # {メッセージ名 => {言語名 => メッセージ}} + }; + bless $this => $class; +} + +sub get { + my ($this, $key, $lang) = @_; + $this = _instance($this); + if (!defined $key) { + return $this->_new_autoload; + } + + $lang = $default_language if !defined $lang; + + my $msg_langs = $this->{messages}{$key}; + if (defined $msg_langs) { + my $msg = $msg_langs->{$lang}; + if (defined $msg) { + $msg; + } + elsif (defined($_ = $msg_langs->{$secondary_language})) { + $_; + } + else { + (values %$msg_langs)[0]; + } + } + else { + undef; + } +} + +# ----------------------------------------------------------------------------- +package L10N::Autoload; +our $AUTOLOAD; + +sub AUTOLOAD { + my ($this, $lang) = @_; + if ($AUTOLOAD =~ /::DESTROY$/) { + return; + } + + (my $key = $AUTOLOAD) =~ s/.+?:://g; + $this->{l10n}->get($key, $lang); +} + +package L10N; +sub _new_autoload { + my $this = shift; + bless {l10n => $this} => 'L10N::Autoload'; +} + +1; diff -urN /non-existant-dir/main/LinedINETSocket.pm tiarra-20050322/main/LinedINETSocket.pm --- /non-existant-dir/main/LinedINETSocket.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/LinedINETSocket.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,87 @@ +# ----------------------------------------------------------------------------- +# $Id: LinedINETSocket.pm 780 2005-02-24 15:02:10Z topia $ +# ----------------------------------------------------------------------------- +# Lined IO Socket +# ----------------------------------------------------------------------------- +# copyright (C) 2003-2004 Topia . all rights reserved. +# this module based IrcIO.pm, thanks phonohawk! +package LinedINETSocket; +use strict; +use warnings; +use IO::Socket::INET; +use Tiarra::Utils; +use Tiarra::Socket::Lined; +use base qw(Tiarra::Socket::Lined); + +use SelfLoader; +SelfLoader->load_stubs; +1; +__DATA__ + +# 行単位の入出力を行うINET-tcpソケットです。 +# read, writeはRunLoopによって自動的に行われる他、 +# pop_queueの実行前とflushによっても実行されます。 + +# newでeolを指定することによって、 +# CRLF,LF,CR,またはNULLなど、さまざまな行終端文字が使用できます。 +# 省略した場合はCRLFを使用します。 +# callback を指定すると disconnect 時に callback method が呼ばれます。 +# $callback->($genre, $errno), $genre は read, write, exception, eof, もしくは +# undef で、 eof や undef の時には errno はありません。 + +sub new { + my ($class, $eol, $callback) = @_; + + my $this = $class->SUPER::new( + _caller => 1, + _subject => 'lined-inet-socket', + eol => $eol, + ); + $this->{disconnect_callback} = $callback + if defined ref($callback) && + ref($callback) eq 'CODE'; + $this; +} + +sub disconnect { + my ($this, $errno, $genre, @params) = @_; + $this->SUPER::disconnect($errno, $genre, @params); + if (defined $this->{disconnect_callback}) { + $this->{disconnect_callback}->($errno, $genre); + } +} + +sub connect { + # 接続先ホストとポートを指定して接続を行なう。 + my ($this, $host, $port) = @_; + return if $this->connected; + + # ソケットを開く。開けなかったらundef。 + my $sock = new IO::Socket::INET(PeerAddr => $host, + PeerPort => $port, + Proto => 'tcp', + Timeout => 5); + $this->attach($sock); +} + +sub attach { + my $this = shift; + $this->SUPER::attach(@_); + $this->install; +} + +sub length { shift->write_length; } + +sub send_reserve { + my ($this, $string) = @_; + # 文字列を送るように予約する。ソケットの送信の準備が整っていなくてもブロックしない。 + # CRLFはつけてはならない。 + + if ($this->sock) { + $this->append_line($string); + } else { + die "LinedINETSocket::send_reserve : socket is not connected."; + } +} + +1; diff -urN /non-existant-dir/main/LocalChannelManager.pm tiarra-20050322/main/LocalChannelManager.pm --- /non-existant-dir/main/LocalChannelManager.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/LocalChannelManager.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,146 @@ +# ----------------------------------------------------------------------------- +# $Id: LocalChannelManager.pm 542 2004-09-11 08:26:06Z topia $ +# ----------------------------------------------------------------------------- +# このクラスはTiarraローカルなチャンネルを管理します。 +# 各クライアントに、そのクライアントが入っているTiarraローカルチャンネルを +# 註釈`tiarra-local-channels'として持たせます。 +# この註釈はチャンネル名の配列です。 +# ----------------------------------------------------------------------------- +# 使い方: +# +# ----------------------------------------------------------------------------- +package LocalChannelManager; +use strict; +use warnings; +use Carp; +use Tiarra::SharedMixin; +our $_shared_instance; + +sub _new { + my $class = shift; + my $this = { + registered => {}, # {チャンネル名 => [トピック(文字列), ハンドラ(クロージャ)]} + }; + bless $this => $class; +} + +sub register { + # Name => チャンネル名 + # Topic => トピック + # Handler => ハンドラ; $handler->($client, $msg)のように呼ばれる。 + my ($class_or_this, %args) = @_; + my $this = $class_or_this->_this; + + foreach my $arg (qw/Name Topic Handler/) { + if (!defined $args{$arg}) { + croak "LocalChannelManager->register, Arg{Name} is undef.\n"; + } + } + if (ref($args{Handler}) ne 'CODE') { + croak "LocalChannelManager->register, Arg{Handler} is not a function.\n"; + } + + if (defined $this->{registered}{$args{Name}}) { + croak "LocalChannelManager->register, channel `$args{Name}' is already registered.\n"; + } + + $this->{registered}{$args{Name}} = [@args{'Topic', 'Handler'}]; + $this; +} + +sub unregister { + my ($class_or_this, $channel) = @_; + my $this = $class_or_this->_this; + + delete $this->{registered}{$channel}; + $this; +} + +sub registered_p { + my ($class_or_this, $channel) = @_; + my $this = $class_or_this->_this; + + defined $this->{registered}{$channel}; +} + +sub message_arrived { + # IRCMessageまたはundefを返す。 + my ($class_or_this, $msg, $sender) = @_; + my $this = $class_or_this->_this; + + my $method = '_'.$msg->command; + if ($this->can($method)) { + $this->$method($msg, $sender); + } + else { + $msg; + } +} + +sub _JOIN { + my ($this, $msg, $sender) = @_; + + # チャンネル名のリストから、Tiarraローカルチャンネルを抜き取る。 + my @new_list; + foreach my $ch_name (split m/,/, $msg->param(0)) { + if ($this->registered_p($ch_name)) { + my ($topic, $handler) = @{$this->{registered}{$ch_name}}; + + # このクライアントの`tiarra-local-channels'に入っているか？ + my $list = $sender->remark('tiarra-local-channels'); + if (!defined $list) { + $list = []; + $sender->remark('tiarra-local-channels', $list); + } + if (!{map {$_ => 1} @$list}->{$ch_name}) { + # 入っていないのでJOIN処理を行う。 + push @$list, $ch_name; + + my $local_nick = RunLoop->shared->current_nick; + # まずJOIN + $sender->send_message( + IRCMessage->new( + Prefix => $sender->fullname, + Command => 'JOIN', + Param => $ch_name)); + # 次にRPL_TOPIC(あれば) + if ($topic ne '') { + $sender->send_message( + IRCMessage->new( + Prefix => 'Tiarra', + Command => '332', + Params => [ + $local_nick, + $ch_name, + $topic, + ])); + } + # 次にRPL_NAMREPLY。この本人だけ。 + $sender->send_message( + IRCMessage->new( + Prefix => 'Tiarra', + Command => '353', + Params => [$local_nick, + '=', + $ch_name, + $local_nick])); + # そしてRPL_ENOFNAMES + $sender->send_message( + IRCMessage->new( + Prefix => 'Tiarra', + Command => '366', + Params => [$local_nick, + $ch_name, + 'End of NAMES list'])); + } + } + else { + push @new_list, $ch_name; + } + } + $msg->param(0, join(',', @new_list)); + + $msg; +} + +1; diff -urN /non-existant-dir/main/Mask.pm tiarra-20050322/main/Mask.pm --- /non-existant-dir/main/Mask.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Mask.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,348 @@ +# ----------------------------------------------------------------------------- +# $Id: Mask.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +package Mask; +use strict; +use warnings; +use Carp; +use Multicast; + +sub match { + # matchはワイルドカードを使ったマッチングを行う関数です。 + # ワイルドカード以外にも、+や-を使った除外指定や、 + # re: を使った正規表現マッチングが行えます。 + + # $masksには','(コンマ)で区切ったマッチリストを渡してください。 + # 条件中に','(コンマ)を使いたい場合は'\,'と書けます。 + + # 引数名 : [既定値] - 説明 - + # $match_type : [0] 0: 最後にマッチした値を返します。 1: 最初にマッチした値を返します。 + # $use_re : [1] 0: 正規表現マッチを使用しません。 1: 使用します。 + # $use_flag : [1] 0: +や-を使用しません。 1: 使用します。 + + # 返り値 : { 1 (true) => + にマッチ, + # 0 (false) => - にマッチ, + # (undef) => まったくマッチしなかった + my ($masks, $str, $match_type, $use_re, $use_flag) = @_; + if (!defined $masks || !defined $str) { + return undef; + } + + return match_array([_split($masks)], $str, $match_type, $use_re, $use_flag); +} + +sub match_deep { + # match_deepは次のようなマスクの解釈に使います。 + + # mask: +*!*@* + # mask: -example!* + + # 引数名 : [既定値] - 説明 - + # $masks_array : [無し] マスク配列の参照を渡します。 + # Mask::match_deep([Mask::mask_array_or_all($this->config->mask('all'))], $msg->prefix) + # : のように使います。 + # $global_match_type : [1] 0: 最後にマッチした行の値を返します。 1: 最初にマッチした行の値を返します。 + my ($masks_array, $str, $g_match_type, $match_type, $use_re, $use_flag) = @_; + if (!defined $masks_array) { + return undef; + } + + $g_match_type = 1 unless defined $g_match_type; + + my $g_matched = undef; + foreach my $masks (@$masks_array) { + my $matched = match_array([_split($masks)], $str, $match_type, $use_re, $use_flag); + if (defined $matched) { + $g_matched = $matched; + return $g_matched if $g_match_type == 1; + } + } + + return $g_matched; +} + +sub match_array { + # match_arrayは、matchから呼ばれる内部関数ですが、普通に呼び出して使うこともできます。 + # match との違いは、マスクをマスク配列の参照として渡す点です。 + + # $match_type: 0: last matching rule, 1: first matching rule + # $use_re : use 're:' feature. + # $use_flag : use [+-] match flag. + + # : status { 1 (true) => +, matched, + # 0 (false) => -, matched, + # (undef) => no-match } + my ($mask_array, $str, $match_type, $use_re, $use_flag) = @_; + + if (!defined $mask_array || ref($mask_array) ne 'ARRAY' || !defined $str) { + return undef; + } + + $match_type = 0 unless defined $match_type; + $use_re = 1 unless defined $use_re; + $use_flag = 1 unless defined $use_flag; + + my $matched = undef; + foreach my $part (@$mask_array) { + my $work = $part; + my $first = substr($work, 0, 1); + my $include = 1; + if (!$use_flag) { + # noop + } elsif ($first eq '+') { + substr($work, 0, 1) = ''; + } elsif ($first eq '-') { + $include = 0; + substr($work, 0, 1) = ''; + } + + if ($use_re && substr($work, 0, 3) eq 're:') { + # 正規表現 + $work = substr($work,3); + # untaint + $work =~ /\A(.*)\z/s; + $work = eval { + qr/$1/; + }; if ($@) { + $work = ''; + carp "error in regex: $@"; + } + } else { + $work = make_regex($work); + } + + if ($str =~ m/$work/) { + # マッチした + $matched = $include; + return $matched if $match_type == 1; + } + } + return $matched; +} + + +# channel version +sub match_chan { + my ($masks, $str, $chan, $match_type, $use_re, $use_flag) = @_; + if (!defined $masks || !defined $str) { + return undef; + } + + return match_array_chan(_split_with_chan($masks), $str, $chan, $match_type, $use_re, $use_flag); +} + +sub match_deep_chan { + my ($masks_array, $str, $chan, $g_match_type, $match_type, $use_re, $use_flag) = @_; + if (!defined $masks_array) { + return undef; + } + + $g_match_type = 1 unless defined $g_match_type; + + my $g_matched = undef; + foreach my $masks (@$masks_array) { + my $matched = match_array_chan(_split_with_chan($masks), $str, $chan, $match_type, $use_re, $use_flag); + if (defined $matched) { + $g_matched = $matched; + return $g_matched if $g_match_type == 1; + } + } + + return $g_matched; +} + +my $chanmask_mode = undef; # undefined, +my $CHANMASK_TIARRA = 1; +my $CHANMASK_PLUM = 2; + +# tiarra Configuration check; +sub _check_chanmask_conf { + # configuration を読み、chanmask_mode を決定する。 + use Configuration; + + my $maskmode = Configuration::shared_conf->general->chanmask_mode; + if (defined $maskmode) { + if ($maskmode =~ /plum/i) { + $chanmask_mode = $CHANMASK_PLUM; + } elsif ($maskmode =~ /tiarra/i) { + $chanmask_mode = $CHANMASK_TIARRA; + } else { + ::printmsg('Configure_variable [maskmode] ' . $maskmode . ' is not known... use Tiarra mode.'); + $chanmask_mode = $CHANMASK_TIARRA; + } + } else { + # fallback + $chanmask_mode = $CHANMASK_TIARRA; + } +} + +sub match_array_chan { + # $match_type: 0: last matching rule, 1: first matching rule + # $use_re : use 're:' feature. + # $use_flag : use [+-] match flag. + + # : status { 1 (true) => +, matched, + # 0 (false) => -, matched, + # (undef) => no-match } + my ($usermask_array, $chanmask_array, $str, $chan, $match_type, $use_re, $use_flag) = @_; + + return undef if (!defined $str); + foreach my $var ($usermask_array, $chanmask_array) { + return undef if (!defined $var || ref($var) ne 'ARRAY'); + } + + _check_chanmask_conf() if (!defined($chanmask_mode)); + + my ($chanmask_use_flag); + if ($chanmask_mode == $CHANMASK_TIARRA) { + $chanmask_use_flag = $use_flag; + } elsif ($chanmask_mode == $CHANMASK_PLUM) { + $chanmask_use_flag = 0; + } else { + croak 'chanmask_mode is unsupported value!'; + } + + # channelマッチを行ってからuserマッチを行う。 + # channelマッチではflagは使わない。 + my $matched = undef; + if (Multicast::channel_p($chan)) { + # $chanがchannelの時は普通にマッチ。 + $matched = match_array($chanmask_array, $chan, $match_type, $use_re, $chanmask_use_flag); + } else { + # $chanがchannelでないときはpriv等なので * にマッチさせる。 + $matched = match_array($chanmask_array, '*', $match_type, $use_re, $chanmask_use_flag); + } + + $matched = undef unless $matched; # matchしなかったらundefを代入する + # channelでマッチしなかったらこの行は無視する。 + if (defined $matched) { + $matched = undef; + $matched = match_array($usermask_array, $str, $match_type, $use_re, $use_flag); + } + + return $matched; +} + +# support functions +my $cache_limit = 150; +my @cache_keys; +my %cache_table; +sub make_regex { + my $str = $_[0]; + + if (my $cached = $cache_table{$str}) { + $cached; + } + else { + # キャッシュされていない。 + if (@cache_keys >= $cache_limit) { + # キャッシュされている値をランダムに一つ消す。 + my $to_delete = scalar(splice @cache_keys, int(rand @cache_keys), 1); + delete $cache_table{$to_delete}; + } + + my $compiled = compile($str); + push @cache_keys, $str; + $cache_table{$str} = $compiled; + + $compiled; + } +} + +sub compile { + # $mask: マスク文字列 + # $consider_case: 真なら、大文字小文字を区別する。 + my ($mask, $consider_case) = @_; + + if (!defined $mask) { + return qr/(?!)/; # マッチしない正規表現 + } + + my $regex = $mask; + $regex =~ s/(\W)/\\$1/g; + $regex =~ s/\\\?/\./g; + $regex =~ s/\\\*/\.\*/g; + $regex = "^$regex\$"; + if ($consider_case) { + qr/$regex/; + } + else { + qr/$regex/i; + } +} + +sub _split { + # ',' でわけられたマスクを配列にする。 + my $mask = shift; + return () if !defined $mask; + + return map { + s/\\,/,/g; + $_; + } split /(?shared_manager; + foreach (@modules) { + $mod_manager->timestamp($_,time); + } + } +} + +1; diff -urN /non-existant-dir/main/Module.pm tiarra-20050322/main/Module.pm --- /non-existant-dir/main/Module.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Module.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,145 @@ +# ----------------------------------------------------------------------------- +# $Id: Module.pm 847 2005-03-21 10:38:56Z topia $ +# ----------------------------------------------------------------------------- +# Tiarraモジュール(プラグイン)を表わす抽象クラスです。 +# 全てのTiarraモジュールはこのクラスを継承し、 +# 必要なメソッドをオーバーライドしなければなりません。 +# ----------------------------------------------------------------------------- +package Module; +use strict; +use warnings; +use Carp; +use Tiarra::ShorthandConfMixin; +use Tiarra::Utils; +# our @USES = (); +Tiarra::Utils->define_attr_getter(0, [qw(_runloop runloop)]); + +sub new { + my ($class, $runloop) = @_; + if (!defined $runloop) { + carp 'please update module constructor; see Skelton.pm'; + $runloop = RunLoop->shared; + } + # モジュールが必要になった時に呼ばれる。 + # これはモジュールのコンストラクタである。 + # 引数は無し。 + bless { + runloop => $runloop, + },$class; # デフォルトではモジュールはフィールドを持たない。 +} + +sub destruct { + my $this = shift; + # モジュールが不要になった時に呼ばれる。 + # これはモジュールのデストラクタである。このメソッドが呼ばれた後はDESTROYを除いて + # いかなるメソッドも呼ばれる事が無い。タイマーを登録した場合は、このメソッドが + # 責任を持ってそれを解除しなければならない。 + # 引数は無し。 +} + +sub message_arrived { + my ($this,$message,$sender) = @_; + # サーバーまたはクライアントからメッセージが来た時に呼ばれる。 + # 戻り値はIRCMessageまたはその配列またはundef。 + # + # $message : + # 内容: IRCMessageオブジェクト + # サーバーから、またはクライアントから送られてきたメッセージ。 + # モジュールはこのオブジェクトをそのまま返しても良いし、 + # 改変して返しても良いし何も返さなくても良いし二つ以上返しても良い。 + # $sender : + # 内容: IrcIOオブジェクト + # このメッセージを発したIrcIO。サーバーまたはクライアントである。 + # メッセージがサーバーから来たのかクライアントから来たのかは + # $sender->isa('IrcIO::Server')などとすれば判定出来る。 + # + # サーバー→クライアントの流れでも、Prefixを持たないメッセージを + # 流しても構わない。逆に言えば、そのようなメッセージが来ても + # 問題が起こらないようにモジュールを設計しなければならない。 + return $message; +} + +sub client_attached { + my ($this,$client) = @_; + # クライアントが新規に接続した時に呼ばれる。 + # 戻り値は無し。 + # + # $client : + # 内容: IrcIO::Clientオブジェクト + # 接続されたクライアント。 +} + +sub client_detached { + my ($this,$client) = @_; + # クライアントが切断した時に呼ばれる。 + # 戻り値は無し。 + # + # $client : + # 内容: IrcIO::Clientオブジェクト + # 切断したクライアント。 +} + +sub connected_to_server { + my ($this,$server,$new_connection) = @_; + # サーバーに接続した時に呼ばれる。 + # 戻り値は無し。 + # + # $server : + # 内容: IrcIO::Serverオブジェクト + # 接続したサーバー。 + # $new_connection : + # 内容: 真偽値 + # 新規の接続なら1。切断後の自動接続ではundef。 +} + +sub disconnected_from_server { + my ($this,$server) = @_; + # サーバーから切断した(或いはされた)時に呼ばれる。 + # 戻り値は無し。 + # + # $server : + # 内容: IrcIO::Serverオブジェクト + # 切断したサーバー。 +} + +sub message_io_hook { + my ($this,$message,$io,$type) = @_; + # サーバーから受け取ったメッセージ、サーバーに送ったメッセージ、 + # クライアントから受け取ったメッセージ、クライアントに送ったメッセージは + # このメソッドで各モジュールに通知される。メッセージの変更も可能で、 + # 戻り値のルールはmessage_arrivedと同じ。 + # + # 通常のモジュールはこのメソッドを実装する必要は無い。 + # + # $message : + # 内容: IRCMessageオブジェクト + # 送受信されたメッセージ + # $io : + # 内容: IrcIO::Server又はIrcIO::Clientオブジェクト + # 送受信が行なわれたIrcIO + # $type : + # 内容: 文字列 + # 'in'なら受信、'out'なら送信 + return $message; +} + +sub control_requested { + my ($this,$request) = @_; + # 外部コントロールプログラムからのメッセージが来た。 + # 戻り値はControlPort::Reply。 + # + # $request: + # 内容 : ControlPort::Request + # 送られたリクエスト + die "This module doesn't support controlling.\n"; +} + +sub config { + my $this = shift; + # このモジュールの設定を取得する。 + # オーバーライドする必要は無い。 + # 戻り値はConfiguration::Block。 + $this->_conf->find_module_conf(ref($this),'block'); +} + +1; diff -urN /non-existant-dir/main/ModuleManager.pm tiarra-20050322/main/ModuleManager.pm --- /non-existant-dir/main/ModuleManager.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/ModuleManager.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,610 @@ +# ----------------------------------------------------------------------------- +# $Id: ModuleManager.pm 712 2004-10-31 14:35:07Z topia $ +# ----------------------------------------------------------------------------- +# このクラスは全てのTiarraモジュールを管理します。 +# モジュールをロードし、リロードし、破棄するのはこのクラスです。 +# ----------------------------------------------------------------------------- +package ModuleManager; +use strict; +use Carp; +use warnings; +use UNIVERSAL; +use RunLoop; +use Tiarra::SharedMixin qw(shared shared_manager); +use Tiarra::ShorthandConfMixin; +use Tiarra::Utils; +our $_shared_instance; +utils->define_attr_getter(1, [qw(_runloop runloop)]); + +sub _new { + shift->new(shift || RunLoop->shared); +} + +sub new { + my ($class, $runloop) = @_; + croak 'runloop is not specified!' unless defined $runloop; + my $obj = { + runloop => $runloop, + modules => [], # 現在使用されている全てのモジュール + using_modules_cache => undef, # ブラックリストを除いた全てのモジュールのキャッシュ。 + mod_configs => {}, # 現在使用されている全モジュールのConfiguration::Block + mod_timestamps => {}, # 現在使用されている全モジュールおよびサブモジュールの初めてuseされた時刻 + mod_blacklist => {}, # 過去に正常動作しなかったモジュール。 + updated_once => 0, # 過去にupdate_modulesが実行された事があるか。 + }; + bless $obj,$class; +} + +sub _initialize { + my $this = shift; + $this->update_modules; +} + +sub add_to_blacklist { + my ($this,$modname) = @_; + $this->_set_blacklist($modname, 1); +} + +sub remove_from_blacklist { + my ($this,$modname) = @_; + $this->_set_blacklist($modname, 0); +} + +sub check_blacklist { + my ($class_or_this,$modname) = @_; + + exists $class_or_this->_this->{mod_blacklist}->{$modname}; +} + +sub _set_blacklist { + my ($class_or_this,$modname,$add_or_remove) = @_; + my $this = $class_or_this->_this; + + $this->_clear_module_cache; + if ($add_or_remove) { + # modname の存在テストはしない: && defined $this->get($modname) + $this->{mod_blacklist}->{$modname} = 1; + } elsif (!$add_or_remove && exists $this->{mod_blacklist}->{$modname}) { + delete $this->{mod_blacklist}->{$modname}; + } else { + return undef; + } + return 1; +} + +sub _clear_module_cache { + shift->{using_modules_cache} = undef; +} + +sub get_modules { + # @options(省略可能): + # 'even-if-blacklisted': ブラックリスト入りのものを含める。 + # モジュールの配列への参照を返すが、これを変更してはならない！ + my ($class_or_this,@options) = @_; + my $this = $class_or_this->_this; + if (defined $options[0] && $options[0] eq 'even-if-blacklisted') { + return $this->{modules}; + } else { + if (!defined $this->{using_modules_cache}) { + $this->{using_modules_cache} = [grep { + !$this->check_blacklist(ref($_)); + } @{$this->{modules}}]; + } + return $this->{using_modules_cache}; + } +} + +sub get { + my ($class_or_this,$modname) = @_; + my $this = $class_or_this->_this; + foreach (@{$this->{modules}}) { + return $_ if ref $_ eq $modname; + } + undef; +} + +sub terminate { + # Tiarra終了時に呼ぶ事。 + my $this = shift->_this; + foreach (@{$this->{modules}}) { + eval { + $_->destruct; + }; if ($@) { + print "$@\n"; + } + $this->_unload(ref($_)); + } + foreach (keys %{$this->{mod_timestamps}}) { + eval { + $_->destruct; + }; + $this->_unload($_); + } + @{$this->{modules}} = (); + $this->_clear_module_cache; + %{$this->{mod_configs}} = (); + %{$this->{mod_timestamps}} = (); +} + +sub timestamp { + my ($class_or_this,$module,$timestamp) = @_; + my $this = $class_or_this->_this; + if (defined $timestamp) { + $this->{mod_timestamps}->{$module} = $timestamp; + } + $this->{mod_timestamps}->{$module}; +} + +sub check_timestamp_update { + my ($class_or_this,$module,$timestamp) = @_; + my $this = $class_or_this->_this; + + $timestamp = $this->{mod_timestamps}->{$module} if !defined $timestamp; + if (defined $timestamp) { + (my $mod_filename = $module) =~ s|::|/|g; + my $mod_fpath = $INC{$mod_filename.'.pm'}; + return if (!defined($mod_fpath) || !-f $mod_fpath); + if ((stat($mod_fpath))[9] > $timestamp) { + return 1; + } else { + return 0; + } + } else { + return undef; + } +} + +sub update_modules { + # +で指定されたモジュール一覧を読み、modulesを再構成する。 + # 必要なモジュールがまだロードされていなければロードし、 + # もはや必要とされなくなったモジュールがあれば破棄する。 + # 二度目以降、つまり起動後にこれが実行された場合は + # モジュールのロードや破棄に関して成功時にもメッセージを出力する。 + my $this = shift->_this; + my $mod_configs = $this->_conf->get_list_of_modules; + my ($new,$deleted,$changed,$not_changed) = $this->_check_difference($mod_configs); + + my $show_msg = sub { + if ($this->{updated_once}) { + # 過去に一度以上、update_modulesが実行された事がある。 + return sub { + $this->_runloop->notify_msg( $_[0] ); + }; + } + else { + # 起動時なので何もしない無名関数を設定。 + return sub {}; + } + }->(); + + # $this->{modules}をモジュール名 => Moduleのテーブルに。 + my %loaded_mods = map { + ref($_) => $_; + } @{$this->{modules}}; + + # 新たに追加されたモジュール、作り直されたモジュール、変更されなかったモジュールを + # モジュール名 => Moduleの形式でテーブルにする。 + my %new_mods = map { + # 新たに追加されたモジュール。 + $show_msg->("Module ".$_->block_name." will be loaded newly."); + $this->remove_from_blacklist($_->block_name); + $_->block_name => $this->_load($_); + } @$new; + my %rebuilt_mods = map { + # 作り直すモジュール。 + # %loaded_modsに古い物が入っているので、破棄する。 + $show_msg->("Configuration of the module ".$_->block_name." has been changed. It will be restarted."); + $loaded_mods{$_->block_name}->destruct; + $this->remove_from_blacklist($_->block_name); + $_->block_name => $this->_load($_); + } @$changed; + my %not_changed_mods = map { + # 設定変更されなかったモジュール。 + # %loaded_modsに実物が入っている。 + my $modname = $_->block_name; + if (!defined $loaded_mods{$modname} && + $this->check_timestamp_update($modname)) { + # ロードできてなくて、なおかつアップデートされていたらロードしてみる。 + $show_msg->("$modname has been modified. It will be reloaded."); + $this->remove_from_blacklist($modname); + $modname => $this->_load($_); + } else { + $modname => $loaded_mods{$modname}; + } + } @$not_changed; + + # $mod_configsに書かれた順序に従い、$this->{modules}を再構成。 + # 但しロードに失敗したモジュールはnullになっているので除外。 + @{$this->{modules}} = grep { defined $_ } map { + my $modname = $_->block_name; + $not_changed_mods{$modname} || $rebuilt_mods{$modname} || $new_mods{$modname}; + } @$mod_configs; + + my $deleted_any = @$deleted > 0; + foreach (@$deleted) { + # 削除されたモジュール。 + # %loaded_modsに古い物が入っている場合は破棄した上、アンロードする。 + $show_msg->("Module ".$_->block_name." will be unloaded."); + if (defined $loaded_mods{$_->block_name}) { + eval { + $loaded_mods{$_->block_name}->destruct; + }; if ($@) { + $this->_runloop->notify_error($@); + } + } + $this->_unload($_); + } + + # gc の前に一度キャッシュクリア + $this->_clear_module_cache; + + if ($deleted_any > 0) { + # 何か一つでもアンロードしたモジュールがあれば、最早参照されなくなったモジュールが + # あるかどうかを調べ、一つでもあればmark and sweepを実行。 + my $fixed = $this->fix_USED_fields; + if ($fixed) { + $this->gc; + } + } + + $this->_clear_module_cache; + + $this->{updated_once} = 1; + $this; +} + +sub _check_difference { + # 前回の_check_difference実行時から、現在のモジュール設定がどのように変化したか。 + # 戻り値は(<新規追加>,<削除>,<変更>,<無変更>) それぞれARRAYへの参照である。 + # 新規追加と変更はそれぞれ新しいConfiguration::Blockが、削除には(新しいものが無いので)古いConfiguration::Blockが返される。 + my ($this,$mod_configs) = @_; + # まずは新たに登場したモジュールと、設定を変更されたモジュールを探す。 + my @new; + my @changed; + my @not_changed; + foreach my $conf (@$mod_configs) { + my $old_conf = $this->{mod_configs}->{$conf->block_name}; + if (defined $old_conf) { + # このモジュールは既に定義されているが、変更を加えられてはいないか？ + if ($old_conf->equals($conf)) { + # 変わってない。 + push @not_changed,$conf; + } + else { + # 内容が変わった。 + push @changed,$conf; + } + } + else { + # 初めて見るモジュールだ。 + push @new,$conf; + } + } + # 削除されたモジュールを探す。 + # 上のループと纏める事も出来るが、コードが分かりにくくなる。 + my %names_of_old_modules + = map { $_ => 1 } keys %{$this->{mod_configs}}; + foreach my $conf (@$mod_configs) { + delete $names_of_old_modules{$conf->block_name}; + } + my @deleted = map { + $this->{mod_configs}->{$_}; + } keys %names_of_old_modules; + # $this->{mod_configs}に新たな値を設定。 + %{$this->{mod_configs}} = + map { $_->block_name => $_ } @$mod_configs; + # 完了 + return (\@new,\@deleted,\@changed,\@not_changed); +} + +sub reload_modules_if_modified { + # コード自体が更新されているモジュールがあれば、それを一旦アンロードしてロードし直す。 + # インスタンスも当然作り直す。 + my $this = shift; + + my $show_msg = sub { + $this->_runloop->notify_msg($_[0]); + }; + + my $mods_to_be_reloaded = {}; # モジュール名 => 1 + my $check = sub { + my ($modname,$timestamp) = @_; + # 既に更新されたものとしてマークされていれば抜ける。 + return if $mods_to_be_reloaded->{$modname}; + + if ($this->check_timestamp_update($modname, $timestamp)) { + # 更新されている。少なくともこのモジュールはリロードされる。 + $mods_to_be_reloaded->{$modname} = 1; + $show_msg->("$modname has been modified. It will be reloaded."); + + my $trace; + $trace = sub { + my ($modname, $depth) = @_; + ++$depth; + no strict 'refs'; + # このモジュールに%USEDは定義されているか？ + my $USED = \%{$modname.'::USED'}; + if (defined $USED) { + # USEDの全ての要素に対し再帰的にマークを付ける。 + foreach my $used_elem (keys %$USED) { + if (!defined $mods_to_be_reloaded->{$used_elem} || + $mods_to_be_reloaded->{$used_elem} < $depth) { + $mods_to_be_reloaded->{$used_elem} = $depth; + $show_msg->("$used_elem will be reloaded because of modification of $modname"); + $trace->($used_elem, $depth); + } + } + } + }; + + $trace->($modname, 1); + } + }; + + while (my ($modname,$timestamp) = each %{$this->{mod_timestamps}}) { + $check->($modname,$timestamp); + } + + # 一つでもマークされたモジュールがあれば、$this->{modules}内の何処に + # 目的のモジュールが在るのかを調べるために、モジュール名 => 位置のテーブルを作る。 + if (keys(%$mods_to_be_reloaded) > 0) { + my $mod2index = {}; + for (my $i = 0; $i < @{$this->{modules}}; $i++) { + $mod2index->{ref $this->{modules}->[$i]} = $i; + } + + # マークされたモジュールをリロードするが、それが$mod2indexに登録されていたら + # インスタンスを作り直す。 + foreach my $modname (map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [$_, $mods_to_be_reloaded->{$_}]; } + keys %$mods_to_be_reloaded) { + my $idx = $mod2index->{$modname}; + if (defined $idx) { + eval { + $this->{modules}->[$idx]->destruct; + }; if ($@) { + $this->_runloop->notify_error($@); + } + + my $conf_block = $this->{mod_configs}->{$modname}; + # message_io_hook が定義されているモジュールが死ぬと怖いので + # とりあえず undef を入れて無視させる。 + $this->{modules}->[$idx] = undef; + $this->_unload($conf_block); + $this->{modules}->[$idx] = $this->_load($conf_block); # 失敗するとundefが入る。 + # _unload でブラックリストから消えるから大丈夫だと思うが、一応。 + $this->remove_from_blacklist($modname); + } + else { + # アンロード後、use。 + no strict 'refs'; + # その時、%USEDを保存する。@USEは保存しない。 + my %USED = %{$modname.'::USED'}; + eval { + $modname->destruct; + }; + $this->_unload($modname); + eval qq{ + use $modname; + }; if ($@) { + $this->_runloop->notify_error($@); + } + %{$modname.'::USED'} = %USED; + } + } + + # 全てのモジュールの%USEDを調べて、その%USEDが指しているモジュールが + # 本当にそのモジュールを参照しているのかどうかをチェック。 + # モジュールの更新で最早参照しなくなっていれば、%USEDから削除する。 + # このような事が起こるのはリロード時に%USEDを保存するためである。 + my $fixed = $this->fix_USED_fields; + + # %USEDの不整合性が見付かったら、もはや必要とされなくなった + # モジュールがあるかも知れない。gcを実行。 + if ($fixed) { + $this->gc; + } + + # $this->{modules}にはundefの要素が入っているかも知れないので、そのような要素は除外する。 + @{$this->{modules}} = grep { + defined $_; + } @{$this->{modules}}; + + $this->_clear_module_cache; + } +} + +sub _load { + # モジュールをuseしてインスタンスを生成して返す。 + # 失敗したらundefを返す。 + my ($this,$mod_conf) = @_; + my $mod_name = $mod_conf->block_name; + + # use + utils->do_with_errmsg("module load: $mod_name", sub { + eval "use $mod_name;"; + }); + if ($@) { + $this->_runloop->notify_error( + "Couldn't load module $mod_name because of exception.\n$@"); + return undef; + } + + # モジュール名をファイル名に変換して%INCを検査。 + # module/で始まっていなければエラー。 + #(my $mod_filename = $mod_name) =~ s|::|/|g; + #my $filepath = $INC{$mod_filename.'.pm'}; + #if ($filepath !~ m|^module/|) { + # $this->_runloop->notify_error( + # "Class $mod_name exists outside the module directory.\n$filepath\n"); + # next; + #} + + # このモジュールは本当にModuleのサブクラスか？ + # 何故かUNIVERSAL::isaは嘘を付く事があるので自力で@ISA内を検索する。 + # 5.6.0 for darwinではモジュールをリロードすると嘘を付く。 + no strict 'refs'; + my $is_inherit_ok = sub { + return 1 if UNIVERSAL::isa($mod_name,'Module'); + my @isa = @{$mod_name.'::ISA'}; + foreach (@isa) { + if ($_ eq 'Module') { + ::debug_printmsg('UNIVERSAL::isa tell a lie...'); + return 1; + } + } + undef; + }; + unless ($is_inherit_ok->()) { + $this->_runloop->notify_error( + "Class $mod_name doesn't inherit class Module."); + return undef; + } + + # インスタンス生成 + my $mod; + eval { + $mod = $mod_name->new($this->_runloop); + }; if ($@) { + $this->_runloop->notify_error( + "Couldn't instantiate module $mod_name because of exception.\n$@"); + return undef; + } + + # このインスタンスは本当に$mod_nameそのものか？ + if (ref($mod) ne $mod_name) { + $this->_runloop->notify_error( + "A thing ".$mod_name."->new returned was not a instance of $mod_name."); + return undef; + } + + # timestampに登録 + $this->timestamp($mod_name,time); + + return $mod; +} + +sub _unload { + # 指定されたモジュールを削除する。 + # モジュール名の代わりにConfiguration::Blockを渡しても良い。 + my ($this,$modname) = @_; + $modname = $modname->block_name if UNIVERSAL::isa($modname,'Configuration::Block'); + + # このモジュールのuse時刻を消去 + delete $this->{mod_timestamps}->{$modname}; + + # このモジュールのブラックリストを消去。 + $this->remove_from_blacklist($modname); + + # このモジュールのファイル名を求めておく。 + (my $mod_filename = $modname) =~ s|::|/|g; + $mod_filename .= '.pm'; + + # シンボルテーブルを削除してしまえば変数やサブルーチンにアクセス出来なくなる。 + use Symbol (); + # サブパッケージを消す挙動は危険かもしれないのでとりあえず退避。 + # (%INC のこともあるし) + # ただし、サブパッケージの性格上メインパッケージなしに動く保証はどこにもない。 + + no strict; + my(%stab) = %{$modname.'::'}; + my %shelter = map { + if (/::$/ && + !/^(SUPER)::$/ && !/^::(ISA|ISA::CACHE)::$/) { + ($_, $stab{$_}); + } else { + (); + } + } keys(%stab); + + Symbol::delete_package($modname); + + # 隔離しておいたものを戻す。 + %{$modname.'::'} = ( %shelter, %{$modname.'::'} ); + + # %INCからも削除 + delete $INC{$mod_filename}; +} + +sub fix_USED_fields { + my $this = shift; + my $result; + no strict 'refs'; + foreach my $modname (keys %{$this->{mod_timestamps}}) { + my $USED = \%{$modname.'::USED'}; + if (defined $USED) { + my @mods_refer_me = keys %$USED; + foreach my $mod_refs_me (@mods_refer_me) { + # このモジュールの@USEには本当に$modnameが入っているか？ + my $USE = \@{$mod_refs_me.'::USE'}; + my $refers_actually = sub { + if (defined $USE) { + foreach (@$USE) { + if ($_ eq $modname) { + return 1; + } + } + } + undef; + }->(); + unless ($refers_actually) { + # 実際には参照されていなかった。 + delete $USED->{$mod_refs_me}; + $result = 1; + } + } + } + } + $result; +} + +sub gc { + # $this->{modules}から到達可能でないサブモジュールを全てアンロードする。 + my $this = shift; + my %all_mods = %{$this->{mod_timestamps}}; # コピーする + # %all_modsの要素で値が空になっている部分が、マークされた個所。 + + my $trace; + no strict 'refs'; + $trace = sub { + my $modname = shift; + # 既にマークされているか、もしくはモジュールが存在しなければ抜ける。 + my $val = $all_mods{$modname}; + if (!defined($val) || $val eq '') { + return; + } + else { + # このモジュールをマークする + $all_mods{$modname} = ''; + # このモジュールに@USEが定義されていたら、 + # その全てのモジュールについて再帰的にトレース。 + my $USE = \@{$modname.'::USE'}; + if (defined $USE) { + foreach (@$USE) { + $trace->($_); + } + } + } + }; + + for my $mod (@{$this->{modules}}) { + my $modname = ref $mod; + $trace->($modname); + } + + # マークされなかったサブモジュールは到達不可能なのでアンロードする。 + while (my ($key,$value) = each %all_mods) { + if ($value ne '') { + eval { + $key->destruct; + }; + + $this->_runloop->notify_msg( + "Submodule $key is no longer required. It will be unloaded."); + $this->_unload($key); + } + } +} + +1; diff -urN /non-existant-dir/main/Multicast.pm tiarra-20050322/main/Multicast.pm --- /non-existant-dir/main/Multicast.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Multicast.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,731 @@ +# ----------------------------------------------------------------------------- +# $Id: Multicast.pm 811 2005-03-06 18:59:11Z topia $ +# ----------------------------------------------------------------------------- +# サーバーからクライアントにメッセージが流れるとき、このクラスはフィルタとして +# ネットワーク名を付加します。 +# クライアントからサーバーに流れるとき、このクラスはネットワーク名をパースして +# 送るべき各サーバーに送ります。 +# ローカル←→グローバルnickの変換もここで行います。 +# ----------------------------------------------------------------------------- +package Multicast; +use strict; +use warnings; +use Configuration; +use Carp; +use NumericReply; +my $runloop = undef; # デフォルトのRunLoopのキャッシュ。 +my $separator = ''; # セパレータ記号のキャッシュ。これらはcast_messageが呼ばれる度に更新される。 + +sub _ISON_from_client { + # nickをネットワーク毎に分類する。 + my ($message, $sender) = @_; + my $networks = classify($message->params); + + while (my ($network_name,$params) = each %$networks) { + my $network = $runloop->networks->{$network_name}; + @$params = map( local_to_global($_,$network) ,@$params); + + forward_to_server(new IRCMessage( + Command => $message->command, + Params => $params), + $network_name); + } +} + +sub _INVITE_from_server { + my ($message,$sender) = @_; + # nickはそのまま。チャンネルにはネットワーク名を付ける。 + $message->nick(global_to_local($message->nick,$sender)); + $message->params->[0] = global_to_local($message->params->[0],$sender); + $message->params->[1] = attach($message->params->[1],$sender->network_name); + return $message; +} +sub _INVITE_from_client { + my ($message,$sender) = @_; + # nickはパースするだけで捨てる。チャンネルのパース結果を見る。 + my $to = ''; + ($message->params->[0]) = detach($message->params->[0]); + ($message->params->[1],$to) = detach($message->params->[1]); + $message->params->[0] = local_to_global($message->params->[0],$to); # 自分をINVITEする事など無いので必要は無いが… + forward_to_server($message,$to); +} + +sub _JOIN_from_server { + my ($message,$sender) = @_; + # カンマで区切られ複数のチャンネルが指定されていたとしても + # それらの全てにネットワーク名を付加する。(まさか無いだろうが。) + $message->nick(global_to_local($message->nick,$sender)); + + my @channels = split(/,/,$message->params->[0]); + my $n_channels = @channels; + for (my $i = 0; $i < $n_channels; $i++) { + $channels[$i] = attach($channels[$i],$sender->network_name); + } + $message->params->[0] = join(',',@channels); + return $message; +} +sub _JOIN_from_client { + my ($message,$sender) = @_; + # パスワードの部分は弄らず、ネットワーク名をパースして取り除く。 + # 各チャンネルをネットワーク毎に分類する。 + if ($message->params->[0] eq '0') { + # 0は特殊。 + # 全てのサーバーにJOIN 0を送る。 + distribute_to_servers( + new IRCMessage( + Command => 'JOIN', + Param => '0')); + } + else { + my @targets = split(/,/,$message->params->[0]); + my $networks = classify(\@targets); + while (my ($network_name,$channels) = each %$networks) { + $message->params->[0] = join(',',@$channels); + forward_to_server($message,$network_name); + } + } +} + +sub _KICK_from_server { + my ($message,$sender) = @_; + # チャンネル名にだけ、ネットワーク名を付加する。 + $message->nick(global_to_local($message->nick,$sender)); + $message->params->[0] = attach($message->params->[0],$sender->network_name); + $message->params->[1] = global_to_local($message->params->[1],$sender); + return $message; +} +sub _KICK_from_client { + my ($message,$sender) = @_; + my @channels = split(/,/,$message->params->[0]); + my @nicks = split(/,/,$message->params->[1]); + if (scalar(@channels) == scalar(@nicks)) { + # チャンネルとnickが一対一で対応する。 + # チャンネルのネットワーク名を使用し、nickのネットワーク名は捨てる。 + for (my $i = 0; $i < @channels; $i++) { + my ($raw_channel,$to) = detach($channels[$i]); + my ($raw_nick) = detach($nicks[$i]); + + $message->params->[0] = $raw_channel; + $message->params->[1] = local_to_global($raw_nick,$runloop->networks->{$to}); + forward_to_server($message,$to); + } + } + elsif (@channels == 1) { + # 一つのチャンネルから複数のnickを蹴り出す。 + # チャンネルのネットワーク名を使用し、nickのネットワーク名は捨てる。 + my ($raw_channel,$to) = detach($channels[0]); + my $network = $runloop->networks->{$to}; + $message->params->[0] = $raw_channel; + + foreach my $nick (@nicks) { + my ($raw_nick) = detach($nick); + $message->params->[1] = local_to_global($raw_nick,$network); + + forward_to_server($message,$to); + } + } +} + +sub _LIST_from_client { + my ($message,$sender) = @_; + # チャンネルのネットワーク名で分類。 + if (defined $message->params->[0]) { + my @targets = split(/,/,$message->params->[0]); + my $networks = classify(\@targets); + + while (my ($network_name,$channels) = each %$networks) { + $message->params->[0] = join(',',@$channels); + forward_to_server($message,$network_name); + } + } + else { + forward_to_server($message, $runloop->default_network); + } +} + +sub _MODE_from_server { + my ($message,$sender) = @_; + $message->nick(global_to_local($message->nick,$sender)); + @{$message->params} = map( global_to_local($_,$sender) ,@{$message->params}); + + my $target = $message->params->[0]; + if (channel_p($target)) { + # nick(つまり自分)の場合はそのままクライアントに配布。 + # この場合はチャンネルなので、ネットワーク名を付加。 + $message->params->[0] = attach($target,$sender->network_name); + } + return $message; +} + +sub _MODE_from_client { + my ($message,$sender) = @_; + my $to; + ($message->params->[0],$to) = detach($message->params->[0]); + + my $network = $runloop->networks->{$to}; + @{$message->params} = map( local_to_global($_,$network) ,@{$message->params}); + + forward_to_server($message,$to); +} + +sub _NICK_from_client { + # ネットワーク名が指定されていたら、その鯖にのみNICKを送信。 + # そうでなければ全ての鯖に送る。 + my ($message,$sender) = @_; + my $to; + my $specified; + ($message->params->[0],$to,$specified) = detach($message->params->[0]); + + if ($specified) { + forward_to_server($message,$to); + } + else { + distribute_to_servers($message); + } +} + +sub _NJOIN_from_server { + my ($message,$sender) = @_; + $message->param(0,attach($message->param(0),$sender->network_name)); + $message->param(1, + join(',', + map{ s/^([\@+]*)(.+)$/$1.global_to_local($2,$sender)/e; $_; } split(/,/,$message->param(1)))); + $message; +} + +sub _NOTICE_from_server { + my ($message,$sender) = @_; + $message->nick(global_to_local($message->nick,$sender)); + + my $target = $message->params->[0]; + if (channel_p($target)) { + # nick(つまり自分)の場合はそのままクライアントに配布。 + # この場合はチャンネルなので、ネットワーク名を付加。 + $message->params->[0] = attach($target,$sender->network_name); + } + return $message; +} + +sub _WHOIS_from_client { + my ($message,$sender) = @_; + my $to; + ($message->params->[0],$to) = detach($message->params->[0]); + + my $network = $runloop->networks->{$to}; + $message->params->[0] = local_to_global($message->params->[0],$runloop->networks->{$to}); + + # ローカルnickと送信先のグローバルnickが異なっていたら、その旨をクライアントに報告する。 + # ただしWHOISの対象が自分だった場合のみ。 + my $local_nick = $runloop->current_nick; + my $global_nick = $network->current_nick; + if (($message->command eq 'WHOIS' || $message->command eq 'WHO') && + $message->param(0) eq $global_nick && + $local_nick ne $global_nick) { + $sender->send_message( + new IRCMessage( + Prefix => $runloop->sysmsg_prefix(qw(priv system)), + Command => 'NOTICE', + Params => [$local_nick, + "*** Your global nick in $to is currently '$global_nick'."])); + } + + forward_to_server($message,$to); +} + +sub _RPL_USERHOST { + my ($message,$sender) = @_; + $message->params->[1] =~ s/^([^*=]+)(.+)$/global_to_local($1,$sender).$2/e; + $message; +} + +sub _RPL_ISON { + my ($message,$sender) = @_; + $message->params->[1] = + join(' ', + map { + global_to_local($_,$sender); + } split / /,$message->params->[1]); + $message; +} + +sub _RPL_INVITING { + my ($message,$sender) = @_; + $message->param(1,attach($message->param(1),$sender->network_name)); + $message->param(2,global_to_local($message->param(2),$sender)); + $message; +} + +sub _RPL_WHOREPLY { + my ($message, $sender) = @_; + $message->param(1,attach($message->param(1),$sender->network_name)); + $message->param(5,global_to_local($message->param(5),$sender)); + $message; +} + +sub _RPL_NAMREPLY { + my ($message,$sender) = @_; + $message->param(2,attach($message->param(2),$sender->network_name)); + $message->params->[3] = + join(' ', + map { + s/^([\@+]*)(.+)$/$1.global_to_local($2,$sender)/e; $_; + } split / /,$message->params->[3]); + $message; +} + +sub _attach_RPL_WHOISCHANNELS { + my ($message,$sender) = @_; + $message->param(1,global_to_local($message->param(1),$sender)); + $message->params->[2] = + join(' ', + map { + s/^([\@+]*)(.+)$/$1.attach($2, $sender->network_name)/e; $_; + } split / /,$message->params->[2]); + $message; +} + +sub _detach_RPL_WHOISCHANNELS { + my ($message,$sender) = @_; + $message->params->[2] = + join(' ', + map { + s/^([\@+]*)(.+)$/$1.detach($2)/e; $_; + } split / /,$message->params->[2]); + $message; +} + +my $g2l_cache = {}; +sub _gen_g2l_translator { + my $index = shift; + + unless (exists $g2l_cache->{$index}) { + $g2l_cache->{$index} = sub { + my ($message,$sender) = @_; + $message->params->[$index] = global_to_local($message->params->[$index],$sender); + $message; + }; + } + $g2l_cache->{$index}; +} + +my $attach_cache = {}; +sub _gen_attach_translator { + my $index = shift; + + unless (exists $attach_cache->{$index}) { + $attach_cache->{$index} = sub { + my ($message,$sender) = @_; + $message->param($index,attach($message->param($index),$sender->network_name)); + $message; + }; + } + $attach_cache->{$index}; +} + +my $detach_cache = {}; +sub _gen_detach_translator { + my $index = shift; + + if (!exists $detach_cache->{$index}) { + $detach_cache->{$index} = sub { + my ($message, $sender) = @_; + $message->param( + $index, + detach($message->param($index))); + forward_to_server($message, $sender); + }; + } + $detach_cache->{$index}; +} + +my $server_sent = { + 'INVITE' => \&_INVITE_from_server, + 'JOIN' => \&_JOIN_from_server, + 'KICK' => \&_KICK_from_server, + 'MODE' => \&_MODE_from_server, + 'NICK' => undef, # 本体は鯖からのNICKを弄らない。これを見て情報を更新するのはIrcIO::Serverである。 + 'NOTICE' => \&_NOTICE_from_server, # Prefixを弄るとすれば、それはモジュールの役目。 + 'PART' => \&_JOIN_from_server, # JOINと同じ処理で良い。 + 'PING' => undef, + 'PRIVMSG' => \&_NOTICE_from_server, # NOTICEと同じ処理で良い。 + 'QUIT' => undef, # QUITしたのが自分だったら捨てる、といった処理はIrcIO::Serverが行なう。 + 'SQUERY' => \&_MODE_from_server, # 多分これは鯖からも来るだろうが、良く分からない。 + 'TOPIC' => \&_MODE_from_server, + 'NJOIN' => \&_NJOIN_from_server, + (RPL_UNIQOPIS) => \&_RPL_INVITING, # UNIQOPIS (INVITINGと同じ処理) + # TRACE系のリプライはTiarraは関知しない。少なくとも今のところは。 + do { + my $sub = _gen_g2l_translator(1); + map { + (NumericReply::fetch_number($_), $sub) + } (map {"RPL_$_"} + ((map {"WHOIS$_"} qw(USER SERVER OPERATOR IDLE)), + (map {"ENDOF$_"} qw(WHOIS WHOWAS)), + qw(WHOWASUSER AWAY)))}, + do { + my $sub = _gen_attach_translator(1); + map { + (NumericReply::fetch_number($_), $sub); + } ((map {"RPL_$_"} + ((map { ("$_", "ENDOF$_"); } map {$_.'LIST'} + qw(INVITE EXCEPT BAN REOP)), + (map {"ENDOF$_"} qw(WHO NAMES)), + qw(LIST CHANNELMODEIS NOTOPIC TOPIC TOPICWHOTIME), + qw(CREATIONTIME))), + qw(ERR_TOOMANYCHANNELS ERR_NOTONCHANNEL ERR_NOSUCHCHANNEL))}, + do { + no strict 'refs'; + map { + my $funcname = "_$_"; + (NumericReply::fetch_number($_), \&$funcname) + } (map {"RPL_$_"} + qw(USERHOST ISON INVITING WHOREPLY NAMREPLY))}, + do { + no strict 'refs'; + map { + my $funcname = "_attach_$_"; + (NumericReply::fetch_number($_), \&$funcname) + } (map {"RPL_$_"} + qw(WHOISCHANNELS))}, +}; + +my $client_sent = { + 'ISON' => \&_ISON_from_client, + 'INVITE' => \&_INVITE_from_client, + 'JOIN' => \&_JOIN_from_client, + 'KICK' => \&_KICK_from_client, + 'LIST' => \&_LIST_from_client, + 'MODE' => \&_MODE_from_client, + 'NAMES' => \&_LIST_from_client, # LISTと同じ処理で良い。 + 'NICK' => \&_NICK_from_client, + 'NOTICE' => \&_LIST_from_client, # LISTと同じ処理で良い。 + #'MODE' => \&_MODE_from_client, # MODEと同じ処理で良い。 + #↑意図不明。 + 'PART' => \&_LIST_from_client, # LISTと同じ処理で良い。 + 'PASS' => \&_MODE_from_client, # これを真面目に処理しないとSERVICE出来ない。MODEと同じで良い。 + 'PONG' => undef, + 'PRIVMSG' => \&_LIST_from_client, # NOTICEと同じ処理で良い。 + 'QUIT' => undef, # QUITをトラップするのはIrcIO::Client。つまりここには決してQUITは流れて来ない。 + 'SERVICE' => \&_MODE_from_client, # 良く分からないが、とりあえずMODEと同じにする。 + 'SERVLIST' => \&_MODE_from_client, # これも良く分からない。MODEと同じに。 + 'SERVSET' => \&_MODE_from_client, # これも。 + 'SQUERY' => \&_MODE_from_client, # これも + 'STATS' => \&_MODE_from_client, # サーバ名はうしろにつくのでこれはよくないかも + 'SUMMON' => \&_MODE_from_client, + 'TIME' => \&_MODE_from_client, + 'TOPIC' => \&_MODE_from_client, + 'TRACE' => \&_MODE_from_client, + 'UMODE' => \&_MODE_from_client, + 'USER' => undef, + 'USERHOST' => \&_ISON_from_client, + 'USERS' => \&_MODE_from_client, + 'VERSION' => \&_MODE_from_client, + 'ADMIN' => \&_MODE_from_client, + 'WHO' => \&_WHOIS_from_client, + 'WHOIS' => \&_WHOIS_from_client, + 'WHOWAS' => \&_WHOIS_from_client, + 'CLOSE' => \&_MODE_from_client, + 'CONNECT' => \&_MODE_from_client, # 無理があるが… + 'DIE' => \&_MODE_from_client, + 'KILL' => \&_MODE_from_client, + 'REHASH' => \&_MODE_from_client, + 'RESTART' => \&_MODE_from_client, + 'SQUIT' => \&_MODE_from_client, + 'ERROR' => undef, + 'NJOIN' => undef, # クライアントからNJOINを発行するのは勿論無意味。 + 'RECONNECT' => undef, + 'SERVER' => undef, + 'WALLOPS' => \&_MODE_from_client, # クライアントからWALLOPSを発行出来るのかどうかは知らないが… + # 以下リプライ。これはdetach_network_nameの為だけにある。 + (RPL_NAMREPLY) => _gen_detach_translator(2), + do { + my $sub = _gen_detach_translator(1); + map { + (NumericReply::fetch_number($_), $sub) + } ((map {"RPL_$_"} + ((map { ("$_", "ENDOF$_"); } qw(INVITELIST EXCEPTLIST BANLIST)), + (map {"ENDOF$_"} qw(WHO NAMES)), + qw(LIST CHANNELMODEIS NOTOPIC TOPIC TOPICWHOTIME), + qw(CREATIONTIME INVITING UNIQOPIS WHOREPLY))), + qw(ERR_TOOMANYCHANNELS ERR_NOTONCHANNEL ERR_NOSUCHCHANNEL))}, + do { + no strict 'refs'; + map { + my $funcname = "_detach_$_"; + (NumericReply::fetch_number($_), \&$funcname) + } (map {"RPL_$_"} + qw(WHOISCHANNELS))}, +}; + + +sub _update_cache { + $separator = Configuration->shared_conf-> + networks->channel_network_separator; + $runloop = RunLoop->shared_loop; +} + +sub from_server_to_client { + no warnings; + my ($message, $sender) = @_; + &_update_cache; + # server -> clientの流れでは、一つのメッセージが複数に分割される事は無い。 + # この関数は一つのIRCMessageを返す。 + + if ($message->command =~ /^\d+$/) { + # ニューメリックリプライの0番目のパラメタは全てnick。 + $message->params->[0] = global_to_local($message->params->[0],$sender); + } + + eval { + # フィルタが無かったり、フィルタの実行中に例外が起こったりした場合はそのまま返す。 + $message = $server_sent->{$message->command}->($message, $sender); + }; if ($@) { + $message->nick(global_to_local($message->nick,$sender)); + } + return $message; +} + +sub from_client_to_server { + no warnings; + my ($message, $sender) = @_; + &_update_cache; + # client -> serverの流れでは、一つのメッセージが複数に分割される事がある。 + # この関数はメッセージを鯖に直接送り、戻り値は返さない。 + eval { + $client_sent->{$message->command}->($message, $sender); + }; if ($@) { + forward_to_server($message,$runloop->default_network); + } +} + +sub detach_network_name { + no strict; + no warnings; + my ($message, $sender) = @_; + &_update_cache; + my $result; + local $hijack_forward_to_server = sub { + my ($msg, $network_name) = @_; + $result = $msg; + }; + local $hijack_local_to_global = 1; + eval { + $client_sent->{$message->command}->($message, $sender); + }; if ( !defined $result ) { + $hijack_forward_to_server->($message, $runloop->default_network); + } + $result; +} + +*detatch = \&detach; # 勘違いしていた。detachが正しい。 +sub detach { + # 戻り値: (セパレータ前の文字列,ネットワーク名,ネットワーク名が明示されたかどうか) + # ただしスカラーコンテクストではセパレータ前の文字列のみを返す。 + my $str = shift; + + if (!defined $str) { + croak "Arg[0] was undef.\n"; + } + elsif (ref($str) ne '') { + croak "Arg[0] was ref.\n"; + } + + my ($pkg_caller) = caller; + _update_cache() unless $pkg_caller->isa('Multicast'); + + my @result; + if ((my $sep_index = index($str,$separator)) != -1) { + my $before_sep = substr($str,0,$sep_index); + my $after_sep = substr($str,$sep_index+length($separator)); + if ((my $colon_pos = index($after_sep,':')) != -1) { + # #さいたま@taiyou:*.jp → #さいたま:*.jp + taiyou + @result = ($before_sep.substr($after_sep,$colon_pos), + substr($after_sep,0,$colon_pos), + 1); + } + else { + # #さいたま@taiyou → #さいたま + taiyou + @result = ($before_sep,$after_sep,1); + } + } + else { + @result = ($str,$runloop->default_network,undef); + } + return wantarray ? @result : $result[0]; +} + +sub detach_for_client { + my ($str) = @_; + + if (!$runloop->multi_server_mode_p) { + detach($str); + } else { + $str; + } +} + +sub attach { + # $strはChannelInfoのオブジェクトでも良い。 + # $network_nameは省略可能。IrcIO::Serverのオブジェクトでも良い。 + my ($str,$network_name) = @_; + if (ref($str) eq 'ChannelInfo') { + $str = $str->name; + } + if (ref($network_name) eq 'IrcIO::Server') { + $network_name = $network_name->network_name; + } + + if (!defined $str) { + croak "Arg[0] was undef.\n"; + } + elsif (ref($str) ne '') { + croak "Arg[0] was ref.\n"; + } + + my ($pkg_caller) = caller; + _update_cache() unless $pkg_caller->isa('Multicast'); + + $network_name = $runloop->default_network if $network_name eq ''; + if ((my $pos_colon = index($str,':')) != -1) { + # #さいたま:*.jp → #さいたま@taiyou:*.jp + $str =~ s/:/$separator.$network_name.':'/e; + } + else { + # #さいたま → #さいたま@taiyou + $str .= $separator.$network_name; + } + $str; +} + +sub attach_for_client { + my ($str, $network_name) = @_; + + if ($runloop->multi_server_mode_p) { + attach($str, $network_name); + } else { + $str; + } +} + +sub classify { + # array: 配列への参照 + # 戻り値: ネットワーク名→パース後の文字列を並べた配列への参照 + my $array = shift; + my $networks = {}; + foreach my $target (@$array) { + my ($str,$network_name) = detach($target); + if (defined $networks->{$network_name}) { + push @{$networks->{$network_name}},$str; + } + else { + # 初めて現われたネットワークである。 + $networks->{$network_name} = [$str]; + } + } + return $networks; +} + +sub forward_to_server { + # この関数は、動的スコープに置かれた変数 + # $hijack_forward_to_serverが定義されていたら、 + # それを関数リファと見做してサーバーに送る代わりに呼ぶ。 + no strict; + my ($msg, $network_name) = @_; + + if (defined $hijack_forward_to_server) { + #::printmsg("forward_to_server HIJACKED"); + $hijack_forward_to_server->($msg, $network_name); + } + else { + my $io = $runloop->network($network_name); + if (defined $io && $io->logged_in) { + $io->send_message($msg); + } + } +} + +sub distribute_to_servers { + no strict; + my $msg = shift; + foreach my $server ($runloop->networks_list) { + if (defined $hijack_forward_to_server) { + #::printmsg("forward_to_server HIJACKED"); + $hijack_forward_to_server->($msg, $server->network_name); + } + else { + $server->send_message($msg); + } + } +} + +sub nick_p { + # 文字列がnickとして許される形式であるかどうかを真偽値で返す。 + # これはクライアントで送るのを許されているか返すだけであって、 + # サーバから送られてくる nick の判定に使ってはいけない。 + my $str = detach(shift); + my $nicklen = shift; + return undef unless length($str) && + (!defined $nicklen || (length($str) <= $nicklen)); + + # and irc2.11 permits specially '0'. + my $first_char = '[a-zA-Z_\[\]\\\`\^\{\}\|]'; + my $remaining_char = '[0-9a-zA-Z_\-\[\]\\\`\^\{\}\|]'; + return ($str =~ /^${first_char}${remaining_char}*$/ || $str eq '0'); +} + +sub channel_p { + # 文字列がchannelとして許される形式であるかどうかを真偽値で返す。 + my $str = detach(shift); + return undef unless length($str); + my $chantypes = shift || '#&+!'; + + my $first_char = "[\Q$chantypes\E]"; + my $suffix_spec = '(?::[a-z*.]+)?'; + return $str =~ /^${first_char}.*${suffix_spec}$/ +} + +sub local_to_global { + # この関数は、動的スコープに置かれた変数 + # $hijack_local_to_globalが定義されていたら、 + # 何も変更せずに返す。 + no strict; + my ($str, $server) = @_; + if (defined $hijack_local_to_global) { + $str; + } + else { + if (defined($str) && $str eq $runloop->current_nick) { + $server->current_nick; + } + else { + $str; + } + } +} + +sub global_to_local { + my ($str,$server) = @_; + if (defined($str) && $str eq $server->current_nick) { + return $runloop->current_nick; + } + else { + return $str; + } +} + +sub lc { + # IRC方式で、大文字を小文字に変換する。 + my $str = shift; + # {}|は[]\の小文字である。気違いじみている! + $str =~ tr/A-Z[]\\/a-z{}|/; + $str; +} + +sub uc { + # IRC方式で、小文字を大文字に変換する。 + my $str = shift; + $str =~ tr/a-z{}|/A-Z[]\\/; + $str; +} + +1; diff -urN /non-existant-dir/main/NumericReply.pm tiarra-20050322/main/NumericReply.pm --- /non-existant-dir/main/NumericReply.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/NumericReply.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,280 @@ +# ----------------------------------------------------------------------------- +# $Id: NumericReply.pm 513 2004-08-28 03:42:34Z topia $ +# ----------------------------------------------------------------------------- +# このファイルでは、各ニューメリックリプライに対するシンボルを定義し、exportします。 +# ----------------------------------------------------------------------------- +package NumericReply; +use strict; +use warnings; +require Exporter; +use base qw(Exporter); +our @EXPORT; +our %replies; +our %numbers; + +BEGIN { + my @replies = + split(/\n/, + q{ + --------------------- 通常メッセージ + RPL_WELCOME 001 + RPL_YOURHOST 002 + RPL_CREATED 003 + RPL_MYINFO 004 + RPL_ISUPPORT 005 + + # irc2.11.x or +hemp + RPL_BOUNCE 010 + RPL_REDIR 010 + + RPL_MAP 015 + RPL_MAPMORE 016 + RPL_MAPEND 017 + RPL_MAPSTART 018 + + # irc2.11.x + RPL_HELLO 020 + RPL_YOURID 042 + RPL_SAVENICK 043 + + + RPL_NONE 300 + RPL_AWAY 301 + RPL_USERHOST 302 + RPL_ISON 303 + RPL_TEXT 304 + RPL_UNAWAY 305 + RPL_NOWAWAY 306 + + RPL_WHOISUSER 311 + RPL_WHOISSERVER 312 + RPL_WHOISOPERATOR 313 + + RPL_WHOWASUSER 314 + # RPL_ENDOFWHO 315: below + RPL_ENDOFWHOWAS 369 + + RPL_WHOISCHANOP 316 # redundant and not needed but reserved + RPL_WHOISIDLE 317 + + RPL_ENDOFWHOIS 318 + RPL_WHOISCHANNELS 319 + + RPL_LISTSTART 321 + RPL_LIST 322 + RPL_LISTEND 323 + RPL_CHANNELMODEIS 324 + RPL_UNIQOPIS 325 + + RPL_CREATIONTIME 329 + + RPL_NOTOPIC 331 + RPL_TOPIC 332 + RPL_TOPICWHOTIME 333 + RPL_TOPIC_WHO_TIME 333 + + RPL_INVITING 341 + RPL_SUMMONING 342 + + # irc2.11 + RPL_REOPLIST 344 + RPL_ENDOFREOPLIST 345 + + RPL_INVITELIST 346 + RPL_ENDOFINVITELIST 347 + + RPL_EXCEPTLIST 348 + RPL_ENDOFEXCEPTLIST 349 + + RPL_VERSION 351 + + RPL_WHOREPLY 352 + RPL_ENDOFWHO 315 + RPL_NAMREPLY 353 + RPL_ENDOFNAMES 366 + + RPL_KILLDONE 361 + RPL_CLOSING 362 + RPL_CLOSEEND 362 + RPL_LINKS 364 + RPL_ENDOFLINKS 365 + # RPL_ENDOFNAMES 366: above + RPL_BANLIST 367 + RPL_ENDOFBANLIST 368 + # RPL_ENDOFWHOWAS 369: above + + RPL_INFO 371 + RPL_MOTD 372 + RPL_INFOSTART 373 + RPL_ENDOFINFO 374 + RPL_MOTDSTART 375 + RPL_ENDOFMOTD 376 + + RPL_YOUREOPER 381 + RPL_REHASHING 382 + RPL_YOURESERVICE 383 + RPL_MYPORTIS 384 + RPL_NOTOPERANYMORE 385 + + RPL_TIME 391 + RPL_USERSTART 392 + RPL_USERS 393 + RPL_ENDOFUSERS 394 + RPL_NOUSERS 395 + + + RPL_TRACELINK 200 + RPL_TRACECONNECTING 201 + RPL_TRACEHANDSHAKE 202 + RPL_TRACEUNKNOWN 203 + RPL_TRACEOPERATOR 204 + RPL_TRACEUSER 205 + RPL_TRACESERVER 206 + RPL_TRACESERVICE 207 + RPL_TRACENEWTYPE 208 + RPL_TRACECLASS 209 + RPL_TRACERECONNECT 210 + + RPL_STATSLINKINFO 211 + RPL_STATSCOMMANDS 212 + RPL_STATSCLINE 213 + RPL_STATSNLINE 214 + RPL_STATSILINE 215 + RPL_STATSKLINE 216 + RPL_STATSQLINE 217 + RPL_STATSYLINE 218 + RPL_ENDOFSTATS 219 + RPL_STATSPLINE 220 + RPL_UMODEIS 221 + + RPL_SERVICEINFO 231 + RPL_ENDOFSERVICE 232 + RPL_SERVICE 233 + RPL_SERVLIST 234 + RPL_SERVLISTEND 235 + + RPL_STATSIAUTH 239 + RPL_STATSVLINE 240 + RPL_STATSLLINE 241 + RPL_STATSUPTIME 242 + RPL_STATSOLINE 243 + RPL_STATSHLINE 244 + RPL_STATSSLINE 245 + RPL_STATSPING 246 + RPL_STATSBLINE 247 + RPL_STATSDEFINE 248 + RPL_STATSDEBUG 249 + RPL_STATSDLINE 250 + + RPL_LUSERCLIENT 251 + RPL_LUSEROP 252 + RPL_LUSERUNKNOWN 253 + RPL_LUSERCHANNELS 254 + RPL_LUSERME 255 + RPL_ADMINME 256 + RPL_ADMINLOC1 257 + RPL_ADMINLOC2 258 + RPL_ADMINEMAIL 259 + + RPL_TRACELOG 261 + RPL_TRACEEND 262 + RPL_TRYAGAIN 263 + + RPL_LOCALUSERS 265 + RPL_GLOBALUSERS 266 + + + --------------------- エラーメッセージ + ERR_NOSUCHNICK 401 + ERR_NOSUCHSERVER 402 + ERR_NOSUCHCHANNEL 403 + ERR_CANNOTSENDTOCHAN 404 + ERR_TOOMANYCHANNELS 405 + ERR_WASNOSUCHNICK 406 + ERR_TOOMANYTARGETS 407 + ERR_NOSUCHSERVICE 408 + ERR_NOORIGIN 409 + + ERR_NORECIPIENT 411 + ERR_NOTEXTTOSEND 412 + ERR_NOTOPLEVEL 413 + ERR_WILDTOPLEVEL 414 + ERR_BADMASK 415 + ERR_TOOMANYMATCHES 416 + + ERR_UNKNOWNCOMMAND 421 + ERR_NOMOTD 422 + ERR_NOADMININFO 423 + ERR_FILEERROR 424 + + ERR_NONICKNAMEGIVEN 431 + ERR_ERRONEOUSNICKNAME 432 + ERR_NICKNAMEINUSE 433 + ERR_SERVICENAMEINUSE 434 + ERR_SERVICECONFUSED 435 + ERR_NICKCOLLISION 436 + ERR_UNAVAILRESOURCE 437 + # ERR_DEAD 438: reserved for later use -krys + + ERR_USERNOTINCHANNEL 441 + ERR_NOTONCHANNEL 442 + ERR_USERONCHANNEL 443 + ERR_NOLOGIN 444 + ERR_SUMMONDISABLED 445 + ERR_USERSDISABLED 446 + + ERR_NOTREGISTERED 451 + + ERR_NEEDMOREPARAMS 461 + ERR_ALREADYREGISTRED 462 + ERR_NOPERMFORHOST 463 + ERR_PASSWDMISMATCH 464 + ERR_YOUREBANNEDCREEP 465 + ERR_YOUWILLBEBANNED 466 + ERR_KEYSET 467 + + ERR_CHANNELISFULL 471 + ERR_UNKNOWNMODE 472 + ERR_INVITEONLYCHAN 473 + ERR_BANNEDFROMCHAN 474 + ERR_BADCHANNELKEY 475 + ERR_BADCHANMASK 476 + ERR_NOCHANMODES 477 + ERR_BANLISTFULL 478 + + ERR_NOPRIVILEGES 481 + ERR_CHANOPRIVSNEEDED 482 + ERR_CANTKILLSERVER 483 + ERR_RESTRICTED 484 + ERR_UNIQOPRIVSNEEDED 485 + + ERR_NOOPERHOST 491 + ERR_NOSERVICEHOST 492 + + + ERR_UMODEUNKNOWNFLAG 501 + ERR_USERSDONTMATCH 502 + }); + foreach (@replies) { + s/^\s+//; + my ($key,$value,$comment) = split(/\s+/, $_, 3); + next unless defined $key; # キー名 + next if $key =~ /^-/; # コメント + next if $key =~ /^#/; # コメント + no strict 'refs'; + *$key = sub (){ $value; }; + $replies{$key} = $value; + $numbers{$value} = $key; + push @EXPORT, $key; + } +} + +sub fetch_number { + $replies{+shift}; +} + +sub fetch_name { + $numbers{+shift}; +} + +1; diff -urN /non-existant-dir/main/PersonInChannel.pm tiarra-20050322/main/PersonInChannel.pm --- /non-existant-dir/main/PersonInChannel.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/PersonInChannel.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,74 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: PersonInChannel.pm 566 2004-09-19 11:35:52Z topia $ +# ----------------------------------------------------------------------------- +# なるとや発言権を持っているかどうかの情報とPersonalInfoのセット。 +# ----------------------------------------------------------------------------- +package PersonInChannel; +use strict; +use warnings; +use Carp; +use PersonalInfo; +use Tiarra::DefineEnumMixin qw(PERSON HAS_O HAS_V REMARKS); +use Tiarra::Utils; +Tiarra::Utils->define_array_attr_getter(0, qw(person)); +Tiarra::Utils->define_array_attr_accessor(0, qw(has_o has_v)); + +sub new { + my ($class,$person,$has_o,$has_v) = @_; + croak "PersonInChannel->new requires 3 parameters.\n" if @_ != 4; + my $obj = bless [] => $class; + $obj->[PERSON] = $person; + $obj->[HAS_O] = $has_o; + $obj->[HAS_V] = $has_v; + $obj->[REMARKS] = undef; + $obj; +} + +sub info { + my ($this, $wantarray) = @_; + shift->[PERSON]->info($wantarray); +} + +sub priv_symbol { + my $this = shift; + + return '@' if ($this->has_o); + return '+' if ($this->has_v); + return ''; +} + +*remarks = \&remark; +sub remark { + my ($this,$key,$value) = @_; + my $remarks = $this->[REMARKS]; + + if (defined $value) { + if (!$remarks) { + $remarks = $this->[REMARKS] = {}; + } + + $remarks->{$key} = $value; + } + elsif (@_ >= 3) { + if ($remarks) { + delete $remarks->{$key}; + } + } + + if ($remarks) { + $remarks->{$key}; + } + else { + undef; + } +} + +sub delete_remark { + my ($this,$key) = @_; + if ($_ = $this->[REMARKS]) { + delete $_->{$key}; + } +} + +1; diff -urN /non-existant-dir/main/PersonalInfo.pm tiarra-20050322/main/PersonalInfo.pm --- /non-existant-dir/main/PersonalInfo.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/PersonalInfo.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,66 @@ +# ----------------------------------------------------------------------------- +# $Id: PersonalInfo.pm 781 2005-02-27 06:53:03Z topia $ +# ----------------------------------------------------------------------------- +# nick,username,userhost等を持つ個人情報保持クラス。 +# このオブジェクトはIrcIO::Serverが管理する。 +# +# my $info = new PersonalInfo(Nick => 'saitama'); +# print $info->nick; +# $info->nick("taiyou"); +# ----------------------------------------------------------------------------- +package PersonalInfo; +use strict; +use warnings; +use Tiarra::IRC::Prefix; +use Tiarra::Utils; +use enum (qw(NICK USERNAME USERHOST REALNAME SERVER REMARK AWAY)); +use Carp; +our $AUTOLOAD; + +utils->define_array_attr_accessor(0, + qw(nick username userhost realname), + qw(server away)); + +sub new { + my ($class,%args) = @_; + + # 最低限Nickさえ指定されていれば良い。 + unless (defined $args{Nick}) { + croak "PersonalInfo must be created with Nick parameter.\n"; + } + + my $def_or_null = sub{ utils->get_first_defined(@_,''); }; + my $obj = bless [] => $class; + $obj->[NICK] = $def_or_null->($args{Nick}); + $obj->[USERNAME] = $def_or_null->($args{UserName}); + $obj->[USERHOST] = $def_or_null->($args{UserHost}); + $obj->[REALNAME] = $def_or_null->($args{RealName}); + $obj->[SERVER] = $def_or_null->($args{Server}); + $obj->[REMARK] = undef; # HASH + $obj->[AWAY] = $def_or_null->($args{Away}); + + $obj; +} + +sub info { + my ($this, $wantarray) = @_; + $wantarray ? + @$this[NICK, USERNAME, USERHOST] : + Tiarra::IRC::Prefix->new( + Nick => $this->nick, + User => $this->username, + Host => $this->userhost); +} + +sub remark { + my ($this, $key, $value) = @_; + if (defined($value) or @_ >= 3) { + $this->[REMARK] ||= {}; + $this->[REMARK]{$key} = $value; + } + + $this->[REMARK] ? + $this->[REMARK]{$key} : undef; +} + +1; diff -urN /non-existant-dir/main/ReloadTrigger.pm tiarra-20050322/main/ReloadTrigger.pm --- /non-existant-dir/main/ReloadTrigger.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/ReloadTrigger.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,41 @@ +# ----------------------------------------------------------------------------- +# $Id: ReloadTrigger.pm 606 2004-10-02 08:31:19Z topia $ +# ----------------------------------------------------------------------------- +# confやモジュールのリロードの引き金。 +# ----------------------------------------------------------------------------- +package ReloadTrigger; +use strict; +use warnings; +use RunLoop; +use Configuration; +use ModuleManager; +use Timer; + +sub reload_conf_if_updated { + # confファイルが更新されていたらリロードし、 + # Tiarra内のそれぞれのクラスにconfの更新を通知する。 + # モジュール側で更新された場合になにかの処理をするには、 + # Configuration::Hook の reloaded を使ってください。 + if (Configuration->shared_conf->check_if_updated) { + Configuration->shared_conf->load; + RunLoop->shared_loop->update_networks; + ModuleManager->shared_manager->update_modules; + } +} + +sub reload_mods_if_updated { + ModuleManager->shared_manager->reload_modules_if_modified; +} + +sub _install_reload_timer { + Timer->new( + Name => __PACKAGE__.'/reload', + After => 0, + Code => sub { + reload_conf_if_updated; + reload_mods_if_updated; + } + )->install; +} + +1; diff -urN /non-existant-dir/main/RunLoop.pm tiarra-20050322/main/RunLoop.pm --- /non-existant-dir/main/RunLoop.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/RunLoop.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,1280 @@ +# ----------------------------------------------------------------------------- +# $Id: RunLoop.pm 810 2005-03-06 18:58:14Z topia $ +# ----------------------------------------------------------------------------- +# このクラスはTiarraのメインループを実装します。 +# select()を実行し、サーバーやクライアントとのI/Oを行うのはこのクラスです。 +# ----------------------------------------------------------------------------- +# フック`before-select'及び`after-select'が使用可能です。 +# これらのフックは、それぞれselect()実行直前と直後に呼ばれます。 +# ----------------------------------------------------------------------------- +package RunLoop; +use strict; +use warnings; +use UNIVERSAL; +use Carp; +use IO::Socket::INET; +use IO::Select; +use Configuration; +use IrcIO::Server; +use IrcIO::Client; +use Mask; +use ModuleManager; +use Multicast; +use Timer; +use ControlPort; +use Hook; +use base qw(HookTarget); +use Tiarra::OptionalModules; +use Tiarra::ShorthandConfMixin; +use Tiarra::SharedMixin qw(shared shared_loop); +use Tiarra::Utils; +use Tiarra::TerminateManager; +our $_shared_instance; + +BEGIN { + # Time::HiResは使えるか？ + eval q{ + use Time::HiRes qw(time); + }; if ($@) { + # 使えない。 + } +} + +sub _new { + shift->new(Configuration->shared); +} + +sub new { + my ($class, $conf) = @_; + carp 'conf is not specified!' unless defined $conf; + # early initialization + my $this = { + conf => $conf, + mod_manager => undef, + }; + bless $this, $class; + + # update + %$this = ( + %$this, + + # 受信用セレクタ。あらゆるソケットは常に受信の必要があるため、あらゆるソケットが登録されている。 + receive_selector => new IO::Select, + + # 送信用セレクタ。ソケットに対して送信すべきデータがある場合は限られていて、その場合にのみ登録されて終わり次第削除される。 + send_selector => new IO::Select, + + # Tiarraがリスニングしてクライアントを受け付けるためのソケット。IO::Socket。 + tiarra_server_socket => undef, + + # 現在のnick。全てのサーバーとクライアントの間で整合性を保ちつつnickを変更する手段を、RunLoopが用意する。 + current_nick => $this->_conf_general->nick, + + # 鯖から切断された時の動作。 + action_on_disconnected => do { + my $actions = { + 'part-and-join' => \&_action_part_and_join, + 'one-message' => \&_action_one_message, + 'message-for-each' => \&_action_message_for_each, + }; + my $action_name = $this->_conf_networks->action_when_disconnected; + unless (defined $action_name) { + $action_name = 'part-and-join'; + } + my $act = $actions->{$action_name}; + if (defined $act) { + $act; + } + else { + die "Unknown action specified as networks/action-when-disconnected: $action_name\n"; + } + }, + + multi_server_mode => 1, # マルチサーバーモードに入っているか否か + + default_network => undef, # デフォルトのネットワーク名 + networks => {}, # ネットワーク名 → IrcIO::Server + clients => [], # 接続されている全てのクライアント IrcIO::Client + + timers => [], # インストールされている全てのTimer + sockets => [], # インストールされている全てのTiarra::Socket + socks_to_cleanup => [], # クリーンアップ予定のSocket(not Tiarra::Socket) + + conf_reloaded_hook => undef, # この下でインストールするフック + + terminating => 0, # 正のときは終了処理中。 + ); + + $this->{conf_reloaded_hook} = Configuration::Hook->new( + sub { + $this->_config_changed(0); + }, + )->install(undef, $this->_conf); + + $this->{default_network} = $this->_conf_networks->default; + + $this; +} + +sub DESTROY { + my $this = shift; + if (defined $this->{conf_reloaded_hook}) { + $this->{conf_reloaded_hook}->uninstall; + } +} + +sub network { + my ($class_or_this,$network_name) = @_; + my $this = $class_or_this->_this; + return $this->{networks}->{$network_name}; +} + +sub networks { + my ($class_or_this,@options) = @_; + my $this = $class_or_this->_this; + + if (defined $options[0] && $options[0] eq 'even-if-not-connected') { + $this->{networks}; + } else { + my $hash = $this->{networks}; + $hash = { + map { $_ => $hash->{$_} } + grep { $hash->{$_}->connected } + keys %$hash}; + } +} + +utils->define_attr_getter(1, qw(default_network clients), + [qw(multi_server_mode_p multi_server_mode)], + [qw(_mod_manager mod_manager)]); + +# クライアントから見た、現在のnick。 +# このnickは実際に使われているnickとは異なっている場合がある。 +# すなわち、希望のnickが既に使われていた場合である。 +utils->define_attr_getter(1, qw(current_nick)); + +sub networks_list { values %{shift->networks(@_)}; } +sub clients_list { @{shift->clients}; } + +sub channel { + # $ch_long: ネットワーク名修飾付きチャンネル名 + # 見付かったらChannelInfo、見付からなければundefを返す。 + my ($class_or_this,$ch_long) = @_; + my $this = $class_or_this->_this; + + my ($ch_short,$net_name) = Multicast::detach($ch_long); + my $network = $this->{networks}->{$net_name}; + if (!defined $network) { + return undef; + } + + $network->channel($ch_short); +} + +sub set_current_nick { + my ($class_or_this,$new_nick) = @_; + my $this = $class_or_this->_this; + $this->{current_nick} = $new_nick; + $this->call_hooks('set-current-nick'); +} + +sub change_nick { + my ($class_or_this,$new_nick) = @_; + my $this = $class_or_this->_this; + + foreach my $io ($this->networks_list) { + $io->send_message( + new IRCMessage( + Command => 'NICK', + Param => $new_nick)); + } +} + +sub _runloop { shift->_this; } + +sub sysmsg_prefix { + my ($class_or_this,$purpose,$category) = @_; + my $this = $class_or_this->_this; + $category = (caller)[0] . (defined $category ? "::$category" : ''); + # $purpose は、この関数で得た prefix を何に使うかを示す。 + # いまのところ system(NumericReply など)/priv/channel + # $category は、大まかなカテゴリ。 + # いまのところ log/system/notify があるが、 + # 明確な仕様はまだない。 + + if (Mask::match_array([ + $this->_conf_general->sysmsg_prefix_use_masks('block')-> + get($purpose, 'all')], $category)) { + $this->_conf_general->sysmsg_prefix; + } else { + undef + } +} + + +sub _config_changed { + my ($this, $init) = @_; + + my ($old, $new); + # マルチサーバーモードのOn/Offが変わったか？ + $old = $this->{multi_server_mode}; + $new = utils->cond_yesno($this->_conf_networks->multi_server_mode); + if ($old != $new) { + # 変わった + if ($init) { + $this->{multi_server_mode} = $new; + } else { + $this->_multi_server_mode_changed; + } + } +} + +sub _multi_server_mode_changed { + my $this = shift; + # 一旦全てのチャンネルについてPARTを発行した後、 + # モードを変え接続中ネットワークを更新し、NICKとJOINを発行する。 + my $new = !$this->{multi_server_mode}; + + foreach my $string ( + 'Multi server mode *'.($new ? 'enabled' : 'disabled').'*', + q{It looks as if you would part all channels, but it's just an illusion.}) { + $this->broadcast_to_clients( + IRCMessage->new( + Prefix => $this->sysmsg_prefix(qw(priv system)), + Command => 'NOTICE', + Params => [$this->current_nick, $string])); + } + + my $iterate = sub { + my $func = shift; + foreach my $network ($this->networks_list) { + foreach my $ch ($network->channels_list) { + foreach my $client ($this->clients_list) { + $func->($network, $ch, $client); + } + } + } + }; + + $iterate->( + sub { + my ($network, $ch, $client) = @_; + $client->send_message( + IRCMessage->new( + Prefix => $client->fullname, + Command => 'PART', + Params => [ + do { + if ($new) { + # これまではネットワーク名が付いていなかった。 + $ch->name; + } + else { + scalar Multicast::attach( + $ch->name, $network->network_name); + } + }, + '[Caused by Tiarra] Clients have to part all channels.', + ], + ) + ); + } + ); + $this->{multi_server_mode} = $new; + $this->update_networks; + my $global_nick = (($this->networks_list)[0])->current_nick; + if ($global_nick ne $this->current_nick) { + $this->broadcast_to_clients( + IRCMessage->new( + Command => 'NICK', + Param => $global_nick, + Remarks => {'fill-prefix-when-sending-to-client' => 1 + })); + + $this->set_current_nick($global_nick); + } + foreach my $client ($this->clients_list) { + $client->inform_joinning_channels; + } +} + +sub _update_send_selector { + my $this = shift; + # 送信する必要のあるTiarra::Socketだけを抜き出し、そのソケットを送信セレクタに登録する。 + + my $sel = $this->{send_selector} = IO::Select->new; + foreach my $socket (@{$this->{sockets}}) { + if ($socket->want_to_write) { + $sel->add($socket->sock); + } + } +} + +sub _cleanup_closed_link { + # networksとclientsの中から切断されたリンクを探し、 + # そのソケットをセレクタから外す。 + # networksならクライアントに然るべき通知をし、再接続するタイマーをインストールする。 + my $this = shift; + + my $do_update_networks_after = 0; + while (my ($network_name,$io) = each %{$this->networks('even-if-not-connected')}) { + next if $io->connected || $io->connecting; + if ($io->state_finalized) { + delete $this->{networks}->{$network_name}; + } elsif ($io->state_terminated) { + $do_update_networks_after = 1; + } + } + if ($do_update_networks_after) { + Timer->new( + After => $do_update_networks_after, + Code => sub { + $this->update_networks; + }, + )->install($this); + } + + for (my $i = 0; $i < @{$this->{clients}}; $i++) { + my $io = $this->{clients}->[$i]; + unless ($io->connected) { + #::printmsg("Connection with ".$io->fullname." has been closed."); + #$this->unregister_receive_socket($io->sock); + splice @{$this->{clients}},$i,1; + $i--; + } + } +} + +sub _action_part_and_join { + # $event: 'connected' 若しくは 'disconnected' + # 今のところ、このメソッドはconfからの削除による切断時にも流用されている。 + my ($this,$network,$event) = @_; + my $network_name = $network->network_name; + if ($event eq 'connected') { + $this->_rejoin_all_channels($network); + } + elsif ($event eq 'disconnected') { + foreach my $client (@{$this->clients}) { + foreach my $ch (values %{$network->channels}) { + $client->send_message( + IRCMessage->new( + Prefix => $client->fullname, + Command => 'PART', + Params => [Multicast::attach_for_client($ch->name,$network_name), + $network->host." closed the connection."])); + } + } + } +} +sub _action_one_message { + my ($this,$network,$event) = @_; + my $network_name = $network->network_name; + if ($event eq 'connected') { + $this->_rejoin_all_channels($network); + $this->broadcast_to_clients( + IRCMessage->new( + Prefix => $this->sysmsg_prefix(qw(priv system)), + Command => 'NOTICE', + Params => [$this->current_nick, + '*** The connection has been revived between '.$network->network_name.'.'])); + } + elsif ($event eq 'disconnected') { + $this->broadcast_to_clients( + IRCMessage->new( + Prefix => $this->sysmsg_prefix(qw(priv system)), + Command => 'NOTICE', + Params => [$this->current_nick, + '*** The connection has been broken between '.$network->network_name.'.'])); + } +} +sub _action_message_for_each { + my ($this,$network,$event) = @_; + my $network_name = $network->network_name; + if ($event eq 'connected') { + $this->_rejoin_all_channels($network); + + my $msg = IRCMessage->new( + Prefix => $this->sysmsg_prefix(qw(channel system)), + Command => 'NOTICE', + Params => ['', # チャンネル名は後で設定。 + '*** The connection has been revived between '.$network->network_name.'.']); + foreach my $ch (values %{$network->channels}) { + $msg->param(0,Multicast::attach_for_client($ch->name,$network_name)); + $this->broadcast_to_clients($msg); + } + } + elsif ($event eq 'disconnected') { + my $msg = IRCMessage->new( + Prefix => $this->sysmsg_prefix(qw(channel system)), + Command => 'NOTICE', + Params => ['', # チャンネル名は後で設定。 + '*** The connection has been broken between '.$network->network_name.'.']); + foreach my $ch (values %{$network->channels}) { + $msg->param(0,Multicast::attach_for_client($ch->name,$network_name)); + $this->broadcast_to_clients($msg); + } + } +} +sub _rejoin_all_channels { + my ($this,$network) = @_; + # networkが記憶している全てのチャンネルにJOINする。 + # そもそもJOINしていないチャンネルは通常IrcIO::Serverは記憶していないが、 + # サーバーから切断された時だけは例外である。 + # 尚、註釈kicked-outが付けられているチャンネルにはJOINしない。 + my @ch_with_key; # パスワードを持ったチャンネルの配列。要素は["チャンネル名","パスワード"] + my @ch_without_key; # パスワードを持たないチャンネルの配列。要素は"チャンネル名" + foreach my $ch (values %{$network->channels}) { + next if $ch->remarks('kicked-out'); + + my $password = $ch->parameters('k'); + if (defined $password && $password ne '') { + push @ch_with_key,[$ch->name,$password]; + } + else { + push @ch_without_key,$ch->name; + } + } + # JOIN実行 + my ($buf_ch,$buf_key) = ('',''); + my $buf_flush = sub { + return if ($buf_ch eq ''); + my $params = do { + if ($buf_key eq '') { + [$buf_ch]; + } + else { + [$buf_ch,$buf_key]; + } + }; + $network->send_message( + IRCMessage->new( + Command => 'JOIN', + Params => $params)); + $buf_ch = $buf_key = ''; + }; + my $buf_put = sub { + my ($ch,$key) = @_; + $buf_ch .= ($buf_ch eq '' ? $ch : ",$ch"); + $buf_key .= ($buf_key eq '' ? $key : ",$key") if defined $key; + if (length($buf_ch) + length($buf_key) > 400) { + # 400バイトを越えたら自動でフラッシュする。 + $buf_flush->(); + } + }; + # パスワード付きのチャンネルにJOIN + foreach (@ch_with_key) { + $buf_put->($_->[0],$_->[1]); + } + $buf_flush->(); + # パスワード無しのチャンネルにJOIN + foreach (@ch_without_key) { + $buf_put->($_); + } + $buf_flush->(); +} + +sub update_networks { + my $this = shift; + # networks/nameを読み、その中にまだ接続していないネットワークがあればそれを接続し、 + # 接続中のネットワークで既にnetworks/nameに列挙されていないものがあればそれを切断する。 + my @net_names = $this->_conf_networks->name('all'); + my $do_update_networks_after = 0; # 秒数 + my $do_cleanup_closed_links_after = 0; + my $host_tried = {}; # {接続を試みたホスト名 => 1} + + $this->{default_network} = $this->_conf_networks->default; + + # マルチサーバーモードでなければ、@net_namesの要素は一つに限られるべき。 + # そうでなければ警告を出し、先頭のものだけを残して後は捨てる。 + if (!$this->{multi_server_mode}) { + if (@net_names > 1) { + $this->notify_warn( + "In single server mode, Tiarra will connect to just a one network; `". + $net_names[0]."'"); + @net_names = $net_names[0]; + } + if (@net_names > 0) { + $this->{default_network} = $net_names[0]; + } + } + + my ($net_conf, $network, $genre); + foreach my $net_name (@net_names) { + $net_conf = $this->_conf->get($net_name); + + $network = $this->network($net_name); + eval { + if (!defined $network) { + # 新しいネットワーク + $network = IrcIO::Server->new($this, $net_name); + $this->{networks}->{$net_name} = $network; # networksに登録 + } + else { + if ($network->state_connected || $network->state_connecting) { + # 既に接続されている。 + # このサーバーについての設定が変わっていたら、一旦接続を切る。 + if (!$net_conf->equals($network->config)) { + $network->state_reconnecting(1); + $network->quit( + $this->_conf_messages->quit->netconf_changed_reconnect); + } + } elsif ($network->state_terminated) { + # 終了している + # このサーバーについての設定が変わっていたら、接続する。 + if (!$net_conf->equals($network->config)) { + $this->reconnect_server($net_name); + } + } + } + }; if ($@) { + if ($@ =~ /^[Cc]ouldn't connect to /i) { + ::printmsg($@); + } else { + $this->notify_error($@); + } + # タイマー作り直し。 + $do_update_networks_after = 3; + } + } + + if ($do_cleanup_closed_links_after) { + $this->_cleanup_closed_link; + } + + my @nets_to_disconnect; + my @nets_to_forget; + my $is_there_in_net_names = sub { + my $network_name = shift; + # このネットワークは@net_names内に列挙されているか？ + foreach my $enumerated_net (@net_names) { + return 1 if $network_name eq $enumerated_net; + } + return 0; + }; + # networksから不要なネットワークを削除 + while (my ($net_name,$server) = each %{$this->{networks}}) { + # 入っていなかったらselectorから外して切断する。 + unless ($is_there_in_net_names->($net_name)) { + push @nets_to_disconnect,$net_name; + } + } + foreach my $net_name (@nets_to_disconnect) { + my $server = $this->{networks}->{$net_name}; + $server->finalize( + $this->_conf_messages->quit->netconf_changed_disconnect); + } + + if ($do_update_networks_after) { + Timer->new( + After => $do_update_networks_after, + Code => sub { + $this->update_networks; + }, + )->install($this); + } +} + +sub terminate_server { + my ($class_or_this,$network, $msg) = @_; + my $this = $class_or_this->_this; + + $network->terminate($msg); +} + +sub reconnect_server { + # terminate/disconnect(サーバから)されたサーバへ接続しなおす。 + my ($class_or_this,$network_name) = @_; + my $this = $class_or_this->_this; + my $network = $this->network($network_name); + + $network->reconnect if defined $network; +} + +sub disconnect_server { + # 指定されたサーバーとの接続を切る。 + # fdの監視をやめてしまうので、この後IrcIO::Serverのreceiveはもう呼ばれない事に注意。 + # $server: IrcIO::Server + my ($class_or_this,$server) = @_; + my $this = $class_or_this; + $server->terminate(''); +} + +sub close_client { + # 指定したクライアントとの接続を切る。 + # $client: IrcIO::Client + my ($class_or_this, $client, $message) = @_; + my $this = $class_or_this->_this; + $client->send_message( + IRCMessage->new( + Command => 'ERROR', + Param => 'Closing Link: ['.$client->fullname_from_client. + '] ('.$message.')', + Remarks => {'send-error-as-is-to-client' => 1}, + )); + $client->disconnect_after_writing; +} + +sub reconnected_server { + my ($class_or_this,$network) = @_; + my $this = $class_or_this->_this; + # 再接続だった場合の処理 + $this->{action_on_disconnected}->($this,$network,'connected'); +} + +sub disconnected_server { + my ($class_or_this,$network) = @_; + my $this = $class_or_this->_this; + $this->{action_on_disconnected}->($this,$network,'disconnected'); +} + +sub install_socket { + my ($this,$socket) = @_; + if (!defined $socket) { + croak "RunLoop->install_socket, Arg[1] was undef.\n"; + } + + push @{$this->{sockets}},$socket; + $this->register_receive_socket($socket->sock); # 受信セレクタに登録 + undef; +} + +sub uninstall_socket { + my ($this,$socket) = @_; + if (!defined $socket) { + croak "RunLoop->uninstall_socket, Arg[1] was undef.\n"; + } + + for (my $i = 0; $i < @{$this->{sockets}}; $i++) { + if ($this->{sockets}->[$i] == $socket) { + splice @{$this->{sockets}},$i,1; + $this->unregister_receive_socket($socket->sock); # 受信セレクタから登録解除 + push @{$this->{socks_to_cleanup}},$socket->sock; + $i--; + } + } + $this; +} + +sub register_receive_socket { + # 内部 API です。外部から使うときは Tiarra::Socket または + # ExternalSocket を使用してください。 + shift->{receive_selector}->add(@_); +} + +sub unregister_receive_socket { + # 内部 API です。外部から使うときは Tiarra::Socket または + # ExternalSocket を使用してください。 + shift->{receive_selector}->remove(@_); +} + +sub find_socket_with_sock { + my ($this,$sock) = @_; + foreach my $socket (@{$this->{sockets}}) { + if (!defined $socket->sock) { + warn 'Socket '.$socket->name.': uninitialized sock!'; + } elsif ($socket->sock == $sock) { + return $socket; + } + } + undef; +} + +sub install_timer { + my ($this,$timer) = @_; + push @{$this->{timers}},$timer; + $this; +} + +sub uninstall_timer { + my ($this,$timer) = @_; + for (my $i = 0; $i < scalar(@{$this->{timers}}); $i++) { + if ($this->{timers}->[$i] == $timer) { + splice @{$this->{timers}},$i,1; + $i--; + } + } + $this; +} + +sub get_earliest_timer { + # 登録されている中で最も起動時間の早いタイマーを返す。 + # タイマーが一つも無ければundefを返す。 + my $this = shift; + return undef if (scalar(@{$this->{timers}}) == 0); + + my $eariest = $this->{timers}->[0]; + foreach my $timer (@{$this->{timers}}) { + if ($timer->time_to_fire < $eariest->time_to_fire) { + $eariest = $timer; + } + } + return $eariest; +} + +sub _execute_all_timers_to_fire { + my $this = shift; + + # executeすべきタイマーを集める + my @timers_to_execute = (); + foreach my $timer (@{$this->{timers}}) { + push @timers_to_execute,$timer if $timer->time_to_fire <= time; + } + + # 実行 + foreach my $timer (@timers_to_execute) { + $timer->execute; + } +} + +sub run { + my $this = shift->_this; + my $conf_general = $this->_conf_general; + + # config から初期化 + $this->_config_changed(1); + + # FIXME: only shared + $this->{mod_manager} = + ModuleManager->shared($this); + + # まずはtiarra-portをlistenするソケットを作る。 + # 省略されていたらlistenしない。 + # この値が数値でなかったらdie。 + my $tiarra_port = $conf_general->tiarra_port; + if (defined $tiarra_port) { + if ($tiarra_port !~ /^\d+/) { + die "general/tiarra-port must be integer. '$tiarra_port' is invalid.\n"; + } + + # v4とv6の何れを使うか？ + my @serversocket_args = ( + LocalPort => $tiarra_port, + Proto => 'tcp', + Reuse => 1, + Listen => 0); + my $ip_version = $conf_general->tiarra_ip_version || 'v4'; + my $tiarra_server_socket = do { + if ($ip_version eq 'v4') { + my $bind_addr = $conf_general->tiarra_ipv4_bind_addr; + my @args = do { + if (defined $bind_addr) { + @serversocket_args,LocalAddr => $bind_addr; + } + else { + @serversocket_args; + } + }; + IO::Socket::INET->new(@args); + } + elsif ($ip_version eq 'v6') { + if (!Tiarra::OptionalModules->ipv6) { + ::printmsg("*** IPv6 support is not enabled ***"); + ::printmsg("Set general/tiarra-ip-version to 'v4' or install Socket6.pm if possible.\n"); + die; + } + my $bind_addr = $conf_general->tiarra_ipv6_bind_addr; + my @args = do { + if (defined $bind_addr) { + @serversocket_args,LocalAddr => $bind_addr; + } + else { + @serversocket_args; + } + }; + IO::Socket::INET6->new(@args); + } + else { + die "Unknown ip-version '$ip_version' specified as general/tiarra-ip-version.\n"; + } + }; + if (defined $tiarra_server_socket) { + $tiarra_server_socket->autoflush(1); + $this->{tiarra_server_socket} = $tiarra_server_socket; + $this->register_receive_socket($tiarra_server_socket); # セレクタに登録。 + main::printmsg("Tiarra started listening ${tiarra_port}/tcp. (IP$ip_version)"); + } + else { + # ソケット作れなかった。 + die "Couldn't make server socket to listen ${tiarra_port}/tcp. (IP$ip_version)\n"; + } + } + + # 鯖に接続 + $this->update_networks; + + # 3分毎に全ての鯖にPINGを送るタイマーをインストール。 + # これはtcp接続の切断に気付かない事があるため。 + # 応答のPONGは捨てる。このためにPONG破棄カウンタをインクリメントする。 + # PONG破棄カウンタはIrcIO::Serverのremarkで、キーは'pong-drop-counter' + Timer->new( + Interval => 3 * 60, + Code => sub { + foreach my $network ($this->networks_list) { + $network->send_message( + IRCMessage->new( + Command => 'PING', + Param => $network->server_hostname)); + + my $cntr = $network->remark('pong-drop-counter'); + $network->remark('pong-drop-counter', + utils->get_first_defined($cntr,0) + 1); + } + }, + Repeat => 1, + Name => __PACKAGE__ . '/send ping', + )->install; + + # control-socket-nameが指定されていたら、ControlPortを開く。 + if ($conf_general->control_socket_name) { + eval { + ControlPort->new($conf_general->control_socket_name); + }; if ($@) { + ::printmsg($@); + } + } + + my $zerotime = { + limit => 300, + minimum_to_reset => 2, + interval => 10, + + count => 0, + last_warned => 0, + }; + my $zerotime_warn = sub { + my $elapsed = shift; + + if ($elapsed == 0) { + $zerotime->{count}++; + if ($zerotime->{count} >= $zerotime->{limit}) { + $zerotime->{count} = 0; + + if ($zerotime->{last_warned} + $zerotime->{interval} < CORE::time) { + $zerotime->{last_warned} = CORE::time; + + $this->notify_warn("Tiarra seems to be slowing down your system!"); + } + } + } + elsif ($elapsed > $zerotime->{minimum_to_reset}) { + $zerotime->{count} = 0; + } + }; + + while (1) { + # 処理の流れ + # + # 書きこみ可能なソケットを集めて、必要があれば書き込む。 + # 次に読み込み可能なソケットを集めて、(読む必要は常にあるので)読む。 + # 読んだ場合は通常IRCMessageの配列が返ってくるので、 + # 必要な全てのプラグインに順番に通す。(プラグインはフィルターとして考える。) + # それがサーバーから読んだメッセージだったなら、プラグインを通した後、接続されている全てのクライアントにそれを転送する。 + # クライアントが一つも接続されていなければ、そのIRCMessage群は捨てる。 + # クライアントから読んだメッセージだったなら、プラグインを通した後、渡すべきサーバーに転送する。 + # + # selectにおけるタイムアウトは次のようにする。 + # (普段は何かしら登録されていると思うが)タイマーが一つも登録されていなければ、タイムアウトはundefである。すなわちタイムアウトしない。 + # タイマーが一つでも登録されていた場合は、全てのタイマーの中で最も発動時間が早いものを調べ、 + # それが発動するまでの時間をselectのタイムアウト時間とする。 + + # select前フックを呼ぶ + $this->call_hooks('before-select'); + + # フック内でタイマーをinstall/発動時刻変更をした場合に備え、 + # タイムアウトの計算はbefore-selectフックの実行後にする。 + my $timeout = undef; + my $eariest_timer = $this->get_earliest_timer; + if (defined $eariest_timer) { + $timeout = $eariest_timer->time_to_fire - time; + } + if ($timeout < 0) { + $timeout = 0; + } + + # 書き込むべきデータがあるソケットだけをsend_selectorに登録する。そうでないソケットは除外。 + $this->_update_send_selector; + + # select実行 + my $time_before_select = CORE::time; + my ($readable_socks,$writable_socks,$has_exception_socks) = + IO::Select->select($this->{receive_selector},$this->{send_selector},$this->{receive_selector},$timeout); + $zerotime_warn->(CORE::time - $time_before_select); + # select後フックを呼ぶ + $this->call_hooks('after-select'); + + foreach my $sock ($this->{receive_selector}->can_read(0)) { + if (defined $this->{tiarra_server_socket} && + $sock == $this->{tiarra_server_socket}) { + + # クライアントからの新規の接続 + my $new_sock = $sock->accept; + if (defined $new_sock) { + if (!$this->{terminating}) { + eval { + my $client = new IrcIO::Client($this, $new_sock); + push @{$this->{clients}},$client; + }; if ($@) { + $this->notify_msg($@); + } + } else { + $new_sock->shutdown(2); + } + } else { + $this->notify_error('unknown readable on listen sock'); + } + } + elsif (my $socket = $this->find_socket_with_sock($sock)) { + eval { + $socket->read; + + if (UNIVERSAL::isa($socket, 'IrcIO')) { + while (1) { + my $msg = eval { + $socket->pop_queue; + }; if ($@) { + if (ref($@) && + UNIVERSAL::isa($@,'QueueIsEmptyException')) { + last; + } + else { + ::printmsg($@); + last; + } + } + + if (!defined $msg) { + next; + } + + if ($socket->isa("IrcIO::Server")) { + # このメッセージがPONGであればpong-drop-counterを見る。 + if ($msg->command eq 'PONG') { + my $cntr = $socket->remark('pong-drop-counter'); + if (defined $cntr && $cntr > 0) { + # このPONGは捨てる。 + $cntr--; + $socket->remark('pong-drop-counter',$cntr); + next; + } + } + + # メッセージをMulticastのフィルタに通す。 + my @received_messages = + Multicast::from_server_to_client($msg,$socket); + # モジュールを通す。 + my $filtered_messages = $this->_apply_filters(\@received_messages,$socket); + # シングルサーバーモードなら、ネットワーク名を取り外す。 + if (!$this->{multi_server_mode}) { + @$filtered_messages = map { + Multicast::detach_network_name($_, $socket); + } @$filtered_messages; + } + # 註釈do-not-send-to-clients => 1が付いていないメッセージを各クライアントに送る。 + $this->broadcast_to_clients( + grep { + !($_->remark('do-not-send-to-clients')); + } @$filtered_messages); + } + else { + # シングルサーバーモードなら、メッセージをMulticastのフィルタに通す。 + my @received_messages = + (!$this->{multi_server_mode}) ? Multicast::from_server_to_client($msg,$this->networks_list) : $msg; + + # モジュールを通す。 + my $filtered_messages = $this->_apply_filters(\@received_messages,$socket); + # 対象となる鯖に送る。 + # NOTICE及びPRIVMSGは返答が返ってこないので、同時にこれ以外のクライアントに転送する。 + # 註釈do-not-send-to-servers => 1が付いているメッセージはここで破棄する。 + foreach my $msg (@$filtered_messages) { + if ($msg->remark('do-not-send-to-servers')) { + next; + } + + my $cmd = $msg->command; + if ($cmd eq 'PRIVMSG' || $cmd eq 'NOTICE') { + my $new_msg = undef; # 本当に必要になったら作る。 + foreach my $client (@{$this->{clients}}) { + if ($client != $socket) { + unless (defined $new_msg) { + # まだ作ってなかった + $new_msg = $msg->clone; + $new_msg->prefix($socket->fullname); + # シングルサーバーモードなら、ネットワーク名を取り外す。 + if (!$this->{multi_server_mode}) { + Multicast::detach_network_name($new_msg,$this->networks_list); + } + + } + $client->send_message($new_msg); + } + } + } + + Multicast::from_client_to_server($msg,$socket); + } + } + } + } + }; if ($@) { + $this->notify_error($@); + } + } elsif (grep { $sock == $_ } @{$this->{socks_to_cleanup}}) { + # cleanup socket; ignore + } else { + $this->notify_error('unknown readable socket: '.$sock); + } + } + + foreach my $sock ($this->{send_selector}->can_write(0)) { + if (my $socket = $this->find_socket_with_sock($sock)) { + next unless $socket->want_to_write; + + eval { + $socket->write; + }; if ($@) { + $this->notify_error($@); + } + } elsif (grep { $sock == $_ } @{$this->{socks_to_cleanup}}) { + # cleanup socket; ignore + } else { + $this->notify_error('unknown writable socket: '.$sock); + } + } + + foreach my $sock ($this->{receive_selector}->has_exception(0)) { + if (my $socket = $this->find_socket_with_sock($sock)) { + eval { + $socket->exception; + }; if ($@) { + $this->notify_error($@); + } + } elsif (grep { $sock == $_ } @{$this->{socks_to_cleanup}}) { + # cleanup socket; ignore + } else { + $this->notify_error('unknown has-exception socket: '.$sock); + } + } + + # 切断されたソケットを探して、然るべき処理を行なう。 + $this->_cleanup_closed_link; + + # 発動すべき全てのタイマーを発動させる + $this->_execute_all_timers_to_fire; + + # Tiarra::Socket のクリーンアップ + $this->{socks_to_cleanup} = []; + + # 終了処理中でサーバもクライアントもいなくなればループ終了。 + if ($this->{terminating}) { + if ((scalar $this->networks_list('even-if-not-connected') <= 0) && + (scalar $this->clients_list <= 0) + ) { + last; + } else { + ++$this->{terminating}; + if ($this->{terminating} >= 400) { + # quit loop でそんなに回るとは思えない。 + $this->notify_error( + "very long terminating loop!". + "(".$this->{terminating}." count(s))\n". + "maybe something is wrong; exit force..."); + $this->notify_error( + join ("\n", + map {$_->network_name.": ".$_->state } + $this->networks_list('even-if-not-connected'))); + last; + } + } + } + } + + # 終了処理 + if (defined $this->{tiarra_server_socket}) { + $this->{tiarra_server_socket}->close; + $this->unregister_receive_socket($this->{tiarra_server_socket}); # 受信セレクタから登録解除 + } + $this->_mod_manager->terminate; +} + +sub terminate { + my ($class_or_this, $message) = @_; + my $this = $class_or_this->_this; + + $this->{terminating} = 1; + map { $_->finalize($message) } $this->networks_list('even-if-not-connected'); + map { $this->close_client($_, $message) } $this->clients_list; + if (defined $this->{tiarra_server_socket}) { + #buggy, close on final + #$this->{tiarra_server_socket}->shutdown(2); + } +} + +sub broadcast_to_clients { + # IRCMessageをログイン中でない全てのクライアントに送信する。 + # fill-prefix-when-sending-to-clientという註釈が付いていたら、 + # Prefixをそのクライアントのfullnameに設定する。 + my ($class_or_this,@messages) = @_; + my $this = $class_or_this->_this; + foreach my $client (@{$this->{clients}}) { + next if $client->logging_in; + + foreach my $msg (@messages) { + if ($msg->remark('fill-prefix-when-sending-to-client')) { + $msg = $msg->clone; + $msg->prefix($client->fullname); + } + $client->send_message($msg); + } + } +} + +sub broadcast_to_servers { + # IRCメッセージを全てのサーバーに送信する。 + my ($class_or_this,@messages) = @_; + my $this = $class_or_this->_this; + foreach my $network ($this->networks_list) { + foreach my $msg (@messages) { + $network->send_message($msg); + } + } +} + +sub notify_modules { + my ($class_or_this,$method,@args) = @_; + my $this = $class_or_this->_this; + foreach my $mod (@{$this->_mod_manager->get_modules}) { + eval { + $mod->$method(@args); + }; if ($@) { + $this->notify_error("Exception in ".ref($mod).".\n". + "when calling $method.\n". + " $@"); + } + } +} + +sub apply_filters { + # @extra_args: モジュールに送られる第二引数以降。第一引数は常にIRCMessage。 + my ($this, $src_messages, $method, @extra_args) = @_; + + my $source = $src_messages; + my $filtered = []; + foreach my $mod (@{$this->_mod_manager->get_modules}) { + # (普通ないはずだが) $mod が undef だったらこのモジュールをとばす。 + next unless defined $mod; + # sourceが空だったらここで終わり。 + if (scalar(@$source) == 0) { + return $source; + } + + foreach my $src (@$source) { + my @reply = (); + # 実行 + eval { + @reply = $mod->$method($src, @extra_args); + }; if ($@) { + my $modname = ref($mod); + my $error = $@; + # ブラックリストに入れておく + $this->_mod_manager->add_to_blacklist($modname); + $this->notify_error( + "Exception in ".$modname.".\n". + "This module added to blacklist!\n". + "The message was '".$src->serialize."'.\n". + " $error"); + $this->_mod_manager->remove_from_blacklist($modname); + @reply = ($src); + } + + if (defined $reply[0]) { + # 値が一つ以上返ってきた。 + # 全てIRCMessageのオブジェクトなら良いが、そうでなければエラー。 + foreach my $msg_reply (@reply) { + unless (UNIVERSAL::isa($msg_reply,'IRCMessage')) { + $this->notify_error( + "Reply of ".ref($mod)."::${method} contains illegal value.\n". + "It is ".ref($msg_reply)."."); + return $source; + } + } + + # これをfilteredに追加。 + push @$filtered,@reply; + } + } + + # 次のsourceはfilteredに。filteredは空の配列に。 + $source = $filtered; + $filtered = []; + } + return $source; +} + +sub _apply_filters { + # src_messagesは変更しない。 + my ($this, $src_messages, $sender) = @_; + $this->apply_filters( + $src_messages, 'message_arrived', $sender); +} + +sub notify_error { + my ($class_or_this,$str) = @_; + $class_or_this->notify_msg("===== ERROR =====\n$str"); +} +sub notify_warn { + my ($class_or_this,$str) = @_; + $class_or_this->notify_msg(":: WARNING :: $str"); +} +sub notify_msg { + # 渡された文字列をSTDOUTに出力すると同時に全クライアントにNOTICEする。 + # 改行コードLFで行を分割する。 + # 文字コードはUTF-8でなければならない。 + my ($class_or_this,$str) = @_; + my $this = $class_or_this->_this; + $str =~ s/\n+$//s; # 末尾のLFは消去 + + # STDOUTへ + ::printmsg($str); + + # クライアントへ + my $needed_sending = $this->_conf_general->notice_error_messages; + if ($needed_sending) { + my $client_charset = $this->_conf_general->client_out_encoding; + if (@{$this->clients} > 0) { + $this->broadcast_to_clients( + map { + IRCMessage->new( + Prefix => $this->sysmsg_prefix(qw(priv notify)), + Command => 'NOTICE', + Params => [$this->current_nick, + "*** $_"]); + } split /\n/,$str + ); + } + } +} + +# ----------------------------------------------------------------------------- +# RunLoopが一回実行される度に呼ばれるフック。 +# +# my $hook = RunLoop::Hook->new(sub { +# my $hook_itself = shift; +# # 何らかの処理を行なう。 +# })->install('after-select'); # select実行直後にこのフックを呼ぶ。 +# ----------------------------------------------------------------------------- +package RunLoop::Hook; +use FunctionalVariable; +use base 'Hook'; + +our $HOOK_TARGET_NAME = 'RunLoop'; +our @HOOK_NAME_CANDIDATES = qw(before-select after-select set-current-nick); +our $HOOK_NAME_DEFAULT = 'after-select'; +our $HOOK_TARGET_DEFAULT; +FunctionalVariable::tie( + \$HOOK_TARGET_DEFAULT, + FETCH => sub { + $HOOK_TARGET_NAME->shared_loop; + }, + ) unless defined $HOOK_TARGET_DEFAULT; + +1; diff -urN /non-existant-dir/main/Template.pm tiarra-20050322/main/Template.pm --- /non-existant-dir/main/Template.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Template.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,184 @@ +# ----------------------------------------------------------------------------- +# $Id: Template.pm 794 2005-02-28 19:07:41Z topia $ +# ----------------------------------------------------------------------------- +package Template; +use strict; +use warnings; +use Symbol; +use Carp; +use UNIVERSAL; +our $AUTOLOAD; + +sub new { + # $fpath: テンプレートとして使用するファイル + # $strip_empty_line (省略可能): やの直後の改行を削除するかどうか。 + my ($class,$fpath,$strip_empty_line) = @_; + my $this = { + original => undef, # リーフをに置換した中身。 + current => undef, # <&foo>を置換した後のもの。 + leaves => {}, # {名前 => Template} + parent => undef, # これがトップレベルでなければ、親(Template)。 + leafname => undef, # これがトップレベルでなければ、リーフ名。 + }; + bless $this,$class; + + local $/ = undef; + my $fh = gensym; + open($fh,'<',$fpath) or croak "couldn't open file $fpath"; + my $source = <$fh>; + close($fh); + ungensym($fh); + + # やの直後が改行コードなら、それを消す。 + # その改行コードから始まるスペースまたはタブも、インデントと見做して消す。 + if ($strip_empty_line) { + $source =~ s/(|)\x0d?\x0a[ \t]*/$1/g; + } + + $this->_load($source); + $this; +} + +sub reset { + my $this = shift; + $this->{current} = $this->{original}; + $this; +} + +sub expand { + # $t->expand({foo => '---' , bar => '+++'}); + # もしくは + # $t->expand(foo => '---' , bar => '+++'); + + # このメソッドは、キー内に現われたアンダースコアを + # ハイフンにフォールバックする事が出来ます。 + # つまり、<&foo-bar>というタグを、キー名"foo_bar"で指定する事が出来ます。 + my $this = shift; + my $hash = do { + if (@_ == 1 && UNIVERSAL::isa($_[0],'HASH')) { + $_[0]; + } + elsif (@_ % 2 == 0) { + my %h = @_; + \%h; + } + else { + croak "Illegal argument for Template->expand"; + } + }; + while (my ($key,$value) = each %$hash) { + # $key,$value共にスカラー値でなければならない。 + # リファならエラー。 + if (!defined $value) { + croak "Values must not be undef; key: $key"; + } + if (ref($key) ne '') { + croak "Keys and values must be scalar values: $key"; + } + if (ref($value) ne '') { + croak "Keys and values must be scalar values: $value"; + } + + if ($this->{current} !~ s/<\&\Q$key\E>/$value/g) { + # 無い。アンダースコアをハイフンに変えてみる。 + (my $tred_key = $key) =~ tr/_/-/; + if ($this->{current} !~ s/<\&\Q$tred_key\E>/$value/g) { + # そのようなキーは存在しなかった。警告。 + carp "No <\&$key> are in template, or you have replaced it already."; + } + } + } + $this; +} + +sub add { + my $this = shift; + + # 引数があればexpandする。 + if (@_ > 0) { + eval { + $this->expand(@_); + }; if ($@) { + croak $@; + } + } + + # 親が存在しなければcroak。 + if (!defined $this->{parent}) { + croak "This template doesn't have its parent."; + } + + # 親のの直前に、このリーフを挿入。 + my $str = $this->str; + $this->{parent}{current} =~ s/({leafname}\E>)/$str$1/g; + + # リセット + $this->reset; + + $this; +} + +sub str { + my $this = shift; + my $result = $this->{current}; + + # 未置換の<&foo>があればそれを消してcarp。 + while ($result =~ s/<\&(.+?)>//) { + carp "Unexpanded tag: <\&$1>"; + } + + # を消す。 + $result =~ s///g; + + $result; +} + +sub leaf { + my ($this,$leafname) = @_; + $this->{leaves}{$leafname}; +} + +sub AUTOLOAD { + my $this = shift; + (my $leafname = $AUTOLOAD) =~ s/.+?:://g; + + # アンダースコアはハイフンに置換。 + $leafname =~ tr/_/-/; + $this->{leaves}{$leafname}; +} + +sub _new_leaf { + my ($class,$parent,$leafname,$source) = @_; + my $this = { + original => undef, + current => undef, + leaves => {}, + parent => $parent, + leafname => $leafname, + }; + bless $this,$class; + + $this->_load($source); +} + +sub _load { + my ($this,$source) = @_; + + # ... をに置換しつつ、そのリーフを保存。 + while ($source =~ s/(.+?)//s) { + my ($leafname,$source) = ($1,$2); + + if (defined $this->{leaves}{$leafname}) { + # 既にこのリーフが定義されていたらcroak。 + croak "duplicated leaves in template: $leafname"; + } + else { + $this->{leaves}{$leafname} = Template->_new_leaf($this,$leafname,$source); + } + } + $this->{original} = $this->{current} = $source; + + $this; +} + +1; diff -urN /non-existant-dir/main/Tiarra/DefineEnumMixin.pm tiarra-20050322/main/Tiarra/DefineEnumMixin.pm --- /non-existant-dir/main/Tiarra/DefineEnumMixin.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/DefineEnumMixin.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,36 @@ +# ----------------------------------------------------------------------------- +# $Id: DefineEnumMixin.pm 752 2005-02-16 10:19:01Z topia $ +# ----------------------------------------------------------------------------- +# Definition Enum Mixin +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::DefineEnumMixin; +use strict; +use warnings; +use Tiarra::Utils::DefineHelper; +use base qw(Tiarra::Utils::DefineHelper); + + +# usage: +# use Tiarra::DefineEnumMixin qw(enum1 enum2 enum3...); + +# this import is equivalent as: +# BEGIN { +# use Tiarra::Utils; +# Tiarra::Utils->define_enum(qw(enum1 enum2 enum3...); +# } + +# this module is deprecated. +# please use enum.pm instead. + +sub import { + my $pkg = shift; + my @args = @_; + $pkg->do_with_define_exportlevel( + 0, + sub { + $pkg->define_enum(@args); + }); +} + +1; diff -urN /non-existant-dir/main/Tiarra/Encoding/Encode/CP932JIS.pm tiarra-20050322/main/Tiarra/Encoding/Encode/CP932JIS.pm --- /non-existant-dir/main/Tiarra/Encoding/Encode/CP932JIS.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Encoding/Encode/CP932JIS.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,120 @@ +package Tiarra::Encoding::Encode::CP932JIS; +use strict; +use warnings; +sub DEBUG () { 0 } + +our $VERSION = '1.0'; + +use Encode qw(:fallbacks); + +__PACKAGE__->Define(qw(cp932-jis)); + +use base qw(Encode::Encoding); + +# perlio not supported yet +sub perlio_ok { 0 } + +use Encode::CJKConstants qw(:all); + +# +# decode is identical for all 2022 variants +# +our $re_scan_jis = qr{ + (?:($RE{JIS_0212})|($RE{JIS_0208})|($RE{ISO_ASC})|($RE{JIS_KANA})) + ([^\e]*) +}x; + +sub decode($$;$) +{ + my ($obj, $str, $chk) = @_; + my $ret = ''; + Encode::_utf8_on($ret); + my $chr; + while (length($str)) { + if ($str =~ s/\A$re_scan_jis//s) { + my ($esc_0212, $esc_0208, $esc_asc, $esc_kana, $chunk) = + ($1, $2, $3, $4, $5); + # parse si/so + $chunk =~ s/\x0e(.+)\x0f/pack('C*', map $_ | 0x80, unpack('C*', $1))/eg; + + if ($esc_asc) { + $ret .= Encode::decode('cp932', $chunk, FB_PERLQQ); + } elsif ($esc_0212) { + # JIS X 0212-1990 + # FIXME + #$ret .= join '', '[JISX0212:', unpack('H*', $chunk), ']'; + $ret .= Encode::decode('jis0212-raw', $chunk, FB_PERLQQ); + } elsif ($esc_kana) { + # 0201 kana on G0 + $chunk =~ s/(.)/pack('C', unpack('C', $1) | 0x80)/eog; + $ret .= Encode::decode('cp932', $chunk, FB_PERLQQ); + } elsif ($esc_0208) { + # s1 = ((j1 - 1) >> 1) + ((j1 <= 0x5e) ? 0x71 : 0xb1); + # s2 = j2 + ((j1 & 1) ? ((j2 < 0x60) ? 0x1f : 0x20) : 0x7e); + my ($j1, $j2); + $chunk =~ s{(.{2})}{ + ($j1, $j2) = unpack('C*', $1); + pack('C*', + (($j1 - 1) >> 1) + (($j1 <= 0x5e) ? 0x71 : 0xb1), + $j2 + (($j1 & 1) ? (($j2 < 0x60) ? 0x1f : 0x20) : 0x7e)); + }exog; + $ret .= Encode::decode('cp932', $chunk, FB_PERLQQ); + } + } elsif ($str =~ s/\A(\e?[^\e]*)//s) { + my $str = $1; + $ret .= Encode::decode('cp932', $str, FB_PERLQQ); + } + } + return $ret; +} + +# +# encode is different +# + +sub encode($$;$) +{ + my ($obj, $utf8, $chk) = @_; + $utf8 =~ s/\x{301c}/\x{ff5e}/g; # reverse soldius + $utf8 =~ s/\x{2212}/\x{ff0d}/g; # + my $str = Encode::encode('cp932', $utf8, FB_PERLQQ) ; + my $ret = ''; + Encode::_utf8_off($ret); + my ($s1, $s2); + my $lastmode = 'ascii'; + my $startmode = sub { + my ($mode, $escape) = @_; + if ($lastmode ne $mode) { + $lastmode = $mode; + $ret .= $escape; + } + }; + while (length($str)) { + if ($str =~ s/\A((?:[\x81-\x9f\xe0-\xef].)+)//s) { + $startmode->('0208', $ESC{JIS_0208}); + # sjis 2byte + #j1 = (s1 << 1) - (s1 <= 0x9f ? 0xe0 : 0x160) - (s2 < 0x9f ? 1 : 0); + #j2 = s2 - 0x1f - (s2 >= 0x7f ? 1 : 0) - (s2 >= 0x9f ? 0x5e : 0); + foreach ($1 =~ /(..)/g) { + ($s1, $s2) = unpack('C*', $_); + $ret .= pack('C*', + ($s1 << 1) - ($s1 <= 0x9f ? 0xe0 : 0x160) - ($s2 < 0x9f ? 1 : 0), + $s2 - 0x1f - ($s2 >= 0x7f ? 1 : 0) - ($s2 >= 0x9f ? 0x5e : 0)); + } + } elsif ($str =~ s/\A([\xa1-\xdf]+)//s) { + $startmode->('0201-8bit', "\e\(J"); + foreach (split //, $1) { + #$ret .= unpack('H*', $_); + $ret .= $_; + } + } elsif ($str =~ s/\A(.)//s) { + $startmode->('ascii', $ESC{ASC}); + $ret .= $1; + } + } + $startmode->('ascii', $ESC{ASC}); + return $ret; +} + +1; +__END__ diff -urN /non-existant-dir/main/Tiarra/Encoding/Encode.pm tiarra-20050322/main/Tiarra/Encoding/Encode.pm --- /non-existant-dir/main/Tiarra/Encoding/Encode.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Encoding/Encode.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,242 @@ +# ----------------------------------------------------------------------------- +# $Id: Encode.pm 832 2005-03-08 02:19:34Z topia $ +# ----------------------------------------------------------------------------- +# Encoding with Encode +# ----------------------------------------------------------------------------- +# copyright (C) 2005 Topia . all rights reserved. +package Tiarra::Encoding::Encode; +use strict; +use warnings; +use Carp; +use Encode qw/find_encoding/; +use Encode::Guess; # for getcode +use Encode::JP::H2Z; # for h2zKana, z2hKana +BEGIN { eval { require Tiarra::Encoding::Encode::CP932JIS } } +use Tiarra::OptionalModules; +use base qw(Tiarra::Encoding); + +our %encoding_names = ( # please specify _Encode.pm's canonical_ name. + sjis => 'cp932', # compatible with unijp + ucs2 => 'UCS-2BE', + ucs4 => 'UTF-32BE', + utf8 => 'utf8', + utf16 => 'UTF-16', + jis => (find_encoding('cp932-jis') ? 'cp932-jis' : '7bit-jis'), + euc => 'euc-jp', +); + +our @default_probe_encodings = + __PACKAGE__->_find_canon_encs(qw(sjis euc utf8 jis)); + + +sub getu { + my $this = shift; + $this->{str}; +} + +sub _find_canon_encs { + my $this = shift; + my $temp; + grep { + return $_ unless wantarray; + 1; + } map { + if (exists $encoding_names{$_}) { + $encoding_names{$_}; + } else { + $temp = find_encoding($_); + if (defined $temp) { + $temp->name + } elsif ($_ ne 'auto') { + warn "Unknown encoding: $_"; + (); + } + } + } @_; +} + +sub decode { + my ($this, $str, $encoding) = @_; + + if (defined $str) { + if (ref($str) && !overload::Method($str,'""')) { + croak "string neither scalar nor stringifiable"; + } + # do stringify force to avoid bug on old Encode + $this->{str} = Encode::decode($this->_find_canon_encs($encoding), "$str"); + } + $this; +} + +sub encode { + my ($this, $encoding) = @_; + + if (defined $this->{str}) { + Encode::encode($this->_find_canon_encs($encoding), $this->{str}); + } else { + undef; + } +} + +sub getcode { + my $this = shift; + my $str = shift; + my @encodings = (@_ ? ($this->_find_canon_encs(@_)) : + @default_probe_encodings); + my $guess = find_encoding('Guess')->renew; + $guess->set_suspects(@encodings); + my ($enc, @other) = $guess->guess($str); + if (ref($enc)) { + return wantarray ? ($enc->name, $enc) : $enc->name; + } else { + if (defined $enc && $enc =~ /Encodings too ambiguous/i) { + my @probed = split / or /, shift(@other); + $enc = []; + foreach my $try_enc (@encodings) { + for (my $i = 0; $i < @probed; ++$i) { + if ($probed[$i] eq $try_enc) { + push @$enc, splice @probed, $i, 1; + last; + } + } + } + if (@$enc == 1) { + $enc = find_encoding(shift(@$enc)); + return wantarray ? ($enc->name, $enc) : $enc->name; + } + } + return wantarray ? ('unknown', $enc, @other) : 'unknown'; + } +} +sub h2z { + # only kana supported + my $this = shift; + $this->h2zKana; + $this; +} + +sub h2zKana { + my $this = shift; + my $eucjp = $this->encode($this->_find_canon_encs(qw(euc))); + Encode::JP::H2Z::h2z(\$eucjp); + $this->decode($eucjp, $this->_find_canon_encs(qw(euc))); + $this; +} + +sub z2h { + # only kana supported + my $this = shift; + $this->z2hKana; + $this; +} + +sub z2hKana { + my $this = shift; + my $eucjp = $this->encode($this->_find_canon_encs(qw(euc))); + Encode::JP::H2Z::z2h(\$eucjp); + $this->decode($eucjp, $this->_find_canon_encs(qw(euc))); + $this; +} + +foreach (qw(h2zNum h2zAlpha h2zSym z2hNum z2hAlpha z2hSym), + qw(kata2hira hira2kata), + (map { "sjis_$_" } qw(imode imode1 imode2 doti jsky jsky1 jsky2))) { + eval "sub $_ \{ shift->_not_supported_feature \}"; +} + +# common for non-unijp's + +do { + my %methods = ( + qw(get utf8), + ); + while (my ($key, $value) = each %methods) { + eval " + sub $key \{ + shift-\>conv('$value', \@_); + }"; + } + + my @methods = qw(jis euc sjis utf8 ucs2 ucs4 utf16); + foreach (@methods) { + eval " + sub $_ \{ + shift-\>conv('$_', \@_); + }"; + } +}; + +sub set { + my $this = shift; + my $str = shift; + my $code = shift; + my $encode = shift; + + if (defined $encode && defined $str) { + if ($encode eq 'base64') { + # if you have perl-bundled encode, also have mime-base64. + # (see Module::CoreList) + Tiarra::OptionalModules->check('base64') or + croak 'Couldn\'t load MIME::Base64.'; + $str = MIME::Base64::decode($str); + } + } + + if (!defined $code) { + $code = 'utf8'; + } elsif ($code eq 'auto' || $code =~ /,/) { + my @codes = (); + if ($code =~ /,/) { + # comma seperated guess-list + @codes = split(/\s*,\s*/, $code); + } + my ($enc, @enc_others) = $this->getcode($str, @codes); + if (defined $enc && $enc ne 'unknown') { + $code = $enc; + } else { + $enc = shift @enc_others; + if (ref($enc) eq 'ARRAY') { + # use first + $code = shift @$enc; + } else { + # so we can't probe encoding. + # use first of probe list. + $enc = $default_probe_encodings[0]; + } + } + } + + $this->decode($str, $code); +} + +sub conv { + my $this = shift; + my $code = shift; + my $encode = shift; + + my $str = $this->encode($code); + + if (defined $encode && defined $str) { + if ($encode eq 'base64') { + # if you have perl-bundled encode, also have mime-base64. + # (see Module::CoreList) + Tiarra::OptionalModules->check('base64') or + croak 'Couldn\'t load MIME::Base64.'; + $str = MIME::Base64::encode($str, ''); + } + } + return $str; +} + +sub _not_supported_feature { + my $this = shift; + (my $funcname = (caller(1))[3]) =~ s/^.*::(.+?)$/$1/; + die sprintf '%s is really not supported by %s', $funcname, (ref($this) || $this); +} + +sub join_csv { shift->_not_supported_feature } +sub split_csv { shift->_not_supported_feature } +sub strcut { shift->_not_supported_feature } +sub strlen { shift->_not_supported_feature } + +1; diff -urN /non-existant-dir/main/Tiarra/Encoding/UniJP.pm tiarra-20050322/main/Tiarra/Encoding/UniJP.pm --- /non-existant-dir/main/Tiarra/Encoding/UniJP.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Encoding/UniJP.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,75 @@ +# ----------------------------------------------------------------------------- +# $Id: UniJP.pm 797 2005-02-28 19:32:47Z topia $ +# ----------------------------------------------------------------------------- +# Encoding with Unicode::Japanese +# ----------------------------------------------------------------------------- +# copyright (C) 2005 Topia . all rights reserved. +package Tiarra::Encoding::UniJP; +use strict; +use warnings; +use Carp; +use base qw(Tiarra::Encoding); +use Unicode::Japanese; + +our @default_probe_encodings = qw(sjis euc utf8 jis); + +sub getcode { + my $this = shift; + my $str = shift; + my @encodings = (@_ ? @_ : @default_probe_encodings); + my $guess = $this->{unijp}->getcode($str); + + # really unknown encoding. + return $guess if $guess eq 'unknown'; + + # getcodeで検出された文字コードでencodingsに指定されているものがあれば採用。 + # 無ければencodingsの一番最初を採用する。 (UTF-8をSJISと認識したりするため。) + $guess = ((grep {$guess eq $_} @encodings), @encodings)[0]; + $guess; +} + +sub set { + my $this = shift; + my $str = shift; + my $code = shift; + + if (defined $str) { + if ($code =~ /,/) { + # comma seperated guess-list + $code = $this->getcode($str, split(/\s*,\s*/, $code)); + $code = 'binary' if $code eq 'unknown'; + } + + if (ref($str) && !overload::Method($str,'""')) { + croak "string neither scalar nor stringifiable"; + } + # do stringify force to avoid bug on unijp <= 0.26 + $this->{unijp}->set("$str", $code, @_); + } + $this; +} + +sub _init { + my $this = shift; + $this->{unijp} = Unicode::Japanese->new; +} + +sub AUTOLOAD { + our $AUTOLOAD; + my $this = shift; + + if ($AUTOLOAD =~ /::DESTROY$/) { + # DESTROYは伝達させない。 + return; + } + + (my $method = $AUTOLOAD) =~ s/.+?:://g; + if ($method =~ /^(?:h2z|z2h).*$/) { + $this->{unijp}->$method(@_); + $this; + } else { + $this->{unijp}->$method(@_); + } +} + +1; diff -urN /non-existant-dir/main/Tiarra/Encoding.pm tiarra-20050322/main/Tiarra/Encoding.pm --- /non-existant-dir/main/Tiarra/Encoding.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Encoding.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,73 @@ +# ----------------------------------------------------------------------------- +# $Id: Encoding.pm 833 2005-03-08 02:19:59Z topia $ +# ----------------------------------------------------------------------------- +# Tiarra Encoding Manager +# ----------------------------------------------------------------------------- +# copyright (C) 2005 Topia . all rights reserved. +package Tiarra::Encoding; +use strict; +use warnings; +use Carp; +our %modules = ( + qr/(uni-?jp|unicode(::|-)japanese)/i => 'UniJP', + qr/encode/i => 'Encode', + ); + +sub new { + my ($class, $str, $icode, $encode, %options) = @_; + + if ($class eq __PACKAGE__) { + if (!defined $options{provider}) { + if ($class->_is_supported('encode')) { + $options{provider} = 'encode'; + } elsif ($class->_is_supported('unijp')) { + $options{provider} = 'unijp'; + } else { + die 'supported provider not found!'; + } + } + croak "encoding provider($options{provider}) isn't supported" + unless $class->_is_supported($options{provider}); + $class->_get_module_name($options{provider})->new( + $str, $icode, $encode, %options); + } else { + my $this = {}; + bless $this, $class; + $this->_init(%options) if $this->can('_init'); + $this->set($str, $icode, $encode, %options); + } +} + +sub from_to { + my $this = shift; + my $str = shift; + my $from_code = shift; + my $to_code = shift; + + if ((defined $from_code && $from_code eq 'binary') || + (defined $to_code && $to_code eq 'binary')) { + $str; + } else { + $this->set($str, $from_code); + $this->conv($to_code); + } +} + +sub _is_supported { + my $retval = eval 'require ' . shift->_get_module_name(@_); + warn $@ if $@; + return $retval; +} + +sub _get_module_name { + my ($this, $charset) = @_; + foreach (keys %modules) { + if ($charset =~ /$_/) { + $charset = $modules{$_}; + last; + } + } + return __PACKAGE__ . '::' . $charset; +} + +1; diff -urN /non-existant-dir/main/Tiarra/IRC/Message.pm tiarra-20050322/main/Tiarra/IRC/Message.pm --- /non-existant-dir/main/Tiarra/IRC/Message.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/IRC/Message.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,380 @@ +# ----------------------------------------------------------------------------- +# $Id: Message.pm 841 2005-03-12 13:32:45Z topia $ +# ----------------------------------------------------------------------------- +# Tiarra::IRC::MessageはIRCのメッセージを表わすクラスです。実際のメッセージはUTF-8で保持します。 +# 生のメッセージのパース、シリアライズ、そしてメッセージの生成をサポートします。 +# パースとシリアライズには文字コードを指定して下さい。コードを変換します。 +# LineとEncoding以外の手段でインスタンスを生成する際は、 +# パラメータとしてUTF-8の値を渡して下さい。 +# ----------------------------------------------------------------------------- +# 生成方法一覧 +# +# $msg = new Tiarra::IRC::Message(Line => ':foo!~foo@hogehoge.net PRIVMSG #hoge :hoge', +# Encoding => 'jis'); +# print $msg->command; # 'PRIVMSG'を表示 +# +# $msg = new Tiarra::IRC::Message(Server => 'irc.hogehoge.net', # ServerはPrefixでも良い。 +# Command => '366', +# Params => ['hoge','#hoge','End of /NAMES list.']); +# print $msg->serialize('jis'); # ":irc.hogehoge.net 366 hoge #hoge :End of /NAMES list."を表示 +# +# $msg = new Tiarra::IRC::Message(Nick => 'foo', +# User => '~bar', +# Host => 'hogehoge.net', # 以上３つのパラメータの代わりにPrefix => 'foo!~bar@hogehoge.net'でも良い。 +# Command => 'NICK', +# Params => 'huga', # Paramsは要素が一つだけならスカラー値でも良い。(この時、ParamsでなくParamでも良い。) +# Remarks => {'saitama' => 'SAITAMA'}, # 備考欄。シリアライズには影響しない。 +# print $msg->serialize('jis'); # ":foo!~bar@hogehoge.net NICK :huga"を表示 +# +# $msg = new Tiarra::IRC::Message(Command => 'NOTICE', +# Params => ['foo','hugahuga']); +# print $msg->serialize('jis'); # "NOTICE foo :hugahuga"を表示 +# +package Tiarra::IRC::Message; +use strict; +use warnings; +use Carp; +use overload; +use Data::Dumper; +use Tiarra::OptionalModules; +use Tiarra::Utils; +use Tiarra::IRC::Prefix; +use Tiarra::Encoding; +use enum qw(PREFIX COMMAND PARAMS REMARKS TIME RAW_PARAMS); + +# constants +use constant MAX_MIDDLES => 14; +use constant MAX_PARAMS => MAX_MIDDLES + 1; +# max params = (middles[14] + trailing[1]) = 15 + +utils->define_array_attr_accessor(0, qw(time)); +utils->define_array_attr_translate_accessor( + 0, sub { + my ($from, $to) = @_; + "($to = $from) =~ tr/a-z/A-Z/"; + }, qw(command)); +utils->define_proxy('prefix', 0, qw(nick name host)); + +sub new { + my ($class,%args) = @_; + my $obj = bless [] => $class; + $obj->[PREFIX] = undef; + $obj->[COMMAND] = undef; + $obj->[PARAMS] = undef; + + $obj->[REMARKS] = undef; + + $obj->[TIME] = Tiarra::OptionalModules->time_hires ? + Time::HiRes::time() : CORE::time(); + + $obj->[RAW_PARAMS] = undef; + + if (exists $args{'Line'}) { + $args{'Line'} =~ s/\x0d\x0a$//s; # 行末のcrlfは消去。 + $obj->_parse($args{'Line'},$args{'Encoding'} || 'auto'); # Encodingが省略されたら自動判別 + } + else { + if (exists $args{'Prefix'}) { + $obj->prefix($args{'Prefix'}); # prefixが指定された + } + elsif (exists $args{'Server'}) { + $obj->prefix($args{'Server'}); # prefix決定 + } + else { + foreach (qw(Nick User Host)) { + if (exists $args{$_}) { + my $method = lc($_); + $obj->$method($args{$_}); + } + } + } + + # Commandは絶対に無ければならない。 + if (exists $args{'Command'}) { + $obj->command($args{'Command'}); + } + else { + die "You can't make ".__PACKAGE__." without a COMMAND."; + } + + if (exists $args{'Params'}) { + # Paramsがあった。型はスカラーもしくは配列リファ + my $params = $args{'Params'}; + my $type = ref($params); + if ($type eq '') { + $obj->[PARAMS] = [$params]; + } + elsif ($type eq 'ARRAY') { + $obj->[PARAMS] = [@$params]; # コピーを格納 + } + } + elsif (exists $args{'Param'}) { + # Paramがあった。型はスカラーのみ + $obj->[PARAMS] = [$args{'Param'}]; + } + } + if (exists $args{'Remarks'}) { + $obj->[REMARKS] = {%{$args{'Remarks'}}}; + } + $obj; +} + +sub clone { + my ($this, %args) = @_; + if ($args{deep}) { + eval + Data::Dumper->new([$this])->Terse(1)->Deepcopy(1)->Purity(1)->Dump; + } else { + my @new = @$this; + # do not clone raw_params. this behavior is by design. + # (we want to handle _raw_params by outside. + # if you want, please re-constract or use deep => 1.) + $new[PARAMS] = [@{$this->[PARAMS]}] if defined $this->[PARAMS]; + $new[REMARKS] = {%{$this->[REMARKS]}} if defined $this->[REMARKS]; + bless \@new => ref($this); + } +} + +sub _parse { + my ($this,$line,$encoding) = @_; + delete $this->[PREFIX]; + delete $this->[COMMAND]; + delete $this->[PARAMS]; + delete $this->[RAW_PARAMS]; + my $param_count_warned = 0; + + my $pos = 0; + # prefix + if (substr($line,0,1) eq ':') { + # :で始まっていたら + my $pos_space = index($line,' '); + $this->prefix(substr($line,1,$pos_space - 1)); + $pos = $pos_space + 1; # スペースの次から解釈再開 + } + # command & params + my $add_command_or_param = sub { + my $value_raw = shift; + if ($this->command) { + # commandはもう設定済み。次はパラメータだ。 + $this->_raw_push($value_raw); + } + else { + # まだコマンドが設定されていない。 + $this->command($value_raw); + } + }; + while (1) { + my $param = ''; + + my $pos_space = index($line,' ',$pos); + if ($pos_space == -1) { + # 終了 + $param = substr($line,$pos); + } + else { + $param = substr($line,$pos,$pos_space - $pos); + } + + if ($param ne '') { + if ($this->n_params > MAX_PARAMS && !$param_count_warned) { + $param_count_warned = 1; + carp 'max param exceeded; please fix upstream server!'; + } + if (substr($param,0,1) eq ':') { + $param = substr($line, $pos); # これ以降は全て一つの引数。 + $param =~ s/^://; # :があった場合は外す。 + $add_command_or_param->($param); + last; # ここで終わり。 + } + else { + $add_command_or_param->($param); + } + } + + if ($pos_space == -1) { + last; + } + else { + $pos = $pos_space + 1; # スペースの次から解釈再開 + } + } + + $this->encoding_params($encoding); + + # 解釈結果の正当性をチェック。 + # commandが無かったらdie。 + unless ($this->COMMAND) { + croak __PACKAGE__." parsed invalid one, which doesn't have command.\n $line"; + } +} + +sub serialize { + # encodingを省略するとutf8になる。 + my ($this,$encoding) = @_; + $encoding = 'utf8' unless defined $encoding; + my $result = ''; + + if ($this->prefix) { + $result .= ':'.$this->prefix.' '; + } + + $result .= $this->command.' '; + + if ($this->[PARAMS]) { + my $unicode = Tiarra::Encoding->new; + my $n_params = $this->n_params; + if ($n_params > MAX_PARAMS) { + # 表現不能なので croak (危険なので carp で……) + carp 'this message exceeded maximum param numbers!'; + } + for (my $i = 0;$i < $n_params;$i++) { + my $arg = $this->[PARAMS]->[$i]; + if ($i == $n_params - 1) { + # 最後のパラメタなら頭にコロンを付けて後にはスペースを置かない。 + # 但し半角スペースが一つも無く、且つコロンで始まっていなければコロンを付けない。 + # パラメタが空文字列であった場合は例外としてコロンを付ける。 + # また、 remark/always-use-colon-on-last-param が付いていた場合も + # コロンを付ける。 + $arg = $unicode->from_to($arg, 'utf8', $encoding); + if (length($arg) > 0 and + index($arg, ' ') == -1 and + index($arg, ':') != 0 and + !$this->remark('always-use-colon-on-last-param')) { + $result .= $arg; + } + else { + $result .= ":$arg"; + } + # 本当はCTCPメッセージを外してエンコードすべきかも知れない。 + } + else { + # 最後のパラメタでなければ後にスペースを置く。 + # do stringify force to avoid bug on unijp + $result .= $unicode->from_to($arg, 'utf8', $encoding).' '; + } + } + } + + return $result; +} + +sub length { + my ($this) = shift; + CORE::length($this->serialize(@_)); +} + +sub params { + croak "Parameter specified to params(). You must mistaked with param().\n" if (@_ > 1); + my $this = shift; + $this->[PARAMS] = [] unless defined $this->[PARAMS]; + $this->[PARAMS]; +} + +sub n_params { + scalar @{shift->params}; +} + +sub param { + my ($this,$index,$new_value) = @_; + croak "Parameter index wasn't specified to param(). You must be mistaken with params().\n" if (@_ <= 1); + if (defined $new_value) { + $this->[PARAMS]->[$index] = $new_value; + } + $this->[PARAMS]->[$index]; +} + +sub push { + my $this = shift; + CORE::push(@{$this->params}, @_); +} + +sub pop { + CORE::pop(@{shift->params}); +} + +sub _raw_params { + my $this = shift; + $this->[RAW_PARAMS] = [] unless defined $this->[RAW_PARAMS]; + $this->[RAW_PARAMS]; +} + +sub purge_raw_params { + shift->[RAW_PARAMS] = []; +} + +sub _raw_push { + my $this = shift; + CORE::push(@{$this->_raw_params}, @_); +} + +sub _raw_pop { + CORE::pop(@{shift->_raw_params}); +} + +sub _n_raw_params { + scalar @{shift->_raw_params}; +} + +sub have_raw_params { + shift->_n_raw_params > 0; +} + +sub remark { + my ($this,$key,$value) = @_; + # remark() -> HASH* + # remark('key') -> SCALAR + # remark('key','value') -> 'value' + if (!defined($key)) { + $this->[REMARKS] || {}; + } + else { + if (defined $value) { + if (defined $this->[REMARKS]) { + $this->[REMARKS]->{$key} = $value; + } + else { + $this->[REMARKS] = {$key => $value}; + } + } + defined $this->[REMARKS] ? + $this->[REMARKS]->{$key} : undef; + } +} + +sub encoding_params { + my ($this, $encoding) = @_; + + if (!$this->have_raw_params) { + if ($this->n_params) { + croak "raw_params already purged; cannot re-encoding"; + } else { + # we don't have any params + return undef; + } + } + + my $unicode = Tiarra::Encoding->new; + + # clear + @{$this->params} = (); + + foreach my $value_raw (@{$this->_raw_params}) { + my $value = do { + if (CORE::length ($value_raw) == 0) { + ''; + } else { + $unicode->from_to($value_raw,$encoding,'utf8'); + } + }; + $this->push($value); + } +} + +sub prefix { + my $this = shift; + $this->[PREFIX] ||= Tiarra::IRC::Prefix->new; + $this->[PREFIX]->prefix(shift) if $#_ >= 0; + $this->[PREFIX]; +} + +1; diff -urN /non-existant-dir/main/Tiarra/IRC/Prefix.pm tiarra-20050322/main/Tiarra/IRC/Prefix.pm --- /non-existant-dir/main/Tiarra/IRC/Prefix.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/IRC/Prefix.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,81 @@ +# ----------------------------------------------------------------------------- +# $Id: Prefix.pm 771 2005-02-24 05:41:03Z topia $ +# ----------------------------------------------------------------------------- +# Tiarra:: +# ----------------------------------------------------------------------------- +# copyright (C) 2005 Topia . all rights reserved. +package Tiarra::IRC::Prefix; +use strict; +use warnings; +use enum qw(PREFIX NICK NAME HOST); +use Tiarra::Utils; +use overload + '""' => sub { shift->prefix }; + +utils->define_array_attr_notify_accessor( + 0, '$this->_update_prefix', qw(nick name host)); +utils->define_array_attr_notify_accessor( + 0, '$this->_parse_prefix', qw(prefix)); + +sub new { + my ($class,%args) = @_; + my $obj = bless [] => $class; + $obj->[PREFIX] = undef; + $obj->[NICK] = undef; + $obj->[NAME] = undef; + $obj->[HOST] = undef; + + foreach (qw(Prefix Nick User Host)) { + if (exists $args{$_}) { + my $method = lc($_); + $obj->$method($args{$_}); + } + } + $obj; +} + +sub _parse_prefix { + my $this = shift; + delete $this->[NICK]; + delete $this->[NAME]; + delete $this->[HOST]; + if (defined $this->[PREFIX]) { + if ($this->[PREFIX] !~ /@/) { + $this->[NICK] = $this->[PREFIX]; + } elsif ($this->[PREFIX] =~ m/^(.+?)!(.+?)@(.+)$/) { + $this->[NICK] = $1; + $this->[NAME] = $2; + $this->[HOST] = $3; + } elsif ($this->[PREFIX] =~ m/^(.+?)@(.+)$/) { + $this->[NICK] = $1; + $this->[HOST] = $2; + } + } else { + delete $this->[PREFIX]; + } +} + +sub _update_prefix { + my $this = shift; + if (defined $this->[NICK]) { + $this->[PREFIX] = $this->[NICK]; + if (defined $this->[HOST]) { + if (defined $this->[NAME]) { + $this->[PREFIX] .= '!'.$this->[NAME]; + $this->[PREFIX] .= '@'.$this->[HOST]; + } else { + $this->[PREFIX] .= '@'.$this->[HOST]; + delete $this->[NAME]; + } + } else { + delete $this->[NAME]; + delete $this->[HOST]; + } + } else { + delete $this->[NICK]; + delete $this->[NAME]; + delete $this->[HOST]; + } +} + +1; diff -urN /non-existant-dir/main/Tiarra/ModifiedFlagMixin.pm tiarra-20050322/main/Tiarra/ModifiedFlagMixin.pm --- /non-existant-dir/main/Tiarra/ModifiedFlagMixin.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/ModifiedFlagMixin.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,23 @@ +# ----------------------------------------------------------------------------- +# $Id: ModifiedFlagMixin.pm 598 2004-09-28 01:44:59Z topia $ +# ----------------------------------------------------------------------------- +# Modified Flag Mixin +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::ModifiedFlagMixin; +use strict; +use warnings; +use Tiarra::Utils; +use Exporter; +use base qw(Exporter); +our @EXPORT = qw(set_modified clear_modified modified); + +# usage: +# use Tiarra::ModifiedFlagMixin; + +Tiarra::Utils->define_attr_accessor(0, qw(modified)); + +sub set_modified { shift->modified(1); } +sub clear_modified { shift->modified(0); } + +1; diff -urN /non-existant-dir/main/Tiarra/OptionalModules.pm tiarra-20050322/main/Tiarra/OptionalModules.pm --- /non-existant-dir/main/Tiarra/OptionalModules.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/OptionalModules.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,78 @@ +# ----------------------------------------------------------------------------- +# $Id: OptionalModules.pm 798 2005-02-28 19:48:36Z topia $ +# ----------------------------------------------------------------------------- +# Optional Modules Loader +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::OptionalModules; +use strict; +use warnings; +use Tiarra::SharedMixin; +use Tiarra::Utils; +# failsafe to module-reload +our $status = {}; +our %modules = ( + 'threads' => [qw(threads threads::shared)], + 'ipv6' => [qw(IO::Socket::INET6)], + 'time_hires' => [qw(Time::HiRes)], + 'unix_dom' => [qw(IO::Socket::UNIX)], + 'encode' => [qw(Encode)], + 'base64' => [qw(MIME::Base64)], + ); + +sub _new { + bless $status, shift; +} + +sub all_modules { + keys %modules; +} + +sub repr_modules { + my $this = shift->_this; + $this->check_all; + my @enabled = sort grep $this->check($_), keys %modules; + my @disabled = sort grep !$this->check($_), keys %modules; + + ((@enabled ? + ("enabled:", + map { + " - $_ (" . join(', ', map { + "$_ " . $_->VERSION; + } @{$modules{$_}}) . ")" + } @enabled) : ()), + (@disabled ? + ("disabled:", + map { + " - $_ (" . join(', ', @{$modules{$_}}) . ")" + } @disabled) : ())); +} + +sub check_all { + my $this = shift->_this; + map { ($_, $this->check($_)) } $this->all_modules; +} + +sub check { + my ($class_or_this, $name) = @_; + my $this = $class_or_this->_this; + + return $this->{$name} if defined $this->{$name}; + die "module $name spec. not found" unless defined $modules{$name}; + + $this->{$name} = eval join(' && ', map { "require $_" } @{$modules{$name}}) . ';'; +} + +sub AUTOLOAD { + my $this = shift; + our $AUTOLOAD; + if ($AUTOLOAD =~ /::DESTROY$/) { + # DESTROY篌 + return; + } + + (my $key = $AUTOLOAD) =~ s/.+?:://g; + $this->check($key); +} + +1; diff -urN /non-existant-dir/main/Tiarra/Resolver.pm tiarra-20050322/main/Tiarra/Resolver.pm --- /non-existant-dir/main/Tiarra/Resolver.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Resolver.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,338 @@ +# ----------------------------------------------------------------------------- +# $Id: Resolver.pm 680 2004-10-18 21:01:16Z topia $ +# ----------------------------------------------------------------------------- +# Simple Resolver with multi-thread or blocking. +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::Resolver::QueueData; +use strict; +use warnings; +use Tiarra::DefineEnumMixin (qw(ID TIMEOUT), + qw(QUERY_TYPE QUERY_DATA ANSWER_STATUS ANSWER_DATA)); +use Tiarra::DefineEnumMixin (qw(ANSWER_OK ANSWER_NOT_FOUND ANSWER_TIMEOUT), + qw(ANSWER_NOT_SUPPORTED ANSWER_INTERNAL_ERROR)); +use Tiarra::Utils; +Tiarra::Utils->define_array_attr_accessor( + 0, qw(id timeout query_type query_data answer_status answer_data)); + +sub new { + my $class = shift; + + # FIXME: check type/value! + my $this = [@_]; + bless $this, $class; + $this; +} + +sub serialize { + my $this = shift; + + my @array : shared = @$this; + \@array; +} + +sub parse { + my $this = shift; + + ref($this)->new(@{+shift}); +} + +package Tiarra::Resolver; +use strict; +use warnings; +use Tiarra::OptionalModules; +use Tiarra::SharedMixin; +use Tiarra::WrapMainLoop; +use Tiarra::TerminateManager; +use Socket; +use Carp; +use Net::hostent; +use Tiarra::DefineEnumMixin qw(QUERY_HOST QUERY_ADDR QUERY_SADDR); +my $dataclass = 'Tiarra::Resolver::QueueData'; +our $use_threads; +our $use_ipv6; +BEGIN { + $use_threads = Tiarra::OptionalModules->threads; + if ($use_threads) { + eval 'use Thread::Queue'; + } + + $use_ipv6 = Tiarra::OptionalModules->ipv6; + if ($use_ipv6) { + eval 'use Socket6;'; + } else { + # dummy + *AI_NUMERICHOST = sub () { undef }; + *NI_NUMERICHOST = sub () { undef }; + *NI_NAMEREQD = sub () { undef }; + } +} + +if ($use_threads) { + # fast initialize(for minimal thread) + __PACKAGE__->shared; +} + +sub _new { + my $class = shift; + + my $this = {}; + bless $this, $class; + + if ($use_threads) { + $this->{ask_queue} = Thread::Queue->new; + $this->{reply_queue} = Thread::Queue->new; + $this->{thread} = threads->create("resolver_thread", + $class, + $this->{ask_queue}, + $this->{reply_queue}); + $this->{mainloop} = Tiarra::WrapMainLoop->new( + type => 'timer', + interval => 2, + closure => sub { + $this->mainloop; + }); + $this->{destructor} = Tiarra::TerminateManager::Hook->new( + sub { + $this->destruct; + })->install; + } + $this->{id} = 0; + $this->{closures} = {}; + $this; +} + +sub destruct { + my $this = shift; + + $this->{ask_queue}->enqueue(undef); + $this->{thread}->join; +} + +sub resolve { + my ($class_or_this, $type, $data, $closure, $my_use_threads) = @_; + my $this = $class_or_this->_this; + + $my_use_threads = $use_threads unless defined $my_use_threads; + croak 'data not defined; please specify this' unless defined $data; + croak 'closure not defined; please specify this' unless defined $closure; + my $entry = $dataclass->new; + my $do = undef; + if ($type eq 'addr') { + $entry->query_type(QUERY_ADDR); + $entry->query_data($data); + $do = 1; + } elsif ($type eq 'host') { + $entry->query_type(QUERY_HOST); + $entry->query_data($data); + $do = 1; + } elsif ($type eq 'saddr') { + $entry->query_type(QUERY_SADDR); + $entry->query_data($data); + $do = 1; + } + if ($do) { + $entry->timeout(0); + $entry->id($this->{id}++); + $this->{closures}->{$entry->id} = $closure; + if ($my_use_threads) { + $this->{ask_queue}->enqueue($entry->serialize); + $this->{mainloop}->lazy_install; + undef; + } else { + $this->_call($this->_resolve($entry)); + } + } else { + undef; + } +} + +sub paranoid_check { + # ip -> host -> ip check + my ($class_or_this, $data, $closure, $my_use_threads) = @_; + my $this = $class_or_this->_this; + + # stage 1 + $this->resolve( + 'host', $data, sub { + eval { + $this->_paranoid_stage1($data, $closure, $my_use_threads, shift); + }; if ($@) { + $closure->(0, undef); + } + }, $my_use_threads); +} + +sub _paranoid_stage1 { + my ($this, $data, $closure, $my_use_threads, $entry) = @_; + + if ($entry->answer_status eq $entry->ANSWER_OK) { + my $host = $entry->answer_data; + if (ref($host) eq 'ARRAY') { + # FIXME: support multiple hostname resolved + $host = $host->[0]; + } + $this->resolve( + 'addr', $host, sub { + eval { + $this->_paranoid_stage2($data, $closure, $my_use_threads, shift); + }; if ($@) { + $closure->(0, undef, $entry); + } + }, $my_use_threads); + } else { + $closure->(0, undef, $entry); + } +} + +sub _paranoid_stage2 { + my ($this, $data, $closure, $my_use_threads, $entry) = @_; + + if ($entry->answer_status eq $entry->ANSWER_OK) { + if (grep { $data eq $_ } @{$entry->answer_data}) { + $closure->(1, $entry->query_data, $entry); + } + } else { + $closure->(0, undef, $entry); + } +} + +sub _call { + my ($this, $entry) = @_; + + my $id = $entry->id; + $this->{closures}->{$id}->($entry); + delete $this->{closures}->{$id}; + if (!%{$this->{closures}} && $use_threads) { + $this->{mainloop}->lazy_uninstall; + } + $entry; +} + +sub _resolve { + my ($class_or_this, $entry) = @_; + + my $resolved = undef; + my $ret = undef; + + if ($entry->query_type eq QUERY_ADDR) { + if ($use_ipv6 && !$resolved) { + my @res = getaddrinfo($entry->query_data, 0, AF_UNSPEC, SOCK_STREAM); + my ($saddr, $addr, @addrs, %addrs); + threads::shared::share(@addrs) if $use_threads; + while (scalar(@res) >= 5) { + # check proto,... etc + (undef, undef, undef, $saddr, undef, @res) = @res; + ($addr, undef) = getnameinfo($saddr, NI_NUMERICHOST); + if (defined $addr && !$addrs{$addr}) { + $addrs{$addr} = 1; + push(@addrs, $addr); + } + } + if (@addrs) { + $entry->answer_data(\@addrs); + $resolved = 1; + } + } + if (!$resolved) { + my $hostent = Net::hostent::gethost($entry->query_data); + if (defined $hostent) { + #$entry->answer_data($hostent->addr_list); + my @addrs; + threads::shared::share(@addrs) if $use_threads; + @addrs = map { + inet_ntoa($_); + } @{$hostent->addr_list}; + $entry->answer_data(\@addrs); + $resolved = 1; + } + } + } elsif ($entry->query_type eq QUERY_HOST) { + if ($use_ipv6 && !$resolved) { + my @res = getaddrinfo($entry->query_data, 0, AF_UNSPEC, SOCK_STREAM); + my ($saddr, $host, @hosts, %hosts); + threads::shared::share(@hosts) if $use_threads; + while (scalar(@res) >= 5) { + # check proto,... etc + (undef, undef, undef, $saddr, undef, @res) = @res; + ($host, undef) = getnameinfo($saddr, NI_NAMEREQD); + if (defined $host && !$hosts{$host}) { + $hosts{$host} = 1; + push(@hosts, $host); + } + } + if (@hosts) { + if (@hosts == 1) { + $entry->answer_data($hosts[0]); + } else { + $entry->answer_data(\@hosts); + } + $resolved = 1; + } + } + if (!$resolved) { + my $hostent = Net::hostent::gethost($entry->query_data); + if (defined $hostent) { + $entry->answer_data($hostent->name); + $resolved = 1; + } + } + } elsif ($entry->query_type eq QUERY_SADDR) { + if ($use_ipv6 && !$resolved) { + my @res = getaddrinfo($entry->query_data->[0], + $entry->query_data->[1], + AF_UNSPEC, SOCK_STREAM); + my ($saddr); + (undef, undef, undef, $saddr, undef, @res) = @res; + if (defined $saddr) { + $entry->answer_data($saddr); + $resolved = 1; + } + } + if (!$resolved) { + my $addr = inet_aton($entry->query_data->[0]); + $entry->answer_data(pack_sockaddr_in($entry->query_data->[1], + $addr)); + $resolved = 1; + } + } else { + carp 'unsupported query type('.$entry->query_type.')'; + $entry->answer_status($entry->ANSWER_NOT_SUPPORTED); + } + + if ($resolved) { + $entry->answer_status($entry->ANSWER_OK); + } else { + $entry->answer_status($entry->ANSWER_NOT_FOUND); + } + return $entry; +} + +sub resolver_thread { + my ($class, $ask_queue, $reply_queue) = @_; + + my ($data, $entry); + while (defined ($data = $ask_queue->dequeue)) { + $entry = $dataclass->new->parse($data); + eval { + $reply_queue->enqueue($class->_resolve($entry)->serialize); + }; if ($@) { + $data->answer_status($entry->ANSWER_INTERNAL_ERROR); + $data->answer_data($@); + $reply_queue->enqueue($data->serialize); + } + } + return 0; +} + +sub mainloop { + my $this = shift; + + my $entry; + while ($this->{reply_queue}->pending) { + $entry = $this->{reply_queue}->dequeue; + $this->_call($dataclass->new->parse($entry)); + } +} + +1; diff -urN /non-existant-dir/main/Tiarra/SessionMixin.pm tiarra-20050322/main/Tiarra/SessionMixin.pm --- /non-existant-dir/main/Tiarra/SessionMixin.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/SessionMixin.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,113 @@ +# ----------------------------------------------------------------------------- +# $Id: SessionMixin.pm 664 2004-10-17 15:41:42Z topia $ +# ----------------------------------------------------------------------------- +# Session Mixin +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::SessionMixin; +use strict; +use warnings; +use Tiarra::OptionalModules; +use Tiarra::Utils; +use Carp; +use base qw(Tiarra::Utils); +our $use_threads = Tiarra::OptionalModules->threads; + +# usage: +# use Tiarra::SessionMixin; +# use base qw(SessionMixin); +# sub new { +# ... +# $this->_session_init; +# } + +__PACKAGE__->define_attr_accessor(0, qw(session_level)); +sub _session_init { + my $this = shift; + $this->session_level(0); + if ($use_threads) { + my $lock : shared; + $this->{lock} = \$lock; + } + $this->{session_name} = (caller)[0].' session'; +} + +sub session_name { + my $this = shift; + $this->get_first_defined( + eval { $this->name; }, + $this->{session_name}); +} + +sub __session_start { + my $this = shift; + if ($this->session_level == 1) { + carp 'this object already started...'; + } + eval { $this->_before_session_start; }; + ++$this->session_level; + eval { $this->_after_session_start; }; + 1; +} + +sub __session_finish { + my $this = shift; + if ($this->session_level == 0) { + carp 'this object already finished!'; + $this->session_level = 1; + } + eval { $this->_before_session_finish; }; + --$this->session_level; + eval { $this->_after_session_finish; }; + 1; +} + +sub with_session { + my ($this, $closure) = @_; + my $wantarray = wantarray; + my $level = $this->session_level; + $this->__session_start unless $level; + lock $this->{lock} if $use_threads; + $this->do_with_ensure( + sub { + $this->do_with_errmsg( + $this->session_name, + sub { + $this->call_with_wantarray($wantarray, $closure); + } + ); + }, + sub { $this->__session_finish unless $level; }); +} + +sub define_session_wrap { + my $pkg = shift; + my $class_method_p = shift; + foreach (@_) { + my ($funcname, $proxyname); + if (ref($_) eq 'ARRAY') { + $funcname = $_->[0]; + $proxyname = $_->[1]; + } else { + $funcname = $_; + $proxyname = "_$_"; + } + $pkg->define_function( + $pkg->get_package, + ($class_method_p ? sub { + my $class_or_this = shift; + my $this = $class_or_this->_this; + $this->with_session( + sub { $this->$proxyname(@_) } + ); + } : sub { + my $this = shift; + $this->with_session( + sub { $this->$proxyname(@_) } + ); + }), + $funcname); + } +} + +1; diff -urN /non-existant-dir/main/Tiarra/SharedMixin.pm tiarra-20050322/main/Tiarra/SharedMixin.pm --- /non-existant-dir/main/Tiarra/SharedMixin.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/SharedMixin.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,71 @@ +# ----------------------------------------------------------------------------- +# $Id: SharedMixin.pm 845 2005-03-20 09:19:41Z topia $ +# ----------------------------------------------------------------------------- +# Shared Instance(Singleton) Mixin +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::SharedMixin; +use strict; +use warnings; +use base qw(Tiarra::Utils); +our $ExportLevel = 0; + +# usage: +# use Tiarra::SharedMixin qw(shared shared_module); +# our $_shared_instance; # optional, but useful for documentation. +# sub _new { +# my $class = shift; +# my ($this) = {@_}; +# bless $this, $class; +# #__PACKAGE__->shared->some_func; # can't use +# return $this; +# } +# sub _initialize { # optional +# my $this = shift; +# __PACKAGE__->shared->some_func; # OK +# } +# __PACKAGE__->_shared_init(args...); + +# use $_shared_instance variable. +# import shared and _shared_init and _this functions. + +sub import { + my $pkg = shift; + my $call_pkg = $pkg->get_package($ExportLevel); + my $instance_name = $call_pkg.'::_shared_instance'; + if ($#_ != 0) { + push(@_, 'shared'); + } + my @funcnames = @_; + + no strict 'refs'; + # fastest call + no warnings; + + $pkg->define_function( + $call_pkg, + sub { + my $class = shift; + if (!defined ${$instance_name}) { + ${$instance_name} = $call_pkg->_new(@_); + eval { + # safe initialize with ->shared. + ${$instance_name}->_initialize(@_); + }; + } + $pkg->define_function( + $call_pkg, + sub () { ${$instance_name} }, + @funcnames); + ${$instance_name}; + }, + @funcnames, + '_shared_init'); + + $pkg->define_function( + $call_pkg, + $pkg->can('_this'), + '_this'); +} + +1; diff -urN /non-existant-dir/main/Tiarra/ShorthandConfMixin.pm tiarra-20050322/main/Tiarra/ShorthandConfMixin.pm --- /non-existant-dir/main/Tiarra/ShorthandConfMixin.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/ShorthandConfMixin.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,26 @@ +# ----------------------------------------------------------------------------- +# $Id: ShorthandConfMixin.pm 542 2004-09-11 08:26:06Z topia $ +# ----------------------------------------------------------------------------- +# Shorthand writing conf Mixin +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::ShorthandConfMixin; +use strict; +use warnings; +use Exporter; +use base qw(Exporter); +our @EXPORT = qw(_conf _conf_general _conf_networks _conf_messages); + +# usage: +# use Tiarra::ShorthandConfMixin; +# use base qw(Tiarra::ShorthandConfMixin) + +# use _runloop function. + +# shorthand for Configuration->shared->... +sub _conf { shift->_runloop->{conf}; } +sub _conf_general { shift->_conf->general; } +sub _conf_networks { shift->_conf->networks; } +sub _conf_messages { shift->_conf_general->messages; } + +1; diff -urN /non-existant-dir/main/Tiarra/Socket/Buffered.pm tiarra-20050322/main/Tiarra/Socket/Buffered.pm --- /non-existant-dir/main/Tiarra/Socket/Buffered.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Socket/Buffered.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,173 @@ +# ----------------------------------------------------------------------------- +# $Id: Buffered.pm 780 2005-02-24 15:02:10Z topia $ +# ----------------------------------------------------------------------------- +# Buffered Socket +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::Socket::Buffered; +use strict; +use warnings; +use Carp; +use Tiarra::Socket; +use base qw(Tiarra::Socket); +use Tiarra::Utils; +utils->define_attr_getter(0, qw(connected)); +utils->define_attr_accessor(0, qw(recvbuf sendbuf)); + +sub new { + my ($class, %opts) = @_; + + $class->_increment_caller('buffered-socket', \%opts); + my $this = $class->SUPER::new(%opts); + $this->{connected} = undef; + $this->{sendbuf} = ''; + $this->{recvbuf} = ''; + $this->{disconnect_after_writing} = 0; + $this; +} + +sub DESTROY { + my $this = shift; + + $this->disconnect if $this->connected; +} + +sub disconnect_after_writing { + shift->{disconnect_after_writing} = 1; +} + +sub disconnect { + my ($this, $errno, $genre, @params) = @_; + + $this->uninstall if $this->installed; + $this->close; +} + +sub attach { + my ($this, $sock) = @_; + return undef if $this->connected; + return undef unless defined $sock; + + $this->SUPER::attach($sock); + $this->{connected} = 1; + + return $this; +} + +sub detach { + my $this = shift; + + if (!defined $this->sock) { + croak "already detached; can't detach!"; + } + if ($this->installed) { + carp "installed; anyway detach..."; + $this->uninstall; + } + + $this->{connected} = 0; + $this->{sendbuf} = ''; + $this->{recvbuf} = ''; + $this->SUPER::detach; +} + +sub write_length { length shift->sendbuf } +# 送るべきデータがあれば1、無ければ0を返します。 +sub want_to_write { shift->write_length > 0 } +sub read_length { length shift->recvbuf } +sub has_data { shift->read_length > 0 } + +sub append { + my ($this, $str) = @_; + + $this->sendbuf .= $str; +} + +sub write { + my ($this) = @_; + # このメソッドはソケットに送れるだけのメッセージを送ります。 + # 送信の準備が整っていなかった場合は、このメソッドは操作をブロックします。 + # それがまずいのなら予めselectで書き込める事を確認しておいて下さい。 + if (!$this->connected) { + die "write : socket is not connected.\n"; + } + + my $bytes_sent = $this->sock->syswrite($this->sendbuf, $this->write_length); + if (defined $bytes_sent) { + substr($this->sendbuf, 0, $bytes_sent) = ''; + + if ($this->{disconnect_after_writing} && + !$this->want_to_write) { + $this->disconnect; + } + } else { + # write error + $this->handle_io_error('write', $!); + } +} + +sub read { + my $this = shift; + # ソケットに読めるデータが来ていなかった場合、このメソッドは読めるようになるまで + # 操作をブロックします。それがまずい場合は予めselectで読める事を確認しておいて下さい。 + # このメソッドを実行したことで始めてソケットが閉じられた事が分かった場合は、 + # メソッド実行後からはconnectedメソッドが偽を返すようになります。 + if (!$this->connected) { + $this->disconnect; + return (); + } + + my $recvbuf = ''; + my $retval = $this->sock->sysread($recvbuf,4096); # とりあえず最大で4096バイトを読む + if (defined $retval) { + if ($retval == 0) { + # EOF + $this->disconnect('eof'); + } else { + $this->recvbuf .= $recvbuf; + } + } else { + # read error + $this->handle_io_error('read', $!); + } +} + +sub handle_io_error { + my ($this, $genre, $errno) = @_; + + local $! = $errno; + if ($!{EWOULDBLOCK} || $!{EINPROGRESS} || $!{EALREADY} || $!{ENOBUFS}) { + $this->runloop->notify_warn($this->sock_errno_to_msg($errno, "$genre error")); + } else { + # maybe couldn't continue + $this->disconnect($genre, $errno); + } +} + +sub exception { + my $this = shift; + + $this->handle_io_error('exception', $this->errno); +} + +sub flush { + my $this = shift; + + return undef unless $this->connected; + + my ($select) = IO::Select->new($this->sock); + + if ($this->want_to_write && $select->can_write(0)) { + $this->write; + } + + return undef unless $this->connected; + + if ($select->can_read(0)) { + $this->read; + } + + return 1; +} + +1; diff -urN /non-existant-dir/main/Tiarra/Socket/Connect.pm tiarra-20050322/main/Tiarra/Socket/Connect.pm --- /non-existant-dir/main/Tiarra/Socket/Connect.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Socket/Connect.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,402 @@ +# ----------------------------------------------------------------------------- +# $Id: Connect.pm 787 2005-02-28 18:12:45Z topia $ +# ----------------------------------------------------------------------------- +# Socket Connector +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::Socket::Connect; +use strict; +use warnings; +use Carp; +use Tiarra::Socket; +use base qw(Tiarra::Socket); +use Timer; +use Tiarra::OptionalModules; +use Tiarra::Utils; +utils->define_attr_accessor(0, qw(domain host addr port callback), + qw(bind_addr prefer timeout), + qw(retry_int retry_count try_count)); +utils->define_attr_enum_accessor('domain', 'eq', + qw(tcp unix)); + +# now supported tcp, unix + +# tcp: +# my $connector = connect->new( +# host => [hostname], +# port => [port], +# callback => sub { +# my ($genre, $connector, $msg_or_sock, $errno) = @_; +# if ($genre eq 'warn') { +# # $msg_or_sock: msg +# # maybe don't have $errno +# warn $msg_or_sock; +# } elsif ($genre eq 'error') { +# # $msg_or_sock: msg +# # maybe has $errno +# die $msg_or_sock; +# } elsif ($genre eq 'sock') { +# # $msg_or_sock: sock +# # maybe don't have $errno +# attach($connector->current_addr, $connector->current_port, +# $msg_or_sock); +# # optional genre +# } elsif ($genre eq 'interrupt') { +# # $msg_or_sock: undef +# # maybe don't have $errno +# die 'interrupted'; +# } elsif ($genre eq 'timeout') { +# # $msg_or_sock: undef +# # maybe don't have $errno +# die 'timeout'; +# } +# }, +# # optional params +# addr => [already resolved addr], +# bind_addr => [bind_addr (cannot specify host)], +# timeout => [timeout], # didn't test enough, please send report when bugs. +# retry_int => [retry interval], +# retry_count => [retry count], +# prefer => [prefer socket type(and order) (ipv4, ipv6) as string's +# array ref, default ipv6, ipv4], +# domain => 'tcp', # default +# ); +# $connector->interrupt; + +sub new { + my ($class, %opts) = @_; + + $class->_increment_caller('socket-connector', \%opts); + my $this = $class->SUPER::new(%opts); + map { + $this->$_($opts{$_}); + } qw(host addr port callback bind_addr timeout retry_int retry_count); + $this->domain(utils->get_first_defined($opts{domain}, + 'tcp')); + $this->prefer(utils->get_first_defined($opts{prefer}, + [qw(ipv6 ipv4)])); + $this->{queue} = []; + $this->connect; +} + +sub connect { + my $this = shift; + + if (defined $this->timeout) { + $this->{timer} = Timer->new( + After => $this->timeout, + Code => sub { + $this->interrupt('timeout'); + }); + } + + $this->prefer([qw('unix')]) if $this->domain_unix; + if (defined $this->addr || $this->domain_unix) { + my $entry = Tiarra::Resolver::QueueData->new; + $entry->answer_status($entry->ANSWER_OK); + $entry->answer_data([$this->addr]); + $this->_connect_stage($entry); + } else { + Tiarra::Resolver->resolve( + 'addr', $this->host, sub { + eval { + $this->_connect_stage(@_); + }; if ($@) { + $this->_connect_error("internal error: $@"); + } + }); + } + $this; +} + +sub _connect_stage { + my ($this, $entry) = @_; + + my %addrs_by_types; + + if ($entry->answer_status ne $entry->ANSWER_OK) { + $this->_connect_error("Couldn't resolve hostname"); + return undef; # end + } + + foreach my $addr (@{$entry->answer_data}) { + push (@{$addrs_by_types{$this->probe_type_by_addr($addr)}}, + $addr); + } + + foreach my $sock_type (@{$this->prefer}) { + my $struct; + push (@{$this->{queue}}, + map { + $struct = { + type => $sock_type, + addr => $_, + port => $this->port, + }; + } @{$addrs_by_types{$sock_type}}); + } + $this->_connect_try_next; +} + +sub _connect_try_next { + my $this = shift; + + $this->{connecting} = shift @{$this->{queue}}; + if (defined $this->{connecting}) { + my $methodname = '_try_connect_' . $this->{connecting}->{type}; + $this->$methodname; + } else { + if ($this->retry_int && (++$this->try_count <= $this->retry_count)) { + $this->{timer} = Timer->new( + After => $this->retry_int, + Code => sub { + $this->cleanup; + $this->connect; + }); + $this->_connect_warn( + 'all dead, ' . + utils->to_ordinal_number($this->try_count) . ' retry'); + } else { + $this->_connect_error('all dead'); + } + } +} + +sub _try_connect_ipv4 { + my $this = shift; + + $this->_try_connect_tcp('IO::Socket::INET'); +} + +sub _try_connect_ipv6 { + my $this = shift; + + if (!Tiarra::OptionalModules->ipv6) { + $this->_error( + qq{Host $this->{host} seems to be an IPv6 address, }. + qq{but IPv6 support is not enabled. }. + qq{Use IPv4 or install Socket6 or IO::Socket::INET6 if possible.\n}); + } + + $this->_try_connect_tcp('IO::Socket::INET6'); +} + +sub _try_connect_tcp { + my ($this, $package, $addr, %additional) = @_; + + if (!eval("require $package")) { + $this->_connect_error("Couldn\'t require socket package: $package"); + return; + } + my $sock = $package->new( + %additional, + (defined $this->{bind_addr} ? + (LocalAddr => $this->{bind_addr}) : ()), + Timeout => undef, + Proto => 'tcp'); + if (!defined $sock) { + $this->_connect_error( + $this->sock_errno_to_msg($!, 'Couldn\'t prepare socket'), + $!); + return; + } + if (!defined $sock->blocking(0)) { + # effect only on connecting; comment out + #$this->_warn('cannot non-blocking') if ::debug_mode(); + + if ($this->_is_winsock) { + # winsock FIONBIO + my $FIONBIO = 0x8004667e; # from Winsock2.h + my $temp = chr(1); + my $retval = $sock->ioctl($FIONBIO, $temp); + if (!$retval) { + $this->_warn($this->sock_errno_to_msg( + $!, 'Couldn\'t set non-blocking mode (winsock2)'), $!); + } + } else { + $this->_warn($this->sock_errno_to_msg( + $!, 'Couldn\'t set non-blocking mode (general)'), $!); + } + } + my $saddr = Tiarra::Resolver->resolve( + 'saddr', [$this->current_addr, $this->current_port], + sub {}, 0); + $this->{connecting}->{saddr} = $saddr->answer_data; + if ($sock->connect($this->{connecting}->{saddr}) || + $!{EINPROGRESS} || $!{EWOULDBLOCK}) { + my $error = $!; + $this->attach($sock); + $! = $error; + if ($!{EINPROGRESS} || $!{EWOULDBLOCK}) { + $this->install; + } else { + $this->_call; + } + } else { + $this->_connect_warn_try_next($!, 'connect error'); + } +} + +sub _try_connect_unix { + my $this = shift; + + if (!Tiarra::OptionalModules->unix_dom) { + $this->_error( + qq{Host $this->{host} seems to be an Unix Domain Socket address, }. + qq{but Unix Domain Socket support is not enabled. }. + qq{Use other protocol if possible.\n}); + } + + require IO::Socket::UNIX; + my $sock = IO::Socket::UNIX->new(Peer => $this->{connecting}->{addr}); + if (defined $sock) { + $this->attach($sock); + $this->_call; + } else { + $this->_connect_warn_try_next($!, 'Couldn\'t connect'); + } +} + +sub _connect_warn_try_next { + my ($this, $errno, $msg) = @_; + + $this->_connect_warn($this->sock_errno_to_msg($errno, $msg), $errno); + $this->_connect_try_next; +} + +sub _connect_error { shift->_connect_warn_or_error('error', @_); } +sub _connect_warn { shift->_connect_warn_or_error('warn', @_); } + +sub _connect_warn_or_error { + my $this = shift; + my $method = '_'.shift; + my $str = shift; + my $errno = shift; # but optional + if (defined $str) { + $str = ': ' . $str; + } else { + $str = ''; + } + + $this->$method("Couldn't connect to ".$this->destination.$str, $errno, @_); +} + +sub destination { + my $this = shift; + + $this->repr_destination( + host => $this->host, + addr => $this->current_addr, + port => $this->current_port, + type => $this->current_type); +} + +sub current_addr { + my $this = shift; + + utils->get_first_defined( + $this->{connecting}->{addr}, + $this->addr); +} + +sub current_port { + my $this = shift; + + utils->get_first_defined( + $this->{connecting}->{port}, + $this->port); +} + +sub current_type { + my $this = shift; + + $this->{connecting}->{type}; +} + +sub _error { + # connection error; and finish ->connect chain + my ($this, $msg, $errno) = @_; + + $this->callback->('error', $this, $msg, $errno); +} + +sub _warn { + # connection warning; but continue trying + my ($this, $msg, $errno) = @_; + + $this->callback->('warn', $this, $msg, $errno); +} + +sub _call { + # connection successful + my $this = shift; + + $this->callback->('sock', $this, $this->sock); +} + +sub cleanup { + my $this = shift; + + if ($this->installed) { + $this->uninstall; + } + if (defined $this->{timer}) { + $this->{timer}->uninstall; + $this->{timer} = undef; + } +} + +sub interrupt { + my ($this, $genre) = @_; + + $this->cleanup; + if (defined $this->sock) { + $this->close; + } + $genre = 'interrupt' unless defined $genre; + $this->callback->($genre, $this); +} + +sub want_to_write { + 1; +} + +sub write { shift->proc_sock } +sub read { shift->proc_sock } +sub exception { shift->_handle_sock_error } + +sub proc_sock { + my $this = shift; + + my $select = IO::Select->new($this->sock); + if (!$select->can_write(0)) { + my $error = $this->errno; + $this->cleanup; + $this->close; + $this->_connect_warn_try_next($error, 'cant write'); + } elsif (!$this->sock->connect($this->{connecting}->{saddr})) { + if ($!{EISCONN} || + ($this->_is_winsock && (($! == 10022) || $!{EWOULDBLOCK} || + $!{EALREADY}))) { + $this->cleanup; + $this->_call; + } else { + $this->_warn( + $this->sock_errno_to_msg($!, 'connection try error'), $!); + $this->_handle_sock_error; + } + } else { + $this->_warn('connect successful, why called this?'); + } +} + +sub _handle_sock_error { + my $this = shift; + + my $error = $this->errno; + $this->cleanup; + $this->close; + $this->_connect_warn_try_next($error); +} + +1; diff -urN /non-existant-dir/main/Tiarra/Socket/Lined.pm tiarra-20050322/main/Tiarra/Socket/Lined.pm --- /non-existant-dir/main/Tiarra/Socket/Lined.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Socket/Lined.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,65 @@ +# ----------------------------------------------------------------------------- +# $Id: Lined.pm 661 2004-10-15 12:09:10Z topia $ +# ----------------------------------------------------------------------------- +# Lined Socket +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::Socket::Lined; +use strict; +use warnings; +use Carp; +use Tiarra::Socket::Buffered; +use base qw(Tiarra::Socket::Buffered); +use Tiarra::Utils; +utils->define_attr_accessor(0, qw(eol)); + +sub new { + my ($class, %opts) = @_; + + $class->_increment_caller('lined-socket', \%opts); + my $this = $class->SUPER::new(%opts); + $this->eol(utils->get_first_defined( + $opts{eol}, + "\x0d\x0a")); + $this->{recvqueue} = []; + $this; +} + +sub append_line { + my ($this, $line) = @_; + + $this->append($line . $this->eol); +} + +sub read { + my $this = shift; + + $this->SUPER::read; + + while (1) { + my $eol_pos = index($this->recvbuf, $this->eol); + if ($eol_pos == -1) { + # 一行分のデータが届いていない。 + last; + } + + my $current_line = substr($this->recvbuf, 0, $eol_pos); + substr($this->recvbuf, 0, $eol_pos + CORE::length($this->eol)) = ''; + + push @{$this->{recv_queue}}, $current_line; + } +} + +sub pop_queue { + # このメソッドは受信キュー内の最も古いものを取り出します。 + # キューが空ならundefを返します。 + my ($this) = @_; + $this->flush; # 念のためflushをしてbufferを更新しておく。 + if (@{$this->{recv_queue}} == 0) { + return undef; + } else { + return splice @{$this->{recv_queue}},0,1; + } +} + +1; diff -urN /non-existant-dir/main/Tiarra/Socket/Win32Errno.pm tiarra-20050322/main/Tiarra/Socket/Win32Errno.pm --- /non-existant-dir/main/Tiarra/Socket/Win32Errno.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Socket/Win32Errno.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,72 @@ +# ----------------------------------------------------------------------------- +# $Id: Win32Errno.pm 726 2004-11-27 05:13:50Z topia $ +# ----------------------------------------------------------------------------- +# Win32 (Winsock2) Errno to message formatter +# why we cannot use 'local $@ = errno; "$@"' ? +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::Socket::Win32Errno; +use strict; +use warnings; +use Tiarra::SharedMixin; +use Errno; +our %descriptions; + +sub _new { + return __PACKAGE__; +} + + +BEGIN { + my @data = split /\n/, <<__YAML__; +--- !tiarra.org/misc^win32-errno-messages +EWOULDBLOCK: Resource temporarily unavailable. +EINPROGRESS: Operation now in progress +EALREADY: Operation already in progress +ENOTSOCK: Socket operation on nonsocket +EDESTADDRREQ: Destination address required +EMSGSIZE: Message too long +EPROTOTYPE: Protocol wrong type for socket +ENOPROTOOPT: Bad protocol option +EPROTONOSUPPORT: Protocol not supported +EOPNOTSUPP: Operation not supported +EPFNOSUPPORT: Protocol family not supported +EAFNOSUPPORT: Address family not supported by protocol family +EADDRINUSE: Address already in use +EADDRNOTAVAIL: Cannot assign requested address +ENETDOWN: Network is down +ENETUNREACH: Network is unreachable +ENETRESET: Network dropped connection on reset +ECONNABORTED: Software caused connection abort +ECONNRESET: Connection reset by peer +ENOBUFS: No buffer space available +EISCONN: Socket is already connected +ENOTCONN: Socket is not connected +ESHUTDOWN: Cannot send after socket shutdown +ETIMEDOUT: Connection timed out +ECONNREFUSED: Connection refused +EHOSTDOWN: Host is down +EHOSTUNREACH: No route to host +EPROCLIM: Too many processes +__YAML__ + # strip yaml header + shift @data; + %descriptions = (); + my ($name, $description, $value); + map { + ($name, $description) = split(/: /, $_, 2); + if (defined $name && exists $!{$name}) { + $value = Errno->$name; + $descriptions{$value} = $description; + } + (); + } @data; +} + +sub fetch_description { + my ($class_or_this, $number) = @_; + + $descriptions{$number}; +} + +1; diff -urN /non-existant-dir/main/Tiarra/Socket.pm tiarra-20050322/main/Tiarra/Socket.pm --- /non-existant-dir/main/Tiarra/Socket.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Socket.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,479 @@ +# ----------------------------------------------------------------------------- +# $Id: Socket.pm 733 2004-12-29 07:59:08Z topia $ +# ----------------------------------------------------------------------------- +# Socket Wrapper +# 注意: Win32 環境では Socket 以外のファイルハンドル等に select を使えません。 +# (see perlport) +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::Socket; +use strict; +use warnings; +use Carp; +use Tiarra::Utils; +use RunLoop; +use Socket; +our $is_winsock = $^O =~ /^MSWin32/; +utils->define_attr_getter(0, qw(sock installed)); +utils->define_attr_accessor(0, qw(name), + map { ["_$_", $_] } + qw(sock installed)); + +sub new { + my ($class, %opts) = @_; + + my $this = { + runloop => $opts{runloop}, + installed => 0, + sock => undef, + name => utils->get_first_defined( + $opts{name}, + utils->simple_caller_formatter( + utils->get_first_defined($opts{_subject}, 'socket').' registered', + ($opts{_caller} || 0))), + }; + bless $this, $class; +} + +sub runloop { + my $this = shift; + + utils->get_first_defined($this->{runloop}, RunLoop->shared); +} + +sub attach { + my ($this, $sock) = @_; + + if ($this->installed) { + croak "already installed; can't attach!"; + } + + return undef unless defined $sock; + $sock->autoflush(1); + $this->_sock($sock); + $this; +} + +sub detach { + my $this = shift; + + if (!defined $this->sock) { + croak "already detached; can't detach!"; + } + if ($this->installed) { + carp "installed; anyway detach..."; + $this->uninstall; + } + + $this->_sock(undef); + $this; +} + +sub close { + my $this = shift; + + if (!defined $this->sock) { + croak "already detached; can't close!"; + } + + $this->shutdown(2); + $this->detach; +} + +sub shutdown { + my ($this, $type) = @_; + + if (!defined $this->sock) { + croak "already detached; can't shutdown!"; + } + + $this->sock->shutdown($type); +} + +sub install { + my $this = shift; + + if ($this->installed) { + croak "already installed; module bug?"; + } + + $this->runloop->install_socket($this); + $this->_installed(1); + $this; +} + +sub uninstall { + my $this = shift; + + if (!$this->installed) { + croak "already uninstalled; module bug?"; + } + + $this->runloop->uninstall_socket($this); + $this->_installed(0); + $this; +} + +sub errno { + my $this = shift; + + if (!defined $this->sock) { + croak "already detached; can't fetch errno!"; + } + + my $errno = $this->sock->sockopt(SO_ERROR); + if ($errno == 0 || $errno == -1) { + $errno = undef; + } + return $errno; +} + +sub errmsg { + my $this = shift; + my $errno = $this->errno; + my $msg = undef; + + if (defined $errno) { + $msg = $this->sock_errno_to_msg($errno, @_); + } + if (wantarray) { + ($msg, $errno); + } else { + $msg; + } +} + +sub _should_define { + die 'method should define! ('.shift->name.')'; +} + +sub want_to_write { shift->_should_define } +sub write { shift->_should_define } +sub read { shift->_should_define } +sub exception { shift->_should_define } + +# class method + +sub repr_destination { + my ($class_or_this, %data) = @_; + + if (!defined $data{host} && defined $data{addr}) { + $data{host} = $data{addr}; + delete $data{addr}; + } + if (defined $data{host} && defined $data{addr} && + $data{host} eq $data{addr}) { + delete $data{addr}; + } + + my $str = ''; + my $append_as_delimiter = sub { + $str .= shift if length $str; + }; + $str .= utils->to_str($data{host}); + $str .= "($data{addr})" if defined $data{addr}; + if (defined $data{port}) { + $append_as_delimiter->('/'); + $str .= $data{port}; + } + if (defined $data{type}) { + $append_as_delimiter->(' ('); + $str .= $class_or_this->repr_type($data{type}) . + (length $str ? ')' : ''); + } + $str; +} + +sub repr_type { + my ($class_or_this, $type) = @_; + + if ($type =~ /^ipv(\d+)$/i) { + return "IPv$1"; + } elsif ($type =~ /^unix$/i) { + return "Unix"; + } else { + return "Unknown: $type"; + } +} + +sub probe_type_by_class { + my ($class_or_this, $obj) = @_; + + map { + if (!wantarray) { + return $_->[1]; + } else { + $_->[1]; + } + } grep { + UNIVERSAL::isa($obj, $_->[0]); + } map { + substr($_->[0],0,0) = 'IO::Socket::'; + $_; + } ([qw(INET ipv4)], [qw(INET6 ipv6)], [qw(UNIX unix)]); +} + +sub probe_type_by_addr { + my ($class_or_this, $addr) = @_; + + if ($addr =~ m/^(?:\d+\.){3}\d+$/) { + return 'ipv4'; + } elsif ($addr =~ m/^[0-9a-fA-F:]+$/) { + return 'ipv6'; + } else { + # maybe + return 'unix'; + } + +} + +sub sock_errno_to_msg { + my ($this, $errno, $msg) = @_; + + local $! = $errno; + $errno = ($!+0); + my $errstr = "$!"; + if ($! eq 'Unknown error' && $this->_is_winsock) { + # try probe (for my ActivePerl v5.8.4 build 810) + require Tiarra::Socket::Win32Errno; + my $new_errstr = Tiarra::Socket::Win32Errno->fetch_description($errno); + if (defined $new_errstr) { + $errstr = $new_errstr; + } + } + return ((defined $msg && length $msg) ? ($msg . ': ') : '' ) . + "$errno: $errstr"; +} + +sub _is_winsock { + return $is_winsock; +} + +sub _increment_caller { + my ($class_or_this, $subject, $opts) = @_; + + $opts->{_caller} = ($opts->{_caller} || 0) + 1; + $opts->{_subject} = utils->get_first_defined( + $opts->{_subject}, + $subject); + $opts; +} + +1; + +=pod + +=head1 NAME + +Tiarra::Socket - Tiarra RunLoop based Socket Handler Base Class + +=head1 SYNOPSIS + +=over + +=item use L + + use Tiarra::Socket; + $socket = Tiarra::Socket->new(name => 'sample socket'); + $socket->attach($sock); + $socket->install; + $socket->uninstall; + $socket->shutdown(2); + $socket->detach; + $socket->close; + $errno = $socket->errno; + $msg = $socket->errmsg( [$additional_msg] ); + $type = Tiarra::Socket->probe_type_by_class($sock); + $type = Tiarra::Socket->probe_type_by_addr($addr); + Tiarra::Socket->repr_type( $type ); + Tiarra::Socket->repr_destination( [datas] ); + $is_winsock = Tiarra::Socket->_is_winsock; + $msg = Tiarra::Socket->sock_errno_to_msg($errno[, $additional_msg]); + +=item make subclass of L + + package Tiarra::SomeSocket; + use Tiarra::Socket; + use base qw(Tiarra::Socket); + + sub new { + my ($class, %opts) = @_; + + $class->_increment_caller('some-socket', \%opts); + my $this = $class->SUPER::new(%opts); + $this; + } + # some overrides and implements... + +=back + +=head1 DESCRIPTION + +L provides RunLoop based event driven Socket I/O interface. + +=head1 CONSTRUCTOR + +=over + +=item C<< $socket = new( [OPTS] ) >> + +opts is options hash. +parametors: + + runloop Tiarra RunLoop + name Socket name for pretty-print + +=back + +=head1 METHODS + +=over + +=item C<< ->runloop >> + +return default runloop or specified runloop + +=item C<< ->attach >> + +attach sock to socket + +=item C<< ->detach >> + +detach sock from socket + +=item C<< ->close >> + +shutdown and detach socket + +=item C<< ->shutdown( HOW ) >> + +call shutdown for this socket. + +=item C<< ->install >> + +install socket to runloop + +=item C<< ->uninstall >> + +uninstall socket from runloop + +=item C<< ->sock >> + +return sock attached to socket + +=item C<< ->installed >> + +return true if socket installed to runloop + +=item C<< ->errno >> + +return socket errno with sockopt(and clear status). +if errno not set, return undef. + +=item C<< ->errmsg( [MESSAGE] ) >> + +return socket error message with msg. +on array context, return $errno as 2nd item, also. + +(implement likes +C<< $this->sock_errno_to_msg($this->errno, [MESSAGE] ) >>.) + +=back + +=head1 CLASS METHODS + +=over + +=item C<< ->repr_destination( [DATAS] ) >> + +representation destination with DATAS hash. +currently supported hash key: + +=over + +=item host + +hostname(maybe FQDN). + +=item addr + +Address(IPv[46] Address). + +=item port + +Port or UNIX Domain Socket path. + +=item type + +Socket type. try repr inside, you haven't necessary call C<< ->repr_type >>. + +=back + +=item C<< ->repr_type( TYPE ) >> + +Simple Pretty-printing type. such as: + + ipv4 -> IPv4 + ipv6 -> IPv6 + unix -> Unix + +=item C<< ->probe_type_by_class( CLASS_OR_OBJECT ) >> + +Probe type by class or object. + +=item C<< ->probe_type_by_addr( ADDRESS ) >> + +Probe type by address. + +=item C<< ->sock_errno_to_msg( ERRNO[, MESSAGE] ) >> + +representation sock errno and message. + +=back + +=head1 METHODS OF PLEASE OVERRIDE BY SUBCLASS + +=over + +=item C<< ->want_to_write >> + +return true(1) on want to write(write buffer has data) + +=item C<< ->write >> + +called when select notified this socket is writable. + +=item C<< ->read >> + +called when select notified this socket is readable. + +=item C<< ->exception >> + +called when select notified this socket has exception. + +=back + +=head1 SEE ALSO + +L: socket connector. + +L, L: reader/writer. + +L: Win32 errno database. + +=head1 COPYRIGHT AND DISCLAIMERS + +Copyright (c) 2004 Topia. All rights reserved. + +This library is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +This program is distributed in the hope that it will be useful, but +without any warranty; without even the implied warranty of +merchantability or fitness for a particular purpose. + +=head1 AUTHOR + +Topia, and originally developed by phonohawk. + +=cut diff -urN /non-existant-dir/main/Tiarra/TerminateManager.pm tiarra-20050322/main/Tiarra/TerminateManager.pm --- /non-existant-dir/main/Tiarra/TerminateManager.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/TerminateManager.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,45 @@ +# ----------------------------------------------------------------------------- +# $Id: TerminateManager.pm 825 2005-03-07 22:22:59Z topia $ +# ----------------------------------------------------------------------------- +# Terminate Hook for write Portable Module +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::TerminateManager; +use strict; +use warnings; +use Carp; +use Hook; +use base qw(HookTarget); +use Tiarra::SharedMixin; + +sub _new { + my $class = shift; + + my $this = {}; + bless $this, $class; + $this; +} + +sub terminate { + my ($class_or_this, $name) = @_; + my $this = $class_or_this->_this; + + $this->call_hooks($name); +} + +package Tiarra::TerminateManager::Hook; +use FunctionalVariable; +use Hook; +use base qw(Hook); +our $HOOK_TARGET_NAME = 'Tiarra::TerminateManager'; +our @HOOK_NAME_CANDIDATES = qw(main); +our $HOOK_NAME_DEFAULT = 'main'; +our $HOOK_TARGET_DEFAULT; +FunctionalVariable::tie( + \$HOOK_TARGET_DEFAULT, + FETCH => sub { + $HOOK_TARGET_NAME->shared; + }, + ); + +1; diff -urN /non-existant-dir/main/Tiarra/Utils/CallWrapper.pm tiarra-20050322/main/Tiarra/Utils/CallWrapper.pm --- /non-existant-dir/main/Tiarra/Utils/CallWrapper.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Utils/CallWrapper.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,251 @@ +# ----------------------------------------------------------------------------- +# $Id: CallWrapper.pm 817 2005-03-07 17:09:18Z topia $ +# ----------------------------------------------------------------------------- +# Call Wrapping Helper +# ----------------------------------------------------------------------------- +# copyright (C) 2004-2005 Topia . all rights reserved. +package Tiarra::Utils::CallWrapper; +use strict; +use warnings; +use Carp; +use base qw(Tiarra::Utils::Core); + +=head1 NAME + +Tiarra::Utils::CallWrapper - Tiarra misc Utility Functions: Call Wrappers + +=head1 SYNOPSIS + + use Tiarra::Utils; # import master + utils->do_with_ensure(..., ...); + +=head1 DESCRIPTION + +Tiarra::Utils is misc helper functions class. this class is implement call +wrapping helpers. + +class splitting is maintainer issue only. please require/use Tiarra::Utils. + +=head1 METHODS + +=over 4 + +=cut + +sub _wantarray_to_type { + shift; # drop + + grep { + if (!wantarray) { + return $_; + } else { + 1; + } + } map { + if (!defined $_) { + 'void'; + } elsif (!$_) { + 'scalar'; + } else { + 'list'; + } + } @_; +} + +=item call_with_wantarray + + utils->call_with_wantarray(wantarray, $closure, @args); + +call closure with wantarray value of you want. + +=over 4 + +=item * wantarray + +wantarray value at context. + +=item * $closure + +closure of want to call. + +=item * @args + +args to call closure. + +=back + +=cut + +sub call_with_wantarray { + my $pkg = shift; + my ($wantarray, $closure, @args) = @_; + my $type = $pkg->_wantarray_to_type($wantarray); + + if ($type eq 'void') { + # void context + $closure->(@args); + return undef; + } elsif ($type eq 'scalar') { + # scalar context + my $ret = $closure->(@args); + return $ret; + } elsif ($type eq 'list') { + # list context + my $ret = [$closure->(@args)]; + return @$ret; + } else { + croak "unsupported wantarray type: $type"; + } +} + +=item do_with_ensure + + utils->do_with_ensure($closure, $ensure, @args); + +call closure with ensure feature. + +=over 4 + +=item * $closure + +closure of want to call. + +=item * $ensure + +ensure closure (call on return/exit from this function). + +=item * @args + +args to call closure. + +=back + +=cut + +sub do_with_ensure { + my $pkg = shift; + my ($closure, $ensure, @args) = @_; + my $cleaner = Tiarra::Utils::CallWrapper::EnsureCleaner->new($ensure); + $closure->(@args); +} + +=item sighandler_or_default + + utils->sighandler_or_default($name[, $func]); + +return coderef of current signal handler. + +=cut + +sub sighandler_or_default { + my ($pkg, $name, $func) = @_; + + $name = "__\U$name\E__" if $name =~ /^(die|warn)$/i; + if (!defined $func) { + if ($name =~ /^__(DIE|WARN)__$/) { + no strict 'refs'; + $func = \&{"__real_\L$1\E"}; + } + } + + my $value = $SIG{$name}; + $value = $func if !defined $value || length($value) == 0 || + $value =~ /^DEFAULT$/i; + if (ref($value) ne 'CODE') { + no strict 'refs'; + $value = \&{$value}; + } + $value; +} + +sub __real_die { die @_ } +sub __real_warn { warn @_ } + +=item do_with_errmsg + + utils->do_with_errmsg($name, $closure, @args); + +call closure with adding "inside foo" annotation to error message. + +=over 4 + +=item * $name + +subject (such as "Timer: foo timer"). + +=item * $closure + +closure of want to call. + +=item * @args + +args to call closure. + +=back + +=cut + +sub do_with_errmsg { + my $pkg = shift; + my ($name, $closure, @args) = @_; + + my $str = " inside $name;\n"; + do { + no strict 'refs'; + local ($SIG{__WARN__}, $SIG{__DIE__}) = + (map { + my $signame = "__\U$_\E__"; + my $handler = $pkg->sighandler_or_default($_); + sub { + my $msg = shift; + if (!ref($msg)) { + $handler->(($msg).$str); + } else { + #FIXME... + $handler->($msg); + } + }; + } qw(warn die)); + + $closure->(@args); + }; +} + +package Tiarra::Utils::CallWrapper::EnsureCleaner; +use strict; +use warnings; +use base qw(Tiarra::Utils::CallWrapper); + +sub new { + my ($class, $closure) = @_; + bless $closure, $class; +} + +sub DESTROY { + my $this = shift; + local $@; # FIXME: we can't know ensure _die_... + $this->do_with_errmsg('ensure', $this); +} + +1; + +__END__ +=back + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Topia Etopia@clovery.jpE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2005 by Topia. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.6 or, +at your option, any later version of Perl 5 you may have available. + +=cut diff -urN /non-existant-dir/main/Tiarra/Utils/Core.pm tiarra-20050322/main/Tiarra/Utils/Core.pm --- /non-existant-dir/main/Tiarra/Utils/Core.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Utils/Core.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,74 @@ +# ----------------------------------------------------------------------------- +# $Id: Core.pm 817 2005-03-07 17:09:18Z topia $ +# ----------------------------------------------------------------------------- +# Tiarra::Utils Core feature +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::Utils::Core; +use strict; +use warnings; + +=head1 NAME + +Tiarra::Utils::Core - Tiarra misc Utility Functions: Core + +=head1 SYNOPSIS + + use Tiarra::Utils; # import master + +=head1 DESCRIPTION + +Tiarra::Utils is misc helper functions class. this class is implement core. + +class splitting is maintainer issue only. please require/use Tiarra::Utils. + +=head1 METHODS + +=over 4 + +=cut + +=item _this + + foopkg->_this + +return shared object(singleton) if ->shared method defined and called as class method. +otherwise(called as object method, or non-singleton class) return $this self. + +=cut + +sub _this { + my $class_or_this = shift; + + if (!ref($class_or_this)) { + if ($class_or_this->can('shared')) { + # fetch shared + $class_or_this = $class_or_this->shared; + } + } + + return $class_or_this; +} + +1; + +__END__ +=back + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Topia Etopia@clovery.jpE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2005 by Topia. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.6 or, +at your option, any later version of Perl 5 you may have available. + +=cut diff -urN /non-existant-dir/main/Tiarra/Utils/DefineHelper.pm tiarra-20050322/main/Tiarra/Utils/DefineHelper.pm --- /non-existant-dir/main/Tiarra/Utils/DefineHelper.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Utils/DefineHelper.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,332 @@ +# ----------------------------------------------------------------------------- +# $Id: DefineHelper.pm 753 2005-02-16 10:22:29Z topia $ +# ----------------------------------------------------------------------------- +# Define Helper Utilities +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::Utils::DefineHelper; +use strict; +use warnings; +use Tiarra::Utils::Core; +use base qw(Tiarra::Utils::Core); +our $ExportLevel = 0; + +# please do { +# Tiarra::Utils::DefineHelper->do_with_define_exportlevel( +# 0, +# sub { +# Tiarra::Utils::DefineHelper->define_enum(qw(...)); +# }); +# in define_*s' wrapper function. + +# all function is class method. +# please use package->method(...); +# maybe all functions can use with Tiarra::Utils->... + +sub define_function { + shift; #package + my $package = shift; + my $code = shift; + my $funcname; + no strict 'refs'; + foreach (@_) { + $funcname = $package.'::'.$_; + undef *{$funcname}; + *{$funcname} = $code; + } + undef; +} + +sub _parse_attr_define { + shift; # drop + shift; # drop + my $value = shift; + + if (ref($value) eq 'ARRAY') { + $value; + } else { + [$value, $value]; + } +} + +sub _define_attr_common { + my $pkg = shift; + my $type = shift; + my $class_method_p = shift; + my $call_pkg = $pkg->get_package(1); + foreach (@_) { + my ($funcname, $valname) = @{$pkg->_parse_attr_define($call_pkg, $_)}; + $pkg->define_function( + $call_pkg, + $pkg->_generate_attr_closure($class_method_p, $type, + "{$valname}", $funcname), + $funcname); + } + undef; +} + +sub define_attr_accessor { + shift->_define_attr_common('accessor', @_); +} + +sub define_attr_getter { + shift->_define_attr_common('getter', @_); +} + +sub _define_attr_hook_common { + my $pkg = shift; + my $type = shift; + my $class_method_p = shift; + my $hook = shift; + my $call_pkg = $pkg->get_package(1); + foreach (@_) { + my ($funcname, $valname) = @{$pkg->_parse_attr_define($call_pkg, $_)}; + $pkg->define_function( + $call_pkg, + $pkg->_generate_attr_hooked_closure($class_method_p, $type, + "{$valname}", $hook, $funcname), + $funcname); + } + undef; +} + +sub _define_attr_translate_accessor { + shift->_define_attr_hook_common('translate', @_); +} + +sub _define_attr_notify_accessor { + shift->_define_attr_hook_common('notify', @_); +} + +sub _parse_array_attr_define { + shift; # drop + my $call_pkg = shift; + + my $value = shift; + if (ref($value) eq 'ARRAY') { + $value; + } else { + my $funcname = $value; + my $index = uc($funcname); + $index = $call_pkg->$index; + [$funcname, $index]; + } +} + +sub _define_array_attr_common { + my $pkg = shift; + my $type = shift; + my $class_method_p = shift; + my $call_pkg = $pkg->get_package(1); + foreach (@_) { + my ($funcname, $index) = + @{$pkg->_parse_array_attr_define($call_pkg, $_)}; + $pkg->define_function( + $call_pkg, + $pkg->_generate_attr_closure($class_method_p, $type, + "[$index]", $funcname), + $funcname); + } + undef; +} + +sub define_array_attr_accessor { + shift->_define_array_attr_common('accessor', @_); +} + +sub define_array_attr_getter { + shift->_define_array_attr_common('getter', @_); +} + +sub _define_array_attr_hook_common { + my $pkg = shift; + my $type = shift; + my $class_method_p = shift; + my $hook = shift; + my $call_pkg = $pkg->get_package(1); + foreach (@_) { + my ($funcname, $index) = + @{$pkg->_parse_array_attr_define($call_pkg, $_)}; + $pkg->define_function( + $call_pkg, + $pkg->_generate_attr_hooked_closure($class_method_p, $type, + "[$index]", $hook, $funcname), + $funcname); + } + undef; +} + +sub define_array_attr_translate_accessor { + shift->_define_array_attr_hook_common('translate', @_); +} + +sub define_array_attr_notify_accessor { + shift->_define_array_attr_hook_common('notify', @_); +} + +sub define_attr_enum_accessor { + my $pkg = shift; + my $attr_name = shift; + my $match_type = shift || 'eq'; + foreach (@_) { + my ($funcname, $value); + if (ref($_) eq 'ARRAY') { + $funcname = $_->[0]; + $value = $_->[1]; + } else { + $funcname = $attr_name . '_' . $_; + $value = $_; + } + $pkg->define_function( + $pkg->get_package, + eval '(sub { + my $this = shift; + $this->$attr_name($value) if defined shift; + $this->$attr_name '.$match_type.' $value; + })', + $funcname); + } +} + +sub define_proxy { + my $pkg = shift; + my $proxy_target_funcname = shift; + my $class_method_p = shift; + foreach (@_) { + my ($funcname, $proxyname); + if (ref($_) eq 'ARRAY') { + $funcname = $_->[0]; + $proxyname = $_->[1]; + } else { + $funcname = $proxyname = $_; + } + $pkg->define_function( + $pkg->get_package, + ($class_method_p ? sub { + shift->_this->$proxy_target_funcname->$proxyname(@_); + } : sub { + shift->$proxy_target_funcname->$proxyname(@_); + }), + $funcname); + } +} + +sub define_enum { + # this function is deprecated. + # please use enum.pm instead. + my $pkg = shift; + my $i = 0; + foreach (@_) { + my (@funcnames); + if (ref($_) eq 'ARRAY') { + @funcnames = @$_; + } else { + @funcnames = $_; + } + $pkg->define_function( + $pkg->get_package, + sub () { $i; }, + @funcnames); + ++$i; + } +} + +sub get_package { + my $pkg = shift; + my $caller_level = shift || 0; + ($pkg->get_caller($caller_level + 1))[0]; +} + +sub get_caller { + my $pkg = shift; + my $caller_level = shift || 0; + caller($caller_level + 1 + $ExportLevel); +} + +sub do_with_define_exportlevel { + my $pkg = shift; + my $level = shift || 0; + + local $ExportLevel; + $ExportLevel += 3 + $level; + shift->(@_); +} + + +# generator +sub _generate_attr_closure { + my $pkg = shift; + my $class_method_p = shift; + my $type = shift; + my $attr = shift; + my $funcname = shift; + # outside parentheses for context + my $str = join('', + "\n# line 1 \"", + (defined $funcname ? "->$funcname\: " : ''), + "attr $type\"\n", + '(sub', + ({ + accessor => ' : lvalue', + getter => '', + }->{$type}), + ' {', + ' die "too many args" if $#_ >= ', + ({ + accessor => '2', + getter => '1', + }->{$type}), + ';', + ({ + accessor => ' my $this = shift', + getter => ' shift', + }->{$type}), + ($class_method_p ? '->_this' : ''), + ({ + accessor => "; \$this->$attr = shift if \$#_ >= 0; \$this", + getter => '', + }->{$type}), + "->$attr;", + ' })'); + no strict 'refs'; + no warnings; + eval $str || + (print STDERR __PACKAGE__."/generator error: \n$str\n$@", undef); +} + +sub _generate_attr_hooked_closure { + my $pkg = shift; + my $class_method_p = shift; + my $type = shift; + my $attr = shift; + my $update_hook = shift; + my $funcname = shift; + # outside parentheses for context + my $str = join('', + "\n# line 1 \"", + (defined $funcname ? "->$funcname\: " : ''), + "attr $type\"\n", + '(sub {', + ' die "too many args" if $#_ >= 2;', + ' my $this = shift', + ($class_method_p ? '->_this' : ''), + ';', + ' if ($#_ >=0) {', + (sub { + if ($type eq 'translate') { + ' '.$update_hook->('shift', "\$this->$attr"); + } elsif ($type eq 'notify') { + " \$this->$attr = shift; $update_hook;"; + } + }->($type)), + ' }', + " \$this->$attr;", + ' })'); + no strict 'refs'; + no warnings; + eval $str || + (print STDERR __PACKAGE__."/generator error: \n$str\n$@", undef); +} + + +1; diff -urN /non-existant-dir/main/Tiarra/Utils.pm tiarra-20050322/main/Tiarra/Utils.pm --- /non-existant-dir/main/Tiarra/Utils.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/Utils.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,196 @@ +# ----------------------------------------------------------------------------- +# $Id: Utils.pm 844 2005-03-20 09:19:15Z topia $ +# ----------------------------------------------------------------------------- +# Misc Utilities +# ----------------------------------------------------------------------------- +# copyright (C) 2004-2005 Topia . all rights reserved. +package Tiarra::Utils; +use strict; +use warnings; +use Carp; +use List::Util qw(first); +use base qw(Tiarra::Utils::Core); +use base qw(Tiarra::Utils::DefineHelper); +use base qw(Tiarra::Utils::CallWrapper); +use base qw(Exporter); +our @EXPORT = qw(utils); + +=head1 NAME + +Tiarra::Utils - Tiarra misc Utility Functions + +=head1 SYNOPSIS + + use Tiarra::Utils; # import utils + utils->get_first_defined(..., ...); + +=head1 DESCRIPTION + +miscellaneous helper functions. + +this class inherited some classes'(L, +L, L) methods. +so please refer these classes' documents. + +=head1 METHODS + +=over 4 + +=cut + +=item utils + + use Tiarra::Utils; + utils->foo_method; + +default export function for shorthand use of Tiarra::Utils functions. + +=cut + +sub utils { + __PACKAGE__->_this; +} + +=item simple_caller_formatter + + utils->simple_caller_formatter([$msg[, $caller_level]]); + +format " at line " style caller information. + +=over 4 + +=item * $msg + +subject of caller information. default is 'called'. + +=item * $caller_level + +caller level to dig. default is 0(caller of your function). + +=back + +=cut + +sub simple_caller_formatter { + my $pkg = shift; + my $msg = $pkg->get_first_defined(shift, 'called'); + my $caller_level = shift || 0; + + sprintf('%s at %s line %s', $msg, + ($pkg->get_caller($caller_level + 1))[1,2]); +} + +=item cond_yesno + + utils->cond_yesno($value[, $default]); + +check yes-or-no style condition. + +return true on yes(or 1, true, and so on), +false on no(or 0, false, and so on). + +if $value is undefined, return $default. + +=cut + +sub cond_yesno { + shift; # drop + my ($value, $default) = @_; + + return $default unless defined $value; + return 0 if $value =~ /[fn]/i; # false/no + return 1 if $value =~ /[ty]/i; # true/yes + return 1 if $value; # 数値判定 + return 0; +} + +=item to_str + + utils->to_str(@strings); + +stringify without undefined warning. + +=cut + +sub to_str { + shift; # drop + # undef(and so on) to str without warning + no warnings 'uninitialized'; + grep { + if (!wantarray) { + return $_; + } else { + 1; + } + } map { + "$_" + } @_; +} + +=item get_first_defined + + utils->get_first_defined(@values); + +(deprecated): return first defined value. + +this function is deprecated; please use +C<< List::Util::first { defined } @values >> instead. + +=cut + +sub get_first_defined { + shift; # drop + first { defined } @_; +} + +=item to_ordinal_number + + utils->to_ordinal_number($int); + +format number to ordinal number. + +=cut + +sub to_ordinal_number { + shift; # drop + grep { + if (!wantarray) { + return $_; + } else { + 1; + } + } map { + if (/1$/) { + $_ . 'st'; + } elsif (/(?:[^1]|^)([23])$/) { + $_ . ($2 eq '2' ? 'nd' : 'rd'); + } else { + $_ . 'th'; + } + } @_; +} + +1; + +__END__ +=back + +=head1 SEE ALSO + +L, +L, +L + +=head1 AUTHOR + +Topia Etopia@clovery.jpE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2005 by Topia. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.6 or, +at your option, any later version of Perl 5 you may have available. + +=cut diff -urN /non-existant-dir/main/Tiarra/WrapMainLoop.pm tiarra-20050322/main/Tiarra/WrapMainLoop.pm --- /non-existant-dir/main/Tiarra/WrapMainLoop.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Tiarra/WrapMainLoop.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,141 @@ +# ----------------------------------------------------------------------------- +# $Id: WrapMainLoop.pm 655 2004-10-14 16:00:17Z topia $ +# ----------------------------------------------------------------------------- +# MainLoop wrapper for write Portable Module +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tiarra::WrapMainLoop; +use strict; +use warnings; +use Carp; +use Tiarra::Utils; +utils->define_attr_accessor(0, + qw(installed name), + map { ["_$_", $_] } + qw(closure type interval object)); + +# lazy load +#use RunLoop; +#use Timer; + +sub new { + my ($class, %opt) = @_; + + my $this = { + installed => 0, + }; + bless $this, $class; + $this->type(utils->get_first_defined($opt{type}, 'timer')); + $this->interval(utils->get_first_defined($opt{interval}, 5)); + $this->_closure(utils->get_first_defined($opt{closure}, undef)); + $this->name(utils->get_first_defined( + $opt{name}, + utils->simple_caller_formatter('wrapmainloop registered'))); + $this; +} + +sub _check_uninstalled { + my $this = shift; + + croak "hook/timer installed; before uninstall this." + if $this->installed; +} + +sub _check_installed { + my $this = shift; + + croak "hook/timer uninstalled; before install this." + unless $this->installed; +} + +sub type { + my ($this, $value) = @_; + + $this->_check_uninstalled; + if (defined $value) { + croak "unsupported mainloop type: $value." + if (!scalar(grep { $value eq $_; } qw(timer mainloop))); + $this->_type($value); + } + $this->_type; +} + +sub interval { + my ($this, $value, $option) = @_; + + if (defined $value) { + if ($this->_type eq 'timer') { + if ($value < 1 && + !(defined $option && $option eq 'permit_toofast')) { + croak "interval is too fast! if without program bug, ". + "pass 'permit_toofast' option."; + } + $this->_interval($value); + $this->_object->interval($value) if ($this->installed); + } elsif ($this->_type eq 'mainloop') { + croak "interval is not used in this type; fix code."; + } else { + die 'internal error! unknown type('.$this->_type.').'; + } + } + $this->_interval; +} + +sub install { + my $this = shift; + $this->_check_uninstalled; + $this->_install; +} + +sub uninstall { + my $this = shift; + $this->_check_installed; + $this->_uninstall; +} + +sub lazy_install { + my $this = shift; + $this->_install unless $this->installed; +} + +sub lazy_uninstall { + my $this = shift; + $this->_uninstall if $this->installed; +} + +sub _install { + my $this = shift; + croak "closure is not defined;" + unless defined $this->_closure; + if ($this->_type eq 'timer') { + if (require Timer) { + $this->_object(Timer->new( + Name => 'WrapMainLoop: '.$this->name, + Repeat => 1, + Interval => $this->_interval, + Code => $this->_closure)->install); + } else { + die 'Timer cannot load'; + } + } elsif ($this->_type eq 'mainloop') { + if (require RunLoop) { + $this->_object(RunLoop::Hook->new($this->_closure)->install('after-select')); + } else { + die 'RunLoop cannot load'; + } + } else { + die 'internal error! unknown type('.$this->_type.').'; + } + $this->installed(1); + $this; +} + +sub _uninstall { + my $this = shift; + $this->_object->uninstall; + $this->_object(undef); + $this->installed(0); + $this; +} + +1; diff -urN /non-existant-dir/main/TiarraDoc.pm tiarra-20050322/main/TiarraDoc.pm --- /non-existant-dir/main/TiarraDoc.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/TiarraDoc.pm 2005-03-23 09:18:47.000000000 +0900 @@ -0,0 +1,405 @@ +# ------------------------------------------------------------------------ +# $Id: TiarraDoc.pm 803 2005-02-28 22:41:29Z topia $ +# ------------------------------------------------------------------------ +# tiarra-docのパーサとトランスレータ群。 +# ------------------------------------------------------------------------ +use strict; +use warnings; +use Tiarra::Encoding; +use IO::File; + +package DocParser; +use Carp; + +sub new { + my ($class,$fpath) = @_; + my $this = { + fpath => $fpath, + + docs => undef, # {パッケージ名 => DocPod} + }; + bless $this,$class; +} + +sub makeconf { + # confのブロックを生成する。 + # 戻り値: ([ブロック名,info,ブロック(文字列)],...) + # スカラーコンテクストで呼ぶとcroak。 + croak "You can't call DocParser->makeconf directly."; +} + +sub makehtml { + croak "You can't call DocParser->makehtml directly."; +} + +sub getdoc { + # パッケージ名を省略すると、要素が一つであればそれを返し、 + # 複数あればcroakする。一つも無ければundefを返す。 + my ($this,$pkg_name) = @_; + + if (!defined $this->{docs}) { + $this->{docs} = {}; + my @dummy = $this->_parse_docpod; + } + + if (defined $pkg_name) { + $this->{docs}{$pkg_name}; + } + else { + my @keys = keys %{$this->{docs}}; + if (@keys == 0) { + undef; + } + elsif (@keys == 1) { + $this->{docs}{$keys[0]}; + } + else { + croak "You can't ommit \$pkg_name if there's multiple poddocs."; + } + } +} + +sub _parse_docpod { + # tiarraドキュメント形式のpodを探してヘッダをパースして返す。 + # 同一パッケージにドキュメントが二つ以上あったらdie。 + # スカラーコンテクストで呼ばれたらcroak。 + # 戻り値の形式: (DocPod,DocPod,...) + croak "Don't call DocParser->_parse_docpod in scalar context." if !wantarray; + my $this = shift; + my @pods = $this->_parse_pod; + my $header_re = qr/^\s*(.+?)\s*:\s*(.+)$/; + + my @result; + my $new_doc = sub { + my ($pkg_name,$header,$remaining) = @_; + # 既にこのパッケージのドキュメントが用意されていないか？ + foreach (@result) { + if ($_->pkg_name eq $pkg_name) { + die "$pkg_name has multiple documents.\n"; + } + } + + my $docpod = DocPod->new($pkg_name,$header,$remaining); + push @result,$docpod; + $this->{docs}{$pkg_name} = $docpod; + }; + + foreach my $pod (@pods) { + my @lines = split /\x0a/,$pod->[1]; + if (@lines == 0) { + next; # これはドキュメントでない。 + } + elsif ($lines[0] =~ m/$header_re/) { + # ヘッダの終わりまでをパースする。 + my $header = {}; + my $remaining_start = @lines; + foreach (my $i = 0; $i < @lines; $i++) { + if ($lines[$i] =~ m/$header_re/) { + $header->{$1} = $2; + } + else { + # ここでヘッダ終わり。 + $remaining_start = $i; + last; + } + } + + # 全ての行について、先頭と末尾の空白を消去する。 + (my $remaining = join "\n",map { + s/^\s*|\s*$//g; + $_; + } @lines[$remaining_start .. (@lines-1)]) =~ s/^\s*|\s*$//g; + $new_doc->($pod->[0],$header,$remaining); + } + } + + @result; +} + +sub _parse_pod { + # =podと=cutに囲まれた範囲を返す。 + # 戻り値: ([パッケージ名,pod範囲],[パッケージ名,pod範囲],...) + # スカラーコンテクストで呼ばれたらcroak。 + croak "Don't call DocParser->_parse_pod in scalar context." if !wantarray; + my $this = shift; + my @lines = split /\x0d?\x0a/,$this->_get_content; + + my @result; + my $search_start_pos = 0; + my $pkg_name; + while (1) { + # =podを探す + my $found_pod_line; + for (my $i = $search_start_pos; $i < @lines; $i++) { + if ($lines[$i] =~ m/^\s*=pod\s*$/) { + $found_pod_line = $i; + last; + } + elsif ($lines[$i] =~ m/\s*package\s+(.+?);/) { + $pkg_name = $1; + } + } + + if (defined $found_pod_line) { + # あった。次は=cutを探す。 + my $found_cut_line; + for (my $i = $found_pod_line+1; $i < @lines; $i++) { + if ($lines[$i] =~ m/^\s*=cut\s*$/) { + $found_cut_line = $i; + last; + } + } + if (defined $found_cut_line) { + # あった。ここまで=pod & =cut。 + push @result,[ + $pkg_name, + join("\n",@lines[$found_pod_line+1 .. $found_cut_line-1]) + ]; + $search_start_pos = $found_cut_line+1; + } + else { + # 無い。エラー。 + die "$this->{fpath} has unbalanced =pod and =cut\n"; + } + } + else { + # 無い。ここで終わり。 + last; + } + } + + @result; +} + +sub _get_content { + # ファイルの中身をutf8で返す。 + my $this = shift; + + my $fh = IO::File->new($this->{fpath},'r'); + if (!defined $fh) { + die "Couldn't open file $this->{fpath}.\n"; + } + local $/ = undef; + my $content = <$fh>; + $fh->close; + + my $code = $this->_getcode($content); + if ($code eq 'unknown') { + die "Couldn't determine the charset of $this->{fpath}.\n"; + } + + Tiarra::Encoding->new($content,$code)->utf8; +} + +sub _getcode { + # 文字コードを判別する。 + my ($this,$content) = @_; + my $unijp = Tiarra::Encoding->new; + + if ((my $code = $unijp->getcode($content)) ne 'unknown') { + # 判別できたら、これを返す。 + $code; + } + else { + # それぞれの行についてgetcodeを実行し、多数決を取る。 + my $total_for_each = {}; + foreach (split /[\r\n]/,$content) { + if ((my $c = $unijp->getcode($_)) ne 'unknown') { + $total_for_each->{$c} = ($total_for_each->{$c} || 0) + 1; + } + } + + my @rank = map { + $_->[0]; + } sort { + $b->[1] <=> $a->[1]; + } map { + [$_, $total_for_each->{$_}]; + } keys %$total_for_each; + if (@rank == 0) { + # 全部unknownだった! + # 仕方無いのでunknownを返す。 + 'unknown'; + } + elsif (@rank == 1) { + # 候補が一つだけ。これを返す。 + $rank[0]; + } + else { + # 候補のトップがasciiだったら、二番目のものを返す。 + # そうでなければトップを返す。 + if ($rank[0] eq 'ascii') { + $rank[1]; + } + else { + $rank[0]; + } + } + } +} + +package DocParser::Module; +use base qw/DocParser/; +use Carp; + +sub new { + my $class = shift; + $class->SUPER::new(@_); +} + +sub makeconf { + my $this = shift; + my $indent_level = shift || 2; + croak "Don't call DocParser->makeconf in scalar context." if !wantarray; + + map { + my $pod = $_; + my $conf = eval { + $this->_makeconf($pod,$indent_level); + }; if ($@) { + die $pod->pkg_name.": $@"; + } + [$pod->pkg_name,$pod->header->{info},$conf,$pod]; + } $this->_parse_docpod; +} + +sub _makeconf { + my ($this,$pod,$indent_level) = @_; + my $result = ''; + + # defaultヘッダに応じて+か-かを設定する。 + # 但しno-switchが定義されていて真であれば、それをしない。 + if ($pod->header->{'no-switch'}) { + $result .= $pod->pkg_name." {\n"; + } + else { + my $enabled = $pod->header->{default}; + if (defined $enabled) { + my $switch = {on => '+' , off => '-'}->{$enabled}; + if (defined $switch) { + $result .= $switch; + } + else { + die "Its `default' header is invalid: $enabled\n"; + } + } + else { + die "It doesn't have `default' header.\n"; + } + $result .= ' '.$pod->pkg_name." {\n"; + } + + # infoヘッダの内容を出力。無ければエラー。 + # ただしinfo-is-omittedが定義されていて真であれば出力しない。 + my $indent = ' ' x $indent_level; + my $block_indent = ''; + my $info = $pod->header->{info}; + if (defined $info) { + if (!$pod->header->{'info-is-omitted'}) { + $result .= "$indent# $info\n\n"; + } + } + else { + die "It doesn't have `info' header.\n"; + } + + # ルール: + # '#'で始まる行はそのまま出力。 + # 空行もそのまま出力。 + # key:value形式になっている部分もそのまま出力するが、 + # そのkeyの頭に'-'が付いていたら、それをコメントアウト。 + my @lines = split /\n/,$pod->content; + for (my $i = 0; $i < @lines; $i++) { + my $line = $lines[$i]; + + my $error = sub { + my $errstr = shift; + + # 前後5行と共にエラー行を示す。 + my $region_lines = 5; + my $begin = $i - $region_lines; + if ($begin < 0) { + $begin = 0; + } + my $end = $i + $region_lines; + if ($end >= @lines) { + $end = @lines-1; + } + my $list = join '',map { + if ($_ == $i) { + "=> |$lines[$_]\n"; + } + else { + " |$lines[$_]\n"; + } + } ($begin .. $end); + + die "$errstr\n$list"; + }; + + $result .= do { + if ($line eq '') { + ''; + } + else { + $indent . do { + if ($line =~ m/^\s*#/) { + (my $stripped = $line) =~ s/^\s*//; + "$block_indent$stripped"; + } + elsif ($line =~ m/^(.+?)\s*:\s*(.*)$/) { + my ($key,$value) = ($1,$2); + if ($key =~ s/^-//) { + "$block_indent#$key: $value"; + } + else { + "$block_indent$key: $value"; + } + } + elsif ($line =~ m/^(.+?)\s*{\s*$/) { + $_ = "$block_indent$1 {"; + $block_indent .= ' ' x 2; + $_; + } + elsif ($line =~ m/^}\s*$/) { + substr($block_indent, 0, 2) = ''; + "$block_indent}"; + } + else { + $error->('illegal line'); + } + }; + } + } . "\n"; + } + + $result . '}'; +} + +package DocPod; +our $AUTOLOAD; + +sub new { + my ($class,$pkg_name,$header,$content) = @_; + my $this = { + pkg_name => $pkg_name, + header => $header, + content => $content, + }; + bless $this,$class; +} + +sub AUTOLOAD { + my ($this,$arg) = @_; + (my $key = $AUTOLOAD) =~ s/.+?:://g; + + my $val = $this->{$key}; + if (defined $arg && ref($val) eq 'HASH') { + $val->{$arg}; + } + else { + $val; + } +} + +1; diff -urN /non-existant-dir/main/Timer.pm tiarra-20050322/main/Timer.pm --- /non-existant-dir/main/Timer.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/main/Timer.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,177 @@ +# ----------------------------------------------------------------------------- +# $Id: Timer.pm 655 2004-10-14 16:00:17Z topia $ +# ----------------------------------------------------------------------------- +# RunLoopに登録され、指定された時刻に起動するタイマーです。 +# 現在の実装では、精度は秒となっています。 +# タイマーの生成に必要なパラメータは、1)起動するサブルーチン、2)起動時刻又は起動までの秒数、 +# 3)起動までの秒数を指定した場合は起動後に再びタイマーをRunLoopに乗せるかどうか、です。 +# +# 起動するサブルーチンとしては、CODE型の値なら何でも構いません。 +# TimerはそのCODEに、引数として自分自身を渡してコールします。 +# +# 3秒後にHello, world!と表示する。 +# my $timer = Timer->new( +# After => 3, +# Code => sub { print "Hello, world!"; } +# )->install; +# +# 3秒毎にHello, world!と表示する。 +# my $timer = Timer->new( +# After => 3, # Intervalでも良い +# Code => sub { print "Hello, world!"; }, +# Repeat => 1 +# )->install; +# +# 3秒後にHello, world!と表示する。 +# my $timer = Timer->new( +# At => time + 3, +# Code => sub { print "Hello, world!"; } +# )->install; +# ----------------------------------------------------------------------------- +package Timer; +use strict; +use warnings; +use Carp; +use RunLoop; +use Tiarra::Utils; +utils->define_attr_accessor(0, qw(interval name)); + +sub new { + my ($class,%args) = @_; + my $obj = { + fire_time => undef, # 発動する時刻のエポック秒。 + interval => undef, # repeatする場合は、その間隔。しなければ未定義。 + code => undef, # 走らせるコード + runloop => undef, # RunLoopに登録されている場合は、そのRunLoop。 + name => utils->simple_caller_formatter('timer registered'), + }; + bless $obj,$class; + + # AfterとIntervalは同義。 + $args{'After'} = $args{'Interval'} if exists($args{'Interval'}); + + # Atで指定するか、AfterまたはIntervalで指定するか、そのどちらかでなければならない。 + if (exists($args{'At'}) && exists($args{'After'})) { + croak "Timer cannot be made with both parameters At and After (or Interval).\n"; + } + + # Atか、AfterまたはIntervalか、そのどちらか一つは必要。 + if (!exists($args{'At'}) && !exists($args{'After'})) { + croak "Either parameter At or After (or Interval) is required to make Timer.\n"; + } + + # Codeは常に必要。 + if (!exists($args{'Code'})) { + croak "Code is always required to make Timer.\n"; + } + + # CodeがCODE型でなければdie。 + if (ref($args{'Code'}) ne 'CODE') { + croak "Parameter Code was not valid CODE ref.\n"; + } + + $obj->{code} = $args{'Code'}; + + if (defined $args{'At'}) { + # Atで起動時刻が与えられた場合は、Repeatは出来ない。 + if ($args{'Repeat'}) { + carp "Warning: It can't repeat that Timer made with At.\n"; + } + + $obj->{fire_time} = $args{'At'}; + } + elsif (defined $args{'After'}) { + # Repeatが真であれば、間隔をAfterまたはIntervalで与えられた数値とする。 + if ($args{'Repeat'}) { + $obj->{interval} = $args{'After'}; + } + + $obj->{fire_time} = time + $args{'After'}; + } + + if (defined $args{'Name'}) { + $obj->{name} = $args{'Name'}; + } + + $obj; +} + +sub time_to_fire { + my ($this, $time) = @_; + if ($time) { + $this->{fire_time} = $time; + } + $this->{fire_time}; +} + +sub install { + # RunLoopにインストールする。 + # 引数を省略した場合はデフォルトのRunLoopにインストールする。 + my ($this,$runloop) = @_; + + if (defined $this->{runloop}) { + # 既にインストール済みだった。 + croak "This Timer has been already installed to RunLoop.\n"; + } + + $runloop = RunLoop->shared_loop unless defined $runloop; + $runloop->install_timer($this); + + $this->{runloop} = $runloop; + $this; +} + +sub uninstall { + # インストールしたRunLoopから、このタイマーをアンインストールする。 + my $this = shift; + + unless (defined $this->{runloop}) { + # インストールされていない。 + croak "This Timer hasn't been installed yet\n"; + } + + $this->{runloop}->uninstall_timer($this); + $this->{runloop} = undef; + $this; +} + +sub execute { + my $this = shift; + # Codeを実行し、必要ならリピートする。 + # RunLoopのみがこのメソッドを呼べる。 + my ($package_of_caller,undef,undef) = caller; + unless ($package_of_caller->isa('RunLoop')) { + croak "Only RunLoop may call method execute of Timer.\n"; + } + + eval { + utils->do_with_errmsg("Timer: $this->{name}", sub { + $this->{code}->($this); + }); + }; if ($@) { + $this->{runloop}->notify_error("$@"); + } + + if (defined $this->{interval}) { + $this->{fire_time} += $this->{interval}; + } + else { + $this->uninstall; + } + + $this; +} + +sub reset { + # interval から fire_time を算出しなおす + my ($this) = shift; + + if (defined $this->{interval}) { + $this->{fire_time} = time + $this->{interval}; + } else { + croak "Only Interval(Repeat) Timer can reset.\n"; + } + $this; +} + +1; diff -urN /non-existant-dir/makedoc tiarra-20050322/makedoc --- /non-existant-dir/makedoc 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/makedoc 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,334 @@ +#!/usr/bin/perl +# ------------------------------------------------------------------------ +# $Id: makedoc 803 2005-02-28 22:41:29Z topia $ +# ------------------------------------------------------------------------ +use strict; +use warnings; +use lib qw(main); +use Tiarra::Encoding; +use IO::File; +use File::Find; +use Template; +use TiarraDoc; +my $unijp_init = Tiarra::Encoding->new; + +my $conf_outputs = { + sample => { + output => 'sample.conf', + sections => qr/(^|,)important($|,)/, + include_defaults => 1, + }, + all => { + output => 'all.conf', + sections => qr/^/, # all + include_defaults => 1, + }, +}; + +my $stdout_charset = 'utf8'; +my $conf_charset = 'euc'; +my $html_charset = 'euc'; + +if (!-f 'tiarra' || !-d 'main' || !-d 'module') { + die "run this script on tiarra's directory.\n"; +} + +mkdir 'doc'; + +&makeconf; +&makehtml_mods_toc; +&makehtml_mods; +exit; + +sub makeconf { + + # module下の.pmを検索 + my @modules; + find(sub { + if (-f $_ && $_ =~ m/\.pm$/) { + push @modules, $File::Find::name; + } + },'module'); + + my $unijp = Tiarra::Encoding->new; + foreach my $genre (qw(sample all)) { + my $output = $conf_outputs->{$genre}; + my $sections = $output->{sections}; + + print "*** Generating $output->{output}... ***\n"; + + my $t = Template->new("doc-src/$genre.conf.in"); + + foreach my $conf (DocParser::Module->new('doc-src/conf-main.tdoc')->makeconf) { + print $conf->[0]." : ".$unijp->set($conf->[1])->$stdout_charset."\n"; + $t->expand($conf->[0] => $unijp->set($conf->[2])->$conf_charset); + } + + map { + my @confs = DocParser::Module->new($_)->makeconf; + foreach my $conf (@confs) { + unless ($output->{include_defaults} && + $conf->[3]->header->{default} eq 'on') { + next unless ($conf->[3]->header->{section} || '') =~ /$sections/; + } + print $conf->[0]." : ".$unijp->set($conf->[1])->$stdout_charset."\n"; + $t->modules->add(module => $unijp->set($conf->[2])->$conf_charset); + } + } sort @modules; + + my $fh = IO::File->new($output->{output}, 'w'); + $fh->print($t->str); + } +} + +our $classify_modules_CACHE; +sub classify_modules { + # 一度実行したら、その結果がキャッシュされる。 + if (defined($_ = $classify_modules_CACHE)) { + return $_; + } + + my $classified = {}; # {グループ名 => [それに含まれるモジュールのDocPod]} + my $classify = sub { + my $doc = shift; + + my $groupname = do { + if ($doc->pkg_name =~ m/^(.+?)::/) { + $1; + } + else { + ''; + } + }; + + my $vec = $classified->{$groupname}; + if (!defined $vec) { + $vec = $classified->{$groupname} = []; + } + push @$vec,$doc; + }; + + # module下の.pmを検索 + find(sub { + if (-f $_ && $_ =~ m/\.pm$/) { + my $parser = DocParser->new($_); + my $doc = eval { + $parser->getdoc; + }; if ($@) { + die "ERROR[$_]: $@\n"; + } + + # 分類 + $classify->($doc) if defined $doc; + } + },'module'); + + # ソート + foreach (keys %$classified) { + @{$classified->{$_}} = + map { $_->[1] } + sort { $a->[0] cmp $b->[0] } + map { [$_->pkg_name, $_]; } @{$classified->{$_}}; + } + + $classify_modules_CACHE = $classified; + $classified; +} + +sub makehtml_mods { + # ファイルはグループ毎に作られる点に注意。 + # すなわち、まず最初に全てのモジュールをグループに分類する必要がある。 + my $classified = &classify_modules; # {グループ名 => [それに含まれるモジュールのDocPod]} + + mkdir 'doc/module'; + + my $unijp = Tiarra::Encoding->new; + my $t = Template->new('doc-src/contents.html'); + + while (my ($groupname,$docpods) = each %$classified) { + my $group_path = + join('', + 'module/', + $groupname eq '' ? 'UNCLASSIFIED' : $groupname, + '.html'); + print "*** Generating doc/$group_path... ***\n"; + + $t->reset; + $t->expand( + group_name => $groupname, + css_path => '../default.css', + ); + + my $last_docpod = $docpods->[-1]; + foreach my $docpod (@$docpods) { + print " parsing and translating ".$docpod->pkg_name."\n"; + # 空行はそのまま出力。 + # key: valueの行は、とで出力。 + # そのkeyの頭に'-'が付いていたら、単にその'-'を消す。 + # + # '#'で始まる行は、

で出力するが、以下の特殊なルールに従う。 + # 1. '#'の行が連続している場合、それらの行を一つのグループにまとめる。 + # 2. 各グループ内で'#'に後続する共通の数のスペースを取り除く。 + # 3. 取り除いた後、'#'後にスペースがまだ残っているなら、それを に置換する。 + # + # 例: + # # foo + # # bar { + # # baz + # # } + # ↓ + #

+ # foo
+ # bar {
+ #   baz
+ # }
+ #

+ my $html = ''; # 文字コードはUTF-8 + + my @lines = split /\n/,$docpod->content; + for (my $i = 0; $i < @lines; $i++) { + my $line = $lines[$i]; + + if ($line eq '') { + #$html .= "
\n"; + } + elsif ($line =~ m/^\s*#/) { + # グループ作成 + my @group; + for (; $i < @lines; $i++) { + if ($lines[$i] =~ m/^\s*#/) { + # これはブロックの続き。 + (my $stripped = $lines[$i]) =~ s/^\s*#//; + + # タブは4つのスペースに変換。この動作は後で修正するかも知れない。 + $stripped =~ s/\t/ /g; + + push @group,$stripped; + } + else { + $i--; + last; # ここで終わり + } + } + + # 共通する先頭のスペースを除去。すなわち各行について先頭のスペースの個数を数え、 + # その最小値を削るべきスペースの数とする。 + my $spaces_to_remove; + foreach (@group) { + m/^(\s*)/; + if (defined $1) { + my $n_spaces = length($1); + if (defined $spaces_to_remove) { + $spaces_to_remove = $n_spaces + if $spaces_to_remove > $n_spaces; + } + else { + $spaces_to_remove = $n_spaces; + } + } + } + if (defined $spaces_to_remove) { + @group = map { + s/^\s{$spaces_to_remove}//; $_; + } @group; + } + + # それでも残っている先頭のスペースを に置換。 + @group = map { + s/^(\s+)/' ' x length($1) if defined $1/e; $_; + } @group; + + $html .= qq{

\n}; + $html .= join('', + map { + "$_
\n"; + } @group); + $html .= qq{

\n}; + } + elsif ($line =~ m/^-?(.+?)\s*:\s*(.*)$/) { + my ($key,$value) = ($1,$2); + $html .= qq{$key:$value
\n}; + } elsif ($line =~ m/^(.+?)\s*{\s*$/) { + $html .= qq{$1\n}; + $html .= qq{
\n}; + } elsif ($line =~ m/^}\s*$/) { + $html .= qq{
\n}; + } + } + + # テンプレを展開 + $t->element->expand( + content_name => $docpod->pkg_name, + description => $unijp->set($docpod->header('info'))->$html_charset, + content => $unijp->set($html)->$html_charset); + + # これが最後の要素でなければ、hrを追加する。 + if ($docpod != $last_docpod) { + $t->element->hr->add; + } + + $t->element->add; + } + + # ファイルに出力 + my $fh = IO::File->new("doc/$group_path",'w'); + $fh->print($t->str); + } +} + +sub makehtml_mods_toc { + print "*** Generating doc/module-toc.html... ***\n"; + + my $t = Template->new('doc-src/module-toc.html'); + + my $classified = &classify_modules; # {グループ名 => [それに含まれるモジュールのDocPod]} + + # module-group.tdocを読んで、各グループの説明を取得する。 + my $groups = DocParser->new('doc-src/module-group.tdoc'); + + foreach my $groupname (sort {$a cmp $b} keys %$classified) { + my $description = do { + # このグループに対して、説明が定義されているか？ + my $groupdoc = $groups->getdoc($groupname); + if (defined $groupdoc) { + my $description = $groupdoc->header->{description}; + defined $description ? $description : ''; + } + else { + ''; + } + }; + if ($description eq '') { + warn "group $groupname don't have description."; + } + + my $unijp = Tiarra::Encoding->new; + + my $group_path = + join('', + 'module/', + $groupname eq '' ? 'UNCLASSIFIED' : $groupname, + '.html'); + + $t->toc_group->expand( + group_path => $unijp->set($group_path)->$html_charset, + group_name => $unijp->set($groupname)->$html_charset, + description => $unijp->set($description)->$html_charset, + ); + + # 各モジュール名とその説明を展開〜 + foreach my $moddoc (@{$classified->{$groupname}}) { + print $moddoc->pkg_name." belongs to the group `".$groupname."'\n"; + $t->toc_group->toc_individual->add( + group_path => $unijp->set($group_path)->$html_charset, + mod_name => $unijp->set($moddoc->pkg_name)->$html_charset, + description => $unijp->set($moddoc->header->{info} || '')->$html_charset, + ); + } + + $t->toc_group->add; + } + + my $fh = IO::File->new('doc/module-toc.html','w'); + $fh->print($t->str); +} diff -urN /non-existant-dir/module/Auto/Alias.pm tiarra-20050322/module/Auto/Alias.pm --- /non-existant-dir/module/Auto/Alias.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/Alias.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,132 @@ +# ----------------------------------------------------------------------------- +# $Id: Alias.pm 598 2004-09-28 01:44:59Z topia $ +# ----------------------------------------------------------------------------- +package Auto::Alias; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::AliasDB Auto::Utils); +use Auto::AliasDB; +use Auto::Utils; +use Mask; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + Auto::AliasDB::setfile($this->config->alias, + $this->config->alias_encoding); + $this; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + if ($msg->command eq 'PRIVMSG') { + + if (Mask::match($this->config->confirm,$msg->param(1))) { + # その人のエイリアスがあればprivで返す。 + my (undef,undef,$reply_as_priv,undef,undef) + = Auto::Utils::generate_reply_closures($msg,$sender,\@result, 0); # Alias conversion disable. + + my $alias = Auto::AliasDB->find_alias_prefix($msg->prefix); + if (defined $alias) { + while (my ($key,$values) = each %$alias) { + map { + $reply_as_priv->("$key: $_"); + } @$values; + } + } + } else { + my (undef,undef,undef,$reply_anywhere,undef) + = Auto::Utils::generate_reply_closures($msg,$sender,\@result, 1); + + my $msg_from_modifier_p = sub { + !defined $msg->prefix || + Mask::match_deep([Mask::array_or_all($this->config->modifier('all'))], + $msg->prefix); + }; + + my ($temp) = $msg->param(1); + $temp =~ s/^\s*(.+)\s*$/$1/; + my ($keyword,$key,$value) + = split(/\s+/, $temp, 3); + + if (Mask::match($this->config->get('add'),$keyword)) { + if ($msg_from_modifier_p->() && defined $key && defined $value) { + if (Auto::AliasDB->add_value_with_prefix($msg->prefix, $key, $value)) { + $reply_anywhere->([$this->config->added_format('all')], + 'key' => $key, 'value' => $value); + } else { + $reply_anywhere->([$this->config->add_failed_format('all')], + 'key' => $key, 'value' => $value); + } + } + } elsif (Mask::match($this->config->get('remove'),$keyword)) { + if ($msg_from_modifier_p->() && defined $key) { + my $count = Auto::AliasDB->del_value_with_prefix($msg->prefix, $key, $value); + if ($count) { + $reply_anywhere->([$this->config->removed_format('all')], 'key' => $key, 'value' => $value, 'count' => $count); + } else { + $reply_anywhere->([$this->config->remove_failed_format('all')], 'key' => $key, 'value' => $value); + } + } + } + } + } + return @result; +} + +1; + +=pod +info: ユーザエイリアス情報の管理を行ないます。 +default: off + +# エイリアスは基本的にname,userの二つのフィールドから成っており、 +# それぞれユーザー名、ユーザーマスクを表します。 + +# エイリアス定義ファイルのパスと、そのエンコーディング。 +# このファイルは次のようなフォーマットである。 +# 1. それぞれの行は「<キー>: <値>」の形式である。 +# 2. 空の行で、各ユーザーを区切る。 +# 3. <値>はカンマで区切られて複数の値とされる。 +# +# エイリアス定義ファイルの例: +# +# name: sample +# user: *!*sample@*.sample.net +# +# name: sample2,[sample2] +# user: *!sample2@*.sample.net,*!sample2@*.sample2.net +# +alias: alias.txt +alias-encoding: euc + +# この発言をした人のエイリアスが登録されていれば、それをprivで送る。 +confirm: エイリアス確認 + +# 「 user *!*user@*.user.net」のようにして情報を追加。 +# 発言をした人のエイリアスが未登録だった場合は、userのみ受け付けて新規追加とする。 +add: エイリアス追加 + +# 「 name ユーザー」のようにして情報を削除。 +# userを全て削除されたエイリアスは他の情報(name等)も含めて消滅する。 +remove: エイリアス削除 + +# メッセージが追加されたときの反応を指定します。 +# ランダムなメッセージを発言する際のフォーマットを指定します。 +# エイリアス置換が有効です。#(nick.now)、#(channel)は +# それぞれ相手のnick、チャンネル名に置換されます。 +# #(key)、#(value)は、追加されたキーと値に置換されます。 +added-format: #(name|nick.now): エイリアス #(key) に #(value) を追加しました。 +add-failed-format: #(name|nick.now): エイリアス #(key) の追加に失敗しました。 + +# メッセージが削除されたときの反応を指定します。 +# added-formatで指定できるものと同じです。 +removed-format: #(name|nick.now): エイリアス #(key) から #(value) を削除しました。 +remove-failed-format: #(name|nick.now): エイリアス #(key) からの削除に失敗しました。 + +# エイリアスの追加や削除が許されている人。省略された場合は「*!*@*」と見做される。 +modifier: *!*@* +=cut diff -urN /non-existant-dir/module/Auto/AliasDB/CallbackUtils.pm tiarra-20050322/module/Auto/AliasDB/CallbackUtils.pm --- /non-existant-dir/module/Auto/AliasDB/CallbackUtils.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/AliasDB/CallbackUtils.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,287 @@ +# ----------------------------------------------------------------------------- +# $Id: CallbackUtils.pm 561 2004-09-15 05:52:20Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. + +package Auto::AliasDB::CallbackUtils; +use Auto::AliasDB; +use strict; +use warnings; +use Carp; +use RunLoop; +use Multicast; +use Tiarra::SharedMixin; +our $_shared_instance; + +sub _new { + my ($class) = @_; + my $obj = { + loaded_modules => {}, + }; + bless $obj,$class; +} + +sub _getmodule { + my ($this, $modulename) = @_; + + return $this->shared->{loaded_modules}->{$modulename}; +} + +sub _loadmodule { + my ($this, $modulename, $need_module_use) = @_; + my ($module) = $this->_getmodule($modulename); + if (defined $module) { + # module already 'tryed' load. + } else { + if ($need_module_use) { + eval "use Module::Use ('$modulename')"; + } + eval 'use ' . $modulename; + unless ($@) { + $module = $this->shared->{loaded_modules}->{$modulename} = 1; + + return $module; + } else { + $module = $this->shared->{loaded_modules}->{$modulename} = 0; + } + carp "can't load $modulename" if $module != 1; + } + return $module; +} + +sub register_callback { + my ($reg_callback, $callbacks) = @_; + + my ($callback_code) = sub { + if (ref($reg_callback) eq 'CODE') { + # code reference + return $reg_callback; + } elsif (!ref($reg_callback)) { + # scalar + my $code = eval('\&' . $reg_callback); + return $code unless ($@); + carp($reg_callback . ' is scalar, but function not defined.'); + return undef; + } else { + carp($reg_callback . ' is not code_reference or scalar.'); + return undef; + } + }->(); + + return $callbacks unless defined($callback_code); + + foreach my $callback (@$callbacks) { + return $callbacks if $callback == $callback_code; + } + push(@$callbacks, $callback_code); + return $callbacks; +} + +sub register_stdcallbacks { + my ($callbacks, $msg, $sender) = @_; + + register_callback(\&DateConvert, $callbacks); + register_callback(\&RandomConvert, $callbacks); + register_callback(\&RandomSelectConvert, $callbacks); + register_callback(\&RandomAliasConvert, $callbacks); + register_callback(\&JoinedListConvert, $callbacks); + if (defined $msg) { + if (defined $sender) { + register_RandomNickConvert($callbacks, $msg->param(0), $sender); + } + register_MessageReplace($callbacks, $msg->param(1)); + } + + return $callbacks; +} + +sub DateConvert { + my ($key) = @_; + my ($tag, $value) = split(/\:/, $key, 2); + + return undef unless ($tag eq 'date'); + return undef unless (Auto::AliasDB::CallbackUtils->shared->_loadmodule('Tools::DateConvert', 1)); + return Tools::DateConvert::replace($value); +} + +sub RandomConvert { + my ($key) = @_; + my ($tag, $value) = split(/\:/, $key, 2); + + return undef unless defined($tag) and defined ($value); + return undef unless ($tag eq 'random'); + return undef unless ($value =~ /^(\d+)-(\d+)$/); + return (int(rand($2 - $1 + 1)) + $1); +} + +sub RandomSelectConvert { + my ($key) = @_; + my ($tag, @values) = split(/\:/, $key); + + return undef unless ($tag eq 'randomselect'); + return @values[int(rand(scalar(@values)))]; +} + +sub RandomAliasConvert { + my ($key, $hashtables) = @_; + my ($tag, $name) = split(/\:/, $key, 2); + + return undef unless ($tag eq 'randomalias'); + return undef unless defined($name); + # search hashtable + foreach my $table (@$hashtables) { + my $value = Auto::AliasDB::get_value_random($table, $name); + return $value if defined($value); + } +} + +sub JoinedListConvert { + my ($key, $hashtables) = @_; + my ($tag, $name, $sep) = split(/\:/, $key, 3); + + return undef unless ($tag eq 'joined_list'); + return undef unless defined($name) && defined($sep); + # search hashtable + foreach my $table (@$hashtables) { + my @values = @{Auto::AliasDB::get_array($table, $name)}; + if (@values) { + # 発見 + return join($sep, @values); + } + } + return undef; +} + + +sub RandomNickConvert { + my ($ch, $key) = @_; + my $idx; + + return undef unless ($key eq 'randomnick'); + $idx = int(rand($ch->names(undef, undef, 'size'))); + return $ch->names((keys(%{$ch->names()}))[$idx])->person->nick; +} + +sub register_RandomNickConvert { + # using: + # Auto::AliasDB::CallbackUtils::register_RandomNickConvert($callbacks, $ch_name, $sender); + my ($callbacks, $ch_name, $sender) = @_; + return $callbacks unless $sender->isa('IrcIO::Server'); + my $ch = $sender->channel(Multicast::detatch($ch_name)); + + return $callbacks unless defined $ch; + register_callback( + sub { + return RandomNickConvert($ch, @_); + }, $callbacks); + + return $callbacks; +} + +sub MessageReplace { + my ($message, $key) = @_; + my ($tag, $split_char, $place) = split(/\:/, $key, 3); + my ($offsetlen); + + if ($tag eq 'message_replace') { + $offsetlen = 2; + } elsif ($tag eq 'message_replace_last') { + $offsetlen = 1; + } else { + return undef; + } + return undef unless (defined $split_char) && (defined $place); + return (split($split_char, $message, $place + $offsetlen))[$place]; +} + +sub register_MessageReplace { + # using: + # Auto::AliasDB::CallbackUtils::register_MessageReplace($callbacks, $message); + my ($callbacks, $message) = @_; + + return $callbacks unless defined $message; + register_callback( + sub { + MessageReplace($message, @_); + }, $callbacks); + + return $callbacks; +} + +# --- not secure --- + +sub register_extcallbacks { + my ($callbacks, $msg, $sender) = @_; + + Auto::AliasDB::CallbackUtils::register_Nick_setMode($callbacks, $msg, $sender); + Auto::AliasDB::CallbackUtils::register_callback(\&ReadFileConvert, $callbacks); + Auto::AliasDB::CallbackUtils::register_callback(\&FileLinesConvert, $callbacks); + + return $callbacks; +} + +sub ReadFileConvert { + my ($key) = @_; + my ($tag, $fpath, $mode, $charset) = split(/\:/, $key, 4); + + return undef unless $tag eq 'read_file'; + return undef unless (Auto::AliasDB::CallbackUtils->shared->_loadmodule('Tools::FileCache', 1)); + $mode = 'std' if (!defined($mode)); + my $file = Tools::FileCache->shared->find_file($fpath, $mode, $charset); + return undef unless defined($file); + return $file->get_value(); +} + +sub FileLinesConvert { + my ($key) = @_; + my ($tag, $fpath, $mode, $charset) = split(/\:/, $key, 4); + + return undef unless $tag eq 'file_lines'; + return undef unless (Auto::AliasDB::CallbackUtils->shared->_loadmodule('Tools::FileCache', 1)); + $mode = 'std' if (!defined($mode)); + my $file = Tools::FileCache->shared->find_file($fpath, $mode, $charset); + return undef unless defined($file); + return $file->length(); +} + +sub Nick_setMode { + my ($irc_message, $sender, $key) = @_; + my ($tag, $value) = split(/\:/, $key, 2); + + return undef unless ($tag eq 'set_chmode'); + return undef unless ($value =~ /^[+-][vo]$/); + return '' unless ($sender->isa('IrcIO::Server')); + $irc_message->param(1, $value); + Timer->new( + After => 0, + Repeat => 0, + Code => sub { + my $timer = shift; + $sender->send_message($irc_message); + })->install; + return ''; +} + +sub register_Nick_setMode { + # using: + # Auto::AliasDB::CallbackUtils::register_Nick_setMode($callbacks, $msg, $sender); + my ($callbacks, $msg, $sender) = @_; + my ($ch_name) = $msg->param(0); + return $callbacks if (Multicast::nick_p($ch_name)); #priv + $ch_name = scalar(Multicast::detatch($ch_name)); + my $irc_message = IRCMessage->new( + Command => 'MODE', + Params => [$ch_name, + '', #set later + $msg->nick]); + + register_callback( + sub { + Nick_setMode($irc_message, $sender, @_); + }, $callbacks); + + return $callbacks; +} + + +1; diff -urN /non-existant-dir/module/Auto/AliasDB.pm tiarra-20050322/module/Auto/AliasDB.pm --- /non-existant-dir/module/Auto/AliasDB.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/AliasDB.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,203 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: AliasDB.pm 801 2005-02-28 20:01:19Z topia $ +# ----------------------------------------------------------------------------- +# エイリアスファイルの読み込みと生成、#(name|nick)といった文字列の置換を行なうクラス。 +# Tiarraモジュールではない。 +# このクラスは共通のインスタンスを一つだけ持つ。 +# ----------------------------------------------------------------------------- +package Auto::AliasDB; +use strict; +use warnings; +use IO::File; +use File::stat; +use Module::Use qw(Auto::AliasDB::CallbackUtils Tools::GroupDB); +use Auto::AliasDB::CallbackUtils; +use Tools::GroupDB; +use Mask; +use Configuration; +use Configuration::Block; +use Tiarra::SharedMixin; +use Tiarra::Utils; +our $_shared_instance; + +Tiarra::Utils->define_attr_getter(1, qw(database config)); +Tiarra::Utils->define_proxy('database', 1, + [qw(add_alias add_group)], + map { [$_.'_prefix', $_.'_primary'] } + qw(add_value_with del_value_with)); + +sub setfile { + # クラス関数。 + my ($fpath,$charset) = @_; + # re-initialize + __PACKAGE__->_shared_init($fpath,$charset); +} + +sub _new { + # fpathを省略するか空の文字列を指定すると、空のAliasDBが作られます。 + my ($class,$fpath,$charset) = @_; + my $obj = { + database => Tools::GroupDB->new($fpath, 'user', $charset || undef, 0), + config => Configuration::shared_conf->get(__PACKAGE__) + || Configuration::Block->new(__PACKAGE__), + }; + bless $obj,$class; +} + +sub find_alias_prefix { + # userinfoはnick!user@hostの形式。 + # 見付からなければundefを返す。 + # flagに付いてはfind_alias参照。 + my ($class_or_this, $userinfo, $flag) = @_; + my $this = $class_or_this->_this; + + return $this->find_alias('user', $userinfo, $flag); +} + +sub find_alias { + # on not found return 'undef' + # $keys is ref[array or scalar] + # $values is ref[array or scalar] + # $flag is public_alias flag. true is 'public', default false. + my ($class_or_this, $keys, $values, $flag) = @_; + my $this = $class_or_this->_this; + + $flag = 0 unless defined($flag); + + my $person = $this->{database}->find_group($keys, $values); + + if (defined($person)) { + if ($flag) { + # public. remove private alias. + return $this->remove_private(dup_struct($person)); + } else { + # not public + return $person; + } + } + + return undef; +} + +sub add_value { + my ($class_or_this, $alias, $key, $value) = @_; + + return $alias->add_value($key, $value); +} + +sub del_value { + my ($class_or_this, $alias, $key, $value) = @_; + + return $alias->del_value($key, $value); +} + +# alias misc functions +sub find_alias_with_stdreplace { + my ($class_or_this, $nick, $name, $host, $prefix, $flag) = @_; + my $this = $class_or_this->_this; + + return add_stdreplace(dup_struct($this->find_alias_prefix($prefix, $flag)), + $nick, $name, $host, $prefix); +} + +sub add_stdreplace { + my ($alias, $nick, $name, $host, $prefix) = @_; + + $alias = {} unless defined($alias); + + $alias->{'nick.now'} = $nick; + $alias->{'user.now'} = $name; + $alias->{'host.now'} = $host; + $alias->{'prefix.now'} = $prefix; + + return $alias; +} + +sub remove_private { + my ($class_or_this, $alias, $prefix, $suffix) = @_; + my $this = $class_or_this->_this; + + $prefix = '' unless defined($prefix); + $suffix = '' unless defined($suffix); + + foreach my $remove_key ($this->config->private('all')) { + delete $alias->{$prefix . $remove_key . $suffix}; + } + + return $alias; +} + +sub check_readonly { + my ($class_or_this, $keys) = @_; + my $this = $class_or_this->_this; + + foreach my $check_key ($this->config->readonly('all')) { + @$keys = grep { + $_ ne $check_key; + } @$keys; + } + + return $keys; +} + +sub dup_struct { + my ($alias) = @_; + + return undef unless defined($alias); + return $alias->clone; +} + +sub concat_string_to_key { + return Tools::GroupDB::concat_string_to_key(@_); +} + +# first param should be Tool::Hash. +sub get_value_random { shift->get_value_random(@_); } +sub get_value { shift->get_value(@_) } +sub get_array { shift->get_array(@_) } + +# replace support functions +sub replace { + # エイリアスマクロの置換を行なう。%optionalは置換に追加するキーと値の組みで、省略可。 + # optionalの値はSCALARでもARRAYでも良い。 + # userinfoはnick!user@hostの形式。 + my ($class_or_this,$userinfo,$str,%optional) = @_; + my $this = $class_or_this->_this; + $this->replace_with_callbacks($userinfo,$str,undef,%optional); +} + +sub stdreplace { + my ($class_or_this, $userinfo, $str, $msg, $sender, %optional) = @_; + my $this = $class_or_this->_this; + my (@callbacks); + + return $this->stdreplace_add($userinfo, $str, \@callbacks, $msg, $sender, %optional); +} + +sub stdreplace_add { + my ($class_or_this, $userinfo, $str, $callbacks, $msg, $sender, %optional) = @_; + my $this = $class_or_this->_this; + + Auto::AliasDB::CallbackUtils::register_stdcallbacks($callbacks, $msg, $sender); + my ($add_alias) = add_stdreplace( + undef, + $msg->nick || RunLoop->shared->current_nick, + $msg->name, + $msg->host, + $msg->prefix); + + return $this->replace_with_callbacks($userinfo, $str, $callbacks, %optional, %$add_alias); +} + +sub replace_with_callbacks { + # エイリアスマクロの置換を行なう。%optionalは置換に追加するキーと値の組みで、省略可。 + # $callbacksはalias/optionalで置換できなかった際に呼び出されるコールバック関数のリファレンス。 + # optionalの値はSCALARでもARRAYでも良い。 + # userinfoはnick!user@hostの形式。 + my ($class_or_this,$userinfo,$str,$callbacks,%optional) = @_; + my $this = $class_or_this->_this; + return $this->{database}->replace_with_callbacks($userinfo, $str, $callbacks, %optional); +} + +1; diff -urN /non-existant-dir/module/Auto/Answer.pm tiarra-20050322/module/Auto/Answer.pm --- /non-existant-dir/module/Auto/Answer.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/Answer.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,56 @@ +# ----------------------------------------------------------------------------- +# $Id: Answer.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +package Auto::Answer; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::Utils); +use Auto::Utils; +use Mask; +use Multicast; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + # サーバーからのメッセージか？ + if ($sender->isa('IrcIO::Server')) { + # PRIVMSGか？ + if ($msg->command eq 'PRIVMSG') { + my ($get_ch_name,undef,undef,$reply_anywhere) + = Auto::Utils::generate_reply_closures($msg,$sender,\@result); + + # replyに設定されたものの中から、一致しているものがあれば発言。 + # 一致にはMask::matchを用いる。 + foreach ($this->config->reply('all')) { + my ($mask,$reply_msg) = m/^(.+?)\s+(.+)$/; + if (Mask::match($mask,$msg->param(1))) { + # 一致していた。 + $reply_anywhere->($reply_msg); + } + } + } + } + + return @result; +} + +1; + +=pod +info: 特定の発言に反応して対応する発言をする。 +default: off + +# Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + +# 反応する発言と、それに対する返事を定義します。 +# エイリアス置換が有効です。#(nick.now)と$(channel)はそれぞれ +# 相手の現在のnickとチャンネル名に置換されます。 +# +# 書式: <反応する発言のマスク> <それに対する返事> +# 例: +-reply: こんにちは* こんにちは、#(name|nick.now)さん。 +# この例では誰かが「こんにちは」で始まる発言をすると、 +# 発言した人のエイリアスを参照して「こんにちは、○○さん。」のように発言します。 +=cut diff -urN /non-existant-dir/module/Auto/CacheManager.pm tiarra-20050322/module/Auto/CacheManager.pm --- /non-existant-dir/module/Auto/CacheManager.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/CacheManager.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,89 @@ +# ----------------------------------------------------------------------------- +# $Id: CacheManager.pm 533 2004-09-07 10:13:14Z topia $ +# ----------------------------------------------------------------------------- +# このクラスは共通のインスタンスを持ちます。 +# キャッシュサイズや有効期限などの設定はAuto::Cacheが行ないます。 +# +# 実際のチャンネルの管理は面倒なので、キャッシュ本体は +# ChannelInfoのremarks/cache-of-auto-modulesに保存します。 +# +# cache-of-auto-modules: ARRAY +# 要素: [発言内容,発言時刻] +# ----------------------------------------------------------------------------- +package Auto::CacheManager; +use strict; +use warnings; +use Tiarra::SharedMixin; +our $_shared_instance; + +sub _new { + my ($class) = @_; + my $this = { + size => 0, # デフォルトのキャッシュサイズ。 + expire => 600, # デフォルトの有効期限。単位は秒。 + }; + bless $this,$class; +} + +sub cached_p { + # ch: ChannelInfo + # str: SCALAR + # キャッシュされていたら1を返します。 + my ($this,$ch,$str) = @_; + my $cache = $this->get_cache($ch); + $this->expire($cache); + + foreach (@$cache) { + if ($_->[0] eq $str) { + return 1; + } + } + undef; +} + +sub cache { + my ($this,$ch,$str) = @_; + my $cache = $this->get_cache($ch); + $this->expire($cache); + + # キャッシュに追加 + push @$cache,[$str,time]; + # キャッシュサイズから溢れた分は削除 + if (@$cache > $this->{size}) { + splice @$cache,(@$cache - $this->{size}); + } +} + +sub get_cache { + my ($this,$ch) = @_; + my $cache = $ch->remarks('cache-of-auto-modules'); + if (!defined $cache) { + $cache = []; + $ch->remarks('cache-of-auto-modules',$cache); + } + $cache; +} + +sub expire { + my ($this,$cache) = @_; + # まずはexpireされる項目が一つでもあるかどうかを調べる。 + my $limit = time - $this->{expire}; + + my $expired_some = sub { + foreach (@$cache) { + if ($_->[1] < $limit) { + return 1; + } + } + undef; + }->(); + + if ($expired_some) { + # キャッシュを再構成 + @$cache = grep { + $_->[1] >= $limit; + } @$cache; + } +} + +1; diff -urN /non-existant-dir/module/Auto/Calc.pm tiarra-20050322/module/Auto/Calc.pm --- /non-existant-dir/module/Auto/Calc.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/Calc.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,239 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: Calc.pm 714 2004-11-05 20:23:07Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003-2004 Topia . all rights reserved. +package Auto::Calc::Share; +use strict; +our $__export = [qw(pi pie e frac)]; +sub export () { $__export } + +sub pi () { 3.141592653589793238 } +sub pie () { pi } +sub e () { exp(1) } +sub frac ($) { $_[0] - int($_[0]) } + +package Auto::Calc; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::Utils Auto::Calc::Share); +use Auto::Utils; +use Mask; + +use Symbol (); +use Safe; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{safe} = Safe->new(__PACKAGE__.'::Root'); + $this->{safe}->erase; + $this->{safe}->permit_only(qw(:base_core :base_math :base_orig), + qw(pack unpack), + qw(atan2 sin cos exp log sqrt), + ); + if (!$this->config->permit_sub) { + $this->{safe}->deny(qw(leavesub)); + } + my $pkg = __PACKAGE__.'::Share'; + $this->{safe}->share_from($pkg, $pkg->export); + + return $this; +} + +sub destruct { + my ($this) = shift; + + Symbol::delete_package(__PACKAGE__.'::Root') +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + my $return_value = sub { + return @result; + }; + + my (undef,undef,undef,$reply_anywhere,$get_full_ch_name) + = Auto::Utils::generate_reply_closures($msg,$sender,\@result); + + if ($msg->command eq 'PRIVMSG') { + my $method = $msg->param(1); + $method =~ s/^\s*(.*)\s*$/$1/; + + # init + if (Mask::match_deep([$this->config->init('all')], $method)) { + if (Mask::match_deep_chan([$this->config->init_mask('all')], + $msg->prefix, $get_full_ch_name->())) { + $this->{safe}->reinit; + $reply_anywhere->([$this->config->init_format('all')]); + return $return_value->(); + } + } + + my $keyword; + ($keyword, $method) = split(/\s+/, $method, 2); + + # request + if (Mask::match_deep([$this->config->request('all')], $keyword)) { + if (Mask::match_deep_chan([$this->config->mask('all')], + $msg->prefix, $get_full_ch_name->())) { + my ($ret, $err, $signal); + do { + # disable warning + local $SIG{__WARN__} = sub { }; + # + my $signal_handler = sub { + $signal = shift; + die "$signal called"; + }; + # floating point exceptions + local $SIG{FPE} = sub { $signal_handler->('SIGFPE'); } + if exists $SIG{FPE}; + # alarm + local $SIG{ALRM} = sub { $signal_handler->('ALARM'); } + if exists $SIG{ALRM}; + my $timeout = $this->config->timeout; + $timeout = 1 unless defined $timeout; + # die handler + local $SIG{__DIE__} = sub { + $err = shift; + die ''; + }; + + alarm $timeout if ($timeout); + no strict; + $ret = $this->{safe}->reval($method); + alarm 0 if ($timeout); + }; + + my $reply = sub { + my $array = shift; + + map { + if (defined($$_)) { + # 汚染の除去 + $$_ =~ tr/\t\x0a\x0d/ /; + $$_ =~ tr/\x00-\x19//d; + $$_ =~ s/^\s+//; + $$_ =~ s/\s+$//; + $$_ =~ s/\s{2,}/ /; + } else { + $$_ = $this->config->undef || 'undef'; + } + } (\$ret, \$err); + + if ($err) { + $err =~ s/ +at \(eval \d+\) line \d+//; + $err =~ s/, line \d+//; + } + + map { + $reply_anywhere->( + $_, + method => $method, + result => $ret, + error => $err, + signal => $signal, + ); + } @$array; + }; + + my @format_names; + if ($signal) { + push(@format_names, 'signal-'.lc($signal).'-format'); + push(@format_names, 'signal-format'); + } + if ($err) { + my $format = undef; + # format の個別化 + my $error_name = $err; + if ($this->config->error_name_formatter) { + + } + $error_name =~ s/'.+' (trapped by operation mask)/$1/; + $error_name =~ s/(Undefined subroutine) \&.+ (called)/$1 $2/; + $error_name =~ tr/ _/-/; + $error_name =~ tr/'`//d; + $error_name =~ s/\.$//; + $error_name =~ s/-+$//; + $error_name = lc($error_name); + #::debug_printmsg("error_name: $error_name"); + + push(@format_names, 'error-format'); + } else { + push(@format_names, 'reply-format'); + } + foreach my $format_name (@format_names) { + my @formats = $this->config->get($format_name, 'all'); + next if $#formats != 0; + $reply->(\@formats); + last; + } + } + } + } + + return $return_value->(); +} + +1; +=pod +info: Perlの式を計算させるモジュール。 +default: off + +# 反応する発言を指定します。 +request: 計算 + +# 使用を許可する人&チャンネルのマスク。 +# 例はTiarraモード時。 [default: なし] +mask: * +*!*@* +# [plum-mode] mask: +*!*@* + +# 結果が未定義だったときに置き換えられる文字列。省略されると undef 。 +-undef: (未定義) + +# 正常に計算できたときのフォーマット +# method: 計算式, result: 結果, error: エラー, signal: シグナル +reply-format: #(method): #(result) + +# エラーが起きたときのフォーマット +# method: 計算式, result: 結果, error: エラー, signal: シグナル +error-format: #(method): エラーです。(#(error)) + +# シグナルが発生したときのフォーマット +-signal-format: #(method): シグナルです。(#(signal)) + +# signal-$SIGNALNAME-format 形式。 +# $SIGNALNAME には現状 alarm/sigfpe があります。 +# 該当がなければ signal-format にフォールバックします。 + +# いくつかの例を挙げます。 +-signal-alarm-format: #(method): 時間切れです。 +-signal-sigfpe-format: $(method): 浮動小数点計算例外です。 + +# タイムアウトする秒数を指定します。 alarm に渡されます。 +# 再帰を止めるのに使えますが、どうもメモリリークしていそうな雰囲気です。 +timeout: 1 + +# サブルーチン定義を許可するかどうかを指定する。 +# 再帰定義が可能なので、許可する場合はこのモジュール専用の +# Tiarra を動かすことをお勧めします。 +permit-sub: 0 + +# 初期化する発言を指定します。 +# このモジュールでは現状変数や関数定義などを行えます。 +# このコマンドが発行されるとそれらをクリアします。 +init: 計算初期化 + +# 初期化を許可する人&チャンネルのマスク。 +# 例はTiarraモード時。 [default: なし] +init-mask: * +*!*@* +# [plum-mode] mask: +*!*@* + +# 再初期化したときの発言を指定します。 +init-format: 初期化しました。 + +=cut diff -urN /non-existant-dir/module/Auto/ChannelWithoutOper.pm tiarra-20050322/module/Auto/ChannelWithoutOper.pm --- /non-existant-dir/module/Auto/ChannelWithoutOper.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/ChannelWithoutOper.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,97 @@ +# ----------------------------------------------------------------------------- +# $Id: ChannelWithoutOper.pm 540 2004-09-10 08:29:31Z topia $ +# ----------------------------------------------------------------------------- +package Auto::ChannelWithoutOper; +use strict; +use warnings; +use base qw(Module); +use Multicast; +use IRCMessage; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{last_message_time} = 0; # 最後にこのモジュールが発言した時刻。 + $this->{table} = do { + my %hash = map { + my ($ch_long,$msg) = m/^(.+?)\s+(.+)$/; + $ch_long => $msg; + } $this->config->channel('all'); + \%hash; + }; + $this; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + my $notify = sub { + my ($ch_long,$ch_short,$str) = @_; + my $msg_to_send = IRCMessage->new( + Command => 'NOTICE', + Params => ['',$str]); # チャンネル名は後で設定 + # 鯖にはネットワーク名を付けない。 + my $for_server = $msg_to_send->clone; + $for_server->param(0,$ch_short); + $sender->send_message($for_server); + + # クライアントには付ける。Prefixも自動設定する。 + my $for_client = $msg_to_send->clone; + $for_client->param(0,$ch_long); + $for_client->remark('fill-prefix-when-sending-to-client',1); + push @result,$for_client; + }; + + if ($sender->isa('IrcIO::Server') && + defined $msg->nick && + $msg->nick ne RunLoop->shared->current_nick && + $msg->command eq 'JOIN') { + + foreach (split /,/,$msg->param(0)) { + my ($ch_long) = m/^([^\x07]+)/; + # このチャンネルに割り当てられたメッセージはあるか？ + my $msg_for_ch = $this->{table}->{$ch_long}; + if (defined $msg_for_ch) { + my $ch_short = Multicast::detach($ch_long); + my $ch = $sender->channel($ch_short); + # このチャンネルは+チャンネルでもなく、+aや+rが設定されていないか？ + if (defined $ch && + $ch->name !~ m/^\+/ && + !$ch->switches('a') && + !$ch->switches('r')) { + + # なるとを誰か持っているか？ + my $oper_exists; + foreach my $person (values %{$ch->names}) { + if ($person->has_o) { + $oper_exists = 1; + } + } + if (!$oper_exists) { + # 発言してから1秒以上経っていれば、発言。 + if (time > $this->{last_message_time} + 1) { + $notify->($ch_long,$ch_short,$msg_for_ch); + $this->{last_message_time} = time; + } + } + } + } + } + } + @result; +} + +1; + +=pod +info: チャンネルオペレータ権限がなくなってしまったときに発言する。 +default: off + +# +で始まらない特定のチャンネルで、+aモードでも+rモードでもないのに +# 誰もチャンネルオペレータ権限を持っていない状態になっている時、 +# そこに誰かがJOINする度に特定のメッセージを発言するモジュールです。 + +# 書式: <チャンネル名> <メッセージ> +-channel: #IRC談話室@ircnet なると消失しました。 +=cut diff -urN /non-existant-dir/module/Auto/Joined.pm tiarra-20050322/module/Auto/Joined.pm --- /non-existant-dir/module/Auto/Joined.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/Joined.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,69 @@ +# ----------------------------------------------------------------------------- +# $Id: Joined.pm 540 2004-09-10 08:29:31Z topia $ +# ----------------------------------------------------------------------------- +package Auto::Joined; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::Utils); +use Auto::Utils; +use Multicast; +use IRCMessage; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{last_message_time} = 0; # 最後にこのモジュールが発言した時刻。 + $this->{table} = do { + my %hash = map { + my ($ch_long,$msg) = m/^(.+?)\s+(.+)$/; + $ch_long => $msg; + } $this->config->channel('all'); + \%hash; + }; + $this; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + my ($get_ch_name,undef,undef,$reply_anywhere) + = Auto::Utils::generate_reply_closures($msg,$sender,\@result); + + if ($sender->isa('IrcIO::Server') && + defined $msg->nick && + $msg->nick ne RunLoop->shared->current_nick && + $msg->command eq 'JOIN') { + + foreach (split /,/,$msg->param(0)) { + my ($ch_long) = m/^([^\x07]+)/; + # このチャンネルに割り当てられたメッセージはあるか？ + my $msg_for_ch = $this->{table}->{$ch_long}; + if (defined $msg_for_ch) { + # 発言してから1秒以上経っていれば、発言。 + if (time > $this->{last_message_time} + 1) { + $reply_anywhere->($msg_for_ch); + $this->{last_message_time} = time; + } + } + } + } + + @result; +} + +1; + +=pod +info: 特定のチャンネルに誰かがJOINする度に特定のメッセージを発言する。 +default: off + +# Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + +# 発言を行なうチャンネルと、その内容を定義します。 +# #(nick.now)と$(channel)は、それぞれ相手の現在のnickとチャンネル名に置換されます。 +# +# 書式: <チャンネル名> <発言内容> +-channel: #チャンネル@ircnet 「#ちゃんねる」に移転しました。 +=cut diff -urN /non-existant-dir/module/Auto/MesMail.pm tiarra-20050322/module/Auto/MesMail.pm --- /non-existant-dir/module/Auto/MesMail.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/MesMail.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,367 @@ +# ----------------------------------------------------------------------------- +# $Id: MesMail.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package Auto::MesMail; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::Utils Auto::AliasDB Tools::DateConvert Tools::MailSend); +use Auto::Utils; +use Auto::AliasDB; +use Tools::DateConvert; +use Tools::MailSend; +use Mask; + +# デフォルト設定 +my $DATE_FORMAT = '%H:%M'; +my $FORMAT = '#(date) << #(from.name|from.nick|from.nick.now) >> #(message)'; +my $SUBJECT = 'Message from IRC'; + +sub new { + my ($class) = shift; + my $this = $class->SUPER::new(@_); + + $this->{from_addr} = sub { + my ($user, $host) = split(/\@/, $_[0], 2); + $user = (getpwuid($>))[0] || '' unless $user; + if ($host) { + substr($host, 0, 0) = '@'; + } else { + $host = '' + } + return ($user . $host); + }->($this->config->from); + + my ($use_pop3) = $this->config->use_pop3; + $use_pop3 = 1 if ($use_pop3 =~ /yes/i) || ($use_pop3 !~ /0/); + $this->{use_pop3} = $use_pop3; + + return $this; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + # サーバーからのメッセージか？ + if ($sender->isa('IrcIO::Server')) { + # PRIVMSGか？ + if ($msg->command eq 'PRIVMSG') { + my ($get_ch_name,undef,undef,$reply_anywhere) + = Auto::Utils::generate_reply_closures($msg,$sender,\@result); + + my ($str, $who, $text) = split(/\s+/, $msg->param(1), 3); + + if (Mask::match_deep([$this->config->send('all')], $str)) { + # 一致していた。 + if (Mask::match_deep_chan([$this->config->mask('all')], $msg->prefix(), $get_ch_name->())) { + $this->_send($msg, $sender, $who, $text, $get_ch_name, $reply_anywhere); + } else { + foreach my $reply ($this->config->deny('all')) { + $reply_anywhere->($reply); + } + } + } + } + } + + return @result; +} + +sub _send { + my ($this, $msg, $sender, $who, $text, $get_ch_name, $reply_anywhere) = @_; + my (@sended_addr, @sended_who); + my ($max_send) = $this->config->max_send_addresses; + + foreach my $name (split(/\,/, $who)) { + next if grep{$_ eq $name;} @sended_who; + push(@sended_who, $name); + my ($to) = Auto::AliasDB->shared->find_alias([$this->config->alias_key('all')], [$name]); + my ($alias) = {}; + + $alias->{'who'} = $name; + if (!defined ($to)) { + foreach my $reply ($this->config->unknown('all')) { + $reply_anywhere->($reply, %$alias); + } + } elsif ($to->{'mail'}) { + next if grep{$_ == $to->{'mail'};} @sended_addr; + push(@sended_addr, $to->{'mail'}); + my ($time) = time(); + $alias->{'date'} = + Tools::DateConvert::replace(Auto::AliasDB::get_value($to, 'mail_date') || + $this->config->date || $DATE_FORMAT, $time); + $alias->{'message'} = $text; + $this->_mail_send_reserve($msg, $sender, $alias, $to, $get_ch_name, $reply_anywhere, $time); + if (defined($max_send)) { + last if scalar(@sended_addr) >= $max_send; + } + } else { + foreach my $reply ($this->config->none_address('all')) { + $reply_anywhere->($reply, %$alias); + } + } + } +} + +sub _mail_send_reserve { + my ($this, $msg, $sender, $alias, $to, $get_ch_name, $reply_anywhere, $time) = @_; + + my ($subject) = Auto::AliasDB::get_value($to, 'mail_subject'); + $subject = $this->config->subject || $SUBJECT unless $subject; + + return Tools::MailSend->shared-> + mail_send( + use_pop3 => $this->{use_pop3}, + pop3_host => $this->config->pop3host, + pop3_port => $this->config->pop3port, + pop3_user => $this->config->pop3user, + pop3_pass => $this->config->pop3pass, + pop3_expire => $this->config->pop3_expire, + smtp_host => $this->config->smtphost, + smtp_port => $this->config->smtpport, + smtp_fqdn => $this->config->smtp_fqdn, + sender => 'Auto::MesMail::' . $msg->prefix(), + priority => 0, + env_from => $this->{from_addr}, + env_to => [Tools::MailSend::parse_mailaddrs(@{Auto::AliasDB::get_array($to, 'mail')})], + from => $this->config->from_header || $this->config->from || $this->{from_addr}, + to => Auto::AliasDB::get_value($to, 'mail'), + subject => $subject, + data_type => Tools::MailSend::DATA_TYPES->{inner_iter}, + data => \&_data, + reply_ok => \&_reply_ok, + reply_error => \&_reply_error, + reply_fatal => \&_reply_fatal, + local => + { + this => $this, + alias => $alias, + from => + Auto::AliasDB::concat_string_to_key( + Auto::AliasDB->shared-> + find_alias_with_stdreplace($msg->nick, + $msg->name, + $msg->host, + $msg->prefix, + 1 # public + ), 'from.'), + to => + Auto::AliasDB->shared-> + remove_private( + Auto::AliasDB::concat_string_to_key($to, 'to.'), + 'to.'), + reply_anywhere => $reply_anywhere, + time => $time, + replacer => sub { + my ($str, %extra_replaces) = @_; + + Auto::AliasDB->shared-> + stdreplace( + $msg->prefix || $sender->fullname, + $str, + $msg, + $sender, + %extra_replaces, + 'channel' => $get_ch_name->()); + }, + }, + ); +} + +sub _data { + my ($struct, $socksend) = @_; + + my $this = $struct->{local}->{this}; + my $alias = $struct->{local}->{alias}; + my $from = $struct->{local}->{from}; + my $to = $struct->{local}->{to}; + my $replacer = $struct->{local}->{replacer}; + + my @format = Auto::AliasDB::get_array($to, 'mail_format'); + @format = $this->config->format('all') unless @format; + @format = $FORMAT unless @format; + + foreach my $send_line (@format) { + $socksend->($replacer->($send_line, %$from, %$to, %$alias)); + } +} + +sub _reply_error { + my ($struct, $state, $line, $info) = @_; + # 使用者にerrorを返すメソッド。$infoには送信失敗のmail addressが含まれるはずだが、 + # channelに向かってmail addressを広報することになるので使用しないことを勧める。 + # なお、from/toにはprivate指定されたものは含まれない。 + + # stateには失敗したときの状態が渡され、'error-mail' や 'fatalerror-connect' のように + # 状態別詳細メッセージを定義することが出来る。 + + my $this = $struct->{local}->{this}; + my $alias = $struct->{local}->{alias}; + my $from = $struct->{local}->{from}; + my $to = $struct->{local}->{to}; + my $reply_anywhere = $struct->{local}->{reply_anywhere}; + + my @replys = $this->config->get('error-' . lc($state), 'all'); + @replys = $this->config->error('all') unless @replys; + foreach my $reply (@replys) { + $reply_anywhere->($reply, %$from, %$to, %$alias, + state => $state, + line => $line, + info => $info + ); + } +} + +sub _reply_fatal { + my ($struct, $state, $line, $info) = @_; + # 使用者にerrorを返すメソッド。$infoには送信失敗のmail addressが含まれるはずだが、 + # channelに向かってmail addressを広報することになるので使用しないことを勧める。 + # なお、from/toにはprivate指定されたものは含まれない。 + + # stateには失敗したときの状態が渡され、'error-mail' や 'fatalerror-connect' のように + # 状態別詳細メッセージを定義することが出来る。 + + # fatal は1送信者につき1つだけ返される(はず)。 + + my $this = $struct->{local}->{this}; + my $alias = $struct->{local}->{alias}; + my $from = $struct->{local}->{from}; + my $to = $struct->{local}->{to}; + my $reply_anywhere = $struct->{local}->{reply_anywhere}; + + # user notfound + my @replys = $this->config->get('fatalerror-' . lc($state), 'all'); + @replys = $this->config->fatalerror('all') unless @replys; + foreach my $reply (@replys) { + $reply_anywhere->($reply, %$from, %$to, %$alias, + state => $state, + line => $line, + info => $info + ); + } +} + +sub _reply_ok { + my ($struct) = @_; + # 使用者にacceptを返すメソッド。 + # from/toにはprivate指定されたものは含まれない。 + + my $this = $struct->{local}->{this}; + my $alias = $struct->{local}->{alias}; + my $from = $struct->{local}->{from}; + my $to = $struct->{local}->{to}; + my $reply_anywhere = $struct->{local}->{reply_anywhere}; + + foreach my $reply ($this->config->accept('all')) { + $reply_anywhere->($reply, %$from, %$alias, %$to); + } +} + +1; + +=pod +info: 伝言をメールとして送信する。 +default: off + +# メールアドレスはエイリアスの mail を参照します。 + +# Fromアドレス。[default: OSのユーザ名] +from: example1@example.jp + +# 送信用のキーワード [default: mesmail_send] +send: 速達伝言 + +# 使用を許可する人&チャンネルのマスク。 +# 例はTiarraモード時。 [default: なし] +mask: * +*!*@* +# [plum-mode] mask: +*!*@* + +# maskで拒否されたときのメッセージ [default: なし] +deny: 伝言したくない。 + +# 一度に送れる宛先の量 [default: 無制限] +max-send-address: 5 + +# 宛先を探すエイリアスエントリ [default: なし] +alias-key: name +alias-key: nick + +# 宛先の人を判別出来なかったときのメッセージ [default: なし] +unknown: #(who)さんと言うのは誰ですか? + +# メールの日付形式 +date: %H:%M:%S + +# エイリアスは見付かったけれどメールアドレスが登録されていなかったときのメッセージ。 [default: なし] +-none-address: #(who)さんはアドレスを登録していません。 + +# SMTPのホスト [default: localhost] +-smtphost: localhost + +# SMTPのポート [default: smtp(25)] +-smtpport: 25 + +# SMTPで自ホストのFQDN [default: localhost] +-smtpfqdn: localhost + +# 送信するメールの既定件名(エイリアス使用不可) [default: Message from IRC] +-subject: Message from IRC + +# 送信するメールの本文 [default: #(date) << #(from.name|from.nick|from.nick.now) >> #(message)] +-format: #(date)に#(from.name|from.nick|from.nick.now)さんから#(message)という伝言です。 + +# 送信したときのメッセージ。 [default: なし] +accept: #(who)さんに#(message)と伝言しておきました。 + +# ---- POP before SMTP の指定 ---- +# POP before SMTPを使う。 [default: no] +-use-pop3: yes + +# POP before SMTPのタイムアウト時間(分)。分からない場合は指定しなくて良い。 [default: 0] +-pop3-expire: 4 + +# POPのホスト。 [default: localhost] +-pop3host: localhost + +# POPのポート。 [default: pop(110)] +-pop3port: 110 + +# POPのユーザ [default: OSのユーザ名] +-pop3user: example1 + +# POPのパスワード [default: 空パスワード('')] +-pop3pass: test-password + +# ---- エラーメッセージの設定 ---- + +# 一般エラー。 +# error-[state] と言う形式で詳細エラーメッセージを指定できる。 +# [state]は、 +# * mailfrom(メールの送信者を指定しようとしてエラー) +# * rcptto(メールの送信先を指定しようとしてエラー) +# * norcptto(メールの送信先が全部無くなった) +# * data(メールの中身を送信しようとしてエラー) +# * finish(メールの中身を送信したらエラー) +# がある。特に欲しくなければerror-[state]は指定しなくても構わない。 +# メッセージを出したくないなら中身の無いエントリを指定すれば良い。 +# error-[state]が指定されてない場合は代わりに error を使う。 [default: 未定義] + +-error-rcptto: +-error-norcptto: #(who)さんには送れませんでした。送信できるメールアドレスがありません。 +-error-data: メールが送信できません。DATAコマンドに失敗しました。#(line;サーバ応答:%s|;) +-error: メール送信エラーです。#(line;サーバ応答:%s|;)#(state; on %s|;) + +# 致命的なエラー。メールに個別なエラーではないので送信者(のprefix)毎に1メッセージ送られる。 +# fatalerror-[state] +# [state]: +# * first(接続エラー) +# * helo(SMTPセッションを開始出来ない) +# がある。特に欲しくなければfatalerror-[state]は指定しなくても構わない。 +# メッセージを出したくないなら中身の無いエントリを指定すれば良い。 +# fatalerror-[state]が指定されてない場合は代わりに fatalerror を使う。 [default: 未定義] + +-fatalerror-first: SMTPサーバに接続できません。 +-fatalerror: SMTPセッションで致命的なエラーがありました。#(line; サーバ応答:%s|;)#(state; on %s|;) +=cut diff -urN /non-existant-dir/module/Auto/Oper.pm tiarra-20050322/module/Auto/Oper.pm --- /non-existant-dir/module/Auto/Oper.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/Oper.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,133 @@ +# ----------------------------------------------------------------------------- +# $Id: Oper.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package Auto::Oper; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::Utils); +use Auto::Utils; +use Mask; +use Multicast; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + my ($get_raw_ch_name,$reply,$reply_as_priv,$reply_anywhere,$get_full_ch_name) + = Auto::Utils::generate_reply_closures($msg,$sender,\@result); + + my $op = sub { + $sender->send_message(IRCMessage->new( + Command => 'MODE', + Params => [$get_raw_ch_name->(),'+o',$msg->nick])); + }; + + # 鯖からクライアントへのPRIVMSGで、かつrequestにマッチしているか？ + if ($sender->isa('IrcIO::Server') && + $msg->command eq 'PRIVMSG' && + Mask::match_array([$this->config->request('all')],$msg->param(1), 1)) { + # 指定されたチャンネルは既知か？言い換えれば、privではないか？ + my $ch_name = $msg->param(0); + my ($ch_name_plain) = Multicast::detatch($ch_name); + my $ch = $sender->channel($ch_name_plain); + if (defined $ch) { + # 指定されたチャンネルに、要求者は入っているか？ + if (defined $ch->names($msg->nick)) { + # なるとを渡しても良いのなら渡す。 + if (Mask::match_deep_chan([$this->config->mask('all')],$msg->prefix,$get_full_ch_name->())) { + # 自分はなるとを持ってるか？ + my $myself = $ch->names($sender->current_nick); + if ($myself->has_o) { + # 相手はなるとを持っているか？ + my $target = $ch->names($msg->nick); + if ($target->has_o) { + $reply->($this->config->oper('random')); + } else { + $reply->($this->config->message('random')); + $op->(); + } + } else { + $reply->($this->config->not_oper('random')); + } + } else { + $reply->($this->config->deny('random')); + } + } else { + $reply_as_priv->($this->config->out('random')); + } + } else { + $reply_as_priv->($this->config->private('random')); + } + } + return @result; +} + +1; + +=pod +info: 特定の文字列を発言した人を+oする。 +default: off +section: important + +# Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + +# +oを要求する文字列(マスク)を指定します。 +request: なると寄越せ + +# チャンネルオペレータ権限を要求した人と要求されたチャンネルが +# ここで指定したマスクに一致しなかった場合は +# denyで指定した文字列を発言し、+oをやめます。 +# 省略された場合は誰にも+oしません。 +# 書式は「チャンネル 発言者」です。 +# マッチングのアルゴリズムは次の通りです。 +# 1. チャンネル名にマッチするmask定義を全て集める +# 2. 集まった定義の発言者マスクを、定義された順にカンマで結合する +# 3. そのようにして生成されたマスクで発言者のマッチングを行ない、結果を+o可能性とする。 +# 例1: +# mask: *@2ch* *!*@* +# mask: #*@ircnet* *!*@*.hoge.jp +# この例ではネットワーク 2ch の全てのチャンネルで誰にでも +o し、 +# ネットワーク ircnet の # で始まる全てのチャンネルでホスト名 *.hoge.jp の人に+oします。 +# #*@ircnetだと「#hoge@ircnet:*.jp」などにマッチしなくなります。 +# 例2: +# mask: #hoge@ircnet -*!*@*,+*!*@*.hoge.jp +# mask: * +*!*@* +# 基本的に全てのチャンネルで誰にでも +o するが、例外的に#hoge@ircnetでは +# ホスト名 *.hoge.jp の人にしか +o しない。 +# この順序を上下逆にすると、全てのチャンネルで全ての人を +o する事になります。 +# 何故なら最初の* +*!*@*が全ての人にマッチするからです。 +mask: * *!*@* + +# +oを要求した人を実際に+oする時、ここで指定した発言をしてから+oします。 +# #(name|nick)のようなエイリアス置換を行います。 +# エイリアス以外でも、#(nick.now)を相手のnickに、#(channel)を +# そのチャンネル名にそれぞれ置換します。 +message: 了解 + +# +oを要求されたが+oすべき相手ではなかった場合の発言。 +# 省略されたら何も喋りません。 +deny: 断わる + +# +oを要求されたが相手は既にチャンネルオペレータ権限を持っていた場合の発言。 +# 省略されたらdenyに設定されたものを使います。 +oper: 既に@を持っている + +# +oを要求されたが自分はチャンネルオペレータ権限を持っていなかった場合の発言。 +# 省略されたらdenyに設定されたものを使います。 +not-oper: @が無い + +# チャンネルに対してでなく自分に対して+oの要求を行なった場合の発言。 +# 省略されたらdenyに設定されたものを使います。 +private: チャンネルで要求せよ + +# チャンネルの外から+oを要求された場合の発言。+nチャンネルでは起こりません。 +# 省略されたらdenyに設定されたものを使います。 +out: チャンネルに入っていない +=cut diff -urN /non-existant-dir/module/Auto/Random.pm tiarra-20050322/module/Auto/Random.pm --- /non-existant-dir/module/Auto/Random.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/Random.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,176 @@ +# ----------------------------------------------------------------------------- +# $Id: Random.pm 801 2005-02-28 20:01:19Z topia $ +# ----------------------------------------------------------------------------- +package Auto::Random; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::Utils Tools::FileCache); +use Auto::Utils; +use Tools::FileCache; +use Mask; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{config} = []; + + $this->_load(); + return $this; +} + +sub _load { + my ($this) = @_; + + my ($BLOCKS_NAME) = 'blocks'; + + foreach my $blockname ($this->config->get($BLOCKS_NAME, 'all')) { + die "$blockname block name is reserved!" if $blockname eq $BLOCKS_NAME; + my $block = $this->config->get($blockname); + die "$blockname isn't block!" unless UNIVERSAL::isa($block, 'Configuration::Block'); + push(@{$this->{config}}, + { + mask => [Mask::array_or_all_chan($block->mask('all'))], + request => [$block->request('all')], + rate => $block->rate, + format => [$block->format('all')], + count_query => [$block->count_query('all')], + count_format => [$block->count_format('all')], + add => [$block->get('add', 'all')], + added_format => [$block->added_format('all')], + remove => [$block->remove('all')], + removed_format => [$block->removed_format('all')], + modifier => [$block->modifier('all')], + database => Tools::FileCache->register($block->file, + 'std', + $block->file_encoding), + }); + } +} + +sub destruct { + my ($this) = @_; + + map { + $_->{database}->unregister(); + } @{$this->{config}}; + + return $this; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + my (undef,undef,undef,$reply_anywhere,$get_full_ch_name) + = Auto::Utils::generate_reply_closures($msg,$sender,\@result); + + if ($msg->command eq 'PRIVMSG') { + foreach my $block (@{$this->{config}}) { + if (Mask::match_deep($block->{request}, $msg->param(1))) { + if (Mask::match_deep_chan($block->{mask}, $msg->prefix, $get_full_ch_name->())) { + # ランダムな発言を行なう。 + my $rate_rand = int(rand() * hex('0xffffffff')) % 100; + if ($rate_rand < ($block->{rate} || 100)) { + my $reply_str = $block->{database}->get_value() || undef; + $reply_anywhere->($block->{format}, 'message' => $reply_str); + } + } + } elsif (Mask::match_deep($block->{count_query}, $msg->param(1))) { + if (Mask::match_deep_chan($block->{mask}, $msg->prefix, $get_full_ch_name->())) { + # 登録数を求める + my $count = $block->{database}->length(); + $reply_anywhere->($block->{count_format}, 'count' => $count); + } + } else { + my $msg_from_modifier_p = sub { + !defined $msg->prefix || + Mask::match_deep_chan($block->{modifier}, $msg->prefix, $get_full_ch_name->()); + }; + my ($keyword,$param) = $msg->param(1) =~ /^\s*(.+?)\s+(.+?)\s*$/; + if (defined $keyword && defined $param) { + if (Mask::match_deep($block->{add}, $keyword) && + $msg_from_modifier_p->()) { + # 発言の追加 + # この人は変更を許可されている。 + if ($param ne '') { + $block->{database}->add_value($param); + $reply_anywhere->($block->{added_format}, 'message' => $param); + } + } + } elsif (Mask::match_deep($block->{remove}, $keyword) && + $msg_from_modifier_p->()) { + # 発言の削除 + # この人は削除を許可されている。 + my $count = $block->{database}->del_value($param); + $reply_anywhere->($block->{removed_format}, 'message' => $param, 'count' => $count); + } + } + } + } + + return @result; +} + +1; + +=pod +info: 特定の発言に反応してランダムな発言をします。 +default: off + +# Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + +# 使用するブロックの定義。 +blocks: wimikuji + +wimikuji { + # ランダムに発言するメッセージの書かれたファイルと、その文字コードを指定します。 + # ファイルの中では一行に一つのメッセージを書いて下さい。 + file: random.txt + file-encoding: euc + + # 反応する発言を表すマスクを指定します。 + request: ゐみくじ + + # メッセージの登録数を返答するキーワードを指定します。 + count-query: ゐみくじ登録数 + + # メッセージの登録数を返答するときの反応を指定します。 + # formatで指定できるものと同じです。#(count)は登録数になります。 + count-format: ゐみくじは#(count)件登録されています。 + + # ランダムなメッセージを発言する際のフォーマットを指定します。 + # エイリアス置換が有効です。#(message)、#(nick.now)、#(channel)は + # それぞれメッセージ内容、相手のnick、チャンネル名に置換されます。 + # 何も登録されていないときのために、#(message|;無登録)のように指定すると良いでしょう。 + format: #(name|nick.now)の運命は#(message) + + # 反応する人のマスク。 + mask: * *!*@* + # plum: mask: *!*@* + + # メッセージが追加されたときの反応を指定します。 + # formatで指定できるものと同じです。#(message)は追加されたメッセージになります。 + added-format: #(name|nick.now): ゐみくじ #(message) を追加しました。 + + # メッセージが削除されたときの反応を指定します。 + # formatで指定できるものと同じです。#(message)は削除されたメッセージになります。 + removed-format: #(name|nick.now): ゐみくじ #(message) を削除しました。 + + # 発言に反応する確率を指定します。百分率です。省略された場合は100と見做されます。 + rate: 100 + + # メッセージを追加するキーワードを指定します。 + # ここで指定したキーワードを発言すると、新しいメッセージを追加します。 + # 実際の追加方法は「 <追加するメッセージ>」です。 + add: ゐみくじ追加 + + # メッセージを削除するキーワードを指定します。 + # 実際の削除方法は「 <削除するキーワード>」です。 + remove: ゐみくじ削除 + + # addとremoveを許可する人。省略された場合は誰も変更できません。 + modifier: * *!*@* + # plum: modifier: *!*@* +} +=cut diff -urN /non-existant-dir/module/Auto/Reply.pm tiarra-20050322/module/Auto/Reply.pm --- /non-existant-dir/module/Auto/Reply.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/Reply.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,236 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: Reply.pm 767 2005-02-24 02:08:34Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package Auto::Reply; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::Utils Auto::AliasDB::CallbackUtils Tools::HashDB); +use Auto::Utils; +use Auto::AliasDB::CallbackUtils; +use Tools::HashDB; +use Mask; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{config} = []; + + $this->_load; + return $this; +} + +sub _load { + my $this = shift; + + my $BLOCKS_NAME = 'blocks'; + + foreach my $blockname ($this->config->get($BLOCKS_NAME, 'all')) { + die "$blockname block name is reserved!" if $blockname eq $BLOCKS_NAME; + my $block = $this->config->get($blockname); + die "$blockname isn't block!" unless UNIVERSAL::isa($block, 'Configuration::Block'); + push(@{$this->{config}}, { + mask => [Mask::array_or_all_chan($block->mask('all'))], + request => [$block->request('all')], + reply_format => [$block->reply_format('all')], + max_reply => $block->max_reply, + rate => $block->rate, + count_query => [$block->count_query('all')], + count_format => [$block->count_format('all')], + add => [$block->get('add', 'all')], + added_format => [$block->added_format('all')], + remove => [$block->remove('all')], + removed_format => [$block->removed_format('all')], + modifier => [$block->modifier('all')], + use_re => $block->use_re, + database => Tools::HashDB->new( + $block->file, + $block->file_encoding, + $block->use_re, + ($block->ignore_comment ? undef : sub {0;})), + }); + } +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + my $return_value = sub { + return @result; + }; + + my (undef,undef,undef,$reply_anywhere,$get_full_ch_name) + = Auto::Utils::generate_reply_closures($msg,$sender,\@result); + + if ($msg->command eq 'PRIVMSG') { + foreach my $block (@{$this->{config}}) { + # count : 登録数の計算 + if (Mask::match_deep($block->{count_query}, $msg->param(1))) { + if (Mask::match_deep_chan($block->{mask}, $msg->prefix, $get_full_ch_name->())) { + # 登録数を求める + my $count = scalar $block->{database}->keys; + $reply_anywhere->($block->{count_format}, 'count' => $count); + } + return $return_value->(); + } + + my $msg_from_modifier_p = do { + !defined $msg->prefix || + Mask::match_deep_chan($block->{modifier}, $msg->prefix, $get_full_ch_name->()); + }; + + my $tail = $msg->param(1); + $tail =~ s/^\s*(.*)\s*$/$1/; + my $keyword; + ($keyword, $tail) = split(/\s+/, $tail, 2); + + if ($msg_from_modifier_p) { + # request + if (Mask::match_deep($block->{request}, $keyword)) { + # 一致する反応をリストする + foreach my $key (_search($block, $tail, $block->{max_reply})) { + foreach my $message (@{$block->{database}->get_array($key)}) { + $reply_anywhere->($block->{reply_format}, + 'key' => $key, + 'message' => $message); + } + } + return $return_value->(); + } + + # add and remove + if (defined $tail) { + my ($key, $param) = split(/\s+/, $tail, 2); + if (Mask::match_deep($block->{add}, $keyword)) { + # 発言の追加 + # この人は変更を許可されている。 + if (defined $key && defined $param) { + $block->{database}->add_value($key, $param); + $reply_anywhere->($block->{added_format}, 'key' => $key, 'message' => $param); + } + return $return_value->(); + } elsif (Mask::match_deep($block->{remove}, $keyword)) { + # 発言の削除 + # この人は削除を許可されている。 + if (defined $key) { + my $count = $block->{database}->del_value($key, $param); + $reply_anywhere->( + $block->{removed_format}, + 'key' => $key, + 'message' => $param, + 'count' => $count); + } + return $return_value->(); + } + } + } + + # match + if (Mask::match_deep_chan($block->{mask}, $msg->prefix, $get_full_ch_name->())) { + my $key = (_search($block, $msg->param(1), 1, $block->{rate}))[0]; + if (defined $key) { + $reply_anywhere->($block->{database}->get_value_random($key)); + } + } + } + } + + return @result; +} + +sub _search { + # key を検索する関数。 + + # $block : 検索対象のブロック + # $key : 検索するキー + # $count : 最大発見個数。省略すると全て。 + # $rate : 発見してもランダムに忘れる(笑)確率(パーセント)。省略すると100%。 + my ($block, $str, $count, $rate) = @_; + + my @masks; + foreach my $mask ($block->{database}->keys) { + if (Mask::match_array([$mask], $str, 1, $block->{use_re}, 0)) { + # match + if (!defined $rate || (int(rand() * hex('0xffffffff')) % 100) < $rate) { + push(@masks, $mask); + if (defined $count && $count <= scalar(@masks)) { + # $count 分発見したので終了。 + last; + } + } + } + } + + return @masks; +} + +1; + +=pod +info: 特定の発言に反応して発言をします。 +default: off + +# Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + +# 使用するブロックの定義。 +blocks: std + +std { + # データファイルと文字コードを指定します。 + # ファイルの中では一行に一つの"反応:メッセージ"を書いて下さい。 + file: reply.txt + file-encoding: euc + + # 反応チェックを行うキーワードを指定します。 + # 実際の指定方法は、「 <チェックしたい発言>」です。 + request: 反応チェック + + # request に反応するときのフォーマットを指定します。 + # #(key) がキーワード、 #(message) が発言に置換されます。 + reply-format: 「#(key)」という発言に「#(message)」と反応します。 + + # request に反応する最大個数を指定します。 + # あまり大きな値を指定すると、アタックが可能になったり、ログが流れて邪魔なので注意してください。 + max-reply: 5 + + # メッセージの登録数を返答するキーワードを指定します。 + count-query: 反応登録数 + + # メッセージの登録数を返答するときの反応を指定します。 + # formatで指定できるものと同じです。#(count)は登録数になります。 + count-format: 反応は#(count)件登録されています。 + + # 反応する人のマスク。 + mask: * *!*@* + # plum: mask: *!*@* + + # 反応が追加されたときの反応を指定します。 + # formatで指定できるものと同じです。#(message)は追加されたメッセージになります。 + added-format: #(name|nick.now): #(key) に対する反応 #(message) を追加しました。 + + # メッセージが削除されたときの反応を指定します。 + # formatで指定できるものと同じです。#(message)は削除されたメッセージになります。 + removed-format: #(name|nick.now): #(key) #(message;に対する反応 %s|;) を #(count) 件削除しました。 + + # 発言に反応する確率を指定します。百分率です。省略された場合は100と見做されます。 + rate: 100 + + # メッセージを追加するキーワードを指定します。 + # ここで指定したキーワードを発言すると、新しいメッセージを追加します。 + # 実際の追加方法は「 <追加するメッセージ>」です。 + add: 反応追加 + + # メッセージを削除するキーワードを指定します。 + # 実際の削除方法は「 <削除するキーワード>」です。 + remove: 反応削除 + + # addとremoveを許可する人。省略された場合は「* *!*@*」と見做します。 + modifier: * *!*@* + + # 正規表現拡張を許可するか。省略された場合は禁止します。 + use-re: 1 +} +=cut diff -urN /non-existant-dir/module/Auto/Response.pm tiarra-20050322/module/Auto/Response.pm --- /non-existant-dir/module/Auto/Response.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/Response.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,91 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: Response.pm 540 2004-09-10 08:29:31Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package Auto::Response; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::Utils Auto::AliasDB::CallbackUtils Tools::GroupDB); +use Auto::Utils; +use Auto::AliasDB::CallbackUtils; +use Tools::GroupDB; +use Mask; +use Multicast; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{database} = Tools::GroupDB->new($this->config->file, 'pattern', $this->config->charset, 1, 1); + + return $this; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + # サーバーからのメッセージか？ + if ($sender->isa('IrcIO::Server')) { + # PRIVMSGか？ + if ($msg->command eq 'PRIVMSG') { + my @matches = $this->{database}->find_groups_with_primary($msg->param(1)); + if (@matches) { + my ($callbacks) = []; + Auto::AliasDB::CallbackUtils::register_extcallbacks($callbacks, $msg, $sender); + my (undef,undef,undef,$reply_anywhere,$get_full_ch_name) + = Auto::Utils::generate_reply_closures($msg, $sender, \@result, undef, $callbacks); + + if (Mask::match_deep_chan([$this->config->mask('all')],$msg->prefix, $get_full_ch_name->())) { + # 一致していた。 + foreach my $match (@matches) { + # maskが一致しなければ実行しない。飛ばす。 + my $mask = Tools::GroupDB::get_array($match, 'mask'); + next if ($mask && !Mask::match_deep_chan($mask, $msg->prefix, $get_full_ch_name->())); + # rate以下ならば実行しない。飛ばす。 + my $rate = Tools::GroupDB::get_value($match, 'rate'); + next unless !defined($rate) || (int(rand(100)) < $rate); + $reply_anywhere->(Tools::GroupDB::get_value_random($match, 'response')); + } + } + } + } + } + + return @result; +} + +1; + +=pod +info: データファイルの指定にしたがって反応する。 +default: off + +# 大量の反応データを定義するのに向いています。 + +# データファイルのフォーマット +# | pattern: re:^(こん(に)?ちは) +# | rate: 90 +# | mask: * *!*@* +# | #plum: mask: *!*@* +# | response: こんにちは。 +# | response: いらっしゃいませ。 +# | +# | pattern: おやすみ +# | rate: 20 +# | response: おやすみなさい。 +# patternは一行しか書けません。(手抜き +# maskもrateも省略できます。省略した場合はmaskは全員、rateは100となります。 +# responseは複数書いておけばランダムに選択されます。 + +# データファイル +file: response.txt + +# 文字コード +charset: euc + +# 使用を許可する人&チャンネルのマスク。 +mask: * *!*@* +# plum: mask: +*!*@* +=cut diff -urN /non-existant-dir/module/Auto/Utils.pm tiarra-20050322/module/Auto/Utils.pm --- /non-existant-dir/module/Auto/Utils.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Auto/Utils.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,226 @@ +# ----------------------------------------------------------------------------- +# $Id: Utils.pm 574 2004-09-21 12:34:36Z topia $ +# ----------------------------------------------------------------------------- +package Auto::Utils; +use strict; +use warnings; +use Module::Use qw(Auto::AliasDB); +use Auto::AliasDB; +use Multicast; +use IRCMessage; +use RunLoop; + +# get_ch_name は get_raw_ch_name のエイリアス(過去互換のため) +*get_ch_name = \&get_raw_ch_name; +sub get_raw_ch_name { + # ネットワーク名抜きの送信先(チャンネル/nick)名 or undef を得る + my ($msg, $ch_place) = @_; + + if (defined($msg->param($ch_place)) && $msg->param($ch_place) ne '') { + return(scalar(Multicast::detach($msg->param($ch_place)))); + } else { + return undef; + } +} + +sub get_full_ch_name { + # ネットワーク名付きの送信先(チャンネル/nick)名 or undef を得る + my ($msg, $ch_place) = @_; + + if (defined($msg->param($ch_place)) && $msg->param($ch_place) ne '') { + return($msg->param($ch_place)); + } else { + return undef; + } +} + +sub sendto_channel_closure { + # チャンネル等に PRIVMSG / NOTICE を送るクロージャを返します。 + + # - 引数 - + # $sendto : チャンネル名 or ニック。ネットワーク名を付けて下さい。 + # $command : 'PRIVMSG' or 'NOTICE'。その他のコマンドも制限はしませんが意味が無いでしょう。 + # $msg : message_arrivedに渡ってきた$msg。エイリアス置換に使用されます。よって、 + # 後述する $use_alias が false なら指定する必要はありません。 + # その場合は undef でも渡しておきましょう。 + # $sender : message_arrivedに渡ってきた$sender。送信に使います。ない場合は + # $result とともに undef を指定してください。 + # $result : message_arrivedの返り値にする配列の参照。詳細は例を見ましょう。 + # $use_alias : エイリアス置き換えを行うかどうか。省略可で省略した場合は + # 行うが、 $msg, $sender のどちらかが undef ならエイリアス + # 置き換えを呼び出せないので行わない。 + # $extra_callbacks + # : 追加のエイリアス置換コールバック。省略可。 + # + # エイリアス置換・コールバックに関しては Auto::AliasDB を参照してください。 + # + # - 返り値 - + # $send_message + # $send_message + # : クロージャ。第一引数にメッセージ、第二引数以降に追加のエイリアス(省略可能)を指定して呼び出す。 + # メッセージとしてundefが渡された場合は、何もせずに終了する。 + # + # - 使用例 - + # sub message_arrived { + # my ($this,$msg,$sender) = @_; + # my @result = ($msg); + # my $send_message = + # sendto_channel_closure('#test@ircnet', 'NOTICE', $msg, $sender, \@result); + # $send_message->('message', 'hoge' => 'moge'); + # return @result; + # } + # + + my ($sendto, $command, $msg, $sender, $result, $use_alias, $extra_callbacks) = @_; + + $use_alias = 1 if (!defined $use_alias && defined $msg && defined $sender); + $extra_callbacks = [] unless defined $extra_callbacks; + + return sub { + my ($line,%extra_replaces) = @_; + return if !defined $line; + foreach my $str ((ref($line) eq 'ARRAY') ? @$line : $line) { + my $msg_to_send = IRCMessage->new( + Command => $command, + Params => ['', # 後で設定 + ($use_alias ? Auto::AliasDB->shared->stdreplace_add( + $msg->prefix || $sender->fullname, + $str, + $extra_callbacks, + $msg, + $sender, + %extra_replaces) + : $str)]); + my ($rawname, $network_name, $specified_network) = + Multicast::detach($sendto); + my $get_network_name = sub { + $specified_network ? $network_name : + Configuration->shared_conf->networks->default; + }; + my $sendto_client = Multicast::attach_for_client($rawname, $network_name); + if (!defined $sender) { + # 鯖にはチャンネル名にネットワーク名を付けない。 + my $for_server = $msg_to_send->clone; + $sender = RunLoop->shared_loop->network($get_network_name->()); + if (defined $sender) { + $for_server->param(0, $rawname); + $sender->send_message($for_server); + } + + # クライアントにはチャンネル名にネットワーク名を付ける。 + # また、クライアントに送られる時にはPrefixがそのユーザーに設定されるよう註釈を付ける。 + my $for_client = $msg_to_send->clone; + $for_client->param(0, $sendto_client); + $for_client->remark('fill-prefix-when-sending-to-client',1); + RunLoop->shared_loop->broadcast_to_clients($for_client); + } elsif ($sender->isa('IrcIO::Server')) { + # 鯖にはチャンネル名にネットワーク名を付けない。 + my $for_server = $msg_to_send->clone; + $for_server->param(0, $rawname); + $sender->send_message($for_server); + + # クライアントにはチャンネル名にネットワーク名を付ける。 + # また、クライアントに送られる時にはPrefixがそのユーザーに設定されるよう註釈を付ける。 + my $for_client = $msg_to_send->clone; + $for_client->param(0, $sendto_client); + $for_client->remark('fill-prefix-when-sending-to-client',1); + push @$result,$for_client; + } elsif ($sender->isa('IrcIO::Client')) { + # チャンネル名にネットワーク名を付ける。 + my $for_server = $msg_to_send->clone; + $for_server->param(0, $sendto); + push @$result,$for_server; + + my $for_client = $msg_to_send->clone; + $for_client->prefix($sender->fullname); + $for_client->param(0, $sendto_client); + $sender->send_message($for_client); + } + } + }; +} + +sub generate_reply_closures { + # 送信者に NOTICE で返答するクロージャを返します。 + + # - 引数 - + # $msg : message_arrivedに渡ってきた$msg。 + # $sender : message_arrivedに渡ってきた$sender。 + # $result : message_arrivedの返り値にする配列の参照。詳細は例を見ましょう。 + # $use_alias : エイリアス置き換えを行うかどうか。省略可、省略した場合は行う。 + # $extra_callbacks + # : 追加のエイリアス置換コールバック。省略可。 + # $ch_place : チャンネル名が存在する $msg->param 内部の位置を指定します。省略時は0(先頭)です。 + # + # エイリアス置換・コールバックに関しては Auto::AliasDB を参照してください。 + # + # - 返り値 - + # ($get_raw_ch_name, $reply, $reply_as_priv, $reply_anywhere, $get_full_ch_name) + # $get_raw_ch_name : クロージャ。ネットワーク名無しのチャンネル名 or undef を返します。 + # $reply : クロージャ。チャンネルに返答します。 + # $reply_as_priv : クロージャ。送信者に直接 priv で返答します。 + # $reply_anywhere : クロージャ。チャンネルが有効であれば $reply が、そうでなければ $reply_as_priv です。 + # $get_full_ch_name : クロージャ。ネットワーク名付きのチャンネル名 or undef を返します。 + # + # $reply* は第一引数にメッセージ、第二引数以降に追加のエイリアス(省略可能)を指定して呼び出します。 + # 第一引数にundefが渡された場合は、何もせずに終了します。 + # + # - 使用例 - + # sub message_arrived { + # my ($this,$msg,$sender) = @_; + # my @result = ($msg); + # my ($get_ch_name, $reply, $reply_as_priv, $reply_anywhere) = + # generate_reply_closures($msg, $sender, \@result); + # $reply_anywhere->('message', 'hoge' => 'moge'); + # return @result; + # } + # + # - 備考 - + # $get_raw_ch_name がクロージャなのは過去との互換性のため、 + # $get_full_ch_name がクロージャーなのは共通性のためです。 + + my ($msg, $sender, $result, $use_alias, $extra_callbacks, $ch_place) = @_; + $use_alias = 1 unless defined $use_alias; + $extra_callbacks = [] unless defined $extra_callbacks; + $ch_place = 0 unless defined $ch_place; + + my $raw_ch_name = get_raw_ch_name($msg, $ch_place); + my $get_raw_ch_name = sub () { + $raw_ch_name; + }; + my $full_ch_name = get_full_ch_name($msg, $ch_place); + my $get_full_ch_name = sub () { + $full_ch_name; + }; + my $reply = sub { + sendto_channel_closure($msg->param($ch_place), 'NOTICE', $msg, $sender, $result, + $use_alias, $extra_callbacks)->(@_, 'channel' => $raw_ch_name); + }; + my $reply_as_priv = sub { + my ($line,%extra_replaces) = @_; + return if !defined $line; + foreach my $str ((ref($line) eq 'ARRAY') ? @$line : $line) { + $sender->send_message(IRCMessage->new( + Command => 'NOTICE', + Params => [$msg->nick, + ($use_alias ? Auto::AliasDB->shared->stdreplace_add( + $msg->prefix, + $str, + $extra_callbacks, + $msg, + $sender, + %extra_replaces) + : $str)])); + } + }; + my $reply_anywhere = sub { + if (defined($raw_ch_name) && Multicast::nick_p($raw_ch_name)) { + return $reply_as_priv; + } else { + return $reply; + } + }; + return ($get_raw_ch_name,$reply,$reply_as_priv,$reply_anywhere->(),$get_full_ch_name); +} + +1; diff -urN /non-existant-dir/module/CTCP/ClientInfo.pm tiarra-20050322/module/CTCP/ClientInfo.pm --- /non-existant-dir/module/CTCP/ClientInfo.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/CTCP/ClientInfo.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,61 @@ +# ----------------------------------------------------------------------------- +# $Id: ClientInfo.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# BulletinBoardのctcp-clientinfo-で始まる値を探し、それをCLIENTINFOとして応答する。 +# ----------------------------------------------------------------------------- +package CTCP::ClientInfo; +use strict; +use warnings; +use base qw(Module); +use CTCP; +use Multicast; +use BulletinBoard; + +# CLIENTINFO設定 +BulletinBoard->shared->ctcp_clientinfo_clientinfo('CLIENTINFO'); + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->isa('IrcIO::Server') && + $msg->command eq 'PRIVMSG' && + defined $msg->nick) { + + my $ctcp = CTCP::extract($msg); + if (defined $ctcp && $ctcp eq 'CLIENTINFO') { + + my $last = $sender->remark('last-ctcp-replied'); + if (!defined $last || time - $last > ($this->config->interval || 3)) { + # 前回のCTCP反応から一定時間以上経過している。 + + my $clientinfo = join( + ' ', + map { + BulletinBoard->shared->get($_); + } grep { + m/^ctcp-clientinfo-/; + } BulletinBoard->shared->keys); + + my $reply = CTCP::make( + "CLIENTINFO $clientinfo", + scalar Multicast::detach($msg->nick) + ); + $sender->send_message($reply); + $sender->remark('last-ctcp-replied',time); + } + } + } + + $msg; +} + +1; + +=pod +info: CTCP CLIENTINFOに応答する。 +default: off +section: important + +# CTCP::Versionのintervalと同じ。 +interval: 3 +=cut diff -urN /non-existant-dir/module/CTCP/Ping.pm tiarra-20050322/module/CTCP/Ping.pm --- /non-existant-dir/module/CTCP/Ping.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/CTCP/Ping.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,51 @@ +# ----------------------------------------------------------------------------- +# $Id: Ping.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package CTCP::Ping; +use strict; +use warnings; +use base qw(Module); +use CTCP; +use Multicast; +use Config; +use BulletinBoard; + +# ctcp-clientinfo-pingを設定 +BulletinBoard->shared->ctcp_clientinfo_ping('PING'); + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->isa('IrcIO::Server') && + $msg->command eq 'PRIVMSG' && + defined $msg->nick) { + + my $ctcp = CTCP::extract($msg); + if (defined $ctcp && $ctcp =~ m/^PING/) { + + my $last = $sender->remark('last-ctcp-replied'); + if (!defined $last || time - $last > ($this->config->interval || 3)) { + # 前回のCTCP反応から一定時間以上経過している。 + my $reply = CTCP::make( + $ctcp, + scalar Multicast::detach($msg->nick) + ); + $sender->send_message($reply); + $sender->remark('last-ctcp-replied',time); + } + } + } + + $msg; +} + +1; + +=pod +info: CTCP PINGに応答する。 +default: off +section: important + +# CTCP::Versionのintervalと同じ。 +interval: 3 +=cut diff -urN /non-existant-dir/module/CTCP/Time.pm tiarra-20050322/module/CTCP/Time.pm --- /non-existant-dir/module/CTCP/Time.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/CTCP/Time.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,53 @@ +# ----------------------------------------------------------------------------- +# $Id: Time.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package CTCP::Time; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Tools::DateConvert); +use Tools::DateConvert; +use CTCP; +use Multicast; +use Config; +use BulletinBoard; + +# ctcp-clientinfo-timeを設定 +BulletinBoard->shared->ctcp_clientinfo_time('TIME'); + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->isa('IrcIO::Server') && + $msg->command eq 'PRIVMSG' && + defined $msg->nick) { + + my $ctcp = CTCP::extract($msg); + if (defined $ctcp && $ctcp eq 'TIME') { + + my $last = $sender->remark('last-ctcp-replied'); + if (!defined $last || time - $last > ($this->config->interval || 3)) { + # 前回のCTCP反応から一定時間以上経過している。 + my $reply = CTCP::make( + 'TIME :'.Tools::DateConvert::replace('%a, %Y/%m/%d %H:%M:%S %z'), + scalar Multicast::detach($msg->nick) + ); + $sender->send_message($reply); + $sender->remark('last-ctcp-replied',time); + } + } + } + + $msg; +} + +1; + +=pod +info: CTCP TIMEに応答する。 +default: off +section: important + +# CTCP::Versionのintervalと同じ。 +interval: 3 +=cut diff -urN /non-existant-dir/module/CTCP/UserInfo.pm tiarra-20050322/module/CTCP/UserInfo.pm --- /non-existant-dir/module/CTCP/UserInfo.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/CTCP/UserInfo.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,54 @@ +# ----------------------------------------------------------------------------- +# $Id: UserInfo.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package CTCP::UserInfo; +use strict; +use warnings; +use base qw(Module); +use CTCP; +use Multicast; +use Config; +use BulletinBoard; + +# ctcp-clientinfo-userinfoを設定 +BulletinBoard->shared->ctcp_clientinfo_version('USERINFO'); + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->isa('IrcIO::Server') && + $msg->command eq 'PRIVMSG' && + defined $msg->nick) { + + my $ctcp = CTCP::extract($msg); + if (defined $ctcp && $ctcp eq 'USERINFO') { + + my $last = $sender->remark('last-ctcp-replied'); + if (!defined $last || time - $last > ($this->config->interval || 3)) { + # 前回のCTCP反応から一定時間以上経過している。 + my $reply = CTCP::make( + 'USERINFO :'.($this->config->message || ''), + scalar Multicast::detach($msg->nick) + ); + $sender->send_message($reply); + $sender->remark('last-ctcp-replied',time); + } + } + } + + $msg; +} + +1; + +=pod +info: CTCP USERINFOに応答する。 +default: off +section: important + +# CTCP::Versionのintervalと同じ。 +interval: 3 + +# USERINFOとして返すメッセージ。 +message: テスト +=cut diff -urN /non-existant-dir/module/CTCP/Version.pm tiarra-20050322/module/CTCP/Version.pm --- /non-existant-dir/module/CTCP/Version.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/CTCP/Version.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,62 @@ +# ----------------------------------------------------------------------------- +# $Id: Version.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# CTCP flood対策のため、VERSION、USERINFO等は一度反応する度に +# IrcIO::Serverに「last-ctcp-replied => 反応時刻」というremarkを付ける。 +# 前回の反応時から一定時間が経過していなければ、CTCPに応答しない。 +# ----------------------------------------------------------------------------- +package CTCP::Version; +use strict; +use warnings; +use base qw(Module); +use CTCP; +use Multicast; +use Config; +use BulletinBoard; + +# ctcp-clientinfo-versionを設定 +BulletinBoard->shared->ctcp_clientinfo_version('VERSION'); + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->isa('IrcIO::Server') && + $msg->command eq 'PRIVMSG' && + defined $msg->nick) { + + my $ctcp = CTCP::extract($msg); + if (defined $ctcp && $ctcp eq 'VERSION') { + + my $last = $sender->remark('last-ctcp-replied'); + if (!defined $last || time - $last > ($this->config->interval || 3)) { + # 前回のCTCP反応から一定時間以上経過している。 + my $reply = CTCP::make( + 'VERSION Tiarra:'.::version.':perl '.$Config{version}.' on '.$Config{archname}, + scalar Multicast::detach($msg->nick) + ); + $sender->send_message($reply); + $sender->remark('last-ctcp-replied',time); + } + } + } + + $msg; +} + +1; + +=pod +info: CTCP VERSIONに応答する。 +default: on +section: important + +# 連続したCTCPリクエストに対する応答の間隔。単位は秒。 +# 例えば3秒に設定した場合、一度応答してから3秒間は +# CTCPに一切応答しなくなる。デフォルトは3。 +# +# なお、CTCP受信時刻の記録は、全てのCTCPモジュールで共有される。 +# 例えばCTCP VERSIONを送った直後にCTCP CLIENTINFOを送ったとしても、 +# CTCP::ClientInfoのintervalで設定された時間を過ぎていなければ +# 後者は応答しない。 +interval: 3 +=cut diff -urN /non-existant-dir/module/Channel/Freeze.pm tiarra-20050322/module/Channel/Freeze.pm --- /non-existant-dir/module/Channel/Freeze.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Channel/Freeze.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,256 @@ +# ----------------------------------------------------------------------------- +# $Id: Freeze.pm 540 2004-09-10 08:29:31Z topia $ +# ----------------------------------------------------------------------------- +# このモジュールは再起動しても凍結設定を失なわないようにする為、 +# 設定をBulletinBoardのfrost-channelsに保存します。 +# ----------------------------------------------------------------------------- +package Channel::Freeze; +use strict; +use warnings; +use base qw/Module/; +use Multicast; +use Timer; +use BulletinBoard; +use Mask; + +sub new { + my $class = shift; + + my $this = $class->SUPER::new(@_); + $this->{reminder_timer} = undef; # Timer + $this->set_timer_if_required; + + $this; +} + +sub destruct { + my $this = shift; + if (defined $this->{reminder_timer}) { + $this->{reminder_timer}->uninstall; + $this->{reminder_timer} = undef; + } +} + +sub set_timer_if_required { + my $this = shift; + if (defined $this->{reminder_timer}) { + # 既にタイマーが入っている。 + return; + } + + if (!$this->config->reminder_interval) { + # 報告しないやうに設定されている。 + return; + } + + my $channels = BulletinBoard->shared->frost_channels; + if (defined $channels && keys(%$channels) > 0) { + # 掲示板に情報が有る。 + $this->{reminder_timer} = Timer->new( + Interval => 60 * $this->config->reminder_interval, + Repeat => 1, + Code => sub { + $this->notify_list_of_frost_channels; + })->install; + #::printmsg("Channel::Freeze - timer installed"); + } +} + +sub notify_list_of_frost_channels { + my ($this) = @_; + my $channels = BulletinBoard->shared->frost_channels; + if (defined $channels && keys(%$channels) > 0) { + # 報告内容を作る + my $msg = "These channels are frost: ".join(', ',keys %$channels); + if (length($msg) > 400) { + # 400バイトを越えたら切り詰める。 + $msg = substr($msg, 0, 400)."..."; + } + + # 報告 + RunLoop->shared->broadcast_to_clients( + IRCMessage->new( + Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv system)), + Command => 'NOTICE', + Params => [ + RunLoop->shared->current_nick, + $msg] + ) + ); + } +} + +sub message_arrived { + my ($this, $msg, $sender) = @_; + + if ($sender->client_p) { + # コマンドの入力か？ + my $notify = sub { + my $notice = shift; + RunLoop->shared->broadcast_to_clients( + IRCMessage->new( + Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv system)), + Command => 'NOTICE', + Params => [ + RunLoop->shared->current_nick, + $notice] + ) + ); + }; + + if ($msg->command eq uc($this->config->freeze_command || 'freeze')) { + # 凍結 + if (my @frost = $this->freeze($msg->param(0))) { + $notify->("Channel ".join(', ', @frost)." frost."); + } + $msg = undef; # 捨て + } + elsif ($msg->command eq uc($this->config->defrost_command || 'defrost')) { + # 解凍 + if (my @defrost = $this->defrost($msg->param(0))) { + $notify->("Channel ".join(', ', @defrost)." defrost."); + } + $msg = undef; # 捨て + } + } + else { + # PRIVMSGやNOTICEか？ + if ($msg->command eq 'PRIVMSG' || $msg->command eq 'NOTICE') { + # 凍結されてゐるチャンネルが存在するか？ + my $board = BulletinBoard->shared; + my $channels = $board->frost_channels; + if (defined $channels) { + # 凍結されてゐるチャンネルか？ + if ($channels->{$msg->param(0)}) { + # do-not-send-to-clientsを付ける。 + $msg->remark('do-not-send-to-clients', 1); + } + } + } + } + + $msg; +} + +sub normalize { + my ($ch_full) = @_; + my ($ch_short, $network_name) = Multicast::detach($ch_full); + if (Multicast::channel_p($ch_short)) { + # チャンネル名として許される。 + Multicast::attach($ch_short, $network_name); + } + else { + # 許されない。 + undef; + } +} + +sub freeze { + # 今囘のfreezeの呼出しでフリーズされたチャンネル名の配列を返す。 + my ($this, $ch_mask) = @_; + + if (!defined $ch_mask) { + # リスト表示 + $this->notify_list_of_frost_channels; + return (); + } + + if (defined $ch_mask) { + my $board = BulletinBoard->shared; + my $channels = $board->frost_channels; + + if (!defined $channels) { + # まだ掲示板に入つてゐない。 + $channels = {}; # {フルチャンネル名 => 1} + $board->frost_channels($channels); + } + + # 全てのサーバーの、全てのjoinしているチャンネルの中から、 + # このマスクに該当するチャンネル名を探し、全てfreezeする。 + my @ch_to_freeze; + foreach my $network (RunLoop->shared->networks_list) { + foreach my $ch ($network->channels_list) { + my $longname = Multicast::attach($ch, $network); + if (Mask::match($ch_mask, $longname)) { + if (!$channels->{$longname}) { + $channels->{$longname} = 1; + push @ch_to_freeze, $longname; + } + } + } + } + + # 必要ならタイマー起動。 + $this->set_timer_if_required; + + return @ch_to_freeze; + } + else { + return (); + } +} + +sub defrost { + my ($this, $ch_mask) = @_; + if (!defined $ch_mask) { + return (); + } + + my @result; + + if (defined $ch_mask) { + my $board = BulletinBoard->shared; + my $channels = $board->frost_channels; + + if (!defined $channels) { + return; # 何も凍結されていない。 + } + + %$channels = map { + $_ => 1; + } grep { + my $ch_full = $_; + if (Mask::match($ch_mask, $ch_full)) { + push @result, $ch_full; + 0; + } + else { + 1; + } + } keys %$channels; + + if (keys(%$channels) == 0) { + # 凍結されたチャンネルはもう無い。 + if (defined $this->{reminder_timer}) { + $this->{reminder_timer}->uninstall; + $this->{reminder_timer} = undef; + } + #::printmsg("Channel::Freeze - timer DELETED"); + } + } + + @result; +} + +1; + +=pod +info: 特定のチャンネルの発言を、一時的に受信するのをやめる。 +default: off + +# ログを取っているなら、ログには記録される。 + +# チャンネルの凍結に用いるコマンド名。 +# 省略時は freeze であり、/freeze #channel@network のように使う。 +# チャンネル名を省略すると、現在フリーズされているチャンネルのリストを表示する。 +freeze-command: freeze + +# 凍結解除に用いるコマンド名。 +# 省略時は defrost であり、/defrost #channel@network のように使う。 +defrost-command: defrost + +# 凍結しているチャンネルが存在する時、一定時間毎にその旨を報告する事も可能。 +# この機能は凍結した事を忘れないようにする為にある。 +# 単位は分、デフォルトはゼロ(報告しない)。 +reminder-interval: 30 +=cut diff -urN /non-existant-dir/module/Channel/Join/Connect.pm tiarra-20050322/module/Channel/Join/Connect.pm --- /non-existant-dir/module/Channel/Join/Connect.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Channel/Join/Connect.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,101 @@ +# ----------------------------------------------------------------------------- +# $Id: Connect.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2002 Topia . all rights reserved. +package Channel::Join::Connect; +use strict; +use warnings; +use base qw(Module); +use Multicast; +use RunLoop; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{servers} = {}; # servername => channellist + # channellist : HASH + # shortname => チャンネルショートネーム + # key => channel key + $this->_init; +} + +sub _init { + my $this = shift; + foreach ($this->config->channel('all')) { + s/(,)\s+/$1/g; # コンマの直後にスペースがあった場合、削除する + my ($fullname, $key) = split(/\s+/, $_, 2); + my @fullnames = split(/\,/, $fullname); + my @keys = split(/,/, $key || ''); + for (my $i = 0; $i < @fullnames; $i++) { + my $ch_fullname = $fullnames[$i]; + my $ch_key = $keys[$i]; + $ch_key = '' unless defined($ch_key); + if (!defined($ch_fullname) || $ch_fullname eq '') { + die "Illegal definition in Channel::Join::Connect/channel : $_\n"; + } + my ($ch_shortname, $server_name) = Multicast::detach($ch_fullname); + push @{$this->{servers}->{$server_name}},{ + shortname => $ch_shortname, + key => $ch_key + }; + } + } + + $this; +} + +sub connected_to_server { + my ($this,$server,$new_connection) = @_; + my ($session) = $this->{servers}->{$server->network_name}; + return if !$new_connection; + + if (defined($session)) { + Timer->new( + Interval => 1, + Repeat => 1, + Code => sub { + my $timer = shift; + if (@$session > 0) { + # 一度に五つずつ送り出す。 + my $msg_per_trigger = 5; + my (@param_chan, @param_key); + for (my $i = 0; $i < @$session && $i < $msg_per_trigger; $i++) { + if (!defined($session->[$i]->{key}) || $session->[$i]->{key} eq '') { + push (@param_chan, $session->[$i]->{shortname}); + push (@param_key, ''); + } else { + unshift (@param_chan, $session->[$i]->{shortname}); + unshift (@param_key, $session->[$i]->{key}); + } + } + splice @$session,0,$msg_per_trigger; + $server->send_message( + IRCMessage->new( + Command => 'JOIN', + Params => [join(',', @param_chan), join(',', @param_key)])); + } + if (@$session == 0) { + delete $this->{sessions}->{$server->network_name}; + $timer->uninstall; + } + })->install; + } +} + +1; +=pod +info: サーバーに初めて接続した時、指定したチャンネルに入るモジュール。 +default: off +section: important + +# 書式: <チャンネル1>[,<チャンネル2>,...] [<チャンネル1のキー>,...] +# コンマの直後のスペースは無視されます。 +# +# 例: +# 「#aaaaa@ircnet」に「aaaaa」というキーで入る。 +-channel: #aaaaa@ircnet aaaaa +# +# 「#aaaaa@ircnet」、「#bbbbb@ircnet:*.jp」、「#ccccc@ircnet」、「#ddddd@ircnet」の4つのチャンネルに入る。 +-channel: #aaaaa@ircnet,#bbbbb@ircnet:*.jp, #ccccc@ircnet +-channel: #ddddd@ircnet +=cut diff -urN /non-existant-dir/module/Channel/Join/Invite.pm tiarra-20050322/module/Channel/Join/Invite.pm --- /non-existant-dir/module/Channel/Join/Invite.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Channel/Join/Invite.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,58 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: Invite.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package Channel::Join::Invite; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::Utils); +use Auto::Utils; +use Multicast; +use Mask; + +sub message_arrived { + my ($this, $msg, $sender) = @_; + my @result = ($msg); + + if ($sender->isa('IrcIO::Server')) { + if ($msg->command eq 'INVITE') { + my ($callbacks) = []; + Auto::AliasDB::CallbackUtils::register_extcallbacks($callbacks, $msg, $sender); + my ($get_ch_name,undef,undef,$reply_anywhere) + = Auto::Utils::generate_reply_closures($msg, $sender, \@result, undef, $callbacks, 1); + if (Multicast::channel_p($get_ch_name->())) { + if (Mask::match_deep_chan([$this->config->mask('all')], $msg->prefix, $get_ch_name->())) { + # match. + $sender-> + send_message(IRCMessage->new( + Command => 'JOIN', + Params => [$get_ch_name->()] + )); + foreach my $reply ($this->config->message('all')) { + $reply_anywhere->($reply); + } + } + } + } + } + + return @result; +}; + + +1; + +=pod +info: 招待されたらそのチャンネルに入る。 +default: off +section: important + +# 許可するユーザ/チャンネルのマスク。 +mask: * *!*@* +# plum: *!*@* + +# 招待されたチャンネルに流すメッセージのフォーマット。 +-message: こんばんわ〜。 +=cut diff -urN /non-existant-dir/module/Channel/Join/Kicked.pm tiarra-20050322/module/Channel/Join/Kicked.pm --- /non-existant-dir/module/Channel/Join/Kicked.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Channel/Join/Kicked.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,44 @@ +# ----------------------------------------------------------------------------- +# $Id: Kicked.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package Channel::Join::Kicked; +use strict; +use warnings; +use base qw(Module); +use Mask; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->server_p && $msg->command eq 'KICK' && + $msg->param(1) eq $sender->current_nick && + Mask::match_deep([$this->config->channel('all')],$msg->param(0))) { + # 自分が蹴られた。 + # +kされているチャンネルならキーワードを付ける。 + my $ch = RunLoop->shared->channel($msg->param(0)); + if (defined $ch) { + my @params = ($ch->name); + if ($ch->parameters('k')) { + push @params,$ch->parameters('k'); + } + + $sender->send_message( + IRCMessage->new( + Command => 'JOIN', + Params => \@params)); + } + } + + $msg; +} + +1; + +=pod +info: 特定のチャンネルからkickされた時に、自動で入りなおす。 +default: off +section: important + +# 対象となるチャンネル名のマスク +channel: * +=cut diff -urN /non-existant-dir/module/Channel/Mode/Get.pm tiarra-20050322/module/Channel/Mode/Get.pm --- /non-existant-dir/module/Channel/Mode/Get.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Channel/Mode/Get.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,88 @@ +# ----------------------------------------------------------------------------- +# $Id: Get.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package Channel::Mode::Get; +use strict; +use warnings; +use base qw(Module); +use Multicast; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{buffer} = []; # [IrcIO::Server,IRCMessage] + $this->{timer} = undef; # Timer：必要な時だけ使われる。 + $this; +} + +sub destruct { + my $this = shift; + if (defined $this->{timer}) { + $this->{timer}->uninstall; + } +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->isa('IrcIO::Server') && + $msg->command eq 'JOIN' && + defined $msg->nick && + $msg->nick eq RunLoop->shared->current_nick) { + # 自分のJOINなので、MODE #channelを発行 + foreach (split /,/,$msg->param(0)) { + my $ch_shortname = Multicast::detatch($_); + my $entry = [$sender, + IRCMessage->new( + Command => 'MODE', + Param => $ch_shortname)]; + push @{$this->{buffer}},$entry; + $this->setup_timer; + } + } + + $msg; +} + +sub setup_timer { + my ($this) = @_; + # 既にタイマーが作られていたら何もせずに戻る。 + if (!defined $this->{timer}) { + $this->{timer} = Timer->new( + Interval => 1, + Repeat => 1, + Code => sub { + my $timer = shift; + # 一度に二つずつ送り出す。 + my $msg_per_once = 2; + my $buffer = $this->{buffer}; + for (my $i = 0; + $i < @$buffer && $i < $msg_per_once; + $i++) { + my $entry = $buffer->[$i]; + $entry->[0]->send_message($entry->[1]); + } + splice @$buffer,0,2; + # バッファが空になったら終了。 + if (@$buffer == 0) { + $timer->uninstall; + $this->{timer} = undef; + } + })->install; + } +} + +1; + +=pod +info: チャンネルにJOINした時、そのチャンネルのモードを取得します。 +default: off +section: important + +# Channel::Mode::Set等が正しく動くためには +# チャンネルのモードをTiarraが把握しておく必要があります。 +# 自動的にモードを取得するクライアントであれば必要ありませんが、 +# そうでなければこのモジュールを使うべきです。 + +# 設定項目は無し。 +=cut diff -urN /non-existant-dir/module/Channel/Mode/Oper/Grant.pm tiarra-20050322/module/Channel/Mode/Oper/Grant.pm --- /non-existant-dir/module/Channel/Mode/Oper/Grant.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Channel/Mode/Oper/Grant.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,146 @@ +# ----------------------------------------------------------------------------- +# $Id: Grant.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package Channel::Mode::Oper::Grant; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Multicast; +use IRCMessage; +use Timer; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{queue} = {}; # network name => [[channel(short),nick], ...] + $this->{timer} = undef; # queueが空でない時だけ必要になるTimer + $this; +} + +sub destruct { + my ($this) = @_; + if (defined $this->{timer}) { + $this->{timer}->uninstall; + } +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + # 先に進むための条件: + # 1. サーバーからのメッセージである + # 2. コマンドはJOINである + # 3. 自分のJOINではない + # 4. @付きのJOINではない + # 5. そのチャンネルで自分は@を持っている + # 6. 相手はmaskに一致する + if ($sender->isa('IrcIO::Server') && + $msg->command eq 'JOIN' && + defined $msg->nick && + $msg->nick ne RunLoop->shared->current_nick) { + foreach (split /,/,$msg->param(0)) { + my ($ch_full,$mode) = (m/^(.+?)(?:\x07(.*))?$/); + my $ch_short = Multicast::detatch($ch_full); + my $ch = $sender->channel($ch_short); + my $myself = $ch->names($sender->current_nick); + if (defined $myself && $myself->has_o && (!defined $mode || $mode !~ /o/)) { + if (Mask::match_deep_chan([$this->config->mask('all')],$msg->prefix,$ch_full)) { + # waitで指定された秒数の経過後に、キューに入れる。 + # 同時にキュー消化タイマーを準備する。 + $this->push_to_queue($sender,$ch_short,$msg->nick); + } + } + } + } + $msg; +} + +sub push_to_queue { + my ($this,$server,$ch_short,$nick) = @_; + my $wait = $this->config->wait || 0; + if ($wait =~ /^\s*(\d+)\s*-\s*(\d+)\s*$/) { + $wait = int(rand($2 - $1 + 1)) + $1; + } + Timer->new( + After => $wait, + Code => sub { + # 対象の人が既に+oされていたら中止。 + my $ch = $server->channel($ch_short); + return if !defined $ch; + my $target = $ch->names($nick); + return if !defined $target; + return if $target->has_o; + + my $queue = $this->{queue}->{$server->network_name}; + if (!defined $queue) { + $queue = $this->{queue}->{$server->network_name} = []; + } + push @$queue,[$ch_short,$nick]; + $this->prepare_timer; + })->install; +} + +sub prepare_timer { + my ($this) = @_; + # キュー消化タイマーが存在しなければ作る + if (!defined $this->{timer}) { + $this->{timer} = Timer->new( + Interval => 0, # 勿論、最初のtriggerで変更する。 + Repeat => 1, + Code => sub { + my ($timer) = @_; + $timer->interval(1); + + # 鯖毎に3つずつ消化する。 + # チャンネル毎に最大３つずつ纏める。 + foreach my $network_name (keys %{$this->{queue}}) { + my $queue = $this->{queue}->{$network_name}; + my $server = $this->_runloop->network($network_name); + my $channels = {}; # ch_shortname => [nick,nick,...] + for (my $i = 0; @$queue && $i < 3; $i++) { + my $elem = shift(@$queue); + my $nicks = $channels->{$elem->[0]}; + if (!defined $nicks) { + $nicks = $channels->{$elem->[0]} = []; + } + push @$nicks,$elem->[1]; + } + while (my ($ch_short,$nicks) = each %$channels) { + $server->send_message( + IRCMessage->new( + Command => 'MODE', + Params => [$ch_short, + '+'.('o' x @$nicks), + @$nicks])); + } + # キューが空になったらキーごと消す。 + delete $this->{queue}->{$network_name} unless @$queue; + } + + # 全てのキューが空になったら終了。 + if (!%{$this->{queue}}) { + $timer->uninstall; + $this->{timer} = undef; + } + })->install; + } +} + +1; + +=pod +info: 特定のチャンネルに特定の人間がjoinした時に、自分がチャンネルオペレータ権限を持っていれば+oする。 +default: off +section: important + +# splitからの復帰などで+o対象の人が一度に大量に入って来ても+oは少しずつ実行します。 +# Excess Floodにはならない筈ですが、本格的な防衛BOTに使える程の物ではありません。 + +# 対象の人間がjoinしてから実際に+oするまで何秒待つか。 +# 省略されたら待ちません。 +# 5-10 のように指定されると、その値の中でランダムに待ちます。 +wait: 2-5 + +# チャンネルと人間のマスクを定義。Auto::Operと同様。 +-mask: * example!~example@*.example.ne.jp +=cut diff -urN /non-existant-dir/module/Channel/Mode/Set.pm tiarra-20050322/module/Channel/Mode/Set.pm --- /non-existant-dir/module/Channel/Mode/Set.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Channel/Mode/Set.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,83 @@ +# ----------------------------------------------------------------------------- +# $Id: Set.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# 掲示板のdo-not-touch-mode-of-channels (HASH*)に記述されているチャンネルのモードは弄らない。 +# ----------------------------------------------------------------------------- +package Channel::Mode::Set; +use strict; +use warnings; +use base qw(Module); +use BulletinBoard; +use Mask; +use Multicast; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->isa('IrcIO::Server') && + $msg->command eq '366') { + my $ch_fullname = $msg->param(1); + my $ch_plainname = Multicast::detatch($ch_fullname); + my $ch = $sender->channel($ch_plainname); + if (defined $ch) { + my $myself = $ch->names($sender->current_nick); + # 自分は入っているか？(バグでもない限り常にdefined。) + if (defined $myself) { + # 自分は@を持っているか？ + my $i_have_o = $myself->has_o; + # チャンネル内に自分一人だけか？ + my $only_me = ($ch->names(undef,undef,'size') == 1); + # MODEの変更が許されているか？ + my $allowed_mode = + $this->is_allowed_changing_mode($ch_fullname); + if ($i_have_o && $only_me && $allowed_mode) { + $this->set_modes($ch_fullname,$ch_plainname,$sender); + } + } + } + } + $msg; +} + +sub is_allowed_changing_mode { + my ($this,$ch_name) = @_; + my $untouchables = BulletinBoard->shared + ->do_not_touch_mode_of_channels; + if (defined $untouchables) { + if ($untouchables->{$ch_name}) { + return undef; + } + } + 1; +} + +sub set_modes { + my ($this,$ch_fullname,$ch_plainname,$sender) = @_; + foreach ($this->config->channel('all')) { + my ($ch_mask,$modes) = (m/^(.+?)\s+(.+)$/); + # このチャンネルのマスクに$ch_nameはマッチするか？ + if (Mask::match($ch_mask,$ch_fullname)) { + foreach my $mode (split /,/,$modes) { + $sender->send_message( + IRCMessage->new( + Command => 'MODE', + Params => [$ch_plainname,$mode])); + } + } + } +} + +1; + +=pod +info: チャンネルを作成した時に自動的にモードを設定するモジュール。 +default: off +section: important + +# 書式は<チャンネル名にマッチするマスク> <設定するモード>[,<設定するモード>,...]です。 +# #IRC談話室@ircnetなら+t+nを、それ以外なら+nを設定する例。 +-channel: #IRC談話室@ircnet +t +-channel: * +n +# LimeChat 標準設定を模倣する設定例。 +-channel: * +sn +=cut diff -urN /non-existant-dir/module/Channel/Rejoin.pm tiarra-20050322/module/Channel/Rejoin.pm --- /non-existant-dir/module/Channel/Rejoin.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Channel/Rejoin.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,326 @@ +# ----------------------------------------------------------------------------- +# $Id: Rejoin.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# このモジュールは動作時に掲示板のdo-not-touch-mode-of-channelsを使います。 +# ----------------------------------------------------------------------------- +package Channel::Rejoin; +use strict; +use warnings; +use base qw(Module); +use BulletinBoard; +use Multicast; +use RunLoop; +use NumericReply; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{sessions} = {}; # チャンネルフルネーム => セッション情報 + # セッション情報 : HASH + # ch_fullname => チャンネルフルネーム + # ch_shortname => チャンネルショートネーム + # ch => ChannelInfo + # server => IrcIO::Server + # got_mode => 既にMODEを取得しているかどうか。 + # got_blist => 既に+bリストを(略 + # got_elist => +e(略 + # got_Ilist => +I(略 + # got_oper => 既にPART->JOINしているかどうか。 + # cmd_buf => ARRAY + $this; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + if ($sender->isa('IrcIO::Server')) { + # PART,KICK,QUIT,KILLが、それぞれ一人になる要因。 + my $cmd = $msg->command; + if ($cmd eq 'PART') { + foreach my $ch_fullname (split /,/,$msg->param(0)) { + $this->check_channel( + scalar Multicast::detatch($ch_fullname), + $sender); + } + } + elsif ($cmd eq 'KICK') { + # RFC2812によると、複数のチャンネルを持つKICKメッセージが + # クライアントに届く事は無い。 + $this->check_channel( + scalar Multicast::detatch($msg->param(0)), + $sender); + } + elsif ($cmd eq 'QUIT' || $cmd eq 'KILL') { + # 註釈affected-channelsに影響のあったチャンネルのリストが入っているはず。 + foreach (@{$msg->remark('affected-channels')}) { + $this->check_channel($_,$sender); + } + } + + $this->session_work($msg,$sender); + } + $msg; +} + +sub check_channel { + my ($this,$ch_name,$server) = @_; + if ($ch_name =~ m/^\+/) { + # +チャンネルに@は付かない。 + return; + } + my $ch = $server->channel($ch_name); + if (!defined $ch) { + # 自分が入っていない + return; + } + if ($ch->switches('a')) { + # +aチャンネルでは一人になったかどうかの判定が面倒である上に、 + # @を復活させる意味も無ければ復活させない方が望ましい。 + return; + } + if ($ch->names(undef,undef,'size') > 1) { + # 二人以上いる。 + return; + } + my $myself = $ch->names($server->current_nick); + if (defined $myself && $myself->has_o) { + # 自分が@を持っている。 + return; + } + $this->rejoin($ch_name,$server); +} + +sub rejoin { + my ($this,$ch_name,$server) = @_; + my $ch_fullname = Multicast::attach($ch_name,$server->network_name); + RunLoop->shared->notify_msg( + "Channel::Rejoin is going to rejoin to ${ch_fullname}."); + + ############### + # 処理の流れ + ### phase 1 ### + # セッション作成。 + # 掲示板に「このチャンネルのモードを変更するな」と書き込む。 + # TOPICを覚える。 + # 備考switches-are-knownが偽ならMODE #channel実行。 + # 必要ならMODE #channel +b,MODE #channel +e,MODE #channel +Iを実行。 + ### phase 2 ### + # 324(modeリプライ),368(+bリスト終わり), + # 349(+eリスト終わり),347(+Iリスト終わり)をそれぞれ必要なら待つ。 + ### phase 3 ### + # PART #channel実行。 + # JOIN #channel実行。 + # 自分のJOINを待つ。 + # 少しずつ命令バッファに溜まったコマンドを実行していく。Timer使用。 + # 命令バッファにはMODEやTOPICが入っている。 + # 掲示板から消す。 + # セッションを破棄。 + ############### + + # チャンネル取得 + my $ch = $server->channel($ch_name); + + # セッション登録 + my $session = $this->{sessions}->{$ch_fullname} = { + ch_fullname => $ch_fullname, + ch_shortname => $ch_name, + ch => $ch, + server => $server, + cmd_buf => [], + }; + + # do-not-touch-mode-of-channelsを取得 + my $untouchables = BulletinBoard->shared->do_not_touch_mode_of_channels; + if (!defined $untouchables) { + $untouchables = {}; + BulletinBoard->shared->set('do-not-touch-mode-of-channels',$untouchables); + } + # このチャンネルをフルネームで登録 + $untouchables->{$ch_fullname} = 1; + + # TOPICを覚える。 + if ($ch->topic ne '') { + push @{$session->{cmd_buf}},IRCMessage->new( + Command => 'TOPIC', + Params => [$ch_name,$ch->topic]); + } + + # 必要ならMODE #channel実行。 + #if ($ch->remarks('switches-are-known')) { + # $session->{got_mode} = 1; + # push @{$session->{cmd_buf}},IRCMessage->new( + # Command => 'MODE', + #} + # やっぱりやめ。面倒。防衛BOTとして使いたかったらこんなモジュール使わないこと。 + #else { + $server->send_message( + IRCMessage->new( + Command => 'MODE', + Param => $ch_name)); + #} + + # 必要なら+e,+b,+I実行。 + if ($this->config->save_lists) { + foreach (qw/+e +b +I/) { + $server->send_message( + IRCMessage->new( + Command => 'MODE', + Params => [$ch_name,$_])); + } + } + else { + $session->{got_elist} = + $session->{got_blist} = + $session->{got_Ilist} = 1; + } + + # 待たなければならないものはあるか？ + if ($this->{got_mode} && $this->{got_elist} && + $this->{got_blist} && $this->{got_Ilist}) { + # もう何も無い。 + $this->part_and_join($session); + } +} + +sub part_and_join { + my ($this,$session) = @_; + $session->{got_oper} = 1; + foreach (qw/PART JOIN/) { + $session->{server}->send_message( + IRCMessage->new( + Command => $_, + Param => $session->{ch_shortname})); + } +} + +sub session_work { + my ($this,$msg,$server) = @_; + my $session; + # ウォッチの対象になるのはJOIN,324,368,349,347。 + + my $got_reply = sub { + my $type = shift; + my ($flagname,$listname) = do { + if ($type eq 'b') { + ('got_blist','banlist'); + } + elsif ($type eq 'e') { + ('got_elist','exceptionlist'); + } + elsif ($type eq 'I') { + ('got_Ilist','invitelist'); + } + }; + + $session = $this->{sessions}->{$msg->param(1)}; + if (defined $session) { + $session->{$flagname} = 1; + + my $list = $session->{ch}->$listname(); + my $list_size = @$list; + # ３つずつまとめる。 + for (my $i = 0; $i < $list_size; $i+=3) { + my @masks = ($list->[$i]); + push @masks,$list->[$i+1] if $i+1 < $list_size; + push @masks,$list->[$i+2] if $i+2 < $list_size; + + push @{$session->{cmd_buf}},IRCMessage->new( + Command => 'MODE', + Params => [$session->{ch_shortname}, + '+'.($type x scalar(@masks)), + @masks]); + } + } + }; + + if ($msg->command eq RPL_CHANNELMODEIS) { + # MODEリプライ + $session = $this->{sessions}->{$msg->param(1)}; + if (defined $session) { + $session->{got_mode} = 1; + my $ch = $session->{ch}; + + my ($params, @params) = $ch->mode_string; + if (length($params) > 1) { + # 設定すべきモードがある。 + push @{$session->{cmd_buf}},IRCMessage->new( + Command => 'MODE', + Params => [$session->{ch_shortname}, + $params, + @params]); + } + } + } + elsif ($msg->command eq RPL_ENDOFBANLIST) { + # +bリスト終わり + $got_reply->('b'); + } + elsif ($msg->command eq RPL_ENDOFEXCEPTLIST) { + # +eリスト終わり + $got_reply->('e'); + } + elsif ($msg->command eq RPL_ENDOFINVITELIST) { + # +Iリスト終わり + $got_reply->('I'); + } + elsif ($msg->command eq 'JOIN') { + $session = $this->{sessions}->{$msg->param(0)}; + if (defined $session && defined $msg->nick && + $msg->nick eq RunLoop->shared->current_nick) { + # 入り直した。 + $session->{got_oper} = 1; # 既にセットされている筈だが念のため + $this->revive($session); + } + } + + # $sessionが空でなければ、必要な情報が全て揃った可能性がある。 + if (defined $session && !$session->{got_oper} && + $session->{got_mode} && $session->{got_blist} && + $session->{got_elist} && $session->{got_Ilist}) { + $this->part_and_join($session); + } +} + +sub revive { + my ($this,$session) = @_; + Timer->new( + Interval => 1, + Repeat => 1, + Code => sub { + my $timer = shift; + my $cmd_buf = $session->{cmd_buf}; + if (@$cmd_buf > 0) { + # 一度に二つずつ送り出す。 + my $msg_per_trigger = 2; + for (my $i = 0; $i < @$cmd_buf && $i < $msg_per_trigger; $i++) { + $session->{server}->send_message($cmd_buf->[$i]); + } + splice @$cmd_buf,0,$msg_per_trigger; + } + if (@$cmd_buf == 0) { + # cmd_bufが空だったら終了。 + # untouchablesから消去 + my $untouchables = BulletinBoard->shared->do_not_touch_mode_of_channels; + delete $untouchables->{$session->{ch_fullname}}; + # session消去 + delete $this->{sessions}->{$session->{ch_fullname}}; + # タイマーをアンインストール + $timer->uninstall; + } + })->install; +} + +1; + +=pod +info: チャンネルオペレータ権限を無くしたとき、一人ならjoinし直す。 +default: off +section: important + +# +チャンネルや+aされているチャンネル以外でチャンネルオペレータ権限を持たずに +# 一人きりになった時、そのチャンネルの@を復活させるために自動的にjoinし直すモジュール。 +# トピック、モード、banリスト等のあらゆるチャンネル属性をも保存します。 + +# +b,+I,+eリストの復旧を行なうかどうか。 +# あまりに長いリストを取得するとMax Send-Q Exceedで落とされるかも知れません。 +save-lists: 1 +=cut diff -urN /non-existant-dir/module/Client/Cache.pm tiarra-20050322/module/Client/Cache.pm --- /non-existant-dir/module/Client/Cache.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Client/Cache.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,307 @@ +# ----------------------------------------------------------------------------- +# $Id: Cache.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003-2004 Topia . all rights reserved. +package Client::Cache; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Multicast; +use NumericReply; + +sub MODE_CACHE_FORCE_SENDED (){0;} +sub MODE_CACHE_SENDED (){1;} +sub MODE_CACHE_EXPIRE_TIME (){5 * 60;} +sub WHO_CACHE_EXPIRE_TIME (){5 * 60;} + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{hook} = IrcIO::Client::Hook->new( + sub { + my ($hook, $client, $ch_name, $network, $ch) = @_; + if ($ch->remark('switches-are-known') && + $this->_yesno($this->config->use_mode_cache)) { + # 送信できる場合は強制的に送信してみる + my $remark = $client->remark('mode-cache-state') || {}; + _send_mode_cache($client,$ch_name,$ch); + $remark->{ + Multicast::attach($ch->name, $network) + }->[MODE_CACHE_FORCE_SENDED] = 1; + $client->remark('mode-cache-state', $remark); + } + })->install('channel-info'); + $this; +} + +sub destruct { + my ($this) = shift; + + # hook を解除 + $this->{hook} and $this->{hook}->uninstall; + + # チャンネルについている remark を削除。 + foreach my $network (RunLoop->shared_loop->networks_list) { + foreach my $ch ($network->channels_list) { + $ch->remark(__PACKAGE__."/fetching-switches", undef, 'delete'); + $ch->remark(__PACKAGE__."/fetching-switches-expire", undef, 'delete'); + $ch->remark(__PACKAGE__."/fetching-who", undef, 'delete'); + $ch->remark(__PACKAGE__."/fetching-who-expire", undef, 'delete'); + } + } + + # クライアントについてるのは削除しない。 +} + +sub _yesno { + my ($this, $value, $default) = @_; + + return $default || 0 if (!defined $value); + return 0 if ($value =~ /[fn]/); # false/no + return 1 if ($value =~ /[ty]/); # true/yes + return 1 if ($value); # 数値判定 + return 0; +} + +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + + if ($io->isa('IrcIO::Server')) { + if ($type eq 'out' && + $msg->command eq 'MODE' && + Multicast::channel_p($msg->param(0)) && + !defined $msg->param(1)) { + my $ch = $io->channel($msg->param(0)); + if (defined $ch) { + $ch->remark(__PACKAGE__."/fetching-switches", 1); + $ch->remark(__PACKAGE__."/fetching-switches-expire", + time() + MODE_CACHE_EXPIRE_TIME); + } + } elsif ($type eq 'in' && + $msg->command eq RPL_CHANNELMODEIS && + Multicast::channel_p($msg->param(1))) { + my $ch = $io->channel($msg->param(1)); + if (defined $ch) { + $ch->remark(__PACKAGE__."/fetching-switches", undef, 'delete'); + $ch->remark(__PACKAGE__."/fetching-switches-expire", undef, 'delete'); + } + } elsif ($type eq 'out' && + $msg->command eq 'WHO' && + Multicast::channel_p($msg->param(0))) { + my $ch = $io->channel($msg->param(0)); + if (defined $ch) { + $ch->remark(__PACKAGE__."/fetching-who", 1); + $ch->remark(__PACKAGE__."/fetching-who-expire", + time() + WHO_CACHE_EXPIRE_TIME); + } + } elsif ($type eq 'in' && + $msg->command eq RPL_WHOREPLY && + Multicast::channel_p($msg->param(1))) { + # 処理の都合上、一つでも帰ってきた時点で取り消し。 + my $ch = $io->channel($msg->param(1)); + if (defined $ch) { + $ch->remark(__PACKAGE__."/fetching-who", undef, 'delete'); + $ch->remark(__PACKAGE__."/fetching-who-expire", undef, 'delete'); + } + } elsif ($type eq 'in' && + $msg->command eq RPL_ENDOFWHO && + Multicast::channel_p($msg->param(1))) { + my $ch = $io->channel($msg->param(1)); + if (defined $ch) { + $ch->remark(__PACKAGE__."/fetching-who", undef, 'delete'); + $ch->remark(__PACKAGE__."/fetching-who-expire", undef, 'delete'); + } + } + } + return $msg; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + # 条件をはずれていたら last で抜ける + while (1) { + # クライアントからのメッセージか？ + last unless ($sender->isa('IrcIO::Client')); + # 動作は許可されているか? + last unless ((!defined $sender->option('no-cache')) || + !$this->_yesno($sender->option('no-cache'))); + my $fetch_channel_info = sub { + my %ret; + $ret{chan_long} = shift; + ($ret{chan_short}, $ret{network_name}) = + Multicast::detach($ret{chan_long}); + $ret{network} = RunLoop->shared_loop->network($ret{network_name}); + unless (defined $ret{network}) { + } else { + $ret{ch} = $ret{network}->channel($ret{chan_short}); + $ret{chan_send} = RunLoop->shared_loop->multi_server_mode_p ? + $ret{chan_long} : $ret{chan_short}; + } + return %ret; + }; + if ($msg->command eq 'MODE' && + $this->_yesno($this->config->use_mode_cache) && + Multicast::channel_p($msg->param(0)) && + !defined $msg->param(1)) { + my %info = $fetch_channel_info->($msg->param(0)); + unless (defined $info{network}){ + # network not found. maybe disconnected + last; + } + last if !defined $info{ch}; + if ($info{ch}->remark('switches-are-known')) { + my $remark = $sender->remark('mode-cache-state') || {}; + my $ch_remark = $remark->{$info{chan_long}}; + if (!$ch_remark->[MODE_CACHE_SENDED]) { + _send_mode_cache($sender, + $info{chan_send}, + $info{ch}) + if (!$ch_remark->[MODE_CACHE_FORCE_SENDED]); + $ch_remark->[MODE_CACHE_SENDED] = 1; + $sender->remark('mode-cache-state', $remark); + return undef; + } + } else { + if ($info{ch}->remark(__PACKAGE__."/fetching-switches") && + ($info{ch}->remark(__PACKAGE__."/fetching-switches-expire") >= time())) { + # 取得しているクライアントがいて、期限が切れてないなら、 + # 今回は消して便乗。 + return undef; + } + # 取得しにいってもらう。 + } + } elsif ($msg->command eq 'WHO' && + $this->_yesno($this->config->use_who_cache) && + Multicast::channel_p($msg->param(0))) { + my %info = $fetch_channel_info->($msg->param(0)); + unless (defined $info{network}){ + # network not found. maybe disconnected + last; + } + last if !defined $info{ch}; + my $remark = $sender->remark('who-cache-used') || {}; + if (!exists $remark->{$info{chan_long}}) { + # cache がそろっているかわからないため、 + # とりあえず作ってみて、足りなかったらあきらめる。 + my $message_tmpl = IRCMessage->new( + Prefix => RunLoop->shared_loop->sysmsg_prefix('system'), + Command => RPL_WHOREPLY, + Params => [ + RunLoop->shared_loop->current_nick, + $info{chan_send}, + ], + ); + my @messages; + eval { + foreach (values %{$info{ch}->names}) { + my $p_ch = $_; + my $p = $p_ch->person; + + # たいして重要でない上、 + # 捏造が簡単なデータは捏造します。 + # 注意してください。 + if (!$p->username || !$p->userhost || + !$p->realname || !$p->server) { + # データ不足。あきらめる。 + die 'cache data not enough'; + } + + my $message = $message_tmpl->clone(deep => 1); + $message->param(2, $p->username); + $message->param(3, $p->userhost); + $message->param(4, $p->server); + $message->param(5, + Multicast::global_to_local($p->nick, + $info{network})); + $message->param(6, + (length($p->away) ? 'G' : 'H') . + $p_ch->priv_symbol); + $message->param(7, + $info{network}->remark('server-hops') + ->{$p->server}.' '. + $p->realname); + push(@messages, $message); + } + }; + if (!$@) { + my $message = $message_tmpl->clone(deep => 1); + $message->command(RPL_ENDOFWHO); + $message->param(2, 'End of WHO list.'); + push(@messages, $message); + map { + $sender->send_message($_); + } @messages; + $remark->{$info{chan_long}} = 1; + $sender->remark('who-cache-used', $remark); + return undef; + } else { + if ($info{ch}->remark(__PACKAGE__."/fetching-who") && + ($info{ch}->remark(__PACKAGE__."/fetching-who-expire") >= time())) { + # 取得しているクライアントがいて、期限が切れてないなら、 + # 今回は消して便乗。 + return undef; + } + # 取得しにいってもらう。 + } + } + } + last; + } + + return $msg; +} + + +sub _send_mode_cache { + my ($sendto,$ch_name,$ch) = @_; + + $sendto->send_message( + IRCMessage->new( + Prefix => RunLoop->shared_loop->sysmsg_prefix('system'), + Command => RPL_CHANNELMODEIS, + Params => [ + RunLoop->shared_loop->current_nick, + $ch_name, + $ch->mode_string, + ], + Remarks => { + 'fill-prefix-when-sending-to-client' => 1, + }, + ) + ); + if (defined $ch->remark('creation-time')) { + $sendto->send_message( + IRCMessage->new( + Prefix => RunLoop->shared_loop->sysmsg_prefix('system'), + Command => RPL_CREATIONTIME, + Params => [ + RunLoop->shared_loop->current_nick, + $ch_name, + $ch->remark('creation-time'), + ], + Remarks => { + 'fill-prefix-when-sending-to-client' => 1, + }, + ) + ); + } +} + +1; +=pod +info: データをキャッシュしてサーバに問い合わせないようにする +default: off +section: important + +# キャッシュを使用しても、使われるのは接続後最初の一度だけです。 +# 二度目からは通常通りにサーバに問い合わせます。 +# また、クライアントオプションの no-cache を指定すれば動きません。 + +# mode キャッシュを使用するか +use-mode-cache: 1 + +# who キャッシュを使用するか +use-who-cache: 1 +=cut diff -urN /non-existant-dir/module/Client/Conservative.pm tiarra-20050322/module/Client/Conservative.pm --- /non-existant-dir/module/Client/Conservative.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Client/Conservative.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,48 @@ +# ----------------------------------------------------------------------------- +# $Id: Conservative.pm 848 2005-03-21 16:50:41Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::Conservative; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Multicast; +use NumericReply; +use Tiarra::Utils; + +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + + if ($io->isa('IrcIO::Client') && + $type eq 'out') { + my $mark_as_need_colon = sub { + $msg->remark('always-use-colon-on-last-param', 1); + $msg; + }; + my $command = $msg->command; + + foreach (qw(PRIVMSG NOTICE NICK WALLOPS PART NJOIN KICK TOPIC INVITE + PING QUIT), + (map { NumericReply::fetch_number("RPL_$_") } + (qw(MAP MAPSTART HELLO SERVLIST AWAY USERHOST ISON), + qw(WHOISUSER WHOISSERVER WHOWASUSER WHOISCHANNELS), + qw(LIST TOPIC VERSION INFO YOUREOPER TIME))), + ) { + if ($command eq $_) { + return $mark_as_need_colon->(); + } + } + } + return $msg; +} + +1; +=pod +info: サーバが送信するような IRC メッセージを作成するようにする +default: on + +# サーバが実際に送信しているようなメッセージにあわせるようにします。 +# 多くのクライアントの設計ミスを回避でき(ると思われ)ます。 + +=cut diff -urN /non-existant-dir/module/Client/Cotton.pm tiarra-20050322/module/Client/Cotton.pm --- /non-existant-dir/module/Client/Cotton.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Client/Cotton.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,87 @@ +# ----------------------------------------------------------------------------- +# $Id: Cotton.pm 826 2005-03-07 22:32:39Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::Cotton; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Multicast; +use Tiarra::Utils; + +sub PART_SHIELD_EXPIRE_TIME (){5 * 60;} + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this; +} + +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + + if ($io->isa('IrcIO::Client') && + $this->is_cotton($io)) { + if (utils->cond_yesno($this->config->use_part_shield) && + $type eq 'in' && + $msg->command eq 'PART' && + Multicast::channel_p($msg->param(0)) && + !defined $msg->param(1)) { + my ($chan_short, $network_name) = Multicast::detach($msg->param(0)); + my $network = $this->_runloop->network($network_name); + if (defined $network) { + my $expire = $network->remark(__PACKAGE__.'/part-shield/expire'); + my $remark = $io->remark(__PACKAGE__.'/part-shield/'.$network_name); + if (defined $expire && + $expire >= time()) { + if (!defined $remark || + (defined $remark->{channels} && + !defined $remark->{channels}->{$chan_short})) { + $remark->{channels}->{$chan_short} = 1; + return undef; + } + } else { + # remove expired network info + $network->remark(__PACKAGE__.'/part-shield/expire', undef, 'delete'); + $io->remark(__PACKAGE__.'/part-shield/'.$network_name, undef, 'delete'); + } + } + } + } + return $msg; +} + +sub connected_to_server { + my ($this,$server,$new_connection) = @_; + + if (!$new_connection) { + # reconnect + $server->remark(__PACKAGE__.'/part-shield/expire', time() + PART_SHIELD_EXPIRE_TIME); + } +} + +sub is_cotton { + my ($this, $client) = @_; + + return 1 if defined $client->remark('client-version') && + $client->remark('client-version') =~ /(Cotton|Unknown) Client/; + return 1 if defined $client->option('client-type') && + $client->option('client-type') =~ /(cotton|unknown)/; + return 0; +} + +1; +=pod +info: Cotton の行うおかしな動作のいくつかを無視する +default: off +section: important + +# 該当クライアントのオプション client-type に cotton や unknown と指定するか、 +# Client::GetVersion を利用してクライアントのバージョンを取得するように +# してください。 + +# part shield (rejoin 時に自動で行われる part の無視)を使用するか +use-part-shield: 1 + +=cut diff -urN /non-existant-dir/module/Client/Eval.pm tiarra-20050322/module/Client/Eval.pm --- /non-existant-dir/module/Client/Eval.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Client/Eval.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,87 @@ +# ----------------------------------------------------------------------------- +# $Id: Eval.pm 607 2004-10-02 08:31:58Z topia $ +# ----------------------------------------------------------------------------- +package Client::Eval; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Timer; +use Data::Dumper; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + # クライアントからのメッセージか？ + if ($sender->isa('IrcIO::Client')) { + # 指定されたコマンドか? + if (Mask::match_deep([$this->config->command('all')], $msg->command)) { + # メッセージ再構築 + my ($method) = join(' ', @{$msg->params}); + my ($ret, $err); + do { + # disable warning + local $SIG{__WARN__} = sub { }; + # die handler + #local $SIG{__DIE__} = sub { $err = $_[0]; }; + no strict; + # untaint + $method =~ /\A(.*)\z/s; + $err = ''; + $ret = eval($1); + }; + $err = $@; + + my $message = IRCMessage->new( + Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv system)), + Command => 'NOTICE', + Params => [RunLoop->shared_loop->current_nick, + ''], + ); + do { + local($Data::Dumper::Terse) = 1; + local($Data::Dumper::Purity) = 1; + map { + my $new = $message->clone; + $new->param(1, $_); + $sender->send_message($new); + } ( + (split /\n/, 'method: '.Dumper($method)), + (split /\n/, 'result: '.Dumper($ret)), + (split /\n/, 'error: '.$err), + ); + return undef; + }; + } + } + + return $msg; +} + +# useful functions to call from eval +sub runloop { return RunLoop->shared; } +sub network { return runloop->network(shift); } +sub conf { return Configuration->shared; } +sub module_manager { return ModuleManager->shared_manager; } +sub module { return module_manager->get(shift); } +sub shutdown { return ::shutdown; } +sub reload { + ReloadTrigger->_install_reload_timer; + return undef; +} +sub reload_mod { + my $name = shift; + delete $INC{$name}; + require $name; +} + +1; +=pod +info: クライアントから Perl 式を実行できるようにする。 +default: off + +# eval を実行するコマンド名。省略されるとコマンドを追加しません。 +# この時コマンドはTiarraが握り潰すので、IRCプロトコル上で定義された +# コマンド名を設定すべきではありません。 +command: eval +=cut diff -urN /non-existant-dir/module/Client/GetVersion.pm tiarra-20050322/module/Client/GetVersion.pm --- /non-existant-dir/module/Client/GetVersion.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Client/GetVersion.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,60 @@ +# ----------------------------------------------------------------------------- +# $Id: GetVersion.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::GetVersion; +use strict; +use warnings; +use base qw(Module); +use CTCP; + +sub CTCP_VERSION_EXPIRE_TIME (){5 * 60;} + +sub client_attached { + my ($this,$client) = @_; + + my $msg = CTCP::make('VERSION', RunLoop->shared_loop->current_nick, 'PRIVMSG'); + $msg->prefix(RunLoop->shared_loop->sysmsg_prefix(qw(system))); + + $client->send_message($msg); + $client->remark(__PACKAGE__.'/fetching-version-expire', + time() + CTCP_VERSION_EXPIRE_TIME); +} + +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + + if ($io->isa('IrcIO::Client')) { + if ($type eq 'in' && $msg->command eq 'NOTICE' && + !Multicast::channel_p($msg->param(0)) && + defined $msg->param(1) && + defined $io->remark(__PACKAGE__.'/fetching-version-expire')) { + if ($io->remark(__PACKAGE__.'/fetching-version-expire') + >= time()) { + my $ctcp = CTCP::extract($msg); + if (defined $ctcp) { + my ($command, $text) = split(/ /, $ctcp, 2); + if ($command eq 'VERSION') { + $io->remark('client-version', $text); + return undef; + } + } + } else { + $io->remark(__PACKAGE__.'/fetching-version-expire', undef, 'delete'); + } + } + } + + return $msg; +} + +1; +=pod +info: クライアントに CTCP Version を発行してバージョン情報を得る +default: on + +# オプションはいまのところありません。 +# (開発者向け情報: 取得した情報は remark の client-version に設定され、 +# Client::Guess から使用されます。) + +=cut diff -urN /non-existant-dir/module/Client/Guess.pm tiarra-20050322/module/Client/Guess.pm --- /non-existant-dir/module/Client/Guess.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Client/Guess.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,214 @@ +# ----------------------------------------------------------------------------- +# $Id: Guess.pm 544 2004-09-11 08:28:32Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::Guess; +use strict; +use warnings; +use RunLoop; +use SelfLoader; +use Tiarra::SharedMixin; + +# shorthand +our $re_ver = qr/[\d.][\d.a-zA-Z-+]+/; +our $re_tok = qr/[^\s]+/; + +sub _new { + # don't need instance present + return shift; +} + +sub destruct { + map { + $_->remark('client-guess-cache', undef, 'delete'); + } RunLoop->shared_loop->clients_list; +} + +sub is_target { + my ($class_or_this, $type, $client) = @_; + my $this = $class_or_this->_this; + + my $guess = $this->guess($client)->{type}; + if (defined $guess) { + return $guess eq $type; + } else { + return undef; + } +} + +sub guess { + my ($class_or_this, $client, $rehash) = @_; + my $this = $class_or_this->_this; + my $struct = $client->remark('client-guess-cache'); + + if (!$rehash && defined $struct && $struct->{completed}) { + return $struct; + } else { + $struct = {}; + } + + if (defined $client->remark('client-version')) { + if ($this->guess_ctcp_version($struct, + $client->remark('client-version'))) { + $struct->{completed} = 1; + } + } + + if (defined $client->remark('client-type')) { + $struct->{type} = $client->remark('client-type'); + } + + if (scalar(keys(%{$struct}))) { + # cache + $client->remark('client-guess-cache', $struct); + } + return $struct; +} + +sub guess_ctcp_version { + my ($class_or_this, $struct, $str) = @_; + my $this = $class_or_this->_this; + + my $struct_set = sub { + my %stor; + # copy values + my $param; + $param = shift; + if (ref($param) eq 'ARRAY') { + $stor{keys} = [@$param]; + } else { + $stor{keys} = [$param]; + } + $stor{values} = [@_]; + + my ($key, $value); + while () { + ($key, $value) = map { + if (scalar @{$stor{$_}}) { + shift @{$stor{$_}}; + } else { + return $struct; + } + } qw(keys values); + $struct->{$key} = $value; + } + }; + + #$struct_set->('ctcp_version', $str); + my $func = 'version_guess_' . lc(substr($str,0,1)); + if ($this->can($func)) { + if ($this->$func($str, $struct_set)) { + return 1; + } + } + + if ($str =~ /^(Cotton|Unknown) Client$/) { + $struct->{type} = 'cotton'; + $struct->{exact_type} = lc($1); + } else { + return undef; + } + return 1; +} + +no warnings 'redefine'; +SelfLoader->load_stubs; +1; +__DATA__ + +sub version_guess_c { + my ($this, $str, $struct_set) = @_; + + if ($str =~ /^CHOCOA ($re_ver) \(($re_tok)\)$/) { + $struct_set->([qw(type ver plat)], + 'chocoa', $1, $2); + } else { + return undef; + } + return 1; +} + +sub version_guess_t { + my ($this, $str, $struct_set) = @_; + + if ($str =~ /^Tiarra:($re_tok):perl ($re_tok) on ($re_tok)$/) { + $struct_set->([qw(type ver perl_ver perl_plat)], + 'tiarra', $1, $2, $3); + } else { + return undef; + } + return 1; +} + +sub version_guess_l { + my ($this, $str, $struct_set) = @_; + + if ($str =~ /^LimeChat ($re_ver) \((.+?)\)$/) { + $struct_set->([qw(type ver plat)], 'limechat', $1, $2); + } elsif ($str =~ /^Loqui version ($re_tok)/) { + $struct_set->([qw(type ver)], 'loqui', $1); + } elsif ($str =~ m{^Liece/($re_ver) :$}) { + $struct_set->([qw(type ver)], 'liece', $1); + } else { + return undef; + } + return 1; +} + +sub version_guess_m { + my ($this, $str, $struct_set) = @_; + + if ($str =~ /^madoka ($re_ver) in perl ($re_ver):$/) { + $struct_set->([qw(type ver perl_ver)], 'madoka', $1, $2); + } elsif ($str =~ /^Misuzilla Ircv \(($re_ver) version\) on (.NET CLR-$re_tok)$/) { + $struct_set->([qw(type ver plat)], 'ircv', $1, $2); + } else { + return undef; + } + return 1; +} + +sub version_guess_p { + my ($this, $str, $struct_set) = @_; + + if ($str =~ /^plum ($re_ver) perl ($re_ver)\s*:?$/) { + $struct_set->([qw(type ver perl_ver)], 'plum', $1, $2); + } else { + return undef; + } + return 1; +} + +sub version_guess_r { + my ($this, $str, $struct_set) = @_; + + if ($str =~ m{^Riece/($re_ver) ($re_tok)/($re_ver) }) { + $struct_set->([qw(type ver emacs_flavor emacs_ver)], 'riece', $1, $2, $3); + } else { + return undef; + } + return 1; +} + +sub version_guess_w { + my ($this, $str, $struct_set) = @_; + + if ($str =~ /^WoolChat Ver ($re_ver)?$/) { + $struct_set->([qw(type ver)], 'woolchat', $1); + } else { + return undef; + } + return 1; +} + +sub version_guess_x { + my ($this, $str, $struct_set) = @_; + + if ($str =~ m{^xchat ($re_ver) ($re_tok) ($re_tok) \[($re_tok)/($re_tok)\]$}) { + $struct_set->([qw(type ver plat plat_ver arch cpu_speed)], + 'xchat', $1, $2, $3, $4, $5); + } else { + return undef; + } + return 1; +} diff -urN /non-existant-dir/module/Client/PatchworkMessage.pm tiarra-20050322/module/Client/PatchworkMessage.pm --- /non-existant-dir/module/Client/PatchworkMessage.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Client/PatchworkMessage.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,78 @@ +# ----------------------------------------------------------------------------- +# $Id: PatchworkMessage.pm 849 2005-03-21 16:54:09Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::PatchworkMessage; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Multicast; +use NumericReply; +use Module::Use qw(Client::Guess); +use Client::Guess; +use Tiarra::Utils; + +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + + my $mark_as_need_colon = sub { + $msg->remark('always-use-colon-on-last-param', 1); + }; + + if ($io->isa('IrcIO::Client')) { + if ($this->is_target('woolchat', $io)) { + if ($type eq 'out' && + $msg->command eq 'NICK') { + $mark_as_need_colon->(); + } + } elsif ($this->is_target('xchat', $io)) { + if ($type eq 'out' && + $msg->command eq RPL_WHOISUSER) { + $mark_as_need_colon->(); + } + } + } + return $msg; +} + +sub is_target { + my ($this, $target, $io, $default_disable) = @_; + + if (Client::Guess->shared->is_target($target, $io) && + utils->cond_yesno($this->config->get("enable-$target"), + !$default_disable)) { + return 1; + } + return 0; +} + +1; +=pod +info: IRC メッセージにちょっと変更を加えて、クライアントのバグを抑制する +default: off + +# 特に注意書きがない場合はデフォルトで有効です。 +# また、 Client::GetVersion も同時に入れておくと便利です。 +# とりあえず obsolete です。このモジュールで実装されていた機能は +# Client::Conservative によって実現できます。 +# Client::Conservative で実装してはいけないようなものがあった場合のみ +# このモジュールで対処します。 + +# WoolChat: +# 対応しているメッセージ: +# NICK(コロンが必須) +# 説明: +# NICK は接続直後にも発行されるため、 Client::GetVersion での判別まで +# 待てません。該当クライアントのオプション client-type に woolchat と +# 指定してください。実名欄に $client-type=woolchat$ と書けば OK です。 +enable-woolchat: 1 + +# X-Chat: +# 対応しているメッセージ: +# RPL_WHOISUSER(コロンが必須) +# 説明: +# WHOIS の realname にスペースが入っていないと最初の一文字が削られます。 +enable-xchat: 1 + +=cut diff -urN /non-existant-dir/module/Client/ProtectMyself.pm tiarra-20050322/module/Client/ProtectMyself.pm --- /non-existant-dir/module/Client/ProtectMyself.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Client/ProtectMyself.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,120 @@ +# ----------------------------------------------------------------------------- +# $Id: ProtectMyself.pm 724 2004-11-27 05:12:17Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::ProtectMyself; +use strict; +use warnings; +use base qw(Module); +use Multicast; +use IRCMessage; +use Auto::AliasDB; +use Tiarra::Utils; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my $runloop = $this->_runloop; + my $current_nick = $runloop->current_nick; + + if ($runloop->multi_server_mode_p && + $sender->isa('IrcIO::Server') && + defined $msg->nick && + $msg->nick eq $current_nick) { + if ($msg->command =~ /^(NICK|QUIT|PART)$/) { + $msg->remark(__PACKAGE__ . '/network-name', $sender->network_name); + } + } + return $msg; +} + +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + my $runloop = $this->_runloop; + my $current_nick = $runloop->current_nick; + + if ($runloop->multi_server_mode_p && + $io->client_p && + $type eq 'out' && + $msg->remark('message-send-by-other') && + defined $msg->nick && + $msg->nick eq $current_nick) { + my ($msg_tmpl, %additional_replaces, @affected); + my $attach_for_client = sub { + my $network_name = $msg->remark(__PACKAGE__ . '/network-name'); + $network_name = $runloop->default_network + unless defined $network_name; + return map { + Multicast::attach_for_client($_, $network_name); + } @_; + }; + my $set_affected_by_remark = sub { + if (defined $msg->remark('affected-channels')) { + @affected = $attach_for_client->( + @{$msg->remark('affected-channels')}); + } else { + @affected = $runloop->current_nick; + } + }; + if ($msg->command eq 'NICK') { + $msg_tmpl = utils->get_first_defined( + $this->config->nick_format, + 'Nick changed #(nick.now) -> #(nick.new)'); + $additional_replaces{'nick.new'} = $msg->param(0); + $set_affected_by_remark->(); + } elsif ($msg->command eq 'PART') { + $msg_tmpl = utils->get_first_defined( + $this->config->part_format, + 'Part #(nick.now) (#(message)) from #(target)'); + $additional_replaces{'message'} = $msg->param(1); + @affected = $msg->param(0); + } elsif ($msg->command eq 'QUIT') { + $msg_tmpl = utils->get_first_defined( + $this->config->quit_format, + 'Quit #(nick.now) (#(message))'); + $additional_replaces{'message'} = $msg->param(0); + $set_affected_by_remark->(); + } elsif ($msg->command eq 'JOIN') { + $msg_tmpl = utils->get_first_defined( + $this->config->join_format, + 'Join #(nick.now) (#(prefix.now)) to #(target)'); + @affected = $msg->param(0); + } + if (@affected) { + my $aliasdb = Auto::AliasDB->shared; + my $msg_skel = IRCMessage->new( + Prefix => $runloop->sysmsg_prefix(qw(system fake::system)), + Command => 'NOTICE', + Params => [undef, undef]); + return map { + my $new_msg = $msg_skel->clone; + $new_msg->param(0, $_); + $new_msg->param(1, $aliasdb->stdreplace( + $msg->prefix, $msg_tmpl, $msg, undef, + target => $_, + %additional_replaces, + )); + $new_msg; + } @affected; + } + } + return $msg; +} + +1; +=pod +info: 意図せず自分のニックが変わってしまうのを防止する +default: off + +# {nick,part,quit,join}-format: それぞれのメッセージのフォーマットを指定します。 +# {nick,user,host,prefix}.now などはどこでも使えます。 +# そのほかには +# target : 表示するチャンネル(またはニック)。 +# nick.new : nick-format のみ。新しいニック。 +# message : part と quit 。メッセージ。 + +nick-format: Nick changed #(nick.now) -> #(nick.new) +part-format: Part #(nick.now) (#(message)) from #(target) +quit-format: Quit #(nick.now) (#(message)) +join-format: Join #(nick.now) (#(prefix.now)) to #(target) + +=cut diff -urN /non-existant-dir/module/Client/Rehash.pm tiarra-20050322/module/Client/Rehash.pm --- /non-existant-dir/module/Client/Rehash.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Client/Rehash.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,131 @@ +# ----------------------------------------------------------------------------- +# $Id: Rehash.pm 499 2004-08-22 09:24:21Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::Rehash; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Multicast; +use NumericReply; +use Timer; + +my $timer_name = __PACKAGE__.'/timer'; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); +} + +sub destruct { + my ($this) = shift; + + # timer があれば解除 + foreach my $client (RunLoop->shared_loop->clients_list) { + my $timer = $client->remark($timer_name); + if (defined $timer) { + $client->remark($timer_name, undef, 'delete'); + $timer->uninstall; + } + } +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + # クライアントからのメッセージか？ + if ($sender->isa('IrcIO::Client')) { + my $runloop = RunLoop->shared_loop; + # 指定されたコマンドか? + if (Mask::match_deep([$this->config->command_nick('all')], $msg->command)) { + if (!defined $msg->param(0)) { + } elsif ($msg->param(0) eq $runloop->current_nick) { + } else { + $sender->send_message( + IRCMessage->new( + Prefix => $msg->param(0).'!'.$sender->username.'@'. + $sender->client_host, + Command => 'NICK', + Param => $runloop->current_nick, + )); + + } + # ここで消す。 + return undef; + } elsif (Mask::match_deep([$this->config->command_names('all')], $msg->command)) { + my @channels = map { + my $network_name = $_->network_name; + map { + [$network_name, $_->name]; + } $_->channels_list; + } $runloop->networks_list; + $sender->remark($timer_name, Timer->new( + Interval => (defined $this->config->interval ? + $this->config->interval : 2), + Repeat => 1, + Code => sub { + my $timer = shift; + my $runloop = RunLoop->shared_loop; + while (1) { + my $entry = shift(@channels); + if (defined $entry && $sender->connected) { + my ($network_name, $ch_name) = @$entry; + my $network = $runloop->network($network_name); + my $flush_namreply = sub { + my $msg = shift; + $msg->param(0, $runloop->current_nick); + $sender->send_message($msg); + }; + if (!defined $network) { + # network disconnected. ignore + next; + } + my $ch = $network->channel($ch_name); + if (!defined $ch) { + # parted channel; ignore + next; + } + $sender->do_namreply($ch, $network, + undef, $flush_namreply); + } else { + $sender->remark($timer_name, undef, 'delete'); + $timer->uninstall; + } + last; + } + }, + )->install); + + # ここで消す。 + return undef; + } + } + + return $msg; +} + +1; +=pod +info: 全チャンネル分の names の内部キャッシュをクライアントに送信する。 +default: off + +# もともとはクライアントの再初期化目的に作ったのですが、 names を送信しても +# 更新されないクライアントが多いので、主に multi-server-mode な Tiarra の +# 下にさらに Tiarra をつないでいる人向けにします。 + +# names でニックリストを更新してくれるクライアント: +# Tiarra +# してくれないクライアント: (括弧内は確認したバージョンまたは注釈) +# LimeChat(1.18) + +# nick rehash に使うコマンドを指定します。 +# 第二パラメータとして現在クライアントが認識している nick を指定してください。 +command-nick: rehash-nick + +# names rehash に使うコマンドを指定します。 +command-names: rehash-names + +# チャンネルとチャンネルの間のウェイトを指定します。 +interval: 2 +=cut diff -urN /non-existant-dir/module/Client/ShowNick.pm tiarra-20050322/module/Client/ShowNick.pm --- /non-existant-dir/module/Client/ShowNick.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Client/ShowNick.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,72 @@ +# ----------------------------------------------------------------------------- +# $Id: ShowNick.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Client::ShowNick; +use strict; +use warnings; +use base qw(Module); + +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + + if ($io->isa('IrcIO::Client')) { + if ($type eq 'in' && + ($msg->command eq 'WHOIS' || $msg->command eq 'WHO') && + RunLoop->shared_loop->multi_server_mode_p) { + my $local_nick = RunLoop->shared_loop->current_nick; + if ($msg->param(0) eq $local_nick) { + my $prefix = RunLoop->shared_loop->sysmsg_prefix(qw(priv system)); + map { + # ローカルnickとグローバルnickが食い違っていたらその旨を伝える。 + # 接続しているネットワーク名を全部表示する + my $network_name = $_->network_name; + my $global_nick = $_->current_nick; + if ($global_nick ne $local_nick) { + $io->send_message( + new IRCMessage(Prefix => $prefix, + Command => 'NOTICE', + Params => [$local_nick, + "*** Your global nick in $network_name is currently '$global_nick'."])); + } else { + $io->send_message( + new IRCMessage(Prefix => $prefix, + Command => 'NOTICE', + Params => [$local_nick, + "*** Your global nick in $network_name is same as local nick."])); + } + } RunLoop->shared_loop->networks_list; + } + } + } + return $msg; +} + +sub client_attached { + my ($this,$client) = @_; + + if (RunLoop->shared_loop->multi_server_mode_p) { + my $current_nick = RunLoop->shared_loop->current_nick; + map { + # ローカルnickとグローバルnickが同じネットワークについてその旨を伝える。 + # (接続しているチャンネルを表示する、程度の用途) + my $network_name = $_->network_name; + my $global_nick = $_->current_nick; + if ($global_nick eq $current_nick) { + $client->send_message( + new IRCMessage( + Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv system)), + Command => 'NOTICE', + Params => [$current_nick, + "*** Your global nick in $network_name is same as local nick."])); + } + } RunLoop->shared_loop->networks_list; + } +} + + +1; +=pod +info: show network +default: off +=cut diff -urN /non-existant-dir/module/Debug/AliasTest.pm tiarra-20050322/module/Debug/AliasTest.pm --- /non-existant-dir/module/Debug/AliasTest.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Debug/AliasTest.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,38 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: AliasTest.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package Debug::AliasTest; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Auto::Utils); +use Auto::Utils; +use Mask; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my @result = ($msg); + + # サーバーからのメッセージか？ + if ($sender->isa('IrcIO::Server')) { + # PRIVMSGか？ + if ($msg->command eq 'PRIVMSG') { + my ($get_ch_name,undef,undef,$reply_anywhere) + = Auto::Utils::generate_reply_closures($msg,$sender,\@result); + + my ($req, $str) = split(/\s+/, $msg->param(1), 2); + if (Mask::match_array([$this->config->request('all')], $req, 1)) { + # 一致していた。 + if (Mask::match_deep_chan([$this->config->mask('all')],$msg->prefix,$get_ch_name->())) { + $reply_anywhere->(join('', ($this->config->prefix||''), $str, ($this->config->suffix||''))); + } + } + } + } + + return @result; +} + +1; diff -urN /non-existant-dir/module/Debug/RawLog.pm tiarra-20050322/module/Debug/RawLog.pm --- /non-existant-dir/module/Debug/RawLog.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Debug/RawLog.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,96 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: RawLog.pm 822 2005-03-07 18:05:42Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. + +package Debug::RawLog; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Tools::DateConvert); +use Tools::DateConvert; +use Mask; +use Multicast; + +sub message_io_hook { + my ($this,$message,$io,$type) = @_; + + my $prefix = 'RAWLOG: '; + my $conf_entry = 'enable-'; + + $prefix .= do { + if ($type eq 'in') { + '<<'; + } elsif ($type eq 'out') { + '>>'; + } else { + '--'; + } + }; + + $prefix .= do { + if ($io->server_p()) { + 'SERVER(' . $io->network_name() . ') '; + } elsif ($io->client_p()) { + 'CLIENT(' . ($io->option('logname') || $io->fullname()) . ') '; + } else { + '------ '; + } + }; + + $conf_entry .= do { + if ($io->server_p()) { + 'server' + } elsif ($io->client_p()) { + 'client'; + } + }; + + $conf_entry .= '-' . $type; + + # break with last + while (1) { + last if (($message->command =~ /^P[IO]NG$/) && + $this->config->ignore_ping); + last unless ($this->config->get($conf_entry)); + my $msg = $message->clone; + if ($this->config->resolve_numeric && $message->command =~ /^\d{3}$/) { + $msg->command( + (NumericReply::fetch_name($message->command)||'undef'). + '('.$message->command.')'); + } + ::printmsg($prefix . $msg->serialize()); + last; + } + + return $message; +} + +1; + +=pod +info: 標準出力にクライアントやサーバとの通信をダンプする。 +default: off + +# 0 または省略で表示しない。 1 で表示する。 +# クライアントオプションの logname によって、ダンプに使う名前を指定できます。 + +# サーバからの入力 +enable-server-in: 1 + +# サーバへの出力 +enable-server-out: 1 + +# クライアントからの入力 +enable-client-in: 0 + +# クライアントへの出力 +enable-client-out: 0 + +# PING/PONG を無視する +ignore-ping: 1 + +# NumericReply の名前を解決して表示する(ちゃんとした dump では無くなります) +resolve-numeric: 1 +=cut diff -urN /non-existant-dir/module/Log/Channel.pm tiarra-20050322/module/Log/Channel.pm --- /non-existant-dir/module/Log/Channel.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Log/Channel.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,388 @@ +# ----------------------------------------------------------------------------- +# $Id: Channel.pm 803 2005-02-28 22:41:29Z topia $ +# ----------------------------------------------------------------------------- +package Log::Channel; +use strict; +use warnings; +use IO::File; +use File::Spec; +use Tiarra::Encoding; +use base qw(Module); +use Module::Use qw(Tools::DateConvert Log::Logger Log::Writer); +use Tools::DateConvert; +use Log::Logger; +use Log::Writer; +use ControlPort; +use Mask; +use Multicast; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{channels} = []; # 要素は[ディレクトリ名,マスク] + $this->{matching_cache} = {}; # <チャンネル名,ファイル名> + $this->{writer_cache} = {}; # <チャンネル名,Log::Writer> + $this->{sync_command} = do { + my $sync = $this->config->sync; + if (defined $sync) { + uc $sync; + } + else { + undef; + } + }; + $this->{distinguish_myself} = do { + my $conf_val = $this->config->distinguish_myself; + if (defined $conf_val) { + $conf_val; + } + else { + 1; + } + }; + $this->{logger} = + Log::Logger->new( + sub { + $this->_search_and_write(@_); + }, + $this, + 'S_PRIVMSG','C_PRIVMSG','S_NOTICE','C_NOTICE'); + + $this->_init; +} + +sub _init { + my $this = shift; + foreach ($this->config->channel('all')) { + my ($dirname,$mask) = split /\s+/; + if (!defined($dirname) || $dirname eq '' || + !defined($mask) || $mask eq '') { + die 'Illegal definition in '.__PACKAGE__."/channel : $_\n"; + } + push @{$this->{channels}},[$dirname,$mask]; + } + + $this; +} + +sub sync { + my $this = shift; + $this->flush_all_file_handles; + RunLoop->shared->notify_msg("Channel logs synchronized."); +} + +sub control_requested { + my ($this,$request) = @_; + if ($request->ID eq 'synchronize') { + $this->sync; + ControlPort::Reply->new(204,'No Content'); + } + else { + die "Log::Channel received control request of unsupported ID ".$request->ID."\n"; + } +} + +sub message_arrived { + my ($this,$message,$sender) = @_; + + # syncは有効で、クライアントから受け取ったメッセージであり、かつ今回のコマンドがsyncに一致しているか？ + if (defined $this->{sync_command} && + $sender->isa('IrcIO::Client') && + $message->command eq $this->{sync_command}) { + # 開いているファイルを全てflush。 + # 他のモジュールも同じコマンドでsyncするかも知れないので、 + # do-not-send-to-servers => 1は設定するが + # メッセージ自体は破棄してしまわない。 + $this->sync; + $message->remark('do-not-send-to-servers',1); + return $message; + } + + # __PACKAGE__/commandにマッチするか？ + if (Mask::match(lc($this->config->command || '*'),lc($message->command))) { + $this->{logger}->log($message,$sender); + } + + $message; +} + +*S_PRIVMSG = \&PRIVMSG_or_NOTICE; +*S_NOTICE = \&PRIVMSG_or_NOTICE; +*C_PRIVMSG = \&PRIVMSG_or_NOTICE; +*C_NOTICE = \&PRIVMSG_or_NOTICE; +sub PRIVMSG_or_NOTICE { + my ($this,$msg,$sender) = @_; + my $target = Multicast::detatch($msg->param(0)); + my $is_priv = Multicast::nick_p($target); + my $cmd = $msg->command; + + my $line = do { + if ($is_priv) { + # privの時は自分と相手を必ず区別する。 + if ($sender->isa('IrcIO::Client')) { + sprintf( + $cmd eq 'PRIVMSG' ? '>%s< %s' : ')%s( %s', + $msg->param(0), + $msg->param(1)); + } + else { + sprintf( + $cmd eq 'PRIVMSG' ? '-%s- %s' : '=%s= %s', + $msg->nick || $sender->current_nick, + $msg->param(1)); + } + } + else { + my $format = do { + if ($this->{distinguish_myself} && $sender->isa('IrcIO::Client')) { + $cmd eq 'PRIVMSG' ? '>%s:%s< %s' : ')%s:%s( %s'; + } + else { + $cmd eq 'PRIVMSG' ? '<%s:%s> %s' : '(%s:%s) %s'; + } + }; + my $nick = do { + if ($sender->isa('IrcIO::Client')) { + RunLoop->shared_loop->network( + (Multicast::detatch($msg->param(0)))[1]) + ->current_nick; + } + else { + $msg->nick || $sender->current_nick; + } + }; + sprintf $format,$msg->param(0),$nick,$msg->param(1); + } + }; + + [$is_priv ? 'priv' : $msg->param(0),$line]; +} + +sub _channel_match { + # 指定されたチャンネル名にマッチするログ保存ファイルのパターンを定義から探す。 + # 一つもマッチしなければundefを返す。 + # このメソッドは検索結果を$this->{matching_cache}に保存して、後に再利用する。 + my ($this,$channel) = @_; + + my $cached = $this->{matching_cache}->{$channel}; + if (defined $cached) { + if ($cached eq '') { + # マッチするエントリは存在しない、という結果がキャッシュされている。 + return undef; + } + else { + return $cached; + } + } + + foreach my $ch (@{$this->{channels}}) { + if (Mask::match($ch->[1],$channel)) { + # マッチした。 + my $fname_format = $this->config->filename || '%Y.%m.%d.txt'; + my $fpath_format = $ch->[0]."/$fname_format"; + + $this->{matching_cache}->{$channel} = $fpath_format; + return $fpath_format; + } + } + $this->{matching_cache}->{$channel} = ''; + undef; +} + +sub _search_and_write { + my ($this,$channel,$line) = @_; + my $dirname = $this->_channel_match($channel); + if (defined $dirname) { + $this->_write($channel,$dirname,$line); + } +} + +sub _write { + # 指定されたログファイルにヘッダ付きで追記する。 + # ディレクトリ名の日付のマクロは置換される。 + my ($this,$channel,$abstract_fpath,$line) = @_; + my $concrete_fpath = do { + my $basedir = $this->config->directory; + if (defined $basedir) { + Tools::DateConvert::replace("$basedir/$abstract_fpath"); + } + else { + Tools::DateConvert::replace($abstract_fpath); + } + }; + my $header = Tools::DateConvert::replace( + $this->config->header || '%H:%M' + ); + my $always_flush = do { + if ($this->config->keep_file_open) { + if ($this->config->always_flush) { + 1; + } else { + 0; + } + } else { + 1; + } + }; + # ファイルに追記 + my $make_writer = sub { + Log::Writer->shared_writer->find_object( + $concrete_fpath, + always_flush => $always_flush, + file_mode_oct => $this->config->mode, + dir_mode_oct => $this->config->dir_mode, + ); + }; + my $writer = sub { + # キャッシュは有効か？ + if ($this->config->keep_file_open) { + # このチャンネルはキャッシュされているか？ + my $cached_elem = $this->{writer_cache}->{$channel}; + if (defined $cached_elem) { + # キャッシュされたファイルパスは今回のファイルと一致するか？ + if ($cached_elem->uri eq $concrete_fpath) { + # このファイルハンドルを再利用して良い。 + #print "$concrete_fpath: RECYCLED\n"; + return $cached_elem; + } + else { + # ファイル名が違う。日付が変わった等の場合。 + # 古いファイルハンドルを閉じる。 + #print "$concrete_fpath: recached\n"; + eval { + $cached_elem->flush; + $cached_elem->unregister; + }; + # 新たなファイルハンドルを生成。 + $cached_elem = $make_writer->(); + if (defined $cached_elem) { + $cached_elem->register; + } + return $cached_elem; + } + } + else { + # キャッシュされていないので、ファイルハンドルを作ってキャッシュ。 + #print "$concrete_fpath: *cached*\n"; + my $cached_elem = + $this->{writer_cache}->{$channel} = + $make_writer->(); + if (defined $cached_elem) { + $cached_elem->register; + } + return $cached_elem; + } + } + else { + # キャッシュ無効。 + return $make_writer->(); + } + }->(); + if (defined $writer) { + $writer->reserve( + Tiarra::Encoding->new("$header $line\n",'utf8')->conv( + $this->config->charset || 'jis')); + } else { + # XXX: do warn with properly frequency + #RunLoop->shared_loop->notify_warn("can't write to $concrete_fpath: ". + # "$header $line"); + } +} + +sub flush_all_file_handles { + my $this = shift; + foreach my $cached_elem (values %{$this->{writer_cache}}) { + eval { + $cached_elem->flush; + }; + } +} + +sub destruct { + my $this = shift; + # 開いている全てのLog::Writerを閉じて、キャッシュを空にする。 + foreach my $cached_elem (values %{$this->{writer_cache}}) { + eval { + $cached_elem->flush; + $cached_elem->unregister; + }; + } + %{$this->{writer_cache}} = (); +} + +1; + +=pod +info: チャンネルやprivのログを取るモジュール。 +default: off +section: important + +# Log系のモジュールでは、以下のように日付や時刻の置換が行なわれる。 +# %% : % +# %Y : 年(4桁) +# %m : 月(2桁) +# %d : 日(2桁) +# %H : 時間(2桁) +# %M : 分(2桁) +# %S : 秒(2桁) + +# ログを保存するディレクトリ。Tiarraが起動した位置からの相対パス。~指定は使えない。 +directory: log + +# ログファイルの文字コード。省略されたらjis。 +charset: sjis + +# 各行のヘッダのフォーマット。省略されたら'%H:%M'。 +header: %H:%M:%S + +# ファイル名のフォーマット。省略されたら'%Y.%m.%d.txt' +filename: %Y.%m.%d.txt + +# ログファイルのモード(8進数)。省略されたら600 +mode: 600 + +# ログディレクトリのモード(8進数)。省略されたら700 +dir-mode: 700 + +# ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。 +command: privmsg,join,part,kick,invite,mode,nick,quit,kill,topic,notice + +# PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。 +distinguish-myself: 1 + +# 各ログファイルを開きっぱなしにするかどうか。 +# このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが +# ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを +# 別々のファイルにログを取るような場合には使うべきではありません。 +# 万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・ +# 新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が +# あります。limit の詳細については OS 等のドキュメントを参照してください。 +-keep-file-open: 1 + +# keep-file-open 時に各行ごとに flush するかどうか。 +# open/close の負荷は気になるが、ログは失いたくない人向け。 +# keep-file-open が有効でないなら無視され(1になり)ます。 +-always-flush: 0 + +# keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく +# 一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても +# 最近の発言はまだ書き込まれていない可能性がある。 +# syncを設定すると、即座にログをディスクに書き込むためのコマンドが追加される。 +# 省略された場合はコマンドを追加しない。 +sync: sync + +# 各チャンネルの設定。チャンネル名の部分はマスクである。 +# 個人宛てに送られたPRIVMSGやNOTICEはチャンネル名"priv"として検索される。 +# 記述された順序で検索されるので、全てのチャンネルにマッチする"*"などは最後に書かなければならない。 +# 指定されたディレクトリが存在しなかったら、Log::Channelはそれを勝手に作る。 +# フォーマットは次の通り。 +# channel: <ディレクトリ名> (<チャンネル名> / 'priv') +# 例: +# filename: %Y.%m.%d.txt +# channel: IRCDanwasitu #IRC談話室@ircnet +# channel: others * +# この例では、#IRC談話室@ircnetのログはIRCDanwasitu/%Y.%m.%d.txtに、 +# それ以外(privも含む)のログはothers/%Y.%m.%d.txtに保存される。 +channel: priv priv +channel: others * +=cut diff -urN /non-existant-dir/module/Log/ChannelList.pm tiarra-20050322/module/Log/ChannelList.pm --- /non-existant-dir/module/Log/ChannelList.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Log/ChannelList.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,192 @@ +# ----------------------------------------------------------------------------- +# $Id: ChannelList.pm 803 2005-02-28 22:41:29Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Log::ChannelList; +use strict; +use warnings; +use base qw(Module); +use Template; +use Mask; +use NumericReply; +use RunLoop; +use IO::File; +use Tiarra::Encoding; +use Tools::DateConvert; +use Module::Use qw(Tools::DateConvert); + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{networks} = []; + $this->{unijp} = Tiarra::Encoding->new; + + $this->_init; +} + +sub _init { + my $this = shift; + + foreach ($this->config->networks('all')) { + my ($filename,$mask,$block) = split /\s+/; + if (!defined($filename) || $filename eq '' || + !defined($mask) || $mask eq '' || + !defined($block) || $block eq '') { + die "Illegal definition in __PACKAGE__/networks : $_\n"; + } + push @{$this->{networks}},[$filename,$mask,$block]; + } + + return $this; +} + +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + + if ($io->isa('IrcIO::Server')) { + if ($type eq 'out' && + $msg->command eq 'LIST' && + !defined $msg->param(0)) { + $io->remark('fetching-list', 1); + my $network = $this->_search_network($io->network_name); + if (defined $network) { + my $config = $this->config->get($network->[2], 'block'); + if (defined $config && + defined $config->template && $config->template ne '') { + my $template = Template->new($config->template); + if (defined $template) { + $io->remark(__PACKAGE__."/template", $template); + $io->remark(__PACKAGE__."/config", $config); + } + } + } + } elsif ($type eq 'in' && + $msg->command eq RPL_LIST) { + my $template = $io->remark(__PACKAGE__."/template"); + my $config = $io->remark(__PACKAGE__."/config"); + if (defined $template) { + if (Mask::match_array([ + Mask::array_or_default( + '*', + $config->mask('all'), + )], $msg->param(1))) { + $template->channel->expand( + name => $this->_output_filter( + $config->charset, + $msg->param(1)), + users => $this->_output_filter( + $config->charset, + $msg->param(2)), + ); + if ($msg->param(2) ne '') { + $template->channel->topic->expand( + topic => $this->_output_filter( + $config->charset, + $msg->param(3)), + ); + $template->channel->topic->add; + } + $template->channel->add; + if (!defined $io->remark(__PACKAGE__."/starttime")) { + $io->remark(__PACKAGE__."/starttime", time()); + } + } + } + } elsif ($type eq 'in' && + $msg->command eq RPL_LISTEND) { + $io->remark('fetching-list', undef, 'delete'); + if ($io->remark(__PACKAGE__."/template")) { + my $network = $this->_search_network($io->network_name); + my $template = $io->remark(__PACKAGE__."/template"); + my $config = $io->remark(__PACKAGE__."/config"); + if (defined $network && defined $template) { + $template->expand( + fetch_starttime => + $this->_output_filter( + $config->charset, + Tools::DateConvert::replace( + $config->fetch_starttime || '', + $io->remark(__PACKAGE__."/starttime") || time, + )), + fetch_endtime => + $this->_output_filter( + $config->charset, + Tools::DateConvert::replace( + $config->fetch_endtime || '', + )), + ); + my $mode = do { + my $mode_conf = $config->mode; + if (defined $mode_conf) { + oct('0'.$mode_conf); + } + else { + 0600; + } + }; + my $fh = IO::File->new($network->[0], O_CREAT | O_WRONLY, $mode); + $fh->print($template->str); + $fh->truncate($fh->tell); + $fh->close; + } + $io->remark(__PACKAGE__."/template", undef, 'delete'); + $io->remark(__PACKAGE__."/config", undef, 'delete'); + $io->remark(__PACKAGE__."/starttime", undef, 'delete'); + } + } + } + return $msg; +} + +sub _output_filter { + my ($this, $charset, $str) = @_; + + $str =~ s/>/>/g; + $str =~ s/{unijp}->set($str)->$charset; +} + +sub _search_network { + my ($this, $network_name) = @_; + + foreach my $network (@{$this->{networks}}) { + if (Mask::match($network->[1], $network_name)) { + return $network; + } + } + return undef; +} + +1; + +=pod +info: チャンネルリストをテンプレートに沿って HTML 化します。 +default: off + +# list コマンドが実行された際に動作します。 + +# 出力したいファイル名、ネットワーク名、使う設定のブロックを指定します。。 +networks: ircnet.html ircnet ircnet + + +ircnet { + # テンプレートファイルを指定します。 + template: channellist.html.tmpl + + # 出力とテンプレートファイルの文字コードを指定します。 + charset: euc + + # 取得を開始/終了した時刻のフォーマットを指定します。 + fetch-starttime: %Y年%m月%d日 %H時%M分(日本時間) + fetch-endtime: %Y年%m月%d日 %H時%M分(日本時間) + + # 表示するチャンネルの mask を指定します。 + mask: * + mask: -re:^\&(AUTH|SERVICES|LOCAL|HASH|SERVERS|NUMERICS|CHANNEL|KILLS|NOTICES|ERRORS) + + # 出力するファイルのモードを指定します。 + mode: 644 +} +=cut diff -urN /non-existant-dir/module/Log/Logger.pm tiarra-20050322/module/Log/Logger.pm --- /non-existant-dir/module/Log/Logger.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Log/Logger.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,161 @@ +# ----------------------------------------------------------------------------- +# $Id: Logger.pm 761 2005-02-21 18:30:05Z topia $ +# ----------------------------------------------------------------------------- +package Log::Logger; +use strict; +use warnings; +use Multicast; + +sub new { + my ($class,$enstringed_callback,$exception_object,@exceptions) = @_; + # enstringed_callback: + # メッセージをログ文字列化した時に呼ばれる関数。CODE型。 + # 引数を二つ取り、一つ目はチャンネル名、二つ目はログ文字列。 + # exception_object: + # exceptionsで指定されたメソッドを呼ぶとき、どのオブジェクトで呼ぶか。 + # exceptions: + # 特定のメッセージのログ文字列化をオーバーライドする + # 'S_PRIVMSG'等。 + # 引数は(IRCMessage,IrcIO)、戻り値は[チャンネル名,ログ文字列]の配列 + my $this = { + enstringed => $enstringed_callback, + exception_object => $exception_object, + exceptions => do { + my %hash = map { $_ => 1 } @exceptions; + \%hash; + }, + }; + bless $this,$class; +} + +sub log { + my ($this,$msg,$sender) = @_; + my $prefix = do { + if ($sender->isa('IrcIO::Server')) { + 'S'; + } + elsif ($sender->isa('IrcIO::Client')) { + 'C'; + } + }; + my $method_name = "${prefix}_".$msg->command; + my @results; + # このメソッドはexceptionsで定義されているか？ + if (defined $this->{exceptions}->{$method_name}) { + eval { + @results = $this->{exception_object}->$method_name($msg,$sender); + }; if ($@) { + RunLoop->shared->notify_error($@); + } + } + else { + # このクラスにメソッドはあるか？ + if ($this->can($method_name)) { + eval { + @results = $this->$method_name($msg,$sender); + }; if ($@) { + RunLoop->shared->notify_error($@); + } + } + } + + foreach (@results) { + $this->{enstringed}->($_->[0],$_->[1]); + } +} + +sub S_JOIN { + my ($this,$msg,$sender) = @_; + + $msg->param(0) =~ m/^([^\x07]+)(?:\x07(.*))?/; + my ($ch_name,$mode) = ($1,(defined $2 ? $2 : '')); + $mode =~ tr/ov/@+/; + + [$msg->param(0), + sprintf('+ %s%s (%s) to %s', + $mode,$msg->nick,$msg->prefix,$msg->param(0))]; +} + +sub S_PART { + my ($this,$msg,$sender) = @_; + if (defined $msg->param(1)) { + [$msg->param(0), + sprintf('- %s from %s (%s)', + $msg->nick,$msg->param(0),$msg->param(1))]; + } else { + [$msg->param(0), + sprintf('- %s from %s', + $msg->nick,$msg->param(0))]; + } +} + +sub S_KICK { + my ($this,$msg,$sender) = @_; + # RFC2812には、「サーバはクライアントに複数のチャンネルやユーザのKICKメッセージを + # 送っては「いけません」。これは、古いクライアントソフトウェアとの下位互換のためです。」とある。 + [$msg->param(0), + sprintf('- %s by %s from %s (%s)', + $msg->param(1),$msg->nick,$msg->param(0),$msg->param(2))]; +} + +sub S_INVITE { + my ($this,$msg,$sender) = @_; + [$msg->param(1), + sprintf 'Invited by %s: %s',$msg->nick,$msg->param(1)]; +} + +sub S_MODE { + my ($this,$msg,$sender) = @_; + [$msg->param(0), + sprintf('Mode by %s: %s %s', + $msg->nick, + $msg->param(0), + join(' ',@{$msg->params}[1 .. ($msg->n_params - 1)]))]; +} + +sub S_NICK { + my ($this,$msg,$sender) = @_; + my $network_name = $sender->network_name; + my $line = do { + sprintf( + do { + if ($msg->param(0) eq $sender->current_nick) { + 'My nick is changed (%s -> %s)'; + } + else { + '%s -> %s'; + } + }, + $msg->nick, + $msg->param(0)); + }; + my @result; + foreach my $ch_name (@{$msg->remark('affected-channels')}) { + push @result,[Multicast::attach($ch_name,$network_name), + $line]; + } + @result; +} + +*S_KILL = \&S_QUIT; +sub S_QUIT { + my ($this,$msg,$sender) = @_; + my $network_name = $sender->network_name; + my @result; + foreach my $ch_name (@{$msg->remark('affected-channels')}) { + push @result,[Multicast::attach($ch_name,$network_name), + sprintf '! %s (%s)',$msg->nick,$msg->param(0)]; + } + @result; +} + +sub S_TOPIC { + my ($this,$msg,$sender) = @_; + [$msg->param(0), + sprintf('Topic of channel %s by %s: %s', + $msg->param(0), + $msg->nick, + $msg->param(1))]; +} + +1; diff -urN /non-existant-dir/module/Log/Raw.pm tiarra-20050322/module/Log/Raw.pm --- /non-existant-dir/module/Log/Raw.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Log/Raw.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,309 @@ +# ----------------------------------------------------------------------------- +# $Id: Raw.pm 837 2005-03-12 09:24:24Z topia $ +# ----------------------------------------------------------------------------- +package Log::Raw; +use strict; +use warnings; +use IO::File; +use File::Spec; +use Tiarra::Encoding; +use base qw(Module); +use Module::Use qw(Tools::DateConvert Log::Writer); +use Tools::DateConvert; +use Log::Writer; +use ControlPort; +use Mask; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{matching_cache} = {}; # + $this->{writer_cache} = {}; # + $this->{sync_command} = do { + my $sync = $this->config->sync; + if (defined $sync) { + uc $sync; + } + else { + undef; + } + }; + $this; +} + +sub sync { + my $this = shift; + $this->flush_all_file_handles; + RunLoop->shared->notify_msg("Raw logs synchronized."); +} + +sub control_requested { + my ($this,$request) = @_; + if ($request->ID eq 'synchronize') { + $this->sync; + ControlPort::Reply->new(204,'No Content'); + } + else { + die ref($this)." received control request of unsupported ID ".$request->ID."\n"; + } +} + +sub message_arrived { + my ($this,$message,$sender) = @_; + + # syncは有効で、クライアントから受け取ったメッセージであり、かつ今回のコマンドがsyncに一致しているか？ + if (defined $this->{sync_command} && + $sender->isa('IrcIO::Client') && + $message->command eq $this->{sync_command}) { + # 開いているファイルを全てflush。 + # 他のモジュールも同じコマンドでsyncするかも知れないので、 + # do-not-send-to-servers => 1は設定するが + # メッセージ自体は破棄してしまわない。 + $this->sync; + $message->remark('do-not-send-to-servers',1); + return $message; + } + $message; +} + +sub message_io_hook { + my ($this,$message,$io,$type) = @_; + + # break with last + while (1) { + last unless $io->server_p; + last unless Mask::match_deep([Mask::array_or_all( + $this->config->command('all'))], $message->command); + my $msg = $message->clone; + if ($this->config->resolve_numeric && $message->command =~ /^\d{3}$/) { + $msg->command( + (NumericReply::fetch_name($message->command)||'undef'). + '('.$message->command.')'); + } + my $server = $io->network_name; + my $dirname = $this->_server_match($server); + if (defined $dirname) { + my $prefix = sprintf '(%s/%s) ', $server, do { + if ($type eq 'in') { + 'recv'; + } elsif ($type eq 'out') { + 'send'; + } else { + '----'; + } + }; + + my $charset = do { + if ($msg->have_raw_params) { + $msg->encoding_params('binary'); + 'binary'; + } elsif ($io->can('out_encoding')) { + $io->out_encoding; + } else { + $this->config->charset; + } + }; + $this->_write($server, $dirname, $msg->time, $prefix . + $msg->serialize($charset)); + } + last; + } + + return $message; +} + +sub _server_match { + my ($this,$server) = @_; + + my $cached = $this->{matching_cache}->{$server}; + if (defined $cached) { + if ($cached eq '') { + # cache of not found + return undef; + } + else { + return $cached; + } + } + + foreach my $line ($this->config->server('all')) { + my ($name, $mask) = split /\s+/, $line, 2; + if (Mask::match($mask,$server)) { + # マッチした。 + my $fname_format = $this->config->filename || '%Y.%m.%d.txt'; + my $fpath_format = $name."/$fname_format"; + + $this->{matching_cache}->{$server} = $fpath_format; + return $fpath_format; + } + } + $this->{matching_cache}->{$server} = ''; + undef; +} + +sub _write { + # 指定されたログファイルにヘッダ付きで追記する。 + # ディレクトリ名の日付のマクロは置換される。 + my ($this,$channel,$abstract_fpath,$time,$line) = @_; + my $concrete_fpath = do { + my $basedir = $this->config->directory; + if (defined $basedir) { + Tools::DateConvert::replace("$basedir/$abstract_fpath", $time); + } + else { + Tools::DateConvert::replace($abstract_fpath, $time); + } + }; + my $header = Tools::DateConvert::replace( + $this->config->header || '%H:%M', + $time, + ); + my $always_flush = do { + if ($this->config->keep_file_open) { + if ($this->config->always_flush) { + 1; + } else { + 0; + } + } else { + 1; + } + }; + # ファイルに追記 + my $make_writer = sub { + Log::Writer->shared_writer->find_object( + $concrete_fpath, + always_flush => $always_flush, + file_mode_oct => $this->config->mode, + dir_mode_oct => $this->config->dir_mode, + ); + }; + my $writer = sub { + # キャッシュは有効か？ + if ($this->config->keep_file_open) { + # このチャンネルはキャッシュされているか？ + my $cached_elem = $this->{writer_cache}->{$channel}; + if (defined $cached_elem) { + # キャッシュされたファイルパスは今回のファイルと一致するか？ + if ($cached_elem->uri eq $concrete_fpath) { + # このファイルハンドルを再利用して良い。 + #print "$concrete_fpath: RECYCLED\n"; + return $cached_elem; + } + else { + # ファイル名が違う。日付が変わった等の場合。 + # 古いファイルハンドルを閉じる。 + #print "$concrete_fpath: recached\n"; + eval { + $cached_elem->flush; + $cached_elem->unregister; + }; + # 新たなファイルハンドルを生成。 + $cached_elem = $make_writer->(); + if (defined $cached_elem) { + $cached_elem->register; + } + return $cached_elem; + } + } + else { + # キャッシュされていないので、ファイルハンドルを作ってキャッシュ。 + #print "$concrete_fpath: *cached*\n"; + my $cached_elem = + $this->{writer_cache}->{$channel} = + $make_writer->(); + if (defined $cached_elem) { + $cached_elem->register; + } + return $cached_elem; + } + } + else { + # キャッシュ無効。 + return $make_writer->(); + } + }->(); + if (defined $writer) { + $writer->reserve("$header $line\n"); + } else { + # XXX: do warn with properly frequency + #RunLoop->shared_loop->notify_warn("can't write to $concrete_fpath: ". + # "$header $line"); + } +} + +1; + +=pod +info: サーバとの生の通信を保存する +default: off + +# Log系のモジュールでは、以下のように日付や時刻の置換が行なわれる。 +# %% : % +# %Y : 年(4桁) +# %m : 月(2桁) +# %d : 日(2桁) +# %H : 時間(2桁) +# %M : 分(2桁) +# %S : 秒(2桁) + +# ログを保存するディレクトリ。Tiarraが起動した位置からの相対パス。~指定は使えない。 +directory: rawlog + +# 各行のヘッダのフォーマット。省略されたら'%H:%M'。 +header: %H:%M:%S + +# ファイル名のフォーマット。省略されたら'%Y.%m.%d.txt' +filename: %Y-%m-%d.txt + +# ログファイルのモード(8進数)。省略されたら600 +mode: 600 + +# ログディレクトリのモード(8進数)。省略されたら700 +dir-mode: 700 + +# 使っている文字コードがよくわからなかったときの文字コード。省略されたらutf8。 +# たぶんこの指定が生きることはないと思いますが……。 +charset: jis + +# NumericReply の名前を解決して表示する(ちゃんとした dump では無くなります) +resolve-numeric: 1 + +# ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。 +command: *,-ping,-pong + +# 各ログファイルを開きっぱなしにするかどうか。 +# このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが +# ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを +# 別々のファイルにログを取るような場合には使うべきではありません。 +# 万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・ +# 新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が +# あります。limit の詳細については OS 等のドキュメントを参照してください。 +-keep-file-open: 1 + +# keep-file-open 時に各行ごとに flush するかどうか。 +# open/close の負荷は気になるが、ログは失いたくない人向け。 +# keep-file-open が有効でないなら無視され(1になり)ます。 +-always-flush: 0 + +# keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく +# 一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても +# 最近の発言はまだ書き込まれていない可能性がある。 +# syncを設定すると、即座にログをディスクに書き込むためのコマンドが追加される。 +# 省略された場合はコマンドを追加しない。 +sync: sync + +# 各サーバの設定。サーバ名の部分はマスクである。 +# 記述された順序で検索されるので、全てのサーバにマッチする"*"などは最後に書かなければならない。 +# 指定されたディレクトリが存在しなかったら、勝手に作られる。 +# フォーマットは次の通り。 +# channel: <ディレクトリ名> <サーバ名マスク> +# 例: +# filename: %Y-%m-%d.txt +# server: ircnet ircnet +# server: others * +# この例では、ircnetのログはircnet/%Y.%m.%d.txtに、 +# それ以外のログはothers/%Y.%m.%d.txtに保存される。 +server: ircnet ircnet +server: others * +=cut diff -urN /non-existant-dir/module/Log/Recent.pm tiarra-20050322/module/Log/Recent.pm --- /non-existant-dir/module/Log/Recent.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Log/Recent.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,210 @@ +# ----------------------------------------------------------------------------- +# $Id: Recent.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package Log::Recent; +use strict; +use warnings; +use base qw(Module); +use Module::Use qw(Tools::DateConvert Log::Logger); +use Tools::DateConvert; +use Log::Logger; +use IRCMessage; +use Mask; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + # チャンネル管理の手間を省くため、チャンネルのログはChannelInfoのremarksに保存する。 + # privのログだけこのクラスで保持。 + $this->{priv_log} = []; # 中身は単なる文字列 + $this->{logger} = + Log::Logger->new( + sub { + $this->log(@_); + }, + $this, + 'S_PRIVMSG','C_PRIVMSG','S_NOTICE','C_NOTICE'); + $this->{hook} = IrcIO::Client::Hook->new( + sub { + my ($hook, $client, $ch_name, $network, $ch) = @_; + # no-recent-logs オプションが指定されていれば何もしない + return if defined $client->option('no-recent-logs'); + # ログはあるか？ + my $vec = $ch->remarks('recent-log'); + if (defined $vec) { + foreach my $elem (@$vec) { + $client->send_message( + IRCMessage->new( + Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(channel log)), + Command => 'NOTICE', + Params => [$ch_name,$elem->[1]])); + } + } + })->install('channel-info'); + $this; +} + +sub destruct { + my $this = shift; + $this->{hook} and $this->{hook}->uninstall; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + # Log::Recent/commandにマッチするか？ + if (Mask::match(lc($this->config->command) || '*', lc($msg->command))) { + $this->{logger}->log($msg,$sender); + } + $msg; +} + +sub client_attached { + my ($this,$client) = @_; + # no-recent-logs オプションが指定されていれば何もしない + return if defined $client->option('no-recent-logs'); + # まずはpriv + my $local_nick = RunLoop->shared->current_nick; + foreach my $elem (@{$this->{priv_log}}) { + $client->send_message( + IRCMessage->new( + Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv log)), + Command => 'NOTICE', + Params => [$local_nick,$elem->[1]])); # $elem->[0]は常に'priv' + } + + # 次に各チャンネル +# foreach my $network (values %{RunLoop->shared->networks}) { +# foreach my $ch (values %{$network->channels}) { +# # ログはあるか？ +# my $vec = $ch->remarks('recent-log'); +# if (defined $vec) { +# my $ch_name; +# foreach my $elem (@$vec) { +# $ch_name = +# RunLoop->shared->multi_server_mode_p ? +# $elem->[0] : $ch->name; +# $client->send_message( +# IRCMessage->new( +# Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(channel log)), +# Command => 'NOTICE', +# Params => [$ch_name,$elem->[1]])); +# } +# } +# } +# } +} + +*S_PRIVMSG = \&PRIVMSG_or_NOTICE; +*S_NOTICE = \&PRIVMSG_or_NOTICE; +*C_PRIVMSG = \&PRIVMSG_or_NOTICE; +*C_NOTICE = \&PRIVMSG_or_NOTICE; +sub PRIVMSG_or_NOTICE { + my ($this,$msg,$sender) = @_; + my $target = Multicast::detach($msg->param(0)); + my $is_priv = Multicast::nick_p($target); + my $cmd = $msg->command; + + my $line = do { + if ($is_priv) { + if ($sender->isa('IrcIO::Client')) { + sprintf( + $cmd eq 'PRIVMSG' ? '>%s< %s' : ')%s( %s', + $msg->param(0), + $msg->param(1)); + } + else { + sprintf( + $cmd eq 'PRIVMSG' ? '-%s- %s' : '=%s= %s', + $msg->nick || $sender->current_nick, + $msg->param(1)); + } + } + else { + my $format = do { + if ($this->config->distinguish_myself && $sender->isa('IrcIO::Client')) { + $cmd eq 'PRIVMSG' ? '>%s< %s' : ')%s( %s'; + } + else { + $cmd eq 'PRIVMSG' ? '<%s> %s' : '(%s) %s'; + } + }; + my $nick = do { + if ($sender->isa('IrcIO::Client')) { + RunLoop->shared_loop->network( + (Multicast::detatch($msg->param(0)))[1]) + ->current_nick; + } + else { + $msg->nick || $sender->current_nick; + } + }; + sprintf $format,$nick,$msg->param(1); + } + }; + + [$is_priv ? 'priv' : $msg->param(0),$line]; +} + +sub log { + my ($this,$ch_full,$log_line) = @_; + my $vec = do { + if ($ch_full eq 'priv') { + # privは自分で保存 + $this->{priv_log}; + } + else { + # privでなければChannelInfoに'recent-log'として保存。 + my ($ch_short,$network_name) = Multicast::detach($ch_full); + my $network = RunLoop->shared->network($network_name); + if (!defined $network) { + RunLoop->shared->notify_warn("errorness network name: $network_name"); + return; + } + my $ch = $network->channel($ch_short); + if (!defined $ch) { + return; + } + my $log_vec = $ch->remarks('recent-log'); + if (!defined $log_vec) { + $log_vec = []; + $ch->remarks('recent-log',$log_vec); + } + $log_vec; + } + }; + + my $header = Tools::DateConvert::replace( + $this->config->header || '%H:%M' + ); + + # ログに追加 + # 要素は[チャンネル名,ログ行] + push @$vec,[$ch_full,"$header $log_line"]; + + # 溢れた分を消す + if (@$vec > $this->config->line) { + splice @$vec,0,(@$vec - $this->config->line); + } +} + +1; + +=pod +info: クライアントを接続した時に、保存しておいた最近のメッセージを送る。 +default: off +section: important + +# クライアントオプションの no-recent-logs が指定されていれば送信しません。 + +# 各行のヘッダのフォーマット。省略されたら'%H:%M'。 +header: %H:%M:%S + +# ログをチャンネル毎に何行まで保存するか。省略されたら10。 +line: 15 + +# PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。 +distinguish-myself: 1 + +# どのメッセージを保存するか。省略されたら保存可能な全てのメッセージを保存する。 +command: privmsg,notice,topic,join,part,quit,kill +=cut diff -urN /non-existant-dir/module/Log/Writer/Base.pm tiarra-20050322/module/Log/Writer/Base.pm --- /non-existant-dir/module/Log/Writer/Base.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Log/Writer/Base.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,229 @@ +# ----------------------------------------------------------------------------- +# $Id: Base.pm 713 2004-10-31 15:39:28Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Log::Writer::Base; +use strict; +use warnings; +use Carp; +use Tiarra::Utils; +use base qw(Tiarra::Utils); + +# pure virtual function helper +sub not_implemented_error { + my ($class_or_this) = shift; + + die $class_or_this->name . '/' . (caller(1))[3] . + ': Please Implement this!'; +} + +# need override +sub new { + my ($class, $parent, $uri, %options) = @_; + + carp 'Cannot use undef on class, parent, and uri.' + if (grep {(!defined $_) ? 1 : ()} ($class, $parent, $uri)); + + my $this = { + refcount => 0, + parent => $parent, + + buffer => '', + always_flush => $class->first_defined($options{always_flush}, 1), + uri => $uri, + notify_cache => {}, + }; + + bless $this, $class; + $this; +} + +sub capability { + my ($class, $type, @args) = @_; + + # $type: + # - fallback: protocol support fallback + return 0; +} + +sub scheme { + my $class_or_this = shift; + + # please return scheme string(such as 'file') + ''; +} + +sub name { + my $class_or_this = shift; + + # please return protocol name + 'base (cannot use this directly)'; +} + +sub supported_schemes { + my $class_or_this = shift; + + # please return supported schemes + (); +} + +sub real_flush { + my $this = shift; + + $this->not_implemented_error; + 0; # please return bool(1: successful, 0: failed) +} + +sub real_destruct { + my ($this, $force) = @_; + + $this->not_implemented_error; + # optionally, you can warning if losing data. + # probably $force is useless, because usually does NOT call this + # on (!$this->can_remove && !$force). + # when $force is true, we will destroy instance even if return failed. + 0; # please return bool(1: successful, 0: failed) +} + +# base definition +sub first_defined { + shift->get_first_defined(@_); +} + +sub define_accessor { + # backward compat + shift->define_attr_accessor(0, @_); +} + +__PACKAGE__->define_attr_accessor(0, qw(buffer always_flush uri)); +__PACKAGE__->define_attr_getter(0, qw(refcount parent)); + +sub add_ref { ++(shift->{refcount}); } +sub release { --(shift->{refcount}); } +sub length { CORE::length(shift->buffer); } +sub clear { shift->buffer(''); } +sub has_data { shift->length > 0; } + +sub path { + my $this = shift; + + if (!defined $this->{path}) { + return undef if (!defined $this->{uri}); + my $scheme = $this->scheme; + return undef if (!defined $scheme); + ($this->{path} = $this->{uri}) =~ s|^\Q$scheme\E://||; + } + $this->{path}; +} + +sub register { + my $this = shift; + + $this->add_ref; + $this; +} + +sub unregister { + my $this = shift; + + $this->release; + if ($this->can_remove) { + return $this->destruct; + } else { + return 1; + } +} + +sub can_remove { + my $this = shift; + + return ($this->refcount <= 0 && !$this->has_data); +} + +sub reserve { + my ($this, $str) = @_; + + $this->{buffer} .= $str; + $this->flush if ($this->always_flush); +} +*write = \&reserve; +*print = \&reserve; + +sub flush { + my $this = shift; + + return 1 if !$this->has_data; + if ($this->real_flush) { + $this->destruct if ($this->can_remove); + return 1; + } else { + return 0; + } +} + +sub destruct { + my ($this, $force) = @_; + + my $ret = $this->real_destruct($force); + $this->parent->object_release($this->uri) if ($ret || $force); + $ret; +} + + +# util + +sub _notify_warn { + my ($this, $str) = @_; + + if ($this->_check_notify_cache($str)) { + $this->parent->notify_warn($this->_notify_prefix(1).$str); + } +} + +sub _notify_error { + my ($this, $str) = @_; + + if ($this->_check_notify_cache($str)) { + $this->parent->notify_error($this->_notify_prefix(1).$str); + } +} + +sub _notify_msg { + my ($this, $str) = @_; + + if ($this->_check_notify_cache($str)) { + $this->parent->notify_msg($this->_notify_prefix(1).$str); + } +} + +sub _check_notify_cache { + # check cache and return true if can notify + my ($this, $str) = @_; + + if (%{$this->{notify_cache}}) { + grep { + if ($this->{notify_cache}->{$_} < time) { + # expire + delete $this->{notify_cache}; + } + 0; + } keys %{$this->{notify_cache}}; + } + if ($this->{notify_cache}->{$str}) { + return 0; + } else { + # ignore 15sec + $this->{notify_cache}->{$str} = time + 15; + return 1; + } +} + +sub _notify_prefix { + my ($this, $stack_level) = @_; + + $stack_level = 0 if !defined $stack_level; + $this->name.'/'.(caller(1 + $stack_level))[3].'(' + .$this->uri.'): '; +} + +1; diff -urN /non-existant-dir/module/Log/Writer/File.pm tiarra-20050322/module/Log/Writer/File.pm --- /non-existant-dir/module/Log/Writer/File.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Log/Writer/File.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,123 @@ +# ----------------------------------------------------------------------------- +# $Id: File.pm 738 2005-01-07 03:11:10Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Log::Writer::File; +use strict; +use warnings; +use IO::File; +use File::Spec; +use Module::Use qw(Log::Writer::Base); +use Log::Writer::Base; +use base qw(Log::Writer::Base); + +sub new { + my ($class, $parent, $uri, %options) = @_; + my $this = $class->SUPER::new($parent, $uri, %options); + + $this->{file_mode} = $this->first_defined($options{file_mode}, + _oct($options{file_mode_oct}), + 0600); + $this->{dir_mode} = $this->first_defined($options{dir_mode}, + _oct($options{dir_mode_oct}), + 0700); + + $this; +} + +sub capability { + my ($class, $type, @args) = @_; + + my $supported = $class->SUPER::capability($type, @args); + return 1 if $supported; + if ($type eq 'fallback') { + return 1; + } + return 0; +} + +sub _file { + my $this = shift; + + if (!defined $this->{file}) { + $this->mkdirs($this->path); + $this->path =~ /^(.+)$/; # untaint + $this->{file} = IO::File->new($1, + O_CREAT | O_APPEND | O_WRONLY, + $this->file_mode); + } + $this->{file}; +} + +sub scheme { + 'file'; +} +*name = \&scheme; +*supported_schemes = \&scheme; + +__PACKAGE__->define_attr_accessor(0, qw(file_mode dir_mode)); + +sub real_flush { + my $this = shift; + + my $file = $this->_file; + if (!defined $file) { + $this->_notify_warn('can\'t open file'); + return 0; + } + + my $ret = 0; + my $size = 1; + while ($size && $this->has_data) { + # use buffer directly; perhaps reduce memory allocation + $size = $file->syswrite($this->{buffer}, $this->length); + if (defined $size) { + substr($this->{buffer}, 0, $size) = ''; + $ret = 1; + } else { + $this->_notify_warn($!); + } + } + return $ret; +} + +sub real_destruct { + my ($this, $force) = @_; + + # make useless efforts + $this->real_flush; + + if (!defined $this->has_data) { + $this->_notify_warn('has can\'t flush data; will lost!'); + } + if (defined $this->{file}) { + # not use ->file. we don't need new allocation. + $this->{file}->close; + } + return 1; +} + +sub _oct { + map { defined $_ ? oct("0$_") : undef } @_; +} + +sub mkdirs { + my ($this,$file) = @_; + my (undef,$directories,undef) = File::Spec->splitpath($file); + + # 直接の親が存在するか + if ($directories eq '' || -d $directories) { + # これ以上辿れないか、存在するので終了。 + return; + } + else { + # 存在しないので作成 + my @dirs = File::Spec->splitdir($directories); + foreach (0 .. (scalar @dirs - 2)) { + my $dir = File::Spec->catdir(@dirs[0 .. $_]); + mkdir $dir, $this->dir_mode unless (-d $dir); + } + } +} + +1; diff -urN /non-existant-dir/module/Log/Writer.pm tiarra-20050322/module/Log/Writer.pm --- /non-existant-dir/module/Log/Writer.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Log/Writer.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,218 @@ +# ----------------------------------------------------------------------------- +# $Id: Writer.pm 732 2004-12-29 07:57:35Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Log::Writer; +use strict; +use warnings; +use RunLoop; +use Carp; +use File::Spec; +use DirHandle; +use Tiarra::SharedMixin qw(shared shared_writer); +use Tiarra::WrapMainLoop; +use Tiarra::Utils; +our $_shared_instance; + +Tiarra::Utils->define_attr_getter(0, qw(mainloop)); +Tiarra::Utils->define_proxy('mainloop', 0, + map { ["_mainloop_$_", "lazy_$_"] } + qw(install uninstall)); + +# todo: +# - accept uri(maybe: ssh, syslog, ...) + +sub _new { + my $class = shift; + my ($this) = { + objects => {}, + schemes => {}, + protocols => {}, + fallbacks => [], + }; + bless $this, $class; + $this->{mainloop} = Tiarra::WrapMainLoop->new( + type => 'timer', + interval => 120, + closure => sub { $this->run; }); + + return $this; +} + +sub _initialize { + my $this = shift; + $this->load_all_protocols; +} + +sub find_object { + my ($this, $path, %options) = @_; + + my $object = $this->{objects}->{$path}; + if (defined($object)) { + # ファイルが存在したので返す。 + return $object; + } else { + # ファイルは存在しないので、登録して返す。 + return $this->_register_inner($path, %options); + } +} + +sub register { + my ($this, $path, %options) = @_; + + my $object = $this->find_object($path, %options); + if (defined $object) { + # ファイルを得られた。 + # 参照回数を増やして返す。 + $object->register; + return $object; + } else { + return undef; + } +} + +sub unregister { + my ($this, $path) = @_; + + my $object = $this->{objects}->{$path}; + if (defined $object) { + return $object->unregister; + } else { + croak('object "' . $path . '" has not registered yet!'); + } +} + +sub _register_inner { + my ($this, $path, %options) = @_; + + my $object; + my @classes; + if ($path =~ m|^([^:]+):|) { + if (defined $this->{schemes}->{$1}) { + push(@classes, @{$this->{schemes}->{$1}}); + } + } + push(@classes, @{$this->{fallbacks}}); + foreach my $class (@classes) { + $object = $class->new($this, $path, %options); + last if defined $object; + } + if (defined $object) { + $this->{objects}->{$path} = $object; + $this->_mainloop_install; + return $object; + } else { + return undef; + } +} + +sub run { + my ($this, $destruct) = @_; + + # do object + foreach my $key (keys %{$this->{objects}}) { + my $object = $this->{objects}->{$key}; + $object->flush; + $object->destruct(1) if $destruct; + } +} + +sub destruct { + shared_writer->run(1); + shared_writer->{mainloop} = undef; +} + +sub object_release { + my ($this, $path) = @_; + + delete $this->{objects}->{$path}; + + if (!(%{$this->{objects}})) { + $this->_mainloop_uninstall; + } +} + + +# protocol +sub load_all_protocols { + my $class_or_this = shift; + my $this = $class_or_this->_this; + + my $pkg_dir = File::Spec->catdir(split(/::/, ref($this))); + foreach (@INC) { + my $dir = File::Spec->catdir($_, $pkg_dir); + my $dh = DirHandle->new($dir); + if (defined $dh) { + my $path; + foreach my $file ($dh->read) { + $path = File::Spec->catdir($dir, $file); + next if !-r $path || -d $path; + next if $file !~ /^(.+)\.pm$/; + $this->load_protocol(ref($this).'::'.$1); + } + } + } +} + +sub load_protocol { + my ($class_or_this, $pkg) = @_; + my $this = $class_or_this->_this; + + return 1 if $this->{protocols}->{$pkg}; + eval 'use ' . $pkg; + if ($@) { + $this->notify_error("load protocol($pkg) error: $@"); + return undef; + } + eval 'use Module::Use ($pkg);'; + if ($@) { + $this->notify_error("regist using protocol($pkg) error: $@"); + return undef; + } + + foreach my $scheme ($pkg->supported_schemes) { + push(@{$this->{schemes}->{$scheme}}, $pkg); + } + if ($pkg->capability('fallback')) { + push(@{$this->{fallbacks}}, $pkg); + } + $this->{protocols}->{$pkg} = 1; + return 1; +} + +sub unload_protocol { + my ($class_or_this, $pkg) = @_; + my $this = $class_or_this->_this; + + return 0 if !$this->{protocols}->{$pkg}; + if ($pkg->capability('fallback')) { + @{$this->{fallbacks}} = grep $_ ne $pkg, @{$this->{fallbacks}}; + } + foreach my $scheme ($pkg->supported_schemes) { + @{$this->{schemes}->{$scheme}} = grep $_ ne $pkg, + @{$this->{schemes}->{$scheme}}; + } + delete $this->{protocols}->{$pkg}; + return 1; +} + +# util +sub notify_warn { + my ($this, $str) = @_; + + RunLoop->shared_loop->notify_warn($str); +} + +sub notify_error { + my ($this, $str) = @_; + + RunLoop->shared_loop->notify_error($str); +} + +sub notify_msg { + my ($this, $str) = @_; + + RunLoop->shared_loop->notify_msg($str); +} + +1; diff -urN /non-existant-dir/module/Skelton.pm tiarra-20050322/module/Skelton.pm --- /non-existant-dir/module/Skelton.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Skelton.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,148 @@ +# ----------------------------------------------------------------------------- +# $Id: Skelton.pm 525 2004-09-07 03:47:24Z topia $ +# ----------------------------------------------------------------------------- +# モジュールのスケルトン。 +# ----------------------------------------------------------------------------- +package Skelton; +use strict; +use warnings; +use base qw(Module); + +sub new { + my $class = shift; + # モジュールが必要になった時に呼ばれる。 + # これはモジュールのコンストラクタである。 + # 引数は無し。 + my $this = $class->SUPER::new(@_); + + return $this; +} + +sub destruct { + my $this = shift; + # モジュールが不要になった時に呼ばれる。 + # これはモジュールのデストラクタである。このメソッドが呼ばれた後はDESTROYを除いて + # いかなるメソッドも呼ばれる事が無い。タイマーを登録した場合は、このメソッドが + # 責任を持ってそれを解除しなければならない。 + # 引数は無し。 +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + # サーバーまたはクライアントからメッセージが来た時に呼ばれる。 + # 戻り値はIRCMessageまたはその配列またはundef。 + # + # $msg : + # 内容: IRCMessageオブジェクト + # サーバーから、またはクライアントから送られてきたメッセージ。 + # モジュールはこのオブジェクトをそのまま返しても良いし、 + # 改変して返しても良いし何も返さなくても良いし二つ以上返しても良い。 + # $sender : + # 内容: IrcIOオブジェクト + # このメッセージを発したIrcIO。サーバーまたはクライアントである。 + # メッセージがサーバーから来たのかクライアントから来たのかは + # $sender->isa('IrcIO::Server')などとすれば判定出来る。 + # + # サーバー→クライアントの流れでも、Prefixを持たないメッセージを + # 流しても構わない。逆に言えば、そのようなメッセージが来ても + # 問題が起こらないようにモジュールを設計しなければならない。 + return $msg; +} +## Auto::Utils::generate_reply_closures を使う場合。 +# sub message_arrived { +# my ($this,$msg,$sender) = @_; +# my @result = ($msg); +# +# if ($msg->command eq 'PRIVMSG') { +# my ($reply,$reply_as_priv,$get_raw_ch_name,$reply_anywhere,$get_full_ch_name) +# = Auto::Utils::generate_reply_closures($msg,$sender,\@result); +# +# $reply_anywhere->('Hello, #(name|default_name)', +# 'default_name' => '(your name)'); +# if ($get_raw_ch_name->() eq '#Tiarra_testing') { +# # なんらかの処理 +# } +# if ($get_full_ch_name->() eq '#Tiarra_testing@LocalServer') { +# # なんらかの処理 +# } +# } +# return @result; +# } +# + +sub client_attached { + my ($this,$client) = @_; + # クライアントが新規に接続した時に呼ばれる。 + # 戻り値は無し。 + # + # $client : + # 内容: IrcIO::Clientオブジェクト + # 接続されたクライアント。 +} + +sub client_detached { + my ($this,$client) = @_; + # クライアントが切断した時に呼ばれる。 + # 戻り値は無し。 + # + # $client : + # 内容: IrcIO::Clientオブジェクト + # 切断したクライアント。 +} + +sub connected_to_server { + my ($this,$server,$new_connection) = @_; + # サーバーに接続した時に呼ばれる。 + # 戻り値は無し。 + # + # $server : + # 内容: IrcIO::Serverオブジェクト + # 接続したサーバー。 + # $new_connection : + # 内容: 真偽値 + # 新規の接続なら1。切断後の自動接続ではundef。 +} + +sub disconnected_from_server { + my ($this,$server) = @_; + # サーバーから切断した(或いはされた)時に呼ばれる。 + # 戻り値は無し。 + # + # $server : + # 内容: IrcIO::Serverオブジェクト + # 切断したサーバー。 +} + +sub message_io_hook { + my ($this,$message,$io,$type) = @_; + # サーバーから受け取ったメッセージ、サーバーに送るメッセージ、 + # クライアントから受け取ったメッセージ、クライアントに送るメッセージは + # このメソッドで各モジュールに通知される。メッセージの変更も可能で、 + # 戻り値のルールはmessage_arrivedと同じ。 + # + # 通常のモジュールはこのメソッドを実装する必要は無い。 + # + # $message : + # 内容: IRCMessageオブジェクト + # 送受信しているメッセージ + # $io : + # 内容: IrcIO::Server又はIrcIO::Clientオブジェクト + # 送受信を行っているIrcIO + # $type : + # 内容: 文字列 + # 'in'なら受信、'out'なら送信 + return $message; +} + +sub control_requested { + my ($this,$request) = @_; + # 外部コントロールプログラムからのメッセージが来た。 + # 戻り値はControlPort::Reply。 + # + # $request: + # 内容 : ControlPort::Request + # 送られたリクエスト + die "This module doesn't support controlling.\n"; +} + +1; diff -urN /non-existant-dir/module/System/Error.pm tiarra-20050322/module/System/Error.pm --- /non-existant-dir/module/System/Error.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/Error.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,38 @@ +# ----------------------------------------------------------------------------- +# $Id: Error.pm 493 2004-08-22 06:16:37Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package System::Error; +use strict; +use warnings; +use base qw(Module); + +sub message_io_hook { + my ($this,$message,$io,$type) = @_; + + if ($io->isa('IrcIO::Client') && + $type eq 'out' && + $message->command eq 'ERROR' && + !$message->remark('send-error-as-is-to-client')) { + $message->param(1, $message->serialize); + $message->param(0, RunLoop->shared_loop->current_nick); + $message->command('NOTICE'); + } + + return $message; +} + +1; + +=pod +info: サーバーからのERRORメッセージをNOTICEに埋め込む +default: on + +# これをoffにするとクライアントにERRORメッセージがそのまま送られます。 +# クライアントとの間ではERRORメッセージは主に切断警告に使われており、 +# そのまま流してしまうとクライアントが混乱する可能性があります。 +# 設定項目はありません。 + +# このモジュールを回避してERRORメッセージをクライアントに送りたい場合は、 +# remarkのsend-error-as-is-to-clientを指定してください。 +=cut diff -urN /non-existant-dir/module/System/Inflate/Gzip.pm tiarra-20050322/module/System/Inflate/Gzip.pm --- /non-existant-dir/module/System/Inflate/Gzip.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/Inflate/Gzip.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,76 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: Gzip.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package System::Inflate::Gzip; +use strict; +use warnings; +use Carp; +use base qw(System::Inflate::Zlib); + +sub new { + my ($obj) = $_[0]->SUPER::new(@_); + + $obj->{accept} = 'gzip'; + + return $obj; +} + +sub setup { + my ($this, $parent) = @_; + + foreach my $compressor qw(gzip) { + $parent->{compressor}->{$compressor} = $this; + $this->{parent} = $parent; + } + + return $parent; +} + +sub init { + my ($this, $datas, $data_chunk) = @_; + my $ret = $this->SUPER::init($datas, $data_chunk); + + if ($ret == $this->parent->COMP_OK) { + $datas->{data} = + { + crc32 => undef, + len => undef, + data_len => 0, + data_crc32 => undef, + }; + $datas->{lasterr} = Compress::Zlib::_removeGzipHeader($data_chunk); + return undef if $datas->{lasterr} != $this->{Z_OK}; + return $this->parent->COMP_OK if $datas->{lasterr} == $this->{Z_OK}; + return $this->parent->COMP_OTHER_ERR; + } else { + return $ret; + } +} + +sub inflate { + my ($this, $datas, $data_chunk) = @_; + my ($ret, $err); + + ($ret, $err) = $this->SUPER::inflate($datas, $data_chunk); + + $datas->{data}->{data_len} += length($ret); + $datas->{data}->{data_crc32} = Compress::Zlib::crc32($ret, $datas->{data}->{data_crc32}); + if ($datas->{lasterr} == $this->{Z_STREAM_END}) { + ($datas->{data}->{crc32}, $datas->{data}->{len}) = unpack ("VV", substr($$data_chunk, 0, 8)); + substr($$data_chunk, 0, 8) = ''; + } + return ($ret, $err); +} + +sub check { + my ($this, $datas) = @_; + my ($compdata) = $datas->{data}; + + return undef unless defined($compdata->{len}) && defined($compdata->{crc32}); + return $this->parent->COMP_DATA_ERROR unless + ($compdata->{len} == $compdata->{data_len}) && ($compdata->{crc32} == $compdata->{data_crc32}); + return $this->parent->COMP_OK; +} +1; diff -urN /non-existant-dir/module/System/Inflate/Zlib.pm tiarra-20050322/module/System/Inflate/Zlib.pm --- /non-existant-dir/module/System/Inflate/Zlib.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/Inflate/Zlib.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,74 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: Zlib.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package System::Inflate::Zlib; +use strict; +use warnings; +use Carp; +use Compress::Zlib; + +sub new { + my ($class) = @_; + my $obj = + { + Z_OK => Compress::Zlib::Z_OK(), + Z_STREAM_END => Compress::Zlib::Z_STREAM_END(), + Z_DATA_ERROR => Compress::Zlib::Z_DATA_ERROR(), + accept => 'inflate' + }; + bless $obj,$class; + return $obj; +} + +sub setup { + my ($this, $parent) = @_; + + foreach my $compressor qw(inflate) { + $parent->{compressor}->{$compressor} = $this; + $this->{parent} = $parent; + } + + return $parent; +} + +sub parent { + return shift->{parent}; +} + +sub init { + my ($this, $datas, $data_chunk) = @_; + + ($datas->{stream}, $datas->{lasterr}) = + Compress::Zlib::inflateInit(-WindowBits => - Compress::Zlib::MAX_WBITS()); + return undef if $datas->{lasterr} != $this->{Z_OK}; + return $this->parent->COMP_OK if $datas->{lasterr} == $this->{Z_OK}; + return $this->parent->COMP_OTHER_ERR; +} + +sub inflate { + my ($this, $datas, $data_chunk) = @_; + my ($ret); + + carp('not initialized!') if !defined $datas->{stream}; + ($ret, $datas->{lasterr}) = $datas->{stream}->inflate($data_chunk); + $datas->{stream} = undef if $datas->{lasterr} != $this->{Z_OK}; + return ($ret, $this->parent->COMP_OK) if $datas->{lasterr} == $this->{Z_OK}; + return ($ret, $this->parent->COMP_STREAM_END) if $datas->{lasterr} == $this->{Z_STREAM_END}; + return (undef, $this->parent->COMP_OTHER_ERR); +} + +sub check { + my ($this, $datas) = @_; + + return 1; +} + +sub final { + my ($this) = @_; + + return $this->parent->COMP_OK; +} + +1; diff -urN /non-existant-dir/module/System/Inflate.pm tiarra-20050322/module/System/Inflate.pm --- /non-existant-dir/module/System/Inflate.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/Inflate.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,132 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: Inflate.pm 533 2004-09-07 10:13:14Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package System::Inflate; +use strict; +use warnings; +use Carp; + +use Tiarra::SharedMixin; +our $_shared_instance; + +sub _new { + my ($class) = @_; + my $obj = + { + datas => {}, # HASH; HASH key is [tag] + # compressor: stream compressor + # stream : stream object + # lasterr : last error infomation + # data : compressor dependent datas + compressor => {}, # HASH; compressor name => Process Classes + const => + { + COMP_OK => 0, + COMP_STREAM_END => 1, + COMP_DATA_ERR => -1, + COMP_OTHER_ERR => -2 + } + }; + bless $obj,$class; + + return $obj->_setup(); +} + +sub _setup { + my ($this) = @_; + + foreach my $classname (map {'System::Inflate::' . $_} qw(Zlib Gzip)) { + eval 'use ' . $classname; + unless ($@) { + eval $classname . '::setup(new ' . $classname . '(), $this)'; + if ($@) { + print "------can't load $classname\n$@------\n"; + } + } else { + print "------can't load $classname\n$@------\n"; + } + } + + return $this; +} + +sub get_compclass { + my ($this, $compressor) = @_; + my ($compclass) = $this->shared->{compressor}->{$compressor}; + + croak('compressor ' . $compressor . ' is not initialized!') unless defined $compclass; + + return $compclass +} + +sub get_data_struct { + my ($this, $tag) = @_; + my ($datas) = $this->shared->{datas}->{$tag}; + + croak('tag ' . $tag . ' is not initialized!') unless defined $datas; + + return $datas; +} + +sub get_lasterr { + my ($this, $tag) = @_; + return $this->get_data_struct($tag)->{lasterr}; +} + +sub COMP_OK { + return shift->{const}->{COMP_OK}; +} + +sub COMP_STREAM_END { + return shift->{const}->{COMP_STREAM_END}; +} + +sub COMP_OTHER_ERR { + return shift->{const}->{COMP_OTHER_ERR}; +} + +sub COMP_DATA_ERR { + return shift->{const}->{COMP_DATA_ERR}; +} + +sub init { + my ($this, $tag, $compressor, $data_chunk) = @_; + my ($datas) = $this->shared->{datas}->{$tag} = + { + stream => undef, + compressor => $compressor, + lasterr => undef, + data => {} + }; + + return $this->get_compclass($compressor)->init($datas, $data_chunk); +} + +sub inflate { + my ($this, $tag, $data_chunk) = @_; + my ($datas) = $this->get_data_struct($tag); + + return $this->get_compclass($datas->{compressor})->inflate($datas, $data_chunk); +} + +sub check { + my ($this, $tag) = @_; + my ($datas) = $this->get_data_struct($tag); + + return $this->get_compclass($datas->{compressor})->check($datas); +} + +sub final { + my ($this, $tag) = @_; + my ($datas) = $this->get_data_struct($tag); + + # ordinary void function + my $ret = $this->shared->{compressor}->{$datas->{compressor}}->final($datas); + return undef unless defined $ret; # return value is undef; maybe can't finalize.... + delete $this->shared->{datas}->{$tag}; + return $ret; +} + +1; diff -urN /non-existant-dir/module/System/Macro.pm tiarra-20050322/module/System/Macro.pm --- /non-existant-dir/module/System/Macro.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/Macro.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,68 @@ +# ----------------------------------------------------------------------------- +# $Id: Macro.pm 540 2004-09-10 08:29:31Z topia $ +# ----------------------------------------------------------------------------- +package System::Macro; +use strict; +use warnings; +use base qw(Module); +use Multicast; +use IRCMessage; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{macros} = $this->hash; # コマンド => ARRAY<動作(IRCMessage)> + $this; +} + +sub hash { + my $this = shift; + my $macros = {}; + foreach ($this->config->macro('all')) { + my ($command,$action) = (m/^(.+?)\s+(.+)$/); + $command = uc($command); + + my $action_msg = IRCMessage->new( + Line => $action, + Encoding => 'utf8'); + my $array = $macros->{$command}; + if (defined $array) { + push @$array,$action_msg; + } + else { + $macros->{$command} = [$action_msg]; + } + } + $macros; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->isa('IrcIO::Client')) { + my $actions = $this->{macros}->{$msg->command}; + if (defined $actions) { + foreach (@$actions) { + Multicast::from_client_to_server($_, $sender); + } + # このメッセージは鯖に送らない。 + $msg->remark('do-not-send-to-servers',1); + } + } + + $msg; +} + +1; + +=pod +info: 新規にコマンドを追加し、そのコマンドが使われた時に特定の動作をまとめて実行します。 +default: off + +# 書式: <コマンド> <動作> +# コマンド"switch"を追加して、それが使われると +# #a@ircnet,#b@ircnet,#c@ircnetにjoinして、 +# #d@ircnet,#e@ircnet,#f@ircnetからpartする例。 +-macro: switch join #a@ircnet,#b@ircnet,#c@ircnet +-macro: switch part #d@ircnet,#e@ircnet,#f@ircnet +=cut diff -urN /non-existant-dir/module/System/NotifyIcon/Win32.pm tiarra-20050322/module/System/NotifyIcon/Win32.pm --- /non-existant-dir/module/System/NotifyIcon/Win32.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/NotifyIcon/Win32.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,456 @@ +# ----------------------------------------------------------------------------- +# $Id: Win32.pm 803 2005-02-28 22:41:29Z topia $ +# ----------------------------------------------------------------------------- +# use shell notify-icon +# based on win32::TaskTray.pm (超ベータVer) by Noboruhi +# ----------------------------------------------------------------------------- +package System::NotifyIcon::Win32; +use strict; +use warnings; +use base qw(Module); +use Win32::GUI (); # non-default +use RunLoop; +use Timer; +use Tiarra::Encoding; +our $AUTOLOAD; +my $can_use_win32api; +BEGIN { + eval q{ use Win32::API; }; + $can_use_win32api = ($@) ? 0 : 1; +} +my $tooltip_length = 64; + +my $event_handler_prefix = 'Win32Event_'; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + + # 日本語等を使うためには文字コード変換しないといけないと思います。 + # 気をつけてください。 + + # メインウィンドウ(現時点ではダミー) + $this->_event_handler_init; + $this->{main_window} = Win32::GUI::Window->new( + -name => __PACKAGE__ . '::MainWindow', + -text => 'Tiarra GUI', + -width => 200, + -height => 200); + + # コンテキストメニュー + $this->event_handler_register('NotifyIcon_Popup_exit_Click'); + $this->event_handler_register('NotifyIcon_Popup_reload_Click'); + $this->{popup_menu} = Win32::GUI::Menu->new( + "" => __PACKAGE__ . '::NotifyIcon_Popup', + " > &Exit" => { -name => __PACKAGE__ . '::NotifyIcon_Popup_exit' }, + " > -" => 0, + " > Re&load" => { -name => __PACKAGE__ . '::NotifyIcon_Popup_reload', -default => 1 }, + ); + + $this->{window_stat} = 1; # start with show + $this->{console_window} = Win32::GUI::GetPerlWindow(); + + # タスクトレイ登録 + if (defined $this->config->iconfile) { + $this->{icon} = new Win32::GUI::Icon($this->config->iconfile); + } + $this->event_handler_register('NotifyIcon_Click'); + $this->event_handler_register('NotifyIcon_RightClick'); + $this->{notify_icon} = $this->{main_window}->AddNotifyIcon( + -name => __PACKAGE__ . '::NotifyIcon', + (defined $this->{icon} ? (-icon => $this->{icon}) : ())); + + if (defined $this->config->hide_console_on_load && + $this->config->hide_console_on_load) { + $this->Win32Event_NotifyIcon_Click(); + } + + if ($can_use_win32api) { + $this->{notifyicondata_version} = $this->init_win32_api(); + ::debug_printmsg(__PACKAGE__.": use notify_icondata version ". + $this->{notifyicondata_version}); + } + + $this->modify_notifyicon_tooltip(); + $this->{set_nick_hook} = RunLoop::Hook->new( + sub { + my ($hook) = shift; + + $this->modify_notifyicon_tooltip(); + })->install('set-current-nick'); + + return $this; +} + +sub modify_notifyicon_tooltip { + my ($this, $tooltip) = @_; + $tooltip = (defined $tooltip ? "$tooltip - " : ""); + $tooltip .= sprintf("Tiarra #%s\n%s@%d\n", + ::version(), + RunLoop->shared_loop->current_nick, + Configuration->shared_conf->get('general')->tiarra_port, + ); + if (defined RunLoop->shared_loop->sysmsg_prefix(qw(system))) { + $tooltip .= RunLoop->shared_loop->sysmsg_prefix(qw(system)); + } + if (length($tooltip) >= $tooltip_length) { + substr($tooltip,$tooltip_length - 1) = ''; + } + if (!$can_use_win32api || $this->{notifyicondata_version} <= 1) { + # This is internal API! + Win32::GUI::NotifyIcon::Modify($this->{notify_icon}->{-handle}, + -id => $this->{notify_icon}->{-id}, + -tip => $tooltip); + } else { + my ($struct,$ret); + + # setversion + $struct = Win32::API::Struct->new($this->{struct}->{NOTIFYICONDATA}); + $struct->{cbSize} = $struct->sizeof; + $struct->{hWnd} = $this->{notify_icon}->{-handle}; + $struct->{uID} = $this->{notify_icon}->{-id}; + $struct->{uTimeout_or_Version} = $this->{define}->{NOTIFYICON_VERSION}; + $ret = $this->{func}->{Shell_NotifyIcon}->Call( + $this->{define}->{NIM_SETVERSION}, + $struct); + if (!$ret) { + ::debug_printmsg('Shell_NotifyIcon setversion return error:'. + sprintf('%x',$ret)); + }; + + # modify + use Data::Dumper; + ::debug_printmsg(Dumper([$tooltip, substr($tooltip,0,64)])); + $struct = Win32::API::Struct->new($this->{struct}->{NOTIFYICONDATA}); + $struct->{cbSize} = $struct->sizeof; + $struct->{hWnd} = $this->{notify_icon}->{-handle}; + $struct->{uID} = $this->{notify_icon}->{-id}; + $struct->{uFlags} |= $this->{define}->{NIF_TIP}; + if ($this->{is_unicode}) { + $tooltip = Tiarra::Encoding->new($tooltip,'utf8')->utf16; + # reverse endian + $tooltip = pack('n*', unpack('v*', $tooltip)); + } + $struct->{szTip} = $tooltip; + $struct->{uFlags} |= $this->{define}->{NIF_STATE}; + $struct->{dwState} = $this->{define}->{NIS_SHAREDICON}; + $struct->{dwStateMask} = $this->{define}->{NIS_SHAREDICON}; + #$struct->{uFlags} |= $this->{define}->{NIF_ICON}; + #$struct->{hIcon} = $this->{icon}->{-handle}; + #::debug_printmsg(Data::Dumper->Dump([$struct->Pack], [qw(struct)])); + $ret = $this->{func}->{Shell_NotifyIcon}->Call( + $this->{define}->{NIM_MODIFY}, + $struct); + if (!$ret) { + ::debug_printmsg('Shell_NotifyIcon setversion return error:'. + sprintf('%x',$ret)); + }; + } +} + +sub destruct { + my $this = shift; + + $this->uninstall_hook('set_nick_hook'); + undef $this->{main_window}->{-notifyicons}{$this->{notify_icon}->{-id}}; + undef $this->{main_window}->{$this->{notify_icon}->{-name}}; + undef $this->{notify_icon}; + # This is internal API! but WIn32::GUI doesn't call this...(commented out) + eval { Win32::GUI::DestroyWindow($this->{main_window}->{-handle}) }; + undef $this->{main_window}; + undef $this->{popup_menu}; + undef $this->{icon}; + # 終了時にはかならず表示させる + Win32::GUI::Show($this->{console_window}); + undef $this->{shell_notifyicon_func}; + $this->_event_handler_destruct; +} + +sub _event_handler_init { + my $this = shift; + + # 先に定義を必要とするのか、うまく動かない + my $autoload = sub { + my (@args) = @_; + + if ($AUTOLOAD =~ /::DESTROY$/) { + # DESTROYは伝達させない。 + return; + } + + (my $method = $AUTOLOAD) =~ s/.+?:://g; + + # define method + $this->event_handler_register($method); + + no strict 'refs'; + goto &$AUTOLOAD; + }; + *AUTOLOAD = $autoload; + + $this->{timer} = Timer->new( + Repeat => 1, + After => ((defined $this->config->interval) ? $this->config->interval : 2), + Code => sub { + my $timer = shift; + # noop + })->install; + $this->{hook} = RunLoop::Hook->new( + sub { + my $hook = shift; + + no warnings; + Win32::GUI::DoEvents(); + $this->{timer}->reset(); + } + )->install('after-select'); + + return $this; +} + +# uninstall hook or timer +sub uninstall_hook { + my ($this, $name) = @_; + + if (defined $this->{$name}) { + $this->{$name}->uninstall; + delete $this->{$name}; + } +} + +sub event_handler_register { + my $this = shift; + + map { + my $method = $_; + if ($method =~ /^\Q$event_handler_prefix\E/) { + warn ("$method is already have $event_handler_prefix prefix."); + next; + } + $this->{registered_event_handlers}->{$method} = 1; + #::debug_printmsg(__PACKAGE__ . '/register_event_handler: ' . $method); + my $sub = sub { + no strict 'refs'; + unshift(@_, $this); + eval "$event_handler_prefix$method(\@_)"; + }; + eval "*$method = \$sub"; + } @_; + + return $this; +} + +sub event_handler_unregister { + my $this = shift; + + foreach my $name (@_) { + if (exists $this->{registered_event_handlers}->{$_}) { + eval "undef *$name"; + delete $this->{registered_event_handlers}->{$_}; + } + }; + + return $this; +} + +sub _event_handler_destruct { + my $this = shift; + + $this->event_handler_unregister(keys %{$this->{registered_event_handlers}}); + $this->{registered_event_handlers} = {}; + undef *AUTOLOAD; + + $this->uninstall_hook('timer'); + $this->uninstall_hook('hook'); +} + + +# NotifyIcon 用のイベントハンドラ +sub Win32Event_NotifyIcon_Click { + my $this = shift; + + $this->{window_stat} = $this->{window_stat} ? 0 : 1; + if ($this->{window_stat}) { + Win32::GUI::Show( $this->{console_window} ); #コンソールをを出す + } else { + Win32::GUI::Hide( $this->{console_window} ); #コンソールを隠す + } + return -1; +}; + +sub Win32Event_NotifyIcon_RightClick { + my $this = shift; + my($x, $y) = Win32::GUI::GetCursorPos(); + + $this->{main_window}->TrackPopupMenu( + $this->{popup_menu}->{__PACKAGE__ . '::NotifyIcon_Popup'}, + $x,$y); + + return -1; +} + +sub Win32Event_NotifyIcon_Popup_exit_Click { + ::shutdown; + return -1; +} + +sub Win32Event_NotifyIcon_Popup_reload_Click { + Timer->new( + After => 0, + Code => sub { + ReloadTrigger->reload_conf_if_updated; + ReloadTrigger->reload_mods_if_updated; + } + )->install; + + return -1; +} + +sub init_win32_api { + my ($this) = shift; + + # Shell 6.0 or above + Win32::API::Type->typedef(qw(HRESULT LONG)); + + $this->{is_unicode} = Win32::API::IsUnicode(); + $this->{is_unicode} = 1; #FIXME:DEBUG + Win32::API::Type->typedef('TCHAR', + $this->{is_unicode} ? 'WCHAR' : 'CHAR'); + my @base_v1 = qw{ + DWORD cbSize; + HWND hWnd; + UINT uID; + UINT uFlags; + UINT uCallbackMessage; + HICON hIcon; + }; + my @base_v2 = (@base_v1, qw{ + TCHAR szTip[128]; + DWORD dwState; + DWORD dwStateMask; + TCHAR szInfo[256]; + UINT uTimeout_or_Version; + TCHAR szInfoTitle[64]; + DWORD dwInfoFlags; + }); + Win32::API::Struct->typedef( + 'NOTIFYICONDATA_V1', + @base_v1, + qw{ + TCHAR szTip[64]; + }); + Win32::API::Struct->typedef( + 'NOTIFYICONDATA_V2', @base_v2); + Win32::API::Struct->typedef( + 'NOTIFYICONDATA_V3', + @base_v2, + qw{ + DWORD guidItem1; + DWORD guidItem2; + }); + + my $use_notifyicondata_version = 1; + do { + Win32::API::Struct->typedef( + 'DLLVERSIONINFO', + qw{ + DWORD cbSize; + DWORD dwMajorVersion; + DWORD dwMinorVersion; + DWORD dwBuildNumber; + DWORD dwPlatformID; + }); + # ULONGLONG(Quad Octet) is not portable; can't use DLLVERSIONINFO2. + my $dvi_func = Win32::API->new( + 'shell32', 'HRESULT DllGetVersion(LPDLLVERSIONINFO dvi)', + ); + if (defined $dvi_func) { + my $dvi = Win32::API::Struct->new('DLLVERSIONINFO'); + $dvi->{cbSize} = $dvi->sizeof; + my $ret = $dvi_func->Call($dvi); + if ($ret == 0) { # NOERROR + if ($dvi->{dwMajorVersion} >= 6) { + $use_notifyicondata_version = 3; + } elsif ($dvi->{dwMajorVersion} >= 5) { + $use_notifyicondata_version = 2; + } else { + $use_notifyicondata_version = 1; + } + } else { + ::debug_printmsg('DllGetVersion return error:' . sprintf('%x',$ret)); + } + } else { + ::debug_printmsg('cant load DllGetVersion'); + } + }; + if ($use_notifyicondata_version >= 2) { + $tooltip_length = 128; + } + # init + my $define = $this->{define} = {}; + my $struct = $this->{struct} = {}; + my $func = $this->{func} = {}; + $struct->{NOTIFYICONDATA} = + 'NOTIFYICONDATA_V'.$use_notifyicondata_version; + $func->{Shell_NotifyIcon} = Win32::API->new( + 'shell32', + join('', + 'BOOL Shell_NotifyIcon', + ($this->{is_unicode} ? 'W' : 'A'), + '(DWORD dwMessage, ', + ' LP'.$struct->{NOTIFYICONDATA}.' lpdata)'), + #'shell32', 'Shell_NotifyIcon', [qw(L S)], 'C' + ); + do { + my @temp = qw(ADD MODIFY DELETE SETFOCUS SETVERSION); + foreach (0 .. $#temp) { + $define->{'NIM_'.$temp[$_]} = $_; + } + }; + do { + my @temp = qw(MESSAGE ICON TIP STATE INFO GUID); + foreach (0 .. $#temp) { + $define->{'NIF_'.$temp[$_]} = 2 ** $_; + } + }; + do { + my @temp = qw(HIDDEN SHAREDICON); + foreach (0 .. $#temp) { + $define->{'NIS_'.$temp[$_]} = $_; + } + }; + $define->{NIIF_NONE} = 0x00; + $define->{NIIF_INFO} = 0x01; + $define->{NIIF_WARNING} = 0x02; + $define->{NIIF_ERROR} = 0x03; + $define->{NIIF_ICON_MASK} = 0x0F; + $define->{NIIF_NOSOUND} = 0x10; + $define->{NOTIFYICON_VERSION} = 3; + return $use_notifyicondata_version; +} + +1; +=pod +info: タスクトレイにアイコンを表示する。 +default: off +section: important + +# タスクトレイにアイコンを表示します。 +# クリックすると表示非表示を切り替えることができ、右クリックすると +# Reload と Exit ができるコンテキストメニューを表示します。 +# 多少反応が鈍いかもしれませんがちょっと待てば出てくると思います。 + +# Win32::GUI を必要とします。 +# コンテキストメニューは表示している間処理をブロックしています。 + +# Win32 イベントループを処理する最大間隔を指定します。 +-interval: 2 + +# 通知領域に表示するアイコンを指定します。 +# Win32::GUI の制限でちゃんとしたアイコンファイルしか指定できません。 +iconfile: guiperl.ico + +# モジュールが読み込まれたときにコンソールウィンドウを隠すかどうかを +# 指定します。 +hide-console-on-load: 1 +=cut diff -urN /non-existant-dir/module/System/Pong.pm tiarra-20050322/module/System/Pong.pm --- /non-existant-dir/module/System/Pong.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/Pong.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,81 @@ +# ----------------------------------------------------------------------------- +# $Id: Pong.pm 804 2005-03-01 00:31:10Z topia $ +# ----------------------------------------------------------------------------- +package System::Pong; +use strict; +use warnings; +use NumericReply; +use base qw(Module); + +sub message_arrived { + my ($this,$message,$sender) = @_; + + if ($message->command eq 'PING') { + my ($prefix) = do { + if ($sender->isa('IrcIO::Server')) { + undef; + } else { + RunLoop->shared_loop->sysmsg_prefix(qw(system)); + } + }; + my ($nick) = do { + if ($sender->isa('IrcIO::Server')) { + $sender->current_nick; + } else { + RunLoop->shared_loop->current_nick; + } + }; + if ($message->n_params < 1) { + # これを送りつけてきたサーバー/クライアントにエラーを返す。 + $sender->send_message( + new IRCMessage( + Prefix => $prefix, + Command => ERR_NOORIGIN, + Params => [ + $nick, + 'No origin specified', + ])); + } else { + my ($target); + if ($sender->isa('IrcIO::Server')) { + $nick = undef; + $target = $sender->server_hostname; + } else { + $target = RunLoop->shared_loop->sysmsg_prefix(qw(system)); + } + # これを送りつけてきたサーバー/クライアントにPONGを送り返す。 + $sender->send_message( + new IRCMessage( + Prefix => $prefix, + Command => 'PONG', + Params => [ + $target, + (defined $nick ? $nick : ()), + ])); + } + # print "System::Pong ponged to ".$message->params->[0].".\n"; + + # PINGメッセージはこれ以上伝達させず、ここで消してしまう。 + return undef; + } + elsif ($message->command eq 'PONG') { + # PONGメッセージはこれ以上伝達させず、ここで消してしまう。 + return undef; + } + else { + return $message; + } +} + +1; + +=pod +info: サーバーからのPINGメッセージに対し、自動的にPONGを返す。 +default: on + +# これをoffにするとクライアントが自らPINGに応答せざるを得なくなりますが、 +# クライアントからのPONGメッセージはデフォルトのサーバーへ送られるので +# デフォルト以外のサーバーからはPing Timeoutで落とされるなど +# 全く良い事がありません。 +# 設定項目はありません。 +=cut diff -urN /non-existant-dir/module/System/PrivTranslator.pm tiarra-20050322/module/System/PrivTranslator.pm --- /non-existant-dir/module/System/PrivTranslator.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/PrivTranslator.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,34 @@ +# ----------------------------------------------------------------------------- +# $Id: PrivTranslator.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package System::PrivTranslator; +use strict; +use warnings; +use base qw(Module); +use Multicast; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + if ($sender->isa('IrcIO::Server') && + defined $msg->nick) { + + my $cmd = $msg->command; + if (($cmd eq 'PRIVMSG' || $cmd eq 'NOTICE') && + Multicast::nick_p($msg->param(0))) { + + $msg->nick( + Multicast::attach($msg->nick,$sender->network_name)); + } + } + $msg; +} + +1; +=pod +info: クライアントからの個人的なprivが相手に届かなくなる現象を回避する。 +default: off +section: important + +# このモジュールは個人宛てのprivmsgの送信者のnickにネットワーク名を付加します。 +# 設定項目はありません。 +=cut diff -urN /non-existant-dir/module/System/Raw.pm tiarra-20050322/module/System/Raw.pm --- /non-existant-dir/module/System/Raw.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/Raw.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,73 @@ +# ----------------------------------------------------------------------------- +# $Id: Raw.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +package System::Raw; +use strict; +use warnings; +use base qw(Module); +use Mask; +use NumericReply; + +sub message_arrived { + my ($this, $msg, $sender) = @_; + if ($sender->client_p and + $msg->command eq uc($this->config->command || 'raw')) { + # 最低限パラメタは二つ必要。 + if ($msg->n_params < 2) { + $sender->send_message( + IRCMessage->new( + Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(system)), + Command => ERR_NEEDMOREPARAMS, + Params => [ + RunLoop->shared->current_nick, + "command `".$msg->command."' requires 2 or more parameters", + ])); + } + else { + # 送り先の鯖を知る。これはマスク。 + my $target = $msg->param(0); + + # メッセージ再構築 + my $raw_msg = IRCMessage->new( + Line => join(' ', @{$msg->params}[1 .. ($msg->n_params - 1)]), + Encoding => 'utf8', + ); + + # 送信先マスクにマッチするネットワーク全てにこれを送る。 + my $sent; + foreach my $network (RunLoop->shared->networks_list) { + if (Mask::match($target, $network->network_name)) { + $network->send_message($raw_msg); + $sent = 1; + } + } + if (!$sent) { + $sender->send_message( + IRCMessage->new( + Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv system)), + Command => 'NOTICE', + Params => [ + RunLoop->shared->current_nick, + "*** no networks matches to `$target'", + ])); + } + } + $msg = undef; # 破棄 + } + $msg; +} + +1; +=pod +info: マスクで指定したサーバーにIRCメッセージを加工せずに直接送る。 +default: off + +# 例えばQUITを送る事で一時的な切断が可能。 + +# この機能を利用するためのコマンド名。デフォルトは「raw」。 +# 「/raw ircnet quit」のようにして使う。 +# 一つ目のパラメータは送り先のネットワーク名。ワイルドカード使用可能。 +# CHOCOA の場合、 raw がクライアントで使われてしまうので、 +# コマンド名を変えるか、 /raw raw ircnet quit のようにする必要がある。 +command: raw +=cut diff -urN /non-existant-dir/module/System/Reload.pm tiarra-20050322/module/System/Reload.pm --- /non-existant-dir/module/System/Reload.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/Reload.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,78 @@ +# ----------------------------------------------------------------------------- +# $Id: Reload.pm 607 2004-10-02 08:31:58Z topia $ +# ----------------------------------------------------------------------------- +package System::Reload; +use strict; +use warnings; +use base qw(Module); +use ReloadTrigger; +use Timer; +use Configuration; +use Mask; +use RunLoop; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + + if (!defined $this->config->conf_reloaded_notify || + $this->config->conf_reloaded_notify) { + $this->{conf_hook} = Configuration::Hook->new( + sub { + my ($hook) = shift; + RunLoop->shared_loop->notify_msg("Reloaded configuration file."); + })->install('reloaded'); + } + return $this; +} + +sub destruct { + my $this = shift; + + $this->{conf_hook}->uninstall if defined $this->{conf_hook}; + $this->{conf_hook} = undef; +} + +sub message_arrived { + my ($this,$msg,$sender) = @_; + my $do_reload = 0; + + # クライアントの発言か？ + if ($sender->isa('IrcIO::Client')) { + # コマンド名は一致してるか？ + if (Mask::match_deep([$this->config->broadcast_command('all')], + $msg->command)) { + RunLoop->shared_loop->broadcast_to_servers($msg->clone); + $do_reload = 1; + } elsif (Mask::match_deep([$this->config->command('all')], + $msg->command)) { + $do_reload = 1; + } + } + if ($do_reload) { + # 必要ならリロードを実行。 + ReloadTrigger->_install_reload_timer; + return undef; + } + return $msg; +} + +1; +=pod +info: confファイルやモジュールの更新をリロードするコマンドを追加する。 +default: on + +# リロードを実行するコマンド名。省略されるとコマンドを追加しません。 +# 例えば"load"を設定すると、"/load"と発言しようとした時にリロードを実行します。 +# この時コマンドはTiarraが握り潰すので、IRCプロトコル上で定義された +# コマンド名を設定すべきではありません。 +command: load + +# command と同じですが、サーバにもブロードキャストします。 +-broadcast-command: load-all + +# confファイルをリロードしたときに通知します。 +# モジュールの設定が変更されていた場合は、ここでの設定にかかわらず、 +# モジュールごとに表示されます。1または省略された場合は通知します。 +conf-reloaded-notify: 1 +=cut diff -urN /non-existant-dir/module/System/RemoteControl.pm tiarra-20050322/module/System/RemoteControl.pm --- /non-existant-dir/module/System/RemoteControl.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/RemoteControl.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,47 @@ +# ----------------------------------------------------------------------------- +# $Id: RemoteControl.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +package System::RemoteControl; +use strict; +use warnings; +use base qw(Module); +use Mask; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + if ($sender->isa('IrcIO::Server') && + $msg->command eq 'PRIVMSG' && + Mask::match_deep([defined($this->config->mask) ? $this->config->mask('all') : '*!*@*'], + $msg->prefix)) { + + my ($nick,$cmd) = $msg->param(1) =~ m/^\+\s+(.+?)\s+(.+)$/; + # 指定されたnickに自分はマッチするか？ + if (Mask::match($nick,$sender->current_nick) && + defined $cmd) { + # 実行。 + $sender->send_message( + IRCMessage->new( + Line => $cmd, + Encoding => 'utf8')); + } + } + $msg; +} + +1; + +=pod +info: 特定の発言が送られてきたとき、それに反応してIRCコマンドを実行します。 +default: off + +# 実行を許可する人間を表すマスク。 +-mask: *!*example@example.net + +# 構文: + +# は反応するbotのnickを表すマスク。 +# はサーバーに向けて発行するIRCメッセージ。 +# +# 例: +# + hoge NICK [hoge] +# hogeというBOTが[hoge]にnickを変更する。 +=cut diff -urN /non-existant-dir/module/System/SendMessage.pm tiarra-20050322/module/System/SendMessage.pm --- /non-existant-dir/module/System/SendMessage.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/SendMessage.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,65 @@ +# ----------------------------------------------------------------------------- +# $Id: SendMessage.pm 677 2004-10-18 19:32:37Z topia $ +# ----------------------------------------------------------------------------- +# SendMessage - メッセージを外部から送信するためのモジュール。 +# ----------------------------------------------------------------------------- +# Copyright (C) 2004 Yoichi Imai +package System::SendMessage; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Multicast; +use ControlPort; +use Auto::Utils; + +sub control_requested { + my ($this,$request) = @_; + # 外部コントロールプログラムからのメッセージが来た。 + # 戻り値はControlPort::Reply。 + # + # $request: + # 内容 : ControlPort::Request + # 送られたリクエスト + + # << NOTIFY System::SendMessage TIARRACONTROL/1.0 + # << Channel: !????channel@network + # << Charset: UTF-8 + # << Text: message + + # >> TIARRACONTROL/1.0 200 OK + + my $mask = $request->table->{"Channel"}; + my $text = $request->table->{"Text"}; + unless ($mask) { + return new ControlPort::Reply(403, "Mask is not set"); + } + unless ($text) { + return new ControlPort::Reply(403, "Doesn't have remark"); + } + + my ($channel_mask, $network_name) = Multicast::detach($mask); + + my $server = $this->_runloop->network($network_name); + unless (defined $server) { + return new ControlPort::Reply(404, "Server Not Found"); + } + + my $matched = 0; + + foreach my $chinfo ($server->channels_list) { + if (Mask::match_array([$channel_mask], $chinfo->name)) { + $matched = 1; + Auto::Utils::sendto_channel_closure( + $chinfo->fullname, 'NOTICE', undef, undef, undef, 0 + )->($text); + } + } + if ($matched) { + return new ControlPort::Reply(200, "OK"); + } else { + return new ControlPort::Reply(404, "Channel Not Found"); + } +} + +1; diff -urN /non-existant-dir/module/System/Shutdown.pm tiarra-20050322/module/System/Shutdown.pm --- /non-existant-dir/module/System/Shutdown.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/System/Shutdown.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,67 @@ +# ----------------------------------------------------------------------------- +# $Id: Shutdown.pm 583 2004-09-22 21:12:26Z topia $ +# ----------------------------------------------------------------------------- +package System::Shutdown; +use strict; +use warnings; +use base qw(Module); +use Mask; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->isa('IrcIO::Client')) { + # クライアントからのコマンド + if ($msg->command eq uc($this->config->command)) { + # どうせクライアントへは送られないがメッセージ表示 + RunLoop->shared->notify_msg( + "System::Shutdown received shutdown command from client."); + ::shutdown(join(' ', @{$msg->params}));; + } + } + elsif ($sender->isa('IrcIO::Server')) { + # privか？ + if (defined $msg->nick && + $msg->param(0) eq RunLoop->shared->current_nick && + ($msg->command eq 'PRIVMSG' || $msg->command eq 'NOTICE')) { + my ($command, $message) = split(/\s+/, $msg->param(1)); + # 発言内容はmessageに完全一致しているか？ + if (Mask::match_deep([$this->config->message('all')], + $command)) { + # 発言者はmaskにマッチするか？ + if (Mask::match_deep([$this->config->mask('all')], + $msg->prefix)) { + # どうせクライアントには送られないがメッセージ表示 + RunLoop->shared->notify_msg( + "System::Shutdown received shutdown command from ".$msg->prefix."."); + ::shutdown($message); + } + } + } + } + $msg; +} + +1; + +=pod +info: Tiarraを終了させる。 +default: off + +# クライアントから特定のコマンドが実行された時や、 +# 誰かから個人的に(privで)特定の発言が送られた時に +# Tiarra を終了させます。 + +# 追加するコマンド。省略された場合はコマンドでのシャットダウンは無効になります。 +-command: shutdown + +# Tiarraをシャットダウンさせるprivの発言。 +# 省略された場合はprivでのシャットダウンは無効になります。 +# パラメータとして shutdown メッセージを指定できます。 +-message: shutdown + +# privでのシャットダウンを許可する人。 +# 省略された場合はprivでのシャットダウンは無効になります。 +# 複数のマスクを指定した場合は、一つでもマッチするものがあればシャットダウンします。 +-mask: example!example@*.example.jp +=cut diff -urN /non-existant-dir/module/Tools/DateConvert.pm tiarra-20050322/module/Tools/DateConvert.pm --- /non-existant-dir/module/Tools/DateConvert.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/DateConvert.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,249 @@ +# ----------------------------------------------------------------------------- +# $Id: DateConvert.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# これはTiarraモジュールではありません。 +# %Yや%mなどを置換する機能を提供します。 +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. + +# This module is supports POSIX strftime; based NetBSD libc strftime. +# On PurePerl, Locale, timezone, and '%V', '%G', '%g' is not supported. +# so use localized constants; +# ex. %z => '$TIMEZONE_NAME'. +package Tools::DateConvert; +use strict; +use warnings; +use Carp; + +my ($can_use_posix, $use_posix); + +eval 'use POSIX'; +unless ($@) { # successful loading POSIX; + $use_posix = $can_use_posix = 1; +} else { + $use_posix = $can_use_posix = 0; + print "------can't use POSIX...\n$@\n------\n"; +} + +#constants; +my ( + $TIME_SEC, # 0 + $TIME_MIN, # 1 + $TIME_HOUR, # 2 + $TIME_DAY, # 3 + $TIME_MON, # 4 + $TIME_YEAR, # 5 + $TIME_WDAY, # 6 + $TIME_YDAY, # 7 + $TIME_ISDST # 8 + ) = (0...8); +my ($DAYSPERWEEK) = 7; +my ($YEAROFFSET) = 1900; +my ($HOURSPERDAY) = 24; +my ($HALF_HOURSPERDAY) = $HOURSPERDAY / 2; +#localized constants; +my (@DAYS) = qw(Sun Mon Tues Wednes Thurs Fri Satur); +my (@MONTHS) = qw(January February March April May June July August September October November December); +my ($FORMAT) = '%a %b %e %H:%M:%S %Y'; +my ($TIME_FORMAT) = '%H:%M:%S'; +my ($DATE_FORMAT) = '%m/%d/%y'; +my ($TIMEZONE_NAME) = 'JST'; +my ($TIMEZONE_OFFSET) = '+0900'; +my (@AM_PM) = qw(AM PM); + +sub import { + my $pkg = shift; + foreach (@_) { + if ($_ eq 'PurePerl') { + $use_posix = 0; + } + } +} + +sub unimport { + my $pkg = shift; + foreach (@_) { + if ($_ eq 'PurePerl') { + $use_posix = $can_use_posix; + carp 'can\'t use posix. no longer effective.' unless $use_posix; + } + } +} + +sub force { + my ($posix) = @_; + + carp 'this is old interface. use "use Tools::DateConvert qw(PurePerl);" instead.'; + + if (defined($posix)) { + if ($posix == 1) { # force use POSIX + $use_posix = 1; + } elsif ($posix == 0) { + $use_posix = 0; + } else { + croak 'force(posix) is only (0,1,undef) value.'; + } + } +} + +sub replace { + my ($str, $time) = @_; + $time = time() unless defined $time; + my (@times) = localtime($time); + my ($temp) = $time; + + $str =~ s/%([+-]\d+[Oo]|.)/_replace_real($1, $time, \$temp, \@times)/eg; + return $str; +} + +sub _replace_real { + my ($tag, $origtime, $time, $times) = @_; + my ($fmt) = '%02d'; + my ($data) = ''; + + if ($tag eq '%') { + $fmt = ''; + $data = $tag; + } elsif ($tag =~ /([+-]\d)?([Oo])/) { + # change times array.... + my ($number, $each); + $number = $1; + $each = $2; + $number = 0 unless defined $number; + + if ($each eq 'O') { # each day + $$time = $origtime + $number * 3600; + } else { # 'o', each second + $$time = $origtime + $number; + } + + @$times = localtime($$time); + $fmt = ''; + $data = ''; + } elsif ($use_posix == 1) { + $fmt = ''; + $data = POSIX::strftime('%' . $tag, @$times); + } else { + if ($tag eq 'A') { + $fmt = ''; + $data = @DAYS[$$times[$TIME_WDAY]] . 'day'; + } elsif ($tag eq 'a') { + $fmt = ''; + $data = substr(@DAYS[$$times[$TIME_WDAY]], 0, 3); + } elsif ($tag eq 'B') { + $fmt = ''; + $data = @MONTHS[$$times[$TIME_MON]]; + } elsif ($tag eq 'b' || $tag eq 'h') { + $fmt = ''; + $data = substr(@MONTHS[$$times[$TIME_MON]], 0, 3); + } elsif ($tag eq 'C') { + $data = ($$times[$TIME_YEAR] + $YEAROFFSET) / 100; + } elsif ($tag eq 'c') { + $fmt = ''; + $data = replace($FORMAT, $$time); + } elsif ($tag eq 'D') { + $fmt = ''; + $data = replace('%m/%d/%y', $$time); + } elsif ($tag eq 'd') { + $data = $$times[$TIME_DAY]; + # C99 locale modifiers: 'Ox' and 'Ex' is ommited. + } elsif ($tag eq 'e') { + $fmt = '%2d'; + $data = $$times[$TIME_DAY]; + } elsif ($tag eq 'F') { + $fmt = ''; + $data = replace('%Y-%m-%d', $$time); + } elsif ($tag eq 'H') { + $data = $$times[$TIME_HOUR]; + } elsif ($tag eq 'I') { + $data = $$times[$TIME_HOUR] % $HALF_HOURSPERDAY; + $data = 12 if $data == 0; + } elsif ($tag eq 'j') { + $fmt = '%03d'; + $data = $$times[$TIME_YDAY] + 1; + } elsif ($tag eq 'k') { + $fmt = '%2d'; + $data = $$times[$TIME_HOUR]; + } elsif ($tag eq 'l') { + $fmt = '%2d'; + $data = $$times[$TIME_HOUR] % $HALF_HOURSPERDAY; + $data = $HALF_HOURSPERDAY if $data == 0; + } elsif ($tag eq 'M') { + $data = $$times[$TIME_MIN]; + } elsif ($tag eq 'm') { + $data = $$times[$TIME_MON] + 1; + } elsif ($tag eq 'n') { + $fmt = ''; + $data = "\n"; + } elsif ($tag eq 'p') { + $fmt = ''; + if ($$times[$TIME_HOUR] < $HALF_HOURSPERDAY) { + $data = $AM_PM[0]; + } else { + $data = $AM_PM[1]; + } + } elsif ($tag eq 'R') { + $fmt = ''; + $data = replace('%H:%M', $$time); + } elsif ($tag eq 'r') { + $fmt = ''; + $data = replace('%I:%M:%S %p', $$time); + } elsif ($tag eq 'S') { + $data = $$times[$TIME_SEC]; + } elsif ($tag eq 's') { + $fmt = '%d'; + $data = $$time; + } elsif ($tag eq 'T') { + $fmt = ''; + $data = replace('%H:%M:%S', $$time); + } elsif ($tag eq 't') { + $fmt = ''; + $data = "\t"; + } elsif ($tag eq 'U') { + $data = ($$times[$TIME_YDAY] + $DAYSPERWEEK - $$times[$TIME_WDAY]) / $DAYSPERWEEK; + } elsif ($tag eq 'u') { + $fmt = '%d'; + $data = $$times[$TIME_WDAY]; + $data = $DAYSPERWEEK if $data == 0; + } elsif ($tag eq 'V' || $tag eq 'G' || $tag eq 'g') { + # not supported + $fmt = ''; + $data = ''; + } elsif ($tag eq 'v') { + $fmt = ''; + $data = replace('%e-%b-%Y', $$time); + } elsif ($tag eq 'W') { + $data = $$times[$TIME_WDAY]; + $data = $DAYSPERWEEK if $data == 0; + $data = ($$times[$TIME_YDAY] + $DAYSPERWEEK - $data - 1) / $DAYSPERWEEK; + } elsif ($tag eq 'w') { + $fmt = '%d'; + $data = $$times[$TIME_WDAY]; + } elsif ($tag eq 'X') { + $fmt = ''; + $data = replace($TIME_FORMAT, $$time); + } elsif ($tag eq 'x') { + $fmt = ''; + $data = replace($DATE_FORMAT, $$time); + } elsif ($tag eq 'y') { + $data = $$times[$TIME_YEAR] % 100; + } elsif ($tag eq 'Y') { + $fmt = '%d'; + $data = $$times[$TIME_YEAR] + $YEAROFFSET; + } elsif ($tag eq 'Z') { + $fmt = ''; + $data = $TIMEZONE_NAME; + } elsif ($tag eq 'z') { + $fmt = ''; + $data = $TIMEZONE_OFFSET; + } else { + $fmt = ''; + $data = ''; + } + } + + return sprintf($fmt, $data) if $fmt ne ''; + return $data; +} + +1; diff -urN /non-existant-dir/module/Tools/FileCache/EachFile.pm tiarra-20050322/module/Tools/FileCache/EachFile.pm --- /non-existant-dir/module/Tools/FileCache/EachFile.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/FileCache/EachFile.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,110 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: EachFile.pm 546 2004-09-11 17:15:05Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package Tools::FileCache::EachFile; +use strict; +use warnings; +use Carp; +use Module::Use qw(Tools::LinedDB); +use Tools::LinedDB; +use Tiarra::Utils; +our $AUTOLOAD; + +my $timeout = 2.5 * 60; + +sub new { + my ($class, $parent, $fpath, $mode, $charset) = @_; + + my ($this) = { + parent => $parent, + mode => undef, + database => undef, + refcount => 0, + expire => undef, + }; + + if ($mode =~ /raw/i) { + $this->{mode} = 'raw'; + $this->{database} = + Tools::LinedDB->new( + FilePath => $fpath, + Charset => $charset, + ); + } elsif ($mode =~ /std/i) { + $this->{mode} = 'std'; + $this->{database} = + Tools::LinedDB->new( + FilePath => $fpath, + Charset => $charset, + Parse => sub { + my ($line) = @_; + $line =~ s/^\s+//; + return () if $line =~ /^[\#\;]/; + $line =~ s/\s+$//; + return () if $line eq ''; + return $line; + }, + ); + } else { + croak 'can\'t understand type "' . $mode . '"'; + } + + bless $this, $class; + + return $this; +} + + +sub register { + my $this = shift; + + $this->add_ref; + $this; +} + +sub unregister { + my $this = shift; + + $this->release; + $this; +} + +Tiarra::Utils->define_attr_getter(0, qw(refcount expire)); + +sub add_ref { ++(shift->{refcount}); } +sub release { --(shift->{refcount}); } +sub can_remove { (shift->refcount <= 0); } + +sub set_expire { + my ($this) = @_; + + $this->{expire} = time() + $timeout; + return $this; +} + +sub clean { + my ($this) = @_; + + $this->{database} = undef; +} + +sub AUTOLOAD { + my ($this, @args) = @_; + + if ($AUTOLOAD =~ /::DESTROY$/) { + # DESTROYは伝達させない。 + return; + } + + (my $method = $AUTOLOAD) =~ s/.+?:://g; + + # define method + eval "sub $method { shift->{database}->$method(\@_); }"; + + no strict 'refs'; + goto &$AUTOLOAD; +} + +1; diff -urN /non-existant-dir/module/Tools/FileCache.pm tiarra-20050322/module/Tools/FileCache.pm --- /non-existant-dir/module/Tools/FileCache.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/FileCache.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,173 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# Tools::FileCache, Data shared file cache service. +# ----------------------------------------------------------------------------- +# $Id: FileCache.pm 539 2004-09-10 08:16:13Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package Tools::FileCache; +use strict; +use warnings; +use RunLoop; +use Carp; +use Tiarra::SharedMixin; +use Module::Use qw(Tools::FileCache::EachFile); +use Tools::FileCache::EachFile; +our $_shared_instance; + +sub _new { + my $class = shift; + my ($this) = { + files => {}, + + timer => undef, + }; + bless $this, $class; + + return $this; +} + +sub find_file { + my ($class_or_this, $fpath, $mode, $charset) = @_; + my $this = $class_or_this->_this; + + my $file = $this->{files}->{$fpath}; + if (defined($file)) { + # とりあえずファイルは存在した。 + my $obj = $file->{$mode}; + if (defined($obj)) { + # そのモードも存在した。オブジェクトを返す。 + return $obj; + } else { + # そのモードは存在しなかった。登録して返す。 + return $this->_register_inner($fpath, $mode, $charset); + } + } else { + # ファイルは存在しない。登録して返す。 + return $this->_register_inner($fpath, $mode, $charset); + } +} + +sub register { + my ($class_or_this, $fpath, $mode, $charset) = @_; + my $this = $class_or_this->_this; + + my $file = $this->find_file($fpath, $mode, $charset); + if (defined $file) { + # ファイルがあった or ファイルを登録した。 + # 参照回数を増やして返す。 + $file->register(); + return $file; + } else { + # ファイルの登録が出来なかった。 + return undef; + } +} + +sub unregister { + my ($class_or_this, $fpath) = @_; + my $this = $class_or_this->_this; + + my $file = $this->{files}->{$fpath}; + if (defined($file)) { + $file->unregister(); + return 0; + } else { + croak('file "' . $fpath . '" has not registered yet!'); + } +} + +sub _register_inner { + my ($class_or_this, $fpath, $mode, $charset) = @_; + my $this = $class_or_this->_this; + + my $obj = Tools::FileCache::EachFile->new($this, $fpath, $mode, $charset); + if (defined $obj) { + $this->{files}->{$fpath} = {} unless (defined($this->{files}->{$fpath})); + $this->{files}->{$fpath}->{$mode} = $obj; + $this->_install_timer(); + return $obj; + } else { + return undef; + } +} + +sub main_loop { + my $this = shift; + + # check expire + foreach my $key (keys(%{$this->{files}})) { + my $file = $this->{files}->{$key}; + foreach my $mode (keys(%$file)) { + my $obj = $file->{$mode}; + if ($obj->can_remove() && ($obj->expire() < time())) { + # expired. + $obj->clean(); + delete $this->{files}->{$key}->{$mode}; + } + } + if (scalar(keys(%$file)) == 0) { + delete $this->{files}->{$key}; + } + } + + # check struct-size + if (scalar(keys(%{$this->{files}})) == 0) { + $this->_uninstall_timer(); + } +} + +sub destruct { + my $this = shared; + + # expire all + foreach my $key (keys(%{$this->{files}})) { + my $file = $this->{files}->{$key}; + foreach my $mode (keys(%$file)) { + my $obj = $file->{$mode}; + $obj->clean(); + delete $this->{files}->{$key}->{$mode}; + } + delete $this->{files}->{$key}; + } + + # re-run main_loop (for uninstall timer) + $this->main_loop(); +} + +# misc/timer +sub _check_timer { + my $this = shift; + + return defined($this->{timer}); +} + +sub _install_timer { + my $this = shift; + + unless ($this->_check_timer) { + $this->{timer} = Timer->new( + Interval => 30, + Repeat => 1, + Code => sub { + my $timer = shift; + $this->main_loop(); + }, + )->install(); + } + + return 0; +} + +sub _uninstall_timer { + my $this = shift; + + if ($this->_check_timer()) { + $this->{timer}->uninstall; + $this->{timer} = undef; + } + + return 0; +} + +1; diff -urN /non-existant-dir/module/Tools/GroupDB.pm tiarra-20050322/module/Tools/GroupDB.pm --- /non-existant-dir/module/Tools/GroupDB.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/GroupDB.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,583 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: GroupDB.pm 803 2005-02-28 22:41:29Z topia $ +# ----------------------------------------------------------------------------- +# エイリアスのように、HashをレコードとしたDBを管理する。 +# ----------------------------------------------------------------------------- +# copyright (C) 2003-2004 Topia . all rights reserved. + + +# - 情報(注意) - +# * キー名に半角スペースは含められません。 error が出ます。 +# * 値の先頭、最後にある空白文字(\s)は読み込み時に消失します。 +# * 機能不足です。 +# * コードが読みにくいです。 + +# technical information +# - datafile format +# | abc: def +# -> key 'abc', value 'def' +# | : abc : def +# -> key ':abc:', value 'def' +# LINE := KEY ANYSPACES [value] ANYSPACES が基本。 +# KEY := ANYSPACES [keyname] ANYSPACES ':' || ANYSPACES ':' [keyname] ':' +# ANYSPACES := REGEXP:\s* +# [keyname] にはコロンをスペースに変換したキー名が入る。 +# キー名の先頭または最後にスペースがある場合は、KEYの後者のフォーマットを使用する。 +# [value] はそのまま。つまり複数行になるデータは追加できない。エラーを出すべきか? + +package Tools::GroupDB; +use strict; +use warnings; +use IO::File; +use File::stat; +use Tiarra::Encoding; +use Mask; +use Carp; +use Module::Use qw(Tools::Hash Tools::HashTools); +use Tools::Hash; +use Tools::HashTools; +use Tiarra::Utils; +use Tiarra::ModifiedFlagMixin; +use Tiarra::SessionMixin; +use base qw(Tiarra::SessionMixin); +use base qw(Tiarra::Utils); + +sub new { + # コンストラクタ + + # - 引数 - + # $fpath : 保存するファイルのパス。空ファイル or undef でファイルに関連付けられないDBが作成されます。 + # $primary_key + # : 主キーを設定します。データベース的な利点はまったくありません(笑)が、適当に作って下さい。 + # $split_primaryが指定されていない場合は undef を渡すことが出来ます。 + # $charset : ファイルの文字セットを指定します。省略すれば UTF-8 になります。 + # $split_primary + # : true なら、データファイルからの読み込み時に、$primary_keyで区切ります。 + # そうでなければデータの無い行が区切りになります。省略されれば false です。 + # $use_re : 値の検索/一致判定に正規表現拡張を使うかどうか。省略されれば使いません。 + # $ignore_proc + # : 無視する行を指定するクロージャ。行を引数に呼び出され、 true が返ればその行を無視します。 + # ここで ignore された行は解析さえ行いませんので、 + # $split_primary=0でも区切りと認識されたりはしません。 + # 一般的な注意として、この状態のデータベースが保存された場合は ignore された行は全て消滅します。 + + my ($class,$fpath,$primary_key,$charset,$split_primary,$use_re,$ignore_proc) = @_; + + if (defined $primary_key) { + if ($primary_key =~ / /) { + croak('primary_key name "'.$primary_key.'" include space!') + } + } else { + croak('primary_key not defined, but split_primary is true!') if $split_primary; + } + + my $this = { + time => undef, # ファイルの最終読み込み時刻 + fpath => $fpath, + primary_key => $primary_key, + split_primary => $split_primary || 0, + charset => $charset || 'utf8', # ファイルの文字コード + use_re => $use_re || 0, + ignore_proc => $ignore_proc || sub { $_[0] =~ /^\s*#/; }, + cleanup_queued => undef, + + caller_name => $class->simple_caller_formatter('GroupDB registered'), + database => undef, # ARRAY + # <キー SCALAR,値の集合 ARRAY> + }; + + bless $this,$class; + $this->clear_modified; + $this->_session_init; + $this->_load; +} + +__PACKAGE__->define_attr_accessor(0, + qw(time fpath charset), + qw(primary_key split_primary), + qw(cleanup_queued)); +__PACKAGE__->define_session_wrap(0, + qw(checkupdate synchronize cleanup)); + +sub name { + my $this = shift; + join('/', $this->{caller_name}, + (defined $this->fpath ? $this->fpath : ())); +} + +sub _load { + my $this = shift; + my $database = []; + + if (defined $this->fpath && $this->fpath ne '') { + my $fh = IO::File->new($this->fpath,'r'); + if (defined $fh) { + my $current = {}; + my $flush = sub { + if ((!$this->split_primary && scalar(%$current)) || + (defined $this->primary_key && + defined $current->{$this->primary_key})) { + push @{$database}, Tools::Hash->new($this, $current); + $current = {}; + } + }; + my $unicode = Tiarra::Encoding->new; + foreach (<$fh>) { + my $line = $unicode->set($_, $this->charset)->get; + next if $this->{ignore_proc}->($line); + my ($key,$value) = grep {defined($_)} + ($line =~ /^\s*(?:([^:]+?)\s*|:([^:]+?)):\s*(.+?)\s*$/); + if (!defined $key || $key eq '' || + !defined $value || $value eq '') { + if (!$this->split_primary) { + $flush->(); + } + } else { + # can use colon(:) on key, but cannot use space( ). + $key =~ s/ /:/g; + if ($this->split_primary && + $key eq $this->primary_key) { + $flush->(); + } + push(@{$current->{$key}}, $value); + } + } + $flush->(); + $this->{database} = $database; + $this->set_time; + $this->clear_modified; + $this->dequeue_cleanup; + } + } + return $this; +} + +sub _match { + my ($this, $value, $str) = @_; + + Mask::match_array($value, $str, 1, $this->{use_re}, 0); +} + +sub _check_primary_key { + my $this = shift; + + croak "primary_key not defined; can't use this method." + unless defined $this->primary_key; +} + +sub _check_no_primary_key { + my $this = shift; + + croak "primary_key defined; can't use this method." + if defined $this->primary_key; +} + +sub _check_primary_key_dups { + my ($this, @values) = @_; + + $this->_check_primary_key; + defined $this->find_group_with_primary([@values]); +} + +sub _checkupdate { + my $this = shift; + + if (defined $this->fpath && $this->fpath ne '') { + my $stat = stat($this->fpath); + + if (defined $stat && defined $this->time && + $stat->mtime > $this->time) { + $this->_load; + return 1; + } + } + return 0; +} + +sub queue_cleanup { shift->cleanup_queued(1); } +sub dequeue_cleanup{ shift->cleanup_queued(0); } +sub set_time { shift->time(CORE::time); } + +sub _synchronize { + my $this = shift; + my $force = shift || 0; + + if (defined $this->fpath && $this->fpath ne '' && + ($this->modified || $force)) { + my $fh = IO::File->new($this->fpath,'w'); + if (defined $fh) { + my $unicode = Tiarra::Encoding->new; + foreach my $person (@{$this->{database}}) { + my @keys = keys %{$person->data}; + if (defined $this->primary_key) { + @keys = grep { $_ ne $this->primary_key } @keys; + unshift(@keys, $this->primary_key); + } + my ($key, $values); + foreach $key (@keys) { + $values = $person->data->{$key}; + # can use colon(:) on key, but cannot use space( ). + $key =~ s/:/ /g; + # \s が先頭/最後にあった場合読み込みで消え去るのでそれを防止。 + $key = ':' . $key if ($key =~ /^\s/ || $key =~ /\s$/); + map { + my $line = "$key: " . $_ . "\n"; + $fh->print($unicode->set($line)->conv($this->{charset})); + } @$values + } + $fh->print("\n"); + } + $this->set_time; + $this->clear_modified; + $this->dequeue_cleanup; + } + } + return $this; +} + +sub groups { + my ($this) = @_; + + return @{$this->with_session(sub{ $this->{database}; })}; +} + +sub find_group_with_primary { + # 見付からなければundefを返す。 + my ($this, $value) = @_; + + $this->_check_primary_key; + return $this->find_group($this->primary_key, $value); +} + +sub find_group { + my ($this, $keys, $values) = @_; + + return $this->find_groups($keys, $values, 1); +} + +sub find_groups_with_primary { + my ($this, $value, $count) = @_; + + $this->_check_primary_key; + return $this->find_groups([$this->primary_key], [$value], $count); +} + +sub find_groups { + # on not found return 'undef' + # $keys is ref[array or scalar] + # $values is ref[array or scalar] + # $count is num of max found group, optional. + my ($this, $keys, $values, $count) = @_; + my (@ret); + + ($keys, $values) = map { + if (!ref($_) || ref($_) ne 'ARRAY') { + [$_]; + } else { + $_; + } + } ($keys, $values); + + my ($return) = sub { + if (wantarray) { + return @ret; + } else { + return $ret[0] || undef; + } + }; + + $this->with_session( + sub { + group_loop: + foreach my $group (@{$this->{database}}) { + foreach my $key (@$keys) { + foreach my $value (@$values) { + if ($this->_match($group->get_array($key), $value)) { + #match. + push(@ret, $group); + if (defined($count) && ($count <= scalar(@ret))) { + return $return->(); + } + next group_loop; # next at $group loop. + } + } + } + } + return $return->(); + }); +} + +sub find_group_with_hash { + my ($this, $hash) = @_; + + return $this->find_groups_with_hash($hash, 1); +} + +sub find_groups_with_hash { + # on not found return 'undef' + # $keys is hashref(key => scalar, key => [scalar, scalar, ...]). + # $count is num of max found group, optional. + my ($this, $hash, $count) = @_; + my (@ret); + + my ($return) = sub { + if (wantarray) { + return @ret; + } else { + return $ret[0] || undef; + } + }; + + $this->with_session( + sub { + group_loop: + foreach my $group (@{$this->{database}}) { + foreach my $key (keys %$hash) { + my $values = $hash->{$key}; + $values = [$values] + unless defined ref($values) && ref($values) eq 'ARRAY'; + foreach my $value (@$values) { + next group_loop + unless $this->_match($group->get_array($key), + $value); + } + } + # ok all match! + push(@ret, $group); + if (defined($count) && ($count <= scalar(@ret))) { + return $return->(); + } + } + return $return->(); + }); +} + +sub new_group { + my $this = shift; + my (@primary_key_values) = @_; + + if (!@primary_key_values && defined $this->primary_key) { + croak 'primary_key_values not defined! please pass value'; + if ($this->_check_primary_key_dups(@primary_key_values)) { + return undef; + } + } elsif (@primary_key_values && !defined $this->primary_key) { + carp 'primary_key_values defined! ignore value...'; + @primary_key_values = (); + } + $this->with_session( + sub { + my $group; + if (@primary_key_values) { + $group = Tools::Hash->new($this, { + $this->primary_key => [@primary_key_values], + }); + } else { + $group = Tools::Hash->new($this); + $this->queue_cleanup; + } + push @{$this->{database}}, $group; + $this->set_modified; + $group; + }); +} + +sub add_group { + # データベースにグループを追加する。 + # 常に成功し 1(true) が返る。 + # sanity check が足りないので new_group を使うことを推奨します。 + + # key に space が含まれないかチェックすべきだが、とりあえずはしていない。 + my ($this, @groups) = @_; + $this->with_session( + sub { + push @{$this->{database}}, map { + if (ref($_) eq 'HASH') { + Tools::Hash->new($this, $_); + } else { + $_; + } + } @groups; + $this->set_modified; + }); + + return 1; +} + +sub del_group { + # データベースからグループを削除する。 + # グループを空にしてクリーンアップにまかせます。 + + my ($this, @groups) = @_; + $this->with_session( + sub { + foreach my $group (@groups) { + foreach ($group->keys) { + $group->del_key($_); + } + } + }); + + return 1; +} + +sub add_array_with_primary { + my ($this, $primary, $key, @values) = @_; + + $this->_check_primary_key; + $this->with_session( + sub { + # 追加。あるか？ + my $group = $this->find_group_with_primary($primary); + + # primary_key の値に重複ができないかチェック。 + if ($key eq $this->primary_key && + $this->_check_primary_key_dups(@values)) { + return 0; + } + + if (defined $group) { + # found. + return $group->add_array($key, @values); + } else { + # 1. 無かった場合、primary_keyだけは追加が許される。 + # 2. primary_key の値と @values が一致するかチェック。 + if ($key eq $this->primary_key && + $this->_match([@values], $primary)) { + $this->new_group(@values); + $this->set_modified; + # added + return 1; + } + } + # not added + return 0; + }); +} + +sub del_array_with_primary { + my ($this, $primary, $key, @values) = @_; + + $this->_check_primary_key; + $this->with_session( + sub { + # 削除。あるか？ + my $group = $this->find_group_with_primary($primary); + + if (defined $group) { + return $group->del_array($key, @values); + } + # not deleted + return 0; + }); +} + +*add_value_with_primary = \&add_array_with_primary; +*del_value_with_primary = \&del_array_with_primary; + +sub _cleanup { + my $this = shift; + my $force = shift || 0; + + if ($this->cleanup_queued || $force) { + my $count = scalar @{$this->{database}}; + if (defined $this->primary_key) { + # primary_keyが一つもないエイリアスを削除する。 + @{$this->{database}} = grep { + my $primary = $_->{$this->primary_key}; + defined $primary && @$primary > 0; + } @{$this->{database}}; + } else { + # 中身が空のエイリアスを削除する。 + @{$this->{database}} = grep { + $_->keys; + } @{$this->{database}}; + } + if ($count != (scalar @{$this->{database}})) { + $this->set_modified; + } + $this->dequeue_cleanup; + } +} + +sub _after_session_start { + my $this = shift; + $this->_checkupdate; +} + +sub _before_session_finish { + my $this = shift; + $this->_cleanup; + $this->_synchronize; +} + +# replace support functions +sub replace_with_callbacks { + # マクロの置換を行なう。%optionalは置換に追加するキーと値の組みで、省略可。 + # $callbacksはgroup/optionalで置換できなかった際に呼び出されるコールバック関数のリファレンス。 + # optionalの値はSCALARでもARRAYでも良い。 + my ($this,$primary,$str,$callbacks,%optional) = @_; + my $main_table = $this->find_group_with_primary($primary) || {}; + return Tools::HashTools::replace_recursive($str,[$main_table,\%optional],$callbacks); +} + +# deprecated interfaces +sub add_array { + my ($this, $group, $key, @values) = @_; + + $group->add_array($key, @values); +} + +sub del_array { + my ($this, $group, $key, @values) = @_; + + $group->del_array($key, @values); +} + +*add_value = \&add_array; +*del_value = \&del_array; + +sub dup_group { + # グループの複製を行います。 + + my ($group) = @_; + return undef unless defined($group); + + return $group->clone; +} + +# group misc functions +sub concat_string_to_key { + # prefix や suffix を group の key に付加します。 + + # - 引数 - + # $group : グループ。 + # $prefix : prefix 文字列 ('to.' とか 'from.' とか) + # $suffix : suffix 文字列 + my ($group, $prefix, $suffix) = @_; + return $group->clone->manipulate_keyname( + prefix => $prefix, + suffix => $suffix, + ); +} + +sub get_value_random { + my ($group, $key) = @_; + + return $group->get_value_random($key); +} + +sub get_value { + my ($group, $key) = @_; + + return $group->get_value($key); +} + +sub get_array { + my ($group, $key) = @_; + + return $group->get_array($key); +} + +1; diff -urN /non-existant-dir/module/Tools/HTTPClient.pm tiarra-20050322/module/Tools/HTTPClient.pm --- /non-existant-dir/module/Tools/HTTPClient.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/HTTPClient.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,237 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: HTTPClient.pm 546 2004-09-11 17:15:05Z topia $ +# ----------------------------------------------------------------------------- +# HTTP/1.1非対応。 +# ----------------------------------------------------------------------------- +package Tools::HTTPClient; +use strict; +use warnings; +use LinedINETSocket; +use Carp; +use RunLoop; +use Timer; +# 本当はHTTP::RequestとHTTP::Responseを使いたいが… + +my $DEBUG = 0; + +sub new { + my ($class, %args) = @_; + my $this = bless {} => $class; + + if (!$args{Method}) { + croak "Argument `Method' is required"; + } + if (!$args{Url}) { + croak "Argument `Url' is required"; + } + + $this->{method} = $args{Method}; # GET | POST + $this->{url} = $args{Url}; + $this->{content} = $args{Content}; # undef可 + $this->{header} = $args{Header} || {}; # {key => value} undef可 + $this->{timeout} = $args{Timeout}; # undef可 + + $this->{callback} = undef; + $this->{socket} = undef; + $this->{hook} = undef; + $this->{timeout_timer} = undef; + + $this->{expire_time} = undef; # タイムアウト時刻 + + $this->{status_fetched} = undef; + $this->{header_fetched} = undef; + + $this->{reply} = {Header => {}, Content => ''}; + + $this; +} + +sub start { + # $callback: セッション終了後に呼ばれる関数。省略不可。 + # この関数には次のようなハッシュが渡される。 + # { + # Protocol => 'HTTP/1.0', + # Code => 200, + # Message => 'OK', + # Header => { + # 'Content-Length' => 6, + # }, + # Content => 'foobar', + # } + # エラーが発生した場合はエラーメッセージ(文字列)が渡される。 + my ($this, $callback) = @_; + if ($this->{callback}) { + croak "This client is already started"; + } + $this->{callback} = $callback; + + if (!$callback or ref($callback) ne 'CODE') { + croak "Callback function is required"; + } + + # URLを分解し、ホスト名とパスを得る。 + my ($host, $path); + $this->{url} =~ s/#.+//; + if ($this->{url} =~ m|^http://(.+)$|) { + if ($1 =~ m|^(.+?)(/.*)|) { + $host = $1; + $path = $2; + } + else { + $host = $1; + $path = '/'; + } + } + else { + croak "Unsupported scheme: $this->{url}"; + } + + # ヘッダにHostが含まれていなければ追加。 + if (!$this->{header}{Host}) { + $this->{header}{Host} = $host; + } + + # ホスト名にポートが含まれていたら分解。 + my $port = 80; + if ($host =~ s/:(\d+)$//) { + $port = $1; + } + + # 接続 + $this->{socket} = LinedINETSocket->new->connect($host, $port); + if (!defined $this->{socket}) { + # 接続不可能 + croak "Failed to connect: $host:$port"; + } + + # 必要ならタイムアウト用のタイマーをインストール + if ($this->{timeout}) { + $this->{expire_time} = time + $this->{timeout}; + $this->{timeout_timer} = Timer->new( + After => $this->{timeout}, + Code => sub { + $this->{timeout_timer} = undef; + $this->_main; + })->install; + } + + # リクエストを発行し、フックをかけて終了。 + my @request = ( + "$this->{method} $path HTTP/1.0", + do { + map { + "$_: ".$this->{header}{$_} + } keys %{$this->{header}} + }, + '', + do { + $this->{content} ? $this->{content} : (); + }, + ); + foreach (@request) { + $DEBUG and print "> $_\n"; + $this->{socket}->send_reserve($_); + } + + $this->{hook} = RunLoop::Hook->new( + sub { + $this->_main; + })->install('before-select'); + + $this; +} + +sub _main { + my $this = shift; + + # タイムアウト判定 + if ($this->{expire_time} and time >= $this->{expire_time}) { + $this->_end("timeout"); + return; + } + + while (defined(my $line = $this->{socket}->pop_queue)) { + $DEBUG and print "< $line\n"; + + if (!$this->{status_fetched}) { + # ステータス行 + $line =~ tr/\n\r//d; + if ($line =~ m|^(HTTP/.+?) (\d+?) (.+)$|) { + $this->{reply}{Protocol} = $1; + $this->{reply}{Code} = $2; + $this->{reply}{Message} = $3; + $this->{status_fetched} = 1; + } + else { + $this->_end("invalid status line: $line"); + return; + } + } + elsif (!$this->{header_fetched}) { + $line =~ tr/\n\r//d; + if (length $line == 0) { + # ヘッダ終わり + $this->{header_fetched} = 1; + } + else { + if ($line =~ m|(.+?): (.+)$|) { + $this->{reply}{Header}{$1} = $2; + } + else { + $this->_end("invalid header line: $line"); + return; + } + } + } + else { + # 中身 + $this->{reply}{Content} .= $line . "\x0d\x0a"; + } + } + + # 切断されていたら、ここで終わり。 + if (!$this->{socket}->connected) { + if (!$this->{status_fetched} or + !$this->{header_fetched}) { + $this->_end("unexpected disconnect by server"); + } + else { + $this->{reply}{Content} .= $this->{socket}->recvbuf; + $this->_end; + } + } +} + +sub _end { + my ($this, $err) = @_; + + $this->stop; + + if ($err) { + $this->{callback}->($err); + } + else { + $this->{callback}->($this->{reply}); + } +} + +sub alive_p { + my $this = shift; + defined $this->{socket}; +} + +sub stop { + my $this = shift; + + $this->{socket}->disconnect if $this->{socket}; + $this->{hook}->uninstall if $this->{hook}; + $this->{timeout_timer}->uninstall if $this->{timeout_timer}; + + $this->{socket} = + $this->{hook} = + $this->{timeout_timer} = + undef; +} + +1; diff -urN /non-existant-dir/module/Tools/Hash.pm tiarra-20050322/module/Tools/Hash.pm --- /non-existant-dir/module/Tools/Hash.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/Hash.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,235 @@ +# ----------------------------------------------------------------------------- +# $Id: Hash.pm 765 2005-02-23 14:02:45Z topia $ +# ----------------------------------------------------------------------------- +# Hash をデータストレージとして便利に使えるようにするクラス。 +# ----------------------------------------------------------------------------- +# copyright (C) 2004 Topia . all rights reserved. +package Tools::Hash; +use strict; +use warnings; +use enum qw(PARENT DATA); +use Tiarra::Utils; +use overload + '%{}' => sub { shift->data }, + 'bool' => sub { %{shift->data} }; + +utils->define_array_attr_accessor(0, 'parent'); +utils->define_array_attr_getter(0, 'data'); + +sub new { + my ($class, $parent, $data) = @_; + + my $this = []; + $this->[PARENT] = $parent; + $this->[DATA] = utils->get_first_defined($data, {}); + bless $this, $class; + $this; +} + +sub drop_parent { shift->parent(undef); } +sub set_parent { shift->parent(shift); } +sub keys { CORE::keys(%{shift->data}); } +sub values { CORE::values(%{shift->data}); } + +sub clone { + my ($this, %args) = @_; + if ($args{deep}) { + ref($this)->new(undef, + eval(Data::Dumper->new([$this->data]) + ->Terse(1)->Deepcopy(1)->Purity(1)->Dump)); + } else { + # shallow copy + ref($this)->new(undef, {%{$this->data}}); + } +} + +sub manipulate_keyname { + # this method update myself, please clone before. + my ($this, %opts) = @_; + + $this->with_session( + sub { + my ($new_data) = {}; + my $new_key; + foreach my $key ($this->keys) { + $new_key = $key; + $new_key = $opts{prefix} . $new_key if defined $opts{prefix}; + $new_key .= $opts{suffix} if defined $opts{suffix}; + $new_key = $opts{code}->($new_key) if defined $opts{code}; + $new_data->{$new_key} = $this->{$key}; + } + $this->[DATA] = $new_data; + $this->set_modified; + }); + + $this; +} + +sub equals { + my ($this, $target) = @_; + + $this->with_session( + sub { + $target->with_session( + sub { + map { + return 0 if $this->$_ != $target->$_; + } qw(keys values); + my ($key, $value); + my ($values, $target_values); + while (($key, $values) = each %$this) { + $target_values = $target->get_array($key); + return 0 unless defined $target_values; + return 0 unless @$values != @$target_values; + $target_values = [@$target_values]; # clone + foreach $value (sort @$values) { + if ($value ne shift(@$target_values)) { + return 0; + } + } + } + })}); + return 1; +} + +sub with_session { + my $this = shift; + if (defined $this->parent) { + $this->parent->with_session(@_); + } else { + shift->(); + } +} + +foreach (qw(set_modified queue_cleanup)) { + eval " + sub $_ \{ + my \$this = shift; + if (defined \$this->parent) { + \$this->parent->$_(\@_); + } + }"; +} + +sub get_value_random { + my ($this, $key) = @_; + + my $values = $this->get_array($key); + if ($values) { + # 発見. どれか一つ選ぶ。 + my $idx = int(rand() * hex('0xffffffff')) % @$values; + return $values->[$idx]; + } + return undef; +} + +sub get_value { + my ($this, $key) = @_; + + my $values = $this->get_array($key); + if ($values) { + # 発見. + return $values->[0]; + } + return undef; +} + +sub get_array { + my ($this, $key) = @_; + + $this->with_session( + sub { + my $value = $this->data->{$key}; + if (defined $value) { + # 発見 + if (ref($value) eq 'ARRAY') { + return $value; + } else { + return [$value]; + } + } + return undef; + }); +} + +sub add_hash { + my ($this, %hash) = @_; + my $retval = 1; + + $this->with_session( + sub { + map { + my $value = $hash{$_}; + if (ref($value) ne 'ARRAY') { + $value = [$value]; + } + $retval &= $this->add_array($_, @$value) ? 1 : 0; + } CORE::keys %hash; + }); + return $retval; +} + +sub add_array { + # 成功すれば 1(true) が返る。 + # 不正なキーのため失敗した場合は 0(false) が返る。 + + my ($this, $key, @values) = @_; + + return 0 if $key =~ / /; + + $this->with_session( + sub { + my $data = $this->data->{$key}; + if (!defined $data) { + $data = []; + $this->data->{$key} = $data; + } + push @$data,@values; + $this->set_modified; + }); + + return 1; +} + +sub del_array { + my ($this, $key, @values) = @_; + + $this->with_session( + sub { + my $data = $this->data->{$key}; + if (defined $data) { + my ($count) = scalar @$data; + if (@values) { + my $item; + @$data = grep { + $item = $_; + !(utils->get_first_defined( + map { + $item eq $_ ? 1 : undef; + } @values)) + } @$data; + $count -= scalar(@$data); + # この項目が空になったら項目自体を削除 + if (@$data == 0) { + delete $this->data->{$key}; + } + } else { + # @values が指定されていない場合は項目削除 + delete $this->data->{$key}; + } + $this->set_modified; + $this->queue_cleanup; + # deleted + return $count; + } + + # not deleted + return 0; + }); +} + +*add_value = \&add_array; +*del_value = \&del_array; +*del_key = \&del_array; + +1; diff -urN /non-existant-dir/module/Tools/HashDB.pm tiarra-20050322/module/Tools/HashDB.pm --- /non-existant-dir/module/Tools/HashDB.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/HashDB.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,220 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: HashDB.pm 803 2005-02-28 22:41:29Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003-2004 Topia . all rights reserved. + +# GroupDB の1レコード分のデータを保持する。 + +# - 情報(注意) - +# * キー名に半角スペースは含められません。 error が出ます。 +# * 値の先頭、最後にある空白文字(\s)は読み込み時に消失します。 +# * 機能不足です。 +# * コードが読みにくいです。 + +# technical information +# - datafile format +# | abc: def +# -> key 'abc', value 'def' +# | : abc : def +# -> key ':abc:', value 'def' +# LINE := KEY ANYSPACES [value] ANYSPACES が基本。 +# KEY := ANYSPACES [keyname] ANYSPACES ':' || ANYSPACES ':' [keyname] ':' +# ANYSPACES := REGEXP:\s* +# [keyname] にはコロンをスペースに変換したキー名が入る。 +# キー名の先頭または最後にスペースがある場合は、KEYの後者のフォーマットを使用する。 +# [value] はそのまま。つまり複数行になるデータは追加できない。エラーを出すべきか? + +package Tools::HashDB; +use strict; +use warnings; +use IO::File; +use File::stat; +use Tiarra::Encoding; +use Mask; +use Carp; +use Module::Use qw(Tools::Hash Tools::HashTools); +use Tools::Hash; +use Tools::HashTools; +use Tiarra::Utils; +use Tiarra::ModifiedFlagMixin; +use Tiarra::SessionMixin; +use base qw(Tiarra::SessionMixin); + +sub new { + # コンストラクタ + + # - 引数 - + # $fpath : 保存するファイルのパス。空ファイル or undef でファイルに関連付けられないDBが作成されます。 + # $charset : ファイルの文字セットを指定します。省略すれば UTF-8 になります。 + # $use_re : 値の検索/一致判定に正規表現拡張を使うかどうか。省略されれば使いません。 + # $ignore_proc + # : 無視する行を指定するクロージャ。行を引数に呼び出され、 true が返ればその行を無視します。 + # ここで ignore された行は解析さえ行いませんので、 + # $split_primary=0でも区切りと認識されたりはしません。 + # 一般的な注意として、この状態のデータベースが保存された場合は ignore された行は全て消滅します。 + + my ($class,$fpath,$charset,$use_re,$ignore_proc) = @_; + + my $this = { + time => undef, # ファイルの最終読み込み時刻 + fpath => $fpath, + charset => $charset || 'utf8', # ファイルの文字コード + use_re => $use_re || 0, + ignore_proc => $ignore_proc || sub { $_[0] =~ /^\s*#/; }, + + database => undef, # HASH + }; + + bless $this,$class; + $this->clear_modified; + $this->_session_init; + $this->_load; +} + +__PACKAGE__->define_attr_accessor(0, + qw(time fpath charset), + qw(use_re)); +__PACKAGE__->define_proxy('database', 0, + qw(keys values), + qw(add_value add_array del_value del_array), + qw(get_array get_value get_value_random)); +__PACKAGE__->define_session_wrap(0, + qw(checkupdate synchronize cleanup)); + +sub _load { + my $this = shift; + + my $database = Tools::Hash->new; + + if (defined $this->fpath && $this->fpath ne '') { + my $fh = IO::File->new($this->fpath,'r'); + if (defined $fh) { + my $unicode = Tiarra::Encoding->new; + foreach (<$fh>) { + my $line = $unicode->set($_, $this->charset)->get; + next if $this->{ignore_proc}->($line); + my ($key,$value) = grep {defined($_)} + ($line =~ /^\s*(?:([^:]+?)\s*|:([^:]+?)):\s*(.+?)\s*$/); + if (!defined $key || $key eq '' || + !defined $value || $value eq '') { + # ignore + } else { + # can use colon(:) on key, but cannot use space( ). + $key =~ s/ /:/g; + $database->add_value($key, $value); + } + } + $this->{database} = $database; + $this->set_time; + $this->clear_modified; + } + } + return $this; +} + +sub _checkupdate { + my $this = shift; + + if (defined $this->fpath && $this->fpath ne '') { + my $stat = stat($this->fpath); + + if (defined $stat && defined $this->time && + $stat->mtime > $this->time) { + $this->_load(); + return 1; + } + } + return 0; +} + +sub _synchronize { + my $this = shift; + my $force = shift || 0; + + if (defined $this->fpath && $this->fpath ne '' && + ($this->modified || $force)) { + my $fh = IO::File->new($this->fpath,'w'); + if (defined $fh) { + my $unicode = Tiarra::Encoding->new; + while (my ($key,$values) = each %{$this->{database}}) { + $key =~ s/:/ /g; # can use colon(:) on key, but cannot use space( ). + # \s が先頭/最後にあった場合読み込みで消え去るのでそれを防止。 + $key = ':' . $key if ($key =~ /^\s/ || $key =~ /\s$/); + map { + my $line = "$key: " . $_ . "\n"; + $fh->print($unicode->set($line)->conv($this->{charset})); + } @$values + } + $this->set_time; + $this->clear_modified; + } + } + return $this; +} + +sub set_time { shift->time(CORE::time); } + +sub database { + my $this = shift; + return $this->with_session(sub{$this->{database};}); +} +*to_hashref = \&database; + +sub _before_session_start { + my $this = shift; + $this->_checkupdate; +} + +sub _after_session_finish { + my $this = shift; + $this->_synchronize; +} + +# group misc functions +sub dup_group { + # グループの複製を行います。 + + my ($group) = @_; + my ($new_group) = {}; + + return undef unless defined($group); + + map { + $new_group->{$_} = $group->{$_}; + } CORE::keys(%$group); + + return $new_group; +} + +sub concat_string_to_key { + # prefix や suffix を group の key に付加します。 + + # - 引数 - + # $group : グループ。 + # $prefix : prefix 文字列 ('to.' とか 'from.' とか) + # $suffix : suffix 文字列 + my ($group, $prefix, $suffix) = @_; + my ($new_group) = {}; + + $prefix = '' unless defined($prefix); + $suffix = '' unless defined($suffix); + + map { + $new_group->{$prefix . $_ . $suffix} = $group->{$_}; + } CORE::keys(%$group); + + return $new_group; +} + +# replace support functions +sub replace_with_callbacks { + # マクロの置換を行なう。%optionalは置換に追加するキーと値の組みで、省略可。 + # $callbacksはgroup/optionalで置換できなかった際に呼び出されるコールバック関数のリファレンス。 + # optionalの値はSCALARでもARRAYでも良い。 + my ($this,$str,$callbacks,%optional) = @_; + my $main_table = %{$this->to_hashref}; + return Tools::HashTools::replace_recursive($str,[$main_table,\%optional],$callbacks); +} + +1; diff -urN /non-existant-dir/module/Tools/HashTools.pm tiarra-20050322/module/Tools/HashTools.pm --- /non-existant-dir/module/Tools/HashTools.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/HashTools.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,161 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: HashTools.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. + +# ハッシュをフォーマットする関数群。 + +package Tools::HashTools; + +sub get_value_random { + my ($hash, $key) = @_; + + my $values = get_array($hash, $key); + if ($values) { + # 発見. どれか一つ選ぶ。 + my $idx = int(rand() * hex('0xffffffff')) % @$values; + return $values->[$idx]; + } + return undef; +} + +sub get_value { + my ($hash, $key) = @_; + + my $values = get_array($hash, $key); + if ($values) { + # 発見. + return $values->[0]; + } + return undef; +} + +sub get_array { + my ($hash, $key) = @_; + + my $value = $hash->{$key}; + if (defined $value) { + # 発見 + if (ref($value) eq 'ARRAY') { + return $value; + } else { + return [$value]; + } + last; + } + return undef; +} + +sub replace_recursive { + # ()がネスト可能な_replace. + + # ていうか ad hoc 過ぎる気がするなあ。良い解析方法無いかな。 + + my ($str,$hashtables,$callbacks) = @_; + + return '' if !defined($str) || ($str eq ''); + + my $start = 0; + my $end; + my $pos; + while (($pos = $start = index($str, '#(', $start)) != -1) { + # 検索開始。 + my $level = 1; + do { + # こっかを探す。 + $end = index($str, ')', $pos + 1); + if ($end == -1) { + # こっかが無い。困ったことになったが、終わった後にこっかがあったことにして誤魔化そう。 + $str .= ')'; + $end = length($str); + last; + } + + # かっこを探す。 + my $next = index($str, '(', $pos + 2); + if ($next == -1 || $next > $end) { + # かっこが無かったか、こっかより後。階層レベルを減らして検索位置を次のこっかに移す。 + $pos = $end; + $level--; + } else { + # こっかより前にかっこがあった。階層レベルを増やして繰り返す。 + $pos = $next; + $level++; + } + } while ($level > 0); # 階層レベルが0になるまで繰り返し。 + # こっかの前までを抽出範囲とする。 + $end--; + #proc $start to $end + my $work = substr($str, $start + 2, $end - $start - 1); + $work = _replace($work,$hashtables,$callbacks); + substr($str, $start, $end - $start + 2) = $work; + $start = $start + length($work); + } + + return $str; +} + +sub _replace { + my ($str,$hashtables,$callbacks) = @_; + + # variables := variable ( '|' variable )* + # variable := key ( ';' format )? + foreach my $variable (split /\|/,$str) { + my ($key, $format) = split(/;/,$variable,2); + my ($ret) = undef; + if (defined($key) && $key ne '') { + foreach my $table (@$hashtables) { + $ret = get_value($table, $key); + last if (defined $ret); + } + if (!defined $ret) { + # not found. + foreach my $callback (@$callbacks) { + if (defined $callback) { + # callback function definition: func($key, [hashtables], [callbacks]); + my $value = $callback->($key, $hashtables, $callbacks); + if (defined $value) { + $ret = $value; + last; + } + } + } + } + } else { + # callback等がエラーを吐くので強制的に''を入れる。 + $ret = ''; + } + if (defined $ret) { + if (defined $format) { + return _format($format,$ret,$hashtables,$callbacks); + } else { + return $ret; + } + } + } + # 最終的に見付からなければ$strそのものを返す。 + return $str; +} + +sub _format { + # %s形式の値をフォーマットする。 + # replace_recursiveを呼び出して再帰変換も行う。 + my ($str,$value,$hashtables,$callbacks) = @_; + + $str = replace_recursive($str,$hashtables,$callbacks); + $str =~ s/%(.)/_format_percent($1, $value)/eg; + return $str; +} + +sub _format_percent { + $char = shift; + + if ($char eq 's') { + return $_[0]; + } else { + return $char; + } +} + +1; diff -urN /non-existant-dir/module/Tools/LinedDB.pm tiarra-20050322/module/Tools/LinedDB.pm --- /non-existant-dir/module/Tools/LinedDB.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/LinedDB.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,303 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: LinedDB.pm 803 2005-02-28 22:41:29Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package Tools::LinedDB; +use strict; +use warnings; +use IO::File; +use File::stat; +use Tiarra::Encoding; +use Mask; +use Carp; + +sub new { + my ($class, %arg) = @_; + + foreach my $key qw(Parse Build Compare Update Hash) { + croak($key . ' should be undef or code reference!') + unless !defined($arg{$key}) || (ref($arg{$key}) eq 'CODE'); + } + + # Compare も Hash も既定を使う場合は、 Hash には _do_nothing を使う。 + $arg{'Hash'} = \&_do_nothing if !defined($arg{'Compare'}) && !defined($arg{'Hash'}); + + my $this = + { + database => [], + fpath => $arg{'FilePath'}, + charset => $arg{'Charset'} || 'utf8', + parse_func => $arg{'Parse'} || \&_do_nothing, + build_func => $arg{'Build'} || \&_do_nothing, + compare_func => $arg{'Compare'} || \&_do_compare_default, + update_callback => $arg{'Update'} || \&_do_nothing, + hash_func => $arg{'Hash'}, + time => undef, # ファイルの最終読み込み時刻 + }; + + # Build が指定されているのに Compare が既定のときは build してから compare する。 + if (defined($arg{'Build'}) && !defined($arg{'Compare'})) { + $this->{compare_func} = sub { + return _do_compare_default(map { + $this->{build_func}->($_); + } @_); + }; + } + + bless $this, $class; + + return $this->_load; +} + +sub _load { + my ($this) = @_; + if (defined $this->{fpath} && $this->{fpath} ne '') { + $this->{database} = []; + my $fh = IO::File->new($this->{fpath},'r'); + if (defined $fh) { + my $unicode = Tiarra::Encoding->new; + foreach my $line (<$fh>) { + chomp $line; + map { + push @{$this->{database}}, $_; + } $this->{parse_func}->($unicode->set($line,$this->{charset})->get); + } + $this->{time} = time(); + } + } + + $this->{update_callback}->(); + return $this; +} + +sub synchronize { + my ($this) = @_; + if (defined $this->{fpath} && $this->{fpath} ne '') { + my $fh = IO::File->new($this->{fpath},'w'); + if (defined $fh) { + my $unicode = Tiarra::Encoding->new; + foreach my $line (@{$this->{database}}) { + map { + $fh->print($unicode->set($_ . "\n")->conv($this->{charset})); + } $this->{build_func}->($line); + } + $this->{time} = time(); + } + } + + $this->{update_callback}->(); + return $this; +} + +sub checkupdate { + my ($this) = @_; + + if (defined $this->{fpath} && $this->{fpath} ne '') { + my $stat = stat($this->{fpath}); + + if (defined($stat) && ($stat->mtime > $this->{time})) { + $this->_load(); + } + } +} + +sub length { + my ($this) = @_; + + $this->checkupdate(); + return scalar(@{$this->{database}}); +} + +sub index { + my ($this, $index) = @_; + + return $this->indexes($index); +} + +sub indexes { + my ($this, @indexes) = @_; + + $this->checkupdate(); + if (wantarray) { + return map { + $this->{database}->[$_]; + } @indexes; + } else { + return undef unless @indexes; + return $this->{database}->[$indexes[0]]; + } +} + +sub get_value { + my ($this) = @_; + + $this->checkupdate(); + if (@{$this->{database}} == 0) { + return undef; + } else { + my $idx = int(rand() * hex('0xffffffff')) % @{$this->{database}}; + return $this->index($idx); + } +} + +sub get_array { + my ($this) = @_; + + $this->checkupdate(); + return @{$this->{database}}; +} + +sub set_value { + my ($this, $index, $value) = @_; + + $this->checkupdate(); + $this->{database}->[$index] = $value; + $this->synchronize(); + return $this; +} + +sub set_array { + my ($this, @array) = @_; + + $this->checkupdate(); + @{$this->{database}} = @array; + $this->synchronize(); + return 0; +} + +sub find_index { + my ($this, $value) = @_; + + return $this->find_indexes($value, 1); +} + +sub find_indexes { + my ($this, $value, $count) = @_; + my (@indexes) = (); + + my ($return) = sub { + if (wantarray) { + return @indexes; + } else { + return $indexes[0] || undef; + } + }; + + my $raw_value = $value; + $this->checkupdate(); + for ( my $i = (@{$this->{database}} - 1) ; $i >= 0 ; --$i ) { + if ($this->{compare_func}->($this->{database}->[$i], $raw_value) == 0) { + push(@indexes, $i); + if (defined($count) && @indexes >= $count) { + return $return->(); + } + } + } + + return $return->(); +} + +sub find_value { + my ($this, $value) = @_; + + return $this->find_values($value, 1); +} + +sub find_values { + my ($this, $value, $count) = @_; + + return $this->indexes($this->find_indexes($value, $count)); +} + +sub add_value { + my ($this, $value) = @_; + + $this->checkupdate(); + push(@{$this->{database}}, $value); + $this->synchronize(); + + return 1; +} + +sub add_value_unique { + my ($this, $value) = @_; + + if (!defined($this->find_value($value))) { + return $this->add_value($value); + } + + return 0; +} + +sub del_value { + my ($this, $value, $count) = @_; + + my $raw_value = $value; + $this->checkupdate(); + my ($deleted_count) = 0; + for ( my $i = (@{$this->{database}} - 1) ; $i >= 0 ; --$i ) { + if ($this->{compare_func}->($this->{database}->[$i], $raw_value) == 0) { + # equal. delete. + splice(@{$this->{database}}, $i, 1); + ++$deleted_count; + if (defined($count) && $deleted_count >= $count) { + $this->synchronize(); + return $deleted_count; + } + } + } + + $this->synchronize(); + return $deleted_count; +} + +sub del_value_single { + my ($this, $value) = @_; + + return $this->del_value($value, 1); +} + +sub simplify { + my ($this) = @_; + + $this->checkupdate(); + if (defined($this->{hash_func})) { + # hash mode. + my (%buf); + @{$this->{database}} = grep { + if (defined($buf{$this->{hash_func}->($_)})) { + # not found past. + $buf{$this->{hash_func}->($_)} = 1; + 1; + } else { + 0; + } + } @{$this->{database}}; + } else { + # compare mode. + + # hash_func が登録されてない場合、hash を使った整理は compare_func の定義に依るので不可。 + # 単純に比較することになるため、非常に重くなるであろう。 + + # 未実装。 + croak('not specified hash function. this mode hasn\'t implemented yet.'); + } + + $this->synchronize(); + return $this; +} + +sub _do_nothing { + # なにもせずただ値を返す + return wantarray ? @_ : $_[0]; +} + +sub _do_compare_default { + # デフォルトの比較関数。 + my ($a, $b) = @_; + + return ($a cmp $b); +} + +1; diff -urN /non-existant-dir/module/Tools/MailSend/EachServer.pm tiarra-20050322/module/Tools/MailSend/EachServer.pm --- /non-existant-dir/module/Tools/MailSend/EachServer.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/MailSend/EachServer.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,668 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: EachServer.pm 803 2005-02-28 22:41:29Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. +package Tools::MailSend::EachServer; +use strict; +use warnings; +use Module::Use qw(Tools::DateConvert); +use Tools::DateConvert; +use RunLoop; +use LinedINETSocket; +use Tiarra::Encoding; + +my $E_MAIL_EOL = "\x0d\x0a"; + +# constant +my $STATE_NONE = 0; +my $STATE_POP3 = 1; +my $STATE_SMTP = 2; + +my $DATA_TYPE_ARRAY = 0; +my $DATA_TYPE_INNER_ITER = 1; + +sub new { + my ($class, %data) = @_; + + return undef unless defined($data{'cleaner'}); + + my $this = { + use_pop3 => 0, + pop3_host => 'localhost', + pop3_port => getservbyname('pop3', 'tcp') || 110, + pop3_user => (getpwuid($>))[0], + pop3_pass => '', + pop3_expire => 0, + + smtp_host => 'localhost', + smtp_port => getservbyname('smtp', 'tcp') || 25, + smtp_fqdn => 'localhost', + + # cleaner is destruction function. + cleaner => undef, + + # parent local datas + local => undef, + + expire_time => undef, + state => undef, + # undef: not found + # other: $STATE_* + + local_state => undef, + # undef: not found + # other: unknown. + + queue => [], + + sock => undef, + + esmtp_capable => [], + + hook => undef, + + timer => undef, + + }; + + # failsafe timer + $this->{timer} = + Timer->new( + Interval => 5, + Repeat => 1, + Code => sub { + my ($timer) = @_; + $this->main_loop(); + } + )->install; + + bless $this, $class; + + foreach my $key (keys %data) { + $this->_set_data($key, $data{$key}); + } + + return $this; +} + +#--- constant --- +sub DATA_TYPES { + return { + array => $DATA_TYPE_ARRAY, # data に送信行の raw data を渡す。 + inner_iter => $DATA_TYPE_INNER_ITER, # data にコールバック関数を渡す。 + }; +} + +#--- server info --- +sub get_data { + my ($this, $name) = @_; + + return undef unless + grep {$name eq $_} + (qw(local cleaner use_pop3), + (map { 'pop3_' . $_ } qw(host port user pass expire)), + (map { 'smtp_' . $_ } qw(host port fqdn))); + return $this->{$name}; +} + +sub _set_data { + my ($this, $name, $value) = @_; + + return undef unless + grep {$name eq $_} + (qw(local cleaner use_pop3), + (map { 'pop3_' . $_ } qw(host port user pass expire)), + (map { 'smtp_' . $_ } qw(host port fqdn))); + + $this->{$name} = $value; + return 1; +} + +sub mail_send_reserve { + my ($this, %arg) = @_; + + return 1 unless $arg{'env_from'}; + return 1 unless $arg{'env_to'}; + return 1 unless $arg{'data'}; + + push(@{$this->{queue}}, { + # local + local => $arg{'local'}, + + # sender + sender => $arg{'sender'} || undef, + + # queue priority + priority => $arg{'priority'} || 0, + + # envelope from + env_from => $arg{'env_from'}, + + # envelope to [array] + env_to => $arg{'env_to'}, + + # header from + from => $arg{'from'}, + + # header to + to => $arg{'to'} || undef, + + # header subject + subject => $arg{'subject'} || undef, + + # data type [0=array, 1=inner_iter] + data_type => $arg{'data_type'}, + + # data + data => $arg{'data'}, + + # reply ok + reply_ok => $arg{'reply_ok'} || \&_do_nothing, + + # reply error + reply_error => $arg{'reply_error'} || \&_do_nothing, + + # reply fatal + reply_fatal => $arg{'reply_fatal'} || \&_do_nothing, + }); + # if state is undef (not processing), start. + $this->{state} = $STATE_NONE unless defined($this->{state}); + # continue_loop + $this->main_loop(); + + return 0; +} + +sub _do_nothing { + # noop func +} + +sub clean { + my ($this) = @_; + + $this->{cleaner}->($this); + undef $this->{cleaner}; + $this->{hook}->uninstall if defined($this->{hook}); + $this->{hook} = undef; + $this->{timer}->uninstall if defined($this->{timer}); + $this->{timer} = undef; +} + +sub main_loop { + my ($this) = @_; + my ($state) = $this->{state}; + + if (!defined($state)) { + # if undef, nothing to process + if (!defined($this->{expire_time}) || $this->{expire_time} < time()) { + return $this->clean(); + } + return; + } + # activate hook + if (!defined($this->{hook})) { + $this->{hook} = RunLoop::Hook->new( + sub { + my ($hook) = @_; + $this->main_loop(); + })->install('before-select'); + } + + if ($state == $STATE_NONE) { + $state = $STATE_SMTP; # fallback + if ($this->{use_pop3} && !defined($this->{expire_time})) { + $state = $STATE_POP3; + } + } + + $this->{state} = $state; + + if ($state == $STATE_POP3) { + $this->_state_pop3(); + } elsif ($state == $STATE_SMTP) { + $this->_state_smtp(); + } +} + + +# --- pop3 --- +sub _state_pop3 { + my ($this) = @_; + + if (!defined($this->{sock})) { + $this->{sock} = $this->_open_pop3(); + if (!defined($this->{sock})) { + RunLoop->shared->notify_warn('mesmail: cannot connect pop3, but start smtp.'); + $this->{state} = $STATE_SMTP; + return; + } else { + $this->{local_state} = 'FIRST'; + } + } + while ($this->_do_pop3()) { + # noop + }; +} + + +sub _open_pop3 { + my ($this) = @_; + my ($host, $port, $sock); + + $host = $this->{pop3_host}; + $port = $this->{pop3_port}; + + $sock = LinedINETSocket->new($E_MAIL_EOL)->connect($host, $port); + + return undef unless (defined $sock); + return $sock; +} + +sub _do_pop3 { + my ($this) = @_; + my ($local_state) = $this->{local_state}; + my ($sock) = $this->{sock}; + + # wait +OK + my ($line) = $sock->pop_queue(); + return 0 unless defined($line); # none data received + if (substr($line, 0, 3) ne '+OK') { + # error + RunLoop->shared->notify_warn('mesmail: pop3 send command "'.$local_state.'" reply is not OK...'); + RunLoop->shared->notify_warn('mesmail: message is ' . $line); + RunLoop->shared->notify_warn('mesmail: but start smtp.'); + $this->_close_pop3(); + return undef; + } else { + if ($local_state eq 'FIRST') { + # send USER + $this->{local_state} = 'USER'; + $sock->send_reserve('USER ' . $this->{pop3_user}); + } elsif ($local_state eq 'USER') { + # send PASS + $this->{local_state} = 'PASS'; + $sock->send_reserve('PASS ' . $this->{pop3_pass}); + } elsif ($local_state eq 'PASS') { + # send STAT + $this->{local_state} = 'STAT'; + $sock->send_reserve("STAT"); + } elsif ($local_state eq 'STAT') { + # close pop3 + $this->{expire_time} = time() + ($this->{pop3_expire} * 60); + $this->_close_pop3(); + return 0; + } + return 1; + } + return 0; # this return is not used +} + +sub _close_pop3 { + my ($this) = @_; + my ($sock) = $this->{sock}; + + $sock->send_reserve('QUIT'); + $sock->disconnect_after_writing(); + $sock->flush(); # flush + $this->{sock} = undef; + $this->{local_state} = undef; + $this->{state} = $STATE_SMTP; + + $this->main_loop(); + + return undef; +} + + +# --- smtp --- +sub _state_smtp { + my ($this) = @_; + + if (!defined($this->{sock})) { + $this->{sock} = $this->_open_smtp(); + if (!defined($this->{sock})) { + $this->_reply_smtp_error(undef, 'CONNECT'); # undef is all + $this->{state} = undef; + return; + } else { + $this->{local_state} = 'FIRST'; + } + } + while ($this->_do_smtp()) { + # noop + } +} + +sub _open_smtp { + my ($this) = @_; + my ($host, $port, $sock); + + $host = $this->{smtp_host}; + $port = $this->{smtp_port}; + + $sock = LinedINETSocket->new($E_MAIL_EOL)->connect($host, $port); + + return undef unless (defined $sock); + return $sock; +} + +sub _do_smtp { + my ($this, $input) = @_; + my ($local_state) = $this->{local_state}; + my ($sock) = $this->{sock}; + my $line; + + if (defined($input)) { + $line = $input; + } else { + $line = $sock->pop_queue(); + } + return 1 unless defined($line); # queue is empty + my ($reply) = substr($line, 0, 4); + if ($local_state eq 'FIRST') { + # first reply: server info. + if ($reply eq '220 ') { + # message end + $this->{local_state} = 'EHLO'; + $sock->send_reserve('EHLO ' . $this->{smtp_fqdn}); + } else { + # error + $this->_reply_smtp_error(undef, $local_state, $line); # all stack + $this->_close_smtp(); + $this->clean(); + } + } elsif ($local_state eq 'EHLO') { + if ($reply eq '250-') { + push(@{$this->{esmtp_capable}}, substr($line, 5)); + } elsif ($reply eq '250 ') { + # end of esmtp capable + push(@{$this->{esmtp_capable}}, substr($line, 5)); + # ここでHELOと処理を一本化するためにSTART_MAILとしてrecursive. + $this->{local_state} = 'START_MAIL'; + return $this->_do_smtp('THROUGH'); + } else { + # error. use HELO instead of EHLO + $this->{local_state} = 'HELO'; + $sock->send_reserve('HELO ' . $this->{smtp_fqdn}); + } + } elsif ($local_state eq 'HELO') { + if ($reply eq '250 ') { + # ここでEHLOと処理を一本化するためにSTART_MAILとしてrecursive. + $this->{local_state} = 'START_MAIL'; + return $this->_do_smtp('THROUGH'); + } else { + # error + $this->_reply_smtp_error(undef, $local_state, $line); # all stack + $this->_close_smtp(); + $this->clean(); + } + } elsif ($local_state eq 'START_MAIL') { + # initialize mail + + $this->{queue}->[0]->{rcpt_ok_addrs} = 0; + $this->{queue}->[0]->{to_seps} = [@{$this->{queue}->[0]->{env_to}}]; # duplicate + + $this->{local_state} = 'MAILFROM'; + $sock->send_reserve('MAIL FROM:<' . $this->{queue}->[0]->{env_from} . '>'); + } elsif ($local_state eq 'MAILFROM') { + if ($reply eq '250 ') { + # initialize rcpt + my ($newaddr) = shift(@{$this->{queue}->[0]->{to_seps}}); + $this->{local_state} = 'RCPTTO'; + $sock->send_reserve('RCPT TO:<' . $newaddr . '>'); + } else { + #error + $this->_reply_smtp_error(0, $local_state, $line); + return $this->_smtp_send_final(); # smtp mail send が終了したものとみなす。 + } + } elsif ($local_state eq 'RCPTTO') { + my ($newaddr); + if ($reply eq '551 ') { + # more simple + $line =~ /\<([^\<\>]*)\>/; + $newaddr = $1; + } elsif ($reply =~ /25[01] /) { + $this->{queue}->[0]->{rcpt_ok_addrs}++; + $newaddr = shift(@{$this->{queue}->[0]->{to_seps}}); + } else { + # error + $line =~ /\<([^\<\>]*)\>/; # use mail_address entry for error msg. + $this->_reply_smtp_error(0, $local_state, $line, $1); + # 無視して次へ。 + $newaddr = shift(@{$this->{queue}->[0]->{to_seps}}); + } + if (defined($newaddr)) { + $sock->send_reserve('RCPT TO:<' . $newaddr . '>'); + } else { + if ($this->{queue}->[0]->{rcpt_ok_addrs}) { + # ok. + $this->{local_state} = 'DATA'; + $sock->send_reserve('DATA'); + } else { + # no rcpt addrs. + # error は既にメッセージを返している。 + $this->_reply_smtp_error(0, 'NORCPTTO'); + return $this->_smtp_send_final(); # smtp mail send が終了したものとみなす。 + } + } + } elsif ($local_state eq 'DATA') { + if ($reply eq '354 ') { + # go ahead + my ($struct) = $this->{queue}->[0]; + + $sock->send_reserve('To: ' . $struct->{to}); + foreach my $send_line + (&mime_unstructured_header_array( + "Subject: " . Tiarra::Encoding->new($struct->{subject})->euc)) { + $sock->send_reserve($send_line); + } + $sock->send_reserve('MIME-Version: 1.0'); + $sock->send_reserve('Content-Type: text/plain; charset=iso-2022-jp'); + $sock->send_reserve('Content-Transfer-Encoding: 7bit'); + $sock->send_reserve('Message-Id: ' . do { + # message-id := '<' time(epoc) rand-value '.' pid '.' envelope-from '>' + # time := epoc time (now) + # rand-value := [0-9]{,6} + # pid := [1-9][0-9]* + # envelope-from := email-addr + # example: Message-Id: <1046695839413024.2151.topia@clovery.jp> + '<' . time().int(rand()*1000000).".$$.".$struct->{env_from}.'>'; + }); + $sock->send_reserve('Date: ' . do { + # example: Tue, 04 Mar 2003 11:10:24 +0900 + Tools::DateConvert::replace('%a, %d %b %Y %H:%M:%S %z', time()); + }); + $sock->send_reserve('From: ' . $struct->{from}) if defined($struct->{from}); + $sock->send_reserve(''); + + my ($socksend) = sub { + foreach my $send_line (@_) { + $send_line =~ s/[\x0d\x0a]+//; + $send_line = '..=' if $send_line eq '.'; + $sock->send_reserve(Tiarra::Encoding->new($send_line)->h2zKana->jis); + } + $sock->flush(); + }; + + if ($struct->{data_type} == $DATA_TYPE_ARRAY) { + $socksend->(@$struct->{data}); + } elsif ($struct->{data_type} == $DATA_TYPE_INNER_ITER) { + $struct->{data}->($struct, $socksend); + } + + $sock->send_reserve('.'); + $this->{local_state} = 'FINISH'; + } else { + $this->_reply_smtp_error(0, $local_state, $line); + } + } elsif ($local_state eq 'FINISH') { + if ($reply eq '250 ') { + # finalize + $this->_reply_smtp_ok(0); + return $this->_smtp_send_final(); + } else { + # error + $this->_reply_smtp_error(0, $local_state, $line); + return $this->_smtp_send_final(); + } + } else { + die 'unknown LOCAL_STATE "' . $local_state . '".'; + } + + return 1; +} + +sub _smtp_send_final { + my ($this) = @_; + + shift(@{$this->{queue}}); + if (@{$this->{queue}}) { + # more queue. + if (scalar(@{$this->{queue}}) != 1 && (grep {$_->{priority} != 0} @{$this->{queue}})) { + # have key having priority. and queue isn't single. + @{$this->{queue}} = sort { $a->{priority} <=> $b->{priority}} @{$this->{queue}}; + } + # START_MAILにしてrecursive. + $this->{local_state} = 'START_MAIL'; + return $this->_do_smtp('THROUGH'); + } else { + # close smtp + $this->_close_smtp(); + $this->{hook}->uninstall; + $this->{hook} = undef; + } +} + +sub _close_smtp { + my ($this) = @_; + my ($sock) = $this->{sock}; + + $sock->send_reserve('QUIT'); + $sock->disconnect_after_writing(); + $sock->flush(); # flush + $this->{sock} = undef; + $this->{local_state} = undef; + $this->{state} = undef; + $this->{esmtp_capable} = []; + + return undef; +} + +sub _reply_smtp_error { + my ($this, $session, $state, $line, $info) = @_; + # 使用者にerrorを返すメソッド。$infoには送信失敗のmail addressが含まれるはずだが、 + # channelに向かってmail addressを広報することになるので使用しないことを勧める。 + # なお、from/toにはprivate指定されたものは含まれない。 + + # stateには失敗したときの状態が渡され、'error-mail' や 'fatalerror-connect' のように + # 状態別詳細メッセージを定義することが出来る。 + + # fatalerror は1送信者につき1つだけ返される(はず)。 + + if (defined($session)) { + my $struct = $this->{queue}->[$session]; + $struct->{reply_error}->($struct, $state, $line, $info); + } else { + my (@sended_from); + foreach my $struct (@{$this->{queue}}) { + next if grep{$_ == $struct->{sender};} @sended_from; + push(@sended_from, $struct->{sender}); + + $struct->{reply_fatal}->($struct, $state, $line, $info); + } + } +} + +sub _reply_smtp_ok { + my ($this, $session) = @_; + # 使用者にacceptを返すメソッド。 + # from/toにはprivate指定されたものは含まれない。 + + my $struct = $this->{queue}->[$session]; + + $struct->{reply_ok}->($struct); +} + +sub mime_unstructured_header_array { + return split(/\n/, mime_unstructured_header(@_)); +} + +# contrib +no strict; # i don't want fix these functions. + +# $str を encoded-word に変換し $line に追加する + +$ascii = '[\x00-\x7F]'; +$twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]'; +$threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]'; + +sub add_encoded_word { + my($str, $line) = @_; + my $result = ''; + + while (length($str)) { + my $target = $str; + $str = ''; + if (length($line) + 22 + + ($target =~ /^(?:$twoBytes|$threeBytes)/o) * 8 > 76) { + $line =~ s/[ \t\n\r]*$/\n/; + $result .= $line; + $line = ' '; + } + while (1) { + my $encoded = '=?ISO-2022-JP?B?' . + Tiarra::Encoding->new($target, 'euc')->h2zKana->conv('jis', 'base64') . '?='; + if (length($encoded) + length($line) > 76) { + $target =~ s/($threeBytes|$twoBytes|$ascii)$//o; + $str = $1 . $str; + } else { + $line .= $encoded; + last; + } + } + } + $result . $line; +} + +# unstructured header $header を MIMEエンコードする +# add_encoded_word() については上のスクリプトを参照 + +sub mime_unstructured_header { + my $oldheader = shift; + my($header, @words, @wordstmp, $i) = (''); + my $crlf = $oldheader =~ /\n$/; + $oldheader =~ s/\s+$//; + @wordstmp = split /\s+/, $oldheader; + for ($i = 0; $i < $#wordstmp; $i++) { + if ($wordstmp[$i] !~ /^[\x21-\x7E]+$/ and + $wordstmp[$i + 1] !~ /^[\x21-\x7E]+$/) { + $wordstmp[$i + 1] = "$wordstmp[$i] $wordstmp[$i + 1]"; + } else { + push(@words, $wordstmp[$i]); + } + } + push(@words, $wordstmp[-1]); + foreach $word (@words) { + if ($word =~ /^[\x21-\x7E]+$/) { + $header =~ /(?:.*\n)*(.*)/; + if (length($1) + length($word) > 76) { + $header .= "\n $word"; + } else { + $header .= $word; + } + } else { + $header = add_encoded_word($word, $header); + } + $header =~ /(?:.*\n)*(.*)/; + if (length($1) == 76) { + $header .= "\n "; + } else { + $header .= ' '; + } + } + $header =~ s/\n? $//mg; + $crlf ? "$header\n" : $header; +} + +1; diff -urN /non-existant-dir/module/Tools/MailSend.pm tiarra-20050322/module/Tools/MailSend.pm --- /non-existant-dir/module/Tools/MailSend.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/Tools/MailSend.pm 2005-03-23 09:18:49.000000000 +0900 @@ -0,0 +1,149 @@ +# -*- cperl -*- +# ----------------------------------------------------------------------------- +# $Id: MailSend.pm 535 2004-09-07 10:21:22Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2003 Topia . all rights reserved. + +# メール送信ラッパ。複数のサーバに非同期で送信する。 +# 実体は Tools::MailSend::EachServer に記述してあり、これはコントロールクラスである。 + +package Tools::MailSend; +use strict; +use warnings; +use Tiarra::SharedMixin; +use Module::Use qw(Tools::MailSend::EachServer); +use Tools::MailSend::EachServer; +our $_shared_instance; + +sub _new { + my ($class) = @_; + my $this = + { + # servers + servers => [], + # structure: + # server + + }; + bless $this, $class; + + return $this; +} + +sub mail_send { + # メール送信を行う。 + # 既存のサーバを探し(なければ作る)、それに丸投げします。 + + my ($this, %arg) = @_; + my ($server) = $this->_get_server(%arg); + + return $server->mail_send_reserve(%arg); +} + +sub _get_server { + my ($this, %args) = @_; + + return $this->{servers}->[$this->_get_server_index(%args)]; +} + +sub _get_server_index { + my ($this, %arg) = @_; + my (%data); + + # default value and convert struct + $data{'use_pop3'} = $arg{'use_pop3'} || 0; + $data{'pop3_host'} = $arg{'pop3_host'} || 'localhost'; + $data{'pop3_port'} = $arg{'pop3_port'} || getservbyname('pop3', 'tcp') || 110; + $data{'pop3_user'} = $arg{'pop3_user'} || (getpwuid($>))[0]; + $data{'pop3_pass'} = $arg{'pop3_pass'} || ''; + $data{'pop3_expire'} = $arg{'pop3_expire'} || 0; + $data{'smtp_host'} = $arg{'smtp_host'} || 'localhost'; + $data{'smtp_port'} = $arg{'smtp_port'} || getservbyname('smtp', 'tcp') || 25; + $data{'smtp_fqdn'} = $arg{'smtp_fqdn'} || 'localhost'; + $data{'local'} = + { + parent => $this, + }; + $data{'cleaner'} = \&_server_cleaner; + + # find. + my $i; + server: + for ($i = scalar(@{$this->{servers}}) - 1 ; $i >= 0 ; --$i) { + my $server = $this->{servers}->[$i]; + foreach my $key (keys %data) { + if ($key ne 'local') { + next server unless $data{$key} eq $server->get_data($key); + } else { + next server unless $data{$key}->{parent} eq $server->get_data($key)->{parent}; + } + } + # match. + return $i; + } + + # make. + my $idx = scalar(@{$this->{servers}}); # new entry! + $data{'local'}->{parent_index} = $idx; + my $server = Tools::MailSend::EachServer->new(%data); + push(@{$this->{servers}}, $server); + return $idx; +} + +sub _server_cleaner { + my ($server) = @_; + + my $this = $server->get_data('local')->{parent}; + my $idx = $server->get_data('local')->{parent_index}; + + splice(@{$this->{servers}}, $idx, 1); # remove server + return 0; +} + +sub _do_nothing { + # noop func +} + +#--- class method --- +sub DATA_TYPES { + return Tools::MailSend::EachServer::DATA_TYPES(); +} + +sub parse_mailaddrs { + my $sub = sub { + my ($temp) = @_; + $temp =~ s/,/\\,/; + $temp; + }; + + my (@addrs) = @_; + @addrs = map { + my ($temp) = $_; + $temp =~ s/\\,/,/g; + $temp; + } map { + split /\s*(?($1)/eg; + $temp; + } @addrs; + + if (wantarray) { + return map { + if ($_ =~ />$/) { + /<([^<]+)>$/; + $1; + } elsif ($_ =~ /"$/) { + ''; + } else { + $_; + } + } @addrs; + } else { + return [@addrs]; + } +} + +1; diff -urN /non-existant-dir/module/User/Away/Client.pm tiarra-20050322/module/User/Away/Client.pm --- /non-existant-dir/module/User/Away/Client.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/User/Away/Client.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,55 @@ +# ----------------------------------------------------------------------------- +# $Id: Client.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package User::Away::Client; +use strict; +use warnings; +use base qw(Module); +use RunLoop; +use IRCMessage; + +sub client_attached { + my ($this,$client) = @_; + # クライアントが接続されたという事は、 + # 少なくとも一つ以上のクライアントが存在するに決まっている。 + RunLoop->shared->broadcast_to_servers( + IRCMessage->new( + Command => 'AWAY')); +} + +sub client_detached { + my ($this,$client) = @_; + # クライアントの数が1(このメソッドから戻った後に0になる)ならAWAYを実行。 + if (@{RunLoop->shared->clients} == 1 && + defined $this->config->away) { + + RunLoop->shared->broadcast_to_servers( + IRCMessage->new( + Command => 'AWAY', + Param => $this->config->away)); + } +} + +sub connected_to_server { + my ($this,$server,$new_connection) = @_; + # クライアントの数が0ならAWAYを実行。 + if (@{RunLoop->shared->clients} == 0 && + defined $this->config->away) { + + $server->send_message( + IRCMessage->new( + Command => 'AWAY', + Param => $this->config->away)); + } +} + +1; + +=pod +info: クライアントが一つも接続されていない時にAWAYを設定します。 +default: off +section: important + +# どのようなAWAYメッセージを設定するか。省略された場合はAWAYを設定しません。 +-away: 居ない。 +=cut diff -urN /non-existant-dir/module/User/Away/Nick.pm tiarra-20050322/module/User/Away/Nick.pm --- /non-existant-dir/module/User/Away/Nick.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/User/Away/Nick.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,88 @@ +# ----------------------------------------------------------------------------- +# $Id: Nick.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +package User::Away::Nick; +use strict; +use warnings; +use base qw(Module); +use Mask; +use IRCMessage; +use Multicast; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + # クライアントから受け取ったNICKにのみ反応する。 + if ($sender->isa('IrcIO::Client') && + $msg->command eq 'NICK') { + + my $set_away; + foreach ($this->config->away('all')) { + my ($mask,$away_str) = m/^(.+?)\s+(.+)$/; + if (Mask::match($mask,$msg->param(0))) { + $this->set_away($msg,$away_str); + $set_away = 1; + last; + } + } + if (!$set_away) { + $this->unset_away($msg); + } + } + $msg; +} + +sub set_away { + my ($this,$msg,$away_str) = @_; + $this->away($msg, + IRCMessage->new( + Command => 'AWAY', + Param => $away_str)); +} + +sub unset_away { + my ($this,$msg) = @_; + $this->away($msg, + IRCMessage->new( + Command => 'AWAY')); +} + +sub away { + my ($this,$msg,$away_msg) = @_; + # NICK hoge@ircnetのようにネットワーク名が明示されていた場合は、 + # 全てのサーバーに対してAWAYを発行する。 + # そうでなければ明示されたネットワークにのみAWAYを発行する。 + + my (undef,$network_name,$specified) = Multicast::detach($msg->param(0)); + if ($specified) { + # 明示された + my $network = RunLoop->shared->network($network_name); + if (defined $network) { + $network->send_message($away_msg); + } + } + else { + # 明示されなかった + RunLoop->shared->broadcast_to_servers($away_msg); + } +} + +1; + +=pod +info: ニックネーム変更に応じて AWAY を設定します。 +default: off +section: important + +# ニックネームを変更したときに、そのニックネームに対応するAWAYが +# 設定されていれば、そのAWAYを設定します。そうでなければAWAYを取り消します。 + +# 書式: <設定するAWAYメッセージ> +# +# nickをhoge_zzzに変更すると、「寝ている」というAWAYを設定する。 +# hoge_workまたはhoge_zzzに変更した場合は、「仕事中」というAWAYを設定する。 +# それ以外のnickに変更した場合はAWAYを取り消す。 +# 後者は正規表現を利用して「away: re:hoge_(work|zzz) 仕事中」としても良い。 +-away: hoge_zzz 寝ている +-away: hoge_work,hoge_zzz 仕事中 +=cut diff -urN /non-existant-dir/module/User/Filter.pm tiarra-20050322/module/User/Filter.pm --- /non-existant-dir/module/User/Filter.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/User/Filter.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,40 @@ +# ----------------------------------------------------------------------------- +# $Id: Filter.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +package User::Filter; +use strict; +use warnings; +use base qw(Module); +use Mask; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + if ($sender->isa('IrcIO::Server') && + ($msg->command eq 'PRIVMSG' || $msg->command eq 'NOTICE')) { + # マッチするパターンを探す + foreach ($this->config->pattern('all')) { + my ($user,$replace) = m/^(.+?)\s+(.+)$/; + if (Mask::match($user,$msg->prefix)) { + # 一致した。 + $replace =~ s/#\(message\)/$msg->param(1)/eg; + $msg->param(1,$replace); + last; + } + } + } + + $msg; +} + +1; + +=pod +info: 指定された人物からのPRIVMSGやNOTICEを書き換える。 +default: off + +# 人物のマスクと、置換パターンを定義。 +# 置換パターン中の#(message)は、発言内容に置換されます。 +# 人物が複数のマスクに一致する場合は、最初に一致したものが使われます。 +pattern: *!*@* #(message) +=cut diff -urN /non-existant-dir/module/User/Ignore.pm tiarra-20050322/module/User/Ignore.pm --- /non-existant-dir/module/User/Ignore.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/User/Ignore.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,42 @@ +# ----------------------------------------------------------------------------- +# $Id: Ignore.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +package User::Ignore; +use strict; +use warnings; +use base qw(Module); +use Mask; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + # 鯖からクライアントへ向かうメッセージか？ + if ($sender->isa('IrcIO::Server')) { + # 対象となるコマンドか？ + if (Mask::match( + $this->config->command, + $msg->command)) { + # 全てのmaskをカンマで繋げてマッチングを行なう。 + if (Mask::match( + join(',',$this->config->mask('all')), + $msg->prefix || '')) { + # 最終的にマッチしたので、このメッセージは捨てる。 + return undef; + } + } + } + return $msg; +} + +1; +=pod +info: 指定された人間からのPRIVMSGやNOTICEを破棄してクライアントへ送らないようにするモジュール。 +default: off + +# 対象となるコマンドのマスク。省略時には"privmsg,notice"が設定されている。 +# ただしprivmsgとnotice以外を破棄してしまうと、(Tiarraは平気でも)クライアントが混乱する。 +command: privmsg,notice + +# maskは複数定義可能。定義された順番でマッチングが行なわれます。 +mask: example!*@*.example.net +=cut diff -urN /non-existant-dir/module/User/Kick.pm tiarra-20050322/module/User/Kick.pm --- /non-existant-dir/module/User/Kick.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/User/Kick.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,97 @@ +# ----------------------------------------------------------------------------- +# $Id: Kick.pm 540 2004-09-10 08:29:31Z topia $ +# ----------------------------------------------------------------------------- +package User::Kick; +use strict; +use warnings; +use base qw/Module/; +use Mask; +use Multicast; +use IRCMessage; +use Timer; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{queue} = {}; # network name => [IRCmessage,...] + $this->{timer} = undef; # queueが空でない時だけ必要になるTimer + $this; +} + +sub destruct { + my ($this) = @_; + if (defined $this->{timer}) { + $this->{timer}->uninstall; + $this->{timer} = undef; + } +} + +sub message_arrived { + my ($this, $msg, $sender) = @_; + + if ($sender->server_p && $msg->command eq 'JOIN' && defined $msg->nick) { + foreach (split m/,/,$msg->param(0)) { + my ($ch_full,$mode) = (m/^(.+?)(?:\x07(.*))?$/); + my $ch_short = Multicast::detatch($ch_full); + my $ch = $sender->channel($ch_short); + my $myself = $ch->names($sender->current_nick); + if ($myself->has_o && + Mask::match_deep_chan([$this->config->mask('all')],$msg->prefix,$ch_full)) { + # kickキューに入れる。 + $this->enqueue( + $sender->network_name, IRCMessage->new( + Command => 'KICK', + Params => [$ch_short, + $msg->nick, + $this->config->message || 'User::Kick'])); + } + } + } + + $msg; +} + +sub enqueue { + my ($this, $network_name, $command) = @_; + + my $queue = $this->{queue}->{$network_name}; + if (!defined $queue) { + $queue = $this->{queue}->{$network_name} = []; + } + push @$queue, $command; + $this->prepare_timer; +} + +sub prepare_timer { + my $this = shift; + # キュー消化タイマーが存在しなければ作る。 + if (!defined $this->{timer}) { + $this->{timer} = Timer->new( + Interval => 0, # 後で變へる + Repeat => 1, + Code => sub { + my $timer = shift; + $timer->interval(1); + + # 鯖毎に1つづつ消化する。 + my $queue_has_elem; + while (my ($network_name, $queue) = each %{$this->{queue}}) { + my $server = RunLoop->shared->network($network_name); + my $msg = shift @$queue; + $server->send_message($msg) if defined $server; + + if (@$queue > 0) { + $queue_has_elem = 1; + } + } + + # 全てのキューが空になつたら終了。 + if (!$queue_has_elem) { + $timer->uninstall; + $this->{timer} = undef; + } + })->install; + } +} + +1; diff -urN /non-existant-dir/module/User/Nick/Detached.pm tiarra-20050322/module/User/Nick/Detached.pm --- /non-existant-dir/module/User/Nick/Detached.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/User/Nick/Detached.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,60 @@ +# ----------------------------------------------------------------------------- +# $Id: Detached.pm 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# このモジュールはRunLoopのcurrent_nick、すなわちローカルnickを変更しない。 +# ----------------------------------------------------------------------------- +package User::Nick::Detached; +use strict; +use warnings; +use base qw(Module); +use IRCMessage; +use RunLoop; + +sub client_attached { + my ($this,$client) = @_; + # クライアントが接続されたという事は、 + # 少なくとも一つ以上のクライアントが存在するに決まっている。 + RunLoop->shared->broadcast_to_servers( + IRCMessage->new( + Command => 'NICK', + Param => RunLoop->shared->current_nick)); +} + +sub client_detached { + my ($this,$client) = @_; + # クライアントの数が1(このメソッドから戻った後に0になる)ならNICKを実行。 + if (@{RunLoop->shared->clients} == 1 && + defined $this->config->detached) { + + RunLoop->shared->broadcast_to_servers( + IRCMessage->new( + Command => 'NICK', + Param => $this->config->detached)); + } +} + +sub connected_to_server { + my ($this,$server,$new_connection) = @_; + # クライアントの数が0ならNICKを実行。 + if (@{RunLoop->shared->clients} == 0 && + defined $this->config->detached) { + + $server->send_message( + IRCMessage->new( + Command => 'NICK', + Param => $this->config->detached)); + } +} + +1; + +=pod +info: クライアントが接続されていない時に、特定のnickに変更します。 +default: off +section: important + +# クライアントが接続されていない時のnick。 +# このnickが既に使われていたら、適当に変更が加えられて使用されます。 +# クライアントが再び接続されると、切断前のローカルnickに戻ります。 +detached: PHO_d +=cut diff -urN /non-existant-dir/module/User/ServerOper.pm tiarra-20050322/module/User/ServerOper.pm --- /non-existant-dir/module/User/ServerOper.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/User/ServerOper.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,46 @@ +# ----------------------------------------------------------------------------- +# $Id: ServerOper.pm 540 2004-09-10 08:29:31Z topia $ +# ----------------------------------------------------------------------------- +package User::ServerOper; +use strict; +use warnings; +use base qw(Module); +use IRCMessage; + +sub new { + my $class = shift; + my $this = $class->SUPER::new(@_); + $this->{table} = do { + # ネットワーク名 => [オペレータ名,オペレータパスワード] + my %hash = map { + my ($network,$id,$pass) = m/^(.+?)\s+(.+?)\s+(.+)$/; + $network => [$id,$pass]; + } $this->config->oper('all'); + \%hash; + }; + $this; +} + +sub connected_to_server { + my ($this,$server,$new_connection) = @_; + my $oper = $this->{table}->{$server->network_name}; + if (defined $oper) { + $server->send_message( + IRCMessage->new( + Command => 'OPER', + Params => [$oper->[0],$oper->[1]])); + } +} + +1; + +=pod +info: 特定のネットワークに接続した時、OPERコマンドを発行します。 +default: off + +# 書式: <ネットワーク名> <オペレータ名> <オペレータパスワード> +# +# ネットワーク"local"に接続した時、オペレータ名oper、 +# オペレータパスワードoper-passでOPERコマンドを発行する例。 +-oper: local oper oper-pass +=cut diff -urN /non-existant-dir/module/User/Vanish.pm tiarra-20050322/module/User/Vanish.pm --- /non-existant-dir/module/User/Vanish.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/module/User/Vanish.pm 2005-03-23 09:18:48.000000000 +0900 @@ -0,0 +1,334 @@ +# ----------------------------------------------------------------------------- +# $Id: Vanish.pm 479 2004-08-20 23:55:47Z topia $ +# ----------------------------------------------------------------------------- +package User::Vanish; +use strict; +use warnings; +use base qw(Module); +use Mask; +use Multicast; +our $DEBUG = 0; + +sub message_arrived { + my ($this,$msg,$sender) = @_; + + my $result = $msg; + if ($sender->server_p) { + my $method = 'cmd_'.$msg->command; + if ($this->can($method)) { + if ($DEBUG) { + my $original = $msg->serialize; + $result = $this->$method($msg, $sender); + my $filtered = (defined $result ? $result->serialize : ''); + if ($original ne $filtered) { + # 内容が書換へられた。 + my $debug_msg = "'$original' -> '$filtered'"; + eval { + substr($debug_msg, 400) = '...'; + }; + RunLoop->shared->notify_msg($debug_msg); + } + } + else { + $result = $this->$method($msg, $sender); + } + } + } + elsif ($sender->client_p) { + if ($msg->command eq 'VANISHDEBUG') { + $DEBUG = $msg->param(0); + RunLoop->shared->notify_msg("User::Vanish - debug-mode ".($DEBUG?'enabled':'disabled')); + $result = undef; + } + } + + $result; +} + +*cmd_NOTICE = \&cmd_PRIVMSG; +sub cmd_PRIVMSG { + my ($this,$msg,$sender) = @_; + + # 発行元がVanish対象か？ + my $ch_long = $msg->param(0); + my $ch_short = Multicast::detach($ch_long); + if (Multicast::nick_p($ch_short)) { + $ch_long = '#___priv___@'.$sender->network_name; + } + + if ($this->target_of_vanish_p($msg->prefix,$ch_long)) { + undef; + } + else { + $msg; + } +} + +sub cmd_JOIN { + my ($this,$msg,$sender) = @_; + my @channels; # チャンネルリストを再構成する。 + foreach my $channel (split m/,/,$msg->param(0)) { + my ($ch_full,$mode) = ($channel =~ m/^([^\x07]+)(?:\x07(.*))?/); + if (!$this->target_of_vanish_p($msg->prefix,$ch_full)) { + push @channels,$channel; + } + } + + if (@channels > 0) { + # 再構成の結果、チャンネルがまだ残ってた。 + $msg->param(0,join(',',@channels)); + } + else { + $msg = undef; + } + + $msg; +} + +sub cmd_NJOIN { + my ($this,$msg,$sender) = @_; + my $ch_long = $msg->param(0); + my $ch_short = Multicast::detach($ch_long); + my $ch = $sender->channel($ch_short); + if (defined $ch) { + my @nicks; + foreach my $mode_and_nick (split m/,/,$msg->param(1)) { + my ($mode,$nick) = ($mode_and_nick =~ m/^([@+]*)(.+)$/); + my $person = $ch->names($nick); + if (!defined $person || !$this->target_of_vanish_p) { + push @nicks,$mode_and_nick; + } + } + + if (@nicks > 0) { + # 再構成の結果、nickがまだ残ってた。 + $msg->param(1,join(',',@nicks)); + } + else { + $msg = undef; + } + } + + $msg; +} + +sub cmd_PART { + my ($this,$msg,$sender) = @_; + if ($this->target_of_vanish_p($msg->prefix,$msg->param(0))) { + undef; + } + else { + $msg; + } +} + +sub cmd_INVITE { + my ($this,$msg,$sender) = @_; + if ($this->target_of_vanish_p($msg->prefix,$msg->param(1))) { + undef; + } + else { + $msg; + } +} + +*cmd_QUIT = \&cmd_NICK; +sub cmd_NICK { + my ($this,$msg,$sender) = @_; + + # 影響を及ぼした全チャンネル名のリストを得る。このリストにはネットワーク名が付いていない。 + my $affected = $msg->remark('affected-channels'); + # 一つでもVanish対象でないチャンネルとnickの組みがあれば、このNICKは破棄しない。 + my $no_vanish; + foreach (@$affected) { + my $ch_long = Multicast::attach($_,$sender->network_name); + if (!$this->target_of_vanish_p($msg->prefix,$ch_long)) { + $no_vanish = 1; + last; + } + } + + if ($no_vanish) { + $msg; + } + else { + undef; + } +} + +sub cmd_TOPIC { + my ($this,$msg,$sender) = @_; + if ($this->target_of_vanish_p($msg->prefix,$msg->param(0))) { + if ($this->config->drop_topic_by_target) { + $msg->prefix('HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH'); + } + } + $msg; +} + +sub cmd_353 { + # RPL_NAMREPLY + my ($this,$msg,$sender) = @_; + + my $ch_long = $msg->param(2); + my $ch_short = Multicast::detach($ch_long); + my $ch = $sender->channel($ch_short); + if (defined $ch) { + my @nicks; + foreach my $mode_and_nick (split / /,$msg->param(3)) { + my ($mode,$nick) = ($mode_and_nick =~ m/^([@\+]{0,2})(.+)$/); + my $person = $ch->names($nick); + if (!defined $person || !$this->target_of_vanish_p($person->info,$ch_long)) { + push @nicks,$mode_and_nick; + } + } + $msg->param(3,join(' ',@nicks)); + } + + $msg; +} + +sub cmd_MODE { + my ($this,$msg,$sender) = @_; + + # 発行元がVanish対象か？ + if ($this->target_of_vanish_p($msg->prefix,$msg->param(0))) { + if ($this->config->drop_mode_by_target) { + # prefix改竄 + $msg->prefix('HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH'); + } + } + + # +o/-o/+v/-vの対象がVanishの対象か？ + my $ch_long = $msg->param(0); + my $ch_short = Multicast::detach($ch_long); + my $ch = $sender->channel($ch_short); + if (defined $ch && (sub{defined$_[0]?$_[0]:1}->($this->config->drop_mode_switch_for_target))) { + my $n_params = @{$msg->params}; + my $plus = 0; # 現在評価中のモードが+なのか-なのか。 + my $mode_char_pos = 1; # 現在評価中のmode characterの位置。 + my $mode_param_offset = 0; # $mode_char_posから幾つの追加パラメタを拾ったか。 + + my $fetch_param = sub { + $mode_param_offset++; + return $msg->param($mode_char_pos + $mode_param_offset); + }; + + my @params = ($ch_long); # パラメータを再構築する。 + my $add = sub { + my ($char,$option) = @_; + push @params,($plus ? '+' : '-').$char; + if (defined $option) { + push @params,$option; + } + }; + + for (;$mode_char_pos < $n_params;$mode_char_pos += $mode_param_offset + 1) { + $mode_param_offset = 0; # これは毎回リセットする。 + foreach my $c (split //,$msg->param($mode_char_pos)) { + if ($c eq '+') { + $plus = 1; + } + elsif ($c eq '-') { + $plus = 0; + } + elsif (index('bIk',$c) != -1) { + $add->($c,$fetch_param->()); + } + elsif (index('Oov',$c) != -1) { + my $target = $fetch_param->(); + my $person = $ch->names($target); + if (!defined $person || !$this->target_of_vanish_p($person->info,$ch_long)) { + $add->($c,$target); + } + } + elsif ($c eq 'l') { + if ($plus) { + $add->($c,$fetch_param->()); # 追加パラメタを捨てる + } + else { + $add->($c); + } + } + else { + $add->($c); + } + } + } + + # パラメタ再構成の結果、一つも無くなったら、このメッセージは破棄。 + if (@params > 1) { + $msg = IRCMessage->new( + Prefix => $msg->prefix, + Command => $msg->command, + Params => \@params); + } + else { + $msg = undef; + } + } + $msg; +} + +sub cmd_KICK { + my ($this,$msg,$sender) = @_; + + if ($this->target_of_vanish_p($msg->prefix,$msg->param(0))) { + if ($this->config->drop_kick_by_target) { + $msg->prefix('HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH'); + } + } + + my $kicked_nick = $msg->param(1); + my $ch = $sender->channel(Multicast::detach($msg->param(0))); + if (defined $ch) { + if ($this->config->drop_kick_for_target) { + $msg = undef; + } + } + + $msg; +} + +sub target_of_vanish_p { + # $userinfo: nick!name@host形式のユーザー情報 + # $ch_long : ネットワーク名付きのチャンネル名 + # 戻り値: 真偽値 + my ($this,$userinfo,$ch_long) = @_; + Mask::match_deep_chan([$this->config->mask('all')],$userinfo,$ch_long); +} + +1; + +=pod +info: 指定された人物の存在を、様々なメッセージから消去する。 +default: off + +# 対象となった人物の発行したJOIN、PART、INVITE、QUIT、NICKは消去され、NAMESの返すネームリストからも消える。 +# また、対象となった人物のNJOINも消去される。 + +# Vanish対象が発行したMODEを消去するかどうか。デフォルトで0。 +# 消去するとは云え、本当にMODEそのものを消してしまうのではなく、 +# そのユーザーの代わりに"HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH"がMODEを実行した事にする。 +drop-mode-by-target: 1 + +# Vanish対象を対象とするMODE +o/-o/+v/-vを消去するかどうか。デフォルトで1。 +drop-mode-switch-for-target: 1 + +# Vanish対象が発行したKICKを消去するかどうか。デフォルトで0。 +# 本当に消すのではなく、"HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH"がKICKを実行した事にする。 +drop-kick-by-target: 1 + +# Vanish対象を対象とするKICKを消去するかどうか。デフォルトで0。 +drop-kick-for-target: 0 + +# Vanish対象が発行したTOPICを消去するかどうか。デフォルトで0。 +# 本当に消すのでは無いが、他の設定と同じ。 +drop-topic-by-target: 1 + +# チャンネルとVanish対象の定義。 +# 特定のチャンネルでのみ対象とする、といった事が可能。 +# また、privの場合は「#___priv___@ネットワーク名」という文字列をチャンネル名の代わりとしてマッチングを行なう。 +# 書式: mask: <チャンネルのマスク> <ユーザーのマスク> +mask: #example@example example!exapmle@example.com +=cut diff -urN /non-existant-dir/run tiarra-20050322/run --- /non-existant-dir/run 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/run 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,29 @@ +#!/bin/sh +# $Id: run 821 2005-03-07 17:58:37Z topia $ +# copyright (C) 2004 Topia . all rights reserved. + +THISDIR="${THISDIR-$(dirname $0)}" +[ "0${DEBUG}" -ge 1 ] && echo "${THISDIR}/run: start" + +# override +WORKDIR="${WORKDIR:-${THISDIR}}" +if [ -z "${TOPDIR}" ]; then + TOPDIR=. +else + TOPDIR="${TOPDIR}/.." +fi +TOPDIR="${TOPDIR#./}" + +[ "0${DEBUG}" -ge 2 ] && echo "${THISDIR}/run: read tiarrarc" +[ -f "${THISDIR}/.tiarrarc" ] && . "${THISDIR}/.tiarrarc" +if [ -f "${THISDIR}/.tiarrarc-once" ]; then + . "${THISDIR}/.tiarrarc-once" + rm -f "${THISDIR}/.tiarrarc-once" +fi + +if [ -f "${THISDIR}/run-main" ]; then + . "${THISDIR}/run-main" +else + THISDIR="${THISDIR}/.." + . "${THISDIR}/run" +fi diff -urN /non-existant-dir/run-main tiarra-20050322/run-main --- /non-existant-dir/run-main 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/run-main 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,58 @@ +#!/bin/sh +# $Id: run-main 821 2005-03-07 17:58:37Z topia $ +# copyright (C) 2004 Topia . all rights reserved. + +if [ -z "${THISDIR}" ]; then + echo "$0 couldn't use directly. please use ./run." 1>&2 + exit 2; +fi +[ "0${DEBUG}" -ge 1 ] && echo "${THISDIR}/run-main: start" + +PERL=${PERL:-/usr/bin/perl} +PERLARG=${PERLARG:--w} +TIARRA=${TIARRA:-${TOPDIR}/tiarra} +CONF=${CONF:-tiarra.conf} +REDIR_STDOUT=${REDIR_STDOUT:->errlog.stdout} +REDIR_STDERR=${REDIR_STDERR:->errlog.stderr} +REDIR_STDIN=${REDIR_STDIN:-&-} +DAEMON_MODE=${DAEMON_MODE:-yes} + +eval "${LAZY_EXECUTE}" + +cmd_line='${PERL} ${PERLARG}' +cmd_line="${cmd_line} "'${TIARRA}' +cmd_line="${cmd_line} "'--config="${CONF}"' +cmd_line="${cmd_line} ${TIARRAARG}" +cmd_line="${cmd_line} "'"$@"' +[ "X${REDIR_STDOUT}" = "X-" ] || cmd_line="${cmd_line} >${REDIR_STDOUT}" +[ "X${REDIR_STDERR}" = "X-" ] || cmd_line="${cmd_line} 2>${REDIR_STDERR}" +[ "X${REDIR_STDIN}" = "X-" ] || cmd_line="${cmd_line} <${REDIR_STDIN}" + +if [ "X${DAEMON_MODE}" = "Xyes" ]; then + cmd_line="${cmd_line} &" +else + cmd_line="exec ${cmd_line}" +fi + + +if [ \! -z "${DEBUG}" ]; then + echo " configuration" + echo "workdir : ${WORKDIR}" + echo "perl : ${PERL}" + echo "perl arg : ${PERLARG}" + echo "tiarra : ${TIARRA}" + echo "config : ${CONF}" + echo "tiarra arg: ${TIARRAARG}" + echo "extra : $@" + echo "stdout : ${REDIR_STDOUT}" + echo "stderr : ${REDIR_STDERR}" + echo "stdin : ${REDIR_STDIN}" + echo "daemon : ${DAEMON_MODE}" + echo "lazy exec : " + echo "${LAZY_EXECUTE}" | while read line ; do echo " $line" ; done + echo "cmdline :" + echo " ${cmd_line}" +else + cd "${WORKDIR}" + eval "${cmd_line}" +fi diff -urN /non-existant-dir/sample.conf tiarra-20050322/sample.conf --- /non-existant-dir/sample.conf 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/sample.conf 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,750 @@ +# -*- tiarra-conf -*- +# ----------------------------------------------------------------------------- +# $Id: sample.conf.in 762 2005-02-21 20:05:25Z topia $ +# ----------------------------------------------------------------------------- +# tiarra.conf サンプル +# +# tiarraは起動時に全ての設定をこのファイルから取得します。 +# このファイルの文字コードは任意ですが、改行コードはLFもしくはCRLFでなければなりません。 +# +# 半角の#で始まる行はコメントとして無視されます。 +# 行の途中に#を置いた場合はコメントにはなりません。 +# +# 設定行は「設定名 : 値」の形式で指定されます。 +# 行の先頭及び末尾、コロンの前後の空白は無視されます。 +# +# 特に指定が無い場合、同じ設定を二度以上繰り返した時は最初に定義された設定が有効になります。 +# +# ブロックごと省略した場合は、そのブロックの全ての値が省略されたものとみなします。 +# ただし省略不可能な設定もありますので御注意下さい。 +# +# 「@include foo.conf」という行があると、foo.confがその場所に +# 挿入されたかのように処理します。 +# +# {}記号の位置には、それなりの自由度があります。 +# 次の例は全て有効です。 +# block { +# foo: bar +# } +# +# block {} +# +# block +# {} +# +# 次の例は全て無効です。 +# block {foo: bar} +# +# block +# {foo: bar} +# +# block { +# foo: bar} +# +# block +# {foo: bar +# } +# ----------------------------------------------------------------------------- + +# ----------------------------------------------------------------------------- +# generalブロック +# +# tiarra.conf自身の文字コードやユーザー情報などを指定するブロックです。 +# ----------------------------------------------------------------------------- +general { + # tiarra.conf自身の文字コード + # コード名はjis,sjis,euc,utf8,utf16,utf32等。(この値はUnicode::Japaneseにそのまま渡されます) + # autoが指定された、または省略された場合は自動判別します。 + conf-encoding: euc + + # ユーザー情報 + # 省略不能です。 + nick: tiarra + user: tiarra + name: Tiarra the "Aeon" + + # どのようなユーザーモードでログインするか。+iwや+iのように指定する。 + # 省略された場合はユーザーモードを特に設定しない。 + #user-mode: +i + + # Tiarraへの接続を許可するホスト名を表わすマスク。 + # 制限をしないのであれば"*"を指定するか省略する。 + client-allowed: * + + # Tiarraが開くポート。ここに指定したポートへクライアントに接続させる。 + # 省略されたらポートを開かない。 + tiarra-port: 6667 + + # Tiarraがポートtiarra-portを開く際、IPv6とIPv4のどちらでリスニングを行なうか。 + # 'v4'または'v6'で指定します。デフォルトは'v4'です。 + # IPv6を使うためにはSocket6.pmが利用可能である必要があります。 + #tiarra-ip-version: v4 + + # Tiarraがポートtiarra-portを開く際のローカルアドレス。 + # 意味が分からなければ省略して下さい。 + # デフォルトは、IPv4のはINADDR_ANY、IPv6のはin6addr_anyになります。 + #tiarra-ipv4-bind-addr: 0.0.0.0 + #tiarra-ipv6-bind-addr: ::0 + + # Tiarraにクライアントが接続する際に要求するパスワードをcryptした文字列。 + # 空の文字列が指定されたり省略された場合はパスワードを要求しない。 + # crypt は ./tiarra --make-password で行えます。 + tiarra-password: xl7cflIcH9AwE + + # 外部プログラムからtiarraをコントロールする為のUNIXドメインソケットの名前。 + # 例えば"foo"を指定した場合、ソケット/tmp/tiarra-control/fooが作られる。 + # 省略された場合はこの機能を無効とする。 + # また、非UNIX環境ではそもそもUNIXドメインソケットが利用可能でないため、 + # そのような場合にもこの機能は無効となる。 + #control-socket-name: test + + # IRCサーバーから送られる文字のコードと、IRCサーバーへ送る文字のコード + # どちらも省略された場合はjis。 + server-in-encoding: jis + server-out-encoding: jis + + # クライアントから受け取る文字のコードと、クライアントへ伝える文字のコード + # どちらも省略された場合はjis。 + client-in-encoding: jis + client-out-encoding: jis + + # Tiarraは標準出力に様々なメッセージを出力するが、その文字コードを指定する。省略時にはeucとなる。 + # ただしtiarra.confのパースが完了するまでは文字コードの変換は行なわれない(つまりこの設定が有効にならない)ことに注意して下さい。 + stdout-encoding: euc + + # Tiarraはエラーメッセージを標準出力に出力するが、その時に接続しているクライアントがあればクライアントにもNOTICEで送る事が出来る。 + # この値を1にすると、その機能が有効になる。省略するか0を指定するとこの機能は無効になる。 + notice-error-messages: 1 + + # Tiarraでチャンネルとユーザーのマスクを指定するときの形式。 + # plum形式とTiarra形式が選択できます。 + #----------------- + # plum形式: (channelには+や-は使えない。channelは省略すると*とみなす。) + # + syntax: user[ channel[ channel[ ...]]] + # + # mask: +*!*@*.example.com #{example}@ircnet +{example3}@ircnet + # mask: -*!*@*.example.com #{example2}@2ch,+{example4}@2ch + # mask: -*!*@* + #----------------- + # Tiarra形式: (channelにも+や-を使える。) + # + syntax: channel user + # + # mask: #{example}@ircnet,-#{example2}@2ch +*!*@*.example.com + # mask: ++{example3}@ircnet,-+{example4}@2ch +*!*@*.example.com # +で始まるチャンネル。 + # mask: * -*!*@* + #----------------- + # となります。 この二つはまったく同じマスクを表しています。 + + # この値をplumにすると、plum形式、省略するかtiarraを指定すると、Tiarra形式になります。 + chanmask-mode: tiarra + + # サーバーに接続する際、ローカル側のどのアドレスにバインドするか。 + # 意味が分からなければ省略して下さい。 + # デフォルトは、IPv4のはINADDR_ANY、IPv6のはin6addr_anyになります。 + #ipv4-bind-addr: 0.0.0.0 + #ipv6-bind-addr: ::0 + + # tiarra が、 001 や 002 や、 recent log を送信するときなどに使う prefix + # を指定します。 hostname や fqdn っぽいものを指定すると良いかもしれません。 + # デフォルトは tiarra です。普通変える必要はありません。 + #sysmsg-prefix: tiarra + + sysmsg-prefix-use-masks { + # sysmsg-prefix を使用する場所を指定する。 + + # システムメッセージ(NumericReply など)。デフォルトは * です。 + # ふつうこれを変更する必要はありません。 + system: * + + # 個人宛メッセージ(Notice,Privmsg の中で)。デフォルトはなし。 + #priv: + + # チャンネル宛メッセージ(Notice,Privmsg の中で)。デフォルトは * です。 + # Ziciz などのクライアントを接続する場合は、 + # -*::log を指定しておくといいかもしれません。 + channel: * + } + + # Tiarra が nick 変更時の衝突等を処理するモードを指定します。 + # 0: Tiarra が接続時と同様に自動処理します。 + # 1: クライアントにそのまま投げます。 + # 複数のクライアントが nick 重複を処理する場合は非常に危険です。 + # (設定不足の IRC クライアントが複数つながっている場合も含みます) + # 2: 対応するエラーメッセージ付きの NOTICE に変換して、 + # クライアントに投げます。 + # multi-server-mode 時のデフォルトは 0 、 single-server-mode 時のデフォルトは 1 です。 + #nick-fix-mode: 0 + + messages { + # Tiarra が使用する、いくつかのメッセージを指定する。 + + quit { + # ネットワーク設定が変更され、再接続する場合の切断メッセージ + netconf-changed-reconnect: Server Configuration changed; reconnect + + # ネットワーク設定が変更され、切断する場合の切断メッセージ + netconf-changed-disconnect: Server Configuration changed; disconnect + } + } +} + +# ----------------------------------------------------------------------------- +# networksブロック +# +# Tiarraから接続するIRCネットワークの名称です。 +# 一つも定義しなかった場合やこのブロックを省略した場合は、 +# "main"というネットワークが一つだけ指定されたものと見做します。 +# ----------------------------------------------------------------------------- +networks { + # 複数のサーバーへの接続を可能にするかどうか。1(オン)と0(オフ)で指定。 + # これを1にすると、次のnameを複数個定義する事が可能になり、 + # 複数のサーバーに同時に接続出来るようになります。 + # その一方、これを1にしている時は、チャンネル名にネットワーク名が付加される等、 + # IRCの大部分のメッセージがTiarraによる改変を受けます。 + # これを0にしている間は、次のnameを複数個定義する事は出来なくなります。 + # マルチサーバーモードの設定を起動中に変えると、クライアントから見たチャンネル名が + # 変更になる為、全クライアントが一時的に全てのチャンネルからpartしたように見え、 + # その直後にjoinし直したように見えます。 + # デフォルトでは1です。 + multi-server-mode: 1 + + # 接続するIRCネットワークに名前を付けます。この名前は後で使用します。 + # 複数のネットワークに接続したい場合は多重定義して下さい。 + name: ircnet + name: 2ch + + # 通常Tiarraではチャンネル名を「#Tiarra@ircnet」のように表現します。 + # これはネットワークircnet内の#Tiarraというチャンネルを表わします。 + # @以降は省略可能ですが、省略された場合のデフォルトのネットワーク名をここで指定します。 + # 省略した場合は最も始めに定義されたnameがデフォルトになります。 + # (そしてnameが一つも無かった場合はmainがデフォルトになります) + #default: ircnet + + # 上に述べた通り、デフォルトではTiarraはチャンネル名とネットワーク名を@で区切ります。 + # この区切り文字は任意の文字に変更する事が出来ます。省略された場合は@になります。 + channel-network-separator: @ + + # 接続先のサーバーから切断された時に、joinしていたそのサーバーのチャンネルをどうするか。 + # 1. "part-and-join"の場合は、切断されるとクライアントにはチャンネルからpartしたように見せ掛け、 + # 再接続に成功すると再びjoinしたように見せ掛ける。最も負荷が高い。(これはplumに似た動作である) + # 2. "one-message"の場合は、切断されるとクライアントに宛ててTiarraがNOTICEでその旨を報告する。 + # 再接続に成功すると再びNOTICEで報告する。JOINやPARTはしないので、 + # クライアントからはまだそのチャンネルに残っているかのように見える。 + # 3. "message-for-each"の場合は、切断されるとクライアントに宛ててTiarraが + # 到達不能になった全てのチャンネルにNOTICEでその旨を報告する。 + # 再接続に成功すると再びNOTICEで報告する。JOINやPARTはしない。 + # デフォルトはpart-and-joinです。 + action-when-disconnected: message-for-each + + # NICKを変更する度に、変更したサーバーでの新しいNICKをNOTICEで常に通知するかどうか。 + # 1なら必ず通知し、0なら変更後のnickがローカルnick(クライアントが見る事の出来るnick)と違っている場合のみ通知する。 + # デフォルトは0です。 + always-notify-new-nick: 0 + + fixed-channels { + # Tiarra がクライアント接続時にチャンネル情報を送る順番を指定する。 + # マッチしなかったチャンネルについては最後にまとめて + # (順番がごちゃごちゃになって)送られてきます。 + channel: #てすとちゃんねる@ircnet + channel: #てすと@localserver + channel: *@localserver + channel: *@localserver:*.jp + } +} + +# ----------------------------------------------------------------------------- +# 各ネットワークの設定 +# +# networksブロックで定義した全てのネットワークについて、 +# そのアドレス、ポート、(必要なら)パスワードを定義します。 +# ----------------------------------------------------------------------------- +ircnet { + # サーバーのホストとポート。省略不可。 + host: irc.nara.wide.ad.jp + port: 6663 + + # general/userで設定したユーザ名を使わずに、各ネットワークで独自のユーザ名を使用する事も可能。 + # 省略されたら当然、general/userで設定したものが使われる。 + #user: hoge + + # general/nameで設定した本名(建前上)を使わずに、各ネットワークで独自の本名を使用可能。 + #name: hoge + + # このサーバーの要求するパスワード。省略可能。 + #password: hoge + + # general/setver-in/out-encodingで設定したエンコーディングを使わずに、 + # 各ネットワークで独自のエンコーディングを使用する事も可能。 + # 省略されたら当然、generalで設定したものが使われる。 + #in-encoding: jis + #out-encoding: jis + + # general/(ipv4|ipv6)bind-addrで設定したローカルアドレスを使わずに、 + # 各ネットワークで独自のbind_addrを使用する事も可能。 + # 省略されたらgeneralで設定したものが使われる。 + #ipv4-bind-addr: 0.0.0.0 + #ipv6-bind-addr: ::0 +} + +2ch { + host: irc.2ch.net + port: 6667 +} + +# ----------------------------------------------------------------------------- +# 必須の設定は以上です。以下はモジュール(プラグイン)の設定です。 +# ----------------------------------------------------------------------------- + +# +または-で始まる行はモジュール設定行と見做されます。 +# +で記述されたモジュールが使用され、-で記述されたモジュールは使用されません。 +# +や-の後の空白は幾つあっても無視されます。 + +# メッセージが各モジュールを通過する順番は、このconfファイルで記述された +# 順番の通りになります。ログを取るモジュールなどはconfでも後の方に +# 記述した方が良いということになります。 + +# モジュール名はperlのそれと同じようにディレクトリ区切り文字を「::」としたパスで表現されます。 +# 例えばモジュールChannel::Auto::Operの実体はファイルmodule/Channel/Auto/Oper.pm +# でなければならず、そのpackage宣言もChannel::Auto::Operでなければなりません。 +# Tiarraモジュールの名称は、perl標準モジュール群やmain/下の.pmファイルと重複しないように +# 気を付けて下さい。Tiarraはモジュールが本当にModuleのサブクラスかどうかをチェックするので +# 例えばIO::Socket::INETといったモジュールを置いても誤動作はしませんが、 +# そのようなモジュールはロード時にエラーを出して使用中止になります。 + +# 一つのモジュールを複数回定義して、何度も同じモジュールをメッセージが通過するようには出来ません。 + +# 幾つかのモジュールはパラメータとしてチャンネル名を必要とします。 +# ここで指定するチャンネル名は、ネットワーク名も含めた文字列でなければなりません。 +# 「#チャンネル」では駄目で「#チャンネル@ネットワーク」などとする必要があります。 + +# マスクの書式: +# ['+' / '-'] ( <マスク文字列> / "re:" 正規表現 ) +# これはカンマで幾つでも継ぐ事が出来ます。"\,"でカンマそのものを表します。 +# 先頭が+なら、それに続く部分にマッチするものが選ばれ、-なら除外されます。省略されたら+と見做されます。 +# マスク文字列とは"*"で0文字以上の任意の文字列を、"?"で1文字の任意の文字列を表す文字列です。 +# 例: +# tiarra* これはtiarraで始まる文字列を表す。 +# +*!*tiarra@*.jp,-re:\d これは*!*tiarra@*.jpにマッチして、かつ文字列中に数字を含まないものを表す。 + +# このファイルには重要と思われるいくつかのモジュールしかありません。 +# そのほかのモジュールについては、 all.conf から設定をコピーしてきてください。 + +- Auto::Oper { + # 特定の文字列を発言した人を+oする。 + + # Auto::Aliasを有効にしていれば、エイリアス置換を行ないます。 + + # +oを要求する文字列(マスク)を指定します。 + request: なると寄越せ + + # チャンネルオペレータ権限を要求した人と要求されたチャンネルが + # ここで指定したマスクに一致しなかった場合は + # denyで指定した文字列を発言し、+oをやめます。 + # 省略された場合は誰にも+oしません。 + # 書式は「チャンネル 発言者」です。 + # マッチングのアルゴリズムは次の通りです。 + # 1. チャンネル名にマッチするmask定義を全て集める + # 2. 集まった定義の発言者マスクを、定義された順にカンマで結合する + # 3. そのようにして生成されたマスクで発言者のマッチングを行ない、結果を+o可能性とする。 + # 例1: + # mask: *@2ch* *!*@* + # mask: #*@ircnet* *!*@*.hoge.jp + # この例ではネットワーク 2ch の全てのチャンネルで誰にでも +o し、 + # ネットワーク ircnet の # で始まる全てのチャンネルでホスト名 *.hoge.jp の人に+oします。 + # #*@ircnetだと「#hoge@ircnet:*.jp」などにマッチしなくなります。 + # 例2: + # mask: #hoge@ircnet -*!*@*,+*!*@*.hoge.jp + # mask: * +*!*@* + # 基本的に全てのチャンネルで誰にでも +o するが、例外的に#hoge@ircnetでは + # ホスト名 *.hoge.jp の人にしか +o しない。 + # この順序を上下逆にすると、全てのチャンネルで全ての人を +o する事になります。 + # 何故なら最初の* +*!*@*が全ての人にマッチするからです。 + mask: * *!*@* + + # +oを要求した人を実際に+oする時、ここで指定した発言をしてから+oします。 + # #(name|nick)のようなエイリアス置換を行います。 + # エイリアス以外でも、#(nick.now)を相手のnickに、#(channel)を + # そのチャンネル名にそれぞれ置換します。 + message: 了解 + + # +oを要求されたが+oすべき相手ではなかった場合の発言。 + # 省略されたら何も喋りません。 + deny: 断わる + + # +oを要求されたが相手は既にチャンネルオペレータ権限を持っていた場合の発言。 + # 省略されたらdenyに設定されたものを使います。 + oper: 既に@を持っている + + # +oを要求されたが自分はチャンネルオペレータ権限を持っていなかった場合の発言。 + # 省略されたらdenyに設定されたものを使います。 + not-oper: @が無い + + # チャンネルに対してでなく自分に対して+oの要求を行なった場合の発言。 + # 省略されたらdenyに設定されたものを使います。 + private: チャンネルで要求せよ + + # チャンネルの外から+oを要求された場合の発言。+nチャンネルでは起こりません。 + # 省略されたらdenyに設定されたものを使います。 + out: チャンネルに入っていない +} + +- CTCP::ClientInfo { + # CTCP CLIENTINFOに応答する。 + + # CTCP::Versionのintervalと同じ。 + interval: 3 +} + +- CTCP::Ping { + # CTCP PINGに応答する。 + + # CTCP::Versionのintervalと同じ。 + interval: 3 +} + +- CTCP::Time { + # CTCP TIMEに応答する。 + + # CTCP::Versionのintervalと同じ。 + interval: 3 +} + +- CTCP::UserInfo { + # CTCP USERINFOに応答する。 + + # CTCP::Versionのintervalと同じ。 + interval: 3 + + # USERINFOとして返すメッセージ。 + message: テスト +} + ++ CTCP::Version { + # CTCP VERSIONに応答する。 + + # 連続したCTCPリクエストに対する応答の間隔。単位は秒。 + # 例えば3秒に設定した場合、一度応答してから3秒間は + # CTCPに一切応答しなくなる。デフォルトは3。 + # + # なお、CTCP受信時刻の記録は、全てのCTCPモジュールで共有される。 + # 例えばCTCP VERSIONを送った直後にCTCP CLIENTINFOを送ったとしても、 + # CTCP::ClientInfoのintervalで設定された時間を過ぎていなければ + # 後者は応答しない。 + interval: 3 +} + +- Channel::Join::Connect { + # サーバーに初めて接続した時、指定したチャンネルに入るモジュール。 + + # 書式: <チャンネル1>[,<チャンネル2>,...] [<チャンネル1のキー>,...] + # コンマの直後のスペースは無視されます。 + # + # 例: + # 「#aaaaa@ircnet」に「aaaaa」というキーで入る。 + #channel: #aaaaa@ircnet aaaaa + # + # 「#aaaaa@ircnet」、「#bbbbb@ircnet:*.jp」、「#ccccc@ircnet」、「#ddddd@ircnet」の4つのチャンネルに入る。 + #channel: #aaaaa@ircnet,#bbbbb@ircnet:*.jp, #ccccc@ircnet + #channel: #ddddd@ircnet +} + +- Channel::Join::Invite { + # 招待されたらそのチャンネルに入る。 + + # 許可するユーザ/チャンネルのマスク。 + mask: * *!*@* + # plum: *!*@* + + # 招待されたチャンネルに流すメッセージのフォーマット。 + #message: こんばんわ〜。 +} + +- Channel::Join::Kicked { + # 特定のチャンネルからkickされた時に、自動で入りなおす。 + + # 対象となるチャンネル名のマスク + channel: * +} + +- Channel::Mode::Get { + # チャンネルにJOINした時、そのチャンネルのモードを取得します。 + + # Channel::Mode::Set等が正しく動くためには + # チャンネルのモードをTiarraが把握しておく必要があります。 + # 自動的にモードを取得するクライアントであれば必要ありませんが、 + # そうでなければこのモジュールを使うべきです。 + + # 設定項目は無し。 +} + +- Channel::Mode::Oper::Grant { + # 特定のチャンネルに特定の人間がjoinした時に、自分がチャンネルオペレータ権限を持っていれば+oする。 + + # splitからの復帰などで+o対象の人が一度に大量に入って来ても+oは少しずつ実行します。 + # Excess Floodにはならない筈ですが、本格的な防衛BOTに使える程の物ではありません。 + + # 対象の人間がjoinしてから実際に+oするまで何秒待つか。 + # 省略されたら待ちません。 + # 5-10 のように指定されると、その値の中でランダムに待ちます。 + wait: 2-5 + + # チャンネルと人間のマスクを定義。Auto::Operと同様。 + #mask: * example!~example@*.example.ne.jp +} + +- Channel::Mode::Set { + # チャンネルを作成した時に自動的にモードを設定するモジュール。 + + # 書式は<チャンネル名にマッチするマスク> <設定するモード>[,<設定するモード>,...]です。 + # #IRC談話室@ircnetなら+t+nを、それ以外なら+nを設定する例。 + #channel: #IRC談話室@ircnet +t + #channel: * +n + # LimeChat 標準設定を模倣する設定例。 + #channel: * +sn +} + +- Channel::Rejoin { + # チャンネルオペレータ権限を無くしたとき、一人ならjoinし直す。 + + # +チャンネルや+aされているチャンネル以外でチャンネルオペレータ権限を持たずに + # 一人きりになった時、そのチャンネルの@を復活させるために自動的にjoinし直すモジュール。 + # トピック、モード、banリスト等のあらゆるチャンネル属性をも保存します。 + + # +b,+I,+eリストの復旧を行なうかどうか。 + # あまりに長いリストを取得するとMax Send-Q Exceedで落とされるかも知れません。 + save-lists: 1 +} + +- Client::Cache { + # データをキャッシュしてサーバに問い合わせないようにする + + # キャッシュを使用しても、使われるのは接続後最初の一度だけです。 + # 二度目からは通常通りにサーバに問い合わせます。 + # また、クライアントオプションの no-cache を指定すれば動きません。 + + # mode キャッシュを使用するか + use-mode-cache: 1 + + # who キャッシュを使用するか + use-who-cache: 1 +} + ++ Client::Conservative { + # サーバが送信するような IRC メッセージを作成するようにする + + # サーバが実際に送信しているようなメッセージにあわせるようにします。 + # 多くのクライアントの設計ミスを回避でき(ると思われ)ます。 +} + +- Client::Cotton { + # Cotton の行うおかしな動作のいくつかを無視する + + # 該当クライアントのオプション client-type に cotton や unknown と指定するか、 + # Client::GetVersion を利用してクライアントのバージョンを取得するように + # してください。 + + # part shield (rejoin 時に自動で行われる part の無視)を使用するか + use-part-shield: 1 +} + ++ Client::GetVersion { + # クライアントに CTCP Version を発行してバージョン情報を得る + + # オプションはいまのところありません。 + # (開発者向け情報: 取得した情報は remark の client-version に設定され、 + # Client::Guess から使用されます。) +} + +- Log::Channel { + # チャンネルやprivのログを取るモジュール。 + + # Log系のモジュールでは、以下のように日付や時刻の置換が行なわれる。 + # %% : % + # %Y : 年(4桁) + # %m : 月(2桁) + # %d : 日(2桁) + # %H : 時間(2桁) + # %M : 分(2桁) + # %S : 秒(2桁) + + # ログを保存するディレクトリ。Tiarraが起動した位置からの相対パス。~指定は使えない。 + directory: log + + # ログファイルの文字コード。省略されたらjis。 + charset: sjis + + # 各行のヘッダのフォーマット。省略されたら'%H:%M'。 + header: %H:%M:%S + + # ファイル名のフォーマット。省略されたら'%Y.%m.%d.txt' + filename: %Y.%m.%d.txt + + # ログファイルのモード(8進数)。省略されたら600 + mode: 600 + + # ログディレクトリのモード(8進数)。省略されたら700 + dir-mode: 700 + + # ログを取るコマンドを表すマスク。省略されたら記録出来るだけのコマンドを記録する。 + command: privmsg,join,part,kick,invite,mode,nick,quit,kill,topic,notice + + # PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。 + distinguish-myself: 1 + + # 各ログファイルを開きっぱなしにするかどうか。 + # このオプションは多くの場合、ディスクアクセスを抑えて効率良くログを保存しますが + # ログを記録すべき全てのファイルを開いたままにするので、50や100のチャンネルを + # 別々のファイルにログを取るような場合には使うべきではありません。 + # 万一 fd があふれた場合、クライアントから(またはサーバへ)接続できない・ + # 新たなモジュールをロードできない・ログが全然できないなどの症状が起こる可能性が + # あります。limit の詳細については OS 等のドキュメントを参照してください。 + #keep-file-open: 1 + + # keep-file-open 時に各行ごとに flush するかどうか。 + # open/close の負荷は気になるが、ログは失いたくない人向け。 + # keep-file-open が有効でないなら無視され(1になり)ます。 + #always-flush: 0 + + # keep-file-openを有効にした場合、発言の度にログファイルに追記するのではなく + # 一定の分量が溜まってから書き込まれる。そのため、ファイルを開いても + # 最近の発言はまだ書き込まれていない可能性がある。 + # syncを設定すると、即座にログをディスクに書き込むためのコマンドが追加される。 + # 省略された場合はコマンドを追加しない。 + sync: sync + + # 各チャンネルの設定。チャンネル名の部分はマスクである。 + # 個人宛てに送られたPRIVMSGやNOTICEはチャンネル名"priv"として検索される。 + # 記述された順序で検索されるので、全てのチャンネルにマッチする"*"などは最後に書かなければならない。 + # 指定されたディレクトリが存在しなかったら、Log::Channelはそれを勝手に作る。 + # フォーマットは次の通り。 + # channel: <ディレクトリ名> (<チャンネル名> / 'priv') + # 例: + # filename: %Y.%m.%d.txt + # channel: IRCDanwasitu #IRC談話室@ircnet + # channel: others * + # この例では、#IRC談話室@ircnetのログはIRCDanwasitu/%Y.%m.%d.txtに、 + # それ以外(privも含む)のログはothers/%Y.%m.%d.txtに保存される。 + channel: priv priv + channel: others * +} + +- Log::Recent { + # クライアントを接続した時に、保存しておいた最近のメッセージを送る。 + + # クライアントオプションの no-recent-logs が指定されていれば送信しません。 + + # 各行のヘッダのフォーマット。省略されたら'%H:%M'。 + header: %H:%M:%S + + # ログをチャンネル毎に何行まで保存するか。省略されたら10。 + line: 15 + + # PRIVMSGとNOTICEを記録する際に、自分の発言と他人の発言でフォーマットを変えるかどうか。1/0。デフォルトで1。 + distinguish-myself: 1 + + # どのメッセージを保存するか。省略されたら保存可能な全てのメッセージを保存する。 + command: privmsg,notice,topic,join,part,quit,kill +} + ++ System::Error { + # サーバーからのERRORメッセージをNOTICEに埋め込む + + # これをoffにするとクライアントにERRORメッセージがそのまま送られます。 + # クライアントとの間ではERRORメッセージは主に切断警告に使われており、 + # そのまま流してしまうとクライアントが混乱する可能性があります。 + # 設定項目はありません。 + + # このモジュールを回避してERRORメッセージをクライアントに送りたい場合は、 + # remarkのsend-error-as-is-to-clientを指定してください。 +} + +- System::NotifyIcon::Win32 { + # タスクトレイにアイコンを表示する。 + + # タスクトレイにアイコンを表示します。 + # クリックすると表示非表示を切り替えることができ、右クリックすると + # Reload と Exit ができるコンテキストメニューを表示します。 + # 多少反応が鈍いかもしれませんがちょっと待てば出てくると思います。 + + # Win32::GUI を必要とします。 + # コンテキストメニューは表示している間処理をブロックしています。 + + # Win32 イベントループを処理する最大間隔を指定します。 + #interval: 2 + + # 通知領域に表示するアイコンを指定します。 + # Win32::GUI の制限でちゃんとしたアイコンファイルしか指定できません。 + iconfile: guiperl.ico + + # モジュールが読み込まれたときにコンソールウィンドウを隠すかどうかを + # 指定します。 + hide-console-on-load: 1 +} + ++ System::Pong { + # サーバーからのPINGメッセージに対し、自動的にPONGを返す。 + + # これをoffにするとクライアントが自らPINGに応答せざるを得なくなりますが、 + # クライアントからのPONGメッセージはデフォルトのサーバーへ送られるので + # デフォルト以外のサーバーからはPing Timeoutで落とされるなど + # 全く良い事がありません。 + # 設定項目はありません。 +} + +- System::PrivTranslator { + # クライアントからの個人的なprivが相手に届かなくなる現象を回避する。 + + # このモジュールは個人宛てのprivmsgの送信者のnickにネットワーク名を付加します。 + # 設定項目はありません。 +} + ++ System::Reload { + # confファイルやモジュールの更新をリロードするコマンドを追加する。 + + # リロードを実行するコマンド名。省略されるとコマンドを追加しません。 + # 例えば"load"を設定すると、"/load"と発言しようとした時にリロードを実行します。 + # この時コマンドはTiarraが握り潰すので、IRCプロトコル上で定義された + # コマンド名を設定すべきではありません。 + command: load + + # command と同じですが、サーバにもブロードキャストします。 + #broadcast-command: load-all + + # confファイルをリロードしたときに通知します。 + # モジュールの設定が変更されていた場合は、ここでの設定にかかわらず、 + # モジュールごとに表示されます。1または省略された場合は通知します。 + conf-reloaded-notify: 1 +} + +- User::Away::Client { + # クライアントが一つも接続されていない時にAWAYを設定します。 + + # どのようなAWAYメッセージを設定するか。省略された場合はAWAYを設定しません。 + #away: 居ない。 +} + +- User::Away::Nick { + # ニックネーム変更に応じて AWAY を設定します。 + + # ニックネームを変更したときに、そのニックネームに対応するAWAYが + # 設定されていれば、そのAWAYを設定します。そうでなければAWAYを取り消します。 + + # 書式: <設定するAWAYメッセージ> + # + # nickをhoge_zzzに変更すると、「寝ている」というAWAYを設定する。 + # hoge_workまたはhoge_zzzに変更した場合は、「仕事中」というAWAYを設定する。 + # それ以外のnickに変更した場合はAWAYを取り消す。 + # 後者は正規表現を利用して「away: re:hoge_(work|zzz) 仕事中」としても良い。 + #away: hoge_zzz 寝ている + #away: hoge_work,hoge_zzz 仕事中 +} + +- User::Nick::Detached { + # クライアントが接続されていない時に、特定のnickに変更します。 + + # クライアントが接続されていない時のnick。 + # このnickが既に使われていたら、適当に変更が加えられて使用されます。 + # クライアントが再び接続されると、切断前のローカルnickに戻ります。 + detached: PHO_d +} + diff -urN /non-existant-dir/tiarra tiarra-20050322/tiarra --- /non-existant-dir/tiarra 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/tiarra 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,438 @@ +#!/usr/bin/perl +# ----------------------------------------------------------------------------- +# - T i a r r a - :::bootstrap::: +# Copyright (c) 2002-2004 phonohawk. All rights reserved. +# This is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# ----------------------------------------------------------------------------- +# $Id: tiarra 803 2005-02-28 22:41:29Z topia $ +# ----------------------------------------------------------------------------- +require 5.006; +use strict; +use warnings; +use File::Basename; +use File::Spec; +use Carp; + +sub follow_link { + my ($file, $max_count, $die_on_max) = @_; + + $max_count = 40 unless defined $max_count; + my ($count, @path) = 0, (); + push(@path, $file); + while (-l $file) { + $file = File::Spec->rel2abs(readlink($file), dirname($file)); + push(@path, $file); + if (++$count >= $max_count) { + if ($die_on_max) { + carp 'Too many levels of symbolic links'; + } else { + last; + } + } + } + return @path; +} + +BEGIN { + # untaint + $0 =~ /^(.+)$/; + my $self = $1; + my @add_inc; + + foreach my $path (map dirname($_), reverse follow_link($1)) { + unshift(@INC, + map{ File::Spec->catdir($path, $_); } qw(main module)); + unshift(@add_inc, File::Spec->catdir($path, 'bundle')); + } + push(@INC, @add_inc); +} + +# optional modules +use Tiarra::OptionalModules; +# 外部から呼べるオプションモジュールの存在チェック。 +# (過去互換) +sub ipv6_enabled { Tiarra::OptionalModules->ipv6; } + +use Tiarra::Resolver; # early initialization +use Tiarra::Encoding; +use Configuration; +use RunLoop; +use ModuleManager; +use ReloadTrigger; +use IO::Handle; +our $terminated = 0; + +# version はバージョン番号 +our $version = '0'; + +# based はベースにしている Tiarra のバージョン(パッケージまたは fork 時用) +our $based_version = ''; + +# short は短いバージョン番号。(CTCP-Version の返答に使われる) +our $short_version = ''; + + +# オリジナル(based_version が未定義)ならば ChangeLog を検索する。 +&check_changelog unless $based_version; +# short_version が未定義なら version の値を使う。 +$short_version ||= $version; + +&install_signal_handlers; + +sub check_changelog { + use IO::File; + my $seek_offset = -300; + my $changelog = 'ChangeLog'; + + foreach my $file (follow_link($0)) { + my $dir = dirname($file); + my $path = File::Spec->catfile($dir, $changelog); + my $fh = IO::File->new($path, 'r'); + if (defined $fh) { + my $revision = undef; + my $date = undef; + + $fh->seek($seek_offset, 2); + foreach (<$fh>) { + if (/\$\QRevision:\E ([\d.]+) \$/) { + $revision = $1; + } elsif (/\$\QDate:\E ([\d\/]+) [\d:]+ \$/) { + $date = $1; + } + } + $version .= '+cvs-' . $revision if defined $revision; + $version .= '(' . $date . ')' if defined $date; + + my $svnversion; + if (-e File::Spec->catfile($dir, '.svnversion')) { + my $path = File::Spec->catfile($dir, '.svnversion'); + my $fh = IO::File->new($path, 'r'); + $svnversion = <$fh>; + chomp $svnversion; + } elsif (-e File::Spec->catdir($dir, '.svn')) { + use Cwd; + (my $svndir = $dir) =~ s/'/'\''/; + my $olddir = getcwd; + do { + $svndir =~ /^(.*)$/; + chdir $1; + # special cleanup for taint check + $ENV{PATH} =~ /^(.*)$/; + local $ENV{PATH} = $1; + $svnversion = `svnversion -n .`; + }; + $olddir =~ /^(.*)$/; + chdir $1; + } + $version .= '+svn-' . $svnversion if defined $svnversion && length $svnversion; + return; + } + } +} + +sub help { + print "\n"; + print "Usage: tiarra [--config=config-file] [options]\n"; + print "\n"; + print "options:\n"; + print " --help print this message\n"; + print " --version print version infomation\n"; + print " --dumpversion print version\n"; + print " --config= tiarra configuration file; default is 'tiarra.conf'\n"; + print " --quiet don't output any messages to stdout and stderr\n"; + print " --no-fork don't move to background when started in quiet mode\n"; + print " --debug show debug infomation\n"; + print " --make-password prompt you a password to encrypt.\n"; + print " *Tiarra doesn't do its normal work with this option*\n"; + print " -D[=]\n"; + print " treat as `\@define ' is in the conf\n"; + print "\n"; + print "If you omit --config= parameter and execute with piped input,\n"; + print "Tiarra will read configuration from stdin(pipe).\n"; + print " example:\n"; + print " cat tiarra.conf | sed -e 's/Tiarra/arraiT/g' | ./tiarra --quiet\n"; + print " gunzip -c tiarra.conf.gz | ./tiarra\n"; + print "\n"; +} + +sub make_password { + eval 'use Crypt;'; + print "Tiarra encrypts your raw password to use it for config file.\n"; + print "\n"; + + my $password = &find_option('make-password'); + if ($password eq "1") { + eval 'use Term::ReadLine;'; + my $term = Term::ReadLine->new('tiarra'); + $password = $term->readline("Please enter raw password: "); + print "\n"; + } + print Crypt::encrypt($password)." is your encoded password.\n"; + print "Use this for the general/tiarra-password entry.\n"; +} + +sub find_option { + my $option = shift; + foreach my $arg (@ARGV) { + if ($arg eq "--$option") { + return 1; + } elsif ($arg =~ m/^--$option=(.+)$/) { + return $1; + } + } + undef; +} + +sub find_options { + # $opt_regex: オプション名の正規表現。後方参照を一つだけ作る事。 + # 戻り値: ([$1, 値], ...) + my $opt_regex = shift; + grep { + defined; + } map { + if (m/^--?$opt_regex=(.+)/) { + [$1, $2]; + } + elsif (m/^--?$opt_regex$/) { + [$1, 1]; + } + else { + undef; + } + } @ARGV; +} + +sub main { + if (&find_option('help')) { + &help; + return 0; + } elsif (&find_option('version')) { + map { print "$_\n" } get_credit(); + return 0; + } elsif (&find_option('dumpversion')) { + print $version . "\n"; + return 0; + } elsif (&find_option('show-env')) { + map { print "$_\n" } get_env(); + return 0; + } elsif (&find_option('make-password')) { + &make_password; + return 0; + } + + if (&find_option('debug')) { + eval q(sub debug_printmsg{printmsg('debug: '.shift)}); + eval q(sub debug_mode{1;}); + $SIG{__WARN__} = sub { + ::printmsg(Carp::longmess(@_)); + }; + $SIG{__DIE__} = sub { + die @_ if $_[0] =~ /^[Cc]ouldn't connect/; + die @_ if $_[0] =~ /^network\/.+:\s*Server replied/; + die(Carp::longmess(@_)); + } + } else { + eval q(sub debug_printmsg{}); + eval q(sub debug_mode{0;}); + } + + foreach my $pp_define (&find_options(qr/D(.+?)/)) { + &Configuration::Preprocessor::initial_define(@$pp_define); + } + + my $conf_file = &find_option('config'); + if (!defined $conf_file) { + if (!-t STDIN) { + $conf_file = undef; # STDINから読む場合はundefを入れておく。 + } elsif (-f 'tiarra.conf') { + $conf_file = 'tiarra.conf'; + } else { + &help; + return 2; + } + } + + my $quiet = &find_option('quiet'); + my $no_fork = &find_option('no-fork'); + + my $load_config = sub { + local($|) = 1; + + if (defined $conf_file) { + print "Reading configuration from ${conf_file}... "; + } else { + $conf_file = IO::Handle->new->fdopen(fileno(STDIN),'r'); + print "Reading configuration from stdin... "; + } + + eval { + Configuration->shared_conf->load($conf_file); + }; if ($@) { + die "ERROR: $@\n"; + } else { + print "ok\n"; + } + }; + + my $boot = sub { + foreach my $line (get_credit()) { + print $line,"\n"; + } + print "\n"; + $load_config->(); + eval { + RunLoop->shared_loop->run; + }; if ($@) { + die "Tiarra aborted: $@\n"; + } else { + print "Tiarra successfully finished.\n"; + } + }; + + # quietモードならSTDIN, STDOUT, STDERRを閉じる。 + # config の read の関連(STDIN)で boot の寸前に。 + if ($quiet) { + close STDIN; + close STDOUT; + close STDERR; + #open(STDOUT,"> /dev/null"); + #open(STDERR,"> /dev/null"); + } + + # quietモードであり、且つno-forkオプションが指定されなかったらfork。 + if ($quiet && !$no_fork) { + my $child_pid = fork; + if ($child_pid == 0) { + # 子プロセス + $boot->(); + } elsif (!defined $child_pid) { + print "Tiarra: fork() failed.\n"; + } + } else { + $boot->(); + } + return 0; +} + +sub printmsg { + # 文字コードはUTF-8でなければならない。 + my $msg = shift; + local($|) = 1; + if (!defined $msg) { + $msg = ''; + } + $msg =~ s/\n*$//s; + + # Configurationが読み込まれていない時に文字コード変換するとdie。 + eval { + local $SIG{__DIE__} = 'IGNORE'; + local $SIG{__WARN__} = 'IGNORE'; + $msg = Tiarra::Encoding->new($msg,'utf8')->conv( + Configuration->shared_conf->get('general')->stdout_encoding); + }; + + my ($sec,$min,$hour,$day,$mon,$year) = localtime(time); + $mon++; + $year += 1900; + + #printf("[%02d/%02d/%04d %02d:%02d:%02d] %s\n",$mon,$day,$year,$hour,$min,$sec,$msg); + #printf("[%02d/%02d %02d:%02d:%02d] %s\n",$mon,$day,$hour,$min,$sec,$msg); + printf("[pid:$$ %04d/%02d/%02d %02d:%02d:%02d] %s\n",$year,$mon,$day,$hour,$min,$sec,$msg); +} + +sub version { + $short_version; +} + +sub get_credit { + return ( + (!$based_version ? + "- T i a r r a - :::version #${version}:::" : + ("- T i a r r a - :::version ${version}:::", + " based #${based_version}") + ), + "Copyright (c) 2002-2004 phonohawk. All rights reserved.", + "This is free software; you can redistribute it and/or modify it", + " under the same terms as Perl itself."); +} + +sub get_env { + use Config; + my @lines; + if (!$based_version) { + push @lines, "- T i a r r a - :::version #${version}:::"; + } else { + push @lines, "- T i a r r a - :::version ${version}:::"; + push @lines, " based #${based_version}"; + } + push @lines, "Environment Information:"; + push @lines, " - Perl $Config{version} built for $Config{archname}"; + push @lines, "Optional Modules:"; + push @lines, map " $_", Tiarra::OptionalModules->repr_modules; + push @lines, "Bundle Modules:"; + foreach my $mod (qw(Unicode::Japanese IO::Socket::INET6 enum)) { + my $modfile = $mod . '.pm'; + $modfile =~ s|::|/|g; + eval "require $mod;"; + push @lines, " - $mod " . + ($INC{$modfile} ? + ($mod->VERSION . " (" . + ($INC{$modfile} =~ m|bundle/| ? "bundle" : "system") . ")") : + "(unknown; not loaded)"); + } + push @lines, "Default Encoding Driver: " . ref(Tiarra::Encoding->new); + @lines; +} + +sub install_signal_handlers { + local $SIG{__WARN__} = sub {}; + foreach (qw(INT QUIT ABRT TERM)) { + $SIG{$_} = \&handle_exit; + } + $SIG{HUP} = \&handle_reload; + $SIG{USR1} = \&handle_conf_reload; +} + +sub handle_exit { + my $signame = shift; + printmsg("SIG$signame received."); + &shutdown('Tiarra '.::version.": SIG$signame received; exit"); +} + +sub handle_reload { + my $signame = shift; + printmsg("SIG$signame received."); + ReloadTrigger->reload_conf_if_updated; + ReloadTrigger->reload_mods_if_updated; +} + +sub handle_conf_reload { + my $signame = shift; + printmsg("SIG$signame received."); + ReloadTrigger->reload_conf_if_updated; +} + +sub shutdown { + my $msg = shift; + $msg = 'Tiarra '.::version.': shutting down...' if !defined $msg; + ++$terminated; + if ($terminated == 1) { + printmsg("Shutting down... [$msg]"); + RunLoop->shared_loop->terminate($msg); + } elsif ($terminated == 2) { + printmsg("Second Terminate Request; Force Exit! [$msg]"); + # force + ModuleManager->shared_manager->terminate; + Tiarra::TerminateManager->terminate('main'); + exit; + } else { + printmsg("Third Terminate Request; Fatal Exit! [$msg]"); + # fatal + exit; + } +} + +my $exitval = main; +Tiarra::TerminateManager->terminate('main'); +exit $exitval; diff -urN /non-existant-dir/tiarra-conf.el tiarra-20050322/tiarra-conf.el --- /non-existant-dir/tiarra-conf.el 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/tiarra-conf.el 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,266 @@ +;; -*- emacs-lisp -*- +;; ---------------------------------------------------------------------------- +;; $Id: tiarra-conf.el 479 2004-08-20 23:55:47Z topia $ +;; ---------------------------------------------------------------------------- +;; tiarra.conf編集用モード。 +;; ---------------------------------------------------------------------------- + +;; キーマップ +(defvar tiarra-conf-mode-map + (let ((map (make-keymap))) + (define-key map "\M-n" 'tiarra-conf-next-block) + (define-key map "\M-p" 'tiarra-conf-prev-block) + (define-key map [?\C-c?\C-.] 'tiarra-conf-jump-to-block) + (define-key map "\C-c." 'tiarra-conf-jump-to-block) + map) + "Keymap for tiarra conf mode.") + +;; 構文定義 +(defvar tiarra-conf-mode-syntax-table nil + "Syntax table used while in tiarra conf mode.") +(if tiarra-conf-mode-syntax-table + () ; 構文テーブルが既存ならば變更しない + (setq tiarra-conf-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?{ "(}") + (modify-syntax-entry ?} "){")) + +;; 略語定義 +(defvar tiarra-conf-mode-abbrev-table nil + "Abbrev table used while in tiarra conf mode.") +(define-abbrev-table 'tiarra-conf-mode-abbrev-table ()) + +;; フック +(defvar tiarra-conf-mode-hook nil + "Normal hook runs when entering tiarra-conf-mode.") + +(defun tiarra-conf-mode () + "Major mode for editing tiarra conf file. +\\{tiarra-conf-mode-map} +Turning on tiarra-conf-mode runs the normal hook `tiarra-conf-mode-hook'." + (interactive) + (kill-all-local-variables) + (use-local-map tiarra-conf-mode-map) + (set-syntax-table tiarra-conf-mode-syntax-table) + (setq local-abbrev-table tiarra-conf-mode-abbrev-table) + (setq mode-name "Tiarra-Conf") + (setq major-mode 'tiarra-conf-mode) + + ;; フォントロックの設定 + (make-local-variable 'font-lock-defaults) + (setq tiarra-conf-font-lock-keywords + (list '("^[\t ]*#.*$" + . font-lock-comment-face) ; コメント + '("^[\t ]*@.*$" + . font-lock-warning-face) ; @文 + '("^[\t ]*\\+[\t ]+.+$" + . font-lock-type-face) ; + モジュール + '("^[\t ]*-[\t ]+.+$" + . font-lock-constant-face) ; - モジュール + '("^[\t ]*\\([^:\n]+\\)\\(:\\).*$" + (1 font-lock-variable-name-face) ; key + (2 font-lock-string-face)) ; ':' + '("^[\t ]*[^{}\n]+" + . font-lock-function-name-face))) ; ブロック名 + (setq font-lock-defaults '(tiarra-conf-font-lock-keywords t)) + + ;; mmm-modeの設定 + (if (featurep 'mmm-auto) + (progn + (mmm-add-group + 'embedding-in-tconf + '((pre-in-tconf + :submode perl + :front "%PRE{" + :back "}ERP%") + (code-in-tconf + :submode perl + :front "%CODE{" + :back "}EDOC%"))) + (setq mmm-classes 'embedding-in-tconf) + (mmm-mode-on))) + + (run-hooks 'tiarra-conf-mode-hook)) + +(defun tiarra-conf-next-token () + "カレントバッファの現在のカーソル位置から次のトークンを探して返す。 +カーソルはそのトークンの終はりの位置へ移動する。 + +返されるのは次のやうなリストである。 +\(\"トークン\" '種類) +種類: + pair -> キーと値のペア + label -> ブロックのラベル + blockstart -> ブロックの開始記號 + blockend -> ブロックの終了記號 + +トークンが無ければnilを返す。" + (catch 'tiarra-conf-next-token + ;; まずは空白とコメントを飛ばす。 + ;; @文も%PREも%CODEも飛ばす。 + ;; ……しかし「最小一致」の使へないElisp-Regexで + ;; どうやつて%PREに一致させたものだか分からない。 + ;; 助けて。 + (or (re-search-forward "^\\([\n\t ]\\|#.*\\|@.*\\)*" nil t 1) + (throw 'tiarra-conf-next-token nil)) + + ;; "キー: 値"の形式であれば、行の終はりまでがトークン。 + (let* ((keychar "[^{}:\n\t ]") ; キーとして許される文字 + (pair (concat keychar "+[\t ]*:.*")) ; キーと値のペア + + ;; 連續する二つのコロンは、特例としてラベル名に許す。 + (labelchar "\\([^-{}\n\t ]\\|::\\)") ; ブロック名として許される文字 + (label (concat "\\(\\(\\+\\|-\\)[\t ]+\\)?" labelchar "+")) ;; ブロックのラベル + + (blockstart "{") ;; ブロックの開始 + (blockend "}") ;; ブロックの終了 + + type) + (setq type + (cond ((looking-at pair) 'pair) + ((looking-at label) 'label) + ((looking-at blockstart) 'blockstart) + ((looking-at blockend) 'blockend))) + (if (null type) + nil + (prog1 (list (buffer-substring (point) (match-end 0)) + type) + (goto-char (match-end 0))))))) + +(defun tiarra-conf-next-block (&optional n) + "次からn番目のブロックの位置へカーソルを移動する。 +nは省略可能で、省略された場合は`1'。 +ブロックが見付かつた場合は、そのラベルの開始位置を返す。" + (interactive "p") + (catch 'tiarra-conf-next-block + (setq n (if (numberp n) n 1)) + + (if (< n 0) + (throw 'tiarra-conf-next-block (tiarra-conf-prev-block (* -1 n)))) + (if (= n 0) + (throw 'tiarra-conf-next-block nil)) + + ;; カーソルを行の先頭へ移動。 + (beginning-of-line) + + (let (result token) + ;; labelが來るまでトークンを探す。 + (while (progn + (setq token (tiarra-conf-next-token)) + ;; tokenがnilまたはlabelなら終了。 + (if (or (null token) + (eq (cadr token) 'label)) + nil + ;; label以外のトークンなので、再度檢索。 + t))) + (if (null token) + ;; トークンが無い。ここで終はり。 + nil + (setq result (point)) + ;; "{"の次の非空白文字へ移動。 + (re-search-forward "{" nil t 1) + (re-search-forward "[^\n\t ]" nil t 1) + (backward-char) + + ;; nが2以上だったらもう一度。 + (if (> n 1) + (tiarra-conf-next-block (1- n)) + result))))) + +(defun tiarra-conf-prev-block (&optional n) + "前からn番目のブロックの位置へカーソルを移動する。 +nは省略可能で、省略された場合は`1'。 +ブロックが見付かつた場合は、そのラベルの開始位置を返す。" + (interactive "p") + (catch 'tiarra-conf-prev-block + (setq n (if (numberp n) n 1)) + (setq n (1+ n)) + + (if (< n 0) + (throw 'tiarra-conf-prev-block (tiarra-conf-next-block (* -1 n)))) + + ;; まづ次のブロックを探して、その位置を記録する。nilならnilで良い。 + (let ((next-block-pos + (save-excursion (tiarra-conf-next-block))) + current-block-pos) + ;; 一行づつカーソルを前に戻しつつ、「次の」ブロックを探してみる。 + ;; next-block-posよりも前に存在するブロックを見付けたら、そこで止める。 + (while (progn + (beginning-of-line) + (if (= (point) (point-min)) + ;; これ以上前には戻れない。 + nil + ;; まだ戻れる。 + (previous-line) + (setq current-block-pos + (save-excursion (tiarra-conf-next-block))) + ;; 最初に見付けた「次の」ブロックがnilだつたり、 + ;; 今囘見付けた「次の」ブロックと最初のそれが異つてゐたりすれば + ;; これを返して終了する。でなければ同じ事を繰返す。 + (eq current-block-pos next-block-pos)))) + + ;; nが2以上だつたらもう一度。 + (if (> n 1) + ;; カーソル位置を先頭へ戻す + (progn (beginning-of-line) + (tiarra-conf-prev-block (- n 2))) + ;; カーソルを適切な位置へ移動させる爲だけに + ;; tiarra-conf-next-blockを呼ぶ。 + (tiarra-conf-next-block) + current-block-pos)))) + +(defun tiarra-conf-join (delimitor sequence) + "perlのjoin(delimitor, sequence)と同じ。" + (let (result join) + (setq join (lambda (elem) + (setq result (if (null result) + elem + (concat result delimitor elem))))) + (mapcar join sequence) + result)) + +(defun tiarra-conf-jump-to-block () + "そのconf中にあるブロックの名前を入力し、その場所にジャンプするコマンド。" + (interactive) + (let (comp-list ;; competing-readで使ふalist ("ブロック名" . labelトークンの直後の位置) + parsing-block-stack ;; ("ブロック名" ...) + blockname-to-jump + point-to-jump) + (save-excursion + ;; カーソルをファイルの先頭へ + (goto-char (point-min)) + ;; 一つづつトークンを見て行く。labelを見たら記録する。 + (while (let (token type blockname) + (setq token (tiarra-conf-next-token)) + (if (null token) + ;; もうトークンが無い。 + nil + (setq type (cadr token)) + (cond ((eq type 'label) + ;; ﾌﾞﾛｯｸ(･∀･)ｶｲｼ + (setq blockname (car token)) + (if (string-match "^[-+][\t ]+" blockname) ; +や-は取る。 + (setq blockname (replace-match "" nil nil blockname))) + (push blockname parsing-block-stack) + (setq comp-list + (append comp-list + (list (cons + (tiarra-conf-join " - " (reverse parsing-block-stack)) + (point)))))) + ((eq type 'blockend) + ;; ﾌﾞﾛｯｸ(･Ａ･)ｼｭｳﾘｮｳ + (pop parsing-block-stack))) + t))) + ;; ブロック名を聞く。 + (let ((completion-ignore-case t)) ; 一時的にこの變數をtに。動的スコープは便利だね…。 + (setq blockname-to-jump (completing-read + "ジャンプするブロック: " + comp-list nil t))) + (setq point-to-jump (cdr (assoc blockname-to-jump comp-list)))) + (if point-to-jump + ;; 適切な位置へカーソルを移動 + (progn + (goto-char point-to-jump) + (beginning-of-line) + (tiarra-conf-next-block))))) + + diff -urN /non-existant-dir/tiarra-conf.l tiarra-20050322/tiarra-conf.l --- /non-existant-dir/tiarra-conf.l 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050322/tiarra-conf.l 2005-03-23 09:18:46.000000000 +0900 @@ -0,0 +1,112 @@ +;;; -*- Mode: Lisp; Package: EDITOR -*- + +;; $Id: tiarra-conf.l 479 2004-08-20 23:55:47Z topia $ + +;;tiarra-conf.l (tiarra-conf.elA) +;;Copyright (C) 2003 Noboruhi + +;;Author: Noboruhi +;;Version: 0.0.0.1 + +;; g: + +;; 1. tiarra-conf.l(t@C)(xyzzyCXg[fBNg)/site-lisp/ Rs[ +;; 2. KvoCgRpC +;; 3. W[o^B +;; [.xyzzy ] +;; (export 'ed::tiarra-conf-mode "ed") +;; (autoload 'tiarra-conf-mode "tiarra-conf" t) +;; [siteinit.l] +;; (in-package "editor") +;; (export 'tiarra-conf-mode) +;; (autoload 'tiarra-conf-mode "tiarra-conf" t) +;; (in-package "user") +;; 4.xyzzyN + +;; JX^}CY: + +;; FX +;; (setq ed::*tiarra-conf-font-lock-comment-face* '(:comment)) +;; (setq ed::*tiarra-conf-font-lock-warning-face* '((:keyword :comment :bold))) +;; (setq ed::*tiarra-conf-font-lock-type-face* '((:keyword 0))) +;; (setq ed::*tiarra-conf-font-lock-constant-face* '((:keyword 2))) +;; (setq ed::*tiarra-conf-font-lock-variable-face* '(:color 11 0)) +;; (setq ed::*tiarra-conf-font-lock-string-face* ':string) +;; (setq ed::*tiarra-conf-font-lock-function-name-face* '((:keyword 1))) + +;; Changes: +;; [Version 0.0.0.1] +;; EBAB +;; + +(provide "tiarra-conf-mode") +(in-package "editor") + +;; L[}bv +(defvar *tiarra-conf-mode-map* nil + "Keymap for tiarra conf mode.") + + +(unless *tiarra-conf-mode-map* + (setq *tiarra-conf-mode-map* (make-sparse-keymap))) + +;; \` +(defvar *tiarra-conf-mode-syntax-table* nil + "Syntax table used while in tiarra conf mode.") +(unless *tiarra-conf-mode-syntax-table* + (setq *tiarra-conf-mode-syntax-table* (make-syntax-table)) + (set-syntax-match *tiarra-conf-mode-syntax-table* #\{ #\})) + + +;; ` +(defvar *tiarra-conf-mode-abbrev-table* nil + "Abbrev table used while in tiarra conf mode.") +(unless *tiarra-conf-mode-abbrev-table* + (define-abbrev-table '*tiarra-conf-mode-abbrev-table*)) + + +;; tbN +(defvar *tiarra-conf-mode-hook* nil + "Normal hook runs when entering tiarra-conf-mode.") + +;; tHgbN +(defvar *tiarra-conf-font-lock-comment-face* '(:comment)) +(defvar *tiarra-conf-font-lock-warning-face* '((:keyword :comment :bold))) +(defvar *tiarra-conf-font-lock-type-face* '((:keyword 0))) +(defvar *tiarra-conf-font-lock-constant-face* '((:keyword 2))) +(defvar *tiarra-conf-font-lock-variable-face* '(:color 11 0)) +(defvar *tiarra-conf-font-lock-string-face* ':string) +(defvar *tiarra-conf-font-lock-function-name-face* '((:keyword 1))) + +(defvar *tiarra-conf-regexp-keyword-list* + (compile-regexp-keyword-list + `( + ("^[\t ]*#.*$" nil . ,*tiarra-conf-font-lock-comment-face*) + ("^[\t ]*@.*$" nil . ,*tiarra-conf-font-lock-warning-face*) + ("^[\t ]*\\+[\t ]+.+$" nil . ,*tiarra-conf-font-lock-type-face*) + ("^[\t ]*-[\t ]+.+$" nil . ,*tiarra-conf-font-lock-constant-face*) + ("^[\t ]*\\([^:\n]+\\)\\(:\\).*$" nil ((1 . ,*tiarra-conf-font-lock-variable-face*) + (2 . ,*tiarra-conf-font-lock-string-face*))) + ("^[\t ]*[^{}\n]+" nil . ,*tiarra-conf-font-lock-function-name-face*) + ))) + + + + +;; +(defun tiarra-conf-mode () + "Major mode for editing tiarra conf file. +\\{*tiarra-conf-mode-map*} +Turning on tiarra-conf-mode runs the normal hook `tiarra-conf-mode-hook'." + (interactive) + (kill-all-local-variables) + (setq mode-name "tiarra-conf") + (setq buffer-mode 'tiarra-conf-mode) + (use-keymap *tiarra-conf-mode-map*) + (use-syntax-table *tiarra-conf-mode-syntax-table*) + (setq *local-abbrev-table* *tiarra-conf-mode-abbrev-table*) + (make-local-variable 'regexp-keyword-list) + (setq regexp-keyword-list *tiarra-conf-regexp-keyword-list*) + (run-hooks '*tiarra-conf-mode-hook*)) + +