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         if (!defined($pr->{'_closed_by'})) {
 128             warn("PR $pr->{'category'}/$pr->{'number'} is incomplete\n");
 129             return;
 130         }
 131         ++$CLOSER{$pr->{'_closed_by'}};
 132     } else {
 133         $age = $pr->{'arrival-date'} / 86400;
 134         foreach (@AGE) {
 135             if ($age >= $_->[0] && $age < $_->[1]) {
 136                 ++$_->[2];
 137                 last;
 138             }
 139         }
 140         ++$CATEGORY{$pr->{'category'}};
 141         ++$OWNER{$pr->{'responsible'}};
 142     }
 143     ++$STATE{$pr->{'state'}};
 144
 145     $PR{$pr->{'number'}} = {
 146         'category'      => $pr->{'category'},
 147         #'number'       => $pr->{'number'},
 148         'responsible'   => $pr->{'responsible'},
 149         'created'       => $pr->{'created'},
 150         'closed'        => $pr->{'closed'},
 151         'closer'        => $pr->{'_closed_by'},
 152     };
 153     push(@EVENTS, [ $pr->{'_created'}, +1 ]);
 154     push(@EVENTS, [ $pr->{'_closed'}, -1 ])
 155             if defined($pr->{'_closed'});
 156 }
 157
 158 sub scan_recurse($);
 159 sub scan_recurse($) {
 160     my $dn = shift;             # Directory name
 161
 162     local *DIR;                 # Directory handle
 163     my $entry;                  # Entry
 164
 165     opendir(DIR, $dn)
 166         or die("$dn: opendir(): $!\n");
 167     while ($entry = readdir(DIR)) {
 168         next if ($entry eq '.' || $entry eq '..');
 169         if (-d "$dn/$entry") {
 170             scan_recurse("$dn/$entry");
 171         } elsif ($entry =~ m/^\d+$/) {
 172             eval {
 173                 scan_pr("$dn/$entry");
 174             };
 175         }
 176     }
 177     closedir(DIR);
 178 }
 179
 180 sub count_prs() {
 181
 182     my $pr;                     # Iterator
 183     my @events;                 # Creations or closures
 184     my $event;                  # Iterator
 185     my $count;                  # PR count
 186
 187     if ($TTY) {
 188         print(int(@EVENTS), " events\n");
 189     }
 190     @COUNT = ( [ 0, 0 ] );
 191     foreach $event (sort({ $a->[0] <=> $b->[0] } @EVENTS)) {
 192         if ($event->[0] == $COUNT[-1]->[0]) {
 193             $COUNT[-1]->[1] += $event->[1];
 194         } else {
 195             push(@COUNT, [ $event->[0], $COUNT[-1]->[1] + $event->[1] ]);
 196         }
 197     }
 198     if (@COUNT > 1) {
 199         $COUNT[0]->[0] = $COUNT[1]->[0] - 1;
 200         unshift(@COUNT, [ 0, 0 ]);
 201     }
 202 }
 203
 204 sub gnuplot(@) {
 205     my @commands = @_;          # Commands
 206
 207     my $pid;                    # Child PID
 208     local *PIPE;                # Pipe
 209
 210     open(PIPE, &GNUPLOT)
 211         or die("fork(): $!\n");
 212     print(PIPE join("\n", @commands, ""));
 213     close(PIPE);
 214     if ($? & 0x7f) {
 215         die("gnuplot caught a signal " . ($? & 0x7f) . "\n");
 216     } elsif ($?) {
 217         die("gunplot returned exit code " . ($? >> 8) . "\n");
 218     }
 219 }
 220
 221 sub write_dat_file($) {
 222     my $fn = shift;             # File name
 223
 224     local *FILE;                # File handle
 225     my $datum;                  # Iterator
 226
 227     sysopen(FILE, $fn, O_RDWR|O_CREAT|O_TRUNC, 0640)
 228         or die("$fn: open(): $!\n");
 229     foreach $datum (@COUNT) {
 230         print(FILE strftime(&TIMEFMT, localtime($datum->[0])),
 231               " ", $datum->[1],
 232               " ", $COUNT[-1]->[1],
 233               "\n");
 234     }
 235     close(FILE);
 236 }
 237
 238 sub graph_open_prs($$$$$) {
 239     my $datfn = shift;          # Data file name
 240     my $fn = shift;             # File name
 241     my $start = shift;          # Starting date
 242     my $end = shift;            # Ending date
 243     my $title = shift;          # Title
 244
 245     my $tickfmt;                # Tick format
 246     my $timefmt;                # Time format
 247
 248     if ($end - $start > 86400 * 30) {
 249         $tickfmt = "%Y-%m-%d";
 250     } else {
 251         $tickfmt = "%m-%d";
 252     }
 253     $start = strftime(&TIMEFMT, localtime($start));
 254     $end = strftime(&TIMEFMT, localtime($end));
 255     $timefmt = &TIMEFMT;
 256     gnuplot("
 257 set term png small color
 258 set xdata time
 259 set timefmt '$timefmt'
 260 set data style line
 261 set grid
 262 set output '$fn'
 263 set format x '$tickfmt'
 264 set xrange ['$start':'$end']
 265 set yrange [0:*]
 266 set title '$title'
 267 plot '$datfn' using 1:2 title 'Open PRs'
 268 ");
 269 }
 270
 271 sub pr_stat_summary() {
 272
 273     my $n;                      # Loop counter
 274
 275     # Overall stats
 276     printf("Total PRs in database: %d\n", scalar(keys(%PR)));
 277     printf("Open PRs: %d\n", scalar(keys(%PR)) - $STATE{'closed'});
 278     print("\n");
 279
 280     # Category ranking
 281     print("Number of PRs in each category:\n");
 282     foreach (sort({ $CATEGORY{$b} <=> $CATEGORY{$a} } keys(%CATEGORY))) {
 283         printf("%12s: %d\n", $_, $CATEGORY{$_});
 284     }
 285     print("\n");
 286
 287     # State ranking
 288     print("Number of PRs in each state:\n");
 289     foreach (sort({ $STATE{$b} <=> $STATE{$a} } keys(%STATE))) {
 290         printf("%12s: %d\n", $_, $STATE{$_});
 291     }
 292     print("\n");
 293
 294     # Closer ranking
 295     print("Top ten PR busters:\n");
 296     $n = 0;
 297     foreach (sort({ $CLOSER{$b} <=> $CLOSER{$a} } keys(%CLOSER))) {
 298         printf("    %2d. %s (%d)\n", ++$n, $_, $CLOSER{$_});
 299         last if ($n == 10);
 300     }
 301     print("\n");
 302
 303     # Owner ranking
 304     print("Top ten owners of open PRs:\n");
 305     $n = 0;
 306     foreach (sort({ $OWNER{$b} <=> $OWNER{$a} } keys(%OWNER))) {
 307         next if (m/^freebsd-(bugs|doc|ports)$/);
 308         printf("    %2d. %s (%d)\n", ++$n, $_, $OWNER{$_});
 309         last if ($n == 10);
 310     }
 311     print("\n");
 312
 313 }
 314
 315 MAIN:{
 316     $| = 1;
 317     $TTY = isatty(*STDOUT);
 318
 319     # Perl lacks strptime(), and its mktime() doesn't accept a
 320     # timezone argument, so we set our local timezone to that of the
 321     # FreeBSD cluster and use localtime() instead.
 322     $ENV{'TZ'} = &GNATS_TZ;
 323     tzset();
 324     $NOW = time();
 325
 326     # Read and count PRs
 327     if (@ARGV) {
 328         foreach (@ARGV) {
 329             scan_recurse(join('/', &GNATS_DIR, $_));
 330         }
 331     } else {
 332         scan_recurse(&GNATS_DIR);
 333     }
 334     if ($TTY) {
 335         print("\r", scalar(keys(%PR)), " problem reports scanned\n");
 336     }
 337
 338     # Generate graphs
 339     if (0) {
 340     count_prs();
 341     write_dat_file(&DATFILE);
 342     graph_open_prs(&DATFILE, "week.png", $NOW - (86400 * 7) + 1, $NOW,
 343                    "Open FreeBSD problem reports (week view)");
 344     graph_open_prs(&DATFILE, "month.png", $NOW - (86400 * 30) + 1, $NOW,
 345                    "Open FreeBSD problem reports (month view)");
 346     graph_open_prs(&DATFILE, "year.png", $NOW - (86400 * 365) + 1, $NOW,
 347                    "Open FreeBSD problem reports (year view)");
 348     graph_open_prs(&DATFILE, "ever.png", $COUNT[1]->[0], $NOW,
 349                    "Open FreeBSD problem reports (project history)");
 350     graph_open_prs(&DATFILE, "drive.png", mktime(0, 0, 0, 29, 4, 101), $NOW,
 351                    "Open FreeBSD problem reports (drive progress)");
 352     unlink(&DATFILE);
 353     }
 354
 355     # Print summary
 356     pr_stat_summary();
 357 }