diff options
43 files changed, 451 insertions, 480 deletions
diff --git a/fml/lib/FML/Article.pm b/fml/lib/FML/Article.pm index c4cdf943..6160a298 100644 --- a/fml/lib/FML/Article.pm +++ b/fml/lib/FML/Article.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Article.pm,v 1.58 2003/08/23 14:37:58 fukachan Exp $ +# $FML: Article.pm,v 1.59 2003/12/30 08:22:35 fukachan Exp $ # package FML::Article; @@ -230,15 +230,15 @@ sub _filepath my $unit = $config->{ spool_subdir_unit }; use Mail::Message::Spool; - my $spool = new Mail::Message::Spool; - my $args = { + my $spool = new Mail::Message::Spool; + my $mms_args = { base_dir => $spool_dir, id => $id, use_subdir => $use_subdir, subdir_unit => $unit, } ; - my $file = $spool->filepath($args); - my $dir = $spool->dirpath($args); # spool/ or spool/$subdir/ + my $file = $spool->filepath($mms_args); + my $dir = $spool->dirpath($mms_args); # spool/ or spool/$subdir/ return ($file, $dir); } diff --git a/fml/lib/FML/CGI/Calendar.pm b/fml/lib/FML/CGI/Calendar.pm index 21076918..2feb0b17 100644 --- a/fml/lib/FML/CGI/Calendar.pm +++ b/fml/lib/FML/CGI/Calendar.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Calendar.pm,v 1.6 2004/01/01 08:41:33 fukachan Exp $ +# $FML: Calendar.pm,v 1.7 2004/01/01 08:48:38 fukachan Exp $ # package FML::CGI::Calendar; @@ -55,12 +55,12 @@ print out the navigator and closing of html. # Descriptions: print out HTML header + body former part and navigator. -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub html_start { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $config = $curproc->config(); my $user = $curproc->safe_param_user; my $myname = $curproc->myname(); @@ -74,23 +74,23 @@ sub html_start -BGCOLOR => $color); print "\n"; - $curproc->_show_guide($args); + $curproc->_show_guide(); print "<HR>\n"; } # Descriptions: print out the navigator and closing of html. -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub html_end { - my ($curproc, $args) = @_; + my ($curproc) = @_; print "<HR>\n"; - $curproc->_show_guide($args); + $curproc->_show_guide(); # o.k. end of html print end_html; @@ -99,12 +99,12 @@ sub html_end # Descriptions: print out navigation bar -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub _show_guide { - my ($curproc, $args) = @_; + my ($curproc) = @_; for my $n ('this', 'next', 'last') { print "<A HREF=\"\#$n\">[$n month]</A>\n"; @@ -128,12 +128,12 @@ dummy. # Descriptions: main routine to print calendar as HTML TABLE format. -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_main { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $user = $curproc->safe_param_user; use Calendar::Lite; @@ -146,23 +146,23 @@ sub run_cgi_main # Descriptions: show menu (table based menu) -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_navigator { - my ($curproc, $args) = @_; + my ($curproc) = @_; ; } # Descriptions: show menu (table based menu) -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_options { - my ($curproc, $args) = @_; + my ($curproc) = @_; ; } diff --git a/fml/lib/FML/CGI/List.pm b/fml/lib/FML/CGI/List.pm index 099871f4..afaf845c 100644 --- a/fml/lib/FML/CGI/List.pm +++ b/fml/lib/FML/CGI/List.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: List.pm,v 1.6 2003/10/14 10:55:27 fukachan Exp $ +# $FML: List.pm,v 1.7 2003/10/17 08:16:28 fukachan Exp $ # package FML::CGI::List; @@ -28,15 +28,12 @@ sub new # Descriptions: show address list -# Arguments: OBJ($self) -# OBJ($curproc) -# HASH_REF($args) -# HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: none # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $config = $curproc->config(); my $target = $curproc->cgi_var_frame_target(); my $action = $curproc->cgi_var_action(); diff --git a/fml/lib/FML/CGI/ML.pm b/fml/lib/FML/CGI/ML.pm index ad5afa3d..0570a858 100644 --- a/fml/lib/FML/CGI/ML.pm +++ b/fml/lib/FML/CGI/ML.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: ML.pm,v 1.4 2003/10/14 10:55:27 fukachan Exp $ +# $FML: ML.pm,v 1.5 2003/10/15 01:03:28 fukachan Exp $ # package FML::CGI::ML; @@ -28,15 +28,12 @@ sub new # Descriptions: show menu for subscribe/unsubscribe commands -# Arguments: OBJ($self) -# OBJ($curproc) -# HASH_REF($args) -# HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: none # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $target = $curproc->cgi_var_frame_target(); my $action = $curproc->cgi_var_action(); my $ml_domain = $curproc->cgi_var_ml_domain(); diff --git a/fml/lib/FML/CGI/Menu.pm b/fml/lib/FML/CGI/Menu.pm index 8a044141..775930c5 100644 --- a/fml/lib/FML/CGI/Menu.pm +++ b/fml/lib/FML/CGI/Menu.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Menu.pm,v 1.5 2003/10/15 08:16:23 fukachan Exp $ +# $FML: Menu.pm,v 1.6 2003/11/02 14:45:25 fukachan Exp $ # package FML::CGI::Menu; @@ -66,12 +66,12 @@ This module has routines needed for the admin CGI. # Descriptions: print out HTML header + body former part -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub html_start { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $config = $curproc->config(); my $myname = $curproc->cgi_var_myname(); my $ml_name = $curproc->cgi_var_ml_name(); @@ -90,12 +90,12 @@ sub html_start # Descriptions: print out body latter part -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub html_end { - my ($curproc, $args) = @_; + my ($curproc) = @_; # o.k. end of html print end_html; @@ -106,17 +106,17 @@ sub html_end # Descriptions: main routine for CGI. # kick off suitable FML::Command finally # via cgi_execulte_command(). -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_main { - my ($curproc, $args) = @_; - my $config = $curproc->config(); - my $address = $curproc->cgi_try_get_address(); - my $ml_name = $curproc->cgi_var_ml_name(); - my $pcb = $curproc->pcb(); - my $mode = 'admin'; # cgi runs under admin mode (same way as makefml) + my ($curproc) = @_; + my $config = $curproc->config(); + my $address = $curproc->cgi_try_get_address(); + my $ml_name = $curproc->cgi_var_ml_name(); + my $pcb = $curproc->pcb(); + my $mode = 'admin'; # cgi runs under admin mode (same way as makefml) # specified command, we need to identify # the command specifined in the cgi_navigation and cgi_mein. @@ -148,7 +148,7 @@ sub run_cgi_main }; $pcb->set('cgi', 'command_args', $command_args); - $curproc->cgi_execute_command($args, $command_args); + $curproc->cgi_execute_command($command_args); } elsif ($command && $address) { print "<br>* case 2 <br>\n" if $debug; @@ -164,7 +164,7 @@ sub run_cgi_main }; $pcb->set('cgi', 'command_args', $command_args); - $curproc->cgi_execute_command($args, $command_args); + $curproc->cgi_execute_command($command_args); } elsif ($navi_command) { print "<br>* case 3 <br>\n" if $debug; @@ -205,14 +205,14 @@ sub run_cgi_main # Descriptions: show menu (table based menu) -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_navigator { - my ($curproc, $args) = @_; - my $target = $curproc->cgi_var_frame_target(); - my $action = $curproc->cgi_var_action(); + my ($curproc) = @_; + my $target = $curproc->cgi_var_frame_target(); + my $action = $curproc->cgi_var_action(); # natural language-ed name my $name_ml_name = $curproc->message_nl('term.ml_name', 'ml_name'); diff --git a/fml/lib/FML/CGI/ThreadTrack.pm b/fml/lib/FML/CGI/ThreadTrack.pm index d14fb0e9..72154edd 100644 --- a/fml/lib/FML/CGI/ThreadTrack.pm +++ b/fml/lib/FML/CGI/ThreadTrack.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: ThreadTrack.pm,v 1.26 2003/08/29 15:33:56 fukachan Exp $ +# $FML: ThreadTrack.pm,v 1.27 2003/10/15 08:16:23 fukachan Exp $ # package FML::CGI::ThreadTrack; @@ -48,12 +48,12 @@ C<FML::Process::CGI> base class. # Descriptions: print out HTML header + body former part -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub html_start { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $config = $curproc->config(); my $title = $config->{ thread_cgi_title } || 'thread system interface'; my $color = $config->{ thread_cgi_bgcolor } || '#E6E6FA'; @@ -69,12 +69,12 @@ sub html_start # Descriptions: print out body latter part -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub html_end { - my ($curproc, $args) = @_; + my ($curproc) = @_; # o.k. end of html print end_html; @@ -84,15 +84,15 @@ sub html_end # Descriptions: main routine for thread control. # run_cgi() can process request: list, show, change_status -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_main { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $config = $curproc->config(); my $myname = $config->{ program_name }; # XXX-TODO: valid ? - my $ttargs = $curproc->_build_threadtrack_param($args); + my $ttargs = $curproc->_build_threadtrack_param(); my $action = $curproc->safe_param_action() || ''; use Mail::ThreadTrack; @@ -141,12 +141,12 @@ sub run_cgi_main # Descriptions: prepare basic parameters for Mail::ThreadTrack module -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: HASH_REF sub _build_threadtrack_param { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $config = $curproc->config(); my $myname = $config->{ program_name }; my $option = $curproc->command_line_options(); @@ -182,17 +182,17 @@ sub _build_threadtrack_param # Descriptions: print navigation bar -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_navigator { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $config = $curproc->config(); my $action = $curproc->safe_cgi_action_name(); my $target = $config->{ thread_cgi_target_window } || '_top'; # XXX-TODO: we should provide $curproc->util->get_ml_list() method ? - my $ml_list = $curproc->get_ml_list($args); + my $ml_list = $curproc->get_ml_list(); my $ml_name = $config->{ ml_name }; print start_form(-action=>$action, -target=>$target); diff --git a/fml/lib/FML/CGI/User.pm b/fml/lib/FML/CGI/User.pm index 48cdbb96..c3bb952a 100644 --- a/fml/lib/FML/CGI/User.pm +++ b/fml/lib/FML/CGI/User.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: User.pm,v 1.5 2003/10/14 10:55:27 fukachan Exp $ +# $FML: User.pm,v 1.6 2003/10/22 04:17:42 fukachan Exp $ # package FML::CGI::User; @@ -29,15 +29,12 @@ sub new # Descriptions: show menu for user control commands such as # subscribe, unsubscribe, addadmin, byeadmin, ... -# Arguments: OBJ($self) -# OBJ($curproc) -# HASH_REF($args) -# HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: none # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $target = $curproc->cgi_var_frame_target(); my $action = $curproc->cgi_var_action(); my $ml_list = $curproc->cgi_var_ml_name_list(); diff --git a/fml/lib/FML/Command/Admin/addadmin.pm b/fml/lib/FML/Command/Admin/addadmin.pm index 937ddd6f..1977f5d3 100644 --- a/fml/lib/FML/Command/Admin/addadmin.pm +++ b/fml/lib/FML/Command/Admin/addadmin.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: addadmin.pm,v 1.14 2003/11/23 03:54:45 fukachan Exp $ +# $FML: addadmin.pm,v 1.15 2003/12/31 03:50:33 fukachan Exp $ # package FML::Command::Admin::addadmin; @@ -106,19 +106,18 @@ sub process # Descriptions: cgi menu to add a new user -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $member_map $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/addmoderator.pm b/fml/lib/FML/Command/Admin/addmoderator.pm index f59e595f..83c53219 100644 --- a/fml/lib/FML/Command/Admin/addmoderator.pm +++ b/fml/lib/FML/Command/Admin/addmoderator.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: addmoderator.pm,v 1.9 2003/11/23 03:54:45 fukachan Exp $ +# $FML: addmoderator.pm,v 1.10 2003/12/31 03:51:04 fukachan Exp $ # package FML::Command::Admin::addmoderator; @@ -106,19 +106,18 @@ sub process # Descriptions: cgi menu to add a new moderator. -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $member_map $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/deladmin.pm b/fml/lib/FML/Command/Admin/deladmin.pm index 414b1e71..00ba708e 100644 --- a/fml/lib/FML/Command/Admin/deladmin.pm +++ b/fml/lib/FML/Command/Admin/deladmin.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: deladmin.pm,v 1.13 2003/11/23 03:54:45 fukachan Exp $ +# $FML: deladmin.pm,v 1.14 2003/12/31 03:49:16 fukachan Exp $ # package FML::Command::Admin::deladmin; @@ -108,19 +108,18 @@ sub process # Descriptions: show cgi menu to remove the remote administrator. -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $member_map $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/delmoderator.pm b/fml/lib/FML/Command/Admin/delmoderator.pm index 4d6be734..9ca1df9d 100644 --- a/fml/lib/FML/Command/Admin/delmoderator.pm +++ b/fml/lib/FML/Command/Admin/delmoderator.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: delmoderator.pm,v 1.12 2003/11/23 03:54:45 fukachan Exp $ +# $FML: delmoderator.pm,v 1.13 2003/12/31 03:49:16 fukachan Exp $ # package FML::Command::Admin::delmoderator; @@ -108,19 +108,18 @@ sub process # Descriptions: show cgi menu to remove the moderator. -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $member_map $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/digest.pm b/fml/lib/FML/Command/Admin/digest.pm index d44e12a6..34474874 100644 --- a/fml/lib/FML/Command/Admin/digest.pm +++ b/fml/lib/FML/Command/Admin/digest.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: digest.pm,v 1.14 2004/01/01 08:41:33 fukachan Exp $ +# $FML: digest.pm,v 1.15 2004/01/01 08:48:40 fukachan Exp $ # package FML::Command::Admin::digest; @@ -230,13 +230,12 @@ sub _userdel # Descriptions: show cgi menu. -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; # @@ -247,7 +246,7 @@ sub cgi_menu eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/digestoff.pm b/fml/lib/FML/Command/Admin/digestoff.pm index 61c3d7d1..1894eb34 100644 --- a/fml/lib/FML/Command/Admin/digestoff.pm +++ b/fml/lib/FML/Command/Admin/digestoff.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: digestoff.pm,v 1.7 2004/01/01 08:41:34 fukachan Exp $ +# $FML: digestoff.pm,v 1.8 2004/01/01 08:48:40 fukachan Exp $ # package FML::Command::Admin::digestoff; @@ -81,19 +81,18 @@ sub process # Descriptions: show cgi menu for digestoff. -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/digeston.pm b/fml/lib/FML/Command/Admin/digeston.pm index 29363263..b091f871 100644 --- a/fml/lib/FML/Command/Admin/digeston.pm +++ b/fml/lib/FML/Command/Admin/digeston.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: digeston.pm,v 1.7 2004/01/01 08:41:34 fukachan Exp $ +# $FML: digeston.pm,v 1.8 2004/01/01 08:48:40 fukachan Exp $ # package FML::Command::Admin::digeston; @@ -81,19 +81,18 @@ sub process # Descriptions: show cgi menu for digeston -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/dir.pm b/fml/lib/FML/Command/Admin/dir.pm index 20c388fa..ea6c38d0 100644 --- a/fml/lib/FML/Command/Admin/dir.pm +++ b/fml/lib/FML/Command/Admin/dir.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: dir.pm,v 1.13 2003/08/29 15:33:58 fukachan Exp $ +# $FML: dir.pm,v 1.14 2003/12/31 03:49:16 fukachan Exp $ # package FML::Command::Admin::dir; @@ -91,13 +91,12 @@ sub process # Descriptions: cgi menu (dummy) -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $member_map $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; ; } diff --git a/fml/lib/FML/Command/Admin/file.pm b/fml/lib/FML/Command/Admin/file.pm index fc5cd92a..a780d572 100644 --- a/fml/lib/FML/Command/Admin/file.pm +++ b/fml/lib/FML/Command/Admin/file.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: file.pm,v 1.15 2004/01/01 08:41:34 fukachan Exp $ +# $FML: file.pm,v 1.16 2004/01/01 08:48:39 fukachan Exp $ # package FML::Command::Admin::file; @@ -106,13 +106,12 @@ sub process # Descriptions: show cgi menu (dummy) -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $member_map $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; # XXX-TODO: dummy.? ; diff --git a/fml/lib/FML/Command/Admin/list.pm b/fml/lib/FML/Command/Admin/list.pm index 4969b9ac..63532ef0 100644 --- a/fml/lib/FML/Command/Admin/list.pm +++ b/fml/lib/FML/Command/Admin/list.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: list.pm,v 1.20 2003/12/20 07:50:41 fukachan Exp $ +# $FML: list.pm,v 1.21 2003/12/31 04:00:52 fukachan Exp $ # package FML::Command::Admin::list; @@ -137,13 +137,12 @@ sub _gen_map_candidates # Descriptions: show cgi menu for list command. -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $member_map $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; # declare CGI mode. @@ -153,7 +152,7 @@ sub cgi_menu eval q{ use FML::CGI::List; my $obj = new FML::CGI::List; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { print $r; diff --git a/fml/lib/FML/Command/Admin/log.pm b/fml/lib/FML/Command/Admin/log.pm index c8e3a7d8..a50b58d1 100644 --- a/fml/lib/FML/Command/Admin/log.pm +++ b/fml/lib/FML/Command/Admin/log.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: log.pm,v 1.22 2004/01/01 08:43:32 fukachan Exp $ +# $FML: log.pm,v 1.23 2004/01/01 08:48:39 fukachan Exp $ # package FML::Command::Admin::log; @@ -70,13 +70,12 @@ sub process # Descriptions: show cgi menu -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $member_map $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $config = $curproc->config(); my $log_file = $config->{ log_file }; diff --git a/fml/lib/FML/Command/Admin/newml.pm b/fml/lib/FML/Command/Admin/newml.pm index 24219a91..9c85d0f0 100644 --- a/fml/lib/FML/Command/Admin/newml.pm +++ b/fml/lib/FML/Command/Admin/newml.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: newml.pm,v 1.73 2003/12/20 07:52:30 fukachan Exp $ +# $FML: newml.pm,v 1.74 2003/12/28 13:23:16 fukachan Exp $ # package FML::Command::Admin::newml; @@ -150,19 +150,18 @@ sub process # Descriptions: show cgi menu for newml -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: create home directories, update aliases, ... # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::ML; my $obj = new FML::CGI::ML; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/off.pm b/fml/lib/FML/Command/Admin/off.pm index 0469e06f..27faa3f3 100644 --- a/fml/lib/FML/Command/Admin/off.pm +++ b/fml/lib/FML/Command/Admin/off.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: off.pm,v 1.13 2003/11/23 03:54:45 fukachan Exp $ +# $FML: off.pm,v 1.14 2003/12/31 03:49:17 fukachan Exp $ # package FML::Command::Admin::off; @@ -103,19 +103,18 @@ sub process # Descriptions: show cgi menu for off -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/on.pm b/fml/lib/FML/Command/Admin/on.pm index e7060bff..d9f4e0c6 100644 --- a/fml/lib/FML/Command/Admin/on.pm +++ b/fml/lib/FML/Command/Admin/on.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: on.pm,v 1.13 2003/11/23 03:54:46 fukachan Exp $ +# $FML: on.pm,v 1.14 2003/12/31 03:49:17 fukachan Exp $ # package FML::Command::Admin::on; @@ -104,19 +104,18 @@ sub process # Descriptions: show cgi menu for on -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/rmml.pm b/fml/lib/FML/Command/Admin/rmml.pm index 6450478c..27e26ca1 100644 --- a/fml/lib/FML/Command/Admin/rmml.pm +++ b/fml/lib/FML/Command/Admin/rmml.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: rmml.pm,v 1.22 2003/12/28 13:23:17 fukachan Exp $ +# $FML: rmml.pm,v 1.23 2003/12/31 03:54:25 fukachan Exp $ # package FML::Command::Admin::rmml; @@ -106,19 +106,18 @@ sub process # Descriptions: show cgi menu for rmml command. -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: create home directories, update aliases, ... # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::ML; my $obj = new FML::CGI::ML; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/subscribe.pm b/fml/lib/FML/Command/Admin/subscribe.pm index f04c60d2..47496e00 100644 --- a/fml/lib/FML/Command/Admin/subscribe.pm +++ b/fml/lib/FML/Command/Admin/subscribe.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: subscribe.pm,v 1.25 2003/09/27 03:00:16 fukachan Exp $ +# $FML: subscribe.pm,v 1.26 2003/11/23 03:54:46 fukachan Exp $ # package FML::Command::Admin::subscribe; @@ -99,19 +99,18 @@ sub process # Descriptions: show cgi menu for subscribe -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $member_map $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Admin/unsubscribe.pm b/fml/lib/FML/Command/Admin/unsubscribe.pm index ae0853f3..12e70b53 100644 --- a/fml/lib/FML/Command/Admin/unsubscribe.pm +++ b/fml/lib/FML/Command/Admin/unsubscribe.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: unsubscribe.pm,v 1.27 2003/11/23 03:54:46 fukachan Exp $ +# $FML: unsubscribe.pm,v 1.28 2003/12/31 03:49:17 fukachan Exp $ # package FML::Command::Admin::unsubscribe; @@ -108,19 +108,18 @@ sub process # Descriptions: show cgi menu for unsubscribe -# Arguments: OBJ($self) -# OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) # Side Effects: update $member_map $recipient_map # Return Value: none sub cgi_menu { - my ($self, $curproc, $args, $command_args) = @_; + my ($self, $curproc, $command_args) = @_; my $r = ''; eval q{ use FML::CGI::User; my $obj = new FML::CGI::User; - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); }; if ($r = $@) { croak($r); diff --git a/fml/lib/FML/Command/Auth.pm b/fml/lib/FML/Command/Auth.pm index a937ca89..0d5a0cb2 100644 --- a/fml/lib/FML/Command/Auth.pm +++ b/fml/lib/FML/Command/Auth.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Auth.pm,v 1.29 2003/11/30 09:59:18 fukachan Exp $ +# $FML: Auth.pm,v 1.30 2003/12/30 03:51:02 fukachan Exp $ # package FML::Command::Auth; @@ -51,36 +51,36 @@ sub new # Descriptions: virtual reject handler, just return __LAST__ :-) -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) HASH_REF($optargs) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($optargs) # Side Effects: none # Return Value: STR (__LAST__, a special upcall) sub reject { - my ($self, $curproc, $args, $optargs) = @_; + my ($self, $curproc, $optargs) = @_; return '__LAST__'; } # Descriptions: permit anyone -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) HASH_REF($optargs) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($optargs) # Side Effects: none # Return Value: NUM sub permit_anyone { - my ($self, $curproc, $args, $optargs) = @_; + my ($self, $curproc, $optargs) = @_; return 1; } # Descriptions: permit if admin_member_maps has the sender -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) HASH_REF($optargs) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($optargs) # Side Effects: none # Return Value: NUM sub permit_admin_member_maps { - my ($self, $curproc, $args, $optargs) = @_; + my ($self, $curproc, $optargs) = @_; my $cred = $curproc->{ credential }; my $sender = $cred->sender(); my $match = $cred->is_privileged_member($sender); @@ -95,12 +95,12 @@ sub permit_admin_member_maps # Descriptions: reject if the mail address looks like system accounts. -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) HASH_REF($optargs) +# Arguments: OBJ($self) OBJ($curproc) HASH_REF($optargs) # Side Effects: none # Return Value: NUM or STR (__LAST__, a special upcall) sub reject_system_special_accounts { - my ($self, $curproc, $args, $optargs) = @_; + my ($self, $curproc, $optargs) = @_; my $cred = $curproc->{ credential }; my $sender = $cred->sender(); my $match = $cred->match_system_special_accounts($sender); @@ -114,7 +114,7 @@ sub reject_system_special_accounts } -=head2 check_admin_member_password($curproc, $args, $optargs) +=head2 check_admin_member_password($curproc, $optargs) check the password if it is valid or not as an administrator. @@ -124,13 +124,12 @@ check the password if it is valid or not as an administrator. # Descriptions: check the password if it is valid or not. # Arguments: OBJ($self) # HASH_REF($curproc) -# HASH_REF($args) # HASH_REF($optargs) # Side Effects: none # Return Value: NUM sub check_admin_member_password { - my ($self, $curproc, $args, $optargs) = @_; + my ($self, $curproc, $optargs) = @_; my $function = "check_admin_member_password"; my $cred = $curproc->{ credential }; my $config = $curproc->config(); diff --git a/fml/lib/FML/Command/HTMLify.pm b/fml/lib/FML/Command/HTMLify.pm index 69494003..49f64fcc 100644 --- a/fml/lib/FML/Command/HTMLify.pm +++ b/fml/lib/FML/Command/HTMLify.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: HTMLify.pm,v 1.18 2003/08/23 07:24:42 fukachan Exp $ +# $FML: HTMLify.pm,v 1.19 2003/09/13 09:14:31 fukachan Exp $ # package FML::Command::HTMLify; @@ -34,12 +34,12 @@ and file in C<$ml_home_dir>. # Descriptions: convert text to html style. -# Arguments: OBJ($curproc) HASH_REF($args) HASH_REF($optargs) +# Arguments: OBJ($curproc) HASH_REF($optargs) # Side Effects: none # Return Value: none sub convert { - my ($curproc, $args, $optargs) = @_; + my ($curproc, $optargs) = @_; my $config = $curproc->config(); my $ml_name = $config->{ ml_name }; my $udb_dir = $config->{ udb_base_dir }; diff --git a/fml/lib/FML/Config.pm b/fml/lib/FML/Config.pm index 579136c0..58010f7b 100644 --- a/fml/lib/FML/Config.pm +++ b/fml/lib/FML/Config.pm @@ -3,7 +3,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Config.pm,v 1.84 2003/08/24 14:08:28 fukachan Exp $ +# $FML: Config.pm,v 1.85 2003/09/27 06:50:25 fukachan Exp $ # package FML::Config; @@ -1053,12 +1053,12 @@ tie() IO. # Descriptions: begin op for tie() with %_fml_config -# Arguments: OBJ($self) HASH_REF($args) +# Arguments: OBJ($self) # Side Effects: none # Return Value: OBJ sub TIEHASH { - my ($self, $args) = @_; + my ($self) = @_; my ($type) = ref($self) || $self; my $me = \%_fml_config; return bless $me, $type; diff --git a/fml/lib/FML/Filter.pm b/fml/lib/FML/Filter.pm index c9c7438d..8750a695 100644 --- a/fml/lib/FML/Filter.pm +++ b/fml/lib/FML/Filter.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Filter.pm,v 1.35 2003/09/20 13:43:29 fukachan Exp $ +# $FML: Filter.pm,v 1.36 2003/10/15 01:03:28 fukachan Exp $ # package FML::Filter; @@ -59,12 +59,12 @@ sub new # Descriptions: entry point for FML::Filter::* modules -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($self) OBJ($curproc) # Side Effects: none # Return Value: STR or UNDEF, error reason (string). return undef if ok. sub article_filter { - my ($self, $curproc, $args) = @_; + my ($self, $curproc) = @_; my $message = $curproc->incoming_message(); my $config = $curproc->config(); @@ -77,7 +77,7 @@ sub article_filter if ($config->yes( "use_${function}" )) { $curproc->log("filter(debug): check by $function") if $debug; my $fp = "_apply_$function"; - $status = $self->$fp($curproc, $args, $message); + $status = $self->$fp($curproc, $message); } else { $curproc->log("filter(debug): not check by $function") if $debug; @@ -94,12 +94,12 @@ sub article_filter # Descriptions: size based filtering -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) OBJ($mesg) +# Arguments: OBJ($self) OBJ($curproc) OBJ($mesg) # Side Effects: none # Return Value: STR(reason) or 0 (not trapped, ok) sub _apply_article_size_filter { - my ($self, $curproc, $args, $mesg) = @_; + my ($self, $curproc, $mesg) = @_; my $config = $curproc->config(); use FML::Filter::Size; @@ -132,12 +132,12 @@ sub _apply_article_size_filter # Descriptions: header based filter -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) OBJ($mesg) +# Arguments: OBJ($self) OBJ($curproc) OBJ($mesg) # Side Effects: none # Return Value: STR(reason) or 0 (not trapped, ok) sub _apply_article_header_filter { - my ($self, $curproc, $args, $mesg) = @_; + my ($self, $curproc, $mesg) = @_; my $config = $curproc->config(); use FML::Filter::Header; @@ -168,12 +168,12 @@ sub _apply_article_header_filter # Descriptions: filter non MIME format message -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) OBJ($mesg) +# Arguments: OBJ($self) OBJ($curproc) OBJ($mesg) # Side Effects: none # Return Value: 0 (always ok, anyway) sub _apply_article_non_mime_filter { - my ($self, $curproc, $args, $mesg) = @_; + my ($self, $curproc, $mesg) = @_; my $config = $curproc->config(); if ($config->yes( 'use_article_non_mime_filter' )) { @@ -198,12 +198,12 @@ sub _apply_article_non_mime_filter # Descriptions: syntax check for text(/plain) -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) OBJ($mesg) +# Arguments: OBJ($self) OBJ($curproc) OBJ($mesg) # Side Effects: none # Return Value: none sub _apply_article_text_plain_filter { - my ($self, $curproc, $args, $mesg) = @_; + my ($self, $curproc, $mesg) = @_; my $config = $curproc->config(); if ($config->yes( 'use_article_text_plain_filter' )) { @@ -233,12 +233,12 @@ sub _apply_article_text_plain_filter # Descriptions: analyze MIME structure and filter it if matched. -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) OBJ($mesg) +# Arguments: OBJ($self) OBJ($curproc) OBJ($mesg) # Side Effects: none # Return Value: none sub _apply_article_mime_component_filter { - my ($self, $curproc, $args, $mesg) = @_; + my ($self, $curproc, $mesg) = @_; my $config = $curproc->config(); if ($config->yes( 'use_article_mime_component_filter' )) { @@ -358,12 +358,12 @@ sub _filter_reject_notice =cut # Descriptions: entry point for FML::Filter::* modules -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($self) OBJ($curproc) # Side Effects: none # Return Value: STR or UNDEF, error reason (string). return undef if ok. sub command_mail_filter { - my ($self, $curproc, $args) = @_; + my ($self, $curproc) = @_; my $message = $curproc->incoming_message(); my $config = $curproc->config(); @@ -377,7 +377,7 @@ sub command_mail_filter if ($config->yes( "use_${function}" )) { $curproc->log("filter(debug): check by $function") if $debug; my $fp = "_apply_$function"; - $status = $self->$fp($curproc, $args, $message); + $status = $self->$fp($curproc, $message); } else { $curproc->log("filter(debug): not check by $function") if $debug; @@ -394,12 +394,12 @@ sub command_mail_filter # Descriptions: size based filtering -# Arguments: OBJ($self) OBJ($curproc) HASH_REF($args) OBJ($mesg) +# Arguments: OBJ($self) OBJ($curproc) OBJ($mesg) # Side Effects: none # Return Value: STR(reason) or 0 (not trapped, ok) sub _apply_command_mail_size_filter { - my ($self, $curproc, $args, $mesg) = @_; + my ($self, $curproc, $mesg) = @_; my $config = $curproc->config(); use FML::Filter::Size; diff --git a/fml/lib/FML/Filter/Header.pm b/fml/lib/FML/Filter/Header.pm index 38b5d1c9..b0f3032a 100644 --- a/fml/lib/FML/Filter/Header.pm +++ b/fml/lib/FML/Filter/Header.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Header.pm,v 1.4 2003/07/21 04:51:33 fukachan Exp $ +# $FML: Header.pm,v 1.5 2003/08/23 04:35:35 fukachan Exp $ # package FML::Filter::Header; @@ -77,7 +77,7 @@ sub rules } -=head2 header_check($msg, $args) +=head2 header_check($msg); C<$msg> is C<Mail::Message> object. @@ -87,7 +87,7 @@ C<Usage>: my $obj = new FML::Filter::Header; my $msg = $curproc->{'incoming_message'}; - $obj->header_check($msg, $args); + $obj->header_check($msg); if ($obj->error()) { # do something for wrong formated message ... } @@ -96,12 +96,12 @@ C<Usage>: # Descriptions: top level dispatcher -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($self) OBJ($msg) # Side Effects: none # Return Value: none sub header_check { - my ($self, $msg, $args) = @_; + my ($self, $msg) = @_; my $hdr = $msg->whole_message_header(); my $rules = $self->{ _rules }; @@ -113,7 +113,7 @@ sub header_check } eval q{ - $self->$rule($hdr, $args); + $self->$rule($hdr); }; if ($@) { @@ -130,12 +130,12 @@ sub header_check # Descriptions: validate the message-id in the given message $msg. # This routine checks whether the message-id has @. -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($self) OBJ($msg) # Side Effects: croak() # Return Value: none sub check_message_id { - my ($self, $msg, $args) = @_; + my ($self, $msg) = @_; my $mid = $msg->get('message-id'); if ($mid !~ /\@/) { @@ -145,12 +145,12 @@ sub check_message_id # Descriptions: validate the date in the given message $msg. # This routine checks missing date field -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($self) OBJ($msg) # Side Effects: croak() # Return Value: none sub check_date { - my ($self, $msg, $args) = @_; + my ($self, $msg) = @_; if (! $msg->get('date')) { croak( "Missing Date: field" ); diff --git a/fml/lib/FML/Filter/MimeComponent.pm b/fml/lib/FML/Filter/MimeComponent.pm index d9a90efe..6c8d5bf8 100644 --- a/fml/lib/FML/Filter/MimeComponent.pm +++ b/fml/lib/FML/Filter/MimeComponent.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: MimeComponent.pm,v 1.5 2003/10/14 10:44:08 fukachan Exp $ +# $FML: MimeComponent.pm,v 1.6 2003/10/15 01:03:32 fukachan Exp $ # package FML::Filter::MimeComponent; @@ -79,7 +79,7 @@ sub new } -=head2 mime_component_check($msg, $args) +=head2 mime_component_check($msg) C<$msg> is C<Mail::Message> object. @@ -89,7 +89,7 @@ C<Usage>: my $obj = new FML::Filter::MimeComponent; my $msg = $curproc->incoming_message(); - $obj->mime_component_check($msg, $args); + $obj->mime_component_check($msg); if ($obj->error()) { # do something for wrong formated message ... } @@ -103,12 +103,12 @@ my $opt_cut_off_empty_part = 1; # Descriptions: parser of child multipart -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($self) OBJ($msg) # Side Effects: update $recursive_level # Return Value: NUM sub _rfc822_mime_component_check { - my ($self, $msg, $args) = @_; + my ($self, $msg) = @_; my $recursive_max_level = 10; my $curproc = $self->{ _curproc }; @@ -136,7 +136,7 @@ sub _rfc822_mime_component_check if (defined $rh) { use Mail::Message; my $msg0 = new Mail::Message->parse( { fd => $rh } ); - $self->mime_component_check($msg0, $args); + $self->mime_component_check($msg0); } } @@ -167,12 +167,12 @@ sub _temp_file_path # Descriptions: top level dispatcher -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($self) OBJ($msg) # Side Effects: none # Return Value: none sub mime_component_check { - my ($self, $msg, $args) = @_; + my ($self, $msg) = @_; my ($data_type, $prevmp, $nextmp, $mp, $action, $reject_reason); my $curproc = $self->{ _curproc }; my $is_cutoff = 0; # debug @@ -206,7 +206,7 @@ sub mime_component_check } if ($data_type =~ /message\/rfc822/i) { - $self->_rfc822_mime_component_check($mp, $args); + $self->_rfc822_mime_component_check($mp); next MSG; } diff --git a/fml/lib/FML/Filter/Size.pm b/fml/lib/FML/Filter/Size.pm index b3e956af..648d10e5 100644 --- a/fml/lib/FML/Filter/Size.pm +++ b/fml/lib/FML/Filter/Size.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Size.pm,v 1.4 2003/08/23 04:35:36 fukachan Exp $ +# $FML: Size.pm,v 1.5 2003/10/15 01:03:32 fukachan Exp $ # package FML::Filter::Size; @@ -98,7 +98,7 @@ sub set_class } -=head2 size_check($msg, $args) +=head2 size_check($msg) C<$msg> is C<Mail::Message> object. @@ -108,7 +108,7 @@ C<Usage>: my $obj = new FML::Filter::Size; my $msg = $curproc->{'incoming_message'}; - $obj->Size_check($msg, $args); + $obj->Size_check($msg); if ($obj->error()) { # do something for wrong formated message ... } @@ -117,12 +117,12 @@ C<Usage>: # Descriptions: top level dispatcher -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($self) OBJ($msg) # Side Effects: none # Return Value: none sub size_check { - my ($self, $msg, $args) = @_; + my ($self, $msg) = @_; my $rules = $self->{ _rules }; RULE: @@ -132,7 +132,7 @@ sub size_check } eval q{ - $self->$rule($msg, $args); + $self->$rule($msg); }; if ($@) { @@ -144,12 +144,12 @@ sub size_check =head1 FILTER RULES -=head2 check_header_size($msg, $args) +=head2 check_header_size($msg) check the size of mail header. throw reason via croak() if the size exceeds the limit. -=head2 check_body_size($msg, $args) +=head2 check_body_size($msg) check the size of mail body. throw reason via croak() if the size exceeds the limit. @@ -158,23 +158,23 @@ throw reason via croak() if the size exceeds the limit. # Descriptions: check the size of mail header. -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($self) OBJ($msg) # Side Effects: none # Return Value: none sub check_header_size { - my ($self, $msg, $args) = @_; + my ($self, $msg) = @_; $self->_check_mail_size($msg, "header"); } # Descriptions: check the size of mail body. -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($self) OBJ($msg) # Side Effects: none # Return Value: none sub check_body_size { - my ($self, $msg, $args) = @_; + my ($self, $msg) = @_; $self->_check_mail_size($msg, "body"); } diff --git a/fml/lib/FML/Filter/TextPlain.pm b/fml/lib/FML/Filter/TextPlain.pm index 11cb0167..14dad01e 100644 --- a/fml/lib/FML/Filter/TextPlain.pm +++ b/fml/lib/FML/Filter/TextPlain.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: TextPlain.pm,v 1.5 2003/10/18 06:53:57 fukachan Exp $ +# $FML: TextPlain.pm,v 1.6 2003/12/06 04:48:20 fukachan Exp $ # package FML::Filter::TextPlain; @@ -80,7 +80,7 @@ sub rules } -=head2 body_check($msg, $args) +=head2 body_check($msg) C<$msg> is C<Mail::Message> object. @@ -90,7 +90,7 @@ C<Usage>: my $obj = new FML::Filter::TextPlain; my $msg = $curproc->incoming_message_body(); - $obj->body_check($msg, $args); + $obj->body_check($msg); if ($obj->error()) { # do something for wrong formated message ... } @@ -99,12 +99,12 @@ C<Usage>: # Descriptions: top level dispatcher -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($self) OBJ($msg) # Side Effects: none # Return Value: none sub body_check { - my ($self, $msg, $args) = @_; + my ($self, $msg) = @_; ## 0. preparation # local scope after here @@ -148,7 +148,7 @@ sub body_check if ($self->can($rule)) { eval q{ - $self->$rule($msg, $args, $first_msg); + $self->$rule($msg, $first_msg); }; if ($@) { $self->error_set($@); @@ -163,12 +163,12 @@ sub body_check # Descriptions: reject if not Japanese in JIS is included in the message. -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) OBJ($first_msg) +# Arguments: OBJ($self) OBJ($msg) OBJ($first_msg) # Side Effects: croak if error # Return Value: none sub reject_not_iso2022jp_japanese_string { - my ($self, $msg, $args, $first_msg) = @_; + my ($self, $msg, $first_msg) = @_; my $buf = $first_msg->nth_paragraph(1); use Mail::Message::Encode; @@ -180,12 +180,12 @@ sub reject_not_iso2022jp_japanese_string # Descriptions: reject if mail body is empty -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) OBJ($first_msg) +# Arguments: OBJ($self) OBJ($msg) OBJ($first_msg) # Side Effects: croak if error # Return Value: none sub reject_null_mail_body { - my ($self, $msg, $args, $first_msg) = @_; + my ($self, $msg, $first_msg) = @_; if ($first_msg->is_empty) { my $size = $first_msg->size(); @@ -202,12 +202,12 @@ sub reject_null_mail_body # helps me to speculate the virus family? # This GUID trap idea is based on ZDNet news information. # Thanks hama@sunny.co.jp on M$ GUID pattern. -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) OBJ($first_msg) +# Arguments: OBJ($self) OBJ($msg) OBJ($first_msg) # Side Effects: croak if error # Return Value: none sub reject_ms_guid { - my ($self, $msg, $args, $first_msg) = @_; + my ($self, $msg, $first_msg) = @_; for (my $mp = $msg->{ next }; $mp ; $mp = $mp->{ next } ) { # XXX croak() if GUID found. @@ -289,12 +289,12 @@ sub _decode_mime_buffer # XXX e.g. "chaddr a@d1 b@d2". # If we include them, # we cannot identify a command or an English phrase ;D -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) OBJ($first_msg) +# Arguments: OBJ($self) OBJ($msg) OBJ($first_msg) # Side Effects: croak if error # Return Value: none sub reject_one_line_message { - my ($self, $msg, $args, $first_msg) = @_; + my ($self, $msg, $first_msg) = @_; my $buf = $first_msg->nth_paragraph(1); if ( $self->need_one_line_check($first_msg) ) { @@ -309,12 +309,12 @@ sub reject_one_line_message # XXX fml 4.0: fml.pl (distribute) should not accpet commands # XXX: "# command" is internal represention # XXX: but to reject the old compatible syntaxes. -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) OBJ($first_msg) +# Arguments: OBJ($self) OBJ($msg) OBJ($first_msg) # Side Effects: croak if error # Return Value: none sub reject_old_fml_command_syntax { - my ($self, $msg, $args, $first_msg) = @_; + my ($self, $msg, $first_msg) = @_; my $buf = $first_msg->message_text; if ($buf =~ /^[\s\n]*(\#\s*[\w\d\:\-\s]+)[\n\s]*$/) { @@ -327,12 +327,12 @@ sub reject_old_fml_command_syntax # Descriptions: reject if $msg looks command (wrong fml command). -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) OBJ($first_msg) +# Arguments: OBJ($self) OBJ($msg) OBJ($first_msg) # Side Effects: croak if error # Return Value: none sub reject_invalid_fml_command_syntax { - my ($self, $msg, $args, $first_msg) = @_; + my ($self, $msg, $first_msg) = @_; my $buf = $first_msg->message_text; if ($buf =~ /^[\s\n]*\%\s*echo.*/i) { @@ -349,12 +349,12 @@ sub reject_invalid_fml_command_syntax # e.g. reject "SUBSCRIBE" : octal code follows: # 243 323 243 325 243 302 243 323 243 303 # 243 322 243 311 243 302 243 305 -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) OBJ($first_msg) +# Arguments: OBJ($self) OBJ($msg) OBJ($first_msg) # Side Effects: croak if error # Return Value: none sub reject_japanese_command_syntax { - my ($self, $msg, $args, $first_msg) = @_; + my ($self, $msg, $first_msg) = @_; my $buf = $first_msg->message_text; if ($buf =~ /\033\044\102(\043[\101-\132\141-\172])/) { @@ -499,12 +499,12 @@ sub clean_up_buffer # Descriptions: virus check against uuencode # Even if Multipart, evaluate all blocks agasint virus checks. -# Arguments: OBJ($self) OBJ($msg) HASH_REF($args) OBJ($first_msg) +# Arguments: OBJ($self) OBJ($msg) OBJ($first_msg) # Side Effects: croak if error # Return Value: none sub reject_uuencode { - my ($self, $msg, $args, $first_msg) = @_; + my ($self, $msg, $first_msg) = @_; for (my $mp = $msg->{ next }; $mp ; $mp = $mp->{ next } ) { $self->_probe_uuencode($mp); diff --git a/fml/lib/FML/Header.pm b/fml/lib/FML/Header.pm index 4c4848ad..34718894 100644 --- a/fml/lib/FML/Header.pm +++ b/fml/lib/FML/Header.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Header.pm,v 1.64 2003/09/19 13:30:33 tmu Exp $ +# $FML: Header.pm,v 1.65 2003/11/29 07:23:38 fukachan Exp $ # package FML::Header; @@ -62,20 +62,20 @@ forward the request up to superclass C<Mail::header::new()>. # Descriptions: forward new() request to the base class -# Arguments: OBJ($self) HASH_REF($args) +# Arguments: OBJ($self) HASH_REF($rw_args) # Side Effects: none # Return Value: OBJ sub new { - my ($self, $args) = @_; + my ($self, $rw_args) = @_; # an adapter for Mail::Header::new() - $self->SUPER::new($args); + $self->SUPER::new($rw_args); } # Descriptions: dummy -# Arguments: OBJ($self) HASH_REF($args) +# Arguments: OBJ($self) HASH_REF($rw_args) # Side Effects: none # Return Value: none sub DESTROY {} @@ -193,15 +193,15 @@ sub data_type =head1 FML SPECIFIC METHODS -=head2 add_fml_ml_name($config, $args) +=head2 add_fml_ml_name($config, $rw_args) add X-ML-Name: -=head2 add_fml_traditional_article_id($config, $args) +=head2 add_fml_traditional_article_id($config, $rw_args) add X-Mail-Count: -=head2 add_fml_article_id($config, $args) +=head2 add_fml_article_id($config, $rw_args) add X-ML-Count: @@ -214,57 +214,57 @@ add X-ML-Count: # Descriptions: add "X-ML-Name: elena" to header -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub add_fml_ml_name { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; $header->add('X-ML-Name', $config->{ outgoing_mail_header_x_ml_name }); } # Descriptions: add "X-Mail-Count: NUM" to header -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub add_fml_traditional_article_id { - my ($header, $config, $args) = @_; - $header->add('X-Mail-Count', $args->{ id }); + my ($header, $config, $rw_args) = @_; + $header->add('X-Mail-Count', $rw_args->{ id }); } # Descriptions: add "X-ML-Count: NUM" to header -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub add_fml_article_id { - my ($header, $config, $args) = @_; - $header->add('X-ML-Count', $args->{ id }); + my ($header, $config, $rw_args) = @_; + $header->add('X-ML-Count', $rw_args->{ id }); } -=head2 add_software_info($config, $args) +=head2 add_software_info($config, $rw_args) add X-MLServer: and List-Software:. -C<MIME::Lite> object as a $args->{ message } can be handled -when $args->{type} is 'MIME::Lite'. +C<MIME::Lite> object as a $rw_args->{ message } can be handled +when $rw_args->{type} is 'MIME::Lite'. -=head2 add_rfc2369($config, $args) +=head2 add_rfc2369($config, $rw_args) add List-* sereies defined in RFC2369 and RFC2919. -C<MIME::Lite> object as a $args->{ message } can be handled -when $args->{type} is 'MIME::Lite'. +C<MIME::Lite> object as a $rw_args->{ message } can be handled +when $rw_args->{type} is 'MIME::Lite'. -=head2 add_x_sequence($config, $args) +=head2 add_x_sequence($config, $rw_args) add X-Sequence. -=head2 add_message_id($config, $args) +=head2 add_message_id($config, $rw_args) add Message-Id. @@ -272,18 +272,18 @@ add Message-Id. # Descriptions: add "X-ML-Server: fml .." and "List-Software: fml .." to header -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub add_software_info { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; my $fml_version = $config->{ fml_version }; - my $object_type = defined $args->{ type } ? $args->{ type } : ''; + my $object_type = defined $rw_args->{ type } ? $rw_args->{ type } : ''; if ($fml_version) { if ($object_type eq 'MIME::Lite') { - my $msg = $args->{ message }; + my $msg = $rw_args->{ message }; $msg->attr('X-MLServer' => $fml_version); $msg->attr('List-Software' => $fml_version); } @@ -296,13 +296,13 @@ sub add_software_info # Descriptions: add List-* to header -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub add_rfc2369 { - my ($header, $config, $args) = @_; - my $object_type = defined $args->{ type } ? $args->{ type } : ''; + my ($header, $config, $rw_args) = @_; + my $object_type = defined $rw_args->{ type } ? $rw_args->{ type } : ''; # addresses my $post = $config->{ address_for_post }; @@ -316,7 +316,7 @@ sub add_rfc2369 # See RFC2369 for more details if ($object_type eq 'MIME::Lite') { - my $msg = $args->{ message }; + my $msg = $rw_args->{ message }; $msg->attr('List-ID' => $id) if $id; $msg->attr('List-Post' => "<mailto:${post}>") if $post; $msg->attr('List-Owner' => "<mailto:${maintainer}>") if $maintainer; @@ -344,19 +344,19 @@ sub add_rfc2369 } # Descriptions: add "Message-ID if not define -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub add_message_id { - my ($header, $config, $args) = @_; - my $object_type = defined $args->{ type } ? $args->{ type } : ''; + my ($header, $config, $rw_args) = @_; + my $object_type = defined $rw_args->{ type } ? $rw_args->{ type } : ''; use FML::Header::MessageID; - my $mid = FML::Header::MessageID->new->gen_id($config,$args); + my $mid = FML::Header::MessageID->new->gen_id($config); if ($object_type eq 'MIME::Lite') { - my $msg = $args->{ message }; + my $msg = $rw_args->{ message }; $msg->attr('Message-Id' => $mid); } else { @@ -366,18 +366,18 @@ sub add_message_id # Descriptions: add "X-Sequence: elena NUM" to header -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub add_x_sequence { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; - $header->add('X-Sequence', "$config->{ outgoing_mail_header_x_ml_name } $args->{ id }"); + $header->add('X-Sequence', "$config->{ outgoing_mail_header_x_ml_name } $rw_args->{ id }"); } -=head2 rewrite_article_subject_tag($config, $args) +=head2 rewrite_article_subject_tag($config, $rw_args) add subject tag like [elena:00010]. The actual function definitions exist in C<FML::Header::Subject>. @@ -406,17 +406,17 @@ replace original C<Received:> to C<X-Received:>. # Descriptions: rewrite subject if needed -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub rewrite_article_subject_tag { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; my $pkg = "FML::Header::Subject"; eval qq{ use $pkg;}; unless ($@) { - $pkg->rewrite_article_subject_tag($header, $config, $args); + $pkg->rewrite_article_subject_tag($header, $config, $rw_args); } else { croak("cannot load $pkg"); @@ -426,12 +426,12 @@ sub rewrite_article_subject_tag # Descriptions: rewrite Reply-To: to this ML's address. # add Reply-To: if not specified. -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub rewrite_reply_to { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; my $reply_to = $header->get('reply-to') || ''; unless ($reply_to) { @@ -442,23 +442,23 @@ sub rewrite_reply_to # Descriptions: rewrite Errors-To: to the maintainer. # add Errors-To: if not specified. -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub rewrite_errors_to { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; $header->add('Errors-To', $config->{ maintainer }); } # Descriptions: rewrite Date: to X-Date: if needed -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub rewrite_date { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; my $orgdate = $header->get('date') || ''; use Mail::Message::Date; @@ -471,12 +471,12 @@ sub rewrite_date # Descriptions: rewrite Received: to X-Received: if needed -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub rewrite_received { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; my($i,$data); my $org = "Received"; my $new = "X-Received"; @@ -490,7 +490,7 @@ sub rewrite_received } -=head2 delete_unsafe_header_fields($config, $args) +=head2 delete_unsafe_header_fields($config, $rw_args) remove header fields defiend in C<$unsafe_header_fields>. C<$unsafe_header_fields> is a list of keys. @@ -502,12 +502,12 @@ The keys are space separeted. # Descriptions: remove some header fields defined in $config -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update $header # Return Value: none sub delete_unsafe_header_fields { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; my ($fields) = $config->get_as_array_ref('unsafe_header_fields'); for my $field (@$fields) { $header->delete($field);} @@ -575,18 +575,18 @@ sub extract_message_id_references =head1 FILTERING FUNCTIONS -=head2 check_message_id($config, $args) +=head2 check_message_id($config, $rw_args) check whether message-id is unique or not. If the message-id is found in the past message-id cache, the injected message must causes a mail loop. -=head2 check_x_ml_info($config, $args) +=head2 check_x_ml_info($config, $rw_args) The injected message loops if x-ml-info: has our own C<address_for_post> address. -=head2 check_list_post($config, $args) +=head2 check_list_post($config, $rw_args) The injected message loops if list-post: has our own C<address_for_post> address. @@ -596,12 +596,12 @@ C<address_for_post> address. # Descriptions: check whether message-id is duplicated or not # against mail loop. -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: update cache # Return Value: STR or 0 sub check_message_id { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; my $dir = $config->{ 'message_id_cache_dir' }, my $mid = $header->get('message-id'); my $dup = 0; @@ -627,12 +627,12 @@ sub check_message_id # Descriptions: check X-ML-Info: duplication against mail loop -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: none # Return Value: 1 or 0 sub check_x_ml_info { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; my $buf = $header->get('x-ml-info') || undef; my $addr = $config->{ addr_for_post } || undef; @@ -646,12 +646,12 @@ sub check_x_ml_info # Descriptions: check mail loop by List-Post: field -# Arguments: OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: none # Return Value: 1 or 0 sub check_list_post { - my ($header, $config, $args) = @_; + my ($header, $config, $rw_args) = @_; my $buf = $header->get('list-post') || undef; my $addr = $config->{ addr_for_post } || undef; diff --git a/fml/lib/FML/Header/MessageID.pm b/fml/lib/FML/Header/MessageID.pm index 379e921c..ddd6fd36 100644 --- a/fml/lib/FML/Header/MessageID.pm +++ b/fml/lib/FML/Header/MessageID.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: MessageID.pm,v 1.16 2003/11/11 10:26:55 tmu Exp $ +# $FML: MessageID.pm,v 1.17 2003/12/30 03:52:07 fukachan Exp $ # package FML::Header::MessageID; @@ -163,12 +163,12 @@ generate and return a new message-id. # Descriptions: generate new message-id used in reply message -# Arguments: OBJ($self) OBJ($config) HASH_REF($args) +# Arguments: OBJ($self) OBJ($config) # Side Effects: counter increment # Return Value: STR sub gen_id { - my ($self, $config, $args) = @_; + my ($self, $config) = @_; # XXX-TODO: if $config->{ address_for_post } undefined ? $Counter++; diff --git a/fml/lib/FML/Header/Subject.pm b/fml/lib/FML/Header/Subject.pm index 584fe9ec..a9bacb30 100644 --- a/fml/lib/FML/Header/Subject.pm +++ b/fml/lib/FML/Header/Subject.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Subject.pm,v 1.39 2003/07/21 11:25:37 fukachan Exp $ +# $FML: Subject.pm,v 1.40 2003/08/23 04:35:36 fukachan Exp $ # package FML::Header::Subject; @@ -58,12 +58,12 @@ replace the subject with the newer content e.g. including the ML tag. # Descriptions: add or rewrite the subject tag -# Arguments: OBJ($self) OBJ($header) OBJ($config) HASH_REF($args) +# Arguments: OBJ($self) OBJ($header) OBJ($config) HASH_REF($rw_args) # Side Effects: the header subject is rewritten # Return Value: none sub rewrite_article_subject_tag { - my ($self, $header, $config, $args) = @_; + my ($self, $header, $config, $rw_args) = @_; my ($in_code, $out_code); # XXX-TODO: need $article_subject_tag expaned already e.g. "\Lmlname\E" @@ -88,7 +88,7 @@ sub rewrite_article_subject_tag my $obj = new Mail::Message::Encode; # add(prepend) the rewrited tag with mime encoding. - $tag = sprintf($tag, $args->{ id }); + $tag = sprintf($tag, $rw_args->{ id }); my $new_subject = $tag." ".$subject; $new_subject = $obj->encode_mime_string($new_subject, 'base64', $in_code); $header->replace('Subject', $new_subject); diff --git a/fml/lib/FML/Process/CGI/Kernel.pm b/fml/lib/FML/Process/CGI/Kernel.pm index f5376989..e8abfe1b 100644 --- a/fml/lib/FML/Process/CGI/Kernel.pm +++ b/fml/lib/FML/Process/CGI/Kernel.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Kernel.pm,v 1.69 2004/01/01 08:40:21 fukachan Exp $ +# $FML: Kernel.pm,v 1.70 2004/01/01 08:48:40 fukachan Exp $ # package FML::Process::CGI::Kernel; @@ -263,9 +263,9 @@ star_html(), run_cgi() and end_html(). C<run()> executes - $curproc->start_html($args); - $curproc->run_cgi($args); - $curproc->end_html($args); + $curproc->html_start(); + $curproc->_drive_cgi_by_table(); + $curproc->html_end(); C<run_cgi()> prepares tables by the following granularity. @@ -291,9 +291,9 @@ sub run { my ($curproc, $args) = @_; - $curproc->html_start($args); - $curproc->_drive_cgi_by_table($args); - $curproc->html_end($args); + $curproc->html_start(); + $curproc->_drive_cgi_by_table(); + $curproc->html_end(); } @@ -329,12 +329,12 @@ sub _error_string # Descriptions: show menu table -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub _drive_cgi_by_table { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $r = ''; # XXX-TODO: hmm, customisable by /etc/fml/cgi.conf ? @@ -372,7 +372,7 @@ sub _drive_cgi_by_table }; # firstly, execute command if needed. - $curproc->run_cgi_main($args); + $curproc->run_cgi_main(); print "<table border=0 cellspacing=\"0\" cellpadding=\"5\">\n"; print "\n<!-- new line -->\n"; @@ -395,7 +395,7 @@ sub _drive_cgi_by_table my $fp = $function_table->{ $pos }; if ($fp) { - eval q{ $curproc->$fp($args);}; + eval q{ $curproc->$fp();}; if ($r = $@) { _error_string($curproc, $r);} } print "\n</td>\n"; @@ -405,7 +405,7 @@ sub _drive_cgi_by_table } -=head2 cgi_execute_command($args, $command_args) +=head2 cgi_execute_command($command_args) execute specified command given as FML::Command::* @@ -413,12 +413,12 @@ execute specified command given as FML::Command::* # Descriptions: execute FML::Command -# Arguments: OBJ($curproc) HASH_REF($args) HASH_REF($command_args) +# Arguments: OBJ($curproc) HASH_REF($command_args) # Side Effects: load module # Return Value: none sub cgi_execute_command { - my ($curproc, $args, $command_args) = @_; + my ($curproc, $command_args) = @_; my $commode = $command_args->{ command_mode }; my $comname = $command_args->{ comname }; my $config = $curproc->config(); @@ -465,7 +465,7 @@ sub cgi_execute_command } -=head2 run_cgi_title($args) +=head2 run_cgi_title() show title. @@ -473,12 +473,12 @@ show title. # Descriptions: show title -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_title { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $myname = $curproc->cgi_var_myname(); my $ml_domain = $curproc->cgi_var_ml_domain(); my $ml_name = $curproc->cgi_var_ml_name(); @@ -497,7 +497,7 @@ sub run_cgi_title } -=head2 run_cgi_help($args) +=head2 run_cgi_help() help. @@ -505,12 +505,12 @@ help. # Descriptions: show help -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_help { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $ml_name = $curproc->cgi_var_ml_name(); my $ml_domain = $curproc->cgi_var_ml_domain(); my $mode = $curproc->cgi_var_cgi_mode(); @@ -539,7 +539,7 @@ sub run_cgi_help } -=head2 run_cgi_command_help($args) +=head2 run_cgi_command_help() command_help. @@ -547,12 +547,12 @@ command_help. # Descriptions: show command_dependent help -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_command_help { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $buf = ''; my $navi_command = $curproc->safe_param_navi_command(); my $command = $curproc->safe_param_command(); @@ -575,12 +575,12 @@ sub run_cgi_command_help # Descriptions: prepare arguemnts for message handling. -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: HASH_REF sub _gen_msg_args { - my ($curproc, $args) = @_; + my ($curproc) = @_; # natural language-ed name my $name_submit = $curproc->message_nl('term.submit', 'submit'); @@ -596,7 +596,7 @@ sub _gen_msg_args } -=head2 run_cgi_log($args) +=head2 run_cgi_log() log. @@ -604,18 +604,18 @@ log. # Descriptions: show log -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_log { - my ($curproc, $args) = @_; + my ($curproc) = @_; # XXX-TODO: NOT IMPLEMENTED. } -=head2 run_cgi_dummy($args) +=head2 run_cgi_dummy() dummy. @@ -623,18 +623,18 @@ dummy. # Descriptions: show dummy -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_dummy { - my ($curproc, $args) = @_; + my ($curproc) = @_; # XXX-TODO: NOT IMPLEMENTED. } -=head2 run_cgi_date($args) +=head2 run_cgi_date() date. @@ -642,19 +642,19 @@ date. # Descriptions: show date -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_date { - my ($curproc, $args) = @_; + my ($curproc) = @_; # XXX-TODO: NOT IMPLEMENTED. NOT USE `date`; print `date`; } -=head2 run_cgi_options($args) +=head2 run_cgi_options() show options. @@ -662,17 +662,17 @@ show options. # Descriptions: show options -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub run_cgi_options { - my ($curproc, $args) = @_; - my $domain = $curproc->cgi_var_ml_domain(); - my $action = $curproc->safe_cgi_action_name(); - my $lang = $curproc->cgi_var_language(); - my $config = $curproc->config(); - my $langlist = $config->get_as_array_ref('cgi_language_list'); + my ($curproc) = @_; + my $domain = $curproc->cgi_var_ml_domain(); + my $action = $curproc->safe_cgi_action_name(); + my $lang = $curproc->cgi_var_language(); + my $config = $curproc->config(); + my $langlist = $config->get_as_array_ref('cgi_language_list'); if ($#$langlist > 0) { # natural language-ed name @@ -699,7 +699,7 @@ sub run_cgi_options } -=head2 run_cgi_menu($args, $comname, $command_args) +=head2 run_cgi_menu() execute cgi_menu() given as FML::Command::* @@ -707,12 +707,12 @@ execute cgi_menu() given as FML::Command::* # Descriptions: execute FML::Command -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: load module # Return Value: none sub run_cgi_menu { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $pcb = $curproc->pcb(); my $command_args = $pcb->get('cgi', 'command_args'); @@ -727,17 +727,17 @@ sub run_cgi_menu }; if (defined $obj) { - $obj->cgi_menu($curproc, $args, $command_args); + $obj->cgi_menu($curproc, $command_args); } } else { my $ml_name = $curproc->safe_param_ml_name(); if ($ml_name) { - $curproc->run_cgi_help($args); + $curproc->run_cgi_help(); } else { - $curproc->run_cgi_help($args); + $curproc->run_cgi_help(); } } } diff --git a/fml/lib/FML/Process/Command.pm b/fml/lib/FML/Process/Command.pm index 84da87e5..71ffa3b6 100644 --- a/fml/lib/FML/Process/Command.pm +++ b/fml/lib/FML/Process/Command.pm @@ -3,7 +3,7 @@ # Copyright (C) 2000,2001,2002,2003 Ken'ichi Fukamachi # All rights reserved. # -# $FML: Command.pm,v 1.91 2003/11/29 10:24:27 fukachan Exp $ +# $FML: Command.pm,v 1.92 2003/11/30 09:59:19 fukachan Exp $ # package FML::Process::Command; @@ -121,7 +121,7 @@ sub verify_request $curproc->verify_sender_credential(); unless ($curproc->is_refused()) { - $curproc->_check_filter($args); + $curproc->_check_filter(); } $eval = $config->get_hook( 'command_verify_request_end_hook' ); @@ -130,18 +130,18 @@ sub verify_request # Descriptions: filter -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: set flag to ignore this process if it should be filtered. # Return Value: none sub _check_filter { - my ($curproc, $args) = @_; - my $config = $curproc->config(); + my ($curproc) = @_; + my $config = $curproc->config(); eval q{ use FML::Filter; my $filter = new FML::Filter; - my $r = $filter->command_mail_filter($curproc, $args); + my $r = $filter->command_mail_filter($curproc); # filter traps this message. if ($r = $filter->error()) { @@ -195,7 +195,7 @@ sub run unless ($curproc->is_refused()) { # permit_xxx() sets the error reason at "check_restriction" in pcb. - if ($curproc->permit_command($args)) { + if ($curproc->permit_command()) { $curproc->_evaluate_command_lines($args); } # XXX reject command use irrespective of requests from admins/users. @@ -311,12 +311,12 @@ sub _check_context # Descriptions: check command (specified in $opts) is valid and permitted # in the configuration. -# Arguments: OBJ($curproc) HASH_REF($args) STR($level) HASH_REF($opts) +# Arguments: OBJ($curproc) STR($level) HASH_REF($opts) # Side Effects: none # Return Value: NUM(1 or 0) sub _config_permit_command { - my ($curproc, $args, $level, $opts) = @_; + my ($curproc, $level, $opts) = @_; my $config = $curproc->config(); my $cred = $curproc->{ credential }; # user credential my $prompt = $config->{ command_mail_reply_prompt } || '>>>'; @@ -348,13 +348,12 @@ sub _config_permit_command # Descriptions: validate command syntax by FML::Restriction. -# Arguments: OBJ($curproc) -# HASH_REF($args) HASH_REF($status) HASH_REF($cominfo) +# Arguments: OBJ($curproc) HASH_REF($status) HASH_REF($cominfo) # Side Effects: none # Return Value: NUM(1 or 0) sub _is_safe_syntax { - my ($curproc, $args, $status, $cominfo) = @_; + my ($curproc, $status, $cominfo) = @_; my $config = $curproc->config(); my $prompt = $config->{ command_mail_reply_prompt } || '>>>'; my $level = $status->{ level }; @@ -435,12 +434,12 @@ sub _get_command_name # Descriptions: authenticate the currrent process sender as an admin -# Arguments: OBJ($curproc) HASH_REF($args) HASH_REF($optargs) +# Arguments: OBJ($curproc) HASH_REF($optargs) # Side Effects: none # Return Value: NUM(1 or 0) sub _try_admin_auth { - my ($curproc, $args, $optargs) = @_; + my ($curproc, $optargs) = @_; my $is_auth = 0; my $obj = undef; @@ -452,7 +451,7 @@ sub _try_admin_auth my $config = $curproc->config(); my $rules = $config->get_as_array_ref('admin_command_restrictions'); for my $rule (@$rules) { - $is_auth = $obj->$rule($curproc, $args, $optargs); + $is_auth = $obj->$rule($curproc, $optargs); # reject as soon as possible if ($is_auth eq '__LAST__') { @@ -481,13 +480,12 @@ sub _try_admin_auth # Descriptions: determine $mode and $level for the current command (line). # We apply this function for each line in command request. # $mode and $level change line by line. -# Arguments: OBJ($curproc) -# HASH_REF($args) HASH_REF($status) HAS_REF($command_info) +# Arguments: OBJ($curproc) HASH_REF($status) HAS_REF($command_info) # Side Effects: update $status, $command_info # Return Value: STR sub _get_command_mode { - my ($curproc, $args, $status, $command_info) = @_; + my ($curproc, $status, $command_info) = @_; my $config = $curproc->config(); my $command = $command_info->{ command }; my $comname = $command_info->{ comname }; @@ -526,7 +524,7 @@ sub _get_command_mode # since $commands_for_stranger contains "confirm" command :-) # It is effective but wrong since we set $level = stranger # though we should set up $level = user. - if ($curproc->_config_permit_command($args, "stranger", $opts)) { + if ($curproc->_config_permit_command("stranger", $opts)) { $status->{ mode } = 'user'; $status->{ level } = 'stranger'; } @@ -552,7 +550,7 @@ sub _get_command_mode my $optargs = { address => $sender, password => $data }; # XXX simple state machine: update $status->{ is_auth } - $is_auth = $curproc->_try_admin_auth($args, $optargs); + $is_auth = $curproc->_try_admin_auth($optargs); $status->{ is_auth } = $is_auth; $curproc->log("admin: o.k. auth-ed as an ML admin") if $is_auth; } @@ -564,7 +562,7 @@ sub _get_command_mode my $opts = { comname => $comname, command => $command }; my $xmode = 'privileged_user'; - if ($curproc->_config_permit_command($args, $xmode, $opts)) { + if ($curproc->_config_permit_command($xmode, $opts)) { $status->{ mode } = 'admin'; $status->{ level } = 'admin'; $command_info->{ command } = $command; @@ -608,7 +606,7 @@ sub _get_command_mode else { if ($is_member) { my $opts = { comname => $comname, command => $command }; - if ($curproc->_config_permit_command($args, "user", $opts)) { + if ($curproc->_config_permit_command("user", $opts)) { $status->{ mode } = 'user'; $status->{ level } = 'user'; } @@ -620,7 +618,7 @@ sub _get_command_mode } else { my $opts = { comname => $comname, command => $command }; - if ($curproc->_config_permit_command($args, "stranger", $opts)) { + if ($curproc->_config_permit_command("stranger", $opts)) { $status->{ mode } = 'user'; $status->{ level } = 'stranger'; } @@ -730,13 +728,13 @@ sub __clean_up # Descriptions: set up error message to inform emergency stop -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # HASH_REF($status) HASH_REF($cominfo) STR($orig_command) # Side Effects: update reply messages # Return Value: none sub __stop_here { - my ($curproc, $args, $status, $cominfo, $orig_command) = @_; + my ($curproc, $status, $cominfo, $orig_command) = @_; my $config = $curproc->config(); my $prompt = $config->{ command_mail_reply_prompt } || '>>>'; my $key = $status->{ _stop_reason_key }; @@ -817,7 +815,7 @@ sub _evaluate_command_lines # Example: if orig_command = "# help", comname = "help" $fixed_command = __clean_up($orig_command); $cominfo = $curproc->_parse_command_args($args, $fixed_command); - $mode = $curproc->_get_command_mode($args, $status, $cominfo); + $mode = $curproc->_get_command_mode($status, $cominfo); # 1. check $mode if the further processing is allowed if ($mode eq '__NEXT__') { @@ -826,7 +824,7 @@ sub _evaluate_command_lines } elsif ($mode eq '__LAST__') { $curproc->logerror("command processing stop."); - $curproc->__stop_here($args, $status, $cominfo, $orig_command); + $curproc->__stop_here($status, $cominfo, $orig_command); last COMMAND; } @@ -839,7 +837,7 @@ sub _evaluate_command_lines # 1.3 valid mode unless ($mode eq 'user' || $mode eq 'admin') { $curproc->logerror("command processing stop."); - $curproc->__stop_here($args, $status, $cominfo, $orig_command); + $curproc->__stop_here($status, $cominfo, $orig_command); last COMMAND; } @@ -853,7 +851,7 @@ sub _evaluate_command_lines } # 3. simple syntax check - unless ($curproc->_is_safe_syntax($args, $status, $cominfo)) { + unless ($curproc->_is_safe_syntax($status, $cominfo)) { $curproc->logerror("invalid/unsafe syntax"); $curproc->log("(debug) ignore $fixed_command"); $num_ignored++; diff --git a/fml/lib/FML/Process/Distribute.pm b/fml/lib/FML/Process/Distribute.pm index 9e6980f2..7b8cd539 100644 --- a/fml/lib/FML/Process/Distribute.pm +++ b/fml/lib/FML/Process/Distribute.pm @@ -3,7 +3,7 @@ # Copyright (C) 2000,2001,2002,2003 Ken'ichi Fukamachi # All rights reserved. # -# $FML: Distribute.pm,v 1.131 2003/12/24 14:29:36 fukachan Exp $ +# $FML: Distribute.pm,v 1.132 2003/12/25 10:52:23 tmu Exp $ # package FML::Process::Distribute; @@ -128,7 +128,7 @@ sub verify_request } unless ($curproc->is_refused()) { - $curproc->_check_filter($args); + $curproc->_check_filter(); } $eval = $config->get_hook( 'distribute_verify_request_end_hook' ); @@ -137,18 +137,18 @@ sub verify_request # Descriptions: filter -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: set flag to ignore this process if it should be filtered. # Return Value: none sub _check_filter { - my ($curproc, $args) = @_; - my $config = $curproc->config(); + my ($curproc) = @_; + my $config = $curproc->config(); eval q{ use FML::Filter; my $filter = new FML::Filter; - my $r = $filter->article_filter($curproc, $args); + my $r = $filter->article_filter($curproc); # filter traps this message. if ($r = $filter->error()) { @@ -212,7 +212,7 @@ sub run # $curproc->lock(); unless ($curproc->is_refused()) { - if ($curproc->permit_post($args)) { + if ($curproc->permit_post()) { $curproc->_distribute($args); } else { @@ -356,7 +356,7 @@ sub _distribute # XXX $article != $curproc->{ article } (which is just a key) # XXX $curproc->{ article } is prepared as a side effect for the future. - my $article = $curproc->_build_article_object($args); + my $article = $curproc->_build_article_object(); # get sequence number my $id = $article->increment_id; @@ -369,8 +369,8 @@ sub _distribute # thread system checks the message before header rewritings. if ($config->yes('use_thread_track')) { - # $curproc->_old_thread_check($args); - $curproc->_new_thread_check($args); + # $curproc->_old_thread_check(); + $curproc->_new_thread_check(); } # header operations @@ -387,29 +387,29 @@ sub _distribute # update header info to sync w/ article header. if ($config->yes('use_thread_track')) { - $curproc->_new_thread_check_post($args); + $curproc->_new_thread_check_post(); } $curproc->unlock($lock_channel); # delivery starts ! - $curproc->_deliver_article($args); + $curproc->_deliver_article(); if ($config->yes('use_html_archive')) { $curproc->log("htmlify article $id"); - $curproc->_htmlify($args); + $curproc->_htmlify(); $curproc->log("htmlify article $id end"); } } # Descriptions: build and return FML::Article object -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: OBJ(FML::Article) sub _build_article_object { - my ($curproc, $args) = @_; + my ($curproc) = @_; # create aritcle to distribute use FML::Article; @@ -422,16 +422,16 @@ sub _build_article_object # Descriptions: header rewrite followed by # $config->{ article_header_rewrite_rules } # each method exists in FML::Header module. -# Arguments: OBJ($curproc) HASH_REF($hw_args) +# Arguments: OBJ($curproc) HASH_REF($hrw_args) # Side Effects: $curproc->{ article }->{ header } is rewritten # Return Value: none sub _header_rewrite { - my ($curproc, $hw_args) = @_; + my ($curproc, $hrw_args) = @_; my $config = $curproc->config(); my $header = $curproc->article_message_header(); my $rules = $config->get_as_array_ref('article_header_rewrite_rules'); - my $id = $hw_args->{ id }; + my $id = $hrw_args->{ id }; for my $rule (@$rules) { $curproc->log("_header_rewrite( $rule )") if $config->yes('debug'); @@ -450,12 +450,12 @@ sub _header_rewrite # Descriptions: deliver the article -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: mail delivery, logging # Return Value: none sub _deliver_article { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $cred = $curproc->{ credential }; my $config = $curproc->config(); # FML::Config object my $message = $curproc->article_message(); # Mail::Message object @@ -521,12 +521,12 @@ sub _deliver_article # Descriptions: the top level interface to drive thread tracking system -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: update thread information # Return Value: none sub _old_thread_check { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $config = $curproc->config(); my $pcb = $curproc->pcb(); my $myname = $curproc->myname(); @@ -560,12 +560,12 @@ sub _old_thread_check # Descriptions: the top level interface to drive thread tracking system -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: update thread information # Return Value: none sub _new_thread_check { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $pcb = $curproc->pcb(); my $msg = $curproc->article_message(); @@ -574,7 +574,7 @@ sub _new_thread_check # XXX we need to specify article_id here since # XXX analyzer routine has no clue for the current primary key. my $article_id = $pcb->get('article', 'id'); - my $tdb_args = $curproc->thread_db_args($args); + my $tdb_args = $curproc->thread_db_args(); $tdb_args->{ id } = $article_id; # analyze the current message to update DB (UDB). @@ -587,12 +587,12 @@ sub _new_thread_check # Descriptions: the top level interface to drive thread tracking system -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: update thread information # Return Value: none sub _new_thread_check_post { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $pcb = $curproc->pcb(); my $hdr = $curproc->article_message_header(); @@ -601,7 +601,7 @@ sub _new_thread_check_post # XXX we need to specify article_id here since # XXX analyzer routine has no clue for the current primary key. my $article_id = $pcb->get('article', 'id'); - my $tdb_args = $curproc->thread_db_args($args); + my $tdb_args = $curproc->thread_db_args(); $tdb_args->{ id } = $article_id; # overwrite header info base on the article. @@ -615,12 +615,12 @@ sub _new_thread_check_post # Descriptions: the top level entry to create HTML article -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: update html database # Return Value: none sub _htmlify { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $config = $curproc->config(); my $pcb = $curproc->pcb(); my $myname = $curproc->myname(); @@ -628,11 +628,11 @@ sub _htmlify my $spool_dir = $config->{ spool_dir }; my $html_dir = $config->{ html_archive_dir }; my $udb_dir = $config->{ udb_base_dir }; - my $article = $curproc->_build_article_object($args); + my $article = $curproc->_build_article_object(); my $article_id = $pcb->get('article', 'id'); my $article_file = $article->filepath($article_id); my $index_order = $config->{ html_archive_index_order_type }; - my $_tdb_args = $curproc->thread_db_args($args); + my $_tdb_args = $curproc->thread_db_args(); $curproc->set_umask_as_public(); diff --git a/fml/lib/FML/Process/Error.pm b/fml/lib/FML/Process/Error.pm index c65e7b24..e7815b61 100644 --- a/fml/lib/FML/Process/Error.pm +++ b/fml/lib/FML/Process/Error.pm @@ -3,7 +3,7 @@ # Copyright (C) 2002,2003 Ken'ichi Fukamachi # All rights reserved. # -# $FML: Error.pm,v 1.34 2003/08/29 15:34:08 fukachan Exp $ +# $FML: Error.pm,v 1.35 2003/11/29 10:24:29 fukachan Exp $ # package FML::Process::Error; @@ -191,7 +191,7 @@ sub run if ($found) { $pcb->set("error", "found", 1); - $curproc->_clean_up_bouncers($args); + $curproc->_clean_up_bouncers(); } } @@ -202,13 +202,13 @@ sub run # Descriptions: run analyzer() if long time spent after the last # analyze. -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: remove addresses which causes bounces # Return Value: none sub _clean_up_bouncers { - my ($curproc, $args) = @_; - my $channel = 'erroranalyzer'; + my ($curproc) = @_; + my $channel = 'erroranalyzer'; if ($curproc->is_event_timeout($channel)) { $curproc->log("(debug) event timeout"); diff --git a/fml/lib/FML/Process/Fake.pm b/fml/lib/FML/Process/Fake.pm index fdec1e75..bb43cc42 100644 --- a/fml/lib/FML/Process/Fake.pm +++ b/fml/lib/FML/Process/Fake.pm @@ -3,7 +3,7 @@ # Copyright (C) 2003 Ken'ichi Fukamachi # All rights reserved. # -# $FML: Fake.pm,v 1.1 2003/12/24 12:49:09 fukachan Exp $ +# $FML: Fake.pm,v 1.2 2003/12/30 03:57:05 fukachan Exp $ # package FML::Process::Fake; @@ -78,7 +78,7 @@ sub prepare if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; } $curproc->_faker_init($args); - $curproc->_faker_prepare($args); + $curproc->_faker_prepare(); $eval = $config->get_hook( 'faker_prepare_end_hook' ); if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; } @@ -223,12 +223,12 @@ sub _faker_init # Descriptions: parser of incoming message header. -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub _faker_prepare { - my ($curproc, $args) = @_; + my ($curproc) = @_; # 1. parse message $curproc->parse_incoming_message(); @@ -303,11 +303,11 @@ sub _faker_main # $curproc->_ml_create($ml_name, $ml_domain); } - $curproc->_process_switch($args, $ml_name, $ml_domain); + $curproc->_faker_process_switch($args, $ml_name, $ml_domain); if ($curproc->is_valid_ml($ml_name, $ml_domain)) { $curproc->log("ml found: $ml_name"); - $curproc->_process_switch($args, $ml_name, $ml_domain); + $curproc->_faker_process_switch($args, $ml_name, $ml_domain); } else { $curproc->logerror("fail to create ml: $ml_name"); @@ -361,7 +361,7 @@ sub _faker_analyze_address # Arguments: OBJ($curproc) HASH_REF($args) STR($ml_name) STR($ml_domain) # Side Effects: none # Return Value: none -sub _process_switch +sub _faker_process_switch { my ($curproc, $args, $ml_name, $ml_domain) = @_; my $ml_addr = sprintf("%s@%s", $ml_name, $ml_domain); diff --git a/fml/lib/FML/Process/Kernel.pm b/fml/lib/FML/Process/Kernel.pm index 22347379..5bf560d3 100644 --- a/fml/lib/FML/Process/Kernel.pm +++ b/fml/lib/FML/Process/Kernel.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Kernel.pm,v 1.199 2003/12/29 14:57:04 fukachan Exp $ +# $FML: Kernel.pm,v 1.200 2003/12/30 03:53:53 fukachan Exp $ # package FML::Process::Kernel; @@ -180,12 +180,12 @@ sub new # Descriptions: set up default signal handling -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub _signal_init { - my ($curproc, $args) = @_; + my ($curproc) = @_; $SIG{'ALRM'} = $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = sub { my ($signal) = @_; @@ -197,23 +197,23 @@ sub _signal_init # Descriptions: set up default printing style handling -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub _print_init { - my ($curproc, $args) = @_; + my ($curproc) = @_; $curproc->set_print_style( 'text' ); } # Descriptions: activate scheduler -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub scheduler_init { - my ($curproc, $args) = @_; + my ($curproc) = @_; use FML::Process::Scheduler; my $scheduler = new FML::Process::Scheduler $curproc; @@ -502,13 +502,13 @@ a side effect. # Descriptions: validate the sender address and do a few things # as a side effect -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: set the return value of $curproc->sender(). # stop the current process if needed. # Return Value: none sub verify_sender_credential { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $msg = $curproc->{'incoming_message'}; my $from = $msg->{'header'}->get('from'); @@ -1019,35 +1019,35 @@ The restriction rules follows the order of C<command_restrictions>. # Descriptions: permit this post process -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: set the error reason at "check_restriction" in pcb. # Return Value: NUM(1 or 0) sub permit_post { - my ($curproc, $args) = @_; - $curproc->_check_restrictions($args, 'post'); + my ($curproc) = @_; + $curproc->_check_restrictions('post'); } # Descriptions: permit this command process -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: set the error reason at "check_restriction" in pcb. # Return Value: NUM(1 or 0) sub permit_command { - my ($curproc, $args) = @_; - $curproc->_check_restrictions($args, 'command'); + my ($curproc) = @_; + $curproc->_check_restrictions('command'); } # Descriptions: permit this $type process based on the rules defined # in ${type}_restrictions. -# Arguments: OBJ($curproc) HASH_REF($args) STR($type) +# Arguments: OBJ($curproc) STR($type) # Side Effects: set the error reason at "check_restriction" n pcb. # Return Value: NUM(1 or 0) sub _check_restrictions { - my ($curproc, $args, $type) = @_; + my ($curproc, $type) = @_; my $config = $curproc->config(); my $cred = $curproc->{ credential }; # user credential my $pcb = $curproc->pcb(); @@ -1513,13 +1513,13 @@ sub _array_is_different # Descriptions: add the specified $msg into on memory queue -# Arguments: OBJ($curproc) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($curproc) OBJ($msg) HASH_REF($rm_args) # ARRAY_REF($recipient) ARRAY_REF($recipient_maps) OBJ($hdr) # Side Effects: update on momory queue which is on PCB area. # Return Value: none sub _append_message_into_queue { - my ($curproc, $msg, $args, $recipient, $recipient_maps, $hdr) = @_; + my ($curproc, $msg, $rm_args, $recipient, $recipient_maps, $hdr) = @_; my $pcb = $curproc->pcb(); my $category = 'reply_message'; my $class = 'queue'; @@ -1538,13 +1538,13 @@ sub _append_message_into_queue # Descriptions: add the specified $msg into on memory queue -# Arguments: OBJ($curproc) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($curproc) OBJ($msg) HASH_REF($rm_args) # ARRAY_REF($recipient) ARRAY_REF($recipient_maps) OBJ($hdr) # Side Effects: update on momory queue which is on PCB area. # Return Value: none sub _append_message_into_queue2 { - my ($curproc, $msg, $args, $recipient, $recipient_maps, $hdr) = @_; + my ($curproc, $msg, $rm_args, $recipient, $recipient_maps, $hdr) = @_; my $pcb = $curproc->pcb(); my $category = 'reply_message'; my $class = 'queue'; @@ -1576,12 +1576,12 @@ sub _append_message_into_queue2 # Descriptions: built and return recipient type and list in # on memory queue. -# Arguments: OBJ($curproc) OBJ($msg) HASH_REF($args) +# Arguments: OBJ($curproc) OBJ($msg) # Side Effects: none # Return Value: ARRAY( HASH_REF, HASH_REF ) sub _reply_message_recipient_keys { - my ($curproc, $msg, $args) = @_; + my ($curproc, $msg) = @_; my $pcb = $curproc->pcb(); my $category = 'reply_message'; my $class = 'queue'; @@ -1664,32 +1664,32 @@ This $args is passed through to reply_message(). # Descriptions: set reply message with translation to natual language -# Arguments: OBJ($curproc) STR($class) STR($default_msg) HASH_REF($args) +# Arguments: OBJ($curproc) STR($class) STR($default_msg) HASH_REF($rm_args) # Side Effects: none # Return Value: none sub reply_message_nl { - my ($curproc, $class, $default_msg, $args) = @_; + my ($curproc, $class, $default_msg, $rm_args) = @_; my $config = $curproc->config(); - my $buf = $curproc->message_nl($class, $default_msg, $args); + my $buf = $curproc->message_nl($class, $default_msg, $rm_args); $curproc->caller_info($class, caller) if $debug; if (defined $buf) { if ($buf =~ /\$/) { - $config->expand_variable_in_buffer(\$buf, $args); + $config->expand_variable_in_buffer(\$buf, $rm_args); } # XXX-TODO: jis-jp is hard-coded. eval q{ use Mail::Message::Encode; my $obj = new Mail::Message::Encode; - $curproc->reply_message( $obj->convert( $buf, 'jis-jp' ), $args); + $curproc->reply_message( $obj->convert( $buf, 'jis-jp' ), $rm_args); }; $curproc->logerror($@) if $@; } else { - $curproc->reply_message($default_msg, $args); + $curproc->reply_message($default_msg, $rm_args); } } @@ -1711,12 +1711,12 @@ sub reply_message_add_header_info # Descriptions: get template message in natual language -# Arguments: OBJ($curproc) STR($class) STR($default_msg) HASH_REF($args) +# Arguments: OBJ($curproc) STR($class) STR($default_msg) HASH_REF($m_args) # Side Effects: none # Return Value: STR sub message_nl { - my ($curproc, $class, $default_msg, $args) = @_; + my ($curproc, $class, $default_msg, $m_args) = @_; my $config = $curproc->config(); my $dir = $config->{ message_template_dir }; my $local_dir = $config->{ ml_local_message_template_dir }; @@ -1749,7 +1749,7 @@ sub message_nl if (defined $buf) { my $config = $curproc->config(); if ($buf =~ /\$/o) { - $config->expand_variable_in_buffer(\$buf, $args); + $config->expand_variable_in_buffer(\$buf, $m_args); } } @@ -1792,12 +1792,12 @@ Prepare the message and queue it in by C<Mail::Delivery::Queue>. # $r = get(message, queue) # msg = header + "text" + $r->[0] + $r->[1] + ... # -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: none sub inform_reply_messages { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $pcb = $curproc->pcb(); # We should classify reply messages by @@ -2208,13 +2208,13 @@ sub _add_info_on_header $msg->attr('X-ML-Name' => $ml_name); use FML::Header; - my $args = { + my $hrw_args = { type => 'MIME::Lite', message => $msg, }; - FML::Header->add_message_id($config, $args); - FML::Header->add_software_info($config, $args); - FML::Header->add_rfc2369($config, $args); + FML::Header->add_message_id($config, $hrw_args); + FML::Header->add_software_info($config, $hrw_args); + FML::Header->add_rfc2369($config, $hrw_args); } diff --git a/fml/lib/FML/Process/QMail.pm b/fml/lib/FML/Process/QMail.pm index 385738b7..7359521f 100644 --- a/fml/lib/FML/Process/QMail.pm +++ b/fml/lib/FML/Process/QMail.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: QMail.pm,v 1.17 2003/08/23 15:33:14 fukachan Exp $ +# $FML: QMail.pm,v 1.18 2003/08/29 15:34:09 fukachan Exp $ # package FML::Process::QMail; @@ -61,13 +61,13 @@ C<NOT YET IMPLERMENTED>. # Descriptions: qmail style command extention # elena-subscribe@domain implies # "mail message body with subscribe to elena-ctl@domain" -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: STR sub DotQmailExt { - my ($curproc, $args) = @_; - my $config = $curproc->config(); + my ($curproc) = @_; + my $config = $curproc->config(); # get ? my $ext = $ENV{'EXT'}; diff --git a/fml/lib/FML/Process/Utils.pm b/fml/lib/FML/Process/Utils.pm index 23f14731..994a9673 100644 --- a/fml/lib/FML/Process/Utils.pm +++ b/fml/lib/FML/Process/Utils.pm @@ -4,7 +4,7 @@ # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. # -# $FML: Utils.pm,v 1.98 2003/12/29 14:49:09 fukachan Exp $ +# $FML: Utils.pm,v 1.99 2003/12/30 03:46:35 fukachan Exp $ # package FML::Process::Utils; @@ -1199,7 +1199,7 @@ sub is_under_mta_process } -=head2 get_ml_list() +=head2 get_ml_list($ml_domain) get ARRAY_REF of valid mailing lists. @@ -1550,7 +1550,7 @@ sub get_accept_language_list } -=head2 thread_db_args($args) +=head2 thread_db_args() prepare and return information (HASH_REF) needed to manipulate thread database. @@ -1559,12 +1559,12 @@ database. # Descriptions: return information (HASH_REF) needed for thread database. -# Arguments: OBJ($curproc) HASH_REF($args) +# Arguments: OBJ($curproc) # Side Effects: none # Return Value: HASH_REF sub thread_db_args { - my ($curproc, $args) = @_; + my ($curproc) = @_; my $config = $curproc->config(); my $ml_name = $config->{ ml_name }; my $html_dir = $config->{ html_archive_dir }; |