o prepend cgi_ or run_cgi to function name.

o implement trampoline mechanism using FML::Command: class.
o change: pop_menu -> scrolling_list

2 files changed, 56 insertions, 78 deletions

diff --git a/fml/lib/FML/CGI/Admin/Menu.pm b/fml/lib/FML/CGI/Admin/Menu.pm
index 117eb909..a522728f 100644
--- a/fml/lib/FML/CGI/Admin/Menu.pm
+++ b/fml/lib/FML/CGI/Admin/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.3 2002/03/18 14:19:41 fukachan Exp $
+# $FML: Menu.pm,v 1.4 2002/03/18 15:21:31 fukachan Exp $
 #
 
 package FML::CGI::Admin::Menu;
@@ -123,7 +123,7 @@ sub run_cgi_main
 {
     my ($curproc, $args) = @_;
     my $command = $curproc->safe_param_command() || '';
-    my $address = $curproc->try_get_address($args);
+    my $address = $curproc->cgi_try_get_address($args);
 
     if ($command && $address) {
 	my $ml_name      = $curproc->safe_param_ml_name();
@@ -139,13 +139,16 @@ sub run_cgi_main
 	$curproc->cgi_execute_command($args, $command_args);
 
 	print hr;
-	$curproc->_show_menu($args);
+	$curproc->run_cgi_menu($args, $command);
+    }
+    elsif ($command) {
+	$curproc->run_cgi_menu($args, $command);
     }
     else {
 	my $ml_name = $curproc->safe_param_ml_name();
 
 	if ($ml_name) {
-	    $curproc->_show_menu($args);
+	    $curproc->run_cgi_help($args);
 	}
 	else {
 	    $curproc->run_cgi_help($args);
@@ -158,67 +161,6 @@ sub run_cgi_main
 #    Arguments: OBJ($curproc) HASH_REF($args)
 # Side Effects: none
 # Return Value: none
-sub _show_menu
-{
-    my ($curproc, $args) = @_;
-    my $action  = $curproc->myname();
-    my $target  = '_top';
-    my $ml_list = $curproc->get_ml_list($args);
-    my $address = $curproc->safe_param_address() || '';
-    my $config  = $curproc->{ config };
-
-    # 
-    my $address_list = $curproc->get_recipient_list();
-    my $command_list = 
-	$config->get_as_array_ref('available_commands_for_admin_cgi');
-
-
-    print start_form(-action=>$action, -target=>$target);
-
-    print table( { -border => undef },
-		Tr( undef, 
-		   td([
-		       "ML: ",
-		      popup_menu(-name => 'ml_name', -values => $ml_list)
-		      ])
-		   ),
-		Tr( undef, 
-		   td([
-		       "command: ",
-		       popup_menu(-name => 'command', -values => $command_list)
-		       ])
-		   ),
-		Tr( undef,
-		   td([
-		       "address: ",
-		       textfield(-name      => 'address_specified',
-				 -default   => $address,
-				 -override  => 1,
-				 -size      => 32,
-				 -maxlength => 64,
-				 )
-		       ])
-		   ),
-		Tr( undef,
-		   td([
-		       "",
-		       popup_menu(-name   => 'address_selected', 
-				  -values => $address_list)
-		       ]),
-		   )
-		);
-
-
-    print submit(-name => 'submit');
-    print reset(-name  => 'reset');
-    print end_form;
-}
-
-
-# Descriptions: show menu
-#    Arguments: OBJ($curproc) HASH_REF($args)
-# Side Effects: none
-# Return Value: none
 sub run_cgi_navigator
 {
     my ($curproc, $args) = @_;
@@ -231,19 +173,26 @@ sub run_cgi_navigator
 	$config->get_as_array_ref('available_commands_for_admin_cgi');
 
     # main menu
-    {
-	my $ml_name = $curproc->safe_param_ml_name() || '?';
-	print "<B>fml admin menu</B>\n<BR>\n";
-	print "ML: $ml_name\n<BR>\n";
-    }
+    my $ml_name = $curproc->safe_param_ml_name() || '?';
+    my $fml_url = '<A HREF="http://www.fml.org/software/fml-devel/">fml</A>';
+    print "<B>$fml_url admin menu</B>\n<BR>\n";
 
     print start_form(-action=>$action, -target=>$target);
 
-    print "Go to: <BR>\n";
-    print popup_menu(-name => 'ml_name', -values => $ml_list);
+    print "mailing list:\n";
+    print scrolling_list(-name    => 'ml_name', 
+			 -values  => $ml_list,
+			 -default => $ml_name,
+			 -size    => 5);
+    print "\n<BR>\n";
+
+    print "  command:\n";
+    print scrolling_list(-name   => 'command', 
+			 -values => $command_list,
+			 -size   => 5);
     print "\n<BR>\n";
 
-    print submit(-name => 'change');
+    print submit(-name => 'submit');
     print reset(-name  => 'reset');
 
     print end_form;
diff --git a/fml/lib/FML/Process/CGI/Kernel.pm b/fml/lib/FML/Process/CGI/Kernel.pm
index 1ac6e6e1..2034af54 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.16 2002/03/18 13:52:20 fukachan Exp $
+# $FML: Kernel.pm,v 1.17 2002/03/18 15:21:33 fukachan Exp $
 #
 
 package FML::Process::CGI::Kernel;
@@ -341,8 +341,6 @@ sub cgi_execute_command
 	    if ($@ =~ /^(.*)\s+at\s+/) {
 		my $reason = $@;
 		print "<BR>\n";
-		print $1;
-		print "<BR>\n";
 		print $reason;
 		print "<BR>\n";
 	    }
@@ -351,7 +349,35 @@ sub cgi_execute_command
 }
 
 
-=head2 try_get_address()
+=head2 run_cgi_menu($args, $comname, $command_args)
+
+execute cgi_menu() given as FML::Command::*
+
+=cut
+
+
+# Descriptions: execute FML::Command
+#    Arguments: OBJ($curproc) HASH_REF($args) HASH_REF($command_args)
+# Side Effects: load module
+# Return Value: none
+sub run_cgi_menu
+{
+    my ($curproc, $args, $comname, $command_args) = @_;
+    my $cmd = "FML::Command::Admin::$comname";
+    my $obj = undef;
+
+    eval qq{ 
+	use $cmd; 
+	\$obj = new $cmd;
+    };
+
+    if (defined $obj) {
+	$obj->cgi_menu($curproc, $args, $command_args);
+    }
+}
+
+
+=head2 cgi_try_get_address()
 
 return input address after validating the input
 
@@ -362,7 +388,7 @@ return input address after validating the input
 #    Arguments: OBJ($curproc) HASH_REF($args)
 # Side Effects: longjmp() if critical error occurs.
 # Return Value: STR
-sub try_get_address
+sub cgi_try_get_address
 {
     my ($curproc, $args) = @_;
     my $address = '';
@@ -376,7 +402,10 @@ sub try_get_address
 	# XXX longjmp() if insecure input is given.
 	my $r = $@;
 	if ($r =~ /ERROR\.INSECURE/) { croak($r);}
+    }
 
+    # retry !
+    unless ($a) {
 	eval q{ $a = $curproc->safe_param_address_selected();};
 	unless ($@) {
 	    $address = $a;