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 32use strict; 33use Data::Dumper; 34use Fcntl; 35use POSIX qw(isatty mktime strftime tzset); 36use vars qw($TTY $NOW %MONTH %PR @EVENTS @COUNT @AGE); 37use 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 63sub GNATS_DIR { "/home/gnats" } 64sub GNATS_TZ { "America/Los_Angeles" } 65sub DATFILE { "/tmp/prstats.dat.$$" } 66sub GNUPLOT { "|/usr/local/bin/gnuplot /dev/stdin" } 67sub TIMEFMT { "%Y-%m-%d/%H:%M:%S" } 68 69sub 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 92sub 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 158sub scan_recurse($); 159sub 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 180sub 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 204sub 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 221sub 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 238sub 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(" 257set term png small color 258set xdata time 259set timefmt '$timefmt' 260set data style line 261set grid 262set output '$fn' 263set format x '$tickfmt' 264set xrange ['$start':'$end'] 265set yrange [0:*] 266set title '$title' 267plot '$datfn' using 1:2 title 'Open PRs' 268"); 269} 270 271sub 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 315MAIN:{ 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} 358