]> git.donarmstrong.com Git - wannabuild.git/blobdiff - bin/wanna-build
perlcritic: Subroutine prototypes used
[wannabuild.git] / bin / wanna-build
index 91d05df91f8c7c346941d69e1303a6aa0caba1f3..27fb2126d65e8eaaa78312b8819fe5b109ec4636 100755 (executable)
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 #
+use strict;
+use warnings;
 
 package conf;
+
+use vars qw< $basedir $dbbase $transactlog $mailprog $buildd_domain >;
 # defaults
 $basedir ||= "/var/lib/debbuild";
 $dbbase ||= "build-db";
@@ -34,7 +38,6 @@ die "mailprog binary $conf::mailprog does not exist or isn't executable\n"
        if !-x $conf::mailprog;
 package main;
 
-use strict;
 use POSIX;
 use FileHandle;
 use File::Copy;
@@ -160,7 +163,7 @@ my %options =
                   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 all failed-removed
+                                                not-for-us auto-not-for-us all failed-removed
                                                 install-wait reupload-wait bd-uninstallable));} },
         # options with args
         dist           =>
@@ -181,7 +184,7 @@ my %options =
         { short => "O", arg => \$list_order,
           code => sub {
                   die "Bad ordering character\n"
-                          if $list_order !~ /^[PSpsncbCW]+$/;
+                          if $list_order !~ /^[PSpsncbCWT]+$/;
           } },
         message        => { short => "m", arg => \$fail_reason },
         # database is deprecated, use arch instead.
@@ -296,12 +299,15 @@ $dbh->{pg_server_prepare} = 0;
 
 $dbh->begin_work or die $dbh->errstr;
 
-my $q = 'SELECT distribution, public, auto_dep_wait FROM distributions';
+my $q = 'SELECT distribution, public, auto_dep_wait, build_dep_resolver, suppress_successful_logs, archive FROM distributions';
 my $rows = $dbh->selectall_hashref($q, 'distribution');
 foreach my $name (keys %$rows) {
        $distributions{$name} = {};
        $distributions{$name}->{'noadw'} = 1 if !($rows->{$name}->{'auto_dep_wait'});
        $distributions{$name}->{'hidden'} = 1 if !($rows->{$name}->{'public'});
+       $distributions{$name}->{'build_dep_resolver'} = $rows->{$name}->{'build_dep_resolver'} if $rows->{$name}->{'build_dep_resolver'};
+       $distributions{$name}->{'suppress_successful_logs'} = $rows->{$name}->{'suppress_successful_logs'} if $rows->{$name}->{'suppress_successful_logs'};
+       $distributions{$name}->{'archive'} = $rows->{$name}->{'archive'} if $rows->{$name}->{'archive'};
 }
 
 $q = 'SELECT alias, distribution FROM distribution_aliases';
@@ -514,7 +520,7 @@ sub process {
                        @ARGV = ( $ARGS[0] );
                        my $pkgs = parse_packages(0);
                        @ARGV = ( $ARGS[3] );
-                       my $pkgs = parse_packages(1);
+                       $pkgs = parse_packages(1);
                        @ARGV = ( $ARGS[1] );
                        parse_quinn_diff(0);
                        @ARGV = ( $ARGS[2] );
@@ -785,6 +791,10 @@ sub add_one_building {
                 print  "    - extra-changelog: $pkg->{'binary_nmu_changelog'}\n" if $pkg->{'binary_nmu_changelog'} && $pkg->{'binary_nmu_version'};
                 print  "    - extra-depends: $pkg->{'extra_depends'}\n" if $pkg->{'extra_depends'};
                 print  "    - extra-conflicts: $pkg->{'extra_conflicts'}\n" if $pkg->{'extra_conflicts'};
+                print  "    - archive: $distributions{$distribution}->{'archive'}\n" if $distributions{$distribution}->{'archive'};
+                print  "    - build_dep_resolver: $distributions{$distribution}->{'build_dep_resolver'}\n" if $distributions{$distribution}->{'build_dep_resolver'};
+                print  "    - arch_all: $pkg->{'build_arch_all'}\n" if $pkg->{'build_arch_all'};
+                print  "    - suppress_successful_logs: $distributions{$distribution}->{'suppress_successful_logs'}\n" if $distributions{$distribution}->{'suppress_successful_logs'};
             }
                change_state( \$pkg, 'Building' );
                $pkg->{'package'} = $name;
@@ -1121,7 +1131,7 @@ sub add_one_needsbuild {
                          "Skipping.\n";
                return;
        }
-       if ($distribution eq "unstable") {
+       if (!defined $distributions{$distribution}{noadw}) {
                change_state( \$pkg, 'BD-Uninstallable' );
                $pkg->{'bd_problem'} = "Installability of build dependencies not tested yet";
        } else {
@@ -1901,9 +1911,9 @@ BEGIN {
 
 sub sort_list_func {
     my $map_funcs = {
-        'C' => ['<=>', sub { return (-1) * $_[0]->{'calprio'}; }],
-        'W' => ['<=>', sub { return (-1) * $_[0]->{'state_days'}; }],
-        'P' => ['<=>', sub { return (-1) * $_[0]->{'buildpri'}; }],
+        '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'}}; }],
         'n' => ['cmp', sub { return $_[0]->{'package'}; }],
@@ -1911,10 +1921,12 @@ sub sort_list_func {
         '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'}; }],
