diff options
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rwxr-xr-x | dselect/methods/disk/setup | 6 | ||||
| -rwxr-xr-x | dselect/methods/multicd/setup | 6 | ||||
| -rwxr-xr-x | dselect/mkcurkeys.pl | 12 | ||||
| -rw-r--r-- | scripts/Dpkg/Changelog/Entry/Debian.pm | 4 | ||||
| -rw-r--r-- | scripts/Dpkg/Package.pm | 4 | ||||
| -rw-r--r-- | scripts/Dpkg/Vendor/Ubuntu.pm | 4 | ||||
| -rwxr-xr-x | scripts/dpkg-architecture.pl | 20 | ||||
| -rwxr-xr-x | scripts/dpkg-distaddfile.pl | 4 | ||||
| -rwxr-xr-x | scripts/dpkg-gencontrol.pl | 32 | ||||
| -rwxr-xr-x | scripts/dpkg-gensymbols.pl | 4 | ||||
| -rw-r--r-- | test/critic.t | 1 |
12 files changed, 50 insertions, 48 deletions
diff --git a/debian/changelog b/debian/changelog index 912f9e294..fe7241cfe 100644 --- a/debian/changelog +++ b/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). diff --git a/dselect/methods/disk/setup b/dselect/methods/disk/setup index cc7e697c5..0ee15bcaa 100755 --- a/dselect/methods/disk/setup +++ b/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; diff --git a/dselect/methods/multicd/setup b/dselect/methods/multicd/setup index 559ca20c0..c84e484f6 100755 --- a/dselect/methods/multicd/setup +++ b/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; diff --git a/dselect/mkcurkeys.pl b/dselect/mkcurkeys.pl index 19a06e321..d433b93b9 100755 --- a/dselect/mkcurkeys.pl +++ b/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 $!; } diff --git a/scripts/Dpkg/Changelog/Entry/Debian.pm b/scripts/Dpkg/Changelog/Entry/Debian.pm index 88b927104..4ad43ebd4 100644 --- a/scripts/Dpkg/Changelog/Entry/Debian.pm +++ b/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; diff --git a/scripts/Dpkg/Package.pm b/scripts/Dpkg/Package.pm index 04fbb00d5..cf5771ee3 100644 --- a/scripts/Dpkg/Package.pm +++ b/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'); diff --git a/scripts/Dpkg/Vendor/Ubuntu.pm b/scripts/Dpkg/Vendor/Ubuntu.pm index 44abf41e2..68ac7c0d4 100644 --- a/scripts/Dpkg/Vendor/Ubuntu.pm +++ b/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; diff --git a/scripts/dpkg-architecture.pl b/scripts/dpkg-architecture.pl index 247fe8252..b59288823 100755 --- a/scripts/dpkg-architecture.pl +++ b/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"; diff --git a/scripts/dpkg-distaddfile.pl b/scripts/dpkg-distaddfile.pl index 5fbb6b091..30ca74b4a 100755 --- a/scripts/dpkg-distaddfile.pl +++ b/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); diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl index 5f92ceba5..af604edda 100755 --- a/scripts/dpkg-gencontrol.pl +++ b/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); diff --git a/scripts/dpkg-gensymbols.pl b/scripts/dpkg-gensymbols.pl index 142596535..99cc8ab4e 100755 --- a/scripts/dpkg-gensymbols.pl +++ b/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)?$/) { diff --git a/test/critic.t b/test/critic.t index 296df2af2..f2ce8eaf5 100644 --- a/test/critic.t +++ b/test/critic.t @@ -107,6 +107,7 @@ my @policies = qw( Variables::ProhibitAugmentedAssignmentInDeclaration Variables::ProhibitConditionalDeclarations Variables::ProhibitLocalVars + Variables::ProhibitMatchVars Variables::ProhibitPackageVars Variables::ProhibitPerl4PackageNames Variables::ProhibitUnusedVariables |