Implement Doug's two killer features: 1) store all occurrences of a

header, not just the last, 2) use pure ordered structure for the
filters, allowing inter-mixing of filters (i.e. you can have some
List-Id filters followed by some X-Mailing-List filters followed by
more List-Id filters and they will all be matched in the correct
order).

Earlier i was using Tie::IxHash to make the filters hash ordered, but
i wasn't using it for the internal hashes so it was incomplete.  I
didn't need hashes in teh first place; switching to nested arrays for
the filters structure solves this problem as well as Doug's killer
feature and as a bonus removes the Tie::IxHash dependency.

README:
    Remove Tie::IxHash from list of non-standard modules.

minc:
    Drop Tie::IxHash.

    FILTERS and %headers become more complex structures (code and
    documentation changes).

    For now, use .mincfilter2 instead of .mincfilter (will change
    back as soon as the new code has had a good shake-down).

    (log_headers): Adapt for new %headers structure and add comment
    cross-referencing the get_headers comment explaining the
    structure.

    (get_headers): Document the %headers structure.  Build and return
    the new structure, preserving multiple occurrences of the same
    header.

    (find_mh_folder): Use the new @FILTERS structure.

    (MAIN): Use @FILTERS instead of %FILTERS.

    In the closing pod section, fix the EXAMPLES section and add a
    section documenting @FILTERS.

diff --git a/README b/README
index db88751..b3b33db 100644 (file)
--- a/README
+++ b/README
@@ -3,7 +3,6 @@ $Id$
 minc requires the following non-standard Perl modules and headers:
 
 Log::Dispatch
 minc requires the following non-standard Perl modules and headers:
 
 Log::Dispatch

-Tie::IxHash

 sysexits.ph
 
 Log::Dispatch is available on CPAN.  You will almost certainly have to
 sysexits.ph
 
 Log::Dispatch is available on CPAN.  You will almost certainly have to

diff --git a/minc b/minc
index 6efc7fd..c95bec2 100755 (executable)
--- a/minc
+++ b/minc
@@ -36,7 +36,6 @@ use Getopt::Std;
 use Log::Dispatch;
 use Log::Dispatch::File;
 use POSIX qw(strftime WEXITSTATUS WIFEXITED);
 use Log::Dispatch;
 use Log::Dispatch::File;
 use POSIX qw(strftime WEXITSTATUS WIFEXITED);

-use Tie::IxHash;

 
 =head1 OPTIONS
 
 
 =head1 OPTIONS
 


@@ -44,7 +43,7 @@ use Tie::IxHash;
 
 =item B<-d>
 
 
 =item B<-d>
 

-Dump (using Data::Dumper) the FILTERS hash and exit.  This is useful
+Dump (using Data::Dumper) the FILTERS list and exit.  This is useful

 for testing the syntax of .mincfilter.
 
 =item B<-f>
 for testing the syntax of .mincfilter.
 
 =item B<-f>


@@ -132,7 +131,7 @@ if (not $MAILDIR) {
 =item $HOME/.mincfilter
 
 This file is Perl code (included via the 'require' directive) which is
 =item $HOME/.mincfilter
 
 This file is Perl code (included via the 'require' directive) which is

-expected to define the FILTERS hash.
+expected to define the FILTERS list.

 
 =item $HOME/.mincspam
 
 
 =item $HOME/.mincspam
 


@@ -173,9 +172,8 @@ marked unseen.
 
 =cut
 
 
 =cut
 

-our %FILTERS;
-tie(%FILTERS, 'Tie::IxHash');
-require "$HOME/.mincfilter";
+our @FILTERS;
+require "$HOME/.mincfilter2";

 
 if (-f "$HOME/.mincspam") {
     require "$HOME/.mincspam";
 
 if (-f "$HOME/.mincspam") {
     require "$HOME/.mincspam";


@@ -253,10 +251,12 @@ sub logerr { mylog('error', ERRORCHAR, @_); }
 sub log_headers {
     my %headers = @_;
 
 sub log_headers {
     my %headers = @_;
 

-    logincoming('From:       ', $headers{'return-path'});
-    logincoming('To:         ', $headers{'to'});
-    logincoming('Subject:    ', $headers{'subject'});
-    logincoming('Message-Id: ', $headers{'message-id'});
+    # For an explanation of the %headers structure, see the
+    # get_headers function below.
+    logincoming('From:       ', @{$headers{'return-path'}}[-1]);
+    logincoming('To:         ', @{$headers{'to'}}[-1]);
+    logincoming('Subject:    ', @{$headers{'subject'}}[-1]);
+    logincoming('Message-Id: ', @{$headers{'message-id'}}[-1]);

 }
 
 \f
 }
 
 \f


@@ -460,11 +460,19 @@ sub store_message {
     }
 }
 
     }
 }
 

