tools/tools/prstats/prstats.pl

   1 #!/usr/bin/perl -w
   2 #-
   3 # Copyright (c) 2001 Dag-Erling Coïdan Smørgrav
   4 # All rights reserved.
   5 #
   6 # Redistribution and use in source and binary forms, with or without
   7 # modification, are permitted provided that the following conditions
   8 # are met:
   9 # 1. Redistributions of source code must retain the above copyright
  10 #    notice, this list of conditions and the following disclaimer
  11 #    in this position and unchanged.
  12 # 2. Redistributions in binary form must reproduce the above copyright
  13 #    notice, this list of conditions and the following disclaimer in the
  14 #    documentation and/or other materials provided with the distribution.
  15 # 3. The name of the author may not be used to endorse or promote products
  16 #    derived from this software without specific prior written permission.
  17 #
  18 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
  19 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  20 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  21 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
  22 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  23 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  24 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  25 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  26 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  27 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  28 #
  29 #      $FreeBSD$
  30 #
  31
  32 use strict;
  33 use Data::Dumper;
  34 use Fcntl;
  35 use POSIX qw(isatty mktime strftime tzset);
  36 use vars qw($TTY $NOW %MONTH %PR @EVENTS @COUNT @AGE);
  37 use vars qw(%STATE %CATEGORY %OWNER %CLOSER);
  38
  39 %MONTH = (
  40     'Jan' => 1,
  41     'Feb' => 2,
  42     'Mar' => 3,
  43     'Apr' => 4,
  44     'May' => 5,
  45     'Jun' => 6,
  46     'Jul' => 7,
  47     'Aug' => 8,
  48     'Sep' => 9,
  49     'Oct' => 10,
  50     'Nov' => 11,
  51     'Dec' => 12,
  52 );
  53
  54 @AGE = (
  55     [ 0,        7,      0 ],    # Less than one week
  56     [ 7,        30,     0 ],    # One week to one month
  57     [ 30,       90,     0 ],    # One to three months
  58     [ 90,       365,    0 ],    # Three months to a year
  59     [ 365,      1095,   0 ],    # One to three years
  60     [ 1095,     999999, 0 ],    # More than three years
  61 );
  62
  63 sub GNATS_DIR                   { "/home/gnats" }
  64 sub GNATS_TZ                    { "America/Los_Angeles" }
  65 sub DATFILE                     { "/tmp/prstats.dat.$$" }
  66 sub GNUPLOT                     { "|/usr/local/bin/gnuplot /dev/stdin" }
  67 sub TIMEFMT                     { "%Y-%m-%d/%H:%M:%S" }
  68
  69 sub parse_date($) {
  70     my $date = shift;           # Date to parse
  71
  72     my $year;
  73     my $month;
  74     my $day;
  75     my $hour;
  76     my $minute;
  77     my $second;
  78
  79     $date =~ s/\s+/ /g;
  80     $date =~ s/^(Mon|Tue|Wed|Thu|Fri|Sat|Sun)\w*\s*//;
  81     if ($date =~ m/^(\w{3}) (\d\d?) (\d\d):(\d\d):(\d\d) [A-Z ]*(\d{4})$/) {
  82         ($month, $day, $hour, $minute, $second, $year) =
  83             ($1, $2, $3, $4, $5, $6);
  84     } else {
  85         die("Unrecognized date format: $date\n");
  86     }
  87     defined($month = $MONTH{$month})
  88         or die("Invalid month: $month\n");
  89     return mktime($second, $minute, $hour, $day, $month - 1, $year - 1900);
  90 }
  91
  92 sub scan_pr($) {
  93     my $fn = shift;             # File name
  94
  95     local *FILE;                # File handle
  96     my $pr = {};                # PR hash
  97     my $age;                    # PR age
  98
  99     sysopen(FILE, $fn, O_RDONLY)
 100         or die("$fn: open(): $!\n");
 101     while (<FILE>) {
 102         if (m/^>([A-Za-z-]+):\s+(.*?)\s*$/o ||
 103             m/^(Category|Responsible|State-Changed-[A-Za-z-]+):\s+(.*?)\s*$/o) {
 104             $pr->{lc($1)} = $2;
 105         }
 106     }
 107
 108     exists($PR{$pr->{'number'}})
 109         and die("$fn: PR $pr->{'number'} already exists\n");
 110
 111     if ($TTY) {
 112         print(" "x40, "\r", scalar(keys(%PR)),
 113               " $pr->{'category'}/$pr->{'number'} ");
 114     }
 115
 116     foreach ('arrival-date', 'closed-date', 'last-modified',
 117              'state-changed-when') {
 118         if (defined($pr->{$_}) && length($pr->{$_})) {
 119             $pr->{$_} = parse_date($pr->{$_});
 120         }
 121     }
 122
 123     $pr->{'_created'} = $pr->{'arrival-date'};
 124     if ($pr->{'state'} eq 'closed') {
 125         $pr->{'_closed'} = $pr->{'closed-date'} || $pr->{'state-changed-when'};
 126         $pr->{'_closed_by'} = $pr->{'state-changed-by'};
 127         ++$CLOSER{$pr->{'_closed_by'}};
 128     } else {
 129         $age = $pr->{'arrival-date'} / 86400;
 130         foreach (@AGE) {
 131             if ($age >= $_->[0] && $age < $_->[1]) {
 132                 ++$_->[2];
 133                 last;
 134             }
 135         }
 136         ++$CATEGORY{$pr->{'category'}};
 137         ++$OWNER{$pr->{'responsible'}};
 138     }
 139     ++$STATE{$pr->{'state'}};
 140
 141     $PR{$pr->{'number'}} = {
 142         'category'      => $pr->{'category'},
 143         #'number'       => $pr->{'number'},
 144         'responsible'   => $pr->{'responsible'},
 145         'created'       => $pr->{'created'},
 146         'closed'        => $pr->{'closed'},
 147         'closer'        => $pr->{'_closed_by'},
 148     };
 149     push(@EVENTS, [ $pr->{'_created'}, +1 ]);
 150     push(@EVENTS, [ $pr->{'_closed'}, -1 ])
 151             if defined($pr->{'_closed'});
 152 }
 153
 154 sub scan_recurse($);
 155 sub scan_recurse($) {
 156     my $dn = shift;             # Directory name
 157
 158     local *DIR;                 # Directory handle
 159     my $entry;                  # Entry
 160
 161     opendir(DIR, $dn)
 162         or die("$dn: opendir(): $!\n");
 163     while ($entry = readdir(DIR)) {
 164         next if ($entry eq '.' || $entry eq '..');
 165         if (-d "$dn/$entry") {
 166             scan_recurse("$dn/$entry");
 167         } elsif ($entry =~ m/^\d+$/) {
 168             eval {
 169                 scan_pr("$dn/$entry");
 170             };
 171         }
 172     }
 173     closedir(DIR);
 174 }
 175
 176 sub count_prs() {
 177
 178     my $pr;                     # Iterator
 179     my @events;                 # Creations or closures
 180     my $event;                  # Iterator
 181     my $count;                  # PR count
 182
 183     if ($TTY) {
 184         print(int(@EVENTS), " events\n");
 185     }
 186     @COUNT = ( [ 0, 0 ] );
 187     foreach $event (sort({ $a->[0] <=> $b->[0] } @EVENTS)) {
 188         if ($event->[0] == $COUNT[-1]->[0]) {
 189             $COUNT[-1]->[1] += $event->[1];
 190         } else {
 191             push(@COUNT, [ $event->[0], $COUNT[-1]->[1] + $event->[1] ]);
 192         }
 193     }
 194     if (@COUNT > 1) {
 195         $COUNT[0]->[0] = $COUNT[1]->[0] - 1;
 196         unshift(@COUNT, [ 0, 0 ]);
 197     }
 198 }
 199
 200 sub gnuplot(@) {
 201     my @commands = @_;          # Commands
 202
 203     my $pid;                    # Child PID
 204     local *PIPE;                # Pipe
 205
 206     open(PIPE, &GNUPLOT)
 207         or die("fork(): $!\n");
 208     print(PIPE join("\n", @commands, ""));
 209     close(PIPE);
 210     if ($? & 0x7f) {
 211         die("gnuplot caught a signal " . ($? & 0x7f) . "\n");
 212     } elsif ($?) {
 213         die("gunplot returned exit code " . ($? >> 8) . "\n");
 214     }
 215 }
 216
 217 sub write_dat_file($) {
 218     my $fn = shift;             # File name
 219
 220     local *FILE;                # File handle
 221     my $datum;                  # Iterator
 222
 223     sysopen(FILE, $fn, O_RDWR|O_CREAT|O_TRUNC, 0640)
 224         or die("$fn: open(): $!\n");
 225     foreach $datum (@COUNT) {
 226         print(FILE strftime(&TIMEFMT, localtime($datum->[0])),
 227               " ", $datum->[1],
 228               " ", $COUNT[-1]->[1],
 229               "\n");
 230     }
 231     close(FILE);
 232 }
 233
 234 sub graph_open_prs($$$$$) {
 235     my $datfn = shift;          # Data file name
 236     my $fn = shift;             # File name
 237     my $start = shift;          # Starting date
 238     my $end = shift;            # Ending date
 239     my $title = shift;          # Title
 240
 241     my $tickfmt;                # Tick format
 242     my $timefmt;                # Time format
 243
 244     if ($end - $start > 86400 * 30) {
 245         $tickfmt = "%Y-%m-%d";
 246     } else {
 247         $tickfmt = "%m-%d";
 248     }
 249     $start = strftime(&TIMEFMT, localtime($start));
 250     $end = strftime(&TIMEFMT, localtime($end));
 251     $timefmt = &TIMEFMT;
 252     gnuplot("
 253 set term png small color
 254 set xdata time
 255 set timefmt '$timefmt'
 256 set data style line
 257 set grid
 258 set output '$fn'
 259 set format x '$tickfmt'
 260 set xrange ['$start':'$end']
 261 set yrange [0:*]
 262 set title '$title'
 263 plot '$datfn' using 1:2 title 'Open PRs'
 264 ");
 265 }
 266
 267 sub pr_stat_summary() {
 268
 269     my $n;                      # Loop counter
 270
 271     # Overall stats
 272     printf("Total PRs in database: %d\n", scalar(keys(%PR)));
 273     printf("Open PRs: %d\n", scalar(keys(%PR)) - $STATE{'closed'});
 274     print("\n");
 275
 276     # Category ranking
 277     print("Number of PRs in each category:\n");
 278     foreach (sort({ $CATEGORY{$b} <=> $CATEGORY{$a} } keys(%CATEGORY))) {
 279         printf("%12s: %d\n", $_, $CATEGORY{$_});
 280     }
 281     print("\n");
 282
 283     # State ranking
 284     print("Number of PRs in each state:\n");
 285     foreach (sort({ $STATE{$b} <=> $STATE{$a} } keys(%STATE))) {
 286         printf("%12s: %d\n", $_, $STATE{$_});
 287     }
 288     print("\n");
 289
 290     # Closer ranking
 291     print("Top ten PR busters:\n");
 292     $n = 0;
 293     foreach (sort({ $CLOSER{$b} <=> $CLOSER{$a} } keys(%CLOSER))) {
 294         printf("    %2d. %s (%d)\n", ++$n, $_, $CLOSER{$_});
 295         last if ($n == 10);
 296     }
 297     print("\n");
 298
 299     # Owner ranking
 300     print("Top ten owners of open PRs:\n");
 301     $n = 0;
 302     foreach (sort({ $OWNER{$b} <=> $OWNER{$a} } keys(%OWNER))) {
 303         next if (m/^freebsd-(bugs|doc|ports)$/);
 304         printf("    %2d. %s (%d)\n", ++$n, $_, $OWNER{$_});
 305         last if ($n == 10);
 306     }
 307     print("\n");
 308
 309 }
 310
 311 MAIN:{
 312     $| = 1;
 313     $TTY = isatty(*STDOUT);
 314
 315     # Perl lacks strptime(), and its mktime() doesn't accept a
 316     # timezone argument, so we set our local timezone to that of the
 317     # FreeBSD cluster and use localtime() instead.
 318     $ENV{'TZ'} = &GNATS_TZ;
 319     tzset();
 320     $NOW = time();
 321
 322     # Read and count PRs
 323     if (@ARGV) {
 324         foreach (@ARGV) {
 325             scan_recurse(join('/', &GNATS_DIR, $_));
 326         }
 327     } else {
 328         scan_recurse(&GNATS_DIR);
 329     }
 330     if ($TTY) {
 331         print("\r", scalar(keys(%PR)), " problem reports scanned\n");
 332     }
 333
 334     # Generate graphs
 335     if (0) {
 336     count_prs();
 337     write_dat_file(&DATFILE);
 338     graph_open_prs(&DATFILE, "week.png", $NOW - (86400 * 7) + 1, $NOW,
 339                    "Open FreeBSD problem reports (week view)");
 340     graph_open_prs(&DATFILE, "month.png", $NOW - (86400 * 30) + 1, $NOW,
 341                    "Open FreeBSD problem reports (month view)");
 342     graph_open_prs(&DATFILE, "year.png", $NOW - (86400 * 365) + 1, $NOW,
 343                    "Open FreeBSD problem reports (year view)");
 344     graph_open_prs(&DATFILE, "ever.png", $COUNT[1]->[0], $NOW,
 345                    "Open FreeBSD problem reports (project history)");
 346     graph_open_prs(&DATFILE, "drive.png", mktime(0, 0, 0, 29, 4, 101), $NOW,
 347                    "Open FreeBSD problem reports (drive progress)");
 348     unlink(&DATFILE);
 349     }
 350
 351     # Print summary
 352     pr_stat_summary();
 353 }