diff -urN tiarra-20030922/ChangeLog tiarra-20030925/ChangeLog --- tiarra-20030922/ChangeLog 2003-09-23 04:14:41.000000000 +0900 +++ tiarra-20030925/ChangeLog 2003-09-26 12:50:56.000000000 +0900 @@ -1,5 +1,52 @@ +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個に減少。 @@ -57,7 +104,7 @@ * main/Hook.pm: フックの一般的な定義。このファイルはクラスHookとクラスHookTargetを定義する。 - + * main/Configuration.pm: リロードした時、フック`reloaded'を呼ぶ。 @@ -93,7 +140,7 @@ * doc-src/contents.html: 追加。htmlドキュメントのテンプレート。 * doc-src/module-group.tdoc: 追加。モジュールの分類情報。 - + * doc-src/module-toc.html: 追加。モジュールの目次のhtmlテンプレート。 * doc-src/sample.conf.in: 追加。sample.confのテンプレート。 @@ -857,7 +904,7 @@ * これ以前のログは書いていません。 -# Id: $Id: ChangeLog,v 1.100 2003/09/22 18:02:06 admin Exp $ -# Author: $Author: admin $ -# Date: $Date: 2003/09/22 18:02:06 $ -# Revision: $Revision: 1.100 $ +# Id: $Id: ChangeLog,v 1.103 2003/09/25 13:15:59 topia Exp $ +# Author: $Author: topia $ +# Date: $Date: 2003/09/25 13:15:59 $ +# Revision: $Revision: 1.103 $ diff -urN tiarra-20030922/NEWS tiarra-20030925/NEWS --- tiarra-20030922/NEWS 2003-09-23 04:14:41.000000000 +0900 +++ tiarra-20030925/NEWS 2003-09-26 12:50:56.000000000 +0900 @@ -1,3 +1,9 @@ +2003-09-25 Topia + + * このバージョン以前の Tiarra には、 + モジュールのアンロードをすると原因不明のエラーが起こるバグがあります。 + また、アップグレードの際には再起動が必要です。 + 2003-08-12 phonohawk * シングルサーバーモードを実装。 diff -urN tiarra-20030922/main/ModuleManager.pm tiarra-20030925/main/ModuleManager.pm --- tiarra-20030922/main/ModuleManager.pm 2003-09-23 04:14:42.000000000 +0900 +++ tiarra-20030925/main/ModuleManager.pm 2003-09-26 12:50:58.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: ModuleManager.pm,v 1.10 2003/05/15 12:11:11 admin Exp $ +# $Id: ModuleManager.pm,v 1.12 2003/09/25 13:15:59 topia Exp $ # ----------------------------------------------------------------------------- # このクラスは全てのTiarraモジュールを管理します。 # モジュールをロードし、リロードし、破棄するのはこのクラスです。 @@ -95,7 +95,7 @@ my %loaded_mods = map { ref($_) => $_; } @{$this->{modules}}; - + # 新たに追加されたモジュール、作り直されたモジュール、変更されなかったモジュールを # モジュール名 => Moduleの形式でテーブルにする。 my %new_mods = map { @@ -116,6 +116,13 @@ $_->block_name => $loaded_mods{$_->block_name}; } @$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) { # 削除されたモジュール。 @@ -129,13 +136,6 @@ $this->_unload($_); } - # $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; - if ($deleted_any > 0) { # 何か一つでもアンロードしたモジュールがあれば、最早参照されなくなったモジュールが # あるかどうかを調べ、一つでもあればmark and sweepを実行。 @@ -144,7 +144,7 @@ $this->gc; } } - + $this->{updated_once} = 1; $this; } @@ -161,7 +161,7 @@ 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; @@ -201,13 +201,13 @@ my $show_msg = sub { RunLoop->shared_loop->notify_msg($_[0]); }; - + my $mods_to_be_reloaded = {}; # モジュール名 => 1 my $check = sub { my ($modname,$timestamp) = @_; # 既に更新されたものとしてマークされていれば抜ける。 return if $mods_to_be_reloaded->{$modname}; - + (my $mod_filename = $modname) =~ s|::|/|g; my $mod_fpath = $INC{$mod_filename.'.pm'}; return if (!defined($mod_fpath) || !-f $mod_fpath); @@ -229,11 +229,11 @@ } } }; - + $trace->($modname); } }; - + while (my ($modname,$timestamp) = each %{$this->{mod_timestamps}}) { $check->($modname,$timestamp); } @@ -256,7 +256,7 @@ }; if ($@) { $show_msg->($@); } - + my $conf_block = $this->{mod_configs}->{$modname}; $this->_unload($conf_block); $this->{modules}->[$idx] = $this->_load($conf_block); # 失敗するとundefが入る。 @@ -276,7 +276,7 @@ }; } } - + # 全てのモジュールの%USEDを調べて、その%USEDが指しているモジュールが # 本当にそのモジュールを参照しているのかどうかをチェック。 # モジュールの更新で最早参照しなくなっていれば、%USEDから削除する。 @@ -310,7 +310,7 @@ "Couldn't load module $mod_name because of exception.\n$@"); return undef; } - + # モジュール名をファイル名に変換して%INCを検査。 # module/で始まっていなければエラー。 #(my $mod_filename = $mod_name) =~ s|::|/|g; @@ -320,7 +320,7 @@ # "Class $mod_name exists outside the module directory.\n$filepath\n"); # next; #} - + # このモジュールは本当にModuleのサブクラスか？ # 何故かUNIVERSAL::isaは嘘を付く事があるので自力で@ISA内を検索する。 # 5.6.0 for darwinではモジュールをリロードすると嘘を付く。 @@ -329,6 +329,7 @@ my @isa = eval qq{ \@${mod_name}::ISA }; foreach (@isa) { if ($_ eq 'Module') { + ::debug_printmsg('UNIVERSAL::isa tell a lie...'); return 1; } } @@ -339,7 +340,7 @@ "Class $mod_name doesn't inherit class Module."); return undef; } - + # インスタンス生成 my $mod; eval { @@ -349,7 +350,7 @@ "Couldn't instantiate module $mod_name because of exception.\n$@"); return undef; } - + # このインスタンスは本当に$mod_nameそのものか？ if (ref($mod) ne $mod_name) { RunLoop->shared_loop->notify_error( @@ -359,11 +360,10 @@ # timestampに登録 $this->timestamp($mod_name,time); - + return $mod; } -no strict; sub _unload { # 指定されたモジュールを削除する。 # モジュール名の代わりにConfiguration::Blockを渡しても良い。 @@ -372,35 +372,53 @@ # このモジュールのuse時刻を消去 delete $this->{mod_timestamps}->{$modname}; - + + # このモジュールのファイル名を求めておく。 + (my $mod_filename = $modname) =~ s|::|/|g; + $mod_filename .= '.pm'; + # シンボルテーブルを削除してしまえば変数やサブルーチンにアクセス出来なくなる。 # 多分これでメモリが開放されるだろう。 #eval 'undef %'.$modname.'::;'; # NG。v5.6.0 built for darwinでこれをやるとbus errorで落ちる。 + # 落ちなかったとしても非常に危険である。 # 代わりにシンボルテーブル内の全てのシンボルをundefする。 # シンボルテーブル一つ分のメモリはリークするが、仕方が無い。 + no strict; local(*stab) = eval qq{\*${modname}::}; - while (($key,$val) = each(%stab)) { + my $defined_on; + 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) { - undef &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 { + ::debug_printmsg("not-unload subroutine: $key, on " . + ($defined_on || '(undefined)')); + } } if ($key ne "${modname}::" && defined %entry) { + ::debug_printmsg("unload symtable: $key"); undef %entry; } } # %INCからも削除 - (my $mod_filename = $modname) =~ s|::|/|g; - delete $INC{$mod_filename.'.pm'}; + delete $INC{$mod_filename}; } -use strict; sub fix_USED_fields { my $this = shift; @@ -460,16 +478,20 @@ } } }; - + for my $mod (@{$this->{modules}}) { my $modname = ref $mod; $trace->($modname); } - + # マークされなかったサブモジュールは到達不可能なのでアンロードする。 my $runloop = RunLoop->shared_loop; while (my ($key,$value) = each %all_mods) { if ($value ne '') { + eval qq{ + \&${key}::destruct(); + }; + $runloop->notify_msg( "Submodule $key is no longer required. It will be unloaded."); $this->_unload($key); diff -urN tiarra-20030922/main/Multicast.pm tiarra-20030925/main/Multicast.pm --- tiarra-20030922/main/Multicast.pm 2003-09-23 04:14:42.000000000 +0900 +++ tiarra-20030925/main/Multicast.pm 2003-09-26 12:50:58.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Multicast.pm,v 1.16 2003/08/17 15:18:53 topia Exp $ +# $Id: Multicast.pm,v 1.17 2003/09/23 15:26:11 admin Exp $ # ----------------------------------------------------------------------------- # サーバーからクライアントにメッセージが流れるとき、このクラスはフィルタとして # ネットワーク名を付加します。 @@ -597,8 +597,8 @@ my $str = detach(shift); return undef unless length($str); - my $first_char = '[a-zA-Z_\[\]\\\`\^\{\}]'; - my $remaining_char = '[0-9a-zA-Z_\-\[\]\\\`\^\{\}]'; + my $first_char = '[a-zA-Z_\[\]\\\`\^\{\}\|]'; + my $remaining_char = '[0-9a-zA-Z_\-\[\]\\\`\^\{\}\|]'; return $str =~ /^${first_char}${remaining_char}*$/; } diff -urN tiarra-20030922/main/PersonInChannel.pm tiarra-20030925/main/PersonInChannel.pm --- tiarra-20030922/main/PersonInChannel.pm 2003-09-23 04:14:41.000000000 +0900 +++ tiarra-20030925/main/PersonInChannel.pm 2003-09-26 12:50:58.000000000 +0900 @@ -1,8 +1,6 @@ -# ----------------------------------------------------------------------------- -# $Id: PersonInChannel.pm,v 1.6 2003/09/22 18:02:06 admin Exp $ # -*- cperl -*- # ----------------------------------------------------------------------------- -# $Id: PersonInChannel.pm,v 1.6 2003/09/22 18:02:06 admin Exp $ +# $Id: PersonInChannel.pm,v 1.7 2003/09/22 19:23:06 admin Exp $ # ----------------------------------------------------------------------------- # なるとや発言権を持っているかどうかの情報とPersonalInfoのセット。 # ----------------------------------------------------------------------------- ファイルtiarra-20030922/main/Unicode/Japanese.pmとtiarra-20030925/main/Unicode/Japanese.pmは違います diff -urN tiarra-20030922/module/Channel/Join/Connect.pm tiarra-20030925/module/Channel/Join/Connect.pm --- tiarra-20030922/module/Channel/Join/Connect.pm 2003-09-23 04:14:44.000000000 +0900 +++ tiarra-20030925/module/Channel/Join/Connect.pm 2003-09-26 12:51:00.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Connect.pm,v 1.2 2003/01/26 10:42:41 admin Exp $ +# $Id: Connect.pm,v 1.3 2003/09/25 13:15:59 topia Exp $ # ----------------------------------------------------------------------------- # copyright (C) 2002 Topia . all rights reserved. package Channel::Join::Connect; @@ -22,6 +22,7 @@ sub _init { my $this = shift; foreach ($this->config->channel('all')) { + s/(,)\s+/$1/; # コンマの直後にスペースがあった場合、削除する my ($fullname, $key) = split(/\s+/, $_, 2); my @fullnames = split(/\,/, $fullname); my @keys = split(/,/, $key || ''); @@ -39,7 +40,7 @@ }; } } - + $this; } @@ -82,3 +83,18 @@ } 1; +=pod +info: サーバーに初めて接続した時、指定したチャンネルに入るモジュール。 +default: off + +# 書式: <チャンネル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 tiarra-20030922/module/Log/Recent.pm tiarra-20030925/module/Log/Recent.pm --- tiarra-20030922/module/Log/Recent.pm 2003-09-23 04:14:42.000000000 +0900 +++ tiarra-20030925/module/Log/Recent.pm 2003-09-26 12:50:59.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Recent.pm,v 1.4 2003/03/17 08:08:32 topia Exp $ +# $Id: Recent.pm,v 1.5 2003/09/23 15:26:10 admin Exp $ # ----------------------------------------------------------------------------- # Local: $Clovery: tiarra/module/Log/Recent.pm,v 1.5 2003/02/11 07:59:32 topia Exp $ package Log::Recent; @@ -31,7 +31,7 @@ sub message_arrived { my ($this,$msg,$sender) = @_; # Log::Recent/commandにマッチするか？ - if (Mask::match($this->config->command || '*',$msg->command)) { + if (Mask::match(lc($this->config->command) || '*', lc($msg->command))) { $this->{logger}->log($msg,$sender); } $msg; diff -urN tiarra-20030922/module/Tools/FileCache.pm tiarra-20030925/module/Tools/FileCache.pm --- tiarra-20030922/module/Tools/FileCache.pm 2003-09-23 04:14:43.000000000 +0900 +++ tiarra-20030925/module/Tools/FileCache.pm 2003-09-26 12:51:00.000000000 +0900 @@ -1,6 +1,6 @@ # -*- cperl -*- # Tools::FileCache, Data shared file cache service. -# $Clovery: tiarra/module/Tools/FileCache.pm,v 1.3 2003/07/24 03:06:34 topia Exp $ +# $Id: FileCache.pm,v 1.3 2003/09/25 13:16:00 topia Exp $ # copyright (C) 2003 Topia . all rights reserved. package Tools::FileCache; use strict; @@ -116,6 +116,24 @@ } } +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; diff -urN tiarra-20030922/module/Tools/GroupDB.pm tiarra-20030925/module/Tools/GroupDB.pm --- tiarra-20030922/module/Tools/GroupDB.pm 2003-09-23 04:14:44.000000000 +0900 +++ tiarra-20030925/module/Tools/GroupDB.pm 2003-09-26 12:51:00.000000000 +0900 @@ -1,5 +1,5 @@ # -*- cperl -*- -# $Clovery: tiarra/module/Tools/GroupDB.pm,v 1.5 2003/05/23 11:25:45 topia Exp $ +# $Id: GroupDB.pm,v 1.6 2003/09/25 13:16:00 topia Exp $ # copyright (C) 2003 Topia . all rights reserved. # エイリアスのように、HashをレコードとしたDBを管理する。 @@ -31,6 +31,7 @@ use Unicode::Japanese; use Mask; use Carp; +use Module::Use qw(Tools::HashTools); use Tools::HashTools; sub new { diff -urN tiarra-20030922/sample.conf tiarra-20030925/sample.conf --- tiarra-20030922/sample.conf 2003-09-23 04:14:41.000000000 +0900 +++ tiarra-20030925/sample.conf 2003-09-26 12:50:56.000000000 +0900 @@ -1,6 +1,6 @@ # -*- tiarra-conf -*- # ----------------------------------------------------------------------------- -# $Id: sample.conf,v 1.57 2003/08/12 01:45:35 admin Exp $ +# $Id: sample.conf,v 1.59 2003/09/25 18:00:41 topia Exp $ # ----------------------------------------------------------------------------- # tiarra.conf サンプル # @@ -697,19 +697,19 @@ reminder-interval: 30 } -- Channel::Join::Connect -{ - # サーバーに初めて接続した時、指定したチャンネルに入る。 - +- Channel::Join::Connect { + # サーバーに初めて接続した時、指定したチャンネルに入るモジュール。 + # 書式: <チャンネル1>[,<チャンネル2>,...] [<チャンネル1のキー>,...] - # + # コンマの直後のスペースは無視されます。 + # # 例: - # channel: #aaaaa@ircnet aaaaa # 「#aaaaa@ircnet」に「aaaaa」というキーで入る。 - # - # channel: #aaaaa@ircnet,#bbbbb@ircnet - # channel: #ccccc@ircnet - # 「#aaaaa@ircnet」、「#bbbbb@ircnet」、「#ccccc@ircnet」の３つのチャンネルに入る。 + #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::Kicked { diff -urN tiarra-20030922/tiarra tiarra-20030925/tiarra --- tiarra-20030922/tiarra 2003-09-23 04:14:41.000000000 +0900 +++ tiarra-20030925/tiarra 2003-09-26 12:50:56.000000000 +0900 @@ -5,7 +5,7 @@ # This is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # ----------------------------------------------------------------------------- -# $Id: tiarra,v 1.24 2003/08/12 01:45:35 admin Exp $ +# $Id: tiarra,v 1.25 2003/09/25 13:15:59 topia Exp $ # ----------------------------------------------------------------------------- require 5.006; use strict; @@ -63,9 +63,11 @@ print "\n"; print "options:\n"; print " --help print this message\n"; + print " --version print version infomation\n"; print " --config= tiarra configuration file; default is 'tiarra.conf'\n"; print " --quiet don't output any messages to stdout and stdin\n"; print " --no-fork don't move to background when started in quiet mode\n"; + print " --debug show debug infomation\n"; print " -D[=]\n"; print " treat as `\@define ' is in the conf\n"; print "\n"; @@ -82,8 +84,7 @@ foreach my $arg (@ARGV) { if ($arg eq "--$option") { return 1; - } - elsif ($arg =~ m/^--$option=(.+)$/) { + } elsif ($arg =~ m/^--$option=(.+)$/) { return $1; } } @@ -114,6 +115,19 @@ exit; } +if (&find_option('version')) { + print join("\n",get_credit()) . "\n"; + exit; +} + +if (&find_option('debug')) { + eval q(sub debug_printmsg{printmsg('debug: '.shift)}); + eval q(sub debug_mode{1;}); +} 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); } @@ -122,11 +136,9 @@ if (!defined $conf_file) { if (!-t STDIN) { $conf_file = undef; # STDINから読む場合はundefを入れておく。 - } - elsif (-f 'tiarra.conf') { + } elsif (-f 'tiarra.conf') { $conf_file = 'tiarra.conf'; - } - else { + } else { &help; exit; } @@ -148,8 +160,7 @@ if (defined $conf_file) { print "Reading configuration from ${conf_file}... "; - } - else { + } else { $conf_file = IO::Handle->new->fdopen(fileno(STDIN),'r'); print "Reading configuration from stdin... "; } @@ -157,9 +168,9 @@ eval { Configuration::shared_conf->load($conf_file); }; if ($@) { - die "ERROR: $@\n"; + die "ERROR: $@\n"; } else { - print "ok\n"; + print "ok\n"; } }; @@ -167,9 +178,9 @@ eval { RunLoop::shared_loop->run; }; if ($@) { - die "Tiarra aborted: $@\n"; + die "Tiarra aborted: $@\n"; } else { - print "Tiarra stopped.\n"; + print "Tiarra stopped.\n"; } }; @@ -189,12 +200,10 @@ if ($child_pid == 0) { # 子プロセス $boot->(); - } - elsif (!defined $child_pid) { + } elsif (!defined $child_pid) { print "Tiarra: fork() failed.\n"; } -} -else { +} else { $boot->(); } exit; @@ -204,6 +213,7 @@ sub printmsg { # 文字コードはUTF-8でなければならない。 my $msg = shift; + local($|) = 1; if (!defined $msg) { $msg = ''; }