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