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