use Log::Dispatch;
use Log::Dispatch::File;
use POSIX qw(strftime WEXITSTATUS WIFEXITED);
-use Tie::IxHash;
=head1 OPTIONS
=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>
=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
=cut
-our %FILTERS;
-tie(%FILTERS, 'Tie::IxHash');
-require "$HOME/.mincfilter";
+our @FILTERS;
+require "$HOME/.mincfilter2";
if (-f "$HOME/.mincspam") {
require "$HOME/.mincspam";
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
}
}
+# 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
+ my $contents; # contents of header
open(MSG, $msg);
while (<MSG>) {
return ();
}
- $headers{$current} .= $_;
+ @{$headers{$current}}[-1] .= $_;
} 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);
sub find_mh_folder {
my $msg = shift;
my %headers;
+ my $filterref;
+ my @filter;
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) {
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;
+ }
}
}
}
if ($dumpfilters) {
$Data::Dumper::Indent = 1;
- print(Dumper(\%FILTERS));
+ print(Dumper(\@FILTERS));
exit(&EX_OK);
}
__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
-%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
projects / minc / commitdiff