scripts: Use named variables instead of using the topic variable

Switch code that uses roughly more explicit instances of the topic
variable than implicit ones.

Addresses BuiltinFunctions::ProhibitUselessTopic.

Warned-by: perlcritic

dselect/methods/ftp/install

@@ -373,11 +373,11 @@ sub download() {
 	      $protected =~ s/\+/\\\+/g;
 	      my $list = $ftp->ls("$pre$dir");
 	      if ($ftp->ok() && ref($list)) {
-                foreach (@{$list}) {
-                  if (m/($dir\/${protected}_[^\/]+.deb)/i) {
-		    print "Package found : $_\n";
-		    print "getting: $_ (size not known)\n";
-                    $res = $ftp->get($_, "$dldir/$1");
+		foreach my $file (@{$list}) {
+		  if ($file =~ m/($dir\/${protected}_[^\/]+.deb)/i) {
+		    print "Package found : $file\n";
+		    print "getting: $file (size not known)\n";
+		    $res = $ftp->get($file, "$dldir/$1");
 		    if (! $res) {
                       $r = $ftp->code();
 		      print $ftp->message() . "\n";
@@ -563,10 +563,10 @@ if (yesno('y', "\nDo you want to install the files fetched")) {
     #Installing pre-dependent package before !
     my (@flds, $package, @filename, $r);
     while (@flds = `dpkg --predep-package`, $? == 0) {
-      foreach (@flds) {
-        s/\s*\n//;
-	$package= $_ if s/^Package: //i;
-	@filename= split(/ +/,$_) if s/^Filename: //i;
+      foreach my $field (@flds) {
+        $field =~ s/\s*\n//;
+        $package = $field if $field =~ s/^Package: //i;
+        @filename = split / +/, $field if $field =~ s/^Filename: //i;
       }
       @filename = map { "$dldir/$_" } @filename;
       next if (! @filename);
@@ -621,9 +621,9 @@ if (yesno('n', "\nDo you want to remove $dldir directory?")) {
 }
 
 #Store useful md5sums
-foreach (keys %md5sums) {
-  next if (-f $_);
-  delete $md5sums{$_};
+foreach my $file (keys %md5sums) {
+  next if -f $file;
+  delete $md5sums{$file};
 }
 open(my $md5sums_fh, '>', "$methdir/md5sums")
   or die "can't open $methdir/md5sums in write mode: $!\n";

dselect/mkcurkeys.pl

@@ -56,18 +56,18 @@ while (<$header_fh>) {
     m/#define KEY_(\w+)\s+\d+\s+/p || next;
     my $rhs = ${^POSTMATCH};
     $k= "KEY_$1";
-    $_= $1;
-    capit();
-    $base{$k}= $_;
-    $_= $rhs;
-    s/(\w)[\(\)]/$1/g;
-    s/\w+ \((\w+)\)/$1/;
-    next unless m{^/\* (\w[\w ]+\w) \*/$};
-    $_= $1;
-    s/ key$//;
-    next if s/^shifted /shift / ? m/ .* .* / : m/ .* /;
-    capit();
-    $name{$k}= $_;
+    $base{$k} = capit($1);
+    $rhs =~ s/(\w)[\(\)]/$1/g;
+    $rhs =~ s/\w+ \((\w+)\)/$1/;
+    next unless $rhs =~ m{^/\* (\w[\w ]+\w) \*/$};
+    my $name = $1;
+    $name =~ s/ key$//;
+    if ($name =~ s/^shifted /shift /) {
+        next if $name =~ m/ .* .* /;
+    } else {
+        next if $name =~ m/ .* /;
+    }
+    $name{$k} = capit($name);
 }
 close($header_fh);
 
@@ -119,17 +119,22 @@ close(STDOUT) or die $!;
 exit(0);
 
 sub capit {
+    my $str = shift;
     my $o = '';
-    y/A-Z/a-z/;
-    $_ = " $_";
-    while (m/ (\w)/p) {
+
+    $str =~ y/A-Z/a-z/;
+    $str = " $str";
+    while ($str =~ m/ (\w)/p) {
         $o .= ${^PREMATCH} . ' ';
-        $_ = $1;
-        y/a-z/A-Z/;
-        $o .= $_;
-        $_ = ${^POSTMATCH};
+        $str = $1;
+        $str =~ y/a-z/A-Z/;
+        $o .= $str;
+        $str = ${^POSTMATCH};
     }
-    $_= $o.$_; s/^ //;
+    $str = $o . $str;
+    $str =~ s/^ //;
+
+    return $str;
 }
 
 sub p {

scripts/Dpkg/Arch.pm

@@ -328,16 +328,13 @@ sub debtriplet_to_debarch(@)
 
 sub debarch_to_debtriplet($)
 {
-    local ($_) = @_;
-    my $arch;
+    my $arch = shift;
 
     read_triplettable();
 
-    if (/^linux-([^-]*)/) {
+    if ($arch =~ /^linux-([^-]*)/) {
 	# XXX: Might disappear in the future, not sure yet.
 	$arch = $1;
-    } else {
-	$arch = $_;
     }
 
     my $triplet = $debarch_to_debtriplet{$arch};

scripts/Dpkg/Changelog.pm

@@ -344,8 +344,8 @@ sub _is_full_range {
     return 1 if $range->{all};
 
     # If no range delimiter is specified, we want everything.
-    foreach (qw(since until from to count offset)) {
-        return 0 if exists $range->{$_};
+    foreach my $delim (qw(since until from to count offset)) {
+        return 0 if exists $range->{$delim};
     }
 
     return 1;
@@ -388,12 +388,12 @@ sub _data_range {
     my @result;
     my $include = 1;
     $include = 0 if defined($range->{to}) or defined($range->{until});
-    foreach (@$data) {
-	my $v = $_->get_version();
+    foreach my $entry (@{$data}) {
+	my $v = $entry->get_version();
 	$include = 1 if defined($range->{to}) and $v eq $range->{to};
 	last if defined($range->{since}) and $v eq $range->{since};
 
-	push @result, $_ if $include;
+	push @result, $entry if $include;
 
 	$include = 1 if defined($range->{until}) and $v eq $range->{until};
 	last if defined($range->{from}) and $v eq $range->{from};
@@ -431,8 +431,8 @@ sub abort_early {
     }
 
     return unless defined($r->{since}) or defined($r->{from});
-    foreach (@$data) {
-	my $v = $_->get_version();
+    foreach my $entry (@{$data}) {
+	my $v = $entry->get_version();
 	return 1 if defined($r->{since}) and $v eq $r->{since};
 	return 1 if defined($r->{from}) and $v eq $r->{from};
     }

scripts/Dpkg/Changelog/Parse.pm

@@ -126,15 +126,15 @@ sub changelog_parse {
 
     # Create the arguments for the changelog parser
     my @exec = ($parser, "-l$changelogfile");
-    foreach (keys %options) {
-	if (m/^-/) {
+    foreach my $option (keys %options) {
+	if ($option =~ m/^-/) {
 	    # Options passed untouched
-	    push @exec, $_;
+	    push @exec, $option;
 	} else {
 	    # Non-options are mapped to long options
-	    push @exec, "--$_";
+	    push @exec, "--$option";
 	}
-	push @exec, $options{$_} if defined($options{$_});
+	push @exec, $options{$option} if defined $options{$option};
     }
 
     # Fork and call the parser

scripts/Dpkg/Compression/Process.pm

@@ -125,9 +125,9 @@ sub _sanity_check {
 	    if $self->{pid};
     # Check options
     my $to = my $from = 0;
-    foreach (qw(file handle string pipe)) {
-        $to++ if $opts{"to_$_"};
-        $from++ if $opts{"from_$_"};
+    foreach my $thing (qw(file handle string pipe)) {
+        $to++ if $opts{"to_$thing"};
+        $from++ if $opts{"from_$thing"};
     }
     croak 'exactly one to_* parameter is needed' if $to != 1;
     croak 'exactly one from_* parameter is needed' if $from != 1;

scripts/Dpkg/Control/HashCore.pm

@@ -510,8 +510,8 @@ sub DELETE {
 sub FIRSTKEY {
     my $self = shift;
     my $parent = $self->[1];
-    foreach (@{$parent->{in_order}}) {
-	return $_ if exists $self->[0]->{lc($_)};
+    foreach my $key (@{$parent->{in_order}}) {
+	return $key if exists $self->[0]->{lc $key};
     }
 }
 
@@ -519,11 +519,11 @@ sub NEXTKEY {
     my ($self, $last) = @_;
     my $parent = $self->[1];
     my $found = 0;
-    foreach (@{$parent->{in_order}}) {
+    foreach my $key (@{$parent->{in_order}}) {
 	if ($found) {
-	    return $_ if exists $self->[0]->{lc($_)};
+	    return $key if exists $self->[0]->{lc $key};
 	} else {
-	    $found = 1 if $_ eq $last;
+	    $found = 1 if $key eq $last;
 	}
     }
     return;

scripts/Dpkg/IPC.pm

@@ -149,10 +149,10 @@ sub _sanity_check_opts {
 	unless $opts{exec};
 
     my $to = my $error_to = my $from = 0;
-    foreach (qw(file handle string pipe)) {
-	$to++ if $opts{"to_$_"};
-	$error_to++ if $opts{"error_to_$_"};
-	$from++ if $opts{"from_$_"};
+    foreach my $thing (qw(file handle string pipe)) {
+	$to++ if $opts{"to_$thing"};
+	$error_to++ if $opts{"error_to_$thing"};
+	$from++ if $opts{"from_$thing"};
     }
     croak 'not more than one of to_* parameters is allowed'
 	if $to > 1;
@@ -161,18 +161,18 @@ sub _sanity_check_opts {
     croak 'not more than one of from_* parameters is allowed'
 	if $from > 1;
 
-    foreach (qw(to_string error_to_string from_string)) {
-	if (exists $opts{$_} and
-	    (not ref($opts{$_}) or ref($opts{$_}) ne 'SCALAR')) {
-	    croak "parameter $_ must be a scalar reference";
+    foreach my $param (qw(to_string error_to_string from_string)) {
+	if (exists $opts{$param} and
+	    (not ref $opts{$param} or ref $opts{$param} ne 'SCALAR')) {
+	    croak "parameter $param must be a scalar reference";
 	}
     }
 
-    foreach (qw(to_pipe error_to_pipe from_pipe)) {
-	if (exists $opts{$_} and
-	    (not ref($opts{$_}) or (ref($opts{$_}) ne 'SCALAR' and
-				 not $opts{$_}->isa('IO::Handle')))) {
-	    croak "parameter $_ must be a scalar reference or " .
+    foreach my $param (qw(to_pipe error_to_pipe from_pipe)) {
+	if (exists $opts{$param} and
+	    (not ref $opts{$param} or (ref $opts{$param} ne 'SCALAR' and
+	     not $opts{$param}->isa('IO::Handle')))) {
+	    croak "parameter $param must be a scalar reference or " .
 	          'an IO::Handle object';
 	}
     }

scripts/Dpkg/Shlibs/Cppfilt.pm

@@ -91,14 +91,14 @@ sub cppfilt_demangle_cpp {
 }
 
 sub terminate_cppfilts {
-    foreach (keys %cppfilts) {
-	next if not defined $cppfilts{$_}{pid};
-	close $cppfilts{$_}{from};
-	close $cppfilts{$_}{to};
-	wait_child($cppfilts{$_}{pid}, cmdline => 'c++filt',
-	                               nocheck => 1,
-	                               timeout => 5);
-	delete $cppfilts{$_};
+    foreach my $type (keys %cppfilts) {
+	next if not defined $cppfilts{$type}{pid};
+	close $cppfilts{$type}{from};
+	close $cppfilts{$type}{to};
+	wait_child($cppfilts{$type}{pid}, cmdline => 'c++filt',
+	                                  nocheck => 1,
+	                                  timeout => 5);
+	delete $cppfilts{$type};
     }
 }
 

scripts/Dpkg/Source/Package.pm

@@ -438,9 +438,9 @@ sub check_signature {
 
 sub parse_cmdline_options {
     my ($self, @opts) = @_;
-    foreach (@opts) {
-        if (not $self->parse_cmdline_option($_)) {
-            warning(_g('%s is not a valid option for %s'), $_, ref($self));
+    foreach my $option (@opts) {
+        if (not $self->parse_cmdline_option($option)) {
+            warning(_g('%s is not a valid option for %s'), $option, ref $self);
         }
     }
 }

scripts/Dpkg/Source/Package/V2.pm

@@ -333,19 +333,19 @@ sub generate_patch {
     my ($tarfile, %origtar);
     my $comp_ext_regex = compression_get_file_extension_regex();
     my @origtarballs;
-    foreach (sort $self->find_original_tarballs()) {
-        if (/\.orig\.tar\.$comp_ext_regex$/) {
+    foreach my $file (sort $self->find_original_tarballs()) {
+        if ($file =~ /\.orig\.tar\.$comp_ext_regex$/) {
             if (defined($tarfile)) {
                 error(_g('several orig.tar files found (%s and %s) but only ' .
-                         'one is allowed'), $tarfile, $_);
+                         'one is allowed'), $tarfile, $file);
             }
-            $tarfile = $_;
-            push @origtarballs, $_;
-            $self->add_file($_);
-        } elsif (/\.orig-([[:alnum:]-]+)\.tar\.$comp_ext_regex$/) {
-            $origtar{$1} = $_;
-            push @origtarballs, $_;
-            $self->add_file($_);
+            $tarfile = $file;
+            push @origtarballs, $file;
+            $self->add_file($file);
+        } elsif ($file =~ /\.orig-([[:alnum:]-]+)\.tar\.$comp_ext_regex$/) {
+            $origtar{$1} = $file;
+            push @origtarballs, $file;
+            $self->add_file($file);
         }
     }
 

scripts/Dpkg/Source/Patch.pm

@@ -400,42 +400,48 @@ sub analyze {
     my $patch_header = '';
     my $diff_count = 0;
 
-    $_ = _getline($self);
+    my $line = _getline($self);
 
   HUNK:
-    while (defined($_) or not eof($self)) {
+    while (defined $line or not eof $self) {
 	my (%path, %fn);
 
 	# Skip comments leading up to the patch (if any). Although we do not
 	# look for an Index: pseudo-header in the comments, because we would
 	# not use it anyway, as we require both ---/+++ filename headers.
 	while (1) {
-	    if (/^(?:--- |\+\+\+ |@@ -)/) {
+	    if ($line =~ /^(?:--- |\+\+\+ |@@ -)/) {
 		last;
 	    } else {
-		$patch_header .= "$_\n";
+		$patch_header .= "$line\n";
 	    }
-	    last HUNK if not defined($_ = _getline($self));
+	    $line = _getline($self);
+	    last HUNK if not defined $line;
 	}
 	$diff_count++;
 	# read file header (---/+++ pair)
-	unless (s/^--- //) {
+	unless ($line =~ s/^--- //) {
 	    error(_g("expected ^--- in line %d of diff `%s'"), $., $diff);
 	}
-	$path{old} = $_ = _fetch_filename($diff, $_);
-	$fn{old} = $_ if $_ ne '/dev/null' and s{^[^/]*/+}{$destdir/};
-	if (/\.dpkg-orig$/) {
+	$path{old} = $line = _fetch_filename($diff, $line);
+	if ($line ne '/dev/null' and $line =~ s{^[^/]*/+}{$destdir/}) {
+	    $fn{old} = $line;
+	}
+	if ($line =~ /\.dpkg-orig$/) {
 	    error(_g("diff `%s' patches file with name ending .dpkg-orig"), $diff);
 	}
 
-	unless (defined($_ = _getline($self))) {
+	$line = _getline($self);
+	unless (defined $line) {
 	    error(_g("diff `%s' finishes in middle of ---/+++ (line %d)"), $diff, $.);
 	}
-	unless (s/^\+\+\+ //) {
+	unless ($line =~ s/^\+\+\+ //) {
 	    error(_g("line after --- isn't as expected in diff `%s' (line %d)"), $diff, $.);
 	}
-	$path{new} = $_ = _fetch_filename($diff, $_);
-	$fn{new} = $_ if $_ ne '/dev/null' and s{^[^/]*/+}{$destdir/};
+	$path{new} = $line = _fetch_filename($diff, $line);
+	if ($line ne '/dev/null' and $line =~ s{^[^/]*/+}{$destdir/}) {
+	    $fn{new} = $line;
+	}
 
 	unless (defined $fn{old} or defined $fn{new}) {
 	    error(_g("none of the filenames in ---/+++ are valid in diff '%s' (line %d)"),

scripts/Dpkg/Source/Quilt.pm

@@ -321,12 +321,16 @@ sub read_patch_list {
     $opts{warn_options} //= 0;
     my @patches;
     open(my $series_fh, '<' , $file) or syserr(_g('cannot read %s'), $file);
-    while (defined($_ = <$series_fh>)) {
-        chomp; s/^\s+//; s/\s+$//; # Strip leading/trailing spaces
-        s/(?:^|\s+)#.*$//; # Strip comment
-        next unless $_;
-        if (/^(\S+)\s+(.*)$/) {
-            $_ = $1;
+    while (defined(my $line = <$series_fh>)) {
+        chomp $line;
+        # Strip leading/trailing spaces
+        $line =~ s/^\s+//;
+        $line =~ s/\s+$//;
+        # Strip comment
+        $line =~ s/(?:^|\s+)#.*$//;
+        next unless $line;
+        if ($line =~ /^(\S+)\s+(.*)$/) {
+            $line = $1;
             if ($2 ne '-p1') {
                 warning(_g('the series file (%s) contains unsupported ' .
                            "options ('%s', line %s); dpkg-source might " .
@@ -334,8 +338,10 @@ sub read_patch_list {
                         $file, $2, $.) if $opts{warn_options};
             }
         }
-        error(_g('%s contains an insecure path: %s'), $file, $_) if m{(^|/)\.\./};
-        CORE::push @patches, $_;
+        if ($line =~ m{(^|/)\.\./}) {
+            error(_g('%s contains an insecure path: %s'), $file, $line);
+        }
+        CORE::push @patches, $line;
     }
     close($series_fh);
     return @patches;

scripts/dpkg-scanpackages.pl

@@ -188,9 +188,8 @@ my $find_h = IO::Handle->new();
 open($find_h, '-|', 'find', '-L', "$binarydir/", @find_args, '-print')
      or syserr(_g("couldn't open %s for reading"), $binarydir);
 FILE:
-    while (<$find_h>) {
-	chomp;
-	my $fn = $_;
+    while (my $fn = <$find_h>) {
+	chomp $fn;
 	my $output;
 	my $pid = spawn(exec => [ 'dpkg-deb', '-I', $fn, 'control' ],
 	                to_pipe => \$output);
@@ -209,19 +208,19 @@ FILE:
 	my $p = $fields->{'Package'};
 
 	if (defined($packages{$p}) and not $options{multiversion}) {
-	    foreach (@{$packages{$p}}) {
+	    foreach my $pkg (@{$packages{$p}}) {
 		if (version_compare_relation($fields->{'Version'}, REL_GT,
-					     $_->{'Version'}))
+		                             $pkg->{'Version'}))
                 {
 		    warning(_g('package %s (filename %s) is repeat but newer version;'),
 		            $p, $fn);
 		    warning(_g('used that one and ignored data from %s!'),
-		            $_->{Filename});
+		            $pkg->{Filename});
 		    $packages{$p} = [];
 		} else {
 		    warning(_g('package %s (filename %s) is repeat;'), $p, $fn);
 		    warning(_g('ignored that one and using data from %s!'),
-		            $_->{Filename});
+		            $pkg->{Filename});
 		    next FILE;
 		}
 	    }

scripts/dpkg-shlibdeps.pl

@@ -303,14 +303,14 @@ foreach my $file (keys %exec) {
     # Scan all undefined symbols of the binary and resolve to a
     # dependency
     my %soname_used;
-    foreach (@sonames) {
+    foreach my $soname (@sonames) {
         # Initialize statistics
-        $soname_used{$_} = 0;
-        $global_soname_used{$_} //= 0;
-        if (exists $global_soname_needed{$_}) {
-            push @{$global_soname_needed{$_}}, $file;
+        $soname_used{$soname} = 0;
+        $global_soname_used{$soname} //= 0;
+        if (exists $global_soname_needed{$soname}) {
+            push @{$global_soname_needed{$soname}}, $file;
         } else {
-            $global_soname_needed{$_} = [ $file ];
+            $global_soname_needed{$soname} = [ $file ];
         }
     }
     my $nb_warnings = 0;
@@ -829,13 +829,13 @@ sub find_packages {
     my @files;
     my $pkgmatch = {};
 
-    foreach (@_) {
-	if (exists $cached_pkgmatch{$_}) {
-	    $pkgmatch->{$_} = $cached_pkgmatch{$_};
+    foreach my $path (@_) {
+	if (exists $cached_pkgmatch{$path}) {
+	    $pkgmatch->{$path} = $cached_pkgmatch{$path};
 	} else {
-	    push @files, $_;
-	    $cached_pkgmatch{$_} = ['']; # placeholder to cache misses too.
-	    $pkgmatch->{$_} = [''];        # might be replaced later on
+	    push @files, $path;
+	    $cached_pkgmatch{$path} = ['']; # placeholder to cache misses too.
+	    $pkgmatch->{$path} = [''];      # might be replaced later on
 	}
     }
     return $pkgmatch unless scalar(@files);