X-Git-Url: https://git.donarmstrong.com/?p=wannabuild.git;a=blobdiff_plain;f=bin%2Fwanna-build;h=28f2b1729650928f54a12586cddbb52d24177034;hp=ffdbcfc531004ae811d5ea1e2468f6f47aa87832;hb=c97a76f09c3b8b7a92d458e1cfe322127e225cd2;hpb=12553100c9f4b4ac2b8f382d442d246c955603b1

diff --git a/bin/wanna-build b/bin/wanna-build
index ffdbcfc..28f2b17 100755
--- a/bin/wanna-build
+++ b/bin/wanna-build
@@ -43,6 +43,7 @@ use POSIX;
 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;
@@ -67,7 +68,7 @@ our ($verbose, $mail_logs, $list_order, $list_state,
     %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
@@ -88,15 +89,6 @@ $curr_date = strftime("%Y %b %d %H:%M:%S",@curr_time);
 $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",
@@ -107,162 +99,115 @@ my %prognames = ( "uploaded-build"  => "set-uploaded",
 					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" },
-	 "pretend-avail" => { short => "p", mode => "pretend-avail" },
-	 "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,
+    'create-db'       => \$opt_create_db,
+    '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,
+    'category|c=s' => sub {
+        $category = $_[1];
+        $category = $short_category{$category}
+          if exists $short_category{$category};
+        die "Unknown category: $category\n"
+          if not $category ~~ [ values %short_category ];
+    },
+    '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;
 
@@ -455,10 +400,6 @@ sub process {
 			forget_packages( @ARGV );
 			last SWITCH;
 		};
-		/^pretend-avail/ && do {
-			pretend_avail( @ARGV );
-			last SWITCH;
-		};
 		/^merge-v3/ && do {
                         die "This operation is restricted to admin users\n"
 			    if (defined @conf::admin_users and !isin( $real_user, @conf::admin_users) and !$simulate);
@@ -1281,84 +1222,6 @@ sub set_one_update {
 }
 
 
-sub pretend_avail {
-	my ($package, $name, $version, $installed);
-	
-	foreach $package (@_) {
-		$package =~ s,^.*/,,; # strip path
-		$package =~ s/\.(dsc|diff\.gz|tar\.gz|deb)$//; # strip extension
-		$package =~ s/_[\w\d]+\.changes$//; # strip extension
-		if ($package =~ /^([\w\d.+-]+)_([\w\d:.+~-]+)/) {
-			($name,$version) = ($1,$2);
-		}
-		else {
-			warn "$package: can't extract package name and version ".
-				 "(bad format)\n";
-			next;
-		}
-		$installed->{$name}{'version'} = $version;
-	}
-
-	check_dep_wait( "--pretend-avail", $installed );
-}
-
-sub check_dep_wait {
-	my $action = shift;
-	my $installed = shift;
-	
-	# check all packages in state Dep-Wait if dependencies are all
-	# available now
-	my $name;
-	my $db = get_all_source_info();
-        foreach $name (keys %$db) {
-		next if $name =~ /^_/;
-		my $pkg = $db->{$name};
-		next if $pkg->{'state'} ne "Dep-Wait";
-		my $deps = $pkg->{'depends'};
-		if (!$deps) {
-			print "$name: was in state Dep-Wait, but with empty ",
-				  "dependencies!\n";
-			goto make_needs_build;
-		}
-		my $deplist = parse_deplist($deps);
-		my $new_deplist;
-		my $allok = 1;
-		my @removed_deps;
-		foreach (keys %$deplist) {
-			if (!exists $installed->{$_} ||
-				($deplist->{$_}->{'rel'} && $deplist->{$_}->{'version'} &&
-				 !version_compare( $installed->{$_}{'version'},
-								   $deplist->{$_}->{'rel'},
-								   $deplist->{$_}->{'version'}))) {
-				$allok = 0;
-				$new_deplist->{$_} = $deplist->{$_};
-			}
-			else {
-				push( @removed_deps, $_ );
-			}
-		}
-		if ($allok) {
-		  make_needs_build:
-			change_state( \$pkg, 'Needs-Build' );
-			log_ta( $pkg, $action );
-			delete $pkg->{'builder'};
-			delete $pkg->{'depends'};
-			print "$name ($pkg->{'version'}) has all ",
-				  "dependencies available now\n" if $verbose;
-			$new_vers{$name}++;
-			update_source_info($pkg);
-		}
-		elsif (@removed_deps) {
-			$pkg->{'depends'} = build_deplist( $new_deplist );
-			print "$name ($pkg->{'version'}): some dependencies ",
-				  "(@removed_deps) available now, but not all yet\n"
-				if $verbose;
-			update_source_info($pkg);
-		}
-	}
-}
-
-
 # for sorting priorities and sections
 BEGIN {
 	%prioval = ( required             => -5,
@@ -1444,21 +1307,21 @@ sub sort_list_func {
         'C' => ['<->', sub { return $_[0]->{'calprio'}; }],
         'W' => ['<->', sub { return $_[0]->{'state_days'}; }],
         'P' => ['<->', sub { return $_[0]->{'buildpri'}; }],
-        'p' => ['<=>', sub { return $prioval{$_[0]->{'priority'}}; }],
-        's' => ['<=>', sub { return $sectval{$_[0]->{'section'}}; }],
+        'p' => ['<=>', sub { return $prioval{$_[0]->{'priority'}//""}//0; }],
+        's' => ['<=>', sub { return $sectval{$_[0]->{'section'}//""}//0; }],
         '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; }],
+        '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 $prioval{$_[0]->{'priority'}} > $prioval{'standard'}; }],
+        'S' => ['<->', sub { return isin($_[0]->{'priority'}, qw(required important standard)); }],
         'T' => ['<->', sub { return $_[0]->{'state_time'} % 86400;} ], # Fractions of a day
     };
 
 	foreach my $letter (split( //, $list_order )) {
             my $r;
-            $r = &{$map_funcs->{$letter}[1]}($b) <=> &{$map_funcs->{$letter}[1]}($a) if $map_funcs->{$letter}[0] eq '<->';
-            $r = &{$map_funcs->{$letter}[1]}($a) <=> &{$map_funcs->{$letter}[1]}($b) if $map_funcs->{$letter}[0] eq '<=>';
-            $r = &{$map_funcs->{$letter}[1]}($a) cmp &{$map_funcs->{$letter}[1]}($b) if $map_funcs->{$letter}[0] eq 'cmp';
+            $r = (&{$map_funcs->{$letter}[1]}($b)//0 ) <=> (&{$map_funcs->{$letter}[1]}($a)//0 ) if $map_funcs->{$letter}[0] eq '<->';
+            $r = (&{$map_funcs->{$letter}[1]}($a)//0 ) <=> (&{$map_funcs->{$letter}[1]}($b)//0 ) if $map_funcs->{$letter}[0] eq '<=>';
+            $r = (&{$map_funcs->{$letter}[1]}($a)//"") cmp (&{$map_funcs->{$letter}[1]}($b)//"") if $map_funcs->{$letter}[0] eq 'cmp';
             return $r if $r != 0;
 	}
 	return 0;
@@ -1586,6 +1449,7 @@ Text could contain further %. To start with !, use %!
         'S' => make_fmt( $pkg->{'state'}, $pkg, $var),
         'u' => make_fmt( $pkg->{'builder'}, $pkg, $var),
         'X' => make_fmt( sub {
+            no warnings;
             my $c = "$pkg->{'priority'}:$pkg->{'notes'}";
             $c .= ":PREV-FAILED" if $pkg->{'previous_state'} && $pkg->{'previous_state'} =~ /^Failed/;
             $c .= ":bp{" . $pkg->{'buildpri'} . "}" if defined $pkg->{'buildpri'};
@@ -2273,8 +2137,6 @@ Options:
 	 BD-Uninstallable, until the installability of its Build-Dependencies
 	 were verified. This happens at each call of --merge-all, usually
 	 every 15 minutes.
-    --pretend-avail: Pretend that given packages are available now and give
-        free packages waiting for them
     -i SRC_PKG, --info SRC_PKG: Show information for source package
     -l STATE, --list=STATE: List all packages in state STATE; can be
         combined with -U to restrict to a specific user; STATE can
@@ -2581,20 +2443,26 @@ sub parse_all_v3 {
             ($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))) {
+        if (isin($pkgs->{'status'}, qw (installed related auto-not-for-us))) {
             my $change = 0;
-            if ($pkg->{'state'} ne 'Installed') {
-                change_state( \$pkg, 'Installed');
-                delete $pkg->{'depends'};
-                delete $pkg->{'extra_depends'};
-                delete $pkg->{'extra_conflicts'};
+            my $tstate = {'installed' => 'Installed', 'related' => 'Installed', 'auto-not-for-us' => 'Auto-Not-For-Us'}->{$pkgs->{'status'}};
+            next if isin( $pkg->{'state'}, qw<Not-For-Us Failed Failed-Removed Dep-Wait Dep-Wait-Removed>) && isin( $tstate, qw<Auto-Not-For-Us>);
+            # if the package is currently current, the status is Installed, not not-for-us
+            if ($pkg->{'state'} ne $tstate) {
+                change_state( \$pkg, $tstate);
+                if (isin( $tstate, qw<Installed>)) {
+                    delete $pkg->{'depends'};
+                    delete $pkg->{'extra_depends'};
+                    delete $pkg->{'extra_conflicts'};
+                }
                 $change++;
             }
             my $attrs = { 'version' => 'version', 'installed_version' => 'version', 'binary_nmu_version' => 'binnmu', 'section' => 'section', 'priority' => 'priority' };
             foreach my $k (keys %$attrs) {
+                next if isin( $tstate, qw<Auto-Not-For-Us>) && isin( $k, qw<installed_version binary_nmu_version>);
                 if (($pkg->{$k}//"") ne ($pkgs->{$attrs->{$k}}//"")) {
                     $pkg->{$k} = $pkgs->{$attrs->{$k}};
                     $change++;
@@ -2605,8 +2473,8 @@ sub parse_all_v3 {
                 $change++;
             }
             if ($change) {
-                print "$logstr set to installed/".($pkg->{'notes'}//"")."\n" if $verbose || $simulate;
-                log_ta( $pkg, "--merge-v3: installed" ) unless $simulate;
+                print "$logstr set to $tstate/".($pkg->{'notes'}//"")."\n" if $verbose || $simulate;
+                log_ta( $pkg, "--merge-v3: $tstate" ) unless $simulate;
                 update_source_info($pkg) unless $simulate;
             }
             next;
@@ -2627,17 +2495,6 @@ sub parse_all_v3 {
             next;
         }
 
-        if ($pkgs->{'status'} eq 'auto-not-for-us') {
-            next if isin( $pkg->{'state'}, qw(Not-For-Us Failed Failed-Removed Dep-Wait Dep-Wait-Removed Auto-Not-For-Us));
-            # if the package is currently current, the status is Installed, not not-for-us
-
-            change_state( \$pkg, "Auto-Not-For-Us" );
-	    log_ta( $pkg, "--merge-v3: Auto-Not-For-Us" ) unless $simulate;
-	    update_source_info($pkg) unless $simulate;
-            print "$logstr set to auto-not-for-us\n" if $verbose || $simulate;
-            next SRCS;
-        }
-
         # only uncompiled / out-of-date are left, so check if anything new
         if (!(isin($pkgs->{'status'}, qw (uncompiled out-of-date)))) {
             print "$logstr package in unknown state: $pkgs->{'status'}\n";