preliminary implementation of thread GUI.

2 files changed, 483 insertions, 25 deletions

diff --git a/fml/lib/FML/Article/Thread.pm b/fml/lib/FML/Article/Thread.pm
index 8acdb0b4..821c4b7c 100644
--- a/fml/lib/FML/Article/Thread.pm
+++ b/fml/lib/FML/Article/Thread.pm
@@ -3,12 +3,14 @@
 # Copyright (C) 2003,2004 Ken'ichi Fukamachi
 #          All rights reserved.
 #
-# $FML: Thread.pm,v 1.4 2003/08/23 14:37:59 fukachan Exp $
+# $FML: Thread.pm,v 1.5 2004/03/28 13:04:31 fukachan Exp $
 #
 
 package FML::Article::Thread;
 
-use vars qw($debug @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use vars qw($debug @ISA @EXPORT @EXPORT_OK $AUTOLOAD
+	    $print_mode
+	    %print_switch);
 use strict;
 use Carp;
 
@@ -25,6 +27,20 @@ my $state_followed    = "followed";
 my $state_closed      = "closed";
 my $state_auto_closed = "closed(auto)";
 
+# DISPATCH TABLE
+$print_mode   = 'text';
+%print_switch = (
+		 text => {
+		     summary => \&psw_message_queue_text_summary_print,
+		     list    => \&psw_message_queue_text_list_print,
+		 },
+
+		 html => {
+		     summary => \&psw_message_queue_html_summary_print,
+		     list    => \&psw_message_queue_html_list_print,
+		 },
+		 );
+
 
 =head1 NAME
 
@@ -149,18 +165,22 @@ sub print_summary
 sub _print_summary
 {
     my ($self, $fp, $thread_args) = @_;
-    my $curproc  = $self->{ _curproc };
-    my $thread   = $self->{ _thread_object };
-    my $article  = $self->{ _article_object };
-    my $prompt   = ">>>";
+    my $curproc = $self->{ _curproc };
+    my $thread  = $self->{ _thread_object };
+    my $article = $self->{ _article_object };
+    my $queue   = [];
 
     # here we go.
     my $summary = $thread->get_thread_data($thread_args);
-    for my $head_id (sort {$a <=> $b} keys %$summary) {
-	my $list = $summary->{ $head_id } || [];
 
-	print "$prompt article $head_id (@$list)\n";
+  THREAD:
+    for my $head_id (sort {$a <=> $b} keys %$summary) {
+	# firstly check thread status.
+	my $status = $thread->get_thread_status($head_id) || "open";
+	next THREAD if $status eq $state_closed;
+	next THREAD if $status eq $state_auto_closed;
 
+	my $list = $summary->{ $head_id } || [];
 	for my $id (@$list) {
 	    my $article_path = $article->filepath($id);
 
@@ -169,14 +189,25 @@ sub _print_summary
 	    if (defined $fh) {
 		use Mail::Message;
 		my $msg = Mail::Message->parse(  { fd => $fh } );
-		print $msg->$fp();
-		print "\n";
+		my $buf = $msg->$fp();
+		my $q = {
+		    cur_id  => $id,
+		    head_id => $head_id,
+		    id_list => $list,
+		    status  => $status,
+		    summary => $buf,
+		    message => $msg,
+		};
+		push(@$queue, $q);
 	    }
 	    else {
 		$curproc->logerror("no such file: $article_path");
 	    }
 	}
     }
+
+    my $pfp = $print_switch{ $print_mode }->{ summary };
+    $self->$pfp($queue);
 }
 
 
@@ -198,25 +229,30 @@ list up thread and the related information.
 sub print_list
 {
     my ($self, $thread_args) = @_;
-    my $curproc  = $self->{ _curproc };
-    my $thread   = $self->{ _thread_object };
-    my $article  = $self->{ _article_object };
-    my $format   = "%-8s %-8d %s\n";
-
+    my $curproc = $self->{ _curproc };
+    my $thread  = $self->{ _thread_object };
+    my $article = $self->{ _article_object };
     my $summary = $thread->get_thread_data($thread_args);
+    my $queue   = [];
+
+  THREAD:
     for my $head_id (sort {$a <=> $b} keys %$summary) {
-	my $list   = $summary->{ $head_id } || [];
-	my $status = "open";
+	my $status = $thread->get_thread_status($head_id) || "open";
+	next THREAD if $status eq $state_closed;
+	next THREAD if $status eq $state_auto_closed;
 
-	if (@$list) {
-	    printf $format, $status, $head_id, join(" ", @$list);
-	}
-	else {
-	    printf $format, $status, $head_id, '';
-	}
+	my $list = $summary->{ $head_id } || [];
+	my $q = {
+	    head_id => $head_id,
+	    id_list => $list,
+	    status  => $status,
+	};
+	push(@$queue, $q);
     }
-}
 
+    my $pfp = $print_switch{ $print_mode }->{ list };
+    $self->$pfp($queue);
+}
 
 
 =head1 HANDLE STATUS
@@ -474,6 +510,194 @@ sub _change_thread_status
 }
 
 