+        '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';
             return $r if $r != 0;
@@ -1998,7 +2010,9 @@ 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
@@ -2032,6 +2046,7 @@ X the string normally between [], e.g. optional:out-of-date:calprio{61}:days{25}
 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),
@@ -2161,11 +2176,12 @@ sub info_packages {
                'failed_category' => 'Failed-Category', 'notes' => 'Notes',
                'distribution' => 'Distribution', 'old_failed' => 'Old-Failed',
                'permbuildpri' => 'PermBuildPri', 'rel' => 'Rel',
-               'calprio' => 'CalculatedPri', 'state_days' => 'State-Days',
+               'calprio' => 'CalculatedPri', 'state_days' => 'State-Days', 'state_time' => 'State-Time',
                 'successtime' => 'Success-build-time',
                 'anytime' => 'Build-time',
                 'extra_depends' => 'Extra-Dependencies',
                 'extra_conflicts' => 'Extra-Conflicts',
+                'build_arch_all' => 'Build-Arch-All',
                         );
        
        foreach $name (@_) {
@@ -2309,7 +2325,7 @@ sub check_entry {
        die "Bad state $pkg->{'state'} of package $pkg->{Package}\n"
                if !isin( $pkg->{'state'},
                                  qw(Needs-Build Building Built Build-Attempted Uploaded Installed Dep-Wait Dep-Wait-Removed
-                                        Failed Failed-Removed Not-For-Us BD-Uninstallable
+                                        Failed Failed-Removed Not-For-Us BD-Uninstallable Auto-Not-For-Us
                                         ) );
 }
 
@@ -2787,10 +2803,10 @@ sub pkg_history_table_name {
 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"
+        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"
             . ", (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"
+            . ", extra_depends, extra_conflicts, build_arch_all"
             . " FROM " .  table_name()
             . ' WHERE package = ? AND distribution = ?';
        my $pkg = $dbh->selectrow_hashref( $q,
@@ -2801,7 +2817,7 @@ sub get_readonly_source_info {
 sub get_source_info {
        my $name = shift;
         return get_readonly_source_info($name) if $simulate;
-       my $pkg = $dbh->selectrow_hashref('SELECT *, extract(days from date_trunc(\'days\', now() - state_change)) as state_days FROM ' . 
+       my $pkg = $dbh->selectrow_hashref('SELECT *, 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 FROM ' . 
                table_name() . ' WHERE package = ? AND distribution = ?' .
                ' FOR UPDATE',
                undef, $name, $distribution);
@@ -2811,7 +2827,7 @@ sub get_source_info {
 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"
+        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"
 #            . ", (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"
@@ -2986,14 +3002,13 @@ sub add_user_info {
                or die $dbh->errstr;
 }
 
-sub lock_table()
-{
+sub lock_table {
         return if $simulate;
        $dbh->do('LOCK TABLE ' . table_name() .
                ' IN EXCLUSIVE MODE', undef) or die $dbh->errstr;
 }
 
-sub parse_argv() {
+sub parse_argv {
 # parts the array $_[0] and $_[1] and returns the sub-array (modifies the original one)
     my @ret = ();
     my $args = shift;
@@ -3005,7 +3020,7 @@ sub parse_argv() {
     return @ret;
 }
 
-sub parse_all_v3() {
+sub parse_all_v3 {
     my $srcs = shift;
     my $vars = shift;
     my $db = get_all_source_info();
@@ -3015,13 +3030,13 @@ sub parse_all_v3() {
     foreach my $name (keys %$srcs) {
         next if $name eq '_binary';
 
-        # state = installed, out-of-date, uncompiled, not-for-us
+        # state = installed, out-of-date, uncompiled, not-for-us, auto-not-for-us
         my $pkgs = $srcs->{$name};
         my $pkg = $db->{$name};
 
         unless ($pkg) {
             next SRCS if $pkgs->{'status'} eq 'not-for-us';
-            my $logstr = "merge-v3 $vars->{'time'} ".$name."_$pkgs->{'version'} ($vars->{'arch'}, $vars->{'suite'}):";
+            my $logstr = sprintf("merge-v3 %s %s_%s (%s, %s):", $vars->{'time'}, $name, $pkgs->{'version'}, $vars->{'arch'}, $vars->{'suite'});
 
             # does at least one binary exist in the database and is more recent - if so, we're probably just outdated, ignore the source package
             for my $bin (@{$pkgs->{'binary'}}) {
@@ -3034,7 +3049,7 @@ sub parse_all_v3() {
         }
         my $logstr = "merge-v3 $vars->{'time'} ".$name."_$pkgs->{'version'}".
             ($pkgs->{'binnmu'} ? ";b".$pkgs->{'binnmu'} : "").
-            "($vars->{'arch'}, $vars->{'suite'}, previous: $pkg->{'version'}".
+            " ($vars->{'arch'}, $vars->{'suite'}, previous: $pkg->{'version'}".
             ($pkg->{'binary_nmu_version'} ? ";b".$pkg->{'binary_nmu_version'} : "").
             ", $pkg->{'state'}):";
 
@@ -3084,6 +3099,17 @@ 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";