modify message output engine.

enable close operation.

2 files changed, 225 insertions, 29 deletions

diff --git a/fml/lib/FML/Article/Thread.pm b/fml/lib/FML/Article/Thread.pm
index 9d005f48..5558ee84 100644
--- a/fml/lib/FML/Article/Thread.pm
+++ b/fml/lib/FML/Article/Thread.pm
@@ -3,7 +3,7 @@
 # Copyright (C) 2003,2004 Ken'ichi Fukamachi
 #          All rights reserved.
 #
-# $FML: Thread.pm,v 1.6 2004/03/29 14:22:17 fukachan Exp $
+# $FML: Thread.pm,v 1.7 2004/03/31 02:49:48 fukachan Exp $
 #
 
 package FML::Article::Thread;
@@ -207,7 +207,7 @@ sub _print_summary
     }
 
     my $pfp = $print_switch{ $print_mode }->{ summary };
-    $self->$pfp($queue);
+    $self->$pfp($curproc, $queue);
 }
 
 
@@ -251,7 +251,7 @@ sub print_list
     }
 
     my $pfp = $print_switch{ $print_mode }->{ list };
-    $self->$pfp($queue);
+    $self->$pfp($curproc, $queue);
 }
 
 
@@ -469,7 +469,7 @@ sub open_thread_status
 {
     my ($self, $thread_args) = @_;
 
-    $self->_change_thread_status($thread_args, $state_open);
+    $self->_change_thread_status("open", $thread_args, $state_open);
 }
 
 
@@ -481,17 +481,17 @@ sub close_thread_status
 {
     my ($self, $thread_args) = @_;
 
-    $self->_change_thread_status($thread_args, $state_closed);
+    $self->_change_thread_status("close", $thread_args, $state_closed);
 }
 
 
 # Descriptions: open/close thread with the specified range.
-#    Arguments: OBJ($self) HASH_REF($thread_args) STR($state)
+#    Arguments: OBJ($self) STR($action) HASH_REF($thread_args) STR($state)
 # Side Effects: update UDB.
 # Return Value: none
 sub _change_thread_status
 {
-    my ($self, $thread_args, $state) = @_;
+    my ($self, $action, $thread_args, $state) = @_;
     my $curproc = $self->{ _curproc };
     my $thread  = $self->{ _thread_object };
     my $article = $self->{ _article_object };
@@ -504,7 +504,7 @@ sub _change_thread_status
     my $tail_id = $id_list->[ 0 ] || 1;
 
     for my $id (@$id_list) {
-	$curproc->log("close thread $id");
+	$curproc->log("$action thread $id");
 	$thread->set_thread_status($id, $state);
     }
 }
