diff -urN tiarra-20040708/ChangeLog tiarra-20040729/ChangeLog --- tiarra-20040708/ChangeLog 2004-07-09 13:27:20 +0900 +++ tiarra-20040729/ChangeLog 2004-08-04 07:24:47 +0900 @@ -1,3 +1,62 @@ +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: @@ -1752,7 +1811,7 @@ * これ以前のログは書いていません。 -# Id: $Id: ChangeLog,v 1.155 2004/07/08 15:13:12 topia Exp $ +# Id: $Id: ChangeLog,v 1.157 2004/07/29 06:23:47 topia Exp $ # Author: $Author: topia $ -# Date: $Date: 2004/07/08 15:13:12 $ -# Revision: $Revision: 1.155 $ +# Date: $Date: 2004/07/29 06:23:47 $ +# Revision: $Revision: 1.157 $ diff -urN tiarra-20040708/HACKING tiarra-20040729/HACKING --- tiarra-20040708/HACKING 2004-07-09 13:27:20 +0900 +++ tiarra-20040729/HACKING 2004-08-04 07:24:47 +0900 @@ -57,12 +57,15 @@ - 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 数の対応を (情報が得られたときに)記録しています。 @@ -93,3 +96,7 @@ * creation-time RPL_CREATIONTIME が返した値。 - PersonInChannel - PersonalInfo + +Local variables: +mode: text +End: diff -urN tiarra-20040708/NEWS tiarra-20040729/NEWS --- tiarra-20040708/NEWS 2004-07-09 13:27:20 +0900 +++ tiarra-20040729/NEWS 2004-08-04 07:24:47 +0900 @@ -1,3 +1,9 @@ +2004-07-29 Topia + + * System::NotifyIcon::Win32 + - 追加。タスクバーの通知領域にアイコンを表示し、コンソールの + 表示・非表示、 conf リロード、終了などができます。 + 2004-07-09 Topia * System::Reload diff -urN tiarra-20040708/doc/module/Auto.html tiarra-20040729/doc/module/Auto.html --- tiarra-20040708/doc/module/Auto.html 2004-07-09 13:27:25 +0900 +++ tiarra-20040729/doc/module/Auto.html 2004-08-04 07:24:53 +0900 @@ -516,9 +516,9 @@

remove:反応削除

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

-modifier:*!*@*
+modifier:* *!*@*

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

diff -urN tiarra-20040708/doc/module/System.html tiarra-20040729/doc/module/System.html --- tiarra-20040708/doc/module/System.html 2004-07-09 13:27:25 +0900 +++ tiarra-20040729/doc/module/System.html 2004-08-04 07:24:53 +0900 @@ -31,6 +31,31 @@
+
+ System::NotifyIcon::Win32 タスクトレイにアイコンを表示する。 +
+

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

+

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

+

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

+interval:2
+ +
+
+ + +
+ +
System::Pong サーバーからのPINGメッセージに対し、自動的にPONGを返す。
diff -urN tiarra-20040708/doc/module/User.html tiarra-20040729/doc/module/User.html --- tiarra-20040708/doc/module/User.html 2004-07-09 13:27:25 +0900 +++ tiarra-20040729/doc/module/User.html 2004-08-04 07:24:53 +0900 @@ -107,7 +107,7 @@
- User::ServerOper 特定のネットワークに接続した時、OPERコマンドを発行してします。 + User::ServerOper 特定のネットワークに接続した時、OPERコマンドを発行します。

 書式: <ネットワーク名> <オペレータ名> <オペレータパスワード>
@@ -143,7 +143,7 @@ drop-mode-switch-for-target:1

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

drop-kick-by-target:1

