#!/usr/bin/perl
#
# sbuild-stats: display package build statistics
# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
# Copyright © 2006-2008 Roger Leigh <rleigh@debian.org>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see
# <http://www.gnu.org/licenses/>.
#
#######################################################################

package conf;
use Sbuild::Conf;

package main;

use strict;
use warnings;

use GDBM_File;
use File::Basename;
use Getopt::Long qw(:config no_ignore_case auto_abbrev gnu_getopt);
use Sbuild qw(help_text version_text usage_error);

package main;

sub align ($);
sub sortfunc ();

$Sbuild::Conf::cwd = "/";

my $db = "unspec";
my $mode = "unspec";
my $topmode = 0;
my $open_mode = GDBM_READER;
my $db_file = "unspec";

if (basename($0) =~ /avg-pkg-build-time$/) {
    $db = "time";
} elsif (basename($0) =~ /avg-pkg-build-space$/) {
    $db = "space";
}

GetOptions (
    "h|help" => sub { help_text("1", "sbuild-stats"); },
    "V|version" => sub {version_text("sbuild-stats"); },
    "t|time" => sub { $db = "time"; },
    "s|space" => sub { $db = "space"; },
    "d|delete" => sub { $mode = "del"; },
    "dump" => sub { $mode = "dump"; },
    "a|add" => sub { $mode = "add"; },
    "top+" => \$topmode,
    "f|db-file=s" => \$db_file)
or usage_error("sbuild-stats", "Error parsing command-line options");

if ($db eq "time") {
    $db_file = $conf::avg_time_db;
} elsif ($db eq "space") {
    $db_file = $conf::avg_space_db;
} elsif ($db_file ne "unspec") {
# Set by hand.
} else {
    usage_error("sbuild-stats", "Database not specified");
}

if ($mode eq "add") {
    $open_mode = GDBM_WRCREAT;
} elsif ($mode eq "del") {
    $open_mode = GDBM_WRCREAT;
} else {
    $open_mode = GDBM_READER;
}

my %db;
if (!tie %db, 'GDBM_File', $db_file, $open_mode, 0664) {
    die "Can't open db";
}

if ($mode eq "del" && !@ARGV) {
    usage_error("sbuild-stats", "No packages given for --delete");
}

if ($mode eq "add") {
    if (@ARGV != 2 || $ARGV[1] !~ /^[\d.:]+$/) {
	usage_error("sbuild-stats", "Arguments for --add must be package and a build time or space");
    }
    my($pkg,$t) = @ARGV;

    if ($db ne "space") {
	if ($t =~ /:/) {
	    my @a = split( ':', $t );
	    my $x;
	    for( $t = 0; $x = shift @a; ) {
		$t = ($t * 60) + $x;
	    }
	}
    }

    if (exists $db{$pkg}) {
	if ($db ne "space") {
	    my @times = split( /\s+/, $db{$pkg} );
	    push( @times, $t );
	    my $sum = 0;
	    foreach (@times[1..$#times]) { $sum += $_; }
	    $times[0] = $sum / (@times-1);
	    $db{$pkg} = join( ' ', @times );
	}
	else {
	    my $keepvals = 4;
	    my @values = split( /\s+/, $db{$pkg} );
	    shift @values;
	    unshift( @values, $t );
	    pop @values if @values > $keepvals;
	    my ($sum, $n, $weight, $i) = (0, 0, scalar(@values));
	    for( $i = 0; $i < @values; ++$i) {
		$sum += $values[$i] * $weight;
		$n += $weight;
	    }
	    unshift( @values, $sum/$n );
	    $db{$pkg} = join( ' ', @values );
	}
    }
    else {
	$db{$pkg} = "$t $t";
    }
} else {
    my $pkg;
    my @pkgs = sort sortfunc (@ARGV ? @ARGV : keys %db);
    foreach $pkg (@pkgs) {
	if (exists $db{$pkg}) {
	    if ($mode eq "del") {
		delete $db{$pkg};
		print "$pkg: deleted\n";
	    }
	    elsif ($mode eq "dump") {
		print "$pkg: $db{$pkg}\n";
	    }
	    else {
		if ($db ne "space") {
		    my @times = split( /\s+/, $db{$pkg} );
		    my $t = $times[0];
		    my($sum, $sumq) = (0, 0);
		    foreach (@times[1..$#times]) {
			$sum += $_;
			$sumq += $_*$_;
		    }
		    my $sigma;
		    $sigma = (@times <= 2) ? 0 :
			sqrt( ($sumq - $sum*$sum/(@times-1))/(@times-2) );
		    printf "%s%02d:%02d:%02d (%d %s, sigma %02d:%02d:%02d)\n",
		    align($pkg), int($t/3600), int(($t%3600)/60),
		    int($t%60), @times-1, (@times == 2) ? "entry" : "entries",
		    int($sigma/3600), int(($sigma%3600)/60), int($sigma%60);
		}
		else {
		    my @values = split( /\s+/, $db{$pkg} );
		    printf "%s%6dk (%dk latest)\n",
		    align($pkg), $values[0], $values[1];
		}
	    }
	}
	else {
	    print "$pkg: unknown\n";
	}
    }
}

untie %db;

exit 0;

sub align ($) {
    my $str = shift;

    $str .= ":";
    my $l = length($str);
    $str .= "\t" if $l < 24;
    $str .= "\t" if $l < 16;
    $str .= "\t" if $l < 8;
    return $str;
}

sub sortfunc () {
    if ($topmode) {
	my $tima = (split( /\s+/, $db{$a} ))[0];
	my $timb = (split( /\s+/, $db{$b} ))[0];
	return $timb <=> $tima;
    }
    else {
	return $a cmp $b;
    }
}
