aboutsummaryrefslogtreecommitdiff
path: root/tools/tools/prstats/prstats.pl
diff options
context:
space:
mode:
Diffstat (limited to 'tools/tools/prstats/prstats.pl')
-rw-r--r--tools/tools/prstats/prstats.pl357
1 files changed, 357 insertions, 0 deletions
diff --git a/tools/tools/prstats/prstats.pl b/tools/tools/prstats/prstats.pl
new file mode 100644
index 000000000000..c31241edb0b4
--- /dev/null
+++ b/tools/tools/prstats/prstats.pl
@@ -0,0 +1,357 @@
+#!/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$
+#
+
+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();
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-26 03:28:04 +0000