perl: Do not use global match variables

Fixes Variables::ProhibitMatchVars.

Warned-by: perlcritic

debian/changelog

@@ -20,6 +20,7 @@ dpkg (1.17.10) UNRELEASED; urgency=low
   * Move dpkg-architecture -L argument to the Commands --help output section.
   * Make dpkg-maintscript-helper print only once that we are moving a
     conffile, and not on every interim state transition. Closes: #747370
+  * Do not use global match variables in perl code.
 
   [ Updated manpages translations ]
   * German (Helge Kreutzmann).

dselect/methods/disk/setup

@@ -96,7 +96,7 @@ getblockdev () {
 			set -e
 			proposeddevice="$tryblockdevice" perl -ne '
 next unless /^ *Device +Boot +Start +End +Blocks +Id +System *$/i .. !/\S/;
-next unless s:^/\S+:: && $& eq $ENV{proposeddevice};
+next unless s:^/\S+::p && ${^MATCH} eq $ENV{proposeddevice};
 next unless s/^ +(\* +)?\d+ +\d+ +\d+\+? +//;
 next unless m/^([0-9a-f]{1,2}) /i;
 %types= ( "1","msdos", "4","msdos", "6","msdos", "7","hpfs", "80","minix",
@@ -314,8 +314,8 @@ then
 	perl -ne '
 next unless /^ *Device +Boot +Start +End +Blocks +Id +System *$/i .. !/\S/;
 next unless / [146] +DOS \d+-bit \S+$/;
-next unless m:^/\S+:;
-print $&;		' <$tp.f >$tp.d
+next unless m:^/\S+:p;
+print ${^MATCH};		' <$tp.f >$tp.d
 	newdefaultdevice="`cat $tp.d`"
 	echo "
 I need to know which disk partition contains the distribution files;

dselect/methods/multicd/setup

@@ -122,7 +122,7 @@ getblockdev () {
 			set -e
 			proposeddevice="$tryblockdevice" perl -ne '
 next unless /^ *Device +Boot +Begin +Start +End +Blocks +Id +System *$/i .. !/\S/;
-next unless s:^/\S+:: && $& eq $ENV{proposeddevice};
+next unless s:^/\S+::p && ${^MATCH} eq $ENV{proposeddevice};
 next unless s/^ +(\* +)?\d+ +\d+ +\d+ +\d+\+? +//;
 next unless m/^([0-9a-f]{1,2}) /i;
 %types= ( "1","msdos", "4","msdos", "6","msdos", "7","hpfs", "80","minix",
@@ -342,8 +342,8 @@ then
 	perl -ne '
 next unless /^ *Device +Boot +Begin +Start +End +Blocks +Id +System *$/i .. !/\S/;
 next unless / [146] +DOS \d+-bit \S+$/;
-next unless m:^/\S+:;
-print $&;		' <$tp.f >$tp.d
+next unless m:^/\S+:p;
+print ${^MATCH};		' <$tp.f >$tp.d
 	newdefaultdevice="`cat $tp.d`"
 	echo "
 I need to know which disk partition contains the distribution files;

dselect/mkcurkeys.pl

@@ -53,8 +53,8 @@ my ($k, $v);
 open(my $header_fh, '<', $ARGV[1]) or die $!;
 while (<$header_fh>) {
     s/\s+$//;
-    m/#define KEY_(\w+)\s+\d+\s+/ || next;
-    my $rhs = $';
+    m/#define KEY_(\w+)\s+\d+\s+/p || next;
+    my $rhs = ${^POSTMATCH};
     $k= "KEY_$1";
     $_= $1;
     capit();
@@ -122,12 +122,12 @@ sub capit {
     my $o = '';
     y/A-Z/a-z/;
     $_ = " $_";
-    while (m/ (\w)/) {
-        $o .= $`.' ';
+    while (m/ (\w)/p) {
+        $o .= ${^PREMATCH} . ' ';
         $_ = $1;
         y/a-z/A-Z/;
         $o .= $_;
-        $_ = $';
+        $_ = ${^POSTMATCH};
     }
     $_= $o.$_; s/^ //;
 }
@@ -135,6 +135,6 @@ sub capit {
 sub p {
     my ($k, $v) = @_;
 
-    $v =~ s/["\\]/\\$&/g;
+    $v =~ s/["\\]/\\${^MATCH}/pg;
     printf("  { %-15s \"%-20s },\n", $k . ',', $v . '"') or die $!;
 }

scripts/Dpkg/Changelog/Entry/Debian.pm

@@ -297,8 +297,8 @@ sub find_closes {
     my %closes;
 
     while ($changes &&
-           ($changes =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig)) {
-        $closes{$_} = 1 foreach ($& =~ /\#?\s?(\d+)/g);
+           ($changes =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/pig)) {
+        $closes{$_} = 1 foreach (${^MATCH} =~ /\#?\s?(\d+)/g);
     }
 
     my @closes = sort { $a <=> $b } keys %closes;

scripts/Dpkg/Package.pm

@@ -32,8 +32,8 @@ sub pkg_name_is_illegal($) {
     if ($name eq '') {
         return _g('may not be empty string');
     }
-    if ($name =~ m/[^-+.0-9a-z]/o) {
-        return sprintf(_g("character '%s' not allowed"), $&);
+    if ($name =~ m/[^-+.0-9a-z]/op) {
+        return sprintf(_g("character '%s' not allowed"), ${^MATCH});
     }
     if ($name !~ m/^[0-9a-z]/o) {
         return _g('must start with an alphanumeric character');

scripts/Dpkg/Vendor/Ubuntu.pm

@@ -170,8 +170,8 @@ sub find_launchpad_closes {
     my %closes;
 
     while ($changes &&
-          ($changes =~ /lp:\s+\#\d+(?:,\s*\#\d+)*/ig)) {
-        $closes{$_} = 1 foreach ($& =~ /\#?\s?(\d+)/g);
+          ($changes =~ /lp:\s+\#\d+(?:,\s*\#\d+)*/pig)) {
+        $closes{$_} = 1 foreach (${^MATCH} =~ /\#?\s?(\d+)/g);
     }
 
     my @closes = sort { $a <=> $b } keys %closes;

scripts/dpkg-architecture.pl

@@ -122,16 +122,16 @@ sub action_needs($) {
 
 while (@ARGV) {
     $_=shift(@ARGV);
-    if (m/^-a/) {
-	$req_host_arch = "$'";
-    } elsif (m/^-t/) {
-	$req_host_gnu_type = "$'";
-    } elsif (m/^-e/) {
-	$req_eq_arch = "$'";
+    if (m/^-a/p) {
+	$req_host_arch = ${^POSTMATCH};
+    } elsif (m/^-t/p) {
+	$req_host_gnu_type = ${^POSTMATCH};
+    } elsif (m/^-e/p) {
+	$req_eq_arch = ${^POSTMATCH};
 	$req_vars = $arch_vars{DEB_HOST_ARCH};
 	$action = 'e';
-    } elsif (m/^-i/) {
-	$req_is_arch = "$'";
+    } elsif (m/^-i/p) {
+	$req_is_arch = ${^POSTMATCH};
 	$req_vars = $arch_vars{DEB_HOST_ARCH};
 	$action = 'i';
     } elsif (m/^-u$/) {
@@ -142,8 +142,8 @@ while (@ARGV) {
 	$action =~ s/^-//;
     } elsif (m/^-f$/) {
         $force=1;
-    } elsif (m/^-q/) {
-	my $varname = "$'";
+    } elsif (m/^-q/p) {
+	my $varname = ${^POSTMATCH};
 	error(_g('%s is not a supported variable name'), $varname)
 	    unless (exists $arch_vars{$varname});
 	$req_variable_to_print = "$varname";

scripts/dpkg-distaddfile.pl

@@ -55,8 +55,8 @@ Options:
 
 while (@ARGV && $ARGV[0] =~ m/^-/) {
     $_=shift(@ARGV);
-    if (m/^-f/) {
-        $fileslistfile= $';
+    if (m/^-f/p) {
+        $fileslistfile = ${^POSTMATCH};
     } elsif (m/^-(\?|-help)$/) {
         usage();
         exit(0);

scripts/dpkg-gencontrol.pl

@@ -97,18 +97,18 @@ sub usage {
 
 while (@ARGV) {
     $_=shift(@ARGV);
-    if (m/^-p/) {
-        $oppackage = $';
+    if (m/^-p/p) {
+        $oppackage = ${^POSTMATCH};
         my $err = pkg_name_is_illegal($oppackage);
         error(_g("illegal package name '%s': %s"), $oppackage, $err) if $err;
-    } elsif (m/^-c/) {
-        $controlfile= $';
-    } elsif (m/^-l/) {
-        $changelogfile= $';
-    } elsif (m/^-P/) {
-        $packagebuilddir= $';
-    } elsif (m/^-f/) {
-        $fileslistfile= $';
+    } elsif (m/^-c/p) {
+        $controlfile = ${^POSTMATCH};
+    } elsif (m/^-l/p) {
+        $changelogfile = ${^POSTMATCH};
+    } elsif (m/^-P/p) {
+        $packagebuilddir = ${^POSTMATCH};
+    } elsif (m/^-f/p) {
+        $fileslistfile = ${^POSTMATCH};
     } elsif (m/^-v(.+)$/) {
         $forceversion= $1;
     } elsif (m/^-O$/) {
@@ -119,17 +119,17 @@ while (@ARGV) {
 	# ignored for backwards compatibility
     } elsif (m/^-F([0-9a-z]+)$/) {
         $changelogformat=$1;
-    } elsif (m/^-D([^\=:]+)[=:]/) {
-        $override{$1}= $';
+    } elsif (m/^-D([^\=:]+)[=:]/p) {
+        $override{$1} = ${^POSTMATCH};
     } elsif (m/^-U([^\=:]+)$/) {
         $remove{$1}= 1;
-    } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
-        $substvars->set_as_used($1, $');
+    } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/p) {
+        $substvars->set_as_used($1, ${^POSTMATCH});
     } elsif (m/^-T(.*)$/) {
 	$substvars->load($1) if -e $1;
 	$substvars_loaded = 1;
-    } elsif (m/^-n/) {
-        $forcefilename= $';
+    } elsif (m/^-n/p) {
+        $forcefilename = ${^POSTMATCH};
     } elsif (m/^-(\?|-help)$/) {
         usage();
         exit(0);

scripts/dpkg-gensymbols.pl

@@ -93,8 +93,8 @@ sub usage {
 my @files;
 while (@ARGV) {
     $_ = shift(@ARGV);
-    if (m/^-p/) {
-	$oppackage = $';
+    if (m/^-p/p) {
+	$oppackage = ${^POSTMATCH};
 	my $err = pkg_name_is_illegal($oppackage);
 	error(_g("illegal package name '%s': %s"), $oppackage, $err) if $err;
     } elsif (m/^-c(\d)?$/) {

test/critic.t

@@ -107,6 +107,7 @@ my @policies = qw(
     Variables::ProhibitAugmentedAssignmentInDeclaration
     Variables::ProhibitConditionalDeclarations
     Variables::ProhibitLocalVars
+    Variables::ProhibitMatchVars
     Variables::ProhibitPackageVars
     Variables::ProhibitPerl4PackageNames
     Variables::ProhibitUnusedVariables