prstats.pl revision 86309 
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: head/tools/tools/prstats/prstats.pl 86309 2001-11-12 23:59:56Z des $
30#
31
32use strict;
33use Data::Dumper;
34use Fcntl;
35use POSIX qw(isatty mktime strftime tzset);
36use vars qw($TTY %MONTH %PR @EVENTS %STATE %CATEGORY @COUNT);
37
38%MONTH = (
39    'Jan' => 1,
40    'Feb' => 2,
41    'Mar' => 3,
42    'Apr' => 4,
43    'May' => 5,
44    'Jun' => 6,
45    'Jul' => 7,
46    'Aug' => 8,
47    'Sep' => 9,
48    'Oct' => 10,
49    'Nov' => 11,
50    'Dec' => 12,
51);
52
53sub GNATS_DIR			{ "/home/gnats" }
54sub GNATS_TZ			{ "America/Los_Angeles" }
55sub DATFILE			{ "/tmp/prstats.dat" }
56sub GNUPLOT			{ "|/usr/local/bin/gnuplot /dev/stdin" }
57sub TIMEFMT			{ "%Y-%m-%d/%H:%M:%S" }
58
59sub parse_date($) {
60    my $date = shift;		# Date to parse
61
62    my $year;
63    my $month;
64    my $day;
65    my $hour;
66    my $minute;
67    my $second;
68
69    $date =~ s/\s+/ /g;
70    $date =~ s/^(Mon|Tue|Wed|Thu|Fri|Sat|Sun)\w*\s*//;
71#      $date =~ s/mi$/96/; # XXX bin/129
72#      $date =~ s/ed$/96/; # XXX bin/184
73#      $date =~ s/ug$/96/; # XXX bin/323
74#      $date =~ s/-u$/96/; # XXX bin/636
75#      $date =~ s/ow$/96/; # XXX bin/657
76#      $date =~ s/:f$/96/; # XXX gnu/1047
77#      $date =~ s/rs$/96/; # XXX bin/1132
78#      $date =~ s/ca$/96/; # XXX bin/1158
79#      $date =~ s/s:$/96/; # XXX gnu/1209
80#      $date =~ s/:c$/96/; # XXX bin/1215
81#      $date =~ s/io$/96/; # XXX bin/1279
82#      $date =~ s/d-$/96/; # XXX bin/1385
83#      $date =~ s/bs$/96/; # XXX bin/1403
84#      $date =~ s/-b$/96/; # XXX gnu/1471
85#      $date =~ s/sd$/96/; # XXX gnu/1472
86#      $date =~ s/al$/96/; # XXX bin/1785
87#      $date =~ s/eb$/96/; # XXX bin/1823
88#      $date =~ s/it$/96/; # XXX bin/1832
89#      $date =~ s/re$/96/; # XXX gnu/1835
90#      $date =~ s/ri$/97/; # XXX gnu/3247
91    if ($date =~ m/^(\w{3}) (\d\d?) (\d\d):(\d\d):(\d\d) [A-Z ]*(\d{4})$/) {
92	($month, $day, $hour, $minute, $second, $year) =
93	    ($1, $2, $3, $4, $5, $6);
94    } else {
95	die("Unrecognized date format: $date\n");
96    }
97    defined($month = $MONTH{$month})
98	or die("Invalid month: $month\n");
99    return mktime($second, $minute, $hour, $day, $month - 1, $year - 1900);
100}
101
102sub scan_pr($) {
103    my $fn = shift;		# File name
104
105    local *FILE;		# File handle
106    my $pr = {};		# PR hash
107
108    sysopen(FILE, $fn, O_RDONLY)
109	or die("$fn: open(): $!\n");
110    while (<FILE>) {
111	if (m/^>([A-Za-z-]+):\s+(.*?)\s*$/o ||
112	    m/^(State-Changed-[A-Za-z-]+):\s+(.*?)\s*$/o) {
113	    $pr->{lc($1)} = $2;
114	}
115    }
116
117    exists($PR{$pr->{'number'}})
118	and die("$fn: PR $pr->{'number'} already exists\n");
119
120    if ($TTY) {
121	print(" "x40, "\r", scalar(keys(%PR)),
122	      " $pr->{'category'}/$pr->{'number'} ");
123    }
124
125    foreach ('arrival-date', 'closed-date', 'last-modified',
126	     'state-changed-when') {
127	if (defined($pr->{$_}) && length($pr->{$_})) {
128	    $pr->{$_} = parse_date($pr->{$_});
129	}
130    }
131
132    $pr->{'_created'} = $pr->{'arrival-date'};
133    if ($pr->{'state'} eq 'closed') {
134	$pr->{'_closed'} = $pr->{'closed-date'} || $pr->{'state-changed-when'};
135	$pr->{'_closed_by'} = $pr->{'state-changed-by'};
136    }
137
138#    $PR{$pr->{'number'} = $pr;
139    $PR{$pr->{'number'}} = {
140  	#'category'	=> $pr->{'category'},
141  	#'number'	=> $pr->{'number'},
142  	#'responsible'	=> $pr->{'responsible'},
143  	'created'	=> $pr->{'created'},
144  	'closed'	=> $pr->{'closed'},
145  	#'closer'	=> $pr->{'_closed_by'},
146    };
147    push(@EVENTS, [ $pr->{'_created'}, +1 ]);
148    push(@EVENTS, [ $pr->{'_closed'}, -1 ])
149	    if defined($pr->{'_closed'});
150    ++$STATE{$pr->{'state'}};
151    ++$CATEGORY{$pr->{'category'}};
152}
153
154sub scan_recurse($);
155sub scan_recurse($) {
156    my $dn = shift;		# Directory name
157
158    local *DIR;			# Directory handle
159    my $entry;			# Entry
160
161    opendir(DIR, $dn)
162	or die("$dn: opendir(): $!\n");
163    while ($entry = readdir(DIR)) {
164	next if ($entry eq '.' || $entry eq '..');
165	if (-d "$dn/$entry") {
166	    scan_recurse("$dn/$entry");
167	} elsif ($entry =~ m/^\d+$/) {
168	    eval {
169		scan_pr("$dn/$entry");
170	    };
171	}
172    }
173    closedir(DIR);
174}
175
176sub count_prs() {
177
178    my $pr;			# Iterator
179    my @events;			# Creations or closures
180    my $event;			# Iterator
181    my $count;			# PR count
182
183    print(int(@EVENTS), " events\n");
184    @COUNT = ( [ 0, 0 ] );
185    foreach $event (sort({ $a->[0] <=> $b->[0] } @EVENTS)) {
186	if ($event->[0] == $COUNT[-1]->[0]) {
187	    $COUNT[-1]->[1] += $event->[1];
188	} else {
189	    push(@COUNT, [ $event->[0], $COUNT[-1]->[1] + $event->[1] ]);
190	}
191    }
192    if (@COUNT > 1) {
193	$COUNT[0]->[0] = $COUNT[1]->[0] - 1;
194	unshift(@COUNT, [ 0, 0 ]);
195    }
196}
197
198sub gnuplot(@) {
199    my @commands = @_;		# Commands
200
201    my $pid;			# Child PID
202    local *PIPE;		# Pipe
203
204    open(PIPE, &GNUPLOT)
205	or die("fork(): $!\n");
206    print(PIPE join("\n", @commands, ""));
207    close(PIPE);
208    if ($? & 0x7f) {
209        die("gnuplot caught a signal " . ($? & 0x7f) . "\n");
210    } elsif ($?) {
211        die("gunplot returned exit code " . ($? >> 8) . "\n");
212    }
213}
214
215sub write_dat_file($) {
216    my $fn = shift;		# File name
217
218    local *FILE;		# File handle
219    my $datum;			# Iterator
220
221    sysopen(FILE, $fn, O_RDWR|O_CREAT|O_TRUNC, 0640)
222	or die("$fn: open(): $!\n");
223    foreach $datum (@COUNT) {
224	print(FILE strftime(&TIMEFMT, localtime($datum->[0])),
225	      " ", $datum->[1],
226	      " ", $COUNT[-1]->[1],
227	      "\n");
228    }
229    close(FILE);
230}
231
232sub graph_open_prs($$$$$) {
233    my $datfn = shift;		# Data file name
234    my $fn = shift;		# File name
235    my $start = shift;		# Starting date
236    my $end = shift;		# Ending date
237    my $title = shift;		# Title
238
239    my $tickfmt;		# Tick format
240    my $timefmt;		# Time format
241
242    if ($end - $start > 86400 * 30) {
243	$tickfmt = "%Y-%m-%d";
244    } else {
245	$tickfmt = "%m-%d";
246    }
247    $start = strftime(&TIMEFMT, localtime($start));
248    $end = strftime(&TIMEFMT, localtime($end));
249    $timefmt = &TIMEFMT;
250    gnuplot("
251set term png small color
252set xdata time
253set timefmt '$timefmt'
254set data style line
255set grid
256set output '$fn'
257set format x '$tickfmt'
258set xrange ['$start':'$end']
259set yrange [0:*]
260set title '$title'
261plot '$datfn' using 1:2 title 'Open PRs'
262");
263}
264
265MAIN:{
266    my $now;			# Current time
267
268    $| = 1;
269    $TTY = isatty(*STDOUT);
270
271    # Perl lacks strptime(), and its mktime() doesn't accept a
272    # timezone argument, so we set our local timezone to that of the
273    # FreeBSD cluster and use localtime() instead.
274    $ENV{'TZ'} = &GNATS_TZ;
275    tzset();
276
277    if (@ARGV) {
278	foreach (@ARGV) {
279	    scan_recurse(join('/', &GNATS_DIR, $_));
280	}
281    } else {
282	scan_recurse(&GNATS_DIR);
283    }
284    if ($TTY) {
285	print("\r", scalar(keys(%PR)), " problem reports scanned\n");
286    }
287
288    count_prs();
289    write_dat_file(&DATFILE);
290    $now = time();
291    graph_open_prs(&DATFILE, "week.png", $now - (86400 * 7) + 1, $now,
292		   "Open FreeBSD problem reports (week view)");
293    graph_open_prs(&DATFILE, "month.png", $now - (86400 * 30) + 1, $now,
294		   "Open FreeBSD problem reports (month view)");
295    graph_open_prs(&DATFILE, "year.png", $now - (86400 * 365) + 1, $now,
296		   "Open FreeBSD problem reports (year view)");
297    graph_open_prs(&DATFILE, "ever.png", $COUNT[1]->[0], $now,
298		   "Open FreeBSD problem reports (project history)");
299    graph_open_prs(&DATFILE, "drive.png", mktime(0, 0, 0, 29, 4, 101), $now,
300		   "Open FreeBSD problem reports (drive progress)");
301    #unlink(&DATFILE);
302}
303