diff -urN tiarra-20040708/doc/module-toc.html tiarra-20040729/doc/module-toc.html --- tiarra-20040708/doc/module-toc.html 2004-07-09 13:27:25 +0900 +++ tiarra-20040729/doc/module-toc.html 2004-08-04 07:24:53 +0900 @@ -123,6 +123,8 @@

  • System::Macro 新規にコマンドを追加し、そのコマンドが使われた時に特定の動作をまとめて実行します。
    • +
  • System::NotifyIcon::Win32 タスクトレイにアイコンを表示する。
    • +
  • System::Pong サーバーからのPINGメッセージに対し、自動的にPONGを返す。
  • System::PrivTranslator クライアントからの個人的なprivが相手に届かなくなる現象を回避する。
    • @@ -152,7 +154,7 @@
  • User::Nick::Detached クライアントが接続されていない時に、特定のnickに変更します。
    • -
  • User::ServerOper 特定のネットワークに接続した時、OPERコマンドを発行してします。
    • +
  • User::ServerOper 特定のネットワークに接続した時、OPERコマンドを発行します。
  • User::Vanish 指定された人物の存在を、様々なメッセージから消去する。
    • diff -urN tiarra-20040708/main/ControlPort.pm tiarra-20040729/main/ControlPort.pm --- tiarra-20040708/main/ControlPort.pm 2004-07-09 13:27:21 +0900 +++ tiarra-20040729/main/ControlPort.pm 2004-08-04 07:24:49 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: ControlPort.pm,v 1.4 2004/04/18 06:01:16 admin Exp $ +# $Id: ControlPort.pm,v 1.5 2004/07/29 06:23:47 topia Exp $ # ----------------------------------------------------------------------------- =pod << NOTIFY Log::Channel TIARRACONTROL/1.0 @@ -29,9 +29,10 @@ use Unicode::Japanese; use RunLoop; -use SelfLoader; -1; -__DATA__ +# 複数のパッケージを混在させてるとSelfLoaderが使えない…？ +#use SelfLoader; +#1; +#__DATA__ sub new { my ($class,$sockname) = @_; diff -urN tiarra-20040708/main/Module/Use.pm tiarra-20040729/main/Module/Use.pm --- tiarra-20040708/main/Module/Use.pm 2004-07-09 13:27:20 +0900 +++ tiarra-20040729/main/Module/Use.pm 2004-08-04 07:24:47 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Use.pm,v 1.2 2003/01/22 11:07:08 admin Exp $ +# $Id: Use.pm,v 1.3 2004/07/29 06:23:47 topia Exp $ # ----------------------------------------------------------------------------- # 全てのTiarraモジュールは@ISAにModuleを登録する必要があるが、 # そのモジュールがmodule下の他のperlモジュールをuseしている場合は @@ -16,7 +16,7 @@ my ($caller_pkg) = caller; # use元の@USEに@modulesを設定。これは到達可能性のトレースに用いられる。 - eval qq{ \@${caller_pkg}::USE = \@modules; }; + eval qq{ push(\@${caller_pkg}::USE, \@modules); }; # use先のUSEDにuse元のクラス名を追加。これはサブモジュール更新時の影響範囲の特定に用いられる。 foreach (@modules) { diff -urN tiarra-20040708/main/ModuleManager.pm tiarra-20040729/main/ModuleManager.pm --- tiarra-20040708/main/ModuleManager.pm 2004-07-09 13:27:21 +0900 +++ tiarra-20040729/main/ModuleManager.pm 2004-08-04 07:24:49 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: ModuleManager.pm,v 1.16 2004/07/08 15:13:13 topia Exp $ +# $Id: ModuleManager.pm,v 1.17 2004/07/29 06:23:47 topia Exp $ # ----------------------------------------------------------------------------- # このクラスは全てのTiarraモジュールを管理します。 # モジュールをロードし、リロードし、破棄するのはこのクラスです。 @@ -132,7 +132,7 @@ eval { $loaded_mods{$_->block_name}->destruct; }; if ($@) { - RunLoop->shared_loop->notify_error->($@); + RunLoop->shared_loop->notify_error($@); } } $this->_unload($_); @@ -226,6 +226,7 @@ if (defined $USED) { # USEDの全ての要素に対し再帰的にマークを付ける。 foreach my $used_elem (keys %$USED) { + $mods_to_be_reloaded->{$used_elem} = 1; $show_msg->("$used_elem will be reloaded because of modification of $modname"); $trace->($used_elem); } @@ -256,7 +257,7 @@ eval { $this->{modules}->[$idx]->destruct; }; if ($@) { - RunLoop->shared_loop->notify_error->($@); + RunLoop->shared_loop->notify_error($@); } my $conf_block = $this->{mod_configs}->{$modname}; @@ -274,7 +275,7 @@ eval qq{ use $modname; }; if ($@) { - RunLoop->shared_loop->notify_error->($@); + RunLoop->shared_loop->notify_error($@); } eval qq{ \%${modname}::USED = \%USED; @@ -383,58 +384,26 @@ $mod_filename .= '.pm'; # シンボルテーブルを削除してしまえば変数やサブルーチンにアクセス出来なくなる。 - # 多分これでメモリが開放されるだろう。 - #eval 'undef %'.$modname.'::;'; - # NG。v5.6.0 built for darwinでこれをやるとbus errorで落ちる。 - # 落ちなかったとしても非常に危険である。 - # 代わりにシンボルテーブル内の全てのシンボルをundefする。 - # シンボルテーブル一つ分のメモリはリークするが、仕方が無い。 + use Symbol (); + # サブパッケージを消す挙動は危険かもしれないのでとりあえず退避。 + # (%INC のこともあるし) + # ただし、サブパッケージの性格上メインパッケージなしに動く保証はどこにもない。 + no strict; local(*stab) = eval qq{\*${modname}::}; - my $defined_on; - my %showed_modules; - while (my ($key,$val) = each(%stab)) { - local(*entry) = $val; - if (defined $entry) { - ::debug_printmsg("unload scalar: $key"); - undef $entry; - } - if (defined @entry) { - ::debug_printmsg("unload array: $key"); - undef @entry; - } - if (defined &entry) { - $defined_on = eval q{ - use B; - B::svref_2object(\&entry)->FILE - }; - if ($defined_on && $defined_on eq $INC{$mod_filename}) { - ::debug_printmsg("unload subroutine: $key"); - undef &entry; - } else { - if (::debug_mode()) { - if (!defined $defined_on) { - ::printmsg("not-unload subroutine: $key, " . - 'defined on (anywhere)'); - } else { - ++$showed_modules{$defined_on}; - if ($showed_modules{$defined_on} <= 10) { - ::printmsg("not-unload subroutine: $key" . - ", defined on $defined_on"); - } - if ($showed_modules{$defined_on} == 10) { - ::printmsg("not-unload subroutine: omit the rest " . - "of defined on $defined_on..."); - } - } - } - } - } - if ($key ne "${modname}::" && defined %entry) { - ::debug_printmsg("unload symtable: $key"); - undef %entry; + my %shelter = map { + if ($_ =~ /::$/ && + $_ !~ /^(SUPER)::$/ && $_ !~ /^::(ISA|ISA::CACHE)::$/) { + ($_, $stab{$_}); + } else { + (); } - } + } keys(%stab); + + Symbol::delete_package($modname); + + # 隔離しておいたものを戻す。 + eval qq{\%${modname}:: = ( \%shelter, \%${modname}:: ) }; # %INCからも削除 delete $INC{$mod_filename}; diff -urN tiarra-20040708/main/Timer.pm tiarra-20040729/main/Timer.pm --- tiarra-20040708/main/Timer.pm 2004-07-09 13:27:21 +0900 +++ tiarra-20040729/main/Timer.pm 2004-08-04 07:24:48 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Timer.pm,v 1.9 2004/07/08 15:13:13 topia Exp $ +# $Id: Timer.pm,v 1.10 2004/07/29 06:23:47 topia Exp $ # ----------------------------------------------------------------------------- # RunLoopに登録され、指定された時刻に起動するタイマーです。 # 現在の実装では、精度は秒となっています。 @@ -167,4 +167,16 @@ $this->{interval}; } +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 tiarra-20040708/module/Auto/Reply.pm tiarra-20040729/module/Auto/Reply.pm --- tiarra-20040708/module/Auto/Reply.pm 2004-07-09 13:27:22 +0900 +++ tiarra-20040729/module/Auto/Reply.pm 2004-08-04 07:24:50 +0900 @@ -231,8 +231,8 @@ # 実際の削除方法は「 <削除するキーワード>」です。 remove: 反応削除 - # addとremoveを許可する人。省略された場合は「*!*@*」と見做します。 - modifier: *!*@* + # addとremoveを許可する人。省略された場合は「* *!*@*」と見做します。 + modifier: * *!*@* # 正規表現拡張を許可するか。省略された場合は許可します。 use-re: 1 diff -urN tiarra-20040708/module/Auto/Utils.pm tiarra-20040729/module/Auto/Utils.pm --- tiarra-20040708/module/Auto/Utils.pm 2004-07-09 13:27:21 +0900 +++ tiarra-20040729/module/Auto/Utils.pm 2004-08-04 07:24:50 +0900 @@ -1,7 +1,6 @@ # ----------------------------------------------------------------------------- -# $Id: Utils.pm,v 1.10 2003/07/31 07:34:14 topia Exp $ +# $Id: Utils.pm,v 1.11 2004/07/29 06:23:47 topia Exp $ # ----------------------------------------------------------------------------- -# $Clovery: tiarra/module/Auto/Utils.pm,v 1.16 2003/07/27 07:02:47 topia Exp $ package Auto::Utils; use strict; use warnings; @@ -9,6 +8,7 @@ use Auto::AliasDB; use Multicast; use IRCMessage; +use RunLoop; # get_ch_name は get_raw_ch_name のエイリアス(過去互換のため) *get_ch_name = \&get_raw_ch_name; @@ -43,9 +43,12 @@ # $msg : message_arrivedに渡ってきた$msg。エイリアス置換に使用されます。よって、 # 後述する $use_alias が false なら指定する必要はありません。 # その場合は undef でも渡しておきましょう。 - # $sender : message_arrivedに渡ってきた$sender。送信に使います。必須。 + # $sender : message_arrivedに渡ってきた$sender。送信に使います。ない場合は + # $result とともに undef を指定してください。 # $result : message_arrivedの返り値にする配列の参照。詳細は例を見ましょう。 - # $use_alias : エイリアス置き換えを行うかどうか。省略可、省略した場合は行う。 + # $use_alias : エイリアス置き換えを行うかどうか。省略可で省略した場合は + # 行うが、 $msg, $sender のどちらかが undef ならエイリアス + # 置き換えを呼び出せないので行わない。 # $extra_callbacks # : 追加のエイリアス置換コールバック。省略可。 # @@ -70,7 +73,7 @@ my ($sendto, $command, $msg, $sender, $result, $use_alias, $extra_callbacks) = @_; - $use_alias = 1 unless defined $use_alias; + $use_alias = 1 if (!defined $use_alias && defined $msg && defined $sender); $extra_callbacks = [] unless defined $extra_callbacks; return sub { @@ -87,16 +90,43 @@ $sender, %extra_replaces) : $str)]); - if ($sender->isa('IrcIO::Server')) { + 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 = sub { + if (RunLoop->shared_loop->multi_server_mode_p) { + $sendto; + } else { + $rawname; + } + }; + 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, scalar(Multicast::detach($sendto))); + $for_server->param(0, $rawname); $sender->send_message($for_server); # クライアントにはチャンネル名にネットワーク名を付ける。 # また、クライアントに送られる時にはPrefixがそのユーザーに設定されるよう註釈を付ける。 my $for_client = $msg_to_send->clone; - $for_client->param(0, $sendto); + $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')) { @@ -107,7 +137,7 @@ my $for_client = $msg_to_send->clone; $for_client->prefix($sender->fullname); - $for_client->param(0, $sendto); + $for_client->param(0, $sendto_client->()); $sender->send_message($for_client); } }; @@ -143,7 +173,7 @@ # my ($this,$msg,$sender) = @_; # my @result = ($msg); # my ($get_ch_name, $reply, $reply_as_priv, $reply_anywhere) = - # sendto_channel_closure($msg, $sender, \@result); + # generate_reply_closures($msg, $sender, \@result); # $reply_anywhere->('message', 'hoge' => 'moge'); # return @result; # } diff -urN tiarra-20040708/module/Client/Eval.pm tiarra-20040729/module/Client/Eval.pm --- tiarra-20040708/module/Client/Eval.pm 2004-07-09 13:27:22 +0900 +++ tiarra-20040729/module/Client/Eval.pm 2004-08-04 07:24:50 +0900 @@ -1,11 +1,12 @@ # ----------------------------------------------------------------------------- -# $Id: Eval.pm,v 1.5 2004/06/19 09:33:42 topia Exp $ +# $Id: Eval.pm,v 1.6 2004/07/29 06:23:47 topia Exp $ # ----------------------------------------------------------------------------- package Client::Eval; use strict; use warnings; use base qw(Module); use Mask; +use Timer; use Data::Dumper; sub message_arrived { @@ -56,13 +57,23 @@ } # useful functions to call from eval -sub network { - return runloop()->network(shift); +sub network { return runloop()->network(shift); } +sub runloop { return RunLoop->shared_loop; } +sub conf { return Configuration->shared_conf; } +sub module_manager { return ModuleManager->shared_manager; } +sub module { return module_manager()->get(shift); } +sub shutdown { return ::shutdown(); } +sub reload { + Timer->new( + After => 0, + Code => sub { + ReloadTrigger->reload_conf_if_updated; + ReloadTrigger->reload_mods_if_updated; + } + )->install; + return undef; } -sub runloop { - return RunLoop->shared_loop; -} 1; =pod info: クライアントから Perl 式を実行できるようにする。 diff -urN tiarra-20040708/module/System/NotifyIcon/Win32.pm tiarra-20040729/module/System/NotifyIcon/Win32.pm --- tiarra-20040708/module/System/NotifyIcon/Win32.pm 1970-01-01 09:00:00 +0900 +++ tiarra-20040729/module/System/NotifyIcon/Win32.pm 2004-08-04 07:24:51 +0900 @@ -0,0 +1,221 @@ +# ----------------------------------------------------------------------------- +# $Id: Win32.pm,v 1.1 2004/07/29 06:23:48 topia Exp $ +# ----------------------------------------------------------------------------- +# use shell notify-icon +# based on win32::TaskTray.pm (超ベータVer) +# ----------------------------------------------------------------------------- +package System::NotifyIcon::Win32; +use strict; +use warnings; +use base qw(Module); +use Win32::GUI (); # non-default +use Timer; +our $AUTOLOAD; + +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, + " > &Reload" => { -name => __PACKAGE__ . '::NotifyIcon_Popup_reload', -default => 1 }, + ); + + $this->{window_stat} = 1; # start with show + $this->{console_window} = Win32::GUI::GetPerlWindow(); + + # タスクトレイ登録 + $this->{icon} = new Win32::GUI::Icon('GUIPERL.ICO'); + $this->event_handler_register('NotifyIcon_Click'); + $this->event_handler_register('NotifyIcon_RightClick'); + $this->{notify_icon} = $this->{main_window}->AddNotifyIcon( + -name => __PACKAGE__ . '::NotifyIcon', + -icon => $this->{icon}, + -tip => 'Tiarra(irc proxy) #' . ::version()); + + return $this; +} + + +sub destruct { + my $this = shift; + + 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; +} + +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 (@_) { + 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; + + if (defined $this->{timer}) { + $this->{timer}->uninstall; + $this->{timer} = undef; + } + if (defined $this->{hook}) { + $this->{hook}->uninstall; + $this->{hook} = undef; + } +} + + +# 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(); +} + +sub Win32Event_NotifyIcon_Popup_reload_Click { + Timer->new( + After => 0, + Code => sub { + ReloadTrigger->reload_conf_if_updated; + ReloadTrigger->reload_mods_if_updated; + } + )->install; +} + +1; +=pod +info: タスクトレイにアイコンを表示する。 +default: off + +# タスクトレイにアイコンを表示します。 +# クリックすると表示非表示を切り替えることができ、右クリックすると +# Reload と Exit ができるコンテキストメニューを表示します。 +# 多少反応が鈍いかもしれませんがちょっと待てば出てくると思います。 + +# Win32::GUI を必要とします。 +# コンテキストメニューは表示している間処理をブロックしています。 + +# Win32 イベントループを処理する最大間隔を指定します。 +-interval: 2 +=cut diff -urN tiarra-20040708/module/User/ServerOper.pm tiarra-20040729/module/User/ServerOper.pm --- tiarra-20040708/module/User/ServerOper.pm 2004-07-09 13:27:22 +0900 +++ tiarra-20040729/module/User/ServerOper.pm 2004-08-04 07:24:50 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: ServerOper.pm,v 1.2 2004/02/23 02:46:20 topia Exp $ +# $Id: ServerOper.pm,v 1.3 2004/07/09 02:34:11 admin Exp $ # ----------------------------------------------------------------------------- package User::ServerOper; use strict; @@ -35,7 +35,7 @@ 1; =pod -info: 特定のネットワークに接続した時、OPERコマンドを発行してします。 +info: 特定のネットワークに接続した時、OPERコマンドを発行します。 default: off # 書式: <ネットワーク名> <オペレータ名> <オペレータパスワード> diff -urN tiarra-20040708/module/User/Vanish.pm tiarra-20040729/module/User/Vanish.pm --- tiarra-20040708/module/User/Vanish.pm 2004-07-09 13:27:22 +0900 +++ tiarra-20040729/module/User/Vanish.pm 2004-08-04 07:24:50 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Vanish.pm,v 1.5 2004/02/23 02:46:20 topia Exp $ +# $Id: Vanish.pm,v 1.6 2004/07/09 02:34:11 admin Exp $ # ----------------------------------------------------------------------------- package User::Vanish; use strict; @@ -160,7 +160,7 @@ 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.BANISH'); + $msg->prefix('HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH'); } } $msg; @@ -275,7 +275,7 @@ 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.BANISH'); + $msg->prefix('HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH'); } } @@ -316,7 +316,7 @@ drop-mode-switch-for-target: 1 # Vanish対象が発行したKICKを消去するかどうか。デフォルトで0。 -# 本当に消すのではなく、"HIDDEN!HIDDEN@HIDDEN"がKICKを実行した事にする。 +# 本当に消すのではなく、"HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH"がKICKを実行した事にする。 drop-kick-by-target: 1 # Vanish対象を対象とするKICKを消去するかどうか。デフォルトで0。 diff -urN tiarra-20040708/sample.conf tiarra-20040729/sample.conf --- tiarra-20040708/sample.conf 2004-07-09 13:27:25 +0900 +++ tiarra-20040729/sample.conf 2004-08-04 07:24:53 +0900 @@ -663,8 +663,8 @@ # 実際の削除方法は「 <削除するキーワード>」です。 remove: 反応削除 - # addとremoveを許可する人。省略された場合は「*!*@*」と見做します。 - modifier: *!*@* + # addとremoveを許可する人。省略された場合は「* *!*@*」と見做します。 + modifier: * *!*@* # 正規表現拡張を許可するか。省略された場合は許可します。 use-re: 1 @@ -1008,6 +1008,21 @@ #macro: switch part #d@ircnet,#e@ircnet,#f@ircnet } +- System::NotifyIcon::Win32 { + # タスクトレイにアイコンを表示する。 + + # タスクトレイにアイコンを表示します。 + # クリックすると表示非表示を切り替えることができ、右クリックすると + # Reload と Exit ができるコンテキストメニューを表示します。 + # 多少反応が鈍いかもしれませんがちょっと待てば出てくると思います。 + + # Win32::GUI を必要とします。 + # コンテキストメニューは表示している間処理をブロックしています。 + + # Win32 イベントループを処理する最大間隔を指定します。 + #interval: 2 +} + + System::Pong { # サーバーからのPINGメッセージに対し、自動的にPONGを返す。 @@ -1141,7 +1156,7 @@ } - User::ServerOper { - # 特定のネットワークに接続した時、OPERコマンドを発行してします。 + # 特定のネットワークに接続した時、OPERコマンドを発行します。 # 書式: <ネットワーク名> <オペレータ名> <オペレータパスワード> # @@ -1165,7 +1180,7 @@ drop-mode-switch-for-target: 1 # Vanish対象が発行したKICKを消去するかどうか。デフォルトで0。 - # 本当に消すのではなく、"HIDDEN!HIDDEN@HIDDEN"がKICKを実行した事にする。 + # 本当に消すのではなく、"HIDDEN!HIDDEN@HIDDEN.BY.USER.VANISH"がKICKを実行した事にする。 drop-kick-by-target: 1 # Vanish対象を対象とするKICKを消去するかどうか。デフォルトで0。