xlog/bin/report

   1 #!/usr/bin/perl -w
   2
   3 use strict (qw(vars));
   4 use IO::Handle;
   5 use POSIX;
   6 use CGI qw/:standard *table end_* -no_xhtml/;
   7
   8 our $timesquash = 3;
   9 # no. of digits at end of time to replace with x, 0..4
  10 our %reasonshow = qw(approve 1 reject 1);
  11 # no. of words to show
  12
  13 for (;;) {
  14     last unless @ARGV;
  15     last unless $ARGV[0] =~ m/^-/;
  16     $_ = shift @ARGV;
  17     last if m/^--?$/;
  18     while (m/^-./) {
  19         if (s/^-t([0-4])/-/) {
  20             $timesquash= $1;
  21         } elsif (s/^-r(\w+)=(\d)$//) {
  22             $reasonshow{$1}= $2;
  23         } else {
  24             die "bad option $_ ?";
  25         }
  26     }
  27 }
  28
  29 our ($ng,$staticfiles,@ARGV) = @ARGV;
  30 chdir $ng or die $!;
  31
  32 our @lines= ();
  33 our @s;
  34 our $oddeven = "o";
  35
  36 our ($processline,$needmap);
  37 our ($selectmid,$selectnum);
  38
  39 sub processlog ($$) {
  40     my ($taccat, $fn)= @_;
  41     open F, "$taccat $fn |" or die $!;
  42     while (<F>) {
  43         chomp;
  44         @s= split /\t/;
  45         push @s, '' if @s<=6;
  46         $s[0]= strftime "%Y-%m-%d %H:%M:%S %Z", localtime $s[0];
  47         for (my $i=0; $i<$timesquash; $i++) {
  48             $s[0] =~ s/(\d\d:[\d:]*)\d/$1x/;
  49         }
  50         $s[0] =~ s/:xx / /;
  51         &$processline();
  52         $oddeven =~ y/oe/eo/;
  53     }
  54 }
  55 sub processlogs ($) {
  56     my ($taccat) = @_;
  57     my (@logs) = qw(event.log.0 event.log);
  58     @logs= reverse @logs if $taccat eq 'tac';
  59     processlog($taccat, $_) foreach @logs;
  60 }
  61
  62 sub processline_print () {
  63     my @sp= @s;
  64     $sp[3] =~ s/\@\w{0,2}/ at .. /;
  65     @sp= map { escapeHTML($_) } @sp[0..5];
  66     $sp[3] =~ s/&lt;/\<br>&lt;/;
  67     $sp[2]=~s/\@/\@<span class='hole'><\/span>/;
  68     my @spu= map {
  69         s/\W/ sprintf "%%%02x", ord $& /ge;
  70         $_;
  71     } @s;
  72     if (length $s[1] && length $s[2]) {
  73         my $url= url().'/message/'.$spu[1].'/'.$spu[2];
  74         foreach my $i (qw(1 2)) {
  75             $sp[$i]= a({ href=>$url }, $sp[$i]."<br>" );
  76         }
  77     }
  78     if (length $s[6]) {
  79         $sp[5]= a({ href=>"$staticfiles/nr-$s[6].txt" }, $sp[5] );
  80     }
  81
  82     if ($sp[5] =~ m/^\w+\b/ &&
  83         defined (my $reasonshow= $reasonshow{$&})) {
  84         my @reas= split /\s+/, $sp[5];
  85         $reasonshow--;
  86         $#reas = $reasonshow if $#reas > $reasonshow;
  87         $sp[5] = join ' ', @reas;
  88     }
  89
  90     print "<tr class='$oddeven'><td>$sp[0]</td>";
  91     print "<td class='ref'>$sp[1] $sp[2]</td>";
  92     print td([@sp[3..5]]),"</tr>\n";
  93 }
  94
  95 sub processline_print_ifsingle () {
  96     return unless $s[1] eq $selectnum
  97                or $s[2] eq $selectmid;
  98     processline_print();
  99 }
 100
 101 our (%done_num,%done_id,%num2id,%id2num);
 102 sub processline_queue_prescan () {
 103     my ($num,$id,$e) = @s[1..2,5];
 104     if (length $id and length $num) {
 105         $id2num{$id}= $num;
 106         $num2id{$num}= $id;
 107     }
 108     return unless $e =~ m/^decide reject discard|^notify reject|^post/;
 109 #print STDERR "finishing $e $s[1] $s[2]\n";
 110     $num= $id2num{$id} if !length $num;
 111     $id= $num2id{$num} if !length $id;
 112 #print STDERR "finishing $e $num $id\n";
 113     $done_num{$num}++ if defined $num;
 114     $done_id{$id}++ if defined $id;
 115 }
 116 sub processline_queue () {
 117     return if $done_num{$s[1]};
 118     return if $done_id{$s[2]};
 119     processline_print();
 120 }
 121
 122 my $pi= path_info();
 123 our $title;
 124
 125 $needmap= 0;
 126 $processline= \&processline_print;
 127
 128 if ($pi =~ m,^/message/(\d+)/(.*)$,) {
 129     ($selectnum, $selectmid) = ($1,$2);
 130     $title= "Single message ".escapeHTML($selectmid);
 131     $processline= \&processline_print_ifsingle;
 132 } elsif ($pi =~ m/^$/) {
 133     $title= "Recent activity - $ng";
 134 } elsif ($pi =~ m,^/queue,) {
 135     $title= "Activity regarding still-queued messages";
 136     $processline= \&processline_queue_prescan;
 137     processlogs('cat');
 138     $processline= \&processline_queue;
 139 }
 140
 141 my $css=<<EOJ;
 142 span.hole:before { content: " "; }
 143 td.ref { font-size: 0.75em; }
 144 tr.o { background: #ddddff; }
 145 EOJ
 146
 147 print header(),
 148   start_html(-title=>$title, -style=>{'-code'=>$css}),
 149   h1($title), start_table();
 150
 151 print Tr(td([map { strong($_) } (qw(
 152                                 Date
 153                                 Reference/Message-ID
 154                                 From
 155                                 Subject
 156                                 Event
 157                             ))]));
 158
 159 processlogs('tac');
 160
 161 print end_table();
 162 print p();
 163
 164 print a({ href=>url() }, "All recent activity"), '; ';
 165 print a({ href=>url().'/queue' }, "Unfinished business");
 166
 167 print end_html();