chiark / gitweb /
xlog: Proper argument parser in record (no functional change)
[modbot-ulm.git] / xlog / bin / record
index 1ba50b70ae543452a6e303297dbc9fcb0225a0e6..240883354825fa8ba935039ec6efb719c7bfb8de 100755 (executable)
@@ -2,13 +2,26 @@
 
 use strict (qw(vars));
 use IO::Handle;
+use POSIX;
 
 our %f;
 
+my $publish_rejections_patfile= '/dev/null';
 my $publish_rejections= 0;
-if ($ARGV[0] eq '-P') {
-    $publish_rejections= 1;
-    shift @ARGV;
+
+for (;;) {
+    last unless @ARGV;
+    last unless $ARGV[0] =~ m/^-/;
+    $_ = shift @ARGV;
+    last if m/^--?$/;
+    while (m/^-./) {
+       if (s/^-P(.*)$//) {
+           $publish_rejections= 1;
+           $publish_rejections_patfile= $1 if length $1;
+       } else {
+           die "bad option $_ ?";
+       }
+    }
 }
 
 our ($how) = @_;
@@ -112,7 +125,10 @@ sub parse_mailout () {
            $message .= $line;
        }
        chomp;
-       $f{Event}= "notify $'" if m/^X-Webstump-Event:\s*/i; #';
+        if (m/^X-Webstump-Event:\s*(?:\[(\d+)\])?\s*/i) { #';
+            $f{Event}= "notify $'";
+            $f{MessageNum}= $1 if defined $1;
+        }
        last if m/^$/;
     }
     while (<STDIN>) {
@@ -131,9 +147,33 @@ STDIN->error and die $!;
 
 $f{Now}= time;
 
+sub want_publish_rejection_kind ($) {
+    my ($kind) = @_;
+    return 1 if $publish_rejections_patfile eq '';
+    if (!open PF, '<', $publish_rejections_patfile) {
+       return 1 if $!==&ENOENT;
+       die "$publish_rejections_patfile: $!";
+    }
+    while (<PF>) {
+       s/^\s+//;
+       s/\s+$//;
+       next if m/^\#/;
+       next unless m/\S/;
+       my $yn = !s/^\!//;
+       s/[^0-9a-zA-Z*?]/\\$&/g;
+       s/\*/.*/g;
+       s/\?/./g;
+        return $yn if $kind =~ m/^$_$/;
+    }
+    close PF or die $!;
+    return 1;
+}
+
 if ($publish_rejections &&
-    $f{Event} =~ m/^notify reject /) {
-    $f{CopyRef}= $f{MessageID};
+    $f{Event} =~ m/^notify reject (\S+)/ &&
+    want_publish_rejection_kind($1))
+{
+    $f{CopyRef}= $f{MessageNum} || $f{MessageID};
     $f{CopyRef} =~ s/\W/ sprintf '-%02x', ord($&) /ge;
     open I, ">$dir/public/nr-$f{CopyRef}.txt" or die $!;
     print I $message or die $!;