From: epg Gillespie <epg@google.com>
Date: Sat, 3 May 2014 00:58:38 +0000 (-0700)
Subject: undocumented lightly tested support for CODE ref filters
X-Git-Url: https://diplodocus.org/git/minc/commitdiff_plain/refs/heads/master?ds=sidebyside;hp=53237e78cea6b9432f4f0fdc5c640dbeacd0ce16

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 1d7a4c2..224e56a 100755
--- 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 {