Seems to be able to format report

[innduct.git] / innduct-stats-report

diff --git a/innduct-stats-report b/innduct-stats-report
new file mode 100755 (executable)
index 0000000..653a8f7
--- /dev/null
+++ b/innduct-stats-report
@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Data::Dumper;
+
+our %counts;
+
+# Input lines look like this:
+# May 23 19:00:02 chiark innduct[23236]: news.relativity.greenend.org.uk| info: completed feedfile read=76 (+bl=7,+err=0) missing=0 offered=76 (ch=76,nc=0) accepted=75 (ch=75,nc=0) unwanted=1 (id=1,bod=0,nc=0) rejected=0 (id=0,bod=0,nc=0) deferred=0 (id=0,bod=0,nc=0) missing=0 (id=0,bod=0,nc=0) connretry=0 (id=0,bod=0,nc=0)
+
+while (<>) {
+    next unless
+       m/^ [:0-9A-Za-z ]+[ ]
+           \w+[ ]
+           innduct\[\d+\]:[ ]
+           ([^|<>: \t]+)\|[ ]
+           info:[ ]
+           (?: completed | processed )[ ]
+           .*?
+           ( (?: [ ]
+                  (?: \w+ = \d+
+                   | \( [=+,0-9a-z]+ \)
+                  )
+              )+
+             )
+           $/x;
+    my ($site,$strs) = ($1,$2);
+    die unless $strs =~ m/^ read=/;
+
+    my $cur;
+    $strs .= ' ';
+    my $c= \%{ $counts{$site} };
+#print Dumper($c);
+    for (;;) {
+       if ($strs =~ s/^[ ] (\w+) = (\d+) [ ]/ /x) {
+           $cur= $1;
+           $c->{$cur} += $2;
+       } elsif ($strs =~ s/^
+                [ ] \(
+                  ( \+? \w+ ) = (\d+)
+                   (?: , ([^()]+) )?
+                \) [ ]/ sprintf " (%s) ", defined $3 ? $3 : '' /xe) {
+           $c->{"${cur}_$1"} += $2;
+       } elsif ($strs =~ s/^ \(\) / /) {
+       } elsif ($strs eq ' ') {
+           last;
+       } else {
+           die "$_ // $strs ?";
+       }
+    }
+    
+#    print "$site|";
+#    foreach my $k (sort keys %$c) { printf " %s=%d", $k, $c->{$k}; }
+#    print "\n";
+#print Dumper(\%counts);;
+}
+
+our $cwr;
+our $site;
+
+foreach $site (sort keys %counts) {
+    $cwr= $counts{$site};
+    write;
+}
+
+sub pct ($$) {
+    my ($dend,$dor) = @_;
+    return undef unless defined($dend) and $dor;
+    return $dend * 100.0 / $dor;
+}
+
+sub amt ($) {
+    my ($v) = @_;
+    return '' unless defined $v;
+    if ($v < 9999) { return sprintf "%4d ", $v; }
+    if ($v < 9999e3) { return sprintf "%4dk", ($v / 1e3); }
+    return sprintf "%4dm", ($v / 1e3);
+}
+
+format STDOUT_TOP =
+offrd acctd unwtd rejtd ac% rj% nochk nc% 
+.
+format STDOUT =
+@>>>> @>>>> @>>>> @>>>> ^## ^## @>>>> ^## @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+{ (map { amt($cwr->{$_}) } qw(offered accepted unwanted rejected)),
+  (map { pct($cwr->{$_}, $cwr->{offered}) } qw(accepted rejected)),
+  ($cwr->{offered_nc} ? (amt($cwr->{offered_nc}),
+                        pct($cwr->{offered_nc}, $cwr->{offered}))
+                      : '',undef),
+  ($site);
+  }
+.