+=head1 DEFAULT PRINT ENGINES
+
+=cut
+
+
+# Descriptions: set mode of output.
+#    Arguments: OBJ($self) STR($mode)
+# Side Effects: update package scope $print_mode variable.
+# Return Value: none
+sub set_print_style
+{
+    my ($self, $mode) = @_;
+
+    if (defined $mode) {
+	if ($mode eq 'text' || $mode eq 'html') {
+	    $print_mode = $mode;
+	}
+    }
+}
+
+
+# Descriptions: set mode of output.
+#    Arguments: OBJ($self) STR($key) STR($value)
+# Side Effects: update package scope %print_switch dispatcher table.
+# Return Value: none
+sub set_print_function
+{
+    my ($self, $key, $value) = @_;
+
+    if (ref($value) eq 'CODE') {
+	$print_switch{ $key } = $value;
+    }
+    else {
+	croak("set_print_function: invalid data");
+    }
+}
+
+
+# Descriptions: default print engine for summary.
+#    Arguments: OBJ($self)ARRAY_REF($queue)
+# Side Effects: none
+# Return Value: none
+sub psw_message_queue_text_summary_print
+{
+    my ($self, $queue) = @_;
+
+    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  = ">>>";
+
+	if ($cur_id && $head_id) {
+	    if ($head_id == $cur_id) {
+		print $wh "$prompt article thread";
+		print $wh " (@$id_list)";
+		print $wh " status=$status\n";
+	    }
+
+	    $summary =~ s/^\s*/   /;
+	    $summary =~ s/\n\s*/\n   /g;
+	    print $wh $summary;
+
+	    print $wh "\n";
+	}
+	else {
+	    carp("psw_message_queue_text_summary_print: invalid data");
+	}
+    }
+}
+
+
+# Descriptions: default print engine for list.
+#    Arguments: OBJ($self)ARRAY_REF($queue)
+# Side Effects: none
+# Return Value: none
+sub psw_message_queue_text_list_print
+{
+    my ($self, $queue) = @_;
+
+    for my $q (@$queue) {
+	my $head_id = $q->{ head_id } || '';	
+	my $id_list = $q->{ id_list } || [];
+	my $status  = $q->{ status }  || 'unknown';
+	my $wh      = $q->{ output_channel } || \*STDOUT;
+	my $format  = "%-12s %s\n";
+
+	if (@$id_list) {
+	    printf $wh $format, $status, join(" ", @$id_list);
+	}
+	else {
+	    printf $wh $format, $status, $head_id, '';
+	}
+    }
+}
+
+
+# Descriptions: default print engine for summary.
+#    Arguments: OBJ($self)ARRAY_REF($queue)
+# Side Effects: none
+# Return Value: none
+sub psw_message_queue_html_summary_print
+{
+    my ($self, $queue) = @_;
+    my $q  = $queue->[ 0 ] || {};
+    my $wh = $q->{ output_channel } || \*STDOUT;
+
+    print $wh "<table border=4>\n";
+
+    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 "<tr>\n";
+
+	if ($cur_id && $head_id) {
+	    if ($head_id == $cur_id) {
+		print $wh "<td> @$id_list";
+		print $wh "<td> $status\n";
+	    }
+	    else {
+		print $wh "<td>\n";
+		print $wh "<td>\n";
+	    }
+
+	    print $wh "<td>\n";
+	    $summary =~ s/^\s*/   /;
+	    $summary =~ s/\n\s*/\n   /g;
+	    print $wh $summary;
+
+	    print $wh "<BR>\n";
+	}
+	else {
+	    carp("psw_message_queue_html_summary_print: invalid data");
+	}
+    }
+
+    print $wh "</table>\n";
+}
+
+
+# Descriptions: default print engine for list.
+#    Arguments: OBJ($self)ARRAY_REF($queue)
+# Side Effects: none
+# Return Value: none
+sub psw_message_queue_html_list_print
+{
+    my ($self, $queue) = @_;
+    my $q  = $queue->[ 0 ] || {};
+    my $wh = $q->{ output_channel } || \*STDOUT;
+
+    print $wh "<table border=4>\n";
+
+    for my $q (@$queue) {
+	my $head_id = $q->{ head_id } || '';	
+	my $id_list = $q->{ id_list } || [];
+	my $status  = $q->{ status }  || 'unknown';
+	my $wh      = $q->{ output_channel } || \*STDOUT;
+
+	print $wh "<tr>\n";
+	if (@$id_list) {
+	    print $wh "<td>\n";
+	    print $wh  $status;
+	    print $wh "<td>\n";
+	    print $wh join(" ", @$id_list);
+	}
+	else {
+	    print $wh "<td>\n";
+	    print $wh  $status;
+	    print $wh "<td>\n";
+	    printf $wh $head_id;
+	}
+    }
+
+    print $wh "</table>\n";
+}
+
+
 =head1 CODING STYLE
 
 See C<http://www.fml.org/software/FNF/> on fml coding style guide.