+# Parse a message file into a structure describing the headers.  The
+# structure is a hash of arrays.  The hash keys are the names of the
+# headers found in the message, made all lower-case.  Each item in
+# the hash is an array of header text.  The array has one element
+# per occurrence of the header.  Most headers will only have a single
+# element because they occur only once.  The Received header is the
+# most common header with multiple texts.

 sub get_headers {
     my $msg = shift;
     my %headers;
     my $current;                # current header, used for unfolding lines
     my $fieldname;              # unmolested header name
 sub get_headers {
     my $msg = shift;
     my %headers;
     my $current;                # current header, used for unfolding lines
     my $fieldname;              # unmolested header name

+    my $contents;               # contents of header

 
     open(MSG, $msg);
     while (<MSG>) {
 
     open(MSG, $msg);
     while (<MSG>) {


@@ -481,11 +489,19 @@ sub get_headers {
                 return ();
             }
 
                 return ();
             }
 

-            $headers{$current} .= $_;
+            @{$headers{$current}}[-1] .= $_;

         } else {
             ($fieldname) = split(/:/);
             $current = lc($fieldname);
         } else {
             ($fieldname) = split(/:/);
             $current = lc($fieldname);

-            (undef, $headers{$current}) = split(/^\Q$fieldname\E:\s*/);
+            (undef, $contents) = split(/^\Q$fieldname\E:\s*/);
+
+            if (defined($headers{$current})) {
+                # multiple occurence of same header
+                push(@{$headers{$current}}, $contents);
+            } else {
+                # first occurence of a header
+                $headers{$current} = [$contents];
+            }

         }
     }
     close(MSG);
         }
     }
     close(MSG);


