← Back to branch summary

~ubuntu-branches/ubuntu/precise/sbuild/precise

« back to all changes in this revision

Viewing changes to bin/wanna-build-statistics

  • Committer: Bazaar Package Importer
  • Author(s): Lorenzo De Liso
  • Date: 2011-05-01 16:55:16 UTC
  • mfrom: (8.1.19 upstream) (3.3.17 sid)
  • Revision ID: james.westby@ubuntu.com-20110501165516-8g3uwrnhv2bzjt8y
Tags: 0.62.2-1ubuntu1
http://bugs.debian.org/607228
* Merge from debian unstable, remaining changes:
  - debian/patches/do-not-install-debfoster-into-chroots.patch: 
    do not install debfoster into the chroots because it is in universe and 
    not needed for package building itself.
  - debian/patches/run-pre-build-hooks-as-root.patch: 
    run pre-build hooks as root (Closes: #607228)
* Now that the package uses a patch system, don't modify the files directly;
  instead, put the changes in the respective patches and add the DEP-3
  patch tagging guidelines to them.

Show diffs side-by-side

added added

removed removed

Lines of Context:
bin/wanna-build-statistics
1
 
#!/usr/bin/perl
2
 
#
3
 
# wanna-build-statistics: print statistics for wanna-build databases
4
 
# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
5
 
#
6
 
# This program is free software: you can redistribute it and/or modify
7
 
# it under the terms of the GNU General Public License as published by
8
 
# the Free Software Foundation, either version 2 of the License, or
9
 
# (at your option) any later version.
10
 
#
11
 
# This program is distributed in the hope that it will be useful, but
12
 
# WITHOUT ANY WARRANTY; without even the implied warranty of
13
 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14
 
# General Public License for more details.
15
 
#
16
 
# You should have received a copy of the GNU General Public License
17
 
# along with this program.  If not, see
18
 
# <http://www.gnu.org/licenses/>.
19
 
#
20
 
#######################################################################
21
 
 
22
 
use strict;
23
 
use warnings;
24
 
use vars qw($verbose $dist $database);
25
 
 
26
 
sub percent (@);
27
 
sub isin ($@);
28
 
 
29
 
$verbose = 0;
30
 
$dist = "unstable";
31
 
$database = "build-db";
32
 
 
33
 
# TODO: Use Getopt::Long.
34
 
while( @ARGV && $ARGV[0] =~ /^-/ ) {
35
 
    $_ = shift @ARGV;
36
 
    if (/^-v$/ || /^--verbose$/) {
37
 
        $verbose++;
38
 
    }
39
 
    elsif (/^-d/ || /^--dist/) {
40
 
        if (/^-d(.)/ || /^--dist=(.)/) {
41
 
            $dist = $1.$';
42
 
        }
43
 
        elsif (!@ARGV) {
44
 
            die "$_ option missing argument\n";
45
 
        }
46
 
        else {
47
 
            $dist = shift @ARGV;
48
 
        }
49
 
# TODO: Use distribution list from main configuration
50
 
        $dist = "oldstable" if $dist eq "o";
51
 
        $dist = "stable"    if $dist eq "s";
52
 
        $dist = "testing"   if $dist eq "t";
53
 
        $dist = "unstable"  if $dist eq "u";
54
 
        die "Bad distribution\n" if !isin($dist, qw(stable testing unstable stable-security testing-security oldstable oldstable-security));
55
 
    }
56
 
    elsif (/^--$/) {
57
 
        last;
58
 
    }
59
 
    elsif (/^--database=(.*)$/) {
60
 
        $database = $1;
61
 
    }
62
 
    else {
63
 
        die "Unknown option: $_\n";
64
 
    }
65
 
}
66
 
 
67
 
my($lastmsg, %n_state, $total, %n_builder);
68
 
open( PIPE, "wanna-build --database=$database --dist=$dist --list=all 2>&1 |" )
69
 
    or die "Cannot spawn wanna-build: $!\n";
70
 
while( <PIPE> ) {
71
 
    if (/^Database for $dist doesn't exist$/) {
72
 
        exit 1;
73
 
    }
74
 
    elsif (/^Total (\d+) package\(s\) in state (\S+)\.$/) {
75
 
        $n_state{$2} = $1;
76
 
    }
77
 
    elsif (/^Total (\d+) package\(s\)$/) {
78
 
        $total = $1;
79
 
    }
80
 
    elsif (/^\S+: (\S+) by (\S+)/) {
81
 
        $n_builder{$1}->{$2}++;
82
 
    }
83
 
    $lastmsg = $_;
84
 
}
85
 
close( PIPE );
86
 
if ($?) {
87
 
    print "$lastmsg";
88
 
    die "Bad exit status $? from wanna-build\n";
89
 
}
90
 
 
91
 
print "Distribution $dist:\n";
92
 
print "--------------", "-" x length($dist), "\n";
93
 
 
94
 
my $total_width = 78;
95
 
 
96
 
my @state_list = qw(Installed Needs-Build Building Built
97
 
                    Build-Attempted Uploaded Failed Dep-Wait
98
 
                    Failed-Removed Dep-Wait-Removed Not-For-Us);
99
 
 
100
 
my $statewidth = 0;
101
 
grep { $statewidth = length($_) if length($_) > $statewidth } @state_list;
102
 
my $startcol = $statewidth + 9;
103
 
 
104
 
my($state, $builder);
105
 
foreach $state (@state_list) {
106
 
    printf "%-${statewidth}s: %5d", $state, $n_state{$state};
107
 
    if (!keys %{$n_builder{$state}}) {
108
 
        print "\n";
109
 
        next;
110
 
    }
111
 
    my $sum = 0;
112
 
    foreach $builder (keys %{$n_builder{$state}}) {
113
 
        $sum += $n_builder{$state}->{$builder};
114
 
    }
115
 
    $n_builder{$state}->{"unknown"} = $n_state{$state} - $sum;
116
 
    print " (";
117
 
    my $is_first = 1;
118
 
    my $pos = $startcol;
119
 
    foreach $builder (sort keys %{$n_builder{$state}}) {
120
 
        next if !$n_builder{$state}->{$builder};
121
 
        my $str = "$builder: $n_builder{$state}->{$builder}";
122
 
        $str = ", $str" if !$is_first;
123
 
        $is_first = 0;
124
 
        if ($pos + length($str) > $total_width) {
125
 
            print ",\n", " " x $startcol;
126
 
            $pos = $startcol;
127
 
            $str =~ s/^, //;
128
 
        }
129
 
        print $str;
130
 
        $pos += length($str);
131
 
    }
132
 
    print ")\n";
133
 
}
134
 
printf "%-${statewidth}s: %5d\n", "total", $total;
135
 
print "\n";
136
 
 
137
 
$total -= $n_state{"Not-For-Us"};
138
 
print percent(qw(Installed)), " up-to-date, ";
139
 
print percent(qw(Installed Uploaded)), " if also counting uploaded pkgs\n";
140
 
print percent(qw(Built Installed Uploaded)), " if also counting built pkgs\n";
141
 
print percent(qw(Needs-Build)), " uncompiled\n";
142
 
print percent(qw(Building)), " currently building (short-term delay)\n";
143
 
print percent(qw(Build-Attempted)), " currently failed building (short-term delay)\n";
144
 
print percent(qw(Failed Dep-Wait)), " failed or waiting (long-term delay)\n";
145
 
 
146
 
exit 0;
147
 
 
148
 
sub percent (@) {
149
 
    my $n = 0;
150
 
    foreach (@_) {
151
 
        $n += $n_state{$_};
152
 
    }
153
 
 
154
 
    return sprintf "%6.2f%%", $n*100/$total if $total;
155
 
    return sprintf "%6.2f%%", 0;
156
 
}
157
 
 
158
 
sub isin ($@) {
159
 
    my $val = shift;
160
 
    return grep( $_ eq $val, @_ );
161
 
}