diff --git a/fml/lib/FML/CGI/Thread.pm b/fml/lib/FML/CGI/Thread.pm
new file mode 100644
index 00000000..45c16231
--- /dev/null
+++ b/fml/lib/FML/CGI/Thread.pm
@@ -0,0 +1,234 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2004 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$
+#
+
+package FML::CGI::Thread;
+use strict;
+use Carp;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use CGI qw/:standard/; # load standard CGI routines
+
+use FML::Process::CGI;
+@ISA = qw(FML::Process::CGI);
+
+
+=head1 NAME
+
+FML::CGI::Thread - CGI details to control thread system
+
+=head1 SYNOPSIS
+
+    $obj = new FML::CGI::Thread;
+    $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::Thread> is a subclass of C<FML::Process::CGI>.
+
+=head1 METHODS
+
+Almost methods common for CGI or HTML are forwarded to
+C<FML::Process::CGI> base class.
+
+=cut
+
+
+# Descriptions: print out HTML header + body former part
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: none
+sub html_start
+{
+    my ($curproc) = @_;
+    my $config  = $curproc->config();
+    my $title   = $config->{ thread_cgi_title }   || 'thread system interface';
+    my $color   = $config->{ thread_cgi_bgcolor } || '#E6E6FA';
+    my $myname  = $curproc->myname();
+    my $charset = $curproc->get_charset("cgi");
+
+    # o.k start html
+    print start_html(-title   => $title,
+		     -lang    => $charset,
+		     -BGCOLOR => $color);
+    print "\n";
+}
+
+
+# Descriptions: print out body latter part
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: none
+sub html_end
+{
+    my ($curproc) = @_;
+
+    # o.k. end of html
+    print end_html;
+    print "\n";
+}
+
+
+# Descriptions: currently, dummy.
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: none
+sub run_cgi_main
+{
+    my ($curproc) = @_;
+}
+
+
+# Descriptions: main routine for thread control.
+#               run_cgi() can process request: list, show, change_status
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: none
+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;
+    my $default_range = 'last:10';
+    my $th_args       = {
+	last_id => $max_id,
+    };
+
+    print "<!-- exec run_cgi_menu start -->\n";
+
+    use FML::Article::Thread;
+    my $article_thread = new FML::Article::Thread $curproc;
+    $article_thread->set_print_style('html');
+
+    if ($command eq 'one_line_summary') {
+	$th_args->{ range } = $range || $default_range;
+	$article_thread->print_one_line_summary($th_args);
+    }
+    elsif ($command eq 'summary') {
+	$th_args->{ range } = $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);
+	$curproc->ui_message("error: $r");
+    }
+
+    print "<!-- exec run_cgi_menu end -->\n";
+}
+
+
+# Descriptions: print navigation bar
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: none
+sub run_cgi_navigator
+{
+    my ($curproc) = @_;
+    my $config    = $curproc->config();
+    my $action    = $curproc->cgi_var_action();
+    my $target    = $curproc->cgi_var_frame_target();
+    my $ml_list   = $curproc->cgi_var_ml_name_list();
+    my $ml_name   = $curproc->cgi_var_ml_name();
+
+    # natural language-ed name
+    my $name_ml_name = $curproc->message_nl('term.ml_name', 'ml_name');
+    my $name_command = $curproc->message_nl('term.command', 'command');
+    my $name_change  = $curproc->message_nl('term.change',  'change');
+    my $name_reset   = $curproc->message_nl('term.reset',   'reset');
+
+    print start_form(-action=>$action, -target=>$target);
+    print $curproc->cgi_hidden_info_language();
+    print $name_ml_name, ":\n";
+    print popup_menu(-name   => 'ml_name', -values => $ml_list);
+    print "<BR>\n";
+
+    if (0) {
+	print "orderd by: ";
+	my $order = [ 'cost', 'date', 'reverse date' ];
+	print popup_menu(-name   => 'order', -values => $order );
+	print "<BR>\n";
+    }
+
+    # 3. submit
+    print submit(-name => $name_change);
+    print reset(-name  => $name_reset);
+
+    print end_form;
+    print "<HR>\n";
+}
+
+
+sub run_cgi_help
+{
+    print "thread.cgi help\n";
+}
+
+
+sub run_cgi_command_help
+{
+    print "thread.cgi command help\n";
+}
+
+
+=head1 SEE ALSO
+
+L<CGI>,
+L<FML::Process::CGI>
+and
+L<FML::Process::Flow>
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2004 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::Thread first appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;