@@ -527,11 +543,14 @@ sub kill_spam {
 sub find_mh_folder {
     my $msg = shift;
     my %headers;
 sub find_mh_folder {
     my $msg = shift;
     my %headers;

+    my $filterref;
+    my @filter;

     my $header;
     my $contents;
     my $header;
     my $contents;

-    my $regex;
-    my $subst;
-    my $try;
+    my $pair;
+    my $match;
+    my $expression;
+    my $result;

 
     %headers = get_headers($msg);
     if (not %headers) {
 
     %headers = get_headers($msg);
     if (not %headers) {


@@ -540,17 +559,22 @@ sub find_mh_folder {
 
     log_headers(%headers);
 
 
     log_headers(%headers);
 

-    foreach $header (keys(%FILTERS)) {
-        $contents = $headers{lc($header)};
-
-        if (defined($contents)) {
-            foreach $regex (keys(%{$FILTERS{$header}})) {
-                $subst = $FILTERS{$header}->{$regex};
-
-                $try = '$contents =~';
-                $try .= " s|$regex|$subst|is";
-                if (eval $try) {
-                    return $contents;
+    # Walk the list of filters.  This structure is documented in
+    # pod at the end of the program.
+    foreach $filterref (@FILTERS) {
+        @filter = @$filterref;
+        $header = shift(@filter);
+
+        # Walk the list of message headers matching the filter's
+        # specified header.
+        foreach $contents (@{$headers{lc($header)}}) {
+            # Walk the filter's list of match/expression pairs.
+            foreach $pair (@filter) {
+                ($match, $expression) = @$pair;
+                if ($contents =~ /$match/) {
+                    if (eval "\$result = \"$expression\"") {
+                        return $result;
+                    }

                 }
             }
         }
                 }
             }
         }


@@ -576,7 +600,7 @@ MAIN: {
 
     if ($dumpfilters) {
         $Data::Dumper::Indent = 1;
 
     if ($dumpfilters) {
         $Data::Dumper::Indent = 1;

-        print(Dumper(\%FILTERS));
+        print(Dumper(\@FILTERS));

         exit(&EX_OK);
     }
 
         exit(&EX_OK);
     }
 


@@ -593,19 +617,51 @@ MAIN: {
 
 __END__
 
 
 __END__
 

+=head1 THE FILTERS STRUCTURE
+
+The user's .mincfilter file must define the @FILTERS structure.  This
+structure is an array.  Each element of @FILTERS is a filter.  A
+filter is itself an array.  The first element of a filter is a string,
+the name of the header this filter acts upon.  The header name is not
+case-sensitive.  Each subsequent element of a filter is a pair (i.e. a
+two-element array): first, a regular expression B<minc> uses to
+determine whether this filter matches or not, and second, an
+expression which B<minc> evaluates to get the folder name.
+
+B<minc> decides where to store a message by iterating over the
+@FILTERS array.  It tests each regexp of each filter against all
+headers matching that filter's specified header.  As soon as a match
+is found, B<minc> evaluates the second part of the pair.  This part
+may contain positional parameters from the matched regexp ($1, $2,
+etc.).  The result of this expression is used as the folder name.
+
+Multiple occurrences of the same header are preserved and tested
+individually against the filters.  That means, for example, that
+filters can search all the Received headers for a certain string.
+
+It is important to note that all the arrays of the @FILTERS structure
+are traversed I<in order>.  This means the filters can be arranged so
+that some have priority over others.  XXX: get Doug to write an
+example of having the same header matched more than once.
+

 =head1 EXAMPLES
 
 =head1 EXAMPLES
 

-%FILTERS =
-  ('List-Id:'=>
-   {'.*<([[:graph:]]+)-([[:graph:]]+)\.lists\.sourceforge\.net>.*'=>'l/$1/$2',
-    '.*<([[:graph:]]+?)(-list)?\.freedesktop\.org>.*'=>'l/freedesktop/$1',
-    '.*<swig\.cs\.uchicago\.edu>.*'=>'l/swig'},
+@FILTERS = (
+
+  ['List-Id',
+   ['<([[:graph:]]+)-([[:graph:]]+)\.lists\.sourceforge\.net>', 'l/$1/$2'],
+   ['<([[:graph:]]+?)(-list)?\.freedesktop\.org>', 'l/freedesktop/$1'],
+   ['<swig\.cs\.uchicago\.edu>', 'l/swig'],
+  ],

 
 

-   'List-Post:'=>
-   {'<mailto:([[:graph:]]+)+@([[:graph:]]+)\.apache\.org>'=>'l/apache/$2/$1'},
+  ['List-Post',
+   ['<mailto:([[:graph:]]+)+@([[:graph:]]+)\.apache\.org>', 'l/apache/$2/$1'],
+  ],

 
 

-   'To:'=>
-   {'root'=>'root'});
+  ['To',
+   ['root', 'root'],
+  ],
+);

 
 The first List-Id filter is a surprisingly effective one which creates
 appropriate folder names (such as l/htdig/updates and l/rox/devel) for
 
 The first List-Id filter is a surprisingly effective one which creates
 appropriate folder names (such as l/htdig/updates and l/rox/devel) for