186309Sdes#!/usr/bin/perl -w 286309Sdes#- 3228953Suqs# Copyright (c) 2001 Dag-Erling Co��dan Sm��rgrav 486309Sdes# All rights reserved. 586309Sdes# 686309Sdes# Redistribution and use in source and binary forms, with or without 786309Sdes# modification, are permitted provided that the following conditions 886309Sdes# are met: 986309Sdes# 1. Redistributions of source code must retain the above copyright 1086309Sdes# notice, this list of conditions and the following disclaimer 1186309Sdes# in this position and unchanged. 1286309Sdes# 2. Redistributions in binary form must reproduce the above copyright 1386309Sdes# notice, this list of conditions and the following disclaimer in the 1486309Sdes# documentation and/or other materials provided with the distribution. 1586309Sdes# 3. The name of the author may not be used to endorse or promote products 1686309Sdes# derived from this software without specific prior written permission. 1786309Sdes# 1886309Sdes# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 1986309Sdes# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 2086309Sdes# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 2186309Sdes# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 2286309Sdes# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 2386309Sdes# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 2486309Sdes# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 2586309Sdes# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 2686309Sdes# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 2786309Sdes# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 2886309Sdes# 2986309Sdes# $FreeBSD$ 3086309Sdes# 3186309Sdes 3286309Sdesuse strict; 3386309Sdesuse Data::Dumper; 3486309Sdesuse Fcntl; 3586309Sdesuse POSIX qw(isatty mktime strftime tzset); 3686312Sdesuse vars qw($TTY $NOW %MONTH %PR @EVENTS @COUNT @AGE); 3786312Sdesuse vars qw(%STATE %CATEGORY %OWNER %CLOSER); 3886309Sdes 3986309Sdes%MONTH = ( 4086309Sdes 'Jan' => 1, 4186309Sdes 'Feb' => 2, 4286309Sdes 'Mar' => 3, 4386309Sdes 'Apr' => 4, 4486309Sdes 'May' => 5, 4586309Sdes 'Jun' => 6, 4686309Sdes 'Jul' => 7, 4786309Sdes 'Aug' => 8, 4886309Sdes 'Sep' => 9, 4986309Sdes 'Oct' => 10, 5086309Sdes 'Nov' => 11, 5186309Sdes 'Dec' => 12, 5286309Sdes); 5386309Sdes 5486312Sdes@AGE = ( 5586312Sdes [ 0, 7, 0 ], # Less than one week 5686312Sdes [ 7, 30, 0 ], # One week to one month 5786312Sdes [ 30, 90, 0 ], # One to three months 5886312Sdes [ 90, 365, 0 ], # Three months to a year 5986312Sdes [ 365, 1095, 0 ], # One to three years 6086312Sdes [ 1095, 999999, 0 ], # More than three years 6186312Sdes); 6286312Sdes 6386309Sdessub GNATS_DIR { "/home/gnats" } 6486309Sdessub GNATS_TZ { "America/Los_Angeles" } 6586310Sdessub DATFILE { "/tmp/prstats.dat.$$" } 6686309Sdessub GNUPLOT { "|/usr/local/bin/gnuplot /dev/stdin" } 6786309Sdessub TIMEFMT { "%Y-%m-%d/%H:%M:%S" } 6886309Sdes 6986309Sdessub parse_date($) { 7086309Sdes my $date = shift; # Date to parse 7186309Sdes 7286309Sdes my $year; 7386309Sdes my $month; 7486309Sdes my $day; 7586309Sdes my $hour; 7686309Sdes my $minute; 7786309Sdes my $second; 7886309Sdes 7986309Sdes $date =~ s/\s+/ /g; 8086309Sdes $date =~ s/^(Mon|Tue|Wed|Thu|Fri|Sat|Sun)\w*\s*//; 8186309Sdes if ($date =~ m/^(\w{3}) (\d\d?) (\d\d):(\d\d):(\d\d) [A-Z ]*(\d{4})$/) { 8286309Sdes ($month, $day, $hour, $minute, $second, $year) = 8386309Sdes ($1, $2, $3, $4, $5, $6); 8486309Sdes } else { 8586309Sdes die("Unrecognized date format: $date\n"); 8686309Sdes } 8786309Sdes defined($month = $MONTH{$month}) 8886309Sdes or die("Invalid month: $month\n"); 8986309Sdes return mktime($second, $minute, $hour, $day, $month - 1, $year - 1900); 9086309Sdes} 9186309Sdes 9286309Sdessub scan_pr($) { 9386309Sdes my $fn = shift; # File name 9486309Sdes 9586309Sdes local *FILE; # File handle 9686309Sdes my $pr = {}; # PR hash 9786312Sdes my $age; # PR age 9886309Sdes 9986309Sdes sysopen(FILE, $fn, O_RDONLY) 10086309Sdes or die("$fn: open(): $!\n"); 10186309Sdes while (<FILE>) { 10286309Sdes if (m/^>([A-Za-z-]+):\s+(.*?)\s*$/o || 10386312Sdes m/^(Category|Responsible|State-Changed-[A-Za-z-]+):\s+(.*?)\s*$/o) { 10486309Sdes $pr->{lc($1)} = $2; 10586309Sdes } 10686309Sdes } 10786309Sdes 10886309Sdes exists($PR{$pr->{'number'}}) 10986309Sdes and die("$fn: PR $pr->{'number'} already exists\n"); 11086309Sdes 11186309Sdes if ($TTY) { 11286309Sdes print(" "x40, "\r", scalar(keys(%PR)), 11386309Sdes " $pr->{'category'}/$pr->{'number'} "); 11486309Sdes } 11586309Sdes 11686309Sdes foreach ('arrival-date', 'closed-date', 'last-modified', 11786309Sdes 'state-changed-when') { 11886309Sdes if (defined($pr->{$_}) && length($pr->{$_})) { 11986309Sdes $pr->{$_} = parse_date($pr->{$_}); 12086309Sdes } 12186309Sdes } 12286309Sdes 12386309Sdes $pr->{'_created'} = $pr->{'arrival-date'}; 12486309Sdes if ($pr->{'state'} eq 'closed') { 12586309Sdes $pr->{'_closed'} = $pr->{'closed-date'} || $pr->{'state-changed-when'}; 12686309Sdes $pr->{'_closed_by'} = $pr->{'state-changed-by'}; 12794738Sdes if (!defined($pr->{'_closed_by'})) { 12894738Sdes warn("PR $pr->{'category'}/$pr->{'number'} is incomplete\n"); 12994738Sdes return; 13094738Sdes } 13186312Sdes ++$CLOSER{$pr->{'_closed_by'}}; 13286312Sdes } else { 13386312Sdes $age = $pr->{'arrival-date'} / 86400; 13486312Sdes foreach (@AGE) { 13586312Sdes if ($age >= $_->[0] && $age < $_->[1]) { 13686312Sdes ++$_->[2]; 13786312Sdes last; 13886312Sdes } 13986312Sdes } 14086312Sdes ++$CATEGORY{$pr->{'category'}}; 14186312Sdes ++$OWNER{$pr->{'responsible'}}; 14286309Sdes } 14386312Sdes ++$STATE{$pr->{'state'}}; 14486309Sdes 14586309Sdes $PR{$pr->{'number'}} = { 14686312Sdes 'category' => $pr->{'category'}, 14786309Sdes #'number' => $pr->{'number'}, 14886312Sdes 'responsible' => $pr->{'responsible'}, 14986309Sdes 'created' => $pr->{'created'}, 15086309Sdes 'closed' => $pr->{'closed'}, 15186312Sdes 'closer' => $pr->{'_closed_by'}, 15286309Sdes }; 15386309Sdes push(@EVENTS, [ $pr->{'_created'}, +1 ]); 15486309Sdes push(@EVENTS, [ $pr->{'_closed'}, -1 ]) 15586309Sdes if defined($pr->{'_closed'}); 15686309Sdes} 15786309Sdes 15886309Sdessub scan_recurse($); 15986309Sdessub scan_recurse($) { 16086309Sdes my $dn = shift; # Directory name 16186309Sdes 16286309Sdes local *DIR; # Directory handle 16386309Sdes my $entry; # Entry 16486309Sdes 16586309Sdes opendir(DIR, $dn) 16686309Sdes or die("$dn: opendir(): $!\n"); 16786309Sdes while ($entry = readdir(DIR)) { 16886309Sdes next if ($entry eq '.' || $entry eq '..'); 16986309Sdes if (-d "$dn/$entry") { 17086309Sdes scan_recurse("$dn/$entry"); 17186309Sdes } elsif ($entry =~ m/^\d+$/) { 17286309Sdes eval { 17386309Sdes scan_pr("$dn/$entry"); 17486309Sdes }; 17586309Sdes } 17686309Sdes } 17786309Sdes closedir(DIR); 17886309Sdes} 17986309Sdes 18086309Sdessub count_prs() { 18186309Sdes 18286309Sdes my $pr; # Iterator 18386309Sdes my @events; # Creations or closures 18486309Sdes my $event; # Iterator 18586309Sdes my $count; # PR count 18686309Sdes 18786312Sdes if ($TTY) { 18886312Sdes print(int(@EVENTS), " events\n"); 18986312Sdes } 19086309Sdes @COUNT = ( [ 0, 0 ] ); 19186309Sdes foreach $event (sort({ $a->[0] <=> $b->[0] } @EVENTS)) { 19286309Sdes if ($event->[0] == $COUNT[-1]->[0]) { 19386309Sdes $COUNT[-1]->[1] += $event->[1]; 19486309Sdes } else { 19586309Sdes push(@COUNT, [ $event->[0], $COUNT[-1]->[1] + $event->[1] ]); 19686309Sdes } 19786309Sdes } 19886309Sdes if (@COUNT > 1) { 19986309Sdes $COUNT[0]->[0] = $COUNT[1]->[0] - 1; 20086309Sdes unshift(@COUNT, [ 0, 0 ]); 20186309Sdes } 20286309Sdes} 20386309Sdes 20486309Sdessub gnuplot(@) { 20586309Sdes my @commands = @_; # Commands 20686309Sdes 20786309Sdes my $pid; # Child PID 20886309Sdes local *PIPE; # Pipe 20986309Sdes 21086309Sdes open(PIPE, &GNUPLOT) 21186309Sdes or die("fork(): $!\n"); 21286309Sdes print(PIPE join("\n", @commands, "")); 21386309Sdes close(PIPE); 21486309Sdes if ($? & 0x7f) { 21586309Sdes die("gnuplot caught a signal " . ($? & 0x7f) . "\n"); 21686309Sdes } elsif ($?) { 21786309Sdes die("gunplot returned exit code " . ($? >> 8) . "\n"); 21886309Sdes } 21986309Sdes} 22086309Sdes 22186309Sdessub write_dat_file($) { 22286309Sdes my $fn = shift; # File name 22386309Sdes 22486309Sdes local *FILE; # File handle 22586309Sdes my $datum; # Iterator 22686309Sdes 22786309Sdes sysopen(FILE, $fn, O_RDWR|O_CREAT|O_TRUNC, 0640) 22886309Sdes or die("$fn: open(): $!\n"); 22986309Sdes foreach $datum (@COUNT) { 23086309Sdes print(FILE strftime(&TIMEFMT, localtime($datum->[0])), 23186309Sdes " ", $datum->[1], 23286309Sdes " ", $COUNT[-1]->[1], 23386309Sdes "\n"); 23486309Sdes } 23586309Sdes close(FILE); 23686309Sdes} 23786309Sdes 23886309Sdessub graph_open_prs($$$$$) { 23986309Sdes my $datfn = shift; # Data file name 24086309Sdes my $fn = shift; # File name 24186309Sdes my $start = shift; # Starting date 24286309Sdes my $end = shift; # Ending date 24386309Sdes my $title = shift; # Title 24486309Sdes 24586309Sdes my $tickfmt; # Tick format 24686309Sdes my $timefmt; # Time format 24786309Sdes 24886309Sdes if ($end - $start > 86400 * 30) { 24986309Sdes $tickfmt = "%Y-%m-%d"; 25086309Sdes } else { 25186309Sdes $tickfmt = "%m-%d"; 25286309Sdes } 25386309Sdes $start = strftime(&TIMEFMT, localtime($start)); 25486309Sdes $end = strftime(&TIMEFMT, localtime($end)); 25586309Sdes $timefmt = &TIMEFMT; 25686309Sdes gnuplot(" 25786309Sdesset term png small color 25886309Sdesset xdata time 25986309Sdesset timefmt '$timefmt' 26086309Sdesset data style line 26186309Sdesset grid 26286309Sdesset output '$fn' 26386309Sdesset format x '$tickfmt' 26486309Sdesset xrange ['$start':'$end'] 26586309Sdesset yrange [0:*] 26686309Sdesset title '$title' 26786309Sdesplot '$datfn' using 1:2 title 'Open PRs' 26886309Sdes"); 26986309Sdes} 27086309Sdes 27186312Sdessub pr_stat_summary() { 27286312Sdes 27386312Sdes my $n; # Loop counter 27486312Sdes 27586312Sdes # Overall stats 27686312Sdes printf("Total PRs in database: %d\n", scalar(keys(%PR))); 27786312Sdes printf("Open PRs: %d\n", scalar(keys(%PR)) - $STATE{'closed'}); 27886312Sdes print("\n"); 27986312Sdes 28086312Sdes # Category ranking 28186312Sdes print("Number of PRs in each category:\n"); 28286312Sdes foreach (sort({ $CATEGORY{$b} <=> $CATEGORY{$a} } keys(%CATEGORY))) { 28386312Sdes printf("%12s: %d\n", $_, $CATEGORY{$_}); 28486312Sdes } 28586312Sdes print("\n"); 28686312Sdes 28786312Sdes # State ranking 28886312Sdes print("Number of PRs in each state:\n"); 28986312Sdes foreach (sort({ $STATE{$b} <=> $STATE{$a} } keys(%STATE))) { 29086312Sdes printf("%12s: %d\n", $_, $STATE{$_}); 29186312Sdes } 29286312Sdes print("\n"); 29386312Sdes 29486312Sdes # Closer ranking 29586312Sdes print("Top ten PR busters:\n"); 29686312Sdes $n = 0; 29786312Sdes foreach (sort({ $CLOSER{$b} <=> $CLOSER{$a} } keys(%CLOSER))) { 29886312Sdes printf(" %2d. %s (%d)\n", ++$n, $_, $CLOSER{$_}); 29986312Sdes last if ($n == 10); 30086312Sdes } 30186312Sdes print("\n"); 30286312Sdes 30386312Sdes # Owner ranking 30486312Sdes print("Top ten owners of open PRs:\n"); 30586312Sdes $n = 0; 30686312Sdes foreach (sort({ $OWNER{$b} <=> $OWNER{$a} } keys(%OWNER))) { 30786312Sdes next if (m/^freebsd-(bugs|doc|ports)$/); 30886312Sdes printf(" %2d. %s (%d)\n", ++$n, $_, $OWNER{$_}); 30986312Sdes last if ($n == 10); 31086312Sdes } 31186312Sdes print("\n"); 31286312Sdes 31386312Sdes} 31486312Sdes 31586309SdesMAIN:{ 31686309Sdes $| = 1; 31786309Sdes $TTY = isatty(*STDOUT); 31886309Sdes 31986309Sdes # Perl lacks strptime(), and its mktime() doesn't accept a 32086309Sdes # timezone argument, so we set our local timezone to that of the 32186309Sdes # FreeBSD cluster and use localtime() instead. 32286309Sdes $ENV{'TZ'} = &GNATS_TZ; 32386309Sdes tzset(); 32486312Sdes $NOW = time(); 32586309Sdes 32686312Sdes # Read and count PRs 32786309Sdes if (@ARGV) { 32886309Sdes foreach (@ARGV) { 32986309Sdes scan_recurse(join('/', &GNATS_DIR, $_)); 33086309Sdes } 33186309Sdes } else { 33286309Sdes scan_recurse(&GNATS_DIR); 33386309Sdes } 33486309Sdes if ($TTY) { 33586309Sdes print("\r", scalar(keys(%PR)), " problem reports scanned\n"); 33686309Sdes } 33786309Sdes 33886312Sdes # Generate graphs 33986312Sdes if (0) { 34086309Sdes count_prs(); 34186309Sdes write_dat_file(&DATFILE); 34286312Sdes graph_open_prs(&DATFILE, "week.png", $NOW - (86400 * 7) + 1, $NOW, 34386309Sdes "Open FreeBSD problem reports (week view)"); 34486312Sdes graph_open_prs(&DATFILE, "month.png", $NOW - (86400 * 30) + 1, $NOW, 34586309Sdes "Open FreeBSD problem reports (month view)"); 34686312Sdes graph_open_prs(&DATFILE, "year.png", $NOW - (86400 * 365) + 1, $NOW, 34786309Sdes "Open FreeBSD problem reports (year view)"); 34886312Sdes graph_open_prs(&DATFILE, "ever.png", $COUNT[1]->[0], $NOW, 34986309Sdes "Open FreeBSD problem reports (project history)"); 35086312Sdes graph_open_prs(&DATFILE, "drive.png", mktime(0, 0, 0, 29, 4, 101), $NOW, 35186309Sdes "Open FreeBSD problem reports (drive progress)"); 35286310Sdes unlink(&DATFILE); 35386312Sdes } 35486312Sdes 35586312Sdes # Print summary 35686312Sdes pr_stat_summary(); 35786309Sdes} 358