xlog/bin/record

   1 #!/usr/bin/perl -w
   2
   3 use strict (qw(vars));
   4 use IO::Handle;
   5
   6 our %f;
   7
   8 my $publish_rejections= 0;
   9 if ($ARGV[0] eq '-P') {
  10     $publish_rejections= 1;
  11     shift @ARGV;
  12 }
  13
  14 our ($how) = @_;
  15
  16 my $dir= $0;
  17 $dir =~ s,/[^/]+$,,;
  18 $dir =~ s,/bin$,/log,;
  19 $dir .= "/$ARGV[1]";
  20
  21 my $message;
  22
  23 sub parse__headerline () {
  24     $f{Subject}= $' if m/^Subject:\s*/i; #';
  25     $f{MessageID}= $' if m/^Message\-ID:\s*/i; #';
  26     $f{From}= $' if m/^From:\s*/i; #';
  27 }
  28 sub parse__stumpsubject () {
  29     $f{MessageNum}=$1 if m/^Subject:.*\:\:\w+\/(\d+)$/i;
  30 }
  31
  32 sub parse_posted () {
  33     while (<STDIN>) {
  34         chomp;
  35         parse__headerline();
  36         last if m/^$/;
  37     }
  38     $f{Event}= 'post';
  39 }
  40 sub parse_submission () {
  41     my $hadng=0;
  42     while (<STDIN>) {
  43         chomp;
  44         $hadng++ if m/^Newsgroups:/i;
  45         if (m/^$/) {
  46             last if $hadng;
  47             undef %f;
  48         }
  49         parse__headerline();
  50     }
  51     $f{Event}= 'receive';
  52 }
  53
  54 sub parse_stump2webstump () {
  55     while (<STDIN>) {
  56         chomp;
  57         parse__stumpsubject() unless exists $f{'MessageNum'};
  58         last if m/^\@{40,}$/;
  59     }
  60     while (<STDIN>) {
  61         chomp;
  62         last if m/^$/;
  63         parse__headerline();
  64     }
  65     $f{Event}= 'enqueue';
  66 }
  67
  68 sub parse_webstump2stump () {
  69     while (<STDIN>) {
  70         chomp;
  71         parse__stumpsubject();
  72         last if m/^$/;
  73     }
  74     while (<STDIN>) {
  75         chomp;
  76         next unless m/^reject|^approve|^preapprove/;
  77         $f{Event}= $_;
  78         last;
  79     }
  80 }
  81
  82 sub parse_mailout () {
  83     my $keepheader= 1;
  84     while (<STDIN>) {
  85         $keepheader= 1 unless m/^[ \t]/;
  86         $keepheader= 0
  87             if m/^(?: received
  88                    | envelope-to
  89                    )/ix;
  90         $keepheader= 'mangle'
  91             if m/^(?: to
  92                    | from
  93                    | return-path
  94                    | reply-to
  95                    | errors-to
  96                    )/ix;
  97         if ($keepheader) {
  98             my $line= $_;
  99             $line =~ s/\@.{0,2}/ at ../g if $keepheader eq 'mangle';
 100             $message .= $line;
 101         }
 102         chomp;
 103         $f{Event}= "notify $'" if m/^X-Webstump-Event:\s*/i; #';
 104         last if m/^$/;
 105     }
 106     while (<STDIN>) {
 107         $message .= $_;
 108         chomp;
 109         next unless s/^\> //;
 110         last if m/^$/;
 111         parse__headerline();
 112     }
 113 }
 114
 115 $f{Event}= '?';
 116 &{"parse_$ARGV[0]"};
 117 while (<STDIN>) { $message .= $_; }
 118 STDIN->error and die $!;
 119
 120 $f{Now}= time;
 121
 122 if ($publish_rejections &&
 123     $f{Event} =~ m/^notify reject /) {
 124     $f{CopyRef}= $f{MessageID};
 125     $f{CopyRef} =~ s/\W/ sprintf '-%02x', ord($&) /ge;
 126     open I, ">$dir/public/nr-$f{CopyRef}.txt" or die $!;
 127     print I $message or die $!;
 128     close I or die $!;
 129 }
 130
 131 open L, ">>$dir/event.log" or die $!;
 132
 133 my @s= map {
 134     my $v= $f{$_};
 135     $v= '' unless defined $v;
 136     $v =~ s/\t/  /g;
 137     $v =~ s/[\r\n]/?/g;
 138     $v;
 139 } qw(Now MessageNum MessageID From Subject Event CopyRef);
 140
 141 print L join("\t",@s)."\n" or die $!;
 142 close L or die $!;