| Current Path : /usr/src/tools/tools/prstats/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
| Current File : //usr/src/tools/tools/prstats/prstats.pl |
#!/usr/bin/perl -w
#-
# Copyright (c) 2001 Dag-Erling Coïdan Smørgrav
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer
# in this position and unchanged.
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# 3. The name of the author may not be used to endorse or promote products
# derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# $FreeBSD: release/9.1.0/tools/tools/prstats/prstats.pl 94738 2002-04-15 06:36:22Z des $
#
use strict;
use Data::Dumper;
use Fcntl;
use POSIX qw(isatty mktime strftime tzset);
use vars qw($TTY $NOW %MONTH %PR @EVENTS @COUNT @AGE);
use vars qw(%STATE %CATEGORY %OWNER %CLOSER);
%MONTH = (
'Jan' => 1,
'Feb' => 2,
'Mar' => 3,
'Apr' => 4,
'May' => 5,
'Jun' => 6,
'Jul' => 7,
'Aug' => 8,
'Sep' => 9,
'Oct' => 10,
'Nov' => 11,
'Dec' => 12,
);
@AGE = (
[ 0, 7, 0 ], # Less than one week
[ 7, 30, 0 ], # One week to one month
[ 30, 90, 0 ], # One to three months
[ 90, 365, 0 ], # Three months to a year
[ 365, 1095, 0 ], # One to three years
[ 1095, 999999, 0 ], # More than three years
);
sub GNATS_DIR { "/home/gnats" }
sub GNATS_TZ { "America/Los_Angeles" }
sub DATFILE { "/tmp/prstats.dat.$$" }
sub GNUPLOT { "|/usr/local/bin/gnuplot /dev/stdin" }
sub TIMEFMT { "%Y-%m-%d/%H:%M:%S" }
sub parse_date($) {
my $date = shift; # Date to parse
my $year;
my $month;
my $day;
my $hour;
my $minute;
my $second;
$date =~ s/\s+/ /g;
$date =~ s/^(Mon|Tue|Wed|Thu|Fri|Sat|Sun)\w*\s*//;
if ($date =~ m/^(\w{3}) (\d\d?) (\d\d):(\d\d):(\d\d) [A-Z ]*(\d{4})$/) {
($month, $day, $hour, $minute, $second, $year) =
($1, $2, $3, $4, $5, $6);
} else {
die("Unrecognized date format: $date\n");
}
defined($month = $MONTH{$month})
or die("Invalid month: $month\n");
return mktime($second, $minute, $hour, $day, $month - 1, $year - 1900);
}
sub scan_pr($) {
my $fn = shift; # File name
local *FILE; # File handle
my $pr = {}; # PR hash
my $age; # PR age
sysopen(FILE, $fn, O_RDONLY)
or die("$fn: open(): $!\n");
while (<FILE>) {
if (m/^>([A-Za-z-]+):\s+(.*?)\s*$/o ||
m/^(Category|Responsible|State-Changed-[A-Za-z-]+):\s+(.*?)\s*$/o) {
$pr->{lc($1)} = $2;
}
}
exists($PR{$pr->{'number'}})
and die("$fn: PR $pr->{'number'} already exists\n");
if ($TTY) {
print(" "x40, "\r", scalar(keys(%PR)),
" $pr->{'category'}/$pr->{'number'} ");
}
foreach ('arrival-date', 'closed-date', 'last-modified',
'state-changed-when') {
if (defined($pr->{$_}) && length($pr->{$_})) {
$pr->{$_} = parse_date($pr->{$_});
}
}
$pr->{'_created'} = $pr->{'arrival-date'};
if ($pr->{'state'} eq 'closed') {
$pr->{'_closed'} = $pr->{'closed-date'} || $pr->{'state-changed-when'};
$pr->{'_closed_by'} = $pr->{'state-changed-by'};
if (!defined($pr->{'_closed_by'})) {
warn("PR $pr->{'category'}/$pr->{'number'} is incomplete\n");
return;
}
++$CLOSER{$pr->{'_closed_by'}};
} else {
$age = $pr->{'arrival-date'} / 86400;
foreach (@AGE) {
if ($age >= $_->[0] && $age < $_->[1]) {
++$_->[2];
last;
}
}
++$CATEGORY{$pr->{'category'}};
++$OWNER{$pr->{'responsible'}};
}
++$STATE{$pr->{'state'}};
$PR{$pr->{'number'}} = {
'category' => $pr->{'category'},
#'number' => $pr->{'number'},
'responsible' => $pr->{'responsible'},
'created' => $pr->{'created'},
'closed' => $pr->{'closed'},
'closer' => $pr->{'_closed_by'},
};
push(@EVENTS, [ $pr->{'_created'}, +1 ]);
push(@EVENTS, [ $pr->{'_closed'}, -1 ])
if defined($pr->{'_closed'});
}
sub scan_recurse($);
sub scan_recurse($) {
my $dn = shift; # Directory name
local *DIR; # Directory handle
my $entry; # Entry
opendir(DIR, $dn)
or die("$dn: opendir(): $!\n");
while ($entry = readdir(DIR)) {
next if ($entry eq '.' || $entry eq '..');
if (-d "$dn/$entry") {
scan_recurse("$dn/$entry");
} elsif ($entry =~ m/^\d+$/) {
eval {
scan_pr("$dn/$entry");
};
}
}
closedir(DIR);
}
sub count_prs() {
my $pr; # Iterator
my @events; # Creations or closures
my $event; # Iterator
my $count; # PR count
if ($TTY) {
print(int(@EVENTS), " events\n");
}
@COUNT = ( [ 0, 0 ] );
foreach $event (sort({ $a->[0] <=> $b->[0] } @EVENTS)) {
if ($event->[0] == $COUNT[-1]->[0]) {
$COUNT[-1]->[1] += $event->[1];
} else {
push(@COUNT, [ $event->[0], $COUNT[-1]->[1] + $event->[1] ]);
}
}
if (@COUNT > 1) {
$COUNT[0]->[0] = $COUNT[1]->[0] - 1;
unshift(@COUNT, [ 0, 0 ]);
}
}
sub gnuplot(@) {
my @commands = @_; # Commands
my $pid; # Child PID
local *PIPE; # Pipe
open(PIPE, &GNUPLOT)
or die("fork(): $!\n");
print(PIPE join("\n", @commands, ""));
close(PIPE);
if ($? & 0x7f) {
die("gnuplot caught a signal " . ($? & 0x7f) . "\n");
} elsif ($?) {
die("gunplot returned exit code " . ($? >> 8) . "\n");
}
}
sub write_dat_file($) {
my $fn = shift; # File name
local *FILE; # File handle
my $datum; # Iterator
sysopen(FILE, $fn, O_RDWR|O_CREAT|O_TRUNC, 0640)
or die("$fn: open(): $!\n");
foreach $datum (@COUNT) {
print(FILE strftime(&TIMEFMT, localtime($datum->[0])),
" ", $datum->[1],
" ", $COUNT[-1]->[1],
"\n");
}
close(FILE);
}
sub graph_open_prs($$$$$) {
my $datfn = shift; # Data file name
my $fn = shift; # File name
my $start = shift; # Starting date
my $end = shift; # Ending date
my $title = shift; # Title
my $tickfmt; # Tick format
my $timefmt; # Time format
if ($end - $start > 86400 * 30) {
$tickfmt = "%Y-%m-%d";
} else {
$tickfmt = "%m-%d";
}
$start = strftime(&TIMEFMT, localtime($start));
$end = strftime(&TIMEFMT, localtime($end));
$timefmt = &TIMEFMT;
gnuplot("
set term png small color
set xdata time
set timefmt '$timefmt'
set data style line
set grid
set output '$fn'
set format x '$tickfmt'
set xrange ['$start':'$end']
set yrange [0:*]
set title '$title'
plot '$datfn' using 1:2 title 'Open PRs'
");
}
sub pr_stat_summary() {
my $n; # Loop counter
# Overall stats
printf("Total PRs in database: %d\n", scalar(keys(%PR)));
printf("Open PRs: %d\n", scalar(keys(%PR)) - $STATE{'closed'});
print("\n");
# Category ranking
print("Number of PRs in each category:\n");
foreach (sort({ $CATEGORY{$b} <=> $CATEGORY{$a} } keys(%CATEGORY))) {
printf("%12s: %d\n", $_, $CATEGORY{$_});
}
print("\n");
# State ranking
print("Number of PRs in each state:\n");
foreach (sort({ $STATE{$b} <=> $STATE{$a} } keys(%STATE))) {
printf("%12s: %d\n", $_, $STATE{$_});
}
print("\n");
# Closer ranking
print("Top ten PR busters:\n");
$n = 0;
foreach (sort({ $CLOSER{$b} <=> $CLOSER{$a} } keys(%CLOSER))) {
printf(" %2d. %s (%d)\n", ++$n, $_, $CLOSER{$_});
last if ($n == 10);
}
print("\n");
# Owner ranking
print("Top ten owners of open PRs:\n");
$n = 0;
foreach (sort({ $OWNER{$b} <=> $OWNER{$a} } keys(%OWNER))) {
next if (m/^freebsd-(bugs|doc|ports)$/);
printf(" %2d. %s (%d)\n", ++$n, $_, $OWNER{$_});
last if ($n == 10);
}
print("\n");
}
MAIN:{
$| = 1;
$TTY = isatty(*STDOUT);
# Perl lacks strptime(), and its mktime() doesn't accept a
# timezone argument, so we set our local timezone to that of the
# FreeBSD cluster and use localtime() instead.
$ENV{'TZ'} = &GNATS_TZ;
tzset();
$NOW = time();
# Read and count PRs
if (@ARGV) {
foreach (@ARGV) {
scan_recurse(join('/', &GNATS_DIR, $_));
}
} else {
scan_recurse(&GNATS_DIR);
}
if ($TTY) {
print("\r", scalar(keys(%PR)), " problem reports scanned\n");
}
# Generate graphs
if (0) {
count_prs();
write_dat_file(&DATFILE);
graph_open_prs(&DATFILE, "week.png", $NOW - (86400 * 7) + 1, $NOW,
"Open FreeBSD problem reports (week view)");
graph_open_prs(&DATFILE, "month.png", $NOW - (86400 * 30) + 1, $NOW,
"Open FreeBSD problem reports (month view)");
graph_open_prs(&DATFILE, "year.png", $NOW - (86400 * 365) + 1, $NOW,
"Open FreeBSD problem reports (year view)");
graph_open_prs(&DATFILE, "ever.png", $COUNT[1]->[0], $NOW,
"Open FreeBSD problem reports (project history)");
graph_open_prs(&DATFILE, "drive.png", mktime(0, 0, 0, 29, 4, 101), $NOW,
"Open FreeBSD problem reports (drive progress)");
unlink(&DATFILE);
}
# Print summary
pr_stat_summary();
}