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 sub parse__headerline () {
  15     $f{Subject}= $' if m/^Subject:\s*/i; #';
  16     $f{MessageID}= $' if m/^Message\-ID:\s*/i; #';
  17     $f{From}= $' if m/^From:\s*/i; #';
  18 }
  19 sub parse__stumpsubject () {
  20     $f{MessageNum}=$1 if m/^Subject:.*\:\:\w+\/(\d+)$/i;
  21 }
  22
  23 sub parse_posted () {
  24     while (<STDIN>) {
  25         chomp;
  26         parse__headerline();
  27         last if m/^$/;
  28     }
  29     $f{Event}= 'post';
  30 }
  31 sub parse_submission () {
  32     my $hadng=0;
  33     while (<STDIN>) {
  34         chomp;
  35         $hadng++ if m/^Newsgroups:/i;
  36         if (m/^$/) {
  37             last if $hadng;
  38             undef %f;
  39         }
  40         parse__headerline();
  41     }
  42     $f{Event}= 'receive';
  43 }
  44
  45 sub parse_stump2webstump () {
  46     while (<STDIN>) {
  47         chomp;
  48         parse__stumpsubject() unless exists $f{'MessageNum'};
  49         last if m/^\@{40,}$/;
  50     }
  51     while (<STDIN>) {
  52         chomp;
  53         last if m/^$/;
  54         parse__headerline();
  55     }
  56     $f{Event}= 'enqueue';
  57 }
  58
  59 sub parse_webstump2stump () {
  60     while (<STDIN>) {
  61         chomp;
  62         parse__stumpsubject();
  63         last if m/^$/;
  64     }
  65     while (<STDIN>) {
  66         chomp;
  67         next unless m/^reject|^approve|^preapprove/;
  68         $f{Event}= $_;
  69         last;
  70     }
  71 }
  72
  73 sub parse_mailout () {
  74     while (<STDIN>) {
  75         chomp;
  76         $f{Event}= "notify $'" if m/^X-Webstump-Event:\s*/i; #';
  77         last if m/^$/;
  78     }
  79     while (<STDIN>) {
  80         chomp;
  81         next unless s/^\> //;
  82         last if m/^$/;
  83         parse__headerline();
  84     }
  85 }
  86
  87 $f{Event}= '?';
  88 &{"parse_$ARGV[0]"};
  89 while (<STDIN>) { }
  90 STDIN->error and die $!;
  91
  92 $f{Now}= time;
  93
  94 open L, ">>$dir/event.log" or die $!;
  95
  96 my @s= map {
  97     my $v= $f{$_};
  98     $v= '' unless defined $v;
  99     $v =~ s/\t/  /g;
 100     $v =~ s/[\r\n]/?/g;
 101     $v;
 102 } qw(Now MessageNum MessageID From Subject Event);
 103
 104 print L join("\t",@s)."\n" or die $!;
 105 close L or die $!;