use DBI;
use lib '/org/wanna-build/bin';
use WannaBuild;
+use YAML::Tiny;
+use Data::Dumper;
+use Hash::Merge qw ( merge );
+use String::Format;
+use Date::Parse;
our ($verbose, $mail_logs, $list_order, $list_state,
$curr_date, $op_mode, $user, $real_user, $distribution,
$info_all_dists, $arch,
$category, %catval, %short_category,
$short_date, $list_min_age, $dbbase, @curr_time,
- $build_priority, %new_vers, $binNMUver, %merge_srcvers, %merge_binsrc);
+ $build_priority, %new_vers, $binNMUver, %merge_srcvers, %merge_binsrc,
+ $printformat
+ );
# global vars
$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin:/org/wanna-build/bin/";
+$ENV{'LC_ALL'} = 'C';
$verbose = 0;
$mail_logs = "";
@curr_time = gmtime;
if $list_min_age == 0;
$list_min_age *= -1;
} },
+ "format" => { arg => \$printformat },
# special actions
export => { arg => \$export_to, mode => "export" },
import => { arg => \$import_from, mode => "import" },
}
}
+my $yamlmap = ();
+my $yamldir = "/org/wanna-build/etc/yaml";
+my @files = ('wanna-build.yaml');
+if ($user =~ /(buildd.*)-/) { push (@files, "$1.yaml") };
+push ( @files, "$user.yaml");
+foreach my $file (@files) {
+ if ($verbose >= 2) { print "Trying to read $file ...\n"; }
+ next unless -f $yamldir."/".$file;
+ if ($verbose >= 2) { print "Read $file ...\n"; }
+ my $m = YAML::Tiny->read( $yamldir."/".$file )->[0];
+ $yamlmap = merge($m, $yamlmap);
+}
+if (not $yamlmap) {
+ die "FATAL: no configuration found\n";
+}
+
my $dbh;
END {
}
sub calculate_prio {
-######################
-# priority: required = 50, important = 40, standard = 30, optional = 5
-# section: libs = 4, devel = 2
-# component: contrib = -10, non-free = -20
-# never built = -20
-# max(floor(waitingdays),6)
-
- my $priomap;
- $priomap->{'priority'} = { 'required' => 50, 'important' => 40, 'standard' => 30, 'optional' => 5 };
- $priomap->{'section'} = { 'libs' => 4, 'devel' => 2 };
- $priomap->{'component'} = { 'contrib' => -10, 'non-free' => -20 };
- $priomap->{'notes'} = { 'uncompiled' => 20, 'out-of-date' => 40, 'partial' => 40 };
- $priomap->{'waitingdays'} = { 'min' => 0, 'max' => 6, scale => 2 };
+ my $priomap = $yamlmap->{priority};
my $pkg = shift;
+ my @s=split("/", $pkg->{'section'});
+ $pkg->{'component'} = $s[0] if $s[1];
+ $pkg->{'component'} ||= 'main';
$pkg->{'calprio'} = 0;
- foreach my $k (keys %$priomap) {
- $pkg->{'calprio'} += $priomap->{$k}{$pkg->{$k}} if $pkg->{$k} and $priomap->{$k}{$pkg->{$k}};
+ foreach my $k (keys %{$priomap->{keys}}) {
+ $pkg->{'calprio'} += $priomap->{keys}->{$k}{$pkg->{$k}} if $pkg->{$k} and $priomap->{keys}->{$k}{$pkg->{$k}};
}
my $days = $pkg->{'state_days'};
}
+sub use_fmt {
+ my $r;
+
+ if (ref($_[0]) eq 'CODE') {
+ $r = &{$_[0]};
+ } else {
+ $r = $_[0];
+ }
+
+ shift;
+ my $t = shift;
+
+ $r ||= "";
+ return $r unless $t;
+
+ my $pkg = shift;
+ my $var = shift;
+ if (substr($t,0,1) eq '!') {
+ $t = substr($t,1);
+ return "" if $r;
+ } else {
+ return "" unless $r;
+ }
+ if ($t =~ /%/) {
+ return print_format($t, $pkg, $var);
+ }
+ return $t;
+}
+sub make_fmt { my $c = shift; my $pkg = shift; my $var = shift; return sub { use_fmt($c, $_[0], $pkg, $var); } };
+
+sub print_format {
+ my $printfmt = shift;
+ my $pkg = shift;
+ my $var = shift;
+=pod
+Within an format string, the following values are allowed (need to be preceded by %).
+This can be combined to e.g.
+wanna-build --format='wanna-build -A %a --give-back %p_%v' -A mipsel --list=failed
+
+p Package name
+a Architecture
+s Time in this state in full seconds since epoch
+v Package version
+S Package state
+u Builder (e.g. buildd_mipsel-rem)
+X the string normally between [], e.g. optional:out-of-date:calprio{61}:days{25}
+c section (e.g. libs or utils)
+P previous state
+E in case of Dep-Wait the packages being waited on, in case of Needs-Build the number in the queue
+D in case of BD-Uninstallable the reason for the uninstallability
+d distribution
+t time of state change
+
+%{Text}? print Text in case ? is not empty; ? is never printed
+%{!Text}? print Text in case ? is empty; ? is never printed
+Text could contain further %. To start with !, use %!
+
+=cut
+ return stringf($printfmt, (
+ 'p' => make_fmt( $pkg->{'package'}, $pkg, $var),
+ 'a' => make_fmt( $arch, $pkg, $var),
+ 's' => make_fmt( sub { return floor(str2time($pkg->{'state_change'})); }, $pkg, $var),
+ 'v' => make_fmt( $pkg->{'version'}, $pkg, $var),
+ 'S' => make_fmt( $pkg->{'state'}, $pkg, $var),
+ 'u' => make_fmt( $pkg->{'builder'}, $pkg, $var),
+ 'X' => make_fmt( sub {
+ my $c = "$pkg->{'priority'}:$pkg->{'notes'}";
+ $c .= ":PREV-FAILED" if $pkg->{'previous_state'} =~ /^Failed/;
+ $c .= ":bp{" . $pkg->{'buildpri'} . "}" if defined $pkg->{'buildpri'};
+ $c .= ":binNMU{" . $pkg->{'binary_nmu_version'} . "}" if defined $pkg->{'binary_nmu_version'};
+ $c .= ":calprio{". $pkg->{'calprio'}."}";
+ $c .= ":days{". $pkg->{'state_days'}."}";
+ return $c;
+ }, $pkg, $var),
+ 'c' => make_fmt( $pkg->{'section'}, $pkg, $var),
+ 'P' => make_fmt( $pkg->{'previous_state'} || "unknwon", $pkg, $var),
+ 'E' => make_fmt( sub { return $pkg->{'depends'} if $pkg->{'state'} eq "Dep-Wait";
+ return $var->{scnt}{'Needs-Build'} + 1 if $pkg->{'state'} eq 'Needs-Build';
+ return ""; }, $pkg, $var),
+ 'D' => make_fmt( sub { return "" unless $pkg->{'bd_problem'};
+ return $pkg->{'package'}."#".$arch."-bd-problem\n".
+ join("\\0a",split("\n",$pkg->{'bd_problem'}))."\\0a\n"; }, $pkg, $var),
+ 'B' => make_fmt( sub { return $pkg->{'binary_nmu_version'} if defined $pkg->{'binary_nmu_version'}; }, $pkg, $var),
+ 'd' => make_fmt( $distribution, $pkg, $var),
+ 't' => make_fmt( $pkg->{'state_change'}, $pkg, $var),
+ ));
+}
+
sub list_packages {
my $state = shift;
my( $name, $pkg, @list );
}
foreach $pkg (sort sort_list_func @list) {
+ if ($printformat) {
+ print print_format($printformat, $pkg, {'cnt' => $cnt, 'scnt' => \%scnt})."\n";
+ ++$cnt;
+ $scnt{$pkg->{'state'}}++;
+ next;
+ }
print "$pkg->{'section'}/$pkg->{'package'}_$pkg->{'version'}";
print ": $pkg->{'state'}"
if $state eq "all";
print " Reasons for BD-Uninstallable:\n ",
join("\n ",split("\n",$pkg->{'bd_problem'})), "\n"
if $pkg->{'state'} eq "BD-Uninstallable";
- print " Previous state was $pkg->{'previous_state'} until ",
- "$pkg->{'state_change'}\n"
+ print " Previous state was $pkg->{'previous_state'}\n"
if $verbose && $pkg->{'previous_state'};
print " No previous state recorded\n"
if $verbose && !$pkg->{'previous_state'};
+ print " State changed at $pkg->{'state_change'}\n"
+ if $verbose && $pkg->{'state_change'};
+ print " Previous state $pkg->{'previous_state'} left $pkg->{'state_time'} ago\n"
+ if $verbose && $pkg->{'previous_state'};
print " Previous failing reasons:\n ",
join("\n ",split("\n",$pkg->{'old_failed'})), "\n"
if $verbose && $pkg->{'old_failed'};
++$cnt;
$scnt{$pkg->{'state'}}++ if $state eq "all";
}
- if ($state eq "all") {
+ if ($state eq "all" && !$printformat) {
foreach (sort keys %scnt) {
print "Total $scnt{$_} package(s) in state $_.\n";
}
}
- print "Total $cnt package(s)\n";
+ print "Total $cnt package(s)\n" unless $printformat;
}
sub get_all_source_info {
my %options = @_;
- my $q = 'SELECT *, extract(days from date_trunc(\'days\', now() - state_change::timestamp)) as state_days FROM ' . table_name()
+ my $q = 'SELECT *, '.
+ 'extract(days from date_trunc(\'days\', now() - state_change::timestamp)) as state_days, '.
+ 'date_trunc(\'seconds\', now() - state_change::timestamp) as state_time'.
+ ' FROM ' . table_name()
. ' WHERE distribution = ? ';
my @args = ($distribution);
if ($options{state} && uc($options{state}) ne "ALL") {
projects / wannabuild.git / blobdiff