fmlthread -f filterlist ...

3 files changed, 69 insertions, 8 deletions

diff --git a/fml/lib/FML/Process/Switch.pm b/fml/lib/FML/Process/Switch.pm
index 6299c33b..92d528a1 100644
--- a/fml/lib/FML/Process/Switch.pm
+++ b/fml/lib/FML/Process/Switch.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: Switch.pm,v 1.27 2001/11/05 12:26:38 fukachan Exp $
+# $FML: Switch.pm,v 1.28 2001/11/05 13:02:35 fukachan Exp $
 #
 
 package FML::Process::Switch;
@@ -342,7 +342,7 @@ sub _module_specific_options
 	return qw(ctladdr! debug! params=s -c=s);
     }
     elsif ($myname eq 'fmlthread'|| $myname eq 'fmlthread.cgi') {
-	return qw(debug! params=s -c=s -A=s -R=s);
+	return qw(debug! params=s -f=s -c=s -A=s -R=s);
     }
     elsif ($myname eq 'fmlconf') {
 	return qw(debug! params=s -c=s n!);
diff --git a/fml/lib/FML/Process/ThreadTrack.pm b/fml/lib/FML/Process/ThreadTrack.pm
index a2341122..48d5e392 100644
--- a/fml/lib/FML/Process/ThreadTrack.pm
+++ b/fml/lib/FML/Process/ThreadTrack.pm
@@ -4,7 +4,7 @@
 # Copyright (C) 2000-2001 Ken'ichi Fukamachi
 #          All rights reserved. 
 #
-# $FML: ThreadTrack.pm,v 1.5 2001/11/05 14:35:48 fukachan Exp $
+# $FML: ThreadTrack.pm,v 1.6 2001/11/06 22:52:27 fukachan Exp $
 #
 
 package FML::Process::ThreadTrack;
@@ -75,6 +75,7 @@ sub run
     my ($curproc, $args) = @_;
     my $config  = $curproc->{ config };
     my $argv    = $curproc->command_line_argv();
+    my $options = $curproc->command_line_options();
     my $command = $argv->[ 0 ] || '';
 
     #  argumente for thread track module
@@ -94,6 +95,10 @@ sub run
     my $thread = new Mail::ThreadTrack $ttargs;
     $thread->set_mode('text');
 
+    if (defined $options->{ f }) {
+	_read_filter_list($thread, $options->{ f });
+    }
+
     $curproc->lock();
 
     if ($command eq 'list' || $command eq 'summary') {
@@ -128,6 +133,28 @@ sub run
 }
 
 
+sub _read_filter_list
+{
+    my ($thread, $file) = @_;
+
+    if (-f $file) {
+	use FileHandle;
+	my $fh = new FileHandle $file;
+	if (defined $fh) {
+	    my ($key, $value);
+	    while (<$fh>) {
+		chop;
+		($key, $value) = split(/\s+/, $_, 2);
+		if ($key) {
+		    $thread->add_filter( { $key => $value });
+		}
+	    }
+	    $fh->close();
+	}
+    }
+}
+
+
 # $thread_id accepts MH style format.
 # MH style is expanded by C<Mail::Messsage::MH>.
 sub _close
diff --git a/fml/lib/Mail/ThreadTrack/Analyze.pm b/fml/lib/Mail/ThreadTrack/Analyze.pm
index 242aab17..1f838cbf 100644
--- a/fml/lib/Mail/ThreadTrack/Analyze.pm
+++ b/fml/lib/Mail/ThreadTrack/Analyze.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: Analyze.pm,v 1.9 2001/11/04 04:43:18 fukachan Exp $
+# $FML: Analyze.pm,v 1.10 2001/11/04 06:53:22 fukachan Exp $
 #
 
 package Mail::ThreadTrack::Analyze;
@@ -231,15 +231,23 @@ sub update_thread_status
 	croak("invalid object");
     }
 
+    # filter messages of some class
+    if (defined $self->{ _filterlist }) {
+	if ($self->_is_ignore($msg)) {
+	    $self->log("this thread should be ignored");
+	    $pragma = "close";
+	}
+    }
+
     my $header  = $msg->rfc822_message_header();
     my $textmsg = $msg->get_first_plaintext_message();
     $content    = $textmsg->data_in_body_part();
     $subject    = $header->get('subject') || '';
-    $pragma     = $header->get('x-thread-pragma') || '';
+    $pragma     = $header->get('x-thread-pragma') || $pragma || '';
 
-    if ($content =~ /^\s*close/ || 
-	$subject =~ /^\s*close/ || 
-	$pragma  =~ /close/) {
+    if ($pragma  =~ /close/     ||
+	$content =~ /^\s*close/ || 
+	$subject =~ /^\s*close/) {
 	$self->set_thread_status("closed");
 	$self->_append_thread_status_info("closed");
 	$self->log("thread is closed");
@@ -250,6 +258,32 @@ sub update_thread_status
 }
 
 
+sub _is_ignore
+{
+    my ($self, $msg) = @_;
+    my ($header, $textmsg, $content);
+    my ($field, $rule);
+    my $filterlist = $self->{ _filterlist };
+
+    $header  = $msg->rfc822_message_header();
+    $textmsg = $msg->get_first_plaintext_message();
+    $content = $textmsg->data_in_body_part();
+
+    # check header
+    while (($field, $rule) = each %$filterlist) {
+	if (defined $header->get($field)) {
+	    my $value = $header->get($field);
+	    if ($ENV{'debug'}) {
+		print STDERR "ignore $field: $value\n" if $value =~ /$rule/m;
+	    }
+	    return 1 if $value =~ /$rule/;
+	}
+    }
+
+    return 0;
+}
+
+
 =head2 get_thread_id()
 
 =head2 set_thread_id($thread_id)