xlog/bin/record

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