3 # Copyright (c) 2001 Dag-Erling Coïdan Smørgrav
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
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.
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.
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);
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
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" }
70 my $date = shift; # Date to parse
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);
85 die("Unrecognized date format: $date\n");
87 defined($month = $MONTH{$month})
88 or die("Invalid month: $month\n");
89 return mktime($second, $minute, $hour, $day, $month - 1, $year - 1900);
93 my $fn = shift; # File name
95 local *FILE; # File handle
96 my $pr = {}; # PR hash
99 sysopen(FILE, $fn, O_RDONLY)
100 or die("$fn: open(): $!\n");
102 if (m/^>([A-Za-z-]+):\s+(.*?)\s*$/o ||
103 m/^(Category|Responsible|State-Changed-[A-Za-z-]+):\s+(.*?)\s*$/o) {
108 exists($PR{$pr->{'number'}})
109 and die("$fn: PR $pr->{'number'} already exists\n");
112 print(" "x40, "\r", scalar(keys(%PR)),
113 " $pr->{'category'}/$pr->{'number'} ");
116 foreach ('arrival-date', 'closed-date', 'last-modified',
117 'state-changed-when') {
118 if (defined($pr->{$_}) && length($pr->{$_})) {
119 $pr->{$_} = parse_date($pr->{$_});
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");
131 ++$CLOSER{$pr->{'_closed_by'}};
133 $age = $pr->{'arrival-date'} / 86400;
135 if ($age >= $_->[0] && $age < $_->[1]) {
140 ++$CATEGORY{$pr->{'category'}};
141 ++$OWNER{$pr->{'responsible'}};
143 ++$STATE{$pr->{'state'}};
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'},
153 push(@EVENTS, [ $pr->{'_created'}, +1 ]);
154 push(@EVENTS, [ $pr->{'_closed'}, -1 ])
155 if defined($pr->{'_closed'});
159 sub scan_recurse($) {
160 my $dn = shift; # Directory name
162 local *DIR; # Directory handle
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+$/) {
173 scan_pr("$dn/$entry");
183 my @events; # Creations or closures
184 my $event; # Iterator
185 my $count; # PR count
188 print(int(@EVENTS), " events\n");
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];
195 push(@COUNT, [ $event->[0], $COUNT[-1]->[1] + $event->[1] ]);
199 $COUNT[0]->[0] = $COUNT[1]->[0] - 1;
200 unshift(@COUNT, [ 0, 0 ]);
205 my @commands = @_; # Commands
211 or die("fork(): $!\n");
212 print(PIPE join("\n", @commands, ""));
215 die("gnuplot caught a signal " . ($? & 0x7f) . "\n");
217 die("gunplot returned exit code " . ($? >> 8) . "\n");
221 sub write_dat_file($) {
222 my $fn = shift; # File name
224 local *FILE; # File handle
225 my $datum; # Iterator
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])),
232 " ", $COUNT[-1]->[1],
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
245 my $tickfmt; # Tick format
246 my $timefmt; # Time format
248 if ($end - $start > 86400 * 30) {
249 $tickfmt = "%Y-%m-%d";
253 $start = strftime(&TIMEFMT, localtime($start));
254 $end = strftime(&TIMEFMT, localtime($end));
257 set term png small color
259 set timefmt '$timefmt'
263 set format x '$tickfmt'
264 set xrange ['$start':'$end']
267 plot '$datfn' using 1:2 title 'Open PRs'
271 sub pr_stat_summary() {
273 my $n; # Loop counter
276 printf("Total PRs in database: %d\n", scalar(keys(%PR)));
277 printf("Open PRs: %d\n", scalar(keys(%PR)) - $STATE{'closed'});
281 print("Number of PRs in each category:\n");
282 foreach (sort({ $CATEGORY{$b} <=> $CATEGORY{$a} } keys(%CATEGORY))) {
283 printf("%12s: %d\n", $_, $CATEGORY{$_});
288 print("Number of PRs in each state:\n");
289 foreach (sort({ $STATE{$b} <=> $STATE{$a} } keys(%STATE))) {
290 printf("%12s: %d\n", $_, $STATE{$_});
295 print("Top ten PR busters:\n");
297 foreach (sort({ $CLOSER{$b} <=> $CLOSER{$a} } keys(%CLOSER))) {
298 printf(" %2d. %s (%d)\n", ++$n, $_, $CLOSER{$_});
304 print("Top ten owners of open PRs:\n");
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{$_});
317 $TTY = isatty(*STDOUT);
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;
329 scan_recurse(join('/', &GNATS_DIR, $_));
332 scan_recurse(&GNATS_DIR);
335 print("\r", scalar(keys(%PR)), " problem reports scanned\n");
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)");