summaryrefslogtreecommitdiff
path: root/fml/lib/FML/CGI/Admin/Menu.pm
diff options
context:
space:
mode:
Diffstat (limited to 'fml/lib/FML/CGI/Admin/Menu.pm')
-rw-r--r--fml/lib/FML/CGI/Admin/Menu.pm340
1 files changed, 340 insertions, 0 deletions
diff --git a/fml/lib/FML/CGI/Admin/Menu.pm b/fml/lib/FML/CGI/Admin/Menu.pm
new file mode 100644
index 00000000..b2f544fc
--- /dev/null
+++ b/fml/lib/FML/CGI/Admin/Menu.pm
@@ -0,0 +1,340 @@
+#-*- perl -*-
+#
+# Copyright (C) 2001 Ken'ichi Fukamachi
+# All rights reserved. This program is free software; you can
+# redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML: Configure.pm,v 1.9 2001/12/23 11:39:44 fukachan Exp $
+#
+
+package FML::CGI::Admin::Menu;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+use CGI qw/:standard/; # load standard CGI routines
+
+use FML::Process::CGI;
+@ISA = qw(FML::Process::CGI);
+
+
+=head1 NAME
+
+FML::CGI::Admin::Menu - provides functions for makefml CGI interface
+
+=head1 SYNOPSIS
+
+ $obj = new FML::CGI::Admin::Menu;
+ $obj->prepare();
+ $obj->verify_request();
+ $obj->run();
+ $obj->finish();
+
+run() executes html_start(), run_cgi() and html_end() described below.
+
+See L<FML::Process::Flow> for flow details.
+
+=head1 DESCRIPTION
+
+=head2 CLASS HIERARCHY
+
+C<FML::CGI::Admin::Menu> is a subclass of C<FML::Process::CGI>.
+
+ FML::Process::Kernel
+ |
+ A
+ FML::Process::CGI
+ |
+ A
+ -----------------------
+ | |
+ A A
+ FML::CGI::Admin::Menu
+
+=head1 METHODS
+
+Almost methods common for CGI or HTML are forwarded to
+C<FML::Process::CGI> base class.
+
+This module has routines needed for CGI.
+
+=cut
+
+
+# Descriptions: print out HTML header + body former part
+# Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: none
+# Return Value: none
+sub html_start
+{
+ my ($curproc, $args) = @_;
+ my $myname = $curproc->myname();
+ my $ml_name = $curproc->safe_param_ml_name();
+ my $title = "$ml_name configuration interface";
+ my $color = '#E6E6FA';
+ my $charset = 'euc-jp';
+
+ # o.k start html
+ print start_html(-title=>$title,
+ -lang => $charset,
+ -BGCOLOR=>$color);
+ print "\n";
+}
+
+
+# Descriptions: print out body latter part
+# Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: none
+# Return Value: none
+sub html_end
+{
+ my ($curproc, $args) = @_;
+
+ # o.k. end of html
+ print end_html;
+ print "\n";
+}
+
+
+sub _try_get_address
+{
+ my ($curproc, $args) = @_;
+ my $address = '';
+ my $a = '';
+
+ eval q{ $a = $curproc->safe_param_address_specified();};
+ unless ($@) {
+ $address = $a;
+ }
+ else {
+ # XXX longjmp() if insecure input is given.
+ my $r = $@;
+ if ($r =~ /ERROR\.INSECURE/) { croak($r);}
+
+ eval q{ $a = $curproc->safe_param_address_selected();};
+ unless ($@) {
+ $address = $a;
+ }
+ else {
+ # XXX longjmp() if insecure input is given.
+ my $r = $@;
+ if ($r =~ /ERROR\.INSECURE/) { croak($r);}
+ }
+ }
+
+ return $address;
+}
+
+
+
+# Descriptions: show help
+# Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: none
+# Return Value: none
+sub run_cgi_help
+{
+ my ($curproc, $args) = @_;
+ my $domain = $curproc->default_domain();
+
+ print "<B>\n";
+ print "fml CGI interface for \@$domain ML's\n";
+ print "</B>\n";
+}
+
+
+# Descriptions: main routine for makefml.cgi.
+# kick off suitable FML::Command finally via _execulte_command().
+# Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: none
+# Return Value: none
+sub run_cgi_main
+{
+ my ($curproc, $args) = @_;
+ my $command = $curproc->safe_param_command() || '';
+ my $address = $curproc->_try_get_address($args);
+
+ if ($command && $address) {
+ my $ml_name = $curproc->safe_param_ml_name();
+ my $command_args = {
+ command_mode => 'admin',
+ comname => $command,
+ command => $command,
+ ml_name => $ml_name,
+ options => [ $address ],
+ argv => undef,
+ args => undef,
+ };
+ $curproc->_execute_command($args, $command_args);
+
+ print hr;
+ $curproc->_show_menu($args);
+ }
+ else {
+ my $ml_name = $curproc->safe_param_ml_name();
+
+ if ($ml_name) {
+ $curproc->_show_menu($args);
+ }
+ else {
+ $curproc->run_cgi_help($args);
+ }
+ }
+}
+
+
+# Descriptions: execute FML::Command
+# Arguments: OBJ($curproc) HASH_REF($args) HASH_REF($command_args)
+# Side Effects: load module
+# Return Value: none
+sub _execute_command
+{
+ my ($curproc, $args, $command_args) = @_;
+
+ use FML::Command;
+ my $obj = new FML::Command;
+ if (defined $obj) {
+ my $comname = $command_args->{ comname };
+ eval q{
+ $obj->$comname($curproc, $command_args);
+ };
+ unless ($@) {
+ print "OK! $comname succeed.\n";
+ }
+ else {
+ print "Error! $comname fails.\n<BR>\n";
+ if ($@ =~ /^(.*)\s+at\s+/) {
+ my $reason = $@;
+ print "<BR>\n";
+ print $1;
+ print "<BR>\n";
+ print $reason;
+ print "<BR>\n";
+ }
+ }
+ }
+}
+
+
+# Descriptions: show menu
+# 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) = @_;
+ 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 $command_list =
+ $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";
+ }
+
+ print start_form(-action=>$action, -target=>$target);
+
+ print "Go to: <BR>\n";
+ print popup_menu(-name => 'ml_name', -values => $ml_list);
+ print "\n<BR>\n";
+
+ print submit(-name => 'change');
+ print reset(-name => 'reset');
+
+ print end_form;
+}
+
+
+=head1 SEE ALSO
+
+L<CGI>,
+L<FML::Process::CGI>
+and
+L<FML::Process::Flow>
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::CGI::Admin::Menu appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
generated by cgit v1.2.1 (git 2.18.0) at 2026-09-01 17:19:13 +0000