use FileHandle;
use File::Copy;
use DBI;
+use Getopt::Long qw ( :config gnu_getopt );
use lib '/org/wanna-build/lib';
#use lib 'lib';
use WannaBuild;
our ($verbose, $mail_logs, $list_order, $list_state,
$curr_date, $op_mode, $user, $real_user, $distribution,
- $fail_reason, $opt_override, $import_from, $export_to, $opt_create_db,
+ $fail_reason, $opt_override, $import_from, $export_to,
%prioval, %sectval,
$info_all_dists, $arch,
- $category, %catval, %short_category,
- $short_date, $list_min_age, $dbbase, @curr_time,
+ $short_date, $list_min_age, $list_max_age, $dbbase, @curr_time,
$build_priority, %new_vers, $binNMUver, %merge_srcvers, %merge_binsrc,
$printformat, $ownprintformat, $privmode, $extra_depends, $extra_conflicts,
%distributions, %distribution_aliases
$short_date = strftime("%m/%d/%y",@curr_time);
$| = 1;
-# map program invocation names to operation modes
-my %prognames = ( "uploaded-build" => "set-uploaded",
- "failed-build" => "set-failed",
- "no-build" => "set-not-for-us",
- "give-back-build" => "set-needs-build",
- "dep-wait-build" => "set-dep-wait",
- "forget-build" => "forget",
- "build-info" => "info" );
-
-%short_category = ( u => "uploaded-fixed-pkg",
- f => "fix-expected",
- r => "reminder-sent",
- n => "nmu-offered",
- e => "easy",
- m => "medium",
- h => "hard",
- c => "compiler-error",
- "" => "none" );
-
-my $progname;
-($progname = $0) =~ s,.*/,,;
-if ($prognames{$progname}) {
- $op_mode = $prognames{$progname};
-}
-elsif ($progname =~ /^list-(.*)$/) {
- $op_mode = "list";
- $list_state = ($1 eq "all") ? "" : $1;
-}
-
-my %options =
- (# flags
- simulate => { flag => \$simulate }, # this is not supported by all operations (yet)!
- "simulate-edos" => { flag => \$simulate_edos },
- "simulate-all" => { code => sub { $simulate = 1; $simulate_edos = 1; } },
- api => { arg => \$api, code => sub {
- # official apis are numeric
- die "$api isn't numeric" unless int($api) eq $api;
- die "$api too large" unless $api <= 1;
- } },
- verbose => { short => "v", flag => \$verbose },
- override => { short => "o", flag => \$opt_override },
- "create-db" => { flag => \$opt_create_db },
- "correct-compare" => { flag => \$WannaBuild::opt_correct_version_cmp },
- # TODO: remove after buildds no longer pass to wanna-build
- "no-propagation" => { short => "N" },
- "no-down-propagation" => { short => "D" },
- # normal actions
- take => { mode => "set-building" },
- failed => { short => "f", mode => "set-failed" },
- uploaded => { short => "u", mode => "set-uploaded" },
- "no-build" => { short => "n", mode => "set-not-for-us" },
- built => { mode => "set-built" },
- attempted => { mode => "set-attempted" },
- "give-back" => { mode => "set-needs-build" },
- "dep-wait" => { mode => "set-dep-wait" },
- forget => { mode => "forget" },
- 'forget-user' => { mode => 'forget-user' },
- update => { mode => "set-update" },
- "merge-v3" => { mode => "merge-v3" },
- info => { short => "i", mode => "info" },
- 'binNMU' => { mode => 'set-binary-nmu', arg => \$binNMUver,
- code => sub { die "Invalid binNMU version: $binNMUver\n"
- if $binNMUver !~ /^([\d]*)$/ and $1 >= 0; } },
- 'perm-build-priority' => { mode => "set-permanent-build-priority", arg => \$build_priority,
- code => sub { die "Invalid build priority: $build_priority\n"
- if $build_priority !~ /^-?[\d]+$/; } },
- 'build-priority' => { mode => "set-build-priority", arg => \$build_priority,
- code => sub { die "Invalid build priority: $build_priority\n"
- if $build_priority !~ /^-?[\d]+$/; } },
- list =>
- { short => "l", mode => "list", arg => \$list_state,
- code => sub {
- die "Unknown state to list: $list_state\n"
- if !isin( $list_state, qw(needs-build building uploaded
- built build-attempted failed installed dep-wait
- not-for-us auto-not-for-us all failed-removed
- install-wait reupload-wait bd-uninstallable));} },
- # options with args
- dist =>
- { short => "d", arg => \$distribution,
- code => sub {
- if ($distribution eq "a" || $distribution eq "all") {
- $info_all_dists = 1;
- $distribution = "";
- }
- else {
- $distribution = "oldstable" if $distribution eq "o";
- $distribution = "stable" if $distribution eq "s";
- $distribution = "testing" if $distribution eq "t";
- $distribution = "unstable" if $distribution eq "u";
- }
- } },
- order =>
- { short => "O", arg => \$list_order,
- code => sub {
- die "Bad ordering character\n"
- if $list_order !~ /^[PSpsncbCWT]+$/;
- } },
- message => { short => "m", arg => \$fail_reason },
- # database is deprecated, use arch instead.
- database => { short => "b", arg => \$conf::dbbase },
- arch => { short => "A", arg => \$arch },
- user => { short => "U", arg => \$user },
- category => { short => "c", arg => \$category,
- code => sub {
- $category = $short_category{$category}
- if exists $short_category{$category};
- die "Unknown category: $category\n"
- if !isin( $category, values %short_category );
- } },
- "min-age" => { short => "a", arg => \$list_min_age,
- code => sub {
- die "Argument of --min-age must be a non-zero number\n"
- if $list_min_age == 0;
- } },
- "max-age" => { arg => \$list_min_age,
- code => sub {
- die "Argument of --max-age must be a non-zero number\n"
- if $list_min_age == 0;
- $list_min_age *= -1;
- } },
- "format" => { arg => \$printformat },
- "own-format" => { arg => \$ownprintformat },
- "Pas" => { arg => \$Pas },
- "extra-depends"=> { arg => \$extra_depends },
- "extra-conflicts"=> { arg => \$extra_conflicts },
- # special actions
- export => { arg => \$export_to, mode => "export" },
- import => { arg => \$import_from, mode => "import" },
- "manual-edit" => { mode => "manual-edit" },
- "distribution-architectures" => { mode => "distribution-architectures" },
- "distribution-aliases" => { mode => "distribution-aliases" },
- );
-
-while( @ARGV && $ARGV[0] =~ /^-/ ) {
- $_ = shift @ARGV;
- last if $_ eq "--";
- my($opt, $optname, $arg);
- if (/^--([^=]+)(=|$)/) {
- $optname = $1;
- $opt = $options{$optname};
- $arg = $1 if /^--\Q$optname\E=((.|\n)*)$/;
- }
- else {
- $optname = substr( $_, 1, 1 );
- $opt = (grep { defined($_->{short}) ? $_->{short} eq $optname : 0} values %options)[0];
- $arg = $1 if /^-$optname(.+)$/;
- }
- if (!$opt) {
- warn "Unknown option: --$1\n";
- usage();
- }
- if ($opt->{arg}) {
- if (!defined $arg) {
- die "$optname option missing argument\n" if !@ARGV;
- $arg = shift @ARGV;
- }
- ${$opt->{arg}} = $arg;
- }
- elsif (defined $arg) {
- die "Option $optname takes no argument\n";
- }
-
- if ($opt->{mode}) {
- die "Conflicting operation modes\n" if $op_mode;
- $op_mode = $opt->{mode};
- }
- if ($opt->{flag}) {
- ${$opt->{flag}}++;
- }
- if ($opt->{code}) {
- &{$opt->{code}};
- }
-}
+# set mode of operation based on command line switch. Should be used
+# by GetOptions below.
+sub _set_mode_set { $op_mode = "set-$_[0]" }
+sub _set_mode { $op_mode = "$_[0]" }
+
+sub _option_deprecated { warn "Option $_[0] is deprecated" }
+
+GetOptions(
+ # this is not supported by all operations (yet)!
+ 'simulate' => \$simulate,
+ 'simulate-edos' => \$simulate_edos,
+ 'simulate-all' => sub { $simulate = 1; $simulate_edos = 1; },
+ 'api=i' => sub {
+ $api = $_[1];
+ die "$api too large" unless $api <= 1;
+ },
+ 'verbose|v' => \$verbose,
+ 'override|o' => \$opt_override,
+ 'correct-compare' => \$WannaBuild::opt_correct_version_cmp,
+
+ # TODO: remove after buildds no longer pass to wanna-build
+ 'no-propagation|N' => \&_option_deprecated,
+ 'no-down-propagation|D' => \&_option_deprecated,
+
+ # normal actions
+ 'building|take' => \&_set_mode_set,
+ 'failed|f' => \&_set_mode_set,
+ 'uploaded|u' => \&_set_mode_set,
+ 'not-for-us|no-build|n' => \&_set_mode_set,
+ 'built' => \&_set_mode_set,
+ 'attempted' => \&_set_mode_set,
+ 'needs-build|give-back' => \&_set_mode_set,
+ 'dep-wait' => \&_set_mode_set,
+ 'update' => \&_set_mode_set,
+ 'forget' => \&_set_mode,
+ 'forget-user' => \&_set_mode,
+ 'merge-v3' => \&_set_mode,
+ 'info|i' => \&_set_mode,
+ 'binary-nmu|binNMU=i' => sub {
+ _set_mode_set(@_);
+ $binNMUver = $_[1];
+ },
+ 'permanent-build-priority|perm-build-priority=i' => sub {
+ _set_mode_set(@_);
+ $build_priority = $_[1];
+ },
+ 'build-priority=i' => sub {
+ _set_mode_set(@_);
+ $build_priority = $_[1];
+ },
+ 'list|l=s' => sub {
+ _set_mode(@_);
+ $list_state = $_[1];
+ die "Unknown state to list: $list_state\n"
+ if not $list_state ~~ [
+ qw( needs-build building uploaded built
+ build-attempted failed installed
+ dep-wait not-for-us auto-not-for-us
+ all failed-removed install-wait
+ reupload-wait bd-uninstallable ) ];
+ },
+ 'dist|d=s' => sub {
+ given ( $_[1] ) {
+ when ( [qw< a all >] ) {
+ $info_all_dists = 1;
+ $distribution = '';
+ }
+ when ('o') { $distribution = 'oldstable'; }
+ when ('s') { $distribution = 'stable'; }
+ when ('t') { $distribution = 'testing'; }
+ when ('u') { $distribution = 'unstable'; }
+ }
+ },
+ 'order|O=s' => sub {
+ $list_order = $_[1];
+ die "Bad ordering character\n"
+ if $list_order !~ /^[PSpsncbCWT]+$/;
+ },
+ 'message|m=s' => \$fail_reason,
+ 'database|b=s' => sub {
+ warn "database is deprecated, please use 'arch' instead.\n";
+ $conf::dbbase = $_[1];
+ },
+ 'arch|A=s' => \$arch,
+ 'user|U=s' => \$user,
+ 'min-age|a=i' => \$list_min_age,
+ 'max-age=i' => \$list_max_age,
+ 'format=s' => \$printformat,
+ 'own-format=s' => \$ownprintformat,
+ 'Pas=s' => \$Pas,
+ 'extra-depends=s' => \$extra_depends,
+ 'extra-conflicts=s' => \$extra_conflicts,
+
+ # special actions
+ 'export' => sub { _set_mode(@_); $export_to = $_[1]; },
+ 'import' => sub { _set_mode(@_); $import_from = $_[1]; },
+ 'manual-edit' => \&_set_mode,
+ 'distribution-architectures' => \&_set_mode,
+ 'distribution-aliases' => \&_set_mode,
+) or usage();
+$list_min_age = -1 * $list_max_age if $list_max_age;
my $dbh;
}
$distribution = $distribution_aliases{$distribution} if (isin($distribution, keys %distribution_aliases));
-$op_mode = $category ? "set-failed" : "set-building"
- if !$op_mode; # default operation
+$op_mode ||= "set-building";
undef $distribution if $distribution eq 'any';
if ($distribution) {
my @dists = split(/[, ]+/, $distribution);
!($user = $real_user);
if (!$fail_reason) {
- if ($op_mode eq "set-failed" && !$category) {
+ if ($op_mode eq "set-failed" ) {
print "Enter reason for failing (end with '.' alone on ".
"its line):\n";
my $line;
sub add_one_failed {
my $name = shift;
my $version = shift;
- my ($state, $cat);
+ my $state;
my $pkg = get_source_info($name);
if (!defined($pkg)) {
return;
}
- $cat = $category;
- if (!$cat && $fail_reason =~ /^\[([^\]]+)\]/) {
- $cat = $1;
- $cat = $short_category{$cat} if exists $short_category{$cat};
- if (!isin( $cat, values %short_category )) {
- print "$name: Warning: unknown category $cat; discarded\n";
- $cat = "";
- }
- $fail_reason =~ s/^\[[^\]]+\][ \t]*\n*//;
- }
-
if ($state eq "Needs-Build") {
print "$name: Warning: not registered for building previously, ".
"but processing anyway.\n";
elsif ($state eq "Failed") {
print "$name: already registered as failed; will append new message\n"
if $fail_reason;
- print "$name: already registered as failed; changing category\n"
- if $cat;
- }
-
- if (($cat eq "reminder-sent" || $cat eq "nmu-offered") &&
- defined $pkg->{'failed_category'} &&
- $pkg->{'failed_category'} ne $cat) {
- (my $action = $cat) =~ s/-/ /;
- $fail_reason .= "\n$short_date: $action";
}
change_state( \$pkg, 'Failed' );
$pkg->{'builder'} = $user;
$pkg->{'failed'} .= "\n" if $pkg->{'failed'};
$pkg->{'failed'} .= $fail_reason;
- $pkg->{'failed_category'} = $cat if $cat;
if (defined $pkg->{'permbuildpri'}) {
$pkg->{'buildpri'} = $pkg->{'permbuildpri'};
} else {
}
$sectval{'unknown'} = -165;
- %catval = ( "none" => -20,
- "uploaded-fixed-pkg" => -19,
- "fix-expected" => -18,
- "reminder-sent" => -17,
- "nmu-offered" => -16,
- "easy" => -15,
- "medium" => -14,
- "hard" => -13,
- "compiler-error" => -12 );
}
sub sort_list_func {
'n' => ['cmp', sub { return $_[0]->{'package'}; }],
'b' => ['cmp', sub { return $_[0]->{'builder'}; }],
'c' => ['<=>', sub { return ($_[0]->{'notes'}//"" =~ /^(out-of-date|partial)/) ? 0: ($_[0]->{'notes'}//"" =~ /^uncompiled/) ? 2 : 1; }],
- 'f' => ['<=>', sub { return $catval{ $_[0]->{'failed_category'} ? $_[0]->{'failed_category'}: "none" }; }],
'S' => ['<->', sub { return isin($_[0]->{'priority'}, qw(required important standard)); }],
'T' => ['<->', sub { return $_[0]->{'state_time'} % 86400;} ], # Fractions of a day
};
my %scnt;
my $ctime = time;
- my $db = get_all_source_info(state => $state, user => $user, category => $category, list_min_age => $list_min_age);
+ my $db = get_all_source_info(state => $state, user => $user, list_min_age => $list_min_age);
foreach $name (keys %$db) {
next if $name =~ /^_/;
push @list, calculate_prio($db->{$name});
if $pkg->{'state'} ne "Needs-Build";
print print_format(" [%X]\n", $pkg, {});
print " Reasons for failing:\n",
- " [Category: ",
- defined $pkg->{'failed_category'} ? $pkg->{'failed_category'} : "none",
- "]\n ",
join("\n ",split("\n",$pkg->{'failed'})), "\n"
if $pkg->{'state'} =~ /^Failed/;
print " Dependencies: $pkg->{'depends'}\n"
'bd_problem' => 'BD-Problem',
'binary_nmu_changelog' => 'Binary-NMU-Changelog', 'binary_nmu_version' => 'Binary-NMU-Version',
'buildpri' => 'BuildPri', 'depends' => 'Depends', 'failed' => 'Failed',
- 'failed_category' => 'Failed-Category', 'notes' => 'Notes',
+ 'notes' => 'Notes',
'distribution' => 'Distribution', 'old_failed' => 'Old-Failed',
'permbuildpri' => 'PermBuildPri', 'rel' => 'Rel',
'calprio' => 'CalculatedPri', 'state_days' => 'State-Days', 'state_time' => 'State-Time',
($pkg->{'failed'} // ""). "\n" .
($pkg->{'old_failed'} // "");
delete $pkg->{'failed'};
- delete $pkg->{'failed_category'};
}
if (defined($$state) and $$state eq 'BD-Uninstallable') {
delete $pkg->{'bd_problem'};
sub get_readonly_source_info {
my $name = shift;
# SELECT FLOOR(EXTRACT('epoch' FROM age(localtimestamp, '2010-01-22 23:45')) / 86400) -- change to that?
- my $q = "SELECT rel, priority, state_change, permbuildpri, section, buildpri, failed, state, binary_nmu_changelog, bd_problem, version, package, distribution, installed_version, notes, failed_category, builder, old_failed, previous_state, binary_nmu_version, depends, extract(days from date_trunc('days', now() - state_change)) as state_days, floor(extract(epoch from now()) - extract(epoch from state_change)) as state_time"
+ my $q = "SELECT rel, priority, state_change, permbuildpri, section, buildpri, failed, state, binary_nmu_changelog, bd_problem, version, package, distribution, installed_version, notes, builder, old_failed, previous_state, binary_nmu_version, depends, extract(days from date_trunc('days', now() - state_change)) as state_days, floor(extract(epoch from now()) - extract(epoch from state_change)) as state_time"
. ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution AND result = 'successful') AS successtime"
. ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution ) AS anytime"
. ", extra_depends, extra_conflicts, build_arch_all"
sub get_all_source_info {
my %options = @_;
- my $q = "SELECT rel, priority, state_change, permbuildpri, section, buildpri, failed, state, binary_nmu_changelog, bd_problem, version, package, distribution, installed_version, notes, failed_category, builder, old_failed, previous_state, binary_nmu_version, depends, extract(days from date_trunc('days', now() - state_change)) as state_days, floor(extract(epoch from now()) - extract(epoch from state_change)) as state_time"
+ my $q = "SELECT rel, priority, state_change, permbuildpri, section, buildpri, failed, state, binary_nmu_changelog, bd_problem, version, package, distribution, installed_version, notes, builder, old_failed, previous_state, binary_nmu_version, depends, extract(days from date_trunc('days', now() - state_change)) as state_days, floor(extract(epoch from now()) - extract(epoch from state_change)) as state_time"
# . ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution AND result = 'successful') AS successtime"
# . ", (SELECT max(build_time) FROM ".pkg_history_table_name()." WHERE pkg_history.package = packages.package AND pkg_history.distribution = packages.distribution ) AS anytime"
. ", successtime.build_time as successtime, anytime.build_time as anytime, extra_depends, extra_conflicts"
push @args, $options{user};
}
- if ($options{category}) {
- $q .= ' AND failed_category <> ? AND upper(state) = ? ';
- push @args, $options{category};
- push @args, "FAILED";
- }
-
if ($options{list_min_age} && $options{list_min_age} > 0) {
$q .= ' AND age(state_change) > ? ';
push @args, $options{list_min_age} . " days";
'old_failed = ?, ' .
'binary_nmu_version = ?, ' .
'binary_nmu_changelog = ?, ' .
- 'failed_category = ?, ' .
'permbuildpri = ?, ' .
'buildpri = ?, ' .
'depends = ?, ' .
$pkg->{'old_failed'},
$pkg->{'binary_nmu_version'},
$pkg->{'binary_nmu_changelog'},
- $pkg->{'failed_category'},
$pkg->{'permbuildpri'},
$pkg->{'buildpri'},
$pkg->{'depends'},
($pkg->{'binary_nmu_version'} ? ";b".$pkg->{'binary_nmu_version'} : "").
", $pkg->{'state'}):";
- if (isin($pkgs->{'status'}, qw (installed related)) && $pkgs->{'version'} eq $pkg->{'version'} && $pkgs->{'binnmu'}//0 < int($pkg->{'binary_nmu_version'}//0)) {
+ if (isin($pkgs->{'status'}, qw (installed related)) && $pkgs->{'version'} eq $pkg->{'version'} && ($pkgs->{'binnmu'}//0) < int($pkg->{'binary_nmu_version'}//0)) {
$pkgs->{'status'} = 'out-of-date';
}
if (isin($pkgs->{'status'}, qw (installed related auto-not-for-us))) {
projects / wannabuild.git / blobdiff