sbuild 0.62.6-1ubuntu2 / usr / bin / sbuild-stats

#!/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/>.
#
#######################################################################

use strict;
use warnings;

package Conf;

use Sbuild::Conf qw();

use GDBM_File;

sub setup {
    my $conf = shift;

    my $keyring = '';
    $keyring = '/etc/apt/trusted.gpg'
	if -f '/etc/apt/trusted.gpg';

    my %stats_keys = (
	'STATS_DB'				=> {
	    DEFAULT => ''
	},
	'STATS_DB_FILE'				=> {
	    DEFAULT => ''
	},
	'STATS_DB_OPEN_MODE'			=> {
	    DEFAULT => &GDBM_READER
	},
	'STATS_MODE'				=> {
	    DEFAULT => ''
	},
	'STATS_TOPMODE'				=> {
	    DEFAULT => 0
	});

    $conf->set_allowed_keys(\%stats_keys);
}

package Options;

use Sbuild::OptionsBase;
use Sbuild::Conf qw();

use GDBM_File;

BEGIN {
    use Exporter ();
    our (@ISA, @EXPORT);

    @ISA = qw(Exporter Sbuild::OptionsBase);

    @EXPORT = qw();
}

sub set_options {
    my $self = shift;

    $self->add_options(
	"t|time" => sub {
	    $self->set_conf('STATS_DB', 'time');
	    $self->set_conf('STATS_DB_FILE', $self->get_conf('AVG_TIME_DB'));
	},
	"s|space" => sub {
	    $self->set_conf('STATS_DB', 'space');
	    $self->set_conf('STATS_DB_FILE', $self->get_conf('AVG_SPACE_DB'));
	},
	"d|delete" => sub {
	    $self->set_conf('STATS_MODE', 'del');
	    $self->set_conf('STATS_OPEN_MODE', &GDBM_WRCREAT);
	},
	"dump" => sub {
	    $self->set_conf('STATS_MODE', 'dump');
	},
	"a|add" => sub {
	    $self->set_conf('STATS_MODE', 'add');
	    $self->set_conf('STATS_OPEN_MODE', &GDBM_WRCREAT);
	},
	"top" => sub {
	    $self->set_conf('STATS_TOPMODE',
			    $self->get_conf('STATS_TOPMODE') + 1);
	},
	"f|db-file=s" => sub {
	    $self->set_conf('STATS_DB_FILE', $_[1]);
	});
}

package main;

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 check_group_membership);

sub align ($);
sub sortfunc ();

my $conf = Sbuild::Conf::new();
Conf::setup($conf);
exit 1 if !defined($conf);
my $options = Options->new($conf, "sbuild-stats", "1");
exit 1 if !defined($options);
check_group_membership();

if ($conf->get('STATS_DB_FILE') eq "") {
    usage_error("sbuild-stats", "Database not specified");
}

$conf->set('CWD', '/');

my %db;
if (!tie %db, 'GDBM_File',
    $conf->get('STATS_DB_FILE'),
    $conf->get('STATS_DB_OPEN_MODE'), 0664) {
    die "Can't open db";
}

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

if ($conf->get('STATS_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 ($conf->get('STATS_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 ($conf->get('STATS_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 ($conf->get('STATS_MODE') eq "del") {
		delete $db{$pkg};
		print "$pkg: deleted\n";
	    }
	    elsif ($conf->get('STATS_MODE') eq "dump") {
		print "$pkg: $db{$pkg}\n";
	    }
	    else {
		if ($conf->get('STATS_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 ($conf->get('STATS_TOPMODE')) {
	my $tima = (split( /\s+/, $db{$a} ))[0];
	my $timb = (split( /\s+/, $db{$b} ))[0];
	return $timb <=> $tima;
    }
    else {
	return $a cmp $b;
    }
}