diff -urN tiarra-20050322/.svnversion tiarra-20050327/.svnversion --- tiarra-20050322/.svnversion 2005-03-23 09:18:47.000000000 +0900 +++ tiarra-20050327/.svnversion 2005-03-27 21:22:41.000000000 +0900 @@ -1 +1 @@ -850 +872 diff -urN tiarra-20050322/ChangeLog.svn tiarra-20050327/ChangeLog.svn --- tiarra-20050322/ChangeLog.svn 2005-03-23 09:19:10.000000000 +0900 +++ tiarra-20050327/ChangeLog.svn 2005-03-27 21:23:05.000000000 +0900 @@ -1,4 +1,387 @@ ------------------------------------------------------------------------ +r872 | topia | 2005-03-27 21:16:02 +0900 (Sun, 27 Mar 2005) | 2 lines +Changed paths: + M /trunk/module/System/PrivTranslator.pm + +* add nick tracking feature. + +------------------------------------------------------------------------ +r871 | topia | 2005-03-27 19:43:26 +0900 (Sun, 27 Mar 2005) | 4 lines +Changed paths: + M /trunk/main/Tiarra/IRC/Message.pm + +* deep prefix on ->clone. + +* make loading Data::Dumper on-demand. + +------------------------------------------------------------------------ +r870 | topia | 2005-03-27 19:41:55 +0900 (Sun, 27 Mar 2005) | 2 lines +Changed paths: + M /trunk/main/Tiarra/IRC/Prefix.pm + +* add ->clone. + +------------------------------------------------------------------------ +r869 | topia | 2005-03-27 17:52:27 +0900 (Sun, 27 Mar 2005) | 1 line +Changed paths: + M /trunk/module/Auto/AliasDB/CallbackUtils.pm + M /trunk/module/Auto/ChannelWithoutOper.pm + M /trunk/module/Auto/Joined.pm + M /trunk/module/Auto/Oper.pm + M /trunk/module/Auto/Utils.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/Eval.pm + M /trunk/module/Client/ProtectMyself.pm + M /trunk/module/Client/Rehash.pm + M /trunk/module/Client/ShowNick.pm + M /trunk/module/Defence/Buffer.pm + M /trunk/module/Defence/Command.pm + M /trunk/module/Defence/Logger.pm + M /trunk/module/Defence/Whistle.pm + M /trunk/module/Defence.pm + M /trunk/module/Log/Logger.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/Skelton.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/User/Away/Client.pm + M /trunk/module/User/Away/Nick.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 + +* second migration to use ->construct_irc_message(for modules). +------------------------------------------------------------------------ +r868 | topia | 2005-03-27 13:27:29 +0900 (Sun, 27 Mar 2005) | 4 lines +Changed paths: + M /trunk/module/System/SendMessage.pm + +* add Notice header; notice or privmsg, default is notice. + +* error message tweaks; header name is Channel, isn't Mask. + +------------------------------------------------------------------------ +r867 | topia | 2005-03-27 02:07:57 +0900 (Sun, 27 Mar 2005) | 1 line +Changed paths: + M /trunk/AUTHORS + M /trunk/ChangeLog + M /trunk/HACKING + M /trunk/INSTALL + M /trunk/LICENSE + M /trunk/NEWS + M /trunk/all.conf + 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/all.conf.in + 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/makedoc + M /trunk/sample.conf + M /trunk/web/index.html.ja.utf8.tmpl + M /trunk/web/index.rdf.ja.utf8.tmpl + +* add more mime-type. +------------------------------------------------------------------------ +r866 | topia | 2005-03-27 01:57:29 +0900 (Sun, 27 Mar 2005) | 1 line +Changed paths: + M /trunk/bundle/Unicode/Japanese.pm + M /trunk/bundle/enum.pm + 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/Tiarra/DefineEnumMixin.pm + M /trunk/main/Tiarra/Encoding/Encode/CP932JIS.pm + M /trunk/main/Tiarra/Encoding/Encode.pm + M /trunk/main/Tiarra/Encoding/UniJP.pm + M /trunk/main/Tiarra/Encoding.pm + M /trunk/main/Tiarra/IRC/Message.pm + M /trunk/main/Tiarra/IRC/NewMessageMixin.pm + M /trunk/main/Tiarra/IRC/Prefix.pm + M /trunk/main/Tiarra/ModifiedFlagMixin.pm + M /trunk/main/Tiarra/OptionalModules.pm + M /trunk/main/Tiarra/Resolver.pm + M /trunk/main/Tiarra/SessionMixin.pm + M /trunk/main/Tiarra/SharedMixin.pm + M /trunk/main/Tiarra/ShorthandConfMixin.pm + M /trunk/main/Tiarra/Socket/Buffered.pm + M /trunk/main/Tiarra/Socket/Connect.pm + M /trunk/main/Tiarra/Socket/Lined.pm + M /trunk/main/Tiarra/Socket/Win32Errno.pm + M /trunk/main/Tiarra/Socket.pm + M /trunk/main/Tiarra/TerminateManager.pm + M /trunk/main/Tiarra/Utils/CallWrapper.pm + M /trunk/main/Tiarra/Utils/Core.pm + M /trunk/main/Tiarra/Utils/DefineHelper.pm + M /trunk/main/Tiarra/Utils.pm + M /trunk/main/Tiarra/WrapMainLoop.pm + M /trunk/main/TiarraDoc.pm + M /trunk/main/Timer.pm + 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/Conservative.pm + M /trunk/module/Client/Cotton.pm + M /trunk/module/Client/Eval.pm + M /trunk/module/Client/GetVersion.pm + M /trunk/module/Client/Guess.pm + M /trunk/module/Client/PatchworkMessage.pm + M /trunk/module/Client/ProtectMyself.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.pm + M /trunk/module/Log/Channel.pm + M /trunk/module/Log/ChannelList.pm + M /trunk/module/Log/Logger.pm + M /trunk/module/Log/Raw.pm + M /trunk/module/Log/Recent.pm + M /trunk/module/Log/Writer/Base.pm + M /trunk/module/Log/Writer/File.pm + M /trunk/module/Log/Writer.pm + M /trunk/module/Skelton.pm + M /trunk/module/System/Error.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/SendMessage.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/Hash.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/runtiarra.perl + M /trunk/test/dateconvert-test.perl + M /trunk/test/inflate-test.perl + M /trunk/tiarra + M /trunk/tools/archive.perl + +* add mime-type. +------------------------------------------------------------------------ +r865 | topia | 2005-03-26 22:37:18 +0900 (Sat, 26 Mar 2005) | 1 line +Changed paths: + M /trunk/main/CTCP.pm + +* fix typo. +------------------------------------------------------------------------ +r864 | topia | 2005-03-26 22:31:11 +0900 (Sat, 26 Mar 2005) | 1 line +Changed paths: + M /trunk/main/CTCP.pm + +* rewrite. add extract_from_text, make_text, dequote and quote (as class method). +------------------------------------------------------------------------ +r863 | topia | 2005-03-26 22:28:42 +0900 (Sat, 26 Mar 2005) | 5 lines +Changed paths: + 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/Mask.pm + M /trunk/main/Module.pm + M /trunk/main/Multicast.pm + M /trunk/main/RunLoop.pm + A /trunk/main/Tiarra/IRC/NewMessageMixin.pm + +* main/Tiarra/IRC/NewMessageMixin.pm: for ->irc_message_class, ->construct_irc_message. + +* add and use ->construct_irc_message friends. + +* main/LocalChannelManager.pm: use NumericReply. +------------------------------------------------------------------------ +r862 | topia | 2005-03-26 22:06:03 +0900 (Sat, 26 Mar 2005) | 1 line +Changed paths: + M /trunk/module/Client/Guess.pm + +* add Conversation. +------------------------------------------------------------------------ +r861 | topia | 2005-03-26 22:01:41 +0900 (Sat, 26 Mar 2005) | 3 lines +Changed paths: + M /trunk/module/Client/Eval.pm + +* add hexcmd, max. + +* protect huge instance(such as runloop) from dump. +------------------------------------------------------------------------ +r860 | topia | 2005-03-26 21:51:37 +0900 (Sat, 26 Mar 2005) | 1 line +Changed paths: + M /trunk/module/Client/GetVersion.pm + +* clear expire remark on successful. +------------------------------------------------------------------------ +r859 | topia | 2005-03-26 03:03:20 +0900 (Sat, 26 Mar 2005) | 2 lines +Changed paths: + M /trunk/module/Client/Cache.pm + +* we really unnecessary deep clone of message template. + +------------------------------------------------------------------------ +r858 | topia | 2005-03-26 02:59:51 +0900 (Sat, 26 Mar 2005) | 2 lines +Changed paths: + M /trunk/main/Tiarra/IRC/Message.pm + +* inhibits generator deep clone. + +------------------------------------------------------------------------ +r857 | topia | 2005-03-26 02:39:07 +0900 (Sat, 26 Mar 2005) | 2 lines +Changed paths: + M /trunk/main/Tiarra/IRC/Message.pm + +* add generator attribute (partially support). + +------------------------------------------------------------------------ +r855 | topia | 2005-03-24 21:06:02 +0900 (Thu, 24 Mar 2005) | 4 lines +Changed paths: + M /trunk/main/IrcIO/Client.pm + +* (_receive_after_logged_in): cleanup code with adding $rawnick variable. + +* make reload-safe. + +------------------------------------------------------------------------ +r854 | topia | 2005-03-24 20:54:49 +0900 (Thu, 24 Mar 2005) | 4 lines +Changed paths: + M /trunk/main/IrcIO/Server.pm + +* cosmetic tweaks. + +* fix _handle_fix_nick's params. + +------------------------------------------------------------------------ +r853 | topia | 2005-03-23 13:31:19 +0900 (Wed, 23 Mar 2005) | 1 line +Changed paths: + M /trunk/bundle/Unicode/Japanese.pm + +* update to Unicode::Japanese 0.26(from 0.22). +------------------------------------------------------------------------ +r852 | topia | 2005-03-23 10:45:54 +0900 (Wed, 23 Mar 2005) | 2 lines +Changed paths: + M /trunk/main/Module/Use.pm + +* use ModuleManager->__initialized. + +------------------------------------------------------------------------ +r851 | topia | 2005-03-23 10:44:39 +0900 (Wed, 23 Mar 2005) | 2 lines +Changed paths: + M /trunk/main/ModuleManager.pm + +* add internal public method _initialized. + +------------------------------------------------------------------------ r850 | topia | 2005-03-22 01:56:03 +0900 (Tue, 22 Mar 2005) | 1 line Changed paths: M /trunk/all.conf ファイルtiarra-20050322/bundle/Unicode/Japanese.pmとtiarra-20050327/bundle/Unicode/Japanese.pmは違います diff -urN tiarra-20050322/main/CTCP.pm tiarra-20050327/main/CTCP.pm --- tiarra-20050322/main/CTCP.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/main/CTCP.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: CTCP.pm 479 2004-08-20 23:55:47Z topia $ +# $Id: CTCP.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # IRCMessage椫CTCPåФꡢCTCPåIRCMessageäꡣ # ----------------------------------------------------------------------------- @@ -8,7 +8,7 @@ use warnings; use Carp; use UNIVERSAL; -use IRCMessage; +use base qw(Tiarra::IRC::NewMessageMixin); use SelfLoader; 1; @@ -24,66 +24,20 @@ if (!defined $msg) { croak "CTCP::extract, Arg[0] is undef.\n"; } - if (!UNIVERSAL::isa($msg,'IRCMessage')) { + if (!UNIVERSAL::isa($msg, __PACKAGE__->irc_message_class)) { 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]; + __PACKAGE__->extract_from_text($msg->param(1)); } } sub make { - # CTCPåޤIRCMessageä֤ + # CTCPåޤTiarra::IRC::Messageä֤ # # $message: ޤCTCPå - # $target : IRCMessageκǽΥѥ᡼nickͥ̾롣 + # $target : Tiarra::IRC::MessageκǽΥѥ᡼nickͥ̾롣 # $command: PRIVMSGNOTICEΤɤΥޥɤǺ뤫ά줿NOTICEˤʤ롣 my ($message,$target,$command) = @_; @@ -94,26 +48,92 @@ $command = 'NOTICE'; } - my $result = IRCMessage->new( + my $result = __PACKAGE__->construct_irc_message( Command => $command, Params => [$target, - do { - $_ = $message; + __PACKAGE__->make_text($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; + $result; +} - "\x01$_\x01"; - }]); +sub _low_level_dequote { + my ($symbol) = @_; - $result; + 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; + } +} + +sub _ctcp_level_dequote { + my ($symbol) = @_; + + if ($symbol eq 'a') { + return "\x01"; + } elsif ($symbol eq "\x5c") { + return "\x5c"; + } else { + # error, but return. + return $symbol; + } +} + +sub dequote { + shift; # drop + local $_ = shift; + + # 2nd Level + s/\x10(.)/_low_level_dequote($1)/eg; + + # 1st Level + s/\x5c(.)/_ctcp_level_dequote($1)/eg; + + $_; +} + +sub extract_from_text { + my $this = shift; + grep { + if (!wantarray) { + return $_; + } + 1; + } map { + $this->dequote($1); + } (shift =~ m/\x01(.*)\x01/g); +} + +sub quote { + shift; # drop + local $_ = shift; + # 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; + + $_; +} + +sub make_text { + my $this = shift; + my @ctcps = map { + "\x01" . $this->quote($_) . "\x01"; + } @_; + return wantarray ? @ctcps : join('', @ctcps); } 1; diff -urN tiarra-20050322/main/IrcIO/Client.pm tiarra-20050327/main/IrcIO/Client.pm --- tiarra-20050322/main/IrcIO/Client.pm 2005-03-23 09:18:47.000000000 +0900 +++ tiarra-20050327/main/IrcIO/Client.pm 2005-03-27 21:22:41.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Client.pm 790 2005-02-28 18:40:53Z topia $ +# $Id: Client.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # IrcIO::Clientϥ饤Ȥ³ # IRCåꤹ륯饹Ǥ @@ -8,7 +8,6 @@ use strict; use warnings; use Carp; -use IrcIO; use base qw(IrcIO); use Crypt; use Multicast; @@ -217,13 +216,13 @@ } elsif ($command eq 'PING') { $this->send_message( - new IRCMessage( + $this->construct_irc_message( Command => 'PONG', Param => $msg->param(0))); } elsif ($command eq 'QUIT') { $this->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'ERROR', Param => 'Closing Link: ['.$this->fullname_from_client.'] ()')); $this->disconnect_after_writing; @@ -239,11 +238,11 @@ ::printmsg("Refused login of ".$this->fullname_from_client." because of bad password."); $this->send_message( - new IRCMessage(Prefix => $prefix, + $this->construct_irc_message(Prefix => $prefix, Command => ERR_PASSWDMISMATCH, Params => [$this->{nick},'Password incorrect'])); $this->send_message( - new IRCMessage(Command => 'ERROR', + $this->construct_irc_message(Command => 'ERROR', Param => 'Closing Link: ['.$this->fullname_from_client.'] (Bad Password)')); $this->disconnect_after_writing; } @@ -260,7 +259,7 @@ $this->{logging_in} = 0; $this->send_message( - new IRCMessage(Prefix => $prefix, + $this->construct_irc_message(Prefix => $prefix, Command => RPL_WELCOME, Params => [$this->{nick},'Welcome to the Internet Relay Network '.$this->fullname_from_client])); @@ -268,7 +267,7 @@ if ($this->{nick} ne $current_nick) { # 饤ȤäƤnickȥnickäƤΤnick򶵤롣 $this->send_message( - new IRCMessage(Prefix => $this->fullname_from_client, + $this->construct_irc_message(Prefix => $this->fullname_from_client, Command => 'NICK', Param => $current_nick)); } @@ -276,7 +275,7 @@ my $send_message = sub { my ($command, @params) = @_; $this->send_message( - new IRCMessage( + $this->construct_irc_message( Prefix => $prefix, Command => $command, Params => [$current_nick, @@ -290,7 +289,7 @@ my $global_nick = $_->current_nick; if ($global_nick ne $current_nick) { $this->send_message( - new IRCMessage( + $this->construct_irc_message( Prefix => $this->_runloop->sysmsg_prefix(qw(priv system)), Command => 'NOTICE', Params => [$current_nick, @@ -305,14 +304,14 @@ if (defined $network) { # send isupport - my $msg_tmpl = IRCMessage->new( + my $msg_tmpl = $this->construct_irc_message( 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 $max_params = $this->irc_message_class->MAX_PARAMS - 2; my @params = (); my $length = 0; my $flush_msg = sub { @@ -366,38 +365,35 @@ if (defined $msg->params) { # ¤NICKˤϾơRunLoopΥnickѹˤʤ롣 # ͥåȥ̾ƤϥȤѹʤ - my ($nick,undef,$specified) = Multicast::detach($msg->params->[0]); + my $rawnick = $msg->params->[0]; + my ($nick,undef,$specified) = Multicast::detach($rawnick); 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) { + if ($this->_runloop->multi_server_mode_p && + $this->_runloop->current_nick ne $rawnick) { $this->_runloop->broadcast_to_clients( - IRCMessage->new( + $this->construct_irc_message( Command => 'NICK', - Param => $msg->param(0), + Param => $rawnick, Remarks => {'fill-prefix-when-sending-to-client' => 1})); - $this->_runloop->set_current_nick($msg->params->[0]); + $this->_runloop->set_current_nick($rawnick); } } } else { $this->send_message( - new IRCMessage( + $this->construct_irc_message( Prefix => $this->_runloop->sysmsg_prefix('system'), Command => ERR_ERRONEOUSNICKNAME, Params => [$this->_runloop->current_nick, - $msg->params->[0], + $rawnick, 'Erroneous nickname'])); # ϻʤ $msg = undef; } } else { $this->send_message( - new IRCMessage( + $this->construct_irc_message( Prefix => $this->_runloop->sysmsg_prefix('system'), Command => ERR_NONICKNAMEGIVEN, Params => [$this->_runloop->current_nick, @@ -411,7 +407,7 @@ $quit_message = '' unless defined $quit_message; $this->send_message( - new IRCMessage(Command => 'ERROR', + $this->construct_irc_message(Command => 'ERROR', Param => 'Closing Link: '.$this->fullname('error').' ('.$quit_message.')')); $this->disconnect_after_writing; @@ -454,7 +450,7 @@ my $flush_enum_buffer = sub { if ($nick_enumeration ne '') { $flush_func->( - IRCMessage->new( + $this->construct_irc_message( Prefix => $this->fullname, Command => RPL_NAMREPLY, Params => [$this->_runloop->current_nick, @@ -506,14 +502,14 @@ # ޤJOIN $this->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => $this->fullname, Command => 'JOIN', Param => $ch_name)); # RPL_TOPIC() if ($ch->topic ne '') { $this->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => $this->fullname, Command => RPL_TOPIC, Params => [$local_nick,$ch_name,$ch->topic])); @@ -521,7 +517,7 @@ # RPL_TOPICWHOTIME() if (defined($ch->topic_who)) { $this->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => $this->fullname, Command => RPL_TOPICWHOTIME, Params => [$local_nick,$ch_name,$ch->topic_who,$ch->topic_time])); @@ -534,7 +530,7 @@ $this->do_namreply($ch, $network, undef, $flush_namreply); # ǸRPL_ENDOFNAMES $this->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => $this->fullname, Command => RPL_ENDOFNAMES, Params => [$local_nick,$ch_name,'End of NAMES list'])); @@ -600,7 +596,7 @@ FETCH => sub { IrcIO::Client::HookTarget->shared; }, - ); + ) unless defined $HOOK_TARGET_DEFAULT; # ----------------------------------------------------------------------------- package IrcIO::Client::HookTarget; diff -urN tiarra-20050322/main/IrcIO/Server.pm tiarra-20050327/main/IrcIO/Server.pm --- tiarra-20050322/main/IrcIO/Server.pm 2005-03-23 09:18:47.000000000 +0900 +++ tiarra-20050327/main/IrcIO/Server.pm 2005-03-27 21:22:41.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Server.pm 830 2005-03-08 00:28:45Z topia $ +# $Id: Server.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # IrcIO::ServerIRCС³IRCåꤹ륯饹Ǥ # Υ饹ϥСåäƥͥ丽ߤnickʤɤݻޤ @@ -9,7 +9,6 @@ package IrcIO::Server; use strict; use warnings; -use IrcIO; use base qw(IrcIO); use Carp; use ChannelInfo; @@ -415,14 +414,14 @@ # NICKɤ³receive᥽åɤȽǤ롣 my $server_password = $this->{server_password}; if (defined $server_password && $server_password ne '') { - $this->send_message(new IRCMessage( + $this->send_message($this->construct_irc_message( 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( + $this->send_message($this->construct_irc_message( Command => 'NICK', Param => $this->{current_nick})); @@ -440,7 +439,7 @@ } } } - $this->send_message(new IRCMessage( + $this->send_message($this->construct_irc_message( Command => 'USER', Params => [$this->{user_shortname}, $usermode, @@ -522,7 +521,7 @@ sub quit { my ($this, $msg) = @_; return $this->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'QUIT', Param => $msg)); } @@ -536,7 +535,7 @@ elsif (!ref($msg)) { croak "IrcIO::Server->send_message, Arg[1] was not ref.\n"; } - elsif (!UNIVERSAL::isa($msg, 'IRCMessage')) { + elsif (!UNIVERSAL::isa($msg, $this->irc_message_class)) { croak "IrcIO::Server->send_message, Arg[1] was bad ref: ".ref($msg)."\n"; } @@ -592,7 +591,7 @@ if (!$this->_runloop->multi_server_mode_p && $this->_runloop->current_nick ne $this->{current_nick}) { $this->_runloop->broadcast_to_clients( - IRCMessage->new( + $this->construct_irc_message( Command => 'NICK', Param => $first_msg->param(0), Remarks => {'fill-prefix-when-sending-to-client' => 1 @@ -631,7 +630,7 @@ } elsif ($reply eq 'PING') { $this->send_message( - new IRCMessage( + $this->construct_irc_message( Command => 'PONG', Param => $first_msg->param(0))); } @@ -682,7 +681,7 @@ my $old_nick = $msg->nick; $this->_runloop->broadcast_to_clients( - IRCMessage->new( + $this->construct_irc_message( Prefix => $this->_runloop->sysmsg_prefix(qw(priv nick::system)), Command => 'NOTICE', Params => [$local_nick, @@ -1235,9 +1234,10 @@ @args = @args[1 .. $#args]; $this->_MODE( - new IRCMessage(Prefix => $msg->prefix, - Command => 'MODE', - Params => \@args)); + $this->construct_irc_message( + Prefix => $msg->prefix, + Command => 'MODE', + Params => \@args)); } sub _RPL_ISUPPORT { @@ -1270,7 +1270,7 @@ } sub _handle_fix_nick { - my ($this, $type, $msg) = @_; + my ($this, $msg) = @_; # ³ʳnickʣޤ my $mode = $this->config_local_or_general('nick-fix-mode'); @@ -1288,7 +1288,7 @@ # б륨顼åդ NOTICE Ѵơ # 饤Ȥꤲޤ - my $new_msg = IRCMessage->new( + my $new_msg = $this->construct_irc_message( Prefix => $this->_runloop->sysmsg_prefix(qw(priv nick::system)), Command => 'NOTICE', Params => [$this->_runloop->current_nick, @@ -1314,11 +1314,11 @@ my $msg_for_user = "Nick $failed_nick was already in use in the ".$this->network_name.". Trying ".$next_nick."..."; $this->send_message( - new IRCMessage( + $this->construct_irc_message( Command => 'NICK', Param => $next_nick)); $this->_runloop->broadcast_to_clients( - new IRCMessage( + $this->construct_irc_message( Prefix => $this->_runloop->sysmsg_prefix(qw(priv nick::system)), Command => 'NOTICE', Params => [$this->_runloop->current_nick,$msg_for_user])); diff -urN tiarra-20050322/main/IrcIO.pm tiarra-20050327/main/IrcIO.pm --- tiarra-20050322/main/IrcIO.pm 2005-03-23 09:18:47.000000000 +0900 +++ tiarra-20050327/main/IrcIO.pm 2005-03-27 21:22:41.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: IrcIO.pm 749 2005-02-16 01:21:44Z topia $ +# $Id: IrcIO.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # IrcIOIRCСϥ饤Ȥ³IRCåꤹݥ饹Ǥ # ----------------------------------------------------------------------------- @@ -8,13 +8,15 @@ use warnings; use Carp; use Configuration; -use IRCMessage; +use Tiarra::IRC::Message; use Exception; use Tiarra::ShorthandConfMixin; use Tiarra::Utils; use Tiarra::Socket::Buffered; use base qw(Tiarra::Socket::Buffered); +use base qw(Tiarra::IRC::NewMessageMixin); utils->define_attr_getter(0, [qw(_runloop runloop)]); +utils->define_proxy('_runloop', 0, qw(irc_message_class)); sub new { my ($class, $runloop, %opts) = @_; @@ -53,7 +55,7 @@ my ($this,$msg,$encoding) = @_; # ǡ褦ͽ󤹤롣åȤνäƤʤƤ֥åʤ - # msgʸǤɤIRCMessageΥ󥹥󥹤Ǥɤ + # msgʸǤɤTiarra::IRC::MessageΥ󥹥󥹤Ǥɤ # ʸϤˤϡCRLFդƤϤʤʤ # ޤʸˤĤƤʸɤѴԤʤʤ my $data_to_send = ''; @@ -62,7 +64,7 @@ # FIXME: warn٤ $data_to_send = "$msg\x0d\x0a"; } - elsif ($msg->isa('IRCMessage')) { + elsif ($msg->isa($this->irc_message_class)) { # message_io_hook my $filtered = $this->_runloop->apply_filters( [$msg], 'message_io_hook', $this, 'out'); @@ -85,7 +87,7 @@ sub read { my ($this,$encoding) = @_; - # Υ᥽åɤIRCåԤļꡢIRCMessageΥ󥹥󥹤򥭥塼ίޤ + # Υ᥽åɤIRCåԤļꡢTiarra::IRC::MessageΥ󥹥󥹤򥭥塼ίޤ # åȤɤǡƤʤä硢Υ᥽åɤɤ褦ˤʤޤ # ֥åޤ줬ޤͽselectɤǧƤƲ # Υ᥽åɤ¹ԤȤǻϤƥåȤĤ줿ʬäϡ @@ -113,8 +115,9 @@ } # message_io_hook - my $msg = IRCMessage->new( - Line => $current_line, Encoding => $encoding); + my $msg = $this->construct_irc_message( + Line => $current_line, + Encoding => $encoding); my $filtered = $this->_runloop->apply_filters( [$msg], 'message_io_hook', $this, 'in'); diff -urN tiarra-20050322/main/LocalChannelManager.pm tiarra-20050327/main/LocalChannelManager.pm --- tiarra-20050322/main/LocalChannelManager.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/main/LocalChannelManager.pm 2005-03-27 21:22:41.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: LocalChannelManager.pm 542 2004-09-11 08:26:06Z topia $ +# $Id: LocalChannelManager.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # Υ饹Tiarraʥͥޤ # ƥ饤ȤˡΥ饤ȤäƤTiarraͥ @@ -14,6 +14,8 @@ use warnings; use Carp; use Tiarra::SharedMixin; +use NumericReply; +use base qw(Tiarra::IRC::NewMessageMixin); our $_shared_instance; sub _new { @@ -64,7 +66,7 @@ } sub message_arrived { - # IRCMessageޤundef֤ + # Tiarra::IRC::Messageޤundef֤ my ($class_or_this, $msg, $sender) = @_; my $this = $class_or_this->_this; @@ -99,16 +101,16 @@ my $local_nick = RunLoop->shared->current_nick; # ޤJOIN $sender->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => $sender->fullname, Command => 'JOIN', Param => $ch_name)); # RPL_TOPIC() if ($topic ne '') { $sender->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => 'Tiarra', - Command => '332', + Command => RPL_TOPIC, Params => [ $local_nick, $ch_name, @@ -117,18 +119,18 @@ } # RPL_NAMREPLYܿͤ $sender->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => 'Tiarra', - Command => '353', + Command => RPL_NAMREPLY, Params => [$local_nick, '=', $ch_name, $local_nick])); - # RPL_ENOFNAMES + # RPL_ENDOFNAMES $sender->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => 'Tiarra', - Command => '366', + Command => RPL_ENDOFNAMES, Params => [$local_nick, $ch_name, 'End of NAMES list'])); diff -urN tiarra-20050322/main/Mask.pm tiarra-20050327/main/Mask.pm --- tiarra-20050322/main/Mask.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/main/Mask.pm 2005-03-27 21:22:41.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Mask.pm 479 2004-08-20 23:55:47Z topia $ +# $Id: Mask.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- package Mask; use strict; @@ -258,10 +258,10 @@ return qr/(?!)/; # ޥåʤɽ } - my $regex = $mask; - $regex =~ s/(\W)/\\$1/g; - $regex =~ s/\\\?/\./g; - $regex =~ s/\\\*/\.\*/g; + my $regex = quotemeta($mask); + $regex =~ s/\\\?/./g; + $regex =~ s/\\\*/.*/g; + $regex =~ s/\\\#/\\d*/g; $regex = "^$regex\$"; if ($consider_case) { qr/$regex/; diff -urN tiarra-20050322/main/Module/Use.pm tiarra-20050327/main/Module/Use.pm --- tiarra-20050322/main/Module/Use.pm 2005-03-23 09:18:47.000000000 +0900 +++ tiarra-20050327/main/Module/Use.pm 2005-03-27 21:22:41.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Use.pm 740 2005-01-21 18:05:33Z topia $ +# $Id: Use.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # ƤTiarra⥸塼@ISAModuleϿɬפ뤬 # Υ⥸塼뤬module¾perl⥸塼useƤ @@ -9,6 +9,7 @@ package Module::Use; use strict; use warnings; +use ModuleManager; sub import { my ($class,@modules) = @_; @@ -22,9 +23,9 @@ eval qq{ \$${_}::USED{\$caller_pkg} = 1; }; } - if (%ModuleManager::) { + if (ModuleManager->__initialized) { # ModuleManager ¸ߤƤС ModuleManageruseϿ - # ¸ߤƤʤ MainLoop ͳǵưƤʤȻפΤ̵롣 + # ¸ߤƤʤ RunLoop ͳǵưƤʤȻפΤ̵롣 my $mod_manager = ModuleManager->shared_manager; foreach (@modules) { $mod_manager->timestamp($_,time); diff -urN tiarra-20050322/main/Module.pm tiarra-20050327/main/Module.pm --- tiarra-20050322/main/Module.pm 2005-03-23 09:18:47.000000000 +0900 +++ tiarra-20050327/main/Module.pm 2005-03-27 21:22:41.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Module.pm 847 2005-03-21 10:38:56Z topia $ +# $Id: Module.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # Tiarra⥸塼(ץ饰)ɽ魯ݥ饹Ǥ # ƤTiarra⥸塼ϤΥ饹Ѿ @@ -11,6 +11,7 @@ use Carp; use Tiarra::ShorthandConfMixin; use Tiarra::Utils; +use base qw(Tiarra::IRC::NewMessageMixin); # our @USES = (); Tiarra::Utils->define_attr_getter(0, [qw(_runloop runloop)]); @@ -25,7 +26,7 @@ # ̵ bless { runloop => $runloop, - },$class; # ǥեȤǤϥ⥸塼ϥեɤʤ + },$class; } sub destruct { @@ -40,10 +41,10 @@ sub message_arrived { my ($this,$message,$sender) = @_; # Сޤϥ饤Ȥå褿˸ƤФ롣 - # ͤIRCMessageޤϤޤundef + # ͤTiarra::IRC::MessageޤϤޤundef # # $message : - # : IRCMessage֥ + # : Tiarra::IRC::Message֥ # С顢ޤϥ饤ȤƤå # ⥸塼ϤΥ֥Ȥ򤽤Τޤ֤Ƥɤ # Ѥ֤Ƥɤ֤ʤƤɤİʾ֤Ƥɤ @@ -52,6 +53,10 @@ # ΥåȯIrcIOСޤϥ饤ȤǤ롣 # åС褿Τ饤Ȥ褿Τ # $sender->isa('IrcIO::Server')ʤɤȤȽ롣 + # ΰϸ߽Ƥåκ򥵡Фǡºݤ + # #message 󥹥󥹤 $message->generator + # (⥸塼뤬äƤʤ⤢뤷ޤ + # Multicast åʬǤ generator Ѳʤ) # # С饤ȤήǤ⡢Prefixʤå # ήƤ⹽ʤդ˸СΤ褦ʥåƤ @@ -112,7 +117,7 @@ # ̾Υ⥸塼ϤΥ᥽åɤɬפ̵ # # $message : - # : IRCMessage֥ + # : Tiarra::IRC::Message֥ # 줿å # $io : # : IrcIO::ServerIrcIO::Client֥ diff -urN tiarra-20050322/main/ModuleManager.pm tiarra-20050327/main/ModuleManager.pm --- tiarra-20050322/main/ModuleManager.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/main/ModuleManager.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: ModuleManager.pm 712 2004-10-31 14:35:07Z topia $ +# $Id: ModuleManager.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # Υ饹ƤTiarra⥸塼ޤ # ⥸塼ɤɤ˴ΤϤΥ饹Ǥ @@ -16,6 +16,11 @@ our $_shared_instance; utils->define_attr_getter(1, [qw(_runloop runloop)]); +sub __initialized { + # internal public method for instance initialized + defined $_shared_instance; +} + sub _new { shift->new(shift || RunLoop->shared); } diff -urN tiarra-20050322/main/Multicast.pm tiarra-20050327/main/Multicast.pm --- tiarra-20050322/main/Multicast.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/main/Multicast.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Multicast.pm 811 2005-03-06 18:59:11Z topia $ +# $Id: Multicast.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # С饯饤Ȥ˥åήȤΥ饹ϥե륿Ȥ # ͥåȥ̾ղäޤ @@ -13,6 +13,7 @@ use Configuration; use Carp; use NumericReply; +use base qw(Tiarra::IRC::NewMessageMixin); my $runloop = undef; # ǥեȤRunLoopΥå塣 my $separator = ''; # ѥ졼Υå塣cast_messageƤФ٤˹롣 @@ -23,12 +24,10 @@ 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); + my $msg = $message->clone; + @{$msg->params} = map { local_to_global($_,$network) } @$params; + $msg->remark('real-generator', __PACKAGE__); + forward_to_server($msg, $network_name); } } @@ -71,10 +70,7 @@ if ($message->params->[0] eq '0') { # 0ü졣 # ƤΥСJOIN 0롣 - distribute_to_servers( - new IRCMessage( - Command => 'JOIN', - Param => '0')); + distribute_to_servers($message->clone); } else { my @targets = split(/,/,$message->params->[0]); @@ -222,7 +218,7 @@ $message->param(0) eq $global_nick && $local_nick ne $global_nick) { $sender->send_message( - new IRCMessage( + __PACKAGE__->construct_irc_message( Prefix => $runloop->sysmsg_prefix(qw(priv system)), Command => 'NOTICE', Params => [$local_nick, @@ -469,7 +465,7 @@ my ($message, $sender) = @_; &_update_cache; # server -> clientήǤϡĤΥåʣʬ䤵̵ - # δؿϰĤIRCMessage֤ + # δؿϰĤTiarra::IRC::Message֤ if ($message->command =~ /^\d+$/) { # ˥塼åץ饤0ܤΥѥ᥿nick diff -urN tiarra-20050322/main/RunLoop.pm tiarra-20050327/main/RunLoop.pm --- tiarra-20050322/main/RunLoop.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/main/RunLoop.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: RunLoop.pm 810 2005-03-06 18:58:14Z topia $ +# $Id: RunLoop.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # Υ饹TiarraΥᥤ롼פޤ # select()¹ԤС䥯饤ȤȤI/OԤΤϤΥ饹Ǥ @@ -24,6 +24,7 @@ use ControlPort; use Hook; use base qw(HookTarget); +use base qw(Tiarra::IRC::NewMessageMixin); use Tiarra::OptionalModules; use Tiarra::ShorthandConfMixin; use Tiarra::SharedMixin qw(shared shared_loop); @@ -184,7 +185,7 @@ foreach my $io ($this->networks_list) { $io->send_message( - new IRCMessage( + $this->construct_irc_message( Command => 'NICK', Param => $new_nick)); } @@ -239,7 +240,7 @@ '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( + $this->construct_irc_message( Prefix => $this->sysmsg_prefix(qw(priv system)), Command => 'NOTICE', Params => [$this->current_nick, $string])); @@ -260,7 +261,7 @@ sub { my ($network, $ch, $client) = @_; $client->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => $client->fullname, Command => 'PART', Params => [ @@ -285,7 +286,7 @@ my $global_nick = (($this->networks_list)[0])->current_nick; if ($global_nick ne $this->current_nick) { $this->broadcast_to_clients( - IRCMessage->new( + $this->construct_irc_message( Command => 'NICK', Param => $global_nick, Remarks => {'fill-prefix-when-sending-to-client' => 1 @@ -357,7 +358,7 @@ foreach my $client (@{$this->clients}) { foreach my $ch (values %{$network->channels}) { $client->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => $client->fullname, Command => 'PART', Params => [Multicast::attach_for_client($ch->name,$network_name), @@ -372,7 +373,7 @@ if ($event eq 'connected') { $this->_rejoin_all_channels($network); $this->broadcast_to_clients( - IRCMessage->new( + $this->construct_irc_message( Prefix => $this->sysmsg_prefix(qw(priv system)), Command => 'NOTICE', Params => [$this->current_nick, @@ -380,7 +381,7 @@ } elsif ($event eq 'disconnected') { $this->broadcast_to_clients( - IRCMessage->new( + $this->construct_irc_message( Prefix => $this->sysmsg_prefix(qw(priv system)), Command => 'NOTICE', Params => [$this->current_nick, @@ -393,7 +394,7 @@ if ($event eq 'connected') { $this->_rejoin_all_channels($network); - my $msg = IRCMessage->new( + my $msg = $this->construct_irc_message( Prefix => $this->sysmsg_prefix(qw(channel system)), Command => 'NOTICE', Params => ['', # ͥ̾ϸꡣ @@ -404,7 +405,7 @@ } } elsif ($event eq 'disconnected') { - my $msg = IRCMessage->new( + my $msg = $this->construct_irc_message( Prefix => $this->sysmsg_prefix(qw(channel system)), Command => 'NOTICE', Params => ['', # ͥ̾ϸꡣ @@ -447,7 +448,7 @@ } }; $network->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'JOIN', Params => $params)); $buf_ch = $buf_key = ''; @@ -605,7 +606,7 @@ my ($class_or_this, $client, $message) = @_; my $this = $class_or_this->_this; $client->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'ERROR', Param => 'Closing Link: ['.$client->fullname_from_client. '] ('.$message.')', @@ -811,7 +812,7 @@ Code => sub { foreach my $network ($this->networks_list) { $network->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'PING', Param => $network->server_hostname)); @@ -866,10 +867,10 @@ # # 񤭤߲ǽʥåȤ򽸤ơɬפн񤭹ࡣ # ɤ߹߲ǽʥåȤ򽸤ơ(ɤɬפϾˤΤ)ɤࡣ - # ɤ̾IRCMessage֤äƤΤǡ + # ɤ̾Tiarra::IRC::Message֤äƤΤǡ # ɬפƤΥץ饰˽֤̤(ץ饰ϥե륿Ȥƹͤ롣) # 줬Сɤåäʤ顢ץ饰̤塢³ƤƤΥ饤Ȥˤž롣 - # 饤ȤĤ³ƤʤСIRCMessageϼΤƤ롣 + # 饤ȤĤ³ƤʤСTiarra::IRC::MessageϼΤƤ롣 # 饤Ȥɤåäʤ顢ץ饰̤塢Ϥ٤Сž롣 # # selectˤ륿ॢȤϼΤ褦ˤ롣 @@ -1110,7 +1111,7 @@ } sub broadcast_to_clients { - # IRCMessageǤʤƤΥ饤Ȥ롣 + # Tiarra::IRC::MessageǤʤƤΥ饤Ȥ롣 # fill-prefix-when-sending-to-clientȤ᤬դƤ顢 # Prefix򤽤Υ饤Ȥfullnameꤹ롣 my ($class_or_this,@messages) = @_; @@ -1154,7 +1155,7 @@ } sub apply_filters { - # @extra_args: ⥸塼ʹߡϾIRCMessage + # @extra_args: ⥸塼ʹߡϾTiarra::IRC::Message my ($this, $src_messages, $method, @extra_args) = @_; my $source = $src_messages; @@ -1188,9 +1189,9 @@ if (defined $reply[0]) { # ͤİʾ֤äƤ - # IRCMessageΥ֥ȤʤɤǤʤХ顼 + # Tiarra::IRC::MessageΥ֥ȤʤɤǤʤХ顼 foreach my $msg_reply (@reply) { - unless (UNIVERSAL::isa($msg_reply,'IRCMessage')) { + unless (UNIVERSAL::isa($msg_reply,$this->irc_message_class)) { $this->notify_error( "Reply of ".ref($mod)."::${method} contains illegal value.\n". "It is ".ref($msg_reply)."."); @@ -1243,7 +1244,7 @@ if (@{$this->clients} > 0) { $this->broadcast_to_clients( map { - IRCMessage->new( + $this->construct_irc_message( Prefix => $this->sysmsg_prefix(qw(priv notify)), Command => 'NOTICE', Params => [$this->current_nick, diff -urN tiarra-20050322/main/Tiarra/IRC/Message.pm tiarra-20050327/main/Tiarra/IRC/Message.pm --- tiarra-20050322/main/Tiarra/IRC/Message.pm 2005-03-23 09:18:47.000000000 +0900 +++ tiarra-20050327/main/Tiarra/IRC/Message.pm 2005-03-27 21:22:41.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Message.pm 841 2005-03-12 13:32:45Z topia $ +# $Id: Message.pm 871 2005-03-27 10:43:26Z topia $ # ----------------------------------------------------------------------------- # Tiarra::IRC::MessageIRCΥåɽ魯饹ǤºݤΥåUTF-8ݻޤ # ΥåΥѡꥢ饤ƥå򥵥ݡȤޤ @@ -35,19 +35,18 @@ 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); +use enum qw(PREFIX COMMAND PARAMS REMARKS TIME RAW_PARAMS GENERATOR); # 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_accessor(0, qw(time generator)); utils->define_array_attr_translate_accessor( 0, sub { my ($from, $to) = @_; @@ -69,6 +68,8 @@ $obj->[RAW_PARAMS] = undef; + $obj->[GENERATOR] = undef; + if (exists $args{'Line'}) { $args{'Line'} =~ s/\x0d\x0a$//s; # crlfϾõ $obj->_parse($args{'Line'},$args{'Encoding'} || 'auto'); # Encodingά줿鼫ưȽ @@ -116,19 +117,29 @@ if (exists $args{'Remarks'}) { $obj->[REMARKS] = {%{$args{'Remarks'}}}; } + if (exists $args{'Generator'}) { + $obj->generator($args{'Generator'}); + } $obj; } sub clone { my ($this, %args) = @_; if ($args{deep}) { - eval - Data::Dumper->new([$this])->Terse(1)->Deepcopy(1)->Purity(1)->Dump; + # inhibits generator deep clone. + reuire Data::Dumper; + my $obj = $this->clone; + $obj->generator(undef); + $obj = eval(Data::Dumper->new([$obj])->Terse(1) + ->Deepcopy(1)->Purity(1)->Dump); + $obj->generator($this->generator); + $obj; } 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[PREFIX] = $this->[PREFIX]->clone if defined $this->[PREFIX]; $new[PARAMS] = [@{$this->[PARAMS]}] if defined $this->[PARAMS]; $new[REMARKS] = {%{$this->[REMARKS]}} if defined $this->[REMARKS]; bless \@new => ref($this); diff -urN tiarra-20050322/main/Tiarra/IRC/NewMessageMixin.pm tiarra-20050327/main/Tiarra/IRC/NewMessageMixin.pm --- tiarra-20050322/main/Tiarra/IRC/NewMessageMixin.pm 1970-01-01 09:00:00.000000000 +0900 +++ tiarra-20050327/main/Tiarra/IRC/NewMessageMixin.pm 2005-03-27 21:22:41.000000000 +0900 @@ -0,0 +1,79 @@ +# ----------------------------------------------------------------------------- +# $Id: NewMessageMixin.pm 866 2005-03-26 16:57:29Z topia $ +# ----------------------------------------------------------------------------- +# copyright (C) 2005 Topia . all rights reserved. +package Tiarra::IRC::NewMessageMixin; +use strict; +use warnings; +use Tiarra::IRC::Message; + +=head1 NAME + +Tiarra::IRC::NewMessageMixin - Tiarra::IRC::Message Construction Interface Mixin +=head1 SYNOPSIS + + package foo::class; + use base qw(Tiarra::IRC::NewMessageMixin); # use this + $this->irc_message_class->foo_class_method; + $this->construct_irc_message(Command => ...); + +=head1 DESCRIPTION + +Tiarra::IRC::NewMessageMixin is define Tiarra::IRC::NewMessageMixin Construction Interface as Mixin. + +=head1 METHODS + +=over 4 + +=cut + +=item irc_message_class + + __PACKAGE__->irc_message_class; # return Tiarra::IRC::Message + $this->irc_message_class; # likewise. + +return Tiarra::IRC::Message class. you can change class to override this. + +=cut + +sub irc_message_class () { 'Tiarra::IRC::Message' } + +=item construct_irc_message + + __PACKAGE__->construct_irc_message(...); + $this->construct_irc_message(...); # likewise. + +constraction Tiarra::IRC::Message(or specified by ->irc_message_class). + +=cut + +sub construct_irc_message { + my $this = shift; + + $this->irc_message_class->new( + Generator => $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 tiarra-20050322/main/Tiarra/IRC/Prefix.pm tiarra-20050327/main/Tiarra/IRC/Prefix.pm --- tiarra-20050322/main/Tiarra/IRC/Prefix.pm 2005-03-23 09:18:47.000000000 +0900 +++ tiarra-20050327/main/Tiarra/IRC/Prefix.pm 2005-03-27 21:22:41.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Prefix.pm 771 2005-02-24 05:41:03Z topia $ +# $Id: Prefix.pm 870 2005-03-27 10:41:55Z topia $ # ----------------------------------------------------------------------------- # Tiarra:: # ----------------------------------------------------------------------------- @@ -34,6 +34,19 @@ $obj; } +sub clone { + my ($this, %args) = @_; + if ($args{deep}) { + # inhibits generator deep clone. + require Data::Dumper; + eval(Data::Dumper->new([$this])->Terse(1) + ->Deepcopy(1)->Purity(1)->Dump); + } else { + my @new = @$this; + bless \@new => ref($this); + } +} + sub _parse_prefix { my $this = shift; delete $this->[NICK]; diff -urN tiarra-20050322/module/Auto/AliasDB/CallbackUtils.pm tiarra-20050327/module/Auto/AliasDB/CallbackUtils.pm --- tiarra-20050322/module/Auto/AliasDB/CallbackUtils.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Auto/AliasDB/CallbackUtils.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: CallbackUtils.pm 561 2004-09-15 05:52:20Z topia $ +# $Id: CallbackUtils.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # copyright (C) 2003 Topia . all rights reserved. @@ -11,6 +11,7 @@ use RunLoop; use Multicast; use Tiarra::SharedMixin; +use base qw(Tiarra::IRC::NewMessageMixin); our $_shared_instance; sub _new { @@ -269,7 +270,7 @@ 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( + my $irc_message = __PACKAGE__->shared->construct_irc_message( Command => 'MODE', Params => [$ch_name, '', #set later diff -urN tiarra-20050322/module/Auto/ChannelWithoutOper.pm tiarra-20050327/module/Auto/ChannelWithoutOper.pm --- tiarra-20050322/module/Auto/ChannelWithoutOper.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Auto/ChannelWithoutOper.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,12 +1,11 @@ # ----------------------------------------------------------------------------- -# $Id: ChannelWithoutOper.pm 540 2004-09-10 08:29:31Z topia $ +# $Id: ChannelWithoutOper.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package Auto::ChannelWithoutOper; use strict; use warnings; use base qw(Module); use Multicast; -use IRCMessage; sub new { my $class = shift; @@ -28,7 +27,7 @@ my $notify = sub { my ($ch_long,$ch_short,$str) = @_; - my $msg_to_send = IRCMessage->new( + my $msg_to_send = $this->construct_irc_message( Command => 'NOTICE', Params => ['',$str]); # ͥ̾ϸ # ˤϥͥåȥ̾դʤ diff -urN tiarra-20050322/module/Auto/Joined.pm tiarra-20050327/module/Auto/Joined.pm --- tiarra-20050322/module/Auto/Joined.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Auto/Joined.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Joined.pm 540 2004-09-10 08:29:31Z topia $ +# $Id: Joined.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package Auto::Joined; use strict; @@ -8,7 +8,6 @@ use Module::Use qw(Auto::Utils); use Auto::Utils; use Multicast; -use IRCMessage; sub new { my $class = shift; diff -urN tiarra-20050322/module/Auto/Oper.pm tiarra-20050327/module/Auto/Oper.pm --- tiarra-20050322/module/Auto/Oper.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Auto/Oper.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Oper.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Oper.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package Auto::Oper; use strict; @@ -24,7 +24,7 @@ = Auto::Utils::generate_reply_closures($msg,$sender,\@result); my $op = sub { - $sender->send_message(IRCMessage->new( + $sender->send_message($this->construct_irc_message( Command => 'MODE', Params => [$get_raw_ch_name->(),'+o',$msg->nick])); }; diff -urN tiarra-20050322/module/Auto/Utils.pm tiarra-20050327/module/Auto/Utils.pm --- tiarra-20050322/module/Auto/Utils.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Auto/Utils.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Utils.pm 574 2004-09-21 12:34:36Z topia $ +# $Id: Utils.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package Auto::Utils; use strict; @@ -7,8 +7,8 @@ use Module::Use qw(Auto::AliasDB); use Auto::AliasDB; use Multicast; -use IRCMessage; use RunLoop; +use base qw(Tiarra::IRC::NewMessageMixin); # get_ch_name get_raw_ch_name Υꥢ(ߴΤ) *get_ch_name = \&get_raw_ch_name; @@ -80,7 +80,7 @@ my ($line,%extra_replaces) = @_; return if !defined $line; foreach my $str ((ref($line) eq 'ARRAY') ? @$line : $line) { - my $msg_to_send = IRCMessage->new( + my $msg_to_send = __PACKAGE__->construct_irc_message( Command => $command, Params => ['', # ($use_alias ? Auto::AliasDB->shared->stdreplace_add( @@ -200,7 +200,7 @@ my ($line,%extra_replaces) = @_; return if !defined $line; foreach my $str ((ref($line) eq 'ARRAY') ? @$line : $line) { - $sender->send_message(IRCMessage->new( + $sender->send_message(__PACKAGE__->construct_irc_message( Command => 'NOTICE', Params => [$msg->nick, ($use_alias ? Auto::AliasDB->shared->stdreplace_add( diff -urN tiarra-20050322/module/CTCP/Version.pm tiarra-20050327/module/CTCP/Version.pm --- tiarra-20050322/module/CTCP/Version.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/CTCP/Version.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Version.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Version.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # CTCP floodкΤᡢVERSIONUSERINFOϰȿ٤ # IrcIO::Serverˡlast-ctcp-replied => ȿפȤremarkդ롣 @@ -31,7 +31,7 @@ if (!defined $last || time - $last > ($this->config->interval || 3)) { # CTCPȿְʾвᤷƤ롣 my $reply = CTCP::make( - 'VERSION Tiarra:'.::version.':perl '.$Config{version}.' on '.$Config{archname}, + 'VERSION Tiarra:'.::version().':perl '.$Config{version}.' on '.$Config{archname}, scalar Multicast::detach($msg->nick) ); $sender->send_message($reply); diff -urN tiarra-20050322/module/Channel/Freeze.pm tiarra-20050327/module/Channel/Freeze.pm --- tiarra-20050322/module/Channel/Freeze.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/Channel/Freeze.pm 2005-03-27 21:22:43.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Freeze.pm 540 2004-09-10 08:29:31Z topia $ +# $Id: Freeze.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # Υ⥸塼ϺƵưƤ򼺤ʤʤ褦ˤ١ # BulletinBoardfrost-channels¸ޤ @@ -7,7 +7,7 @@ package Channel::Freeze; use strict; use warnings; -use base qw/Module/; +use base qw(Module); use Multicast; use Timer; use BulletinBoard; @@ -69,7 +69,7 @@ # RunLoop->shared->broadcast_to_clients( - IRCMessage->new( + $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv system)), Command => 'NOTICE', Params => [ @@ -88,7 +88,7 @@ my $notify = sub { my $notice = shift; RunLoop->shared->broadcast_to_clients( - IRCMessage->new( + $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv system)), Command => 'NOTICE', Params => [ diff -urN tiarra-20050322/module/Channel/Join/Connect.pm tiarra-20050327/module/Channel/Join/Connect.pm --- tiarra-20050322/module/Channel/Join/Connect.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/Channel/Join/Connect.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Connect.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Connect.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # copyright (C) 2002 Topia . all rights reserved. package Channel::Join::Connect; @@ -70,7 +70,7 @@ } splice @$session,0,$msg_per_trigger; $server->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'JOIN', Params => [join(',', @param_chan), join(',', @param_key)])); } diff -urN tiarra-20050322/module/Channel/Join/Invite.pm tiarra-20050327/module/Channel/Join/Invite.pm --- tiarra-20050322/module/Channel/Join/Invite.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/Channel/Join/Invite.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,6 +1,6 @@ # -*- cperl -*- # ----------------------------------------------------------------------------- -# $Id: Invite.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Invite.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # copyright (C) 2003 Topia . all rights reserved. package Channel::Join::Invite; @@ -26,7 +26,7 @@ if (Mask::match_deep_chan([$this->config->mask('all')], $msg->prefix, $get_ch_name->())) { # match. $sender-> - send_message(IRCMessage->new( + send_message($this->construct_irc_message( Command => 'JOIN', Params => [$get_ch_name->()] )); diff -urN tiarra-20050322/module/Channel/Join/Kicked.pm tiarra-20050327/module/Channel/Join/Kicked.pm --- tiarra-20050322/module/Channel/Join/Kicked.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/Channel/Join/Kicked.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Kicked.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Kicked.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package Channel::Join::Kicked; use strict; @@ -23,7 +23,7 @@ } $sender->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'JOIN', Params => \@params)); } diff -urN tiarra-20050322/module/Channel/Mode/Get.pm tiarra-20050327/module/Channel/Mode/Get.pm --- tiarra-20050322/module/Channel/Mode/Get.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/Channel/Mode/Get.pm 2005-03-27 21:22:43.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Get.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Get.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package Channel::Mode::Get; use strict; @@ -10,7 +10,7 @@ sub new { my $class = shift; my $this = $class->SUPER::new(@_); - $this->{buffer} = []; # [IrcIO::Server,IRCMessage] + $this->{buffer} = []; # [IrcIO::Server,Tiarra::IRC::Message] $this->{timer} = undef; # TimerɬפʻȤ롣 $this; } @@ -33,7 +33,7 @@ foreach (split /,/,$msg->param(0)) { my $ch_shortname = Multicast::detatch($_); my $entry = [$sender, - IRCMessage->new( + $this->construct_irc_message( Command => 'MODE', Param => $ch_shortname)]; push @{$this->{buffer}},$entry; diff -urN tiarra-20050322/module/Channel/Mode/Oper/Grant.pm tiarra-20050327/module/Channel/Mode/Oper/Grant.pm --- tiarra-20050322/module/Channel/Mode/Oper/Grant.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/Channel/Mode/Oper/Grant.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Grant.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Grant.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package Channel::Mode::Oper::Grant; use strict; @@ -7,7 +7,6 @@ use base qw(Module); use Mask; use Multicast; -use IRCMessage; use Timer; sub new { @@ -107,7 +106,7 @@ } while (my ($ch_short,$nicks) = each %$channels) { $server->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'MODE', Params => [$ch_short, '+'.('o' x @$nicks), diff -urN tiarra-20050322/module/Channel/Mode/Set.pm tiarra-20050327/module/Channel/Mode/Set.pm --- tiarra-20050322/module/Channel/Mode/Set.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/Channel/Mode/Set.pm 2005-03-27 21:22:43.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Set.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Set.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # ǼĤdo-not-touch-mode-of-channels (HASH*)˵ҤƤͥΥ⡼ɤϮʤ # ----------------------------------------------------------------------------- @@ -59,7 +59,7 @@ if (Mask::match($ch_mask,$ch_fullname)) { foreach my $mode (split /,/,$modes) { $sender->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'MODE', Params => [$ch_plainname,$mode])); } diff -urN tiarra-20050322/module/Channel/Rejoin.pm tiarra-20050327/module/Channel/Rejoin.pm --- tiarra-20050322/module/Channel/Rejoin.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/Channel/Rejoin.pm 2005-03-27 21:22:43.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Rejoin.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Rejoin.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # Υ⥸塼ư˷ǼĤdo-not-touch-mode-of-channelsȤޤ # ----------------------------------------------------------------------------- @@ -26,7 +26,7 @@ # got_elist => +e(ά # got_Ilist => +I(ά # got_oper => PART->JOINƤ뤫ɤ - # cmd_buf => ARRAY + # cmd_buf => ARRAY $this; } @@ -139,7 +139,7 @@ # TOPICФ롣 if ($ch->topic ne '') { - push @{$session->{cmd_buf}},IRCMessage->new( + push @{$session->{cmd_buf}},$this->construct_irc_message( Command => 'TOPIC', Params => [$ch_name,$ch->topic]); } @@ -147,13 +147,13 @@ # ɬפʤMODE #channel¹ԡ #if ($ch->remarks('switches-are-known')) { # $session->{got_mode} = 1; - # push @{$session->{cmd_buf}},IRCMessage->new( + # push @{$session->{cmd_buf}},$this->construct_irc_message( # Command => 'MODE', #} # äѤᡣݡɱBOTȤƻȤä餳ʥ⥸塼Ȥʤȡ #else { $server->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'MODE', Param => $ch_name)); #} @@ -162,7 +162,7 @@ if ($this->config->save_lists) { foreach (qw/+e +b +I/) { $server->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'MODE', Params => [$ch_name,$_])); } @@ -186,7 +186,7 @@ $session->{got_oper} = 1; foreach (qw/PART JOIN/) { $session->{server}->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => $_, Param => $session->{ch_shortname})); } @@ -223,7 +223,7 @@ 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( + push @{$session->{cmd_buf}},$this->construct_irc_message( Command => 'MODE', Params => [$session->{ch_shortname}, '+'.($type x scalar(@masks)), @@ -242,7 +242,7 @@ my ($params, @params) = $ch->mode_string; if (length($params) > 1) { # ꤹ٤⡼ɤ롣 - push @{$session->{cmd_buf}},IRCMessage->new( + push @{$session->{cmd_buf}},$this->construct_irc_message( Command => 'MODE', Params => [$session->{ch_shortname}, $params, diff -urN tiarra-20050322/module/Client/Cache.pm tiarra-20050327/module/Client/Cache.pm --- tiarra-20050322/module/Client/Cache.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Client/Cache.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Cache.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Cache.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # copyright (C) 2003-2004 Topia . all rights reserved. package Client::Cache; @@ -25,7 +25,7 @@ $this->_yesno($this->config->use_mode_cache)) { # Ǥ϶ŪƤߤ my $remark = $client->remark('mode-cache-state') || {}; - _send_mode_cache($client,$ch_name,$ch); + $this->_send_mode_cache($client,$ch_name,$ch); $remark->{ Multicast::attach($ch->name, $network) }->[MODE_CACHE_FORCE_SENDED] = 1; @@ -155,9 +155,9 @@ 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}) + $this->_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); @@ -185,7 +185,7 @@ if (!exists $remark->{$info{chan_long}}) { # cache äƤ뤫狼ʤᡢ # ȤꤢäƤߤơ­ʤä餢롣 - my $message_tmpl = IRCMessage->new( + my $message_tmpl = $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix('system'), Command => RPL_WHOREPLY, Params => [ @@ -208,7 +208,7 @@ die 'cache data not enough'; } - my $message = $message_tmpl->clone(deep => 1); + my $message = $message_tmpl->clone; $message->param(2, $p->username); $message->param(3, $p->userhost); $message->param(4, $p->server); @@ -226,7 +226,7 @@ } }; if (!$@) { - my $message = $message_tmpl->clone(deep => 1); + my $message = $message_tmpl->clone; $message->command(RPL_ENDOFWHO); $message->param(2, 'End of WHO list.'); push(@messages, $message); @@ -255,10 +255,10 @@ sub _send_mode_cache { - my ($sendto,$ch_name,$ch) = @_; + my ($this,$sendto,$ch_name,$ch) = @_; $sendto->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix('system'), Command => RPL_CHANNELMODEIS, Params => [ @@ -273,7 +273,7 @@ ); if (defined $ch->remark('creation-time')) { $sendto->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix('system'), Command => RPL_CREATIONTIME, Params => [ diff -urN tiarra-20050322/module/Client/Eval.pm tiarra-20050327/module/Client/Eval.pm --- tiarra-20050322/module/Client/Eval.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Client/Eval.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Eval.pm 607 2004-10-02 08:31:58Z topia $ +# $Id: Eval.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package Client::Eval; use strict; @@ -15,7 +15,9 @@ # 饤ȤΥå if ($sender->isa('IrcIO::Client')) { # ꤵ줿ޥɤ? - if (Mask::match_deep([$this->config->command('all')], $msg->command)) { + my $cmd = Mask::match_deep([$this->config->command('all')], $msg->command); + my $hexcmd = Mask::match_deep([$this->config->hex_command('all')], $msg->command); + if ($cmd || $hexcmd) { # åƹ my ($method) = join(' ', @{$msg->params}); my ($ret, $err); @@ -32,23 +34,44 @@ }; $err = $@; - my $message = IRCMessage->new( + my $message = $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv system)), Command => 'NOTICE', Params => [RunLoop->shared_loop->current_nick, ''], ); + my $process = sub { + if (defined $this->config->max_line && + @_ > $this->config->max_line) { + splice @_, $this->config->max_line; + } + map { + if ($hexcmd) { + s/([^\s,'[:print:]])/'\x'.unpack('H*', $1)/eg; + s/\$/\\\$/g; + } + $_; + } @_; + }; do { - local($Data::Dumper::Terse) = 1; - local($Data::Dumper::Purity) = 1; + my $dumper = sub { + my $val = shift; + local $SIG{__WARN__} = sub {}; + Data::Dumper->new([$val])->Terse(1)->Purity(1) + ->Seen({ + ($this->_runloop ne $val) ? + (current_runloop => $this->_runloop) : + (), + })->Dump."\n"; + }; 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), + $process->(split /\n/, 'method: '.$dumper->($method)), + $process->(split /\n/, 'result: '.$dumper->($ret)), + $process->(split /\n/, 'error: '.$err), ); return undef; }; @@ -64,15 +87,23 @@ sub conf { return Configuration->shared; } sub module_manager { return ModuleManager->shared_manager; } sub module { return module_manager->get(shift); } -sub shutdown { return ::shutdown; } +sub shutdown { return ::shutdown(); } sub reload { ReloadTrigger->_install_reload_timer; return undef; } + sub reload_mod { my $name = shift; - delete $INC{$name}; - require $name; + $name .= '.pm'; + $name =~ s|::|/|g; + reload_pm($name); +} + +sub reload_pm { + my $file = shift; + delete $INC{$file}; + require $file; } 1; @@ -84,4 +115,13 @@ # λޥɤTiarra٤ΤǡIRCץȥ줿 # ޥ̾ꤹ٤ǤϤޤ command: eval + +# hex eval ¹Ԥ륳ޥ̾άȥޥɤɲäޤ +# λޥɤTiarra٤ΤǡIRCץȥ줿 +# ޥ̾ꤹ٤ǤϤޤ +hex-command: hexeval + +# ɽԿꤷޤάȤ٤ƤιԤɽޤ +max-line: 30 + =cut diff -urN tiarra-20050322/module/Client/GetVersion.pm tiarra-20050327/module/Client/GetVersion.pm --- tiarra-20050322/module/Client/GetVersion.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Client/GetVersion.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: GetVersion.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: GetVersion.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # copyright (C) 2004 Topia . all rights reserved. package Client::GetVersion; @@ -36,6 +36,7 @@ my ($command, $text) = split(/ /, $ctcp, 2); if ($command eq 'VERSION') { $io->remark('client-version', $text); + $io->remark(__PACKAGE__.'/fetching-version-expire', undef, 'delete'); return undef; } } diff -urN tiarra-20050322/module/Client/Guess.pm tiarra-20050327/module/Client/Guess.pm --- tiarra-20050322/module/Client/Guess.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Client/Guess.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Guess.pm 544 2004-09-11 08:28:32Z topia $ +# $Id: Guess.pm 866 2005-03-26 16:57:29Z topia $ # ----------------------------------------------------------------------------- # copyright (C) 2004 Topia . all rights reserved. package Client::Guess; @@ -122,6 +122,9 @@ if ($str =~ /^CHOCOA ($re_ver) \(($re_tok)\)$/) { $struct_set->([qw(type ver plat)], 'chocoa', $1, $2); + } elsif ($str =~ m[^Conversation ($re_ver) for (MacOS X|.+?) (http://$re_tok)$|]) { + $struct_set->([qw(type ver plat url)], + 'conversation', $1, $2, $3); } else { return undef; } diff -urN tiarra-20050322/module/Client/ProtectMyself.pm tiarra-20050327/module/Client/ProtectMyself.pm --- tiarra-20050322/module/Client/ProtectMyself.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Client/ProtectMyself.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: ProtectMyself.pm 724 2004-11-27 05:12:17Z topia $ +# $Id: ProtectMyself.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # copyright (C) 2004 Topia . all rights reserved. package Client::ProtectMyself; @@ -7,7 +7,6 @@ use warnings; use base qw(Module); use Multicast; -use IRCMessage; use Auto::AliasDB; use Tiarra::Utils; @@ -81,7 +80,7 @@ } if (@affected) { my $aliasdb = Auto::AliasDB->shared; - my $msg_skel = IRCMessage->new( + my $msg_skel = $this->construct_irc_message( Prefix => $runloop->sysmsg_prefix(qw(system fake::system)), Command => 'NOTICE', Params => [undef, undef]); diff -urN tiarra-20050322/module/Client/Rehash.pm tiarra-20050327/module/Client/Rehash.pm --- tiarra-20050322/module/Client/Rehash.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Client/Rehash.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Rehash.pm 499 2004-08-22 09:24:21Z topia $ +# $Id: Rehash.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # copyright (C) 2004 Topia . all rights reserved. package Client::Rehash; @@ -43,7 +43,7 @@ } elsif ($msg->param(0) eq $runloop->current_nick) { } else { $sender->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => $msg->param(0).'!'.$sender->username.'@'. $sender->client_host, Command => 'NICK', diff -urN tiarra-20050322/module/Client/ShowNick.pm tiarra-20050327/module/Client/ShowNick.pm --- tiarra-20050322/module/Client/ShowNick.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Client/ShowNick.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: ShowNick.pm 479 2004-08-20 23:55:47Z topia $ +# $Id: ShowNick.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # copyright (C) 2004 Topia . all rights reserved. package Client::ShowNick; @@ -24,13 +24,13 @@ my $global_nick = $_->current_nick; if ($global_nick ne $local_nick) { $io->send_message( - new IRCMessage(Prefix => $prefix, + $this->construct_irc_message(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, + $this->construct_irc_message(Prefix => $prefix, Command => 'NOTICE', Params => [$local_nick, "*** Your global nick in $network_name is same as local nick."])); @@ -54,7 +54,7 @@ my $global_nick = $_->current_nick; if ($global_nick eq $current_nick) { $client->send_message( - new IRCMessage( + $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv system)), Command => 'NOTICE', Params => [$current_nick, diff -urN tiarra-20050322/module/Log/Logger.pm tiarra-20050327/module/Log/Logger.pm --- tiarra-20050322/module/Log/Logger.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Log/Logger.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Logger.pm 761 2005-02-21 18:30:05Z topia $ +# $Id: Logger.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package Log::Logger; use strict; @@ -16,7 +16,7 @@ # exceptions: # ΥåΥʸ󲽤򥪡С饤ɤ # 'S_PRIVMSG' - # (IRCMessage,IrcIO)ͤ[ͥ̾,ʸ] + # (Tiarra::IRC::Message,IrcIO)ͤ[ͥ̾,ʸ] my $this = { enstringed => $enstringed_callback, exception_object => $exception_object, diff -urN tiarra-20050322/module/Log/Recent.pm tiarra-20050327/module/Log/Recent.pm --- tiarra-20050322/module/Log/Recent.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/Log/Recent.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Recent.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Recent.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package Log::Recent; use strict; @@ -8,7 +8,6 @@ use Module::Use qw(Tools::DateConvert Log::Logger); use Tools::DateConvert; use Log::Logger; -use IRCMessage; use Mask; sub new { @@ -34,7 +33,7 @@ if (defined $vec) { foreach my $elem (@$vec) { $client->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(channel log)), Command => 'NOTICE', Params => [$ch_name,$elem->[1]])); @@ -66,7 +65,7 @@ my $local_nick = RunLoop->shared->current_nick; foreach my $elem (@{$this->{priv_log}}) { $client->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv log)), Command => 'NOTICE', Params => [$local_nick,$elem->[1]])); # $elem->[0]Ͼ'priv' @@ -84,7 +83,7 @@ # RunLoop->shared->multi_server_mode_p ? # $elem->[0] : $ch->name; # $client->send_message( -# IRCMessage->new( +# $this->construct_irc_message( # Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(channel log)), # Command => 'NOTICE', # Params => [$ch_name,$elem->[1]])); diff -urN tiarra-20050322/module/Skelton.pm tiarra-20050327/module/Skelton.pm --- tiarra-20050322/module/Skelton.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/Skelton.pm 2005-03-27 21:22:43.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Skelton.pm 525 2004-09-07 03:47:24Z topia $ +# $Id: Skelton.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # ⥸塼Υȥ # ----------------------------------------------------------------------------- @@ -30,10 +30,10 @@ sub message_arrived { my ($this,$msg,$sender) = @_; # Сޤϥ饤Ȥå褿˸ƤФ롣 - # ͤIRCMessageޤϤޤundef + # ͤTiarra::IRC::MessageޤϤޤundef # # $msg : - # : IRCMessage֥ + # : Tiarra::IRC::Message֥ # С顢ޤϥ饤ȤƤå # ⥸塼ϤΥ֥Ȥ򤽤Τޤ֤Ƥɤ # Ѥ֤Ƥɤ֤ʤƤɤİʾ֤Ƥɤ @@ -123,7 +123,7 @@ # ̾Υ⥸塼ϤΥ᥽åɤɬפ̵ # # $message : - # : IRCMessage֥ + # : Tiarra::IRC::Message֥ # Ƥå # $io : # : IrcIO::ServerIrcIO::Client֥ diff -urN tiarra-20050322/module/System/Macro.pm tiarra-20050327/module/System/Macro.pm --- tiarra-20050322/module/System/Macro.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/System/Macro.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,17 +1,16 @@ # ----------------------------------------------------------------------------- -# $Id: Macro.pm 540 2004-09-10 08:29:31Z topia $ +# $Id: Macro.pm 869 2005-03-27 08:52:27Z 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->{macros} = $this->hash; # ޥ => ARRAY<ư(Tiarra::IRC::Message)> $this; } @@ -22,7 +21,7 @@ my ($command,$action) = (m/^(.+?)\s+(.+)$/); $command = uc($command); - my $action_msg = IRCMessage->new( + my $action_msg = $this->construct_irc_message( Line => $action, Encoding => 'utf8'); my $array = $macros->{$command}; diff -urN tiarra-20050322/module/System/Pong.pm tiarra-20050327/module/System/Pong.pm --- tiarra-20050322/module/System/Pong.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/System/Pong.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Pong.pm 804 2005-03-01 00:31:10Z topia $ +# $Id: Pong.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package System::Pong; use strict; @@ -28,7 +28,7 @@ if ($message->n_params < 1) { # ĤƤС/饤Ȥ˥顼֤ $sender->send_message( - new IRCMessage( + $this->construct_irc_message( Prefix => $prefix, Command => ERR_NOORIGIN, Params => [ @@ -45,7 +45,7 @@ } # ĤƤС/饤ȤPONG֤ $sender->send_message( - new IRCMessage( + $this->construct_irc_message( Prefix => $prefix, Command => 'PONG', Params => [ diff -urN tiarra-20050322/module/System/PrivTranslator.pm tiarra-20050327/module/System/PrivTranslator.pm --- tiarra-20050322/module/System/PrivTranslator.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/System/PrivTranslator.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,28 +1,70 @@ # ----------------------------------------------------------------------------- -# $Id: PrivTranslator.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: PrivTranslator.pm 872 2005-03-27 12:16:02Z topia $ # ----------------------------------------------------------------------------- +# copyright (C) 2003 phonohawk . all rights reserved. +# copyright (C) 2004-2005 Topia . all rights reserved. package System::PrivTranslator; use strict; use warnings; use base qw(Module); use Multicast; +sub NICK_CACHE_EXPIRE_TIME (){ 5 * 60 } +sub NICK_CACHE_EXPIRE_KEY (){ __PACKAGE__ . '/nick-avails' } +sub REMARK_NICK_ATTACHED_KEY (){ __PACKAGE__ . '/nick-attached' } + sub message_arrived { my ($this,$msg,$sender) = @_; if ($sender->isa('IrcIO::Server') && - defined $msg->nick) { + 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)); + !Multicast::channel_p($msg->param(0))) { + $msg->remark(REMARK_NICK_ATTACHED_KEY, [$msg->nick, + $sender->network_name]); + $msg->nick(Multicast::attach($msg->nick, $sender->network_name)); } } $msg; } +sub message_io_hook { + my ($this,$msg,$io,$type) = @_; + + if ($io->isa('IrcIO::Client') && + $type eq 'out') { + my $remark = $io->remark(NICK_CACHE_EXPIRE_KEY) || {}; + if (my $info = $msg->remark(REMARK_NICK_ATTACHED_KEY)) { + $remark->{$info->[1]}->{$info->[0]} = time() + NICK_CACHE_EXPIRE_TIME; + $io->remark(NICK_CACHE_EXPIRE_KEY, $remark); + } elsif ($msg->command eq 'NICK') { + if (defined $msg->generator) { + if ($msg->generator->can('network_name')) { + my $network_name = $msg->generator->network_name; + my $nick = $msg->nick; + my $time = delete $remark->{$network_name}->{$nick}; + if (defined $time && + $time >= time()) { + my $nick_to = $msg->param(0); + + # update expire place + $remark->{$network_name}->{$nick_to} = $time; + + # duplicate nick message + my $new_msg = $msg->clone; + $new_msg->nick(Multicast::attach($nick, $network_name)); + $new_msg->param(0, Multicast::attach($nick_to, $network_name)); + return ($msg, $new_msg); + } + } + } + } + } + return $msg; +} + + 1; =pod info: 饤ȤθĿŪprivϤʤʤ븽ݤ򤹤롣 @@ -30,5 +72,6 @@ section: important # Υ⥸塼ϸĿͰƤprivmsgԤnick˥ͥåȥ̾ղäޤ +# ޤǸ򤫤Ƥ5ʬ nick ѹ򥯥饤Ȥޤ # ܤϤޤ =cut diff -urN tiarra-20050322/module/System/Raw.pm tiarra-20050327/module/System/Raw.pm --- tiarra-20050322/module/System/Raw.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/System/Raw.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Raw.pm 479 2004-08-20 23:55:47Z topia $ +# $Id: Raw.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package System::Raw; use strict; @@ -15,7 +15,7 @@ # ¥ѥ᥿ɬס if ($msg->n_params < 2) { $sender->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(system)), Command => ERR_NEEDMOREPARAMS, Params => [ @@ -28,7 +28,7 @@ my $target = $msg->param(0); # åƹ - my $raw_msg = IRCMessage->new( + my $raw_msg = $this->construct_irc_message( Line => join(' ', @{$msg->params}[1 .. ($msg->n_params - 1)]), Encoding => 'utf8', ); @@ -43,7 +43,7 @@ } if (!$sent) { $sender->send_message( - IRCMessage->new( + $this->construct_irc_message( Prefix => RunLoop->shared_loop->sysmsg_prefix(qw(priv system)), Command => 'NOTICE', Params => [ diff -urN tiarra-20050322/module/System/RemoteControl.pm tiarra-20050327/module/System/RemoteControl.pm --- tiarra-20050322/module/System/RemoteControl.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/System/RemoteControl.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: RemoteControl.pm 479 2004-08-20 23:55:47Z topia $ +# $Id: RemoteControl.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package System::RemoteControl; use strict; @@ -20,7 +20,7 @@ defined $cmd) { # ¹ԡ $sender->send_message( - IRCMessage->new( + $this->construct_irc_message( Line => $cmd, Encoding => 'utf8')); } @@ -39,7 +39,7 @@ # ʸ: + # ȿbotnickɽޥ -# ϥС˸ȯԤIRCå +# ϥС˸ȯԤIRCå # # : # + hoge NICK [hoge] diff -urN tiarra-20050322/module/System/SendMessage.pm tiarra-20050327/module/System/SendMessage.pm --- tiarra-20050322/module/System/SendMessage.pm 2005-03-23 09:18:49.000000000 +0900 +++ tiarra-20050327/module/System/SendMessage.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: SendMessage.pm 677 2004-10-18 19:32:37Z topia $ +# $Id: SendMessage.pm 868 2005-03-27 04:27:29Z topia $ # ----------------------------------------------------------------------------- # SendMessage - å뤿Υ⥸塼롣 # ----------------------------------------------------------------------------- @@ -12,6 +12,7 @@ use Multicast; use ControlPort; use Auto::Utils; +use Tiarra::Utils; sub control_requested { my ($this,$request) = @_; @@ -29,10 +30,12 @@ # >> TIARRACONTROL/1.0 200 OK - my $mask = $request->table->{"Channel"}; - my $text = $request->table->{"Text"}; + my $mask = $request->table->{Channel}; + my $text = $request->table->{Text}; + my $command = utils->cond_yesno($request->table->{Notice}, 1) ? + 'NOTICE' : 'PRIVMSG'; unless ($mask) { - return new ControlPort::Reply(403, "Mask is not set"); + return new ControlPort::Reply(403, "Channel is not set"); } unless ($text) { return new ControlPort::Reply(403, "Doesn't have remark"); @@ -51,7 +54,7 @@ if (Mask::match_array([$channel_mask], $chinfo->name)) { $matched = 1; Auto::Utils::sendto_channel_closure( - $chinfo->fullname, 'NOTICE', undef, undef, undef, 0 + $chinfo->fullname, $command, undef, undef, undef, 0 )->($text); } } diff -urN tiarra-20050322/module/User/Away/Client.pm tiarra-20050327/module/User/Away/Client.pm --- tiarra-20050322/module/User/Away/Client.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/User/Away/Client.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,19 +1,18 @@ # ----------------------------------------------------------------------------- -# $Id: Client.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Client.pm 869 2005-03-27 08:52:27Z 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( + $this->construct_irc_message( Command => 'AWAY')); } @@ -24,7 +23,7 @@ defined $this->config->away) { RunLoop->shared->broadcast_to_servers( - IRCMessage->new( + $this->construct_irc_message( Command => 'AWAY', Param => $this->config->away)); } @@ -37,7 +36,7 @@ defined $this->config->away) { $server->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'AWAY', Param => $this->config->away)); } diff -urN tiarra-20050322/module/User/Away/Nick.pm tiarra-20050327/module/User/Away/Nick.pm --- tiarra-20050322/module/User/Away/Nick.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/User/Away/Nick.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,12 +1,11 @@ # ----------------------------------------------------------------------------- -# $Id: Nick.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Nick.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package User::Away::Nick; use strict; use warnings; use base qw(Module); use Mask; -use IRCMessage; use Multicast; sub message_arrived { @@ -35,7 +34,7 @@ sub set_away { my ($this,$msg,$away_str) = @_; $this->away($msg, - IRCMessage->new( + $this->construct_irc_message( Command => 'AWAY', Param => $away_str)); } @@ -43,7 +42,7 @@ sub unset_away { my ($this,$msg) = @_; $this->away($msg, - IRCMessage->new( + $this->construct_irc_message( Command => 'AWAY')); } diff -urN tiarra-20050322/module/User/Kick.pm tiarra-20050327/module/User/Kick.pm --- tiarra-20050322/module/User/Kick.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/User/Kick.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,13 +1,12 @@ # ----------------------------------------------------------------------------- -# $Id: Kick.pm 540 2004-09-10 08:29:31Z topia $ +# $Id: Kick.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package User::Kick; use strict; use warnings; -use base qw/Module/; +use base qw(Module); use Mask; use Multicast; -use IRCMessage; use Timer; sub new { @@ -39,7 +38,7 @@ Mask::match_deep_chan([$this->config->mask('all')],$msg->prefix,$ch_full)) { # kick塼롣 $this->enqueue( - $sender->network_name, IRCMessage->new( + $sender->network_name, $this->construct_irc_message( Command => 'KICK', Params => [$ch_short, $msg->nick, diff -urN tiarra-20050322/module/User/Nick/Detached.pm tiarra-20050327/module/User/Nick/Detached.pm --- tiarra-20050322/module/User/Nick/Detached.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/User/Nick/Detached.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Detached.pm 762 2005-02-21 20:05:25Z topia $ +# $Id: Detached.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- # Υ⥸塼RunLoopcurrent_nickʤnickѹʤ # ----------------------------------------------------------------------------- @@ -7,7 +7,6 @@ use strict; use warnings; use base qw(Module); -use IRCMessage; use RunLoop; sub client_attached { @@ -15,7 +14,7 @@ # 饤Ȥ³줿Ȥϡ # ʤȤİʾΥ饤Ȥ¸ߤ˷ޤäƤ롣 RunLoop->shared->broadcast_to_servers( - IRCMessage->new( + $this->construct_irc_message( Command => 'NICK', Param => RunLoop->shared->current_nick)); } @@ -27,7 +26,7 @@ defined $this->config->detached) { RunLoop->shared->broadcast_to_servers( - IRCMessage->new( + $this->construct_irc_message( Command => 'NICK', Param => $this->config->detached)); } @@ -40,7 +39,7 @@ defined $this->config->detached) { $server->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'NICK', Param => $this->config->detached)); } diff -urN tiarra-20050322/module/User/ServerOper.pm tiarra-20050327/module/User/ServerOper.pm --- tiarra-20050322/module/User/ServerOper.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/User/ServerOper.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,11 +1,10 @@ # ----------------------------------------------------------------------------- -# $Id: ServerOper.pm 540 2004-09-10 08:29:31Z topia $ +# $Id: ServerOper.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package User::ServerOper; use strict; use warnings; use base qw(Module); -use IRCMessage; sub new { my $class = shift; @@ -26,7 +25,7 @@ my $oper = $this->{table}->{$server->network_name}; if (defined $oper) { $server->send_message( - IRCMessage->new( + $this->construct_irc_message( Command => 'OPER', Params => [$oper->[0],$oper->[1]])); } diff -urN tiarra-20050322/module/User/Vanish.pm tiarra-20050327/module/User/Vanish.pm --- tiarra-20050322/module/User/Vanish.pm 2005-03-23 09:18:48.000000000 +0900 +++ tiarra-20050327/module/User/Vanish.pm 2005-03-27 21:22:42.000000000 +0900 @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Vanish.pm 479 2004-08-20 23:55:47Z topia $ +# $Id: Vanish.pm 869 2005-03-27 08:52:27Z topia $ # ----------------------------------------------------------------------------- package User::Vanish; use strict; @@ -258,7 +258,7 @@ # ѥ᥿ƹη̡Ĥ̵ʤä顢Υå˴ if (@params > 1) { - $msg = IRCMessage->new( + $msg = $this->construct_irc_message( Prefix => $msg->prefix, Command => $msg->command, Params => \@params);