bin/megalog-overview.pl

   1 #!/usr/bin/perl -l
   2
   3 # use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 =head1 NAME
   8
   9 megalog-overview.pl
  10
  11 =head1 SYNOPSIS
  12
  13
  14
  15 =head1 OPTIONS
  16
  17 =over 8
  18
  19 =cut
  20
  21 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  22
  23 =item B<--debug=s>
  24
  25 String can be C<reps>, nothing else. Note: the time estimation for
  26 individual distros is buggy, don't trust them!
  27
  28 =item B<--help|h!>
  29
  30 This help
  31
  32 =item B<--tail=i>
  33
  34 Defaults to 20. Show only the last logfiles
  35
  36 Misnomer since the day we reversed the result of the glob.
  37
  38 =item B<--terse!>
  39
  40 Do not parse the whole files, just report the date and perl.
  41
  42 =back
  43
  44 =head1 DESCRIPTION
  45
  46 Get some stats on a megalog file: seconds per process, total seconds,
  47 number of lines, number of ticks.
  48
  49 Usually called from the cpanpm directory with
  50
  51     perl ~k/sources/CPAN/andk-cpan-tools/bin/megalog-overview.pl --tail=3
  52
  53 =head1 BUGS
  54
  55 The option --debug=reps does not reflect the stack of activities: if
  56 Job A depends on B, then we measure ABBA: A-start, B-start, B-end,
  57 A-end and the running time for A includes the running time for B in
  58 the end.
  59
  60 =cut
  61
  62
  63 use FindBin;
  64 use lib "$FindBin::Bin/../lib";
  65 BEGIN {
  66     push @INC, qw(       );
  67 }
  68
  69 use Dumpvalue;
  70 use File::Basename qw(dirname);
  71 use File::Path qw(mkpath);
  72 use File::Spec;
  73 use File::Temp;
  74 use Getopt::Long;
  75 use Hash::Util qw(lock_keys);
  76 use List::Util qw(max sum);
  77 use Pod::Usage qw(pod2usage);
  78
  79 our %Opt;
  80 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  81 GetOptions(\%Opt,
  82            @opt,
  83           ) or pod2usage(1);
  84 if ($Opt{help}) {
  85     pod2usage(0);
  86 }
  87 $Opt{tail} ||= 20;
  88
  89 my %F;
  90 my @ml = glob("megalog-*.log");
  91 if ($Opt{tail}) {
  92     shift @ml while @ml > $Opt{tail};
  93 }
  94 for my $ml (reverse @ml) {
  95     my $identitylinestyle = undef; # { "CPAN.pm: Building" => "cpanpm", "\e.+?\s\s" => "color" }
  96     open my $fh, $ml or die "Could not open '$ml': $!";
  97     my %seen;
  98     my %S;
  99     my %P; my $P = "00";
 100     my $process_cnt;
 101     my($date) = $ml =~ /megalog-(.+)\.log/;
 102     $S{adate} = $date;
 103     my $prev_0time = 0;
 104     while (<$fh>) {
 105         $S{blines}++ unless $Opt{terse};
 106         my($reps);
 107         if (!$S{aperl} and m!^perl\|->\s+.+?/
 108                              (?: perl | host/([^/]+) )
 109                              /
 110                              ( [^/]+ / [^/]+ )
 111                              /bin/perl
 112                             !x) {
 113             if ($1) {
 114                 $S{aperl} = "$1/$2"; # the normal case
 115             } else {
 116                 $S{aperl} = "k83/$2"; # rarely true
 117             }
 118             last if $Opt{terse};
 119         } elsif (/=monitoring proc/) {
 120             # ==========monitoring proc 18571 perl v5.15.6-585-gc6fb3f6/a2da secs 30001.0000=======
 121             # $S{btix}++;
 122             if (/=monitoring proc (\d+) perl\s+\S+\s+secs (\d+\.\d+)==/) {
 123                 my $process = $1;
 124                 my $time = $2;
 125                 if ($time < $prev_0time) {
 126                     $prev_0time = 0;
 127                 }
 128                 $process_cnt = $P{$process} ||= $P++;
 129                 $S{sprintf "p-%02d-0time", $process_cnt} = $time;
 130             }
 131         } elsif (/^\s+CPAN.pm: Building .\/..\/(\S+)/) { # CPAN.pm up to 2.xx
 132             # CPAN.pm: Building S/SR/SRI/Mojolicious-3.18.tar.gz
 133             my $what = $1;
 134             $identitylinestyle ||= "cpanpm";
 135             if ($identitylinestyle eq "cpanpm") {
 136                 $S{sprintf "p-%02d-3last", $process_cnt} = $what;
 137                 unless ( $seen{$what}++ ){
 138                     $S{sprintf "p-%02d-1reps", $process_cnt}++;
 139                     $reps = $what;
 140                 }
 141             }
 142         } elsif (m{^\e.+?\s\s([A-Z-0-9]+/\S+?)\e}) { # CPAN.pm 2.03, but also before
 143             # <ansicolor>  TOKUHIROM/Test-Requires-0.07.tar.gz</ansicolor>
 144             my $what = $1;
 145             $identitylinestyle ||= "color";
 146             if ($identitylinestyle eq "color") {
 147                 $S{sprintf "p-%02d-3last", $process_cnt} = $what;
 148                 unless ( $seen{$what}++ ){
 149                     $S{sprintf "p-%02d-1reps", $process_cnt}++;
 150                     $reps = $what;
 151                 }
 152             }
 153         }
 154         if ($Opt{debug} && $Opt{debug} eq "reps" && $reps) {
 155             my $this_0time = $S{"p-$process_cnt-0time"};
 156             printf "# %s %5d %5d %s\n", $process_cnt, $this_0time, $this_0time-$prev_0time, $reps;
 157             $prev_0time = $this_0time; # Buggy! do not rely on it. Does not reflect the stack of activities
 158         }
 159     }
 160     unless ($Opt{terse}){
 161         $S{totalsecs} = sum map { $S{$_} } grep { /^p-\d+-0time$/ } keys %S;
 162     }
 163     no warnings 'uninitialized';
 164     print join " ",
 165         map { $F{$_}=max($F{$_},length($S{$_}));
 166               sprintf("%s=%*s", $_, $F{$_}, $S{$_}) }
 167             sort grep { !/^p-/ } keys %S;
 168     for my $kp ( "00"..$P ) {
 169         last unless exists $S{"p-$kp-0time"};
 170         $S{"p-$kp-2avg"} = sprintf "%.1f", $S{"p-$kp-1reps"} ? $S{"p-$kp-0time"}/$S{"p-$kp-1reps"} : 0;
 171         printf " %s:", $kp;
 172         for my $k (sort grep { /^p-$kp-/ } keys %S) {
 173             my($kl) = $k =~ /.+-\d*(\w+)/;
 174             my($v);
 175             if ($kl eq "time") {
 176                 $v = sprintf "%d", $S{$k};
 177             } else {
 178                 $v = $S{$k};
 179             }
 180             printf(" %s=%s", $kl, $v)
 181         }
 182         print "";
 183     }
 184     print "" unless $Opt{terse};
 185 }
 186
 187 # Local Variables:
 188 # mode: cperl
 189 # cperl-indent-level: 4
 190 # End: