Use open in a modern way.

[wannabuild.git] / bin / wanna-build

diff --git a/bin/wanna-build b/bin/wanna-build
index 8780000876d6b60da09f3fed56ae2d67cc43d593..5ebd6196a8f8b917f3b14e6fd897208e8689ecb9 100755 (executable)
--- a/bin/wanna-build
+++ b/bin/wanna-build
@@ -19,8 +19,12 @@
 # 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;
@@ -517,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] );
@@ -2007,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
@@ -2041,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),
@@ -2256,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
@@ -2288,7 +2294,7 @@ sub read_db {
                                or die $dbh->errstr;
                 }
        }
-       close( F );
+       close( $fh );
        print "done\n" if $verbose >= 1;
 }
 
@@ -2328,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();
@@ -2341,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;
 }
 
@@ -2422,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
@@ -2502,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]*)/;
@@ -2513,7 +2519,7 @@ sub wb_edos_builddebcheck {
                return "Package file contains different architectures: $packagearch, $1";
             }
         }
-        close P;
+        close $fh;
     }
 
     if ( $architecture eq "" ) {
@@ -2531,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)
@@ -2567,7 +2573,7 @@ sub wb_edos_builddebcheck {
         }
     }
 
-    close RESULT;
+    close $result_cmd;
     $result->{$binpkg} = $explanation if $binpkg;
     return $result;
 
@@ -2996,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;
@@ -3015,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();
@@ -3031,7 +3036,7 @@ sub parse_all_v3() {
 
         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'}}) {
@@ -3044,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'}):";
 
@@ -3095,7 +3100,7 @@ sub parse_all_v3() {
         }
 
         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));
+            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" );