]> git.donarmstrong.com Git - wannabuild.git/blobdiff - bin/wanna-build
Use open in a modern way.
[wannabuild.git] / bin / wanna-build
index 96bd10f41e8fa85d4790491a853595db32a785b4..5ebd6196a8f8b917f3b14e6fd897208e8689ecb9 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           =>
@@ -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 {
@@ -2000,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
@@ -2034,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),
@@ -2168,6 +2181,7 @@ sub info_packages {
                 'anytime' => 'Build-time',
                 'extra_depends' => 'Extra-Dependencies',
                 'extra_conflicts' => 'Extra-Conflicts',
+                'build_arch_all' => 'Build-Arch-All',
                         );
        
        foreach $name (@_) {
@@ -2248,11 +2262,11 @@ sub read_db {
        my $file = shift;
 
        print "Reading ASCII database from $file..." if $verbose >= 1;
-       open( F, "<$file" ) or
+       open( my $fh, '<', $file ) or
                die "Can't open database $file: $!\n";
 
        local($/) = ""; # read in paragraph mode
-       while( <F> ) {
+       while( <$fh> ) {
                my( %thispkg, $name );
                s/[\s\n]+$//;
                s/\n[ \t]+/\376\377/g;  # fix continuation lines
@@ -2280,7 +2294,7 @@ sub read_db {
                                or die $dbh->errstr;
                 }
        }
-       close( F );
+       close( $fh );
        print "done\n" if $verbose >= 1;
 }
 
@@ -2311,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
                                         ) );
 }
 
@@ -2320,7 +2334,7 @@ sub export_db {
        my($name,$pkg,$key);
 
        print "Writing ASCII database to $file..." if $verbose >= 1;
-       open( F, ">$file" ) or
+       open( my $fh, '>', $file ) or
                die "Can't open export $file: $!\n";
 
         my $db = get_all_source_info();
@@ -2333,11 +2347,11 @@ sub export_db {
                        $val =~ s/\n*$//;
                        $val =~ s/^/ /mg;
                        $val =~ s/^ +$/ ./mg;
-                       print F "$key: $val\n";
+                       print $fh "$key: $val\n";
                }
-               print F "\n";
+               print $fh "\n";
        }
-       close( F );
+       close( $fh );
        print "done\n" if $verbose >= 1;
 }
 
@@ -2414,13 +2428,13 @@ sub send_mail {
        $to .= '@' . $domain if $to !~ /\@/;
        $text =~ s/^\.$/../mg;
        local $SIG{'PIPE'} = 'IGNORE';
-       open( PIPE,  "| $conf::mailprog -oem $to" )
+       open( my $pipe,  '|-', "$conf::mailprog -oem $to" )
                or die "Can't open pipe to $conf::mailprog: $!\n";
        chomp $text;
-       print PIPE "From: $from\n";
-       print PIPE "Subject: $subject\n\n";
-       print PIPE "$text\n";
-       close( PIPE );
+       print $pipe "From: $from\n";
+       print $pipe "Subject: $subject\n\n";
+       print $pipe "$text\n";
+       close( $pipe );
 }
 
 # for parsing input to dep-wait
@@ -2494,8 +2508,8 @@ sub wb_edos_builddebcheck {
 
     my $packagearch="";
     foreach my $packagefile (@$packagefiles) {
-        open(P,$packagefile);
-        while (<P>) {
+        open(my $fh,'<', $packagefile);
+        while (<$fh>) {
             next unless /^Architecture/;
             next if /^Architecture:\s*all/;
             /Architecture:\s*([^\s]*)/;
@@ -2505,7 +2519,7 @@ sub wb_edos_builddebcheck {
                return "Package file contains different architectures: $packagearch, $1";
             }
         }
-        close P;
+        close $fh;
     }
 
     if ( $architecture eq "" ) {
@@ -2523,14 +2537,14 @@ sub wb_edos_builddebcheck {
     }
 
     print "calling: edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @$packagefiles)."\n";
-    open(RESULT, '-|',
+    open(my $result_cmd, '-|',
         "edos-debcheck $edosoptions < $sourcesfile ".join('', map {" '-base FILE' ".$_ } @$packagefiles));
 
     my $explanation="";
     my $result={};
     my $binpkg="";
 
-    while (<RESULT>) {
+    while (<$result_cmd>) {
 # source---pulseaudio (= 0.9.15-4.1~bpo50+1): FAILED
 #   source---pulseaudio (= 0.9.15-4.1~bpo50+1) depends on missing:
 #   - libltdl-dev (>= 2.2.6a-2)
@@ -2559,7 +2573,7 @@ sub wb_edos_builddebcheck {
         }
     }
 
-    close RESULT;
+    close $result_cmd;
     $result->{$binpkg} = $explanation if $binpkg;
     return $result;
 
@@ -2792,7 +2806,7 @@ sub get_readonly_source_info {
         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,
@@ -2988,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;
@@ -3007,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();
@@ -3017,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'}}) {
@@ -3036,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'}):";
 
@@ -3086,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";