@@ -540,7 +540,7 @@ sub set_print_function
     my ($self, $key, $value) = @_;
 
     if (ref($value) eq 'CODE') {
-	$print_switch{ $key } = $value;
+	$print_switch{ $print_mode }->{ $key } = $value;
     }
     else {
 	croak("set_print_function: invalid data");
@@ -549,12 +549,12 @@ sub set_print_function
 
 
 # Descriptions: default print engine for summary.
-#    Arguments: OBJ($self) ARRAY_REF($queue)
+#    Arguments: OBJ($self) OBJ($curproc) ARRAY_REF($queue)
 # Side Effects: none
 # Return Value: none
 sub psw_message_queue_text_summary_print
 {
-    my ($self, $queue) = @_;
+    my ($self, $curproc, $queue) = @_;
 
     for my $q (@$queue) {
 	my $cur_id  = $q->{ cur_id }  || '';
@@ -587,12 +587,12 @@ sub psw_message_queue_text_summary_print
 
 
 # Descriptions: default print engine for list.
-#    Arguments: OBJ($self) ARRAY_REF($queue)
+#    Arguments: OBJ($self) OBJ($curproc) ARRAY_REF($queue)
 # Side Effects: none
 # Return Value: none
 sub psw_message_queue_text_list_print
 {
-    my ($self, $queue) = @_;
+    my ($self, $curproc, $queue) = @_;
 
     for my $q (@$queue) {
 	my $head_id = $q->{ head_id } || '';	
@@ -612,12 +612,12 @@ sub psw_message_queue_text_list_print
 
 
 # Descriptions: default print engine for summary.
-#    Arguments: OBJ($self) ARRAY_REF($queue)
+#    Arguments: OBJ($self) OBJ($curproc) ARRAY_REF($queue)
 # Side Effects: none
 # Return Value: none
 sub psw_message_queue_html_summary_print
 {
-    my ($self, $queue) = @_;
+    my ($self, $curproc, $queue) = @_;
     my $q  = $queue->[ 0 ] || {};
     my $wh = $q->{ output_channel } || \*STDOUT;
 
@@ -662,12 +662,12 @@ sub psw_message_queue_html_summary_print
 
 
 # Descriptions: default print engine for list.
-#    Arguments: OBJ($self) ARRAY_REF($queue)
+#    Arguments: OBJ($self) OBJ($curproc) ARRAY_REF($queue)
 # Side Effects: none
 # Return Value: none
 sub psw_message_queue_html_list_print
 {
-    my ($self, $queue) = @_;
+    my ($self, $curproc, $queue) = @_;
     my $q  = $queue->[ 0 ] || {};
     my $wh = $q->{ output_channel } || \*STDOUT;
 
diff --git a/fml/lib/FML/CGI/Thread.pm b/fml/lib/FML/CGI/Thread.pm
index 839de137..8fc28f31 100644
--- a/fml/lib/FML/CGI/Thread.pm
+++ b/fml/lib/FML/CGI/Thread.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: Thread.pm,v 1.1 2004/03/29 14:22:15 fukachan Exp $
+# $FML: Thread.pm,v 1.2 2004/03/31 04:08:42 fukachan Exp $
 #
 
 package FML::CGI::Thread;
@@ -92,6 +92,25 @@ sub html_end
 sub run_cgi_main
 {
     my ($curproc) = @_;
+    my $max_id    = $curproc->article_max_id();
+    my $cur_id    = $curproc->safe_param_article_id() || 0;
+    my $range     = $cur_id;
+    my $th_args   = {
+	last_id => $max_id,
+    };
+
+    if ($cur_id) {
+	use FML::Article::Thread;
+	my $article_thread = new FML::Article::Thread $curproc;
+	$article_thread->set_print_style('html');
+
+	# interpret subcommand e.g. "close" / "open".
+	my $command = $curproc->safe_param_command() || '';
+	if ($command eq 'close') {
+	    $th_args->{ range } = $range || '';
+	    $article_thread->close_thread_status($th_args);
+	}
+    }
 }
 
 
@@ -106,7 +125,6 @@ sub run_cgi_menu
     my ($curproc)     = @_;
     my $myname        = $curproc->myname();
     my $ml_name       = $curproc->cgi_var_ml_name() || '';
-    my $command       = $curproc->cgi_var_action()  || 'summary';
     my $max_id        = $curproc->article_max_id();
     my $cur_id        = $curproc->safe_param_article_id();
     my $range         = $cur_id;
@@ -115,6 +133,11 @@ sub run_cgi_menu
 	last_id => $max_id,
     };
 
+    # specified command, we need to identify
+    # the command specifined in the cgi_navigation and cgi_mein.
+    my $navi_command = $curproc->safe_param_navi_command() || '';
+    my $command      = $curproc->safe_param_command()      || 'summary';
+
     print "<!-- exec run_cgi_menu start -->\n";
 
     unless ($ml_name) {
@@ -125,6 +148,10 @@ sub run_cgi_menu
 	my $article_thread = new FML::Article::Thread $curproc;
 	$article_thread->set_print_style('html');
 
+	# set print engine to my owe one.
+	my $fp = \&__psw_message_queue_html_summary_print;
+	$article_thread->set_print_function('summary', $fp);
+
 	if ($command eq 'one_line_summary') {
 	    $th_args->{ range } = $range || $default_range;
 	    $article_thread->print_one_line_summary($th_args);
@@ -133,19 +160,16 @@ sub run_cgi_menu
 	    $th_args->{ range } = $range || $default_range;
 	    $article_thread->print_summary($th_args);
 	}
+	elsif ($command eq 'close' || $command eq 'open' ||
+	       $command eq 'reopen' ) {
+	    $th_args->{ range } = $default_range;
+	    $article_thread->print_summary($th_args);
+	}
 	elsif ($command eq 'list') {
 	    $th_args->{ range } = $range || '';
 	    $article_thread->print_list($th_args);
 	    # $article_thread->print_one_line_summary($th_args);
 	}
-	elsif ($command eq 'open' || $command eq 'reopen') {
-	    $th_args->{ range } = $range || '';
-	    $article_thread->open_thread_status($th_args);
-	}
-	elsif ($command eq 'close') {
-	    $th_args->{ range } = $range || '';
-	    $article_thread->close_thread_status($th_args);
-	}
 	else {
 	    my $r = "unknown subcommand: thread $command";
 	    $curproc->logerror($r);
@@ -198,15 +222,187 @@ sub run_cgi_navigator
 }
 
 
+# Descriptions: show help
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: none
 sub run_cgi_help
 {
-    print "thread.cgi help\n";
+    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();
+    my $role      = $curproc->message_nl('term.thread_interface');
+    my $msg_args  = $curproc->_gen_msg_args();
+
+    print "<B>\n<CENTER>\n";
+    if ($mode eq 'admin') {
+	print "fml CGI $role for \@$ml_domain ML's\n";
+    }
+    else {
+	print "fml CGI $role for $ml_name\@$ml_domain ML\n";
+    }
+    print "</CENTER><BR>\n</B>\n";
+
+    # top level help message
+    my $buf  = '';
+    if ($mode eq 'admin') {
+	$buf = $curproc->message_nl("cgi.admin.top", "", $msg_args);
+    }
+    else {
+	$buf = $curproc->message_nl("cgi.ml-admin.top", "", $msg_args);
+    }
+
+    print $buf;
 }
 
 
+=head2 run_cgi_command_help()
+
+command_help.
+
+=cut
+
+
+# Descriptions: show thread command dependent help.
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: none
 sub run_cgi_command_help
 {
-    print "thread.cgi command help\n";
+    my ($curproc)    = @_;
+    my $buf          = '';
+    my $navi_command = $curproc->safe_param_navi_command() || '';
+    my $command      = $curproc->safe_param_command() || 'summary';
+    my $msg_args     = $curproc->_gen_msg_args();
+
+    # re-define: open|close -> summary.
+    if ($command =~ /close|open/) { $command = 'summary';}
+
+    # natural language-ed name
+    my $name_usage   = $curproc->message_nl('term.usage',  'usage');
+
+    if ($navi_command) {
+	print "[$name_usage]<br> <b> $navi_command </b> <br>\n";
+	$buf = $curproc->message_nl("cgi.thread.$navi_command", '', $msg_args);
+    }
+    elsif ($command) {
+	print "[$name_usage]<br> <b> $command </b> <br>\n";
+	$buf = $curproc->message_nl("cgi.thread.$command", '', $msg_args);
+    }
+
+    print $buf;
+}
+
+
+# Descriptions: prepare arguemnts for message handling.
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: HASH_REF
+sub _gen_msg_args
+{
+    my ($curproc) = @_;
+
+    # natural language-ed name
+    my $name_submit = $curproc->message_nl('term.submit', 'submit');
+    my $name_show   = $curproc->message_nl('term.show',   'show');
+    my $name_map    = $curproc->message_nl('term.map',    'map');
+    my $msg_args    = {
+	_arg_button_submit => $name_submit,
+	_arg_button_show   => $name_show,
+	_arg_scroll_map    => $name_map,
+    };
+
+    return $msg_args;
+}
+
+
+
+#
+# THIS MODULE SPECIFIC METHODS
+#
+
+
+# Descriptions: print summary.
+#               See templates within FML::Article::Thread class.
+#    Arguments: OBJ($self) OBJ($curproc) ARRAY_REF($queue)
+# Side Effects: none
+# Return Value: none
+sub __psw_message_queue_html_summary_print
+{
+    my ($self, $curproc, $queue) = @_;
+    my $q       = $queue->[ 0 ] || {};
+    my $wh      = $q->{ output_channel } || \*STDOUT;
+    my $target  = $curproc->cgi_var_frame_target();
+    my $action  = $curproc->cgi_var_action();
+    my $ml_name = $curproc->cgi_var_ml_name();
+
+    # debug
+    print "debug: queue length = ", ($#$queue + 1), "\n";
+
+    # terms
+    my $term_article = $curproc->message_nl('term.article', 'article(s)');
+    my $term_status  = $curproc->message_nl('term.status', 'status');
+    my $term_change  = $curproc->message_nl('term.status_change',
+					    'change status');
+    my $term_summary = $curproc->message_nl('term.thread_summary',
+					    'thread summary');
+
+    print $wh "<table border=4>\n";
+    print $wh "<td> $term_article </td>\n";
+    print $wh "<td> $term_status  </td>\n";
+    print $wh "<td> $term_change  </td>\n";
+    print $wh "<td> $term_summary </td>\n";
+    print $wh "</tr>\n";
+
+    my $buf;
+    for my $q (@$queue) {
+	my $cur_id  = $q->{ cur_id }  || '';
+	my $head_id = $q->{ head_id } || '';	
+	my $id_list = $q->{ id_list } || [];
+	my $status  = $q->{ status }  || 'unknown';
+	my $summary = $q->{ summary } || '';
+	my $msg     = $q->{ message } || undef;
+	my $wh      = $q->{ output_channel } || \*STDOUT;
+	my $prompt  = "";
+
+	print $wh "<!-- cur_id=$cur_id head_id=$head_id -->\n";
+	print $wh "<tr>\n";
+
+	if ($cur_id && $head_id) {
+	    if ($head_id == $cur_id) {
+		$buf  = start_form(-action=>$action, -target=>$target);
+		$buf .= hidden(-name=>'article_id',-value=>$head_id,
+			       -override=>1);
+		$buf .= hidden(-name=>'ml_name',-value=>$ml_name,-override=>1);
+		$buf .= hidden(-name=>'command',-value=>'close',-override=>1);
+		$buf .= submit(-name => '-> close');
+
+		print $wh "<td>\n @$id_list \n</td>\n";
+		print $wh "<td>\n $status   \n</td>\n";
+		print $wh "<td>\n $buf      \n</td>\n";
+	    }
+	    else {
+		print $wh "<td> </td>\n";
+		print $wh "<td> </td>\n";
+		print $wh "<td> </td>\n";
+	    }
+
+	    print $wh "<td>\n";
+	    $summary =~ s/^\s*/   /;
+	    $summary =~ s/\n\s*/\n   /g;
+	    print $wh $summary;
+
+	    print $wh "</td>\n";
+	}
+	else {
+	    carp("psw_message_queue_html_summary_print: invalid data");
+	}
+
+	print $wh "</tr>\n";
+    }
+
+    print $wh "</table>\n";
 }