undocumented lightly tested support for CODE ref filters

For 11 years the simple filtering has been fine, but filtering of code review
mails at work finally requires something more complex quick example:

@FILTERS = (
  # Prioritize reviews to/cc me in special folder.
  sub {
      my $h = shift;
      match($h, ' TO', ['main-review-list', 't'])
          && match($h, ' TO', ['me', 't'])
          && return 'reviews';
  },
  # Isolate the spammy reviews.
  [' TO', ['hi-traffic-review-list', 'wharrgarbl']],

  # Other reviews follow normal rules below.
);

diff --git a/minc b/minc
index 1d7a4c2e228314213b511c91c82535076a0c96cf..224e56a28ac2c5f27879cabb3298d8e5e0672b80 100755 (executable)
--- a/minc
+++ b/minc
@@ -493,63 +493,67 @@ sub get_headers {
 
 sub find_mh_folder {
     my $msg = shift;
-    my %headers = %{(shift)};
-    my $filterref;
-    my @filter;
-    my $header;
-    my $contents;
-    my $pair;
-    my $regexp;
-    my $expression;
-    my $result;
-
-    if (not %headers) {
+    my $header = shift;
+
+    if (not %$header) {
         return 'malformed';
     }
 
     # 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);
-
-        # Handle filters using the magic TO header specially.
-        if ($header eq $MAGIC_TO_TOKEN) {
-            foreach $header (keys(%headers)) {
-                if ($header =~ /$MAGIC_TO_REGEX/i) {
-                    foreach $contents (@{$headers{lc($header)}}) {
-                        foreach $pair (@filter) {
-                            ($regexp, $expression) = @$pair;
-                            if ($contents =~ $regexp) {
-                                if (eval "\$result = \"$expression\"") {
-                                    return $result;
-                                }
-                            }
-                        }
-                    }
-                }
-            }
-
-            # Now that it's been processed specially, skip normal handling.
+    for my $filterref (@FILTERS) {
+        if (ref($filterref) eq 'CODE') {
+            my $m = $filterref->($header, $msg);
+            $m && return $m;
             next;
         }
 
-        # Walk the list of message headers matching the filter's
-        # specified header.
-        foreach $contents (@{$headers{lc($header)}}) {
-            # Walk the filter's list of regexp/expression pairs.
-            foreach $pair (@filter) {
-                ($regexp, $expression) = @$pair;
-                if ($contents =~ $regexp) {
-                    if (eval "\$result = \"$expression\"") {
-                        return $result;
-                    }
-                }
+        my $m = match($header, @$filterref);
+        $m && return $m;
+    }
+
+    return 'inbox';
+}
+
+# Test all the header fields against each [regexp, folder-expression] pair.
+sub match {
+    my $header = shift;
+    my $filter_field = shift;
+    my @filters = @_;
+
+    # Handle filters using the magic TO header specially.
+    if ($filter_field eq $MAGIC_TO_TOKEN) {
+        for my $field_name (keys(%$header)) {
+            if ($field_name =~ /$MAGIC_TO_REGEX/i) {
+                my $m = match_one_field($header->{$field_name}, \@filters);
+                $m && return $m;
             }
         }
+        # Now that it's been processed specially, skip normal handling.
+        return;
     }
 
-    return 'inbox';
+    # Walk the list of header fields matching the filter's specified header.
+    my $m = match_one_field($header->{lc($filter_field)}, \@filters);
+    $m && return $m;
+}
+
+# Test all the values of one header field against each [regexp,
+# folder-expression] pair.
+sub match_one_field {
+    my $values = shift;
+    my $filters = shift;
+    for my $value (@$values) {
+        for my $pair (@$filters) {
+            my ($regexp, $expression) = @$pair;
+            if ($value =~ $regexp) {
+                my $result;
+                if (eval "\$result = \"$expression\"") {
+                    return $result;
+                }
+            }
+        }
+    }
 }
 
 sub scan_line {