Просмотр исходного кода

Do not use double-quotes on strings that do not need interpolation

Using double-quotes imposes a small performance penalty as the perl
parser needs to check if any interpolation is needed. Use double-quotes
only when the string contains single-quotes. Ideally we'd use
double-quotes too for escaped meta-characters that might otherwise be
confusing to immediately see if they need interpolation or not, but the
policy does not (currently) allow to ignore these.

Fixes ValuesAndExpressions::ProhibitInterpolationOfLiterals.

Warned-by: perlcritic
Guillem Jover лет назад: 13
Родитель
Сommit
6a73e3078b
95 измененных файлов с 1970 добавлено и 1960 удалено
  1. 26 26
      dselect/methods/Dselect/Ftp.pm
  2. 35 33
      dselect/methods/ftp/install
  3. 11 11
      dselect/methods/ftp/setup
  4. 22 22
      dselect/methods/ftp/update
  5. 2 2
      dselect/mkcurkeys.pl
  6. 5 5
      scripts/Dpkg.pm
  7. 10 10
      scripts/Dpkg/Arch.pm
  8. 1 1
      scripts/Dpkg/BuildEnv.pm
  9. 26 26
      scripts/Dpkg/BuildFlags.pm
  10. 5 5
      scripts/Dpkg/BuildOptions.pm
  11. 30 30
      scripts/Dpkg/Changelog.pm
  12. 17 17
      scripts/Dpkg/Changelog/Debian.pm
  13. 6 6
      scripts/Dpkg/Changelog/Entry.pm
  14. 9 9
      scripts/Dpkg/Changelog/Entry/Debian.pm
  15. 18 18
      scripts/Dpkg/Changelog/Parse.pm
  16. 12 12
      scripts/Dpkg/Checksums.pm
  17. 17 17
      scripts/Dpkg/Compression.pm
  18. 34 34
      scripts/Dpkg/Compression/FileHandle.pm
  19. 10 10
      scripts/Dpkg/Compression/Process.pm
  20. 4 4
      scripts/Dpkg/Conf.pm
  21. 9 9
      scripts/Dpkg/Control.pm
  22. 1 1
      scripts/Dpkg/Control/Changelog.pm
  23. 11 11
      scripts/Dpkg/Control/Fields.pm
  24. 16 16
      scripts/Dpkg/Control/Hash.pm
  25. 5 5
      scripts/Dpkg/Control/Info.pm
  26. 27 27
      scripts/Dpkg/Deps.pm
  27. 11 11
      scripts/Dpkg/ErrorHandling.pm
  28. 1 1
      scripts/Dpkg/Exit.pm
  29. 4 4
      scripts/Dpkg/File.pm
  30. 1 1
      scripts/Dpkg/Gettext.pm
  31. 28 28
      scripts/Dpkg/IPC.pm
  32. 7 7
      scripts/Dpkg/Index.pm
  33. 16 16
      scripts/Dpkg/Interface/Storable.pm
  34. 3 3
      scripts/Dpkg/Package.pm
  35. 9 9
      scripts/Dpkg/Path.pm
  36. 4 4
      scripts/Dpkg/Shlibs.pm
  37. 5 5
      scripts/Dpkg/Shlibs/Cppfilt.pm
  38. 30 30
      scripts/Dpkg/Shlibs/Objdump.pm
  39. 19 19
      scripts/Dpkg/Shlibs/Symbol.pm
  40. 12 12
      scripts/Dpkg/Shlibs/SymbolFile.pm
  41. 15 15
      scripts/Dpkg/Source/Archive.pm
  42. 6 6
      scripts/Dpkg/Source/Functions.pm
  43. 38 38
      scripts/Dpkg/Source/Package.pm
  44. 46 46
      scripts/Dpkg/Source/Package/V1.pm
  45. 98 98
      scripts/Dpkg/Source/Package/V2.pm
  46. 19 19
      scripts/Dpkg/Source/Package/V3/bzr.pm
  47. 4 4
      scripts/Dpkg/Source/Package/V3/custom.pm
  48. 39 39
      scripts/Dpkg/Source/Package/V3/git.pm
  49. 7 7
      scripts/Dpkg/Source/Package/V3/native.pm
  50. 24 24
      scripts/Dpkg/Source/Package/V3/quilt.pm
  51. 59 59
      scripts/Dpkg/Source/Patch.pm
  52. 30 30
      scripts/Dpkg/Source/Quilt.pm
  53. 14 13
      scripts/Dpkg/Substvars.pm
  54. 2 2
      scripts/Dpkg/Vars.pm
  55. 8 8
      scripts/Dpkg/Vendor.pm
  56. 25 25
      scripts/Dpkg/Vendor/Debian.pm
  57. 7 7
      scripts/Dpkg/Vendor/Default.pm
  58. 19 18
      scripts/Dpkg/Vendor/Ubuntu.pm
  59. 12 12
      scripts/Dpkg/Version.pm
  60. 4 4
      scripts/Makefile.am
  61. 19 18
      scripts/changelog/debian.pl
  62. 20 20
      scripts/dpkg-architecture.pl
  63. 30 30
      scripts/dpkg-buildflags.pl
  64. 45 45
      scripts/dpkg-buildpackage.pl
  65. 18 18
      scripts/dpkg-checkbuilddeps.pl
  66. 17 17
      scripts/dpkg-distaddfile.pl
  67. 62 62
      scripts/dpkg-genchanges.pl
  68. 49 49
      scripts/dpkg-gencontrol.pl
  69. 22 22
      scripts/dpkg-gensymbols.pl
  70. 20 20
      scripts/dpkg-mergechangelogs.pl
  71. 12 12
      scripts/dpkg-name.pl
  72. 13 13
      scripts/dpkg-parsechangelog.pl
  73. 22 22
      scripts/dpkg-scanpackages.pl
  74. 10 10
      scripts/dpkg-scansources.pl
  75. 61 61
      scripts/dpkg-shlibdeps.pl
  76. 58 58
      scripts/dpkg-source.pl
  77. 13 13
      scripts/dpkg-vendor.pl
  78. 48 48
      scripts/t/100_Dpkg_Version.t
  79. 4 4
      scripts/t/150_Dpkg_Package.t
  80. 2 2
      scripts/t/190_Dpkg_Shlibs_Cppfilt.t
  81. 47 47
      scripts/t/200_Dpkg_Shlibs.t
  82. 24 24
      scripts/t/300_Dpkg_BuildOptions.t
  83. 51 51
      scripts/t/400_Dpkg_Deps.t
  84. 18 18
      scripts/t/500_Dpkg_Path.t
  85. 22 22
      scripts/t/600_Dpkg_Changelog.t
  86. 6 6
      scripts/t/700_Dpkg_Control.t
  87. 21 21
      scripts/t/750_Dpkg_Substvars.t
  88. 8 8
      scripts/t/800_Dpkg_IPC.t
  89. 20 20
      scripts/t/850_Dpkg_Compression.t
  90. 3 3
      scripts/t/910_merge_changelogs.t
  91. 62 62
      src/t/100_dpkg_divert.t
  92. 2 2
      test/000_pod.t
  93. 1 0
      test/100_critic.t
  94. 4 0
      test/100_critic/perlcriticrc
  95. 141 141
      utils/t/100_update_alternatives.t

+ 26 - 26
dselect/methods/Dselect/Ftp.pm

@@ -27,11 +27,11 @@ our %config;
 sub nb {
   my $nb = shift;
   if ($nb > 1024**2) {
-    return sprintf("%.2fM", $nb / 1024**2);
+    return sprintf('%.2fM', $nb / 1024**2);
   } elsif ($nb > 1024) {
-    return sprintf("%.2fk", $nb / 1024);
+    return sprintf('%.2fk', $nb / 1024);
   } else {
-    return sprintf("%.2fb", $nb);
+    return sprintf('%.2fb', $nb);
   }
 
 }
@@ -97,7 +97,7 @@ sub edit_config {
       $i++;
     }
     print "\nEnter a command (a=add e=edit d=delete q=quit m=mirror list) \n";
-    print "eventually followed by a site number : ";
+    print 'eventually followed by a site number : ';
     chomp($_ = <STDIN>);
     /q/i && last;
     /a/i && add_site();
@@ -113,8 +113,8 @@ sub edit_config {
   }
 
   print "\n";
-  $config{use_auth_proxy} = yesno($config{use_auth_proxy} ? "y" : "n",
-                                      "Go through an authenticated proxy");
+  $config{use_auth_proxy} = yesno($config{use_auth_proxy} ? 'y' : 'n',
+                                  'Go through an authenticated proxy');
 
   if ($config{use_auth_proxy}) {
     print "\nEnter proxy hostname [$config{proxyhost}] : ";
@@ -144,16 +144,16 @@ sub edit_config {
 
 sub add_site {
   my $pas = 1;
-  my $user = "anonymous";
+  my $user = 'anonymous';
   my $email = `whoami`;
   chomp $email;
   $email .= '@' . `cat /etc/mailname || dnsdomainname`;
   chomp $email;
-  my $dir = "/debian";
+  my $dir = '/debian';
 
-  push (@{$config{site}}, [ "", $dir, [ "dists/stable/main",
-                                          "dists/stable/contrib",
-					  "dists/stable/non-free" ],
+  push (@{$config{site}}, [ '', $dir, [ 'dists/stable/main',
+                                        'dists/stable/contrib',
+                                        'dists/stable/non-free' ],
                                $pas, $user, $email ]);
   edit_site($config{site}[@{$config{site}} - 1]);
 }
@@ -167,7 +167,7 @@ sub edit_site {
   chomp($_ = <STDIN>);
   $site->[0] = $_ || $site->[0];
 
-  print "\nUse passive mode [" . ($site->[3] ? "y" : "n") ."] : ";
+  print "\nUse passive mode [" . ($site->[3] ? 'y' : 'n') . '] : ';
   chomp($_ = <STDIN>);
   $site->[3] = (/y/i ? 1 : 0) if ($_);
 
@@ -202,9 +202,9 @@ sub yesno($$) {
 
   my ($res, $r);
   $r = -1;
-  $r = 0 if $d eq "n";
-  $r = 1 if $d eq "y";
-  die "Incorrect usage of yesno, stopped" if $r == -1;
+  $r = 0 if $d eq 'n';
+  $r = 1 if $d eq 'y';
+  die 'Incorrect usage of yesno, stopped' if $r == -1;
   while (1) {
     print $msg, " [$d]: ";
     $res = <STDIN>;
@@ -229,7 +229,7 @@ sub do_connect {
 
 	if ($useproxy) {
 	    $remotehost = $proxyhost;
-	    $remoteuser = $username . "@" . $ftpsite;
+	    $remoteuser = $username . '@' . $ftpsite;
 	} else {
 	    $remotehost = $ftpsite;
 	    $remoteuser = $username;
@@ -248,13 +248,13 @@ sub do_connect {
 		$ftp->_PASS($proxypassword);
 	    }
 	    print "Login as $username...\n";
-	    if ($pass eq "?") {
-		    print "Enter password for ftp: ";
-		    system("stty", "-echo");
+	    if ($pass eq '?') {
+		    print 'Enter password for ftp: ';
+		    system('stty', '-echo');
 		    $rpass = <STDIN>;
 		    chomp $rpass;
 		    print "\n";
-		    system("stty", "echo");
+		    system('stty', 'echo');
 	    } else {
 		    $rpass = $pass;
 	    }
@@ -271,17 +271,17 @@ sub do_connect {
 	}
 
 	if ($exit) {
-	    if (yesno ("y", "Retry connection at once")) {
+	    if (yesno ('y', 'Retry connection at once')) {
 		next TRY_CONNECT;
 	    } else {
-		die "error";
+		die 'error';
 	    }
 	}
 
 	last TRY_CONNECT;
     }
 
-#    if(!$ftp->pasv()) { print $ftp->message . "\n"; die "error"; }
+#    if(!$ftp->pasv()) { print $ftp->message . "\n"; die 'error'; }
 
     return $ftp;
 }
@@ -334,7 +334,7 @@ sub do_mdtm {
 
 #	print "[$#files]";
 
-	# get the date components from the output of "ls -l"
+	# get the date components from the output of 'ls -l'
 	if ($files[0] =~
 	    /([^ ]+ *){5}[^ ]+ ([A-Z][a-z]{2}) ([ 0-9][0-9]) ([0-9 ][0-9][:0-9][0-9]{2})/) {
 
@@ -364,13 +364,13 @@ sub do_mdtm {
 		$hours = 0; $minutes = 0;
 		$year = $yearOrTime - 1900;
 	    } else {
-		die "Cannot parse year-or-time";
+		die 'Cannot parse year-or-time';
 	    }
 
 	    # build a system time
 	    $time = timegm (0, $minutes, $hours, $day, $month, $year);
 	} else {
-	    die "Regexp match failed on LIST output";
+	    die 'Regexp match failed on LIST output';
 	}
     }
 

+ 35 - 33
dselect/methods/ftp/install

@@ -42,7 +42,7 @@ my $vardir = $ARGV[0];
 my $method = $ARGV[1];
 my $option = $ARGV[2];
 
-if ($option eq "manual" ) {
+if ($option eq 'manual') {
   print "manual mode not supported yet\n";
   exit 1;
 }
@@ -115,14 +115,14 @@ my %curpkgs;
 sub procstatus {
     my (%flds, $fld);
     open(my $status_fh, '<', "$vardir/status") or
-        die "Could not open status file";
+        die 'Could not open status file';
     while (%flds = getblk($status_fh), %flds) {
 	if($flds{'status'} =~ /^install ok/) {
 	    my $cs = (split(/ /, $flds{'status'}))[2];
-	    if(($cs eq "not-installed") ||
-	       ($cs eq "half-installed") ||
-	       ($cs eq "config-files")) {
-		$curpkgs{$flds{'package'}} = "";
+	    if (($cs eq 'not-installed') ||
+	        ($cs eq 'half-installed') ||
+	        ($cs eq 'config-files')) {
+		$curpkgs{$flds{'package'}} = '';
 	    } else {
 		$curpkgs{$flds{'package'}} = $flds{'version'};
 	    }
@@ -135,7 +135,7 @@ procstatus();
 sub dcmpvers {
     my($a, $p, $b) = @_;
     my ($r);
-    $r = system("dpkg", "--compare-versions", "$a", "$p", "$b");
+    $r = system('dpkg', '--compare-versions', "$a", "$p", "$b");
     $r = $r/256;
     if ($r == 0) {
 	return 1;
@@ -164,7 +164,7 @@ sub procpkgfile {
 	@files = split(/[\s\n]+/, $flds{'filename'});
 	@sizes = split(/[\s\n]+/, $flds{'size'});
 	@md5sums = split(/[\s\n]+/, $flds{'md5sum'});
-	if ( defined($ver) && ( ($ver eq "") || dcmpvers( $ver, "lt", $flds{'version'} ) )) {
+	if (defined($ver) && (($ver eq '') || dcmpvers($ver, 'lt', $flds{'version'}))) {
 	    $pkgs{$pkg} = [ $flds{'version'}, [ @files ], $site ];
 	    $curpkgs{$pkg} = $flds{'version'};
 	}
@@ -207,7 +207,7 @@ my $dldir = $config{dldir};
 sub md5sum($) {
     my $fn = shift;
     my $m = `md5sum $fn`;
-    $m = (split(" ", $m))[0];
+    $m = (split(' ', $m))[0];
     $md5sums{"$dldir/$fn"} = $m;
     return $m;
 }
@@ -236,8 +236,8 @@ foreach $pkg (keys(%pkgs)) {
 	    $size = -s "$dldir/$fn";
 	    if($info[1] > $size) {
 		# partial download
-		if(yesno("y", "continue file: $fn (" . nb($size) ."/" .
-		              nb($info[1]). ")")) {
+		if (yesno('y', "continue file: $fn (" . nb($size) . '/' .
+		               nb($info[1]) . ')')) {
 		    $downloads{$fn} = $size;
 		    $totsize += $csize - int($size/1024);
 		} else {
@@ -259,7 +259,7 @@ foreach $pkg (keys(%pkgs)) {
 	} else {
 	    my $ffn = $fn;
 	    $ffn =~ s/binary-[^\/]+/.../;
-	    print "want: " .
+	    print 'want: ' .
 	          $config{site}[$pkgfiles{$fn}[2]][0] . " $ffn (${csize}k)\n";
 	    $downloads{$fn} = 0;
 	    $totsize += $csize;
@@ -277,18 +277,19 @@ print "Available space in $dldir: ${avsp}k\n";
 #chomp $avsp;
 
 if($totsize == 0) {
-    print "Nothing to get.";
+    print 'Nothing to get.';
 } else {
     if($totsize > $avsp) {
 	print "Space required is greater than available space,\n";
 	print "you will need to select which items to get.\n";
     }
 # ask user which files to get
-    if(($totsize > $avsp) || yesno("n", "Do you want to select the files to get")) {
+    if (($totsize > $avsp) ||
+        yesno('n', 'Do you want to select the files to get')) {
 	$totsize = 0;
 	my @files = sort(keys(%downloads));
 	my $fn;
-	my $def = "y";
+	my $def = 'y';
 	foreach $fn (@files) {
 	    my @info = @{$pkgfiles{$fn}};
 	    my $csize = int($info[1] / 1024) + 1;
@@ -300,10 +301,10 @@ if($totsize == 0) {
 		if(yesno($def, $downloads{$fn}
 			 ? "download: $fn ${rsize}k/${csize}k (total = ${totsize}k)"
 			 : "download: $fn ${rsize}k (total = ${totsize}k)")) {
-		    $def = "y";
+		    $def = 'y';
 		    $totsize += $rsize;
 		} else {
-		    $def = "n";
+		    $def = 'n';
 		    delete $downloads{$fn};
 		}
 	    }
@@ -326,7 +327,7 @@ sub download() {
     $cp = -1;
     foreach (@{$site->[2]}) {
       $cp++;
-      $pre_dist[$cp] = "";
+      $pre_dist[$cp] = '';
       $n = (s#\.\./#../#g);
       next if (! $n);
       if (m#^((?:\.\./){$n}(?:[^/]+/){$n})#) {
@@ -351,10 +352,10 @@ sub download() {
 
     my ($fn,$rsize,$res,$pre);
     foreach $fn (@getfiles) {
-        $pre = $pre_dist[$pkgfiles{$fn}[3]] || "";
+        $pre = $pre_dist[$pkgfiles{$fn}[3]] || '';
 	if ($downloads{$fn}) {
 	    $rsize = ${pkgfiles{$fn}}[1] - $downloads{$fn};
-	    print "getting: $pre$fn (". nb($rsize) . "/" .
+	    print "getting: $pre$fn (" . nb($rsize) . '/' .
 	          nb($pkgfiles{$fn}[1]) . ")\n";
 	} else {
 	    print "getting: $pre$fn (". nb($pkgfiles{$fn}[1]) . ")\n";
@@ -399,11 +400,12 @@ sub download() {
 
 # download stuff (protect from ^C)
 if($totsize != 0) {
-    if(yesno("y", "\nDo you want to download the required files")) {
+    if (yesno('y', "\nDo you want to download the required files")) {
       DOWNLOAD_TRY: while (1) {
 	  print "Downloading files... use ^C to stop\n";
 	  eval {
-	      if ((download() == 1) && yesno("y", "\nDo you want to retry downloading at once")) {
+	      if ((download() == 1) &&
+	          yesno('y', "\nDo you want to retry downloading at once")) {
 		  next DOWNLOAD_TRY;
 	      }
 	  };
@@ -415,7 +417,7 @@ if($totsize != 0) {
 	        undef $::ftp;
 	      }
 	      print "FTP ERROR\n";
-              if (yesno("y", "\nDo you want to retry downloading at once")) {
+              if (yesno('y', "\nDo you want to retry downloading at once")) {
 		  # get the first $fn that foreach would give:
 		  # this is the one that got interrupted.
 		my $ffn;
@@ -425,7 +427,7 @@ if($totsize != 0) {
 		}
 	        my $size = -s "$dldir/$fn";
 		# partial download
-		if(yesno("y", "continue file: $fn (at $size)")) {
+		if (yesno('y', "continue file: $fn (at $size)")) {
 		    $downloads{$fn} = $size;
 		} else {
 		    $downloads{$fn} = 0;
@@ -497,9 +499,9 @@ sub prcdeb($$) {
 	return 0;
     }
     if($vers{$pkg}) {
-	if(dcmpvers($vers{$pkg}, "eq", $ver)) {
+	if (dcmpvers($vers{$pkg}, 'eq', $ver)) {
 	    $files{$pkg . $ver} = [ $files{$pkg . $ver }, "$dir/$fn" ];
-	} elsif (dcmpvers($vers{$pkg}, "gt", $ver)) {
+	} elsif (dcmpvers($vers{$pkg}, 'gt', $ver)) {
 	    print "old version\n";
 	    unlink $fn;
 	} else { # else $ver is gt current version
@@ -520,7 +522,7 @@ sub prcdeb($$) {
 sub prcfile() {
     my ($fn) = $_;
     if (-f $fn and $fn ne '.') {
-        my $dir = ".";
+        my $dir = '.';
 	if (length($File::Find::dir) > length($dldir)) {
             $dir = substr($File::Find::dir, length($dldir)+1);
 	}
@@ -558,7 +560,7 @@ sub prcfile() {
 find(\&prcfile, "$dldir/");
 
 # install .debs
-if(yesno("y", "\nDo you want to install the files fetched")) {
+if (yesno('y', "\nDo you want to install the files fetched")) {
     print "Installing files...\n";
     #Installing pre-dependent package before !
     my (@flds, $package, @filename, $r);
@@ -574,7 +576,7 @@ if(yesno("y", "\nDo you want to install the files fetched")) {
       if ($r) { print "DPKG ERROR\n"; $exit = 1; }
     }
     #Installing other packages after
-    $r = system("dpkg", "-iGREOB", $dldir);
+    $r = system('dpkg', '-iGREOB', $dldir);
     if($r) {
 	print "DPKG ERROR\n";
 	$exit = 1;
@@ -584,7 +586,7 @@ if(yesno("y", "\nDo you want to install the files fetched")) {
 sub removeinstalled {
     my $fn = $_;
     if (-f $fn and $fn ne '.') {
-        my $dir = ".";
+        my $dir = '.';
 	if (length($File::Find::dir) > length($dldir)) {
             $dir = substr($File::Find::dir, length($dldir)+1);
 	}
@@ -593,7 +595,7 @@ sub removeinstalled {
 	    if(!defined($pkg) || !defined($ver)) {
 		print "Could not get info for: $dir/$fn\n";
 	    } else {
-		if($curpkgs{$pkg} and dcmpvers($ver, "le", $curpkgs{$pkg})) {
+		if ($curpkgs{$pkg} and dcmpvers($ver, 'le', $curpkgs{$pkg})) {
 		    print "deleting: $dir/$fn\n";
 		    unlink $fn;
 		} else {
@@ -608,7 +610,7 @@ sub removeinstalled {
 
 # remove .debs that have been installed (query user)
 # first need to reprocess status file
-if(yesno("y", "\nDo you wish to delete the installed package (.deb) files?")) {
+if (yesno('y', "\nDo you wish to delete the installed package (.deb) files?")) {
     print "Removing installed files...\n";
     %curpkgs = ();
     procstatus();
@@ -616,7 +618,7 @@ if(yesno("y", "\nDo you wish to delete the installed package (.deb) files?")) {
 }
 
 # remove whole ./debian directory if user wants to
-if(yesno("n", "\nDo you want to remove $dldir directory?")) {
+if (yesno('n', "\nDo you want to remove $dldir directory?")) {
     rmtree("$dldir");
 }
 

+ 11 - 11
dselect/methods/ftp/setup

@@ -32,7 +32,7 @@ my $vardir = $ARGV[0];
 my $method = $ARGV[1];
 my $option = $ARGV[2];
 
-if ($option eq "manual") {
+if ($option eq 'manual') {
     print "Manual package installation.\n";
     exit 0;
 }
@@ -48,11 +48,11 @@ chomp $logname;
 my $host = `cat /etc/mailname || dnsdomainname`;
 chomp $host;
 
-$config{dldir} = "debian";
+$config{dldir} = 'debian';
 $config{use_auth_proxy} = 0;
-$config{proxyhost} = "";
+$config{proxyhost} = '';
 $config{proxylogname} = $logname;
-$config{proxypassword} = "";
+$config{proxypassword} = '';
 
 my $methdir = "$vardir/methods/ftp";
 my $exit = 0;
@@ -63,8 +63,8 @@ if (-f "$methdir/vars") {
 }
 
 chdir "$methdir";
-if (! -d "debian") {
-    mkdir "debian", 0755;
+if (! -d 'debian') {
+    mkdir 'debian', 0755;
 }
 # get info from user
 
@@ -102,7 +102,7 @@ Eg:  use auth proxy: y
 EOM
 
 if (! $config{done}) {
-  view_mirrors() if (yesno("y", "Would you like to see a list of ftp mirrors"));
+  view_mirrors() if (yesno('y', 'Would you like to see a list of ftp mirrors'));
   add_site();
 }
 edit_config($methdir);
@@ -127,10 +127,10 @@ sub download() {
     foreach $dist (@dists) {
 	my $dir = "$dist/binary-$arch";
 	print "Checking $dir...\n";
-#	if(!$ftp->pasv()) { print $ftp->message . "\n"; die "error"; }
+#	if (!$ftp->pasv()) { print $ftp->message . "\n"; die 'error'; }
 	my @dirlst = $ftp->ls("$dir/");
 	my $got_pkgfile = 0;
-	my $line = "";
+	my $line = '';
 	foreach $line (@dirlst) {
 	    if($line =~ /Packages/) {
 		$got_pkgfile=1;
@@ -157,8 +157,8 @@ eval {
 };
 if($@) {
     $ftp->quit();
-    print "FTP ERROR - ";
-    if ($@ eq "connect") {
+    print 'FTP ERROR - ';
+    if ($@ eq 'connect') {
 	print "config was untested\n";
     } else {
 	print "$@\n";

+ 22 - 22
dselect/methods/ftp/update

@@ -33,17 +33,17 @@ my $vardir = $ARGV[0];
 my $method = $ARGV[1];
 my $option = $ARGV[2];
 
-if ($option eq "manual") {
+if ($option eq 'manual') {
     print "Enter package file names or a blank line to finish\n";
     while(1) {
-	print "Enter package file name:";
+	print 'Enter package file name:';
 	my $fn = <STDIN>;
 	chomp $fn;
-	if ( $fn == "") {
+	if ($fn == '') {
 	    exit 0;
 	}
 	if ( -f $fn ) {
-	    system ("dpkg", "--merge-avail", $fn);
+	    system('dpkg', '--merge-avail', $fn);
 	} else {
 	    print "Could not find $fn, try again\n";
 	}
@@ -134,36 +134,36 @@ foreach (@{$config{site}}) {
 	}
 
 	if ($must_get) {
-	    -f "Packages.gz" and unlink "Packages.gz";
-	    -f "Packages" and unlink "Packages";
+	    -f 'Packages.gz' and unlink 'Packages.gz';
+	    -f 'Packages' and unlink 'Packages';
 	    my $size = 0;
 
 	  TRY_GET_PACKAGES:
 	    while (1) {
 		if ($size) {
-		    print " Continuing ";
+		    print ' Continuing ';
 		} else {
-		    print " Getting ";
+		    print ' Getting ';
 		}
 		print "Packages file from $dir...\n";
 		eval {
-		    if ($ftp->get("$dir/Packages.gz", "Packages.gz", $size)) {
-			if (system("gunzip", "Packages.gz")) {
+		    if ($ftp->get("$dir/Packages.gz", 'Packages.gz', $size)) {
+			if (system('gunzip', 'Packages.gz')) {
 			    print "  Couldn't gunzip Packages.gz, stopped";
-			    die "error";
+			    die 'error';
 			}
 		    } else {
 			print "  Couldn't get Packages.gz from $dir !!! Stopped.";
-			die "error";
+			die 'error';
 		    }
 		};
 		if ($@) {
-		    $size = -s "Packages.gz";
+		    $size = -s 'Packages.gz';
 		    if (ref($ftp)) {
 		      $ftp->abort();
 		      $ftp->quit();
 		    };
-		    if (yesno ("y", "Transfer failed at $size: retry at once")) {
+		    if (yesno ('y', "Transfer failed at $size: retry at once")) {
                          $ftp = do_connect ($site->[0], # Ftp server
                            $site->[4], # username
                            $site->[5], # password
@@ -180,15 +180,15 @@ foreach (@{$config{site}}) {
 			}
 			next TRY_GET_PACKAGES;
 		    } else {
-			die "error";
+			die 'error';
 		    }
 		}
 		last TRY_GET_PACKAGES;
 	    }
 
-	    if(!rename "Packages", "Packages.$site->[0].$dist") {
+	    if (!rename 'Packages', "Packages.$site->[0].$dist") {
 		print "  Couldn't rename Packages to Packages.$site->[0].$dist";
-		die "error";
+		die 'error';
 	    } else {
 		# set local Packages file to same date as the one it mirrors
 		# to allow comparison to work.
@@ -228,11 +228,11 @@ However if you have only downloaded a Package files from non-main
 distributions you might not want to do this.
 
 EOM
-    if (yesno ("y", "Do you want to clear available list")) {
+    if (yesno ('y', 'Do you want to clear available list')) {
 	print "Clearing...\n";
-	if(system("dpkg", "--clear-avail")) {
-	    print "dpkg --clear-avail failed.";
-	    die "error";
+	if (system('dpkg', '--clear-avail')) {
+	    print 'dpkg --clear-avail failed.';
+	    die 'error';
 	}
     }
 }
@@ -243,7 +243,7 @@ if (!$packages_modified) {
     my $file;
 
     foreach $file (@pkgfiles) {
-	if(system ("dpkg", "--merge-avail", $file)) {
+	if (system('dpkg', '--merge-avail', $file)) {
 	    print "Dpkg merge available failed on $file";
 	    $exit = 1;
 	}

+ 2 - 2
dselect/mkcurkeys.pl

@@ -23,7 +23,7 @@ use warnings;
 
 use Scalar::Util qw(looks_like_number);
 
-$#ARGV == 1 || die ("usage: mkcurkeys.pl <filename> <curses.h>");
+$#ARGV == 1 || die('usage: mkcurkeys.pl <filename> <curses.h>');
 
 my (%over, %base, %name);
 
@@ -80,7 +80,7 @@ my ($comma);
 
 for (my $i = 33; $i <= 126; $i++) {
     $k= $i;
-    $v= pack("C",$i);
+    $v = pack('C', $i);
     if ($v eq ',') { $comma=$k; next; }
     p();
 }

+ 5 - 5
scripts/Dpkg.pm

@@ -16,7 +16,7 @@ package Dpkg;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use base qw(Exporter);
 our @EXPORT = qw($version $progname $admindir $dpkglibdir $pkgdatadir);
@@ -24,10 +24,10 @@ our @EXPORT = qw($version $progname $admindir $dpkglibdir $pkgdatadir);
 our ($progname) = $0 =~ m#(?:.*/)?([^/]*)#;
 
 # The following lines are automatically fixed at install time
-our $version = "1.17.x";
-our $admindir = "/var/lib/dpkg";
-our $dpkglibdir = ".";
-our $pkgdatadir = "..";
+our $version = '1.17.x';
+our $admindir = '/var/lib/dpkg';
+our $dpkglibdir = '.';
+our $pkgdatadir = '..';
 $pkgdatadir = $ENV{DPKG_DATADIR} if defined $ENV{DPKG_DATADIR};
 
 1;

+ 10 - 10
scripts/Dpkg/Arch.pm

@@ -18,7 +18,7 @@ package Dpkg::Arch;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use base qw(Exporter);
 our @EXPORT_OK = qw(get_raw_build_arch get_raw_host_arch
@@ -60,7 +60,7 @@ my %debarch_to_debtriplet;
 	# variables when they are not requested.
 
 	my $build_arch = `dpkg --print-architecture`;
-	syserr("dpkg --print-architecture failed") if $? >> 8;
+	syserr('dpkg --print-architecture failed') if $? >> 8;
 
 	chomp $build_arch;
 	return $build_arch;
@@ -93,7 +93,7 @@ my %debarch_to_debtriplet;
 
 	if ($gcc_host_gnu_type eq '') {
 	    warning(_g("Couldn't determine gcc system type, falling back to " .
-	               "default (native compilation)"));
+	               'default (native compilation)'));
 	} else {
 	    my (@host_archtriplet) = gnutriplet_to_debtriplet($gcc_host_gnu_type);
 	    $host_arch = debtriplet_to_debarch(@host_archtriplet);
@@ -101,8 +101,8 @@ my %debarch_to_debtriplet;
 	    if (defined $host_arch) {
 		$gcc_host_gnu_type = debtriplet_to_gnutriplet(@host_archtriplet);
 	    } else {
-		warning(_g("Unknown gcc system type %s, falling back to " .
-		           "default (native compilation)"), $gcc_host_gnu_type);
+		warning(_g('Unknown gcc system type %s, falling back to ' .
+		           'default (native compilation)'), $gcc_host_gnu_type);
 		$gcc_host_gnu_type = '';
 	    }
 	}
@@ -147,7 +147,7 @@ sub read_cputable
     local $/ = "\n";
 
     open my $cputable_fh, '<', "$pkgdatadir/cputable"
-	or syserr(_g("cannot open %s"), "cputable");
+	or syserr(_g('cannot open %s'), 'cputable');
     while (<$cputable_fh>) {
 	if (m/^(?!\#)(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/) {
 	    $cputable{$1} = $2;
@@ -171,7 +171,7 @@ sub read_ostable
     local $/ = "\n";
 
     open my $ostable_fh, '<', "$pkgdatadir/ostable"
-	or syserr(_g("cannot open %s"), "ostable");
+	or syserr(_g('cannot open %s'), 'ostable');
     while (<$ostable_fh>) {
 	if (m/^(?!\#)(\S+)\s+(\S+)\s+(\S+)/) {
 	    $ostable{$1} = $2;
@@ -204,7 +204,7 @@ sub abitable_load()
         }
         close $abitable_fh;
     } elsif ($! != ENOENT) {
-        syserr(_g("cannot open %s"), "abitable");
+        syserr(_g('cannot open %s'), 'abitable');
     }
 
     $abitable_loaded = 1;
@@ -221,7 +221,7 @@ sub read_triplettable()
     local $/ = "\n";
 
     open my $triplettable_fh, '<', "$pkgdatadir/triplettable"
-	or syserr(_g("cannot open %s"), "triplettable");
+	or syserr(_g('cannot open %s'), 'triplettable');
     while (<$triplettable_fh>) {
 	if (m/^(?!\#)(\S+)\s+(\S+)/) {
 	    my $debtriplet = $1;
@@ -255,7 +255,7 @@ sub debtriplet_to_gnutriplet(@)
 
     return unless defined($abi) && defined($os) && defined($cpu) &&
         exists($cputable{$cpu}) && exists($ostable{"$abi-$os"});
-    return join("-", $cputable{$cpu}, $ostable{"$abi-$os"});
+    return join('-', $cputable{$cpu}, $ostable{"$abi-$os"});
 }
 
 sub gnutriplet_to_debtriplet($)

+ 1 - 1
scripts/Dpkg/BuildEnv.pm

@@ -18,7 +18,7 @@ package Dpkg::BuildEnv;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 my %env_modified = ();
 my %env_accessed = ();

+ 26 - 26
scripts/Dpkg/BuildFlags.pm

@@ -18,7 +18,7 @@ package Dpkg::BuildFlags;
 use strict;
 use warnings;
 
-our $VERSION = "1.03";
+our $VERSION = '1.03';
 
 use Dpkg::Gettext;
 use Dpkg::BuildEnv;
@@ -72,7 +72,7 @@ sub load_vendor_defaults {
     $self->{features} = {};
     my $build_opts = Dpkg::BuildOptions->new();
     $self->{build_options} = $build_opts;
-    my $default_flags = $build_opts->has("noopt") ? "-g -O0" : "-g -O2";
+    my $default_flags = $build_opts->has('noopt') ? '-g -O0' : '-g -O2';
     $self->{flags} = {
 	CPPFLAGS => '',
 	CFLAGS   => $default_flags,
@@ -95,7 +95,7 @@ sub load_vendor_defaults {
 	LDFLAGS  => 0,
     };
     # The Debian vendor hook will add hardening build flags
-    run_vendor_hook("update-buildflags", $self);
+    run_vendor_hook('update-buildflags', $self);
 }
 
 =item $bf->load_system_config()
@@ -106,7 +106,7 @@ Update flags from the system configuration.
 
 sub load_system_config {
     my ($self) = @_;
-    $self->update_from_conffile("/etc/dpkg/buildflags.conf", "system");
+    $self->update_from_conffile('/etc/dpkg/buildflags.conf', 'system');
 }
 
 =item $bf->load_user_config()
@@ -118,9 +118,9 @@ Update flags from the user configuration.
 sub load_user_config {
     my ($self) = @_;
     my $confdir = $ENV{XDG_CONFIG_HOME};
-    $confdir ||= $ENV{HOME} . "/.config" if defined $ENV{HOME};
+    $confdir ||= $ENV{HOME} . '/.config' if defined $ENV{HOME};
     if (defined $confdir) {
-        $self->update_from_conffile("$confdir/dpkg/buildflags.conf", "user");
+        $self->update_from_conffile("$confdir/dpkg/buildflags.conf", 'user');
     }
 }
 
@@ -134,21 +134,21 @@ dpkg-buildflags(1) for details.
 sub load_environment_config {
     my ($self) = @_;
     foreach my $flag (keys %{$self->{flags}}) {
-	my $envvar = "DEB_" . $flag . "_SET";
+	my $envvar = 'DEB_' . $flag . '_SET';
 	if (Dpkg::BuildEnv::has($envvar)) {
-	    $self->set($flag, Dpkg::BuildEnv::get($envvar), "env");
+	    $self->set($flag, Dpkg::BuildEnv::get($envvar), 'env');
 	}
-	$envvar = "DEB_" . $flag . "_STRIP";
+	$envvar = 'DEB_' . $flag . '_STRIP';
 	if (Dpkg::BuildEnv::has($envvar)) {
-	    $self->strip($flag, Dpkg::BuildEnv::get($envvar), "env");
+	    $self->strip($flag, Dpkg::BuildEnv::get($envvar), 'env');
 	}
-	$envvar = "DEB_" . $flag . "_APPEND";
+	$envvar = 'DEB_' . $flag . '_APPEND';
 	if (Dpkg::BuildEnv::has($envvar)) {
-	    $self->append($flag, Dpkg::BuildEnv::get($envvar), "env");
+	    $self->append($flag, Dpkg::BuildEnv::get($envvar), 'env');
 	}
-	$envvar = "DEB_" . $flag . "_PREPEND";
+	$envvar = 'DEB_' . $flag . '_PREPEND';
 	if (Dpkg::BuildEnv::has($envvar)) {
-	    $self->prepend($flag, Dpkg::BuildEnv::get($envvar), "env");
+	    $self->prepend($flag, Dpkg::BuildEnv::get($envvar), 'env');
 	}
     }
 }
@@ -163,19 +163,19 @@ dpkg-buildflags(1) for details.
 sub load_maintainer_config {
     my ($self) = @_;
     foreach my $flag (keys %{$self->{flags}}) {
-	my $envvar = "DEB_" . $flag . "_MAINT_SET";
+	my $envvar = 'DEB_' . $flag . '_MAINT_SET';
 	if (Dpkg::BuildEnv::has($envvar)) {
 	    $self->set($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
 	}
-	$envvar = "DEB_" . $flag . "_MAINT_STRIP";
+	$envvar = 'DEB_' . $flag . '_MAINT_STRIP';
 	if (Dpkg::BuildEnv::has($envvar)) {
 	    $self->strip($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
 	}
-	$envvar = "DEB_" . $flag . "_MAINT_APPEND";
+	$envvar = 'DEB_' . $flag . '_MAINT_APPEND';
 	if (Dpkg::BuildEnv::has($envvar)) {
 	    $self->append($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
 	}
-	$envvar = "DEB_" . $flag . "_MAINT_PREPEND";
+	$envvar = 'DEB_' . $flag . '_MAINT_PREPEND';
 	if (Dpkg::BuildEnv::has($envvar)) {
 	    $self->prepend($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
 	}
@@ -298,7 +298,7 @@ $source is the origin recorded for any build flag set or modified.
 sub update_from_conffile {
     my ($self, $file, $src) = @_;
     return unless -e $file;
-    open(my $conf_fh, "<", $file) or syserr(_g("cannot read %s"), $file);
+    open(my $conf_fh, '<', $file) or syserr(_g('cannot read %s'), $file);
     while (<$conf_fh>) {
         chomp;
         next if /^\s*#/; # Skip comments
@@ -306,20 +306,20 @@ sub update_from_conffile {
         if (/^(append|prepend|set|strip)\s+(\S+)\s+(\S.*\S)\s*$/i) {
             my ($op, $flag, $value) = ($1, $2, $3);
             unless (exists $self->{flags}->{$flag}) {
-                warning(_g("line %d of %s mentions unknown flag %s"), $., $file, $flag);
-                $self->{flags}->{$flag} = "";
+                warning(_g('line %d of %s mentions unknown flag %s'), $., $file, $flag);
+                $self->{flags}->{$flag} = '';
             }
-            if (lc($op) eq "set") {
+            if (lc($op) eq 'set') {
                 $self->set($flag, $value, $src);
-            } elsif (lc($op) eq "strip") {
+            } elsif (lc($op) eq 'strip') {
                 $self->strip($flag, $value, $src);
-            } elsif (lc($op) eq "append") {
+            } elsif (lc($op) eq 'append') {
                 $self->append($flag, $value, $src);
-            } elsif (lc($op) eq "prepend") {
+            } elsif (lc($op) eq 'prepend') {
                 $self->prepend($flag, $value, $src);
             }
         } else {
-            warning(_g("line %d of %s is invalid, it has been ignored"), $., $file);
+            warning(_g('line %d of %s is invalid, it has been ignored'), $., $file);
         }
     }
     close($conf_fh);

+ 5 - 5
scripts/Dpkg/BuildOptions.pm

@@ -19,7 +19,7 @@ package Dpkg::BuildOptions;
 use strict;
 use warnings;
 
-our $VERSION = "1.01";
+our $VERSION = '1.01';
 
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
@@ -56,7 +56,7 @@ sub new {
     my $self = {
         options => {},
 	source => {},
-	envvar => $opts{envvar} // "DEB_BUILD_OPTIONS",
+	envvar => $opts{envvar} // 'DEB_BUILD_OPTIONS',
     };
     bless $self, $class;
     $self->merge(Dpkg::BuildEnv::get($self->{envvar}), $self->{envvar});
@@ -92,7 +92,7 @@ sub merge {
     my $count = 0;
     foreach (split(/\s+/, $content)) {
 	unless (/^([a-z][a-z0-9_-]*)(?:=(\S*))?$/) {
-            warning(_g("invalid flag in %s: %s"), $source, $_);
+            warning(_g('invalid flag in %s: %s'), $source, $_);
             next;
         }
 	$count += $self->set($1, $2, $source);
@@ -120,7 +120,7 @@ sub set {
     if ($key =~ /^(noopt|nostrip|nocheck)$/ && defined($value)) {
 	$value = undef;
     } elsif ($key eq 'parallel')  {
-	$value //= "";
+	$value //= '';
 	return 0 if $value !~ /^\d*$/;
     }
 
@@ -165,7 +165,7 @@ the given filehandle.
 sub output {
     my ($self, $fh) = @_;
     my $o = $self->{options};
-    my $res = join(" ", map { defined($o->{$_}) ? $_ . "=" . $o->{$_} : $_ } sort keys %$o);
+    my $res = join(' ', map { defined($o->{$_}) ? $_ . '=' . $o->{$_} : $_ } sort keys %$o);
     print $fh $res if defined $fh;
     return $res;
 }

+ 30 - 30
scripts/Dpkg/Changelog.pm

@@ -36,7 +36,7 @@ package Dpkg::Changelog;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg;
 use Dpkg::Gettext;
@@ -165,12 +165,12 @@ sub get_parse_errors {
     if (wantarray) {
 	return @{$self->{parse_errors}};
     } else {
-	my $res = "";
+	my $res = '';
 	foreach my $e (@{$self->{parse_errors}}) {
 	    if ($e->[3]) {
 		$res .= report(_g('warning'),_g("%s(l%s): %s\nLINE: %s"), @$e );
 	    } else {
-		$res .= report(_g('warning'),_g("%s(l%s): %s"), @$e );
+		$res .= report(_g('warning'), _g('%s(l%s): %s'), @$e);
 	    }
 	}
 	return $res;
@@ -228,7 +228,7 @@ sub __sanity_check_range {
 	 defined($r->{to}) || defined($r->{until})))
     {
 	warning(_g("you can't combine 'count' or 'offset' with any other " .
-		   "range option")) if $self->{verbose};
+		   'range option')) if $self->{verbose};
 	delete $r->{from};
 	delete $r->{since};
 	delete $r->{to};
@@ -252,8 +252,8 @@ sub __sanity_check_range {
         push @versions, $entry->get_version()->as_string();
     }
     if ((defined($r->{since}) and not exists $versions{$r->{since}})) {
-        warning(_g("'%s' option specifies non-existing version"), "since");
-        warning(_g("use newest entry that is earlier than the one specified"));
+        warning(_g("'%s' option specifies non-existing version"), 'since');
+        warning(_g('use newest entry that is earlier than the one specified'));
         foreach my $v (@versions) {
             if (version_compare_relation($v, REL_LT, $r->{since})) {
                 $r->{since} = $v;
@@ -262,14 +262,14 @@ sub __sanity_check_range {
         }
         if (not exists $versions{$r->{since}}) {
             # No version was earlier, include all
-            warning(_g("none found, starting from the oldest entry"));
+            warning(_g('none found, starting from the oldest entry'));
             delete $r->{since};
             $r->{from} = $versions[-1];
         }
     }
     if ((defined($r->{from}) and not exists $versions{$r->{from}})) {
-        warning(_g("'%s' option specifies non-existing version"), "from");
-        warning(_g("use oldest entry that is later than the one specified"));
+        warning(_g("'%s' option specifies non-existing version"), 'from');
+        warning(_g('use oldest entry that is later than the one specified'));
         my $oldest;
         foreach my $v (@versions) {
             if (version_compare_relation($v, REL_GT, $r->{from})) {
@@ -279,13 +279,13 @@ sub __sanity_check_range {
         if (defined($oldest)) {
             $r->{from} = $oldest;
         } else {
-            warning(_g("no such entry found, ignoring '%s' parameter"), "from");
+            warning(_g("no such entry found, ignoring '%s' parameter"), 'from');
             delete $r->{from}; # No version was oldest
         }
     }
     if (defined($r->{until}) and not exists $versions{$r->{until}}) {
-        warning(_g("'%s' option specifies non-existing version"), "until");
-        warning(_g("use oldest entry that is later than the one specified"));
+        warning(_g("'%s' option specifies non-existing version"), 'until');
+        warning(_g('use oldest entry that is later than the one specified'));
         my $oldest;
         foreach my $v (@versions) {
             if (version_compare_relation($v, REL_GT, $r->{until})) {
@@ -295,13 +295,13 @@ sub __sanity_check_range {
         if (defined($oldest)) {
             $r->{until} = $oldest;
         } else {
-            warning(_g("no such entry found, ignoring '%s' parameter"), "until");
+            warning(_g("no such entry found, ignoring '%s' parameter"), 'until');
             delete $r->{until}; # No version was oldest
         }
     }
     if (defined($r->{to}) and not exists $versions{$r->{to}}) {
-        warning(_g("'%s' option specifies non-existing version"), "to");
-        warning(_g("use newest entry that is earlier than the one specified"));
+        warning(_g("'%s' option specifies non-existing version"), 'to');
+        warning(_g('use newest entry that is earlier than the one specified'));
         foreach my $v (@versions) {
             if (version_compare_relation($v, REL_LT, $r->{to})) {
                 $r->{to} = $v;
@@ -310,7 +310,7 @@ sub __sanity_check_range {
         }
         if (not exists $versions{$r->{to}}) {
             # No version was earlier
-            warning(_g("no such entry found, ignoring '%s' parameter"), "to");
+            warning(_g("no such entry found, ignoring '%s' parameter"), 'to');
             delete $r->{to};
         }
     }
@@ -451,7 +451,7 @@ Output the changelog to the given filehandle.
 
 sub output {
     my ($self, $fh) = @_;
-    my $str = "";
+    my $str = '';
     foreach my $entry (@{$self}) {
 	my $text = $entry->output();
 	print $fh $text if defined $fh;
@@ -525,10 +525,10 @@ sub dpkg {
     my $entry = shift @data;
 
     my $f = Dpkg::Control::Changelog->new();
-    $f->{Urgency} = $entry->get_urgency() || "unknown";
-    $f->{Source} = $entry->get_source() || "unknown";
-    $f->{Version} = $entry->get_version() // "unknown";
-    $f->{Distribution} = join(" ", $entry->get_distributions());
+    $f->{Urgency} = $entry->get_urgency() || 'unknown';
+    $f->{Source} = $entry->get_source() || 'unknown';
+    $f->{Version} = $entry->get_version() // 'unknown';
+    $f->{Distribution} = join(' ', $entry->get_distributions());
     $f->{Maintainer} = $entry->get_maintainer() || '';
     $f->{Date} = $entry->get_timestamp() || '';
     $f->{Changes} = $entry->get_dpkg_changes();
@@ -565,9 +565,9 @@ sub dpkg {
     }
 
     if (scalar keys %closes) {
-	$f->{Closes} = join " ", sort { $a <=> $b } keys %closes;
+	$f->{Closes} = join ' ', sort { $a <=> $b } keys %closes;
     }
-    run_vendor_hook("post-process-changelog-entry", $f);
+    run_vendor_hook('post-process-changelog-entry', $f);
 
     return $f;
 }
@@ -590,12 +590,12 @@ sub rfc822 {
 
     foreach my $entry (@data) {
 	my $f = Dpkg::Control::Changelog->new();
-	$f->{Urgency} = $entry->get_urgency() || "unknown";
-	$f->{Source} = $entry->get_source() || "unknown";
-	$f->{Version} = $entry->get_version() // "unknown";
-	$f->{Distribution} = join(" ", $entry->get_distributions());
-	$f->{Maintainer} = $entry->get_maintainer() || "";
-	$f->{Date} = $entry->get_timestamp() || "";
+	$f->{Urgency} = $entry->get_urgency() || 'unknown';
+	$f->{Source} = $entry->get_source() || 'unknown';
+	$f->{Version} = $entry->get_version() // 'unknown';
+	$f->{Distribution} = join(' ', $entry->get_distributions());
+	$f->{Maintainer} = $entry->get_maintainer() || '';
+	$f->{Date} = $entry->get_timestamp() || '';
 	$f->{Changes} = $entry->get_dpkg_changes();
 
 	# handle optional fields
@@ -604,7 +604,7 @@ sub rfc822 {
 	    field_transfer_single($opts, $f) unless exists $f->{$_};
 	}
 
-        run_vendor_hook("post-process-changelog-entry", $f);
+        run_vendor_hook('post-process-changelog-entry', $f);
 
 	$index->add($f);
     }

+ 17 - 17
scripts/Dpkg/Changelog/Debian.pm

@@ -43,7 +43,7 @@ package Dpkg::Changelog::Debian;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::Gettext;
 use Dpkg::Changelog qw(:util);
@@ -86,7 +86,7 @@ sub parse {
 	    (my $options = $4) =~ s/^\s+//;
 	    unless ($expect eq FIRST_HEADING || $expect eq NEXT_OR_EOF) {
 		$self->parse_error($file, $.,
-		    sprintf(_g("found start of entry where expected %s"),
+		    sprintf(_g('found start of entry where expected %s'),
 		    $expect), "$_");
 	    }
 	    unless ($entry->is_empty) {
@@ -121,32 +121,32 @@ sub parse {
 	    # save entries on old changelog format verbatim
 	    # we assume the rest of the file will be in old format once we
 	    # hit it for the first time
-	    $self->set_unparsed_tail("$_\n" . join("", <$fh>));
+	    $self->set_unparsed_tail("$_\n" . join('', <$fh>));
 	} elsif (m/^\S/) {
-	    $self->parse_error($file, $., _g("badly formatted heading line"), "$_");
+	    $self->parse_error($file, $., _g('badly formatted heading line'), "$_");
 	} elsif ($_ =~ $regex_trailer) {
 	    unless ($expect eq CHANGES_OR_TRAILER) {
 		$self->parse_error($file, $.,
-		    sprintf(_g("found trailer where expected %s"), $expect), "$_");
+		    sprintf(_g('found trailer where expected %s'), $expect), "$_");
 	    }
-	    $entry->set_part("trailer", $_);
-	    $entry->extend_part("blank_after_changes", [ @blanklines ]);
+	    $entry->set_part('trailer', $_);
+	    $entry->extend_part('blank_after_changes', [ @blanklines ]);
 	    @blanklines = ();
 	    foreach my $error ($entry->check_trailer()) {
 		$self->parse_error($file, $., $error, $_);
 	    }
 	    $expect = NEXT_OR_EOF;
 	} elsif (m/^ \-\-/) {
-	    $self->parse_error($file, $., _g("badly formatted trailer line"), "$_");
+	    $self->parse_error($file, $., _g('badly formatted trailer line'), "$_");
 	} elsif (m/^\s{2,}(\S)/) {
 	    unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
-		$self->parse_error($file, $., sprintf(_g("found change data" .
-		    " where expected %s"), $expect), "$_");
+		$self->parse_error($file, $., sprintf(_g('found change data' .
+		    ' where expected %s'), $expect), "$_");
 		if ($expect eq NEXT_OR_EOF and not $entry->is_empty) {
 		    # lets assume we have missed the actual header line
 		    push @{$self->{data}}, $entry;
 		    $entry = Dpkg::Changelog::Entry::Debian->new();
-		    $entry->set_part('header', "unknown (unknown" . ($unknowncounter++) . ") unknown; urgency=unknown");
+		    $entry->set_part('header', 'unknown (unknown' . ($unknowncounter++) . ') unknown; urgency=unknown');
 		}
 	    }
 	    # Keep raw changes
@@ -155,21 +155,21 @@ sub parse {
 	    $expect = CHANGES_OR_TRAILER;
 	} elsif (!m/\S/) {
 	    if ($expect eq START_CHANGES) {
-		$entry->extend_part("blank_after_header", $_);
+		$entry->extend_part('blank_after_header', $_);
 		next;
 	    } elsif ($expect eq NEXT_OR_EOF) {
-		$entry->extend_part("blank_after_trailer", $_);
+		$entry->extend_part('blank_after_trailer', $_);
 		next;
 	    } elsif ($expect ne CHANGES_OR_TRAILER) {
 		$self->parse_error($file, $.,
-		    sprintf(_g("found blank line where expected %s"), $expect));
+		    sprintf(_g('found blank line where expected %s'), $expect));
 	    }
 	    push @blanklines, $_;
 	} else {
-	    $self->parse_error($file, $., _g("unrecognized line"), "$_");
+	    $self->parse_error($file, $., _g('unrecognized line'), "$_");
 	    unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
 		# lets assume change data if we expected it
-		$entry->extend_part("changes", [ @blanklines, $_]);
+		$entry->extend_part('changes', [ @blanklines, $_]);
 		@blanklines = ();
 		$expect = CHANGES_OR_TRAILER;
 	    }
@@ -177,7 +177,7 @@ sub parse {
     }
 
     unless ($expect eq NEXT_OR_EOF) {
-	$self->parse_error($file, $., sprintf(_g("found eof where expected %s"),
+	$self->parse_error($file, $., sprintf(_g('found eof where expected %s'),
 					      $expect));
     }
     unless ($entry->is_empty) {

+ 6 - 6
scripts/Dpkg/Changelog/Entry.pm

@@ -18,7 +18,7 @@ package Dpkg::Changelog::Entry;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
@@ -110,7 +110,7 @@ lines) corresponding to the requested part. $part can be
 
 sub get_part {
     my ($self, $part) = @_;
-    internerr("invalid part of changelog entry: %s") unless exists $self->{$part};
+    internerr('invalid part of changelog entry: %s') unless exists $self->{$part};
     return $self->{$part};
 }
 
@@ -123,7 +123,7 @@ or an array ref.
 
 sub set_part {
     my ($self, $part, $value) = @_;
-    internerr("invalid part of changelog entry: %s") unless exists $self->{$part};
+    internerr('invalid part of changelog entry: %s') unless exists $self->{$part};
     if (ref($self->{$part})) {
 	if (ref($value)) {
 	    $self->{$part} = $value;
@@ -145,7 +145,7 @@ concatenated at the end of the current line.
 
 sub extend_part {
     my ($self, $part, $value, @rest) = @_;
-    internerr("invalid part of changelog entry: %s") unless exists $self->{$part};
+    internerr('invalid part of changelog entry: %s') unless exists $self->{$part};
     if (ref($self->{$part})) {
 	if (ref($value)) {
 	    push @{$self->{$part}}, @$value;
@@ -288,9 +288,9 @@ in the output format of C<dpkg-parsechangelog>.
 
 sub get_dpkg_changes {
     my ($self) = @_;
-    my $header = $self->get_part("header") || "";
+    my $header = $self->get_part('header') || '';
     $header =~ s/\s+$//;
-    return "\n$header\n\n" . join("\n", @{$self->get_part("changes")});
+    return "\n$header\n\n" . join("\n", @{$self->get_part('changes')});
 }
 
 =back

+ 9 - 9
scripts/Dpkg/Changelog/Entry/Debian.pm

@@ -18,7 +18,7 @@ package Dpkg::Changelog::Entry::Debian;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Exporter;
 use Dpkg::Changelog::Entry;
@@ -77,7 +77,7 @@ following line necessarily starts a new item).
 sub get_change_items {
     my ($self) = @_;
     my (@items, @blanks, $item);
-    foreach my $line (@{$self->get_part("changes")}) {
+    foreach my $line (@{$self->get_part('changes')}) {
 	if ($line =~ /^\s*\*/) {
 	    push @items, $item if defined $item;
 	    $item = "$line\n";
@@ -125,18 +125,18 @@ sub check_header {
 	    }
 	    my ($k, $v) = (field_capitalize($1), $2);
 	    if ($optdone{$k}) {
-		push @errors, sprintf(_g("repeated key-value %s"), $k);
+		push @errors, sprintf(_g('repeated key-value %s'), $k);
 	    }
 	    $optdone{$k} = 1;
 	    if ($k eq 'Urgency') {
-		push @errors, sprintf(_g("badly formatted urgency value: %s"), $v)
+		push @errors, sprintf(_g('badly formatted urgency value: %s'), $v)
 		    unless ($v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i);
 	    } elsif ($k eq 'Binary-Only') {
-		push @errors, sprintf(_g("bad binary-only value: %s"), $v)
-		    unless ($v eq "yes");
+		push @errors, sprintf(_g('bad binary-only value: %s'), $v)
+		    unless ($v eq 'yes');
 	    } elsif ($k =~ m/^X[BCS]+-/i) {
 	    } else {
-		push @errors, sprintf(_g("unknown key-value %s"), $k);
+		push @errors, sprintf(_g('unknown key-value %s'), $k);
 	    }
 	}
 	my ($ok, $msg) = version_check($version);
@@ -154,7 +154,7 @@ sub check_trailer {
     my @errors;
     if (defined($self->{trailer}) and $self->{trailer} =~ $regex_trailer) {
 	if ($3 ne '  ') {
-	    push @errors, _g("badly formatted trailer line");
+	    push @errors, _g('badly formatted trailer line');
 	}
 	unless (defined str2time($4)) {
 	    push @errors, sprintf(_g("couldn't parse date %s"), $4);
@@ -220,7 +220,7 @@ sub get_optional_fields {
     }
     my @closes = find_closes(join("\n", @{$self->{changes}}));
     if (@closes) {
-	$f->{Closes} = join(" ", @closes);
+	$f->{Closes} = join(' ', @closes);
     }
     return $f;
 }

+ 18 - 18
scripts/Dpkg/Changelog/Parse.pm

@@ -34,7 +34,7 @@ package Dpkg::Changelog::Parse;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg; # for $dpkglibdir
 use Dpkg::Gettext;
@@ -74,11 +74,11 @@ it's passed as the parameter that follows.
 
 sub changelog_parse {
     my (%options) = @_;
-    my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
+    my @parserpath = ('/usr/local/lib/dpkg/parsechangelog',
                       "$dpkglibdir/parsechangelog",
-                      "/usr/lib/dpkg/parsechangelog");
-    my $format = "debian";
-    my $changelogfile = "debian/changelog";
+                      '/usr/lib/dpkg/parsechangelog');
+    my $format = 'debian';
+    my $changelogfile = 'debian/changelog';
     my $force = 0;
 
     # Extract and remove options that do not concern the changelog parser
@@ -98,12 +98,12 @@ sub changelog_parse {
     }
 
     # Extract the format from the changelog file if possible
-    unless($force or ($changelogfile eq "-")) {
-	open(my $format_fh, "-|", "tail", "-n", "40", $changelogfile);
+    unless($force or ($changelogfile eq '-')) {
+	open(my $format_fh, '-|', 'tail', '-n', '40', $changelogfile);
 	while (<$format_fh>) {
 	    $format = $1 if m/\schangelog-format:\s+([0-9a-z]+)\W/;
 	}
-	close($format_fh) or subprocerr(_g("tail of %s"), $changelogfile);
+	close($format_fh) or subprocerr(_g('tail of %s'), $changelogfile);
     }
 
     # Find the right changelog parser
@@ -115,10 +115,10 @@ sub changelog_parse {
 	    $parser = $candidate;
 	    last;
 	} else {
-	    warning(_g("format parser %s not executable"), $candidate);
+	    warning(_g('format parser %s not executable'), $candidate);
 	}
     }
-    error(_g("changelog format %s is unknown"), $format) if not defined $parser;
+    error(_g('changelog format %s is unknown'), $format) if not defined $parser;
 
     # Create the arguments for the changelog parser
     my @exec = ($parser, "-l$changelogfile");
@@ -134,24 +134,24 @@ sub changelog_parse {
     }
 
     # Fork and call the parser
-    my $pid = open(my $parser_fh, "-|");
-    syserr(_g("cannot fork for %s"), $parser) unless defined $pid;
+    my $pid = open(my $parser_fh, '-|');
+    syserr(_g('cannot fork for %s'), $parser) unless defined $pid;
     if (not $pid) {
-	if ($changelogfile ne "-") {
-	    open(STDIN, "<", $changelogfile) or
-		syserr(_g("cannot open %s"), $changelogfile);
+	if ($changelogfile ne '-') {
+	    open(STDIN, '<', $changelogfile) or
+		syserr(_g('cannot open %s'), $changelogfile);
 	}
-	exec(@exec) || syserr(_g("cannot exec format parser: %s"), $parser);
+	exec(@exec) || syserr(_g('cannot exec format parser: %s'), $parser);
     }
 
     # Get the output into several Dpkg::Control objects
     my (@res, $fields);
     while (1) {
         $fields = Dpkg::Control::Changelog->new();
-        last unless $fields->parse($parser_fh, _g("output of changelog parser"));
+        last unless $fields->parse($parser_fh, _g('output of changelog parser'));
 	push @res, $fields;
     }
-    close($parser_fh) or subprocerr(_g("changelog parser %s"), $parser);
+    close($parser_fh) or subprocerr(_g('changelog parser %s'), $parser);
     if (wantarray) {
 	return @res;
     } else {

+ 12 - 12
scripts/Dpkg/Checksums.pm

@@ -19,7 +19,7 @@ package Dpkg::Checksums;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg;
 use Dpkg::Gettext;
@@ -50,15 +50,15 @@ about supported checksums.
 
 my $CHECKSUMS = {
     md5 => {
-	program => [ "md5sum" ],
+	program => [ 'md5sum' ],
 	regex => qr/[0-9a-f]{32}/,
     },
     sha1 => {
-	program => [ "sha1sum" ],
+	program => [ 'sha1sum' ],
 	regex => qr/[0-9a-f]{40}/,
     },
     sha256 => {
-	program => [ "sha256sum" ],
+	program => [ 'sha256sum' ],
 	regex => qr/[0-9a-f]{64}/,
     },
 };
@@ -168,9 +168,9 @@ sub add_from_file {
     }
 
     push @{$self->{files}}, $key unless exists $self->{size}{$key};
-    (my @s = stat($file)) || syserr(_g("cannot fstat file %s"), $file);
+    (my @s = stat($file)) || syserr(_g('cannot fstat file %s'), $file);
     if (exists $self->{size}{$key} and $self->{size}{$key} != $s[7]) {
-	error(_g("File %s has size %u instead of expected %u"),
+	error(_g('File %s has size %u instead of expected %u'),
 	      $file, $s[7], $self->{size}{$key});
     }
     $self->{size}{$key} = $s[7];
@@ -184,7 +184,7 @@ sub add_from_file {
 	    my $newsum = $1;
 	    if (exists $self->{checksums}{$key}{$alg} and
 		$self->{checksums}{$key}{$alg} ne $newsum) {
-		error(_g("File %s has checksum %s instead of expected %s (algorithm %s)"),
+		error(_g('File %s has checksum %s instead of expected %s (algorithm %s)'),
 		      $file, $newsum, $self->{checksums}{$key}{$alg}, $alg);
 	    }
 	    $self->{checksums}{$key}{$alg} = $newsum;
@@ -211,13 +211,13 @@ sub add_from_string {
     my ($self, $alg, $fieldtext) = @_;
     $alg = lc($alg);
     my $rx_fname = qr/[0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+/;
-    my $regex = checksums_get_property($alg, "regex");
+    my $regex = checksums_get_property($alg, 'regex');
     my $checksums = $self->{checksums};
 
     for my $checksum (split /\n */, $fieldtext) {
 	next if $checksum eq '';
 	unless ($checksum =~ m/^($regex)\s+(\d+)\s+($rx_fname)$/) {
-	    error(_g("invalid line in %s checksums string: %s"),
+	    error(_g('invalid line in %s checksums string: %s'),
 		  $alg, $checksum);
 	}
 	my ($sum, $size, $file) = ($1, $2, $3);
@@ -253,7 +253,7 @@ sub add_from_control {
     $opts{use_files_for_md5} = 0 unless exists $opts{use_files_for_md5};
     foreach my $alg (checksums_get_list()) {
 	my $key = "Checksums-$alg";
-	$key = "Files" if ($opts{use_files_for_md5} and $alg eq "md5");
+	$key = 'Files' if ($opts{use_files_for_md5} and $alg eq 'md5');
 	if (exists $control->{$key}) {
 	    $self->add_from_string($alg, $control->{$key});
 	}
@@ -340,7 +340,7 @@ object.
 
 sub export_to_string {
     my ($self, $alg, %opts) = @_;
-    my $res = "";
+    my $res = '';
     foreach my $file ($self->get_files()) {
 	my $sum = $self->get_checksum($file, $alg);
 	my $size = $self->get_size($file);
@@ -362,7 +362,7 @@ sub export_to_control {
     $opts{use_files_for_md5} = 0 unless exists $opts{use_files_for_md5};
     foreach my $alg (checksums_get_list()) {
 	my $key = "Checksums-$alg";
-	$key = "Files" if ($opts{use_files_for_md5} and $alg eq "md5");
+	$key = 'Files' if ($opts{use_files_for_md5} and $alg eq 'md5');
 	$control->{$key} = $self->export_to_string($alg, %opts);
     }
 }

+ 17 - 17
scripts/Dpkg/Compression.pm

@@ -18,7 +18,7 @@ package Dpkg::Compression;
 use strict;
 use warnings;
 
-our $VERSION = "1.01";
+our $VERSION = '1.01';
 
 use Dpkg::ErrorHandling;
 use Dpkg::Gettext;
@@ -51,32 +51,32 @@ interact with the set of supported compression methods.
 
 my $COMP = {
     gzip => {
-	file_ext => "gz",
-	comp_prog => [ "gzip", "--no-name", "--rsyncable" ],
-	decomp_prog => [ "gunzip" ],
+	file_ext => 'gz',
+	comp_prog => [ 'gzip', '--no-name', '--rsyncable' ],
+	decomp_prog => [ 'gunzip' ],
 	default_level => 9,
     },
     bzip2 => {
-	file_ext => "bz2",
-	comp_prog => [ "bzip2" ],
-	decomp_prog => [ "bunzip2" ],
+	file_ext => 'bz2',
+	comp_prog => [ 'bzip2' ],
+	decomp_prog => [ 'bunzip2' ],
 	default_level => 9,
     },
     lzma => {
-	file_ext => "lzma",
+	file_ext => 'lzma',
 	comp_prog => [ 'xz', '--format=lzma' ],
 	decomp_prog => [ 'unxz', '--format=lzma' ],
 	default_level => 6,
     },
     xz => {
-	file_ext => "xz",
-	comp_prog => [ "xz" ],
-	decomp_prog => [ "unxz" ],
+	file_ext => 'xz',
+	comp_prog => [ 'xz' ],
+	decomp_prog => [ 'unxz' ],
 	default_level => 6,
     },
 };
 
-our $default_compression = "gzip";
+our $default_compression = 'gzip';
 our $default_compression_level = undef;
 
 =item $compression_re_file_ext
@@ -88,7 +88,7 @@ supported compression methods.
 
 =cut
 
-my $regex = join "|", map { $_->{file_ext} } values %$COMP;
+my $regex = join '|', map { $_->{file_ext} } values %$COMP;
 our $compression_re_file_ext = qr/(?:$regex)/;
 
 =head1 EXPORTED FUNCTIONS
@@ -145,7 +145,7 @@ filename based on its file extension.
 sub compression_guess_from_filename {
     my $filename = shift;
     foreach my $comp (compression_get_list()) {
-	my $ext = compression_get_property($comp, "file_ext");
+	my $ext = compression_get_property($comp, 'file_ext');
         if ($filename =~ /^(.*)\.\Q$ext\E$/) {
 	    return $comp;
         }
@@ -171,7 +171,7 @@ sub compression_get_default {
 
 sub compression_set_default {
     my ($method) = @_;
-    error(_g("%s is not a supported compression"), $method)
+    error(_g('%s is not a supported compression'), $method)
             unless compression_is_supported($method);
     $default_compression = $method;
 }
@@ -194,13 +194,13 @@ sub compression_get_default_level {
     if (defined $default_compression_level) {
         return $default_compression_level;
     } else {
-        return compression_get_property($default_compression, "default_level");
+        return compression_get_property($default_compression, 'default_level');
     }
 }
 
 sub compression_set_default_level {
     my ($level) = @_;
-    error(_g("%s is not a compression level"), $level)
+    error(_g('%s is not a compression level'), $level)
             unless !defined($level) or compression_is_valid_level($level);
     $default_compression_level = $level;
 }

+ 34 - 34
scripts/Dpkg/Compression/FileHandle.pm

@@ -18,7 +18,7 @@ package Dpkg::Compression::FileHandle;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::Compression;
 use Dpkg::Compression::Process;
@@ -42,31 +42,31 @@ Dpkg::Compression::FileHandle - object dealing transparently with file compressi
 
     use Dpkg::Compression::FileHandle;
 
-    $fh = Dpkg::Compression::FileHandle->new(filename=>"sample.gz");
+    $fh = Dpkg::Compression::FileHandle->new(filename => 'sample.gz');
     print $fh "Something\n";
     close $fh;
 
     $fh = Dpkg::Compression::FileHandle->new();
-    open($fh, ">", "sample.bz2");
+    open($fh, '>', 'sample.bz2');
     print $fh "Something\n";
     close $fh;
 
     $fh = Dpkg::Compression::FileHandle->new();
-    $fh->open("sample.xz", "w");
+    $fh->open('sample.xz', 'w');
     $fh->print("Something\n");
     $fh->close();
 
-    $fh = Dpkg::Compression::FileHandle->new(filename=>"sample.gz");
+    $fh = Dpkg::Compression::FileHandle->new(filename => 'sample.gz');
     my @lines = <$fh>;
     close $fh;
 
     $fh = Dpkg::Compression::FileHandle->new();
-    open($fh, "<", "sample.bz2");
+    open($fh, '<', 'sample.bz2');
     my @lines = <$fh>;
     close $fh;
 
     $fh = Dpkg::Compression::FileHandle->new();
-    $fh->open("sample.xz", "r");
+    $fh->open('sample.xz', 'r');
     my @lines = $fh->getlines();
     $fh->close();
 
@@ -127,7 +127,7 @@ sub new {
     tie *$self, $class, $self;
     bless $self, $class;
     # Initializations
-    *$self->{compression} = "auto";
+    *$self->{compression} = 'auto';
     *$self->{compressor} = Dpkg::Compression::Process->new();
     *$self->{add_comp_ext} = $args{add_compression_extension} ||
 	    $args{add_comp_ext} || 0;
@@ -158,9 +158,9 @@ sub ensure_open {
 	return if *$self->{mode} eq $mode;
 	internerr("ensure_open requested incompatible mode: $mode");
     } else {
-	if ($mode eq "w") {
+	if ($mode eq 'w') {
 	    $self->open_for_write();
-	} elsif ($mode eq "r") {
+	} elsif ($mode eq 'r') {
 	    $self->open_for_read();
 	} else {
 	    internerr("invalid mode in ensure_open: $mode");
@@ -178,19 +178,19 @@ sub TIEHANDLE {
 
 sub WRITE {
     my ($self, $scalar, $length, $offset) = @_;
-    $self->ensure_open("w");
+    $self->ensure_open('w');
     return *$self->{file}->write($scalar, $length, $offset);
 }
 
 sub READ {
     my ($self, $scalar, $length, $offset) = @_;
-    $self->ensure_open("r");
+    $self->ensure_open('r');
     return *$self->{file}->read($scalar, $length, $offset);
 }
 
 sub READLINE {
     my ($self) = shift;
-    $self->ensure_open("r");
+    $self->ensure_open('r');
     return *$self->{file}->getlines() if wantarray;
     return *$self->{file}->getline();
 }
@@ -200,15 +200,15 @@ sub OPEN {
     if (scalar(@_) == 2) {
 	my ($mode, $filename) = @_;
 	$self->set_filename($filename);
-	if ($mode eq ">") {
+	if ($mode eq '>') {
 	    $self->open_for_write();
-	} elsif ($mode eq "<") {
+	} elsif ($mode eq '<') {
 	    $self->open_for_read();
 	} else {
 	    internerr("Unsupported open mode on Dpkg::Compression::FileHandle: $mode");
 	}
     } else {
-	internerr("Dpkg::Compression::FileHandle only supports open() with 3 parameters");
+	internerr('Dpkg::Compression::FileHandle only supports open() with 3 parameters');
     }
     return 1; # Always works (otherwise errors out)
 }
@@ -272,7 +272,7 @@ on the filename extension used.
 
 sub set_compression {
     my ($self, $method) = @_;
-    if ($method ne "none" and $method ne "auto") {
+    if ($method ne 'none' and $method ne 'auto') {
 	*$self->{compressor}->set_compression($method);
     }
     *$self->{compression} = $method;
@@ -307,8 +307,8 @@ sub set_filename {
 	*$self->{add_comp_ext} = $add_comp_ext;
     }
     if (*$self->{add_comp_ext} and $filename =~ /\.$compression_re_file_ext$/) {
-	warning("filename %s already has an extension of a compressed file " .
-	        "and add_comp_ext is active", $filename);
+	warning('filename %s already has an extension of a compressed file ' .
+	        'and add_comp_ext is active', $filename);
     }
 }
 
@@ -326,14 +326,14 @@ sub get_filename {
     my $self = shift;
     my $comp = *$self->{compression};
     if (*$self->{add_comp_ext}) {
-	if ($comp eq "auto") {
-	    internerr("automatic detection of compression is " .
-	              "incompatible with add_comp_ext");
-	} elsif ($comp eq "none") {
+	if ($comp eq 'auto') {
+	    internerr('automatic detection of compression is ' .
+	              'incompatible with add_comp_ext');
+	} elsif ($comp eq 'none') {
 	    return *$self->{filename};
 	} else {
-	    return *$self->{filename} . "." .
-	           compression_get_property($comp, "file_ext");
+	    return *$self->{filename} . '.' .
+	           compression_get_property($comp, 'file_ext');
 	}
     } else {
 	return *$self->{filename};
@@ -352,9 +352,9 @@ method.
 sub use_compression {
     my ($self) = @_;
     my $comp = *$self->{compression};
-    if ($comp eq "none") {
+    if ($comp eq 'none') {
 	return 0;
-    } elsif ($comp eq "auto") {
+    } elsif ($comp eq 'auto') {
 	$comp = compression_guess_from_filename($self->get_filename());
 	*$self->{compressor}->set_compression($comp) if $comp;
     }
@@ -383,10 +383,10 @@ sub open_for_write {
 	*$self->{compressor}->compress(from_pipe => \$filehandle,
 		to_file => $self->get_filename());
     } else {
-	CORE::open($filehandle, ">", $self->get_filename) ||
-		syserr(_g("cannot write %s"), $self->get_filename());
+	CORE::open($filehandle, '>', $self->get_filename) ||
+		syserr(_g('cannot write %s'), $self->get_filename());
     }
-    *$self->{mode} = "w";
+    *$self->{mode} = 'w';
     *$self->{file} = $filehandle;
 }
 
@@ -399,16 +399,16 @@ sub open_for_read {
 		from_file => $self->get_filename());
         *$self->{allow_sigpipe} = 1;
     } else {
-	CORE::open($filehandle, "<", $self->get_filename) ||
-		syserr(_g("cannot read %s"), $self->get_filename());
+	CORE::open($filehandle, '<', $self->get_filename) ||
+		syserr(_g('cannot read %s'), $self->get_filename());
     }
-    *$self->{mode} = "r";
+    *$self->{mode} = 'r';
     *$self->{file} = $filehandle;
 }
 
 sub cleanup {
     my ($self) = @_;
-    my $cmdline = *$self->{compressor}{cmdline} || "";
+    my $cmdline = *$self->{compressor}{cmdline} || '';
     *$self->{compressor}->wait_end_process(nocheck => *$self->{allow_sigpipe});
     if (*$self->{allow_sigpipe}) {
         unless (($? == 0) || (WIFSIGNALED($?) && (WTERMSIG($?) == SIGPIPE))) {

+ 10 - 10
scripts/Dpkg/Compression/Process.pm

@@ -18,7 +18,7 @@ package Dpkg::Compression::Process;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::Compression;
 use Dpkg::ErrorHandling;
@@ -68,7 +68,7 @@ B<Dpkg::Compression>).
 
 sub set_compression {
     my ($self, $method) = @_;
-    error(_g("%s is not a supported compression method"), $method)
+    error(_g('%s is not a supported compression method'), $method)
 	    unless compression_is_supported($method);
     $self->{compression} = $method;
 }
@@ -83,7 +83,7 @@ B<Dpkg::Compression>).
 
 sub set_compression_level {
     my ($self, $level) = @_;
-    error(_g("%s is not a compression level"), $level)
+    error(_g('%s is not a compression level'), $level)
 	    unless compression_is_valid_level($level);
     $self->{compression_level} = $level;
 }
@@ -103,9 +103,9 @@ and its standard output.
 
 sub get_compress_cmdline {
     my ($self) = @_;
-    my @prog = (@{compression_get_property($self->{compression}, "comp_prog")});
-    my $level = "-" . $self->{compression_level};
-    $level = "--" . $self->{compression_level}
+    my @prog = (@{compression_get_property($self->{compression}, 'comp_prog')});
+    my $level = '-' . $self->{compression_level};
+    $level = '--' . $self->{compression_level}
 	    if $self->{compression_level} !~ m/^[1-9]$/;
     push @prog, $level;
     return @prog;
@@ -113,13 +113,13 @@ sub get_compress_cmdline {
 
 sub get_uncompress_cmdline {
     my ($self) = @_;
-    return (@{compression_get_property($self->{compression}, "decomp_prog")});
+    return (@{compression_get_property($self->{compression}, 'decomp_prog')});
 }
 
 sub _sanity_check {
     my ($self, %opts) = @_;
     # Check for proper cleaning before new start
-    error(_g("Dpkg::Compression::Process can only start one subprocess at a time"))
+    error(_g('Dpkg::Compression::Process can only start one subprocess at a time'))
 	    if $self->{pid};
     # Check options
     my $to = my $from = 0;
@@ -127,8 +127,8 @@ sub _sanity_check {
         $to++ if $opts{"to_$_"};
         $from++ if $opts{"from_$_"};
     }
-    internerr("exactly one to_* parameter is needed") if $to != 1;
-    internerr("exactly one from_* parameter is needed") if $from != 1;
+    internerr('exactly one to_* parameter is needed') if $to != 1;
+    internerr('exactly one from_* parameter is needed') if $from != 1;
     return %opts;
 }
 

+ 4 - 4
scripts/Dpkg/Conf.pm

@@ -18,7 +18,7 @@ package Dpkg::Conf;
 use strict;
 use warnings;
 
-our $VERSION = "1.01";
+our $VERSION = '1.01';
 
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
@@ -102,7 +102,7 @@ sub parse {
 	s/\s+/=/ unless m/=/; # First spaces becomes = if no =
 	next if /^#/ or /^$/; # Skip empty lines and comments
 	if (/^-[^-]/ and not $self->{allow_short}) {
-	    warning(_g("short option not allowed in %s, line %d"), $desc, $.);
+	    warning(_g('short option not allowed in %s, line %d'), $desc, $.);
 	    next;
 	}
 	if (/^([^=]+)(?:=(.*))?$/) {
@@ -116,7 +116,7 @@ sub parse {
 	    }
 	    $count++;
 	} else {
-	    warning(_g("invalid syntax for option in %s, line %d"), $desc, $.);
+	    warning(_g('invalid syntax for option in %s, line %d'), $desc, $.);
 	}
     }
     return $count;
@@ -160,7 +160,7 @@ Save the options in a file.
 
 sub output {
     my ($self, $fh) = @_;
-    my $ret = "";
+    my $ret = '';
     foreach my $opt ($self->get_options()) {
 	$opt =~ s/^--//;
 	if ($opt =~ s/^([^=]+)=/$1 = "/) {

+ 9 - 9
scripts/Dpkg/Control.pm

@@ -18,7 +18,7 @@ package Dpkg::Control;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
@@ -147,23 +147,23 @@ sub set_options {
         $$self->{allow_pgp} = ($t & (CTRL_PKG_SRC | CTRL_FILE_CHANGES)) ? 1 : 0;
         $$self->{drop_empty} = ($t & (CTRL_INFO_PKG | CTRL_INFO_SRC)) ?  0 : 1;
         if ($t == CTRL_INFO_SRC) {
-            $$self->{name} = _g("general section of control info file");
+            $$self->{name} = _g('general section of control info file');
         } elsif ($t == CTRL_INFO_PKG) {
             $$self->{name} = _g("package's section of control info file");
         } elsif ($t == CTRL_CHANGELOG) {
-            $$self->{name} = _g("parsed version of changelog");
+            $$self->{name} = _g('parsed version of changelog');
         } elsif ($t == CTRL_INDEX_SRC) {
-            $$self->{name} = sprintf(_g("entry in repository's %s file"), "Sources");
+            $$self->{name} = sprintf(_g("entry in repository's %s file"), 'Sources');
         } elsif ($t == CTRL_INDEX_PKG) {
-            $$self->{name} = sprintf(_g("entry in repository's %s file"), "Packages");
+            $$self->{name} = sprintf(_g("entry in repository's %s file"), 'Packages');
         } elsif ($t == CTRL_PKG_SRC) {
-            $$self->{name} = sprintf(_g("%s file"), ".dsc");
+            $$self->{name} = sprintf(_g('%s file'), '.dsc');
         } elsif ($t == CTRL_PKG_DEB) {
-            $$self->{name} = _g("control info of a .deb package");
+            $$self->{name} = _g('control info of a .deb package');
         } elsif ($t == CTRL_FILE_CHANGES) {
-            $$self->{name} = sprintf(_g("%s file"), ".changes");
+            $$self->{name} = sprintf(_g('%s file'), '.changes');
         } elsif ($t == CTRL_FILE_VENDOR) {
-            $$self->{name} = _g("vendor file");
+            $$self->{name} = _g('vendor file');
         } elsif ($t == CTRL_FILE_STATUS) {
             $$self->{name} = _g("entry in dpkg's status file");
         }

+ 1 - 1
scripts/Dpkg/Control/Changelog.pm

@@ -18,7 +18,7 @@ package Dpkg::Control::Changelog;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::Control;
 use base 'Dpkg::Control';

+ 11 - 11
scripts/Dpkg/Control/Fields.pm

@@ -18,7 +18,7 @@ package Dpkg::Control::Fields;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use base qw(Exporter);
 use Dpkg::Gettext;
@@ -288,7 +288,7 @@ our %FIELDS = (
 );
 
 my @checksum_fields = map { &field_capitalize("Checksums-$_") } checksums_get_list();
-my @sum_fields = map { $_ eq "md5" ? "MD5sum" : &field_capitalize($_) }
+my @sum_fields = map { $_ eq 'md5' ? 'MD5sum' : &field_capitalize($_) }
                  checksums_get_list();
 &field_register($_, CTRL_PKG_SRC | CTRL_FILE_CHANGES) foreach @checksum_fields;
 &field_register($_, CTRL_INDEX_PKG) foreach @sum_fields;
@@ -330,20 +330,20 @@ $FIELD_ORDER{CTRL_INDEX_PKG()} = [ @{$FIELD_ORDER{CTRL_PKG_DEB()}} ];
 &field_insert_before(CTRL_INDEX_PKG, 'Section', 'Filename', 'Size', @sum_fields);
 # Order for CTRL_INDEX_SRC is derived from CTRL_PKG_SRC
 $FIELD_ORDER{CTRL_INDEX_SRC()} = [ @{$FIELD_ORDER{CTRL_PKG_SRC()}} ];
-@{$FIELD_ORDER{CTRL_INDEX_SRC()}} = map { $_ eq "Source" ? "Package" : $_ }
+@{$FIELD_ORDER{CTRL_INDEX_SRC()}} = map { $_ eq 'Source' ? 'Package' : $_ }
                                   @{$FIELD_ORDER{CTRL_PKG_SRC()}};
-&field_insert_after(CTRL_INDEX_SRC, "Version", "Priority", "Section");
-&field_insert_before(CTRL_INDEX_SRC, "Checksums-Md5", "Directory");
+&field_insert_after(CTRL_INDEX_SRC, 'Version', 'Priority', 'Section');
+&field_insert_before(CTRL_INDEX_SRC, 'Checksums-Md5', 'Directory');
 
 # Register vendor specifics fields
-foreach my $op (run_vendor_hook("register-custom-fields")) {
+foreach my $op (run_vendor_hook('register-custom-fields')) {
     next if not (defined $op and ref $op); # Skip when not implemented by vendor
     my $func = shift @$op;
-    if ($func eq "register") {
+    if ($func eq 'register') {
         &field_register(@$op);
-    } elsif ($func eq "insert_before") {
+    } elsif ($func eq 'insert_before') {
         &field_insert_before(@$op);
-    } elsif ($func eq "insert_after") {
+    } elsif ($func eq 'insert_after') {
         &field_insert_after(@$op);
     } else {
         error("vendor hook register-custom-fields sent bad data: @$op");
@@ -376,7 +376,7 @@ except the first of each word (words are separated by a dash in field names).
 sub field_capitalize($) {
     my $field = lc(shift);
     # Some special cases due to history
-    return "MD5sum" if $field eq "md5sum";
+    return 'MD5sum' if $field eq 'md5sum';
     return uc($field) if checksums_is_supported($field);
     # Generic case
     return join '-', map { ucfirst } split /-/, $field;
@@ -466,7 +466,7 @@ sub field_transfer_single($$;$) {
 	}
     } elsif (not field_is_allowed_in($field, $from_type)) {
         warning(_g("unknown information field '%s' in input data in %s"),
-                $field, $from->get_option("name") || _g("control information"));
+                $field, $from->get_option('name') || _g('control information'));
     }
     return;
 }

+ 16 - 16
scripts/Dpkg/Control/Hash.pm

@@ -18,7 +18,7 @@ package Dpkg::Control::Hash;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
@@ -183,7 +183,7 @@ sub parse {
 	    $parabody = 1;
 	    if (exists $self->{$1}) {
 		unless ($$self->{allow_duplicate}) {
-		    syntaxerr($desc, sprintf(_g("duplicate field %s found"), $1));
+		    syntaxerr($desc, sprintf(_g('duplicate field %s found'), $1));
 		}
 	    }
 	    $self->{$1} = $2;
@@ -191,7 +191,7 @@ sub parse {
 	} elsif (m/^\s(\s*\S.*)$/) {
 	    my $line = $1;
 	    unless (defined($cf)) {
-                syntaxerr($desc, _g("continued value line not in field"));
+                syntaxerr($desc, _g('continued value line not in field'));
             }
 	    if ($line =~ /^\.+$/) {
 		$line = substr $line, 1;
@@ -205,18 +205,18 @@ sub parse {
 		    last if m/^\s*$/;
 		}
 	    } else {
-		syntaxerr($desc, _g("PGP signature not allowed here"));
+		syntaxerr($desc, _g('PGP signature not allowed here'));
 	    }
 	} elsif (m/^$/ || ($expect_pgp_sig && m/^-----BEGIN PGP SIGNATURE-----$/)) {
 	    if ($expect_pgp_sig) {
 		# Skip empty lines
 		$_ = <$fh> while defined($_) && $_ =~ /^\s*$/;
 		length($_) ||
-                    syntaxerr($desc, _g("expected PGP signature, found EOF " .
-                                        "after blank line"));
+                    syntaxerr($desc, _g('expected PGP signature, found EOF ' .
+                                        'after blank line'));
 		s/\s*\n$//;
 		unless (m/^-----BEGIN PGP SIGNATURE-----$/) {
-		    syntaxerr($desc, sprintf(_g("expected PGP signature, " .
+		    syntaxerr($desc, sprintf(_g('expected PGP signature, ' .
                                                 "found something else \`%s'"), $_));
                 }
 		# Skip PGP signature
@@ -225,7 +225,7 @@ sub parse {
 		    last if m/^-----END PGP SIGNATURE-----$/;
 		}
 		unless (defined($_)) {
-                    syntaxerr($desc, _g("unfinished PGP signature"));
+                    syntaxerr($desc, _g('unfinished PGP signature'));
                 }
 		# This does not mean the signature is correct, that needs to
 		# be verified by gnupg.
@@ -234,12 +234,12 @@ sub parse {
 	    last; # Finished parsing one block
 	} else {
 	    syntaxerr($desc,
-                      _g("line with unknown format (not field-colon-value)"));
+                      _g('line with unknown format (not field-colon-value)'));
 	}
     }
 
     if ($expect_pgp_sig and not $pgp_signed) {
-        syntaxerr($desc, _g("unfinished PGP signature"));
+        syntaxerr($desc, _g('unfinished PGP signature'));
     }
 
     return defined($cf);
@@ -296,7 +296,7 @@ filehandle.
 
 sub output {
     my ($self, $fh) = @_;
-    my $str = "";
+    my $str = '';
     my @keys;
     if (@{$$self->{out_order}}) {
         my $i = 1;
@@ -324,7 +324,7 @@ sub output {
             next if $$self->{drop_empty} and $value !~ m/\S/;
 	    # Escape data to follow control file syntax
 	    my @lines = split(/\n/, $value);
-	    $value = (scalar @lines) ? shift @lines : "";
+	    $value = (scalar @lines) ? shift @lines : '';
 	    foreach (@lines) {
 		s/\s+$//;
 		if (/^$/ or /^\.+$/) {
@@ -336,7 +336,7 @@ sub output {
 	    # Print it out
             if ($fh) {
 	        print $fh "$key: $value\n" ||
-                    syserr(_g("write error on control data"));
+                    syserr(_g('write error on control data'));
             }
 	    $str .= "$key: $value\n" if defined wantarray;
 	}
@@ -407,7 +407,7 @@ use base qw(Tie::ExtraHash);
 sub field_capitalize($) {
     my $field = lc(shift);
     # Some special cases due to history
-    return "MD5sum" if $field eq "md5sum";
+    return 'MD5sum' if $field eq 'md5sum';
     return uc($field) if checksums_is_supported($field);
     # Generic case
     return join '-', map { ucfirst } split /-/, $field;
@@ -433,8 +433,8 @@ sub new {
 
 sub TIEHASH  {
     my ($class, $parent) = @_;
-    die "Parent object must be Dpkg::Control::Hash"
-        if not $parent->isa("Dpkg::Control::Hash");
+    die 'Parent object must be Dpkg::Control::Hash'
+        if not $parent->isa('Dpkg::Control::Hash');
     return bless [ {}, $$parent ], $class;
 }
 

+ 5 - 5
scripts/Dpkg/Control/Info.pm

@@ -18,7 +18,7 @@ package Dpkg::Control::Info;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::Control;
 use Dpkg::ErrorHandling;
@@ -62,7 +62,7 @@ sub new {
     if ($arg) {
 	$self->load($arg);
     } else {
-	$self->load("debian/control");
+	$self->load('debian/control');
     }
     return $self;
 }
@@ -100,17 +100,17 @@ sub parse {
     return if not $cdata->parse($fh, $desc);
     $self->{source} = $cdata;
     unless (exists $cdata->{Source}) {
-	syntaxerr($desc, _g("first block lacks a source field"));
+	syntaxerr($desc, _g('first block lacks a source field'));
     }
     while (1) {
 	$cdata = Dpkg::Control->new(type => CTRL_INFO_PKG);
         last if not $cdata->parse($fh, $desc);
 	push @{$self->{packages}}, $cdata;
 	unless (exists $cdata->{Package}) {
-	    syntaxerr($desc, _g("block lacks the '%s' field"), "Package");
+	    syntaxerr($desc, _g("block lacks the '%s' field"), 'Package');
 	}
 	unless (exists $cdata->{Architecture}) {
-	    syntaxerr($desc, _g("block lacks the '%s' field"), "Architecture");
+	    syntaxerr($desc, _g("block lacks the '%s' field"), 'Architecture');
 	}
 
     }

+ 27 - 27
scripts/Dpkg/Deps.pm

@@ -49,7 +49,7 @@ All the deps_* functions are exported by default.
 use strict;
 use warnings;
 
-our $VERSION = "1.02";
+our $VERSION = '1.02';
 
 use Dpkg::Version;
 use Dpkg::Arch qw(get_host_arch get_build_arch);
@@ -134,17 +134,17 @@ sub _arch_is_superset {
 
 sub _arch_qualifier_allows_implication {
     my ($p, $q) = @_;
-    if (defined $p and $p eq "any") {
-	return 1 if defined $q and $q eq "any";
+    if (defined $p and $p eq 'any') {
+	return 1 if defined $q and $q eq 'any';
 	return 0;
-    } elsif (defined $p and $p eq "native") {
-	return 1 if defined $q and ($q eq "any" or $q eq "native");
+    } elsif (defined $p and $p eq 'native') {
+	return 1 if defined $q and ($q eq 'any' or $q eq 'native');
 	return 0;
     } elsif (defined $p) {
-	return 1 if defined $q and ($p eq $q or $q eq "any");
+	return 1 if defined $q and ($p eq $q or $q eq 'any');
 	return 0;
     } else {
-	return 0 if defined $q and $q ne "any" and $q ne "native";
+	return 0 if defined $q and $q ne 'any' and $q ne 'native';
 	return 1;
     }
 }
@@ -342,8 +342,8 @@ sub deps_parse {
 	$dep_and = Dpkg::Deps::AND->new();
     }
     foreach my $dep (@dep_list) {
-        if ($options{union} and not $dep->isa("Dpkg::Deps::Simple")) {
-            warning(_g("an union dependency can only contain simple dependencies"));
+        if ($options{union} and not $dep->isa('Dpkg::Deps::Simple')) {
+            warning(_g('an union dependency can only contain simple dependencies'));
             return;
         }
         $dep_and->add($dep);
@@ -383,8 +383,8 @@ sub deps_compare {
 	my @deps = $b->get_deps();
 	$b = $deps[0];
     }
-    my $ar = defined($a->{relation}) ? $a->{relation} : "undef";
-    my $br = defined($b->{relation}) ? $b->{relation} : "undef";
+    my $ar = defined($a->{relation}) ? $a->{relation} : 'undef';
+    my $br = defined($b->{relation}) ? $b->{relation} : 'undef';
     return (($a->{package} cmp $b->{package}) ||
 	    ($relation_ordering{$ar} <=> $relation_ordering{$br}) ||
 	    ($a->{version} cmp $b->{version}));
@@ -529,7 +529,7 @@ In the dependency "python:any (>= 2.6)", the arch qualifier is "any".
 
 =over 4
 
-=item $simple_dep->parse_string("dpkg-dev (>= 1.14.8) [!hurd-i386]")
+=item $simple_dep->parse_string('dpkg-dev (>= 1.14.8) [!hurd-i386]')
 
 Parses the dependency and modifies internal properties to match the parsed
 dependency.
@@ -605,7 +605,7 @@ sub parse_string {
 	      \s*$			    # trailing spaces at end
             /x;
     if (defined($2)) {
-	return if $2 eq "native" and not $self->{build_dep};
+	return if $2 eq 'native' and not $self->{build_dep};
 	$self->{archqual} = $2;
     }
     $self->{package} = $1;
@@ -622,13 +622,13 @@ sub output {
     my ($self, $fh) = @_;
     my $res = $self->{package};
     if (defined($self->{archqual})) {
-	$res .= ":" . $self->{archqual};
+	$res .= ':' . $self->{archqual};
     }
     if (defined($self->{relation})) {
-	$res .= " (" . $self->{relation} . " " . $self->{version} .  ")";
+	$res .= ' (' . $self->{relation} . ' ' . $self->{version} .  ')';
     }
     if (defined($self->{arches})) {
-	$res .= " [" . join(" ", @{$self->{arches}}) . "]";
+	$res .= ' [' . join(' ', @{$self->{arches}}) . ']';
     }
     if (defined($fh)) {
 	print $fh $res;
@@ -901,7 +901,7 @@ sub is_empty {
 }
 
 sub merge_union {
-    internerr("The method merge_union() is only valid for Dpkg::Deps::Simple");
+    internerr('The method merge_union() is only valid for Dpkg::Deps::Simple');
 }
 
 package Dpkg::Deps::AND;
@@ -928,7 +928,7 @@ use base qw(Dpkg::Deps::Multiple);
 
 sub output {
     my ($self, $fh) = @_;
-    my $res = join(", ", map { $_->output() } grep { not $_->is_empty() } $self->get_deps());
+    my $res = join(', ', map { $_->output() } grep { not $_->is_empty() } $self->get_deps());
     if (defined($fh)) {
 	print $fh $res;
     }
@@ -1033,7 +1033,7 @@ use base qw(Dpkg::Deps::Multiple);
 
 sub output {
     my ($self, $fh) = @_;
-    my $res = join(" | ", map { $_->output() } grep { not $_->is_empty() } $self->get_deps());
+    my $res = join(' | ', map { $_->output() } grep { not $_->is_empty() } $self->get_deps());
     if (defined($fh)) {
 	print $fh $res;
     }
@@ -1141,7 +1141,7 @@ use base qw(Dpkg::Deps::Multiple);
 
 sub output {
     my ($self, $fh) = @_;
-    my $res = join(", ", map { $_->output() } grep { not $_->is_empty() } $self->get_deps());
+    my $res = join(', ', map { $_->output() } grep { not $_->is_empty() } $self->get_deps());
     if (defined($fh)) {
 	print $fh $res;
     }
@@ -1222,7 +1222,7 @@ sub add_installed_package {
 	package => $pkg,
 	version => $ver,
 	architecture => $arch,
-	multiarch => $multiarch || "no",
+	multiarch => $multiarch || 'no',
     };
     $self->{pkg}{"$pkg:$arch"} = $p if defined $arch;
     push @{$self->{pkg}{$pkg}}, $p;
@@ -1286,12 +1286,12 @@ sub _find_package {
 	    next;
 	}
 	if (not defined $archqual) {
-	    return $p if $ma eq "foreign";
-	    return $p if $a eq $host_arch or $a eq "all";
-	} elsif ($archqual eq "any") {
-	    return $p if $ma eq "allowed";
-	} elsif ($archqual eq "native") {
-	    return $p if $a eq $build_arch and $ma ne "foreign";
+	    return $p if $ma eq 'foreign';
+	    return $p if $a eq $host_arch or $a eq 'all';
+	} elsif ($archqual eq 'any') {
+	    return $p if $ma eq 'allowed';
+	} elsif ($archqual eq 'native') {
+	    return $p if $a eq $build_arch and $ma ne 'foreign';
 	} else {
 	    return $p if $a eq $archqual;
 	}

+ 11 - 11
scripts/Dpkg/ErrorHandling.pm

@@ -16,7 +16,7 @@ package Dpkg::ErrorHandling;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use Dpkg;
 use Dpkg::Gettext;
@@ -51,33 +51,33 @@ sub report(@)
 
 sub info($;@)
 {
-    print $info_fh report(_g("info"), @_) if (!$quiet_warnings);
+    print $info_fh report(_g('info'), @_) if (!$quiet_warnings);
 }
 
 sub warning($;@)
 {
-    warn report(_g("warning"), @_) if (!$quiet_warnings);
+    warn report(_g('warning'), @_) if (!$quiet_warnings);
 }
 
 sub syserr($;@)
 {
     my $msg = shift;
-    die report(_g("error"), "$msg: $!", @_);
+    die report(_g('error'), "$msg: $!", @_);
 }
 
 sub error($;@)
 {
-    die report(_g("error"), @_);
+    die report(_g('error'), @_);
 }
 
 sub errormsg($;@)
 {
-    print STDERR report(_g("error"), @_);
+    print STDERR report(_g('error'), @_);
 }
 
 sub internerr($;@)
 {
-    die report(_g("internal error"), @_);
+    die report(_g('internal error'), @_);
 }
 
 sub subprocerr(@)
@@ -89,11 +89,11 @@ sub subprocerr(@)
     require POSIX;
 
     if (POSIX::WIFEXITED($?)) {
-	error(_g("%s gave error exit status %s"), $p, POSIX::WEXITSTATUS($?));
+	error(_g('%s gave error exit status %s'), $p, POSIX::WEXITSTATUS($?));
     } elsif (POSIX::WIFSIGNALED($?)) {
-	error(_g("%s died from signal %s"), $p, POSIX::WTERMSIG($?));
+	error(_g('%s died from signal %s'), $p, POSIX::WTERMSIG($?));
     } else {
-	error(_g("%s failed with unknown exit code %d"), $p, $?);
+	error(_g('%s failed with unknown exit code %d'), $p, $?);
     }
 }
 
@@ -112,7 +112,7 @@ sub syntaxerr {
     my ($file, $msg) = (shift, shift);
 
     $msg = sprintf($msg, @_) if (@_);
-    error(_g("syntax error in %s at line %d: %s"), $file, $., $msg);
+    error(_g('syntax error in %s at line %d: %s'), $file, $., $msg);
 }
 
 1;

+ 1 - 1
scripts/Dpkg/Exit.pm

@@ -18,7 +18,7 @@ package Dpkg::Exit;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 our @handlers = ();
 sub exit_handler {

+ 4 - 4
scripts/Dpkg/File.pm

@@ -19,7 +19,7 @@ package Dpkg::File;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use Fcntl qw(:flock);
 use Dpkg::Gettext;
@@ -37,14 +37,14 @@ sub file_lock($$) {
     # be installed alongside.
     eval 'use File::FcntlLock';
     if ($@) {
-        warning(_g("File::FcntlLock not available; using flock which is not NFS-safe"));
+        warning(_g('File::FcntlLock not available; using flock which is not NFS-safe'));
         flock($fh, LOCK_EX) ||
-            syserr(_("failed to get a write lock on %s"), $filename);
+            syserr(_('failed to get a write lock on %s'), $filename);
     } else {
         eval q{
             my $fs = File::FcntlLock->new(l_type => F_WRLCK);
             $fs->lock($fh, F_SETLKW) ||
-                syserr(_("failed to get a write lock on %s"), $filename);
+                syserr(_('failed to get a write lock on %s'), $filename);
         }
     }
 }

+ 1 - 1
scripts/Dpkg/Gettext.pm

@@ -26,7 +26,7 @@ package Dpkg::Gettext;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 BEGIN {
 	eval 'use Locale::gettext';

+ 28 - 28
scripts/Dpkg/IPC.pm

@@ -19,7 +19,7 @@ package Dpkg::IPC;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::ErrorHandling;
 use Dpkg::Gettext;
@@ -133,7 +133,7 @@ listed in the array before calling exec.
 sub _sanity_check_opts {
     my (%opts) = @_;
 
-    internerr("exec parameter is mandatory in spawn()")
+    internerr('exec parameter is mandatory in spawn()')
 	unless $opts{exec};
 
     my $to = my $error_to = my $from = 0;
@@ -142,11 +142,11 @@ sub _sanity_check_opts {
 	$error_to++ if $opts{"error_to_$_"};
 	$from++ if $opts{"from_$_"};
     }
-    internerr("not more than one of to_* parameters is allowed")
+    internerr('not more than one of to_* parameters is allowed')
 	if $to > 1;
-    internerr("not more than one of error_to_* parameters is allowed")
+    internerr('not more than one of error_to_* parameters is allowed')
 	if $error_to > 1;
-    internerr("not more than one of from_* parameters is allowed")
+    internerr('not more than one of from_* parameters is allowed')
 	if $from > 1;
 
     foreach (qw(to_string error_to_string from_string)) {
@@ -159,22 +159,22 @@ sub _sanity_check_opts {
     foreach (qw(to_pipe error_to_pipe from_pipe)) {
 	if (exists $opts{$_} and
 	    (!ref($opts{$_}) or (ref($opts{$_}) ne 'SCALAR' and
-				 not $opts{$_}->isa("IO::Handle")))) {
+				 not $opts{$_}->isa('IO::Handle')))) {
 	    internerr("parameter $_ must be a scalar reference or an IO::Handle object");
 	}
     }
 
     if (exists $opts{timeout} and defined($opts{timeout}) and
         $opts{timeout} !~ /^\d+$/) {
-	internerr("parameter timeout must be an integer");
+	internerr('parameter timeout must be an integer');
     }
 
     if (exists $opts{env} and ref($opts{env}) ne 'HASH') {
-	internerr("parameter env must be a hash reference");
+	internerr('parameter env must be a hash reference');
     }
 
     if (exists $opts{delete_env} and ref($opts{delete_env}) ne 'ARRAY') {
-	internerr("parameter delete_env must be an array reference");
+	internerr('parameter delete_env must be an array reference');
     }
 
     return %opts;
@@ -189,7 +189,7 @@ sub spawn {
     } elsif (not ref($opts{exec})) {
 	push @prog, $opts{exec};
     } else {
-	internerr("invalid exec parameter in spawn()");
+	internerr('invalid exec parameter in spawn()');
     }
     my ($from_string_pipe, $to_string_pipe, $error_to_string_pipe);
     if ($opts{to_string}) {
@@ -207,25 +207,25 @@ sub spawn {
     my ($input_pipe, $output_pipe, $error_pipe);
     if ($opts{from_pipe}) {
 	pipe($opts{from_handle}, $input_pipe) ||
-		syserr(_g("pipe for %s"), "@prog");
+		syserr(_g('pipe for %s'), "@prog");
 	${$opts{from_pipe}} = $input_pipe;
 	push @{$opts{close_in_child}}, $input_pipe;
     }
     if ($opts{to_pipe}) {
 	pipe($output_pipe, $opts{to_handle}) ||
-		syserr(_g("pipe for %s"), "@prog");
+		syserr(_g('pipe for %s'), "@prog");
 	${$opts{to_pipe}} = $output_pipe;
 	push @{$opts{close_in_child}}, $output_pipe;
     }
     if ($opts{error_to_pipe}) {
 	pipe($error_pipe, $opts{error_to_handle}) ||
-		syserr(_g("pipe for %s"), "@prog");
+		syserr(_g('pipe for %s'), "@prog");
 	${$opts{error_to_pipe}} = $error_pipe;
 	push @{$opts{close_in_child}}, $error_pipe;
     }
     # Fork and exec
     my $pid = fork();
-    syserr(_g("cannot fork for %s"), "@prog") unless defined $pid;
+    syserr(_g('cannot fork for %s'), "@prog") unless defined $pid;
     if (not $pid) {
 	# Define environment variables
 	if ($opts{env}) {
@@ -238,36 +238,36 @@ sub spawn {
 	}
 	# Change the current directory
 	if ($opts{chdir}) {
-	    chdir($opts{chdir}) || syserr(_g("chdir to %s"), $opts{chdir});
+	    chdir($opts{chdir}) || syserr(_g('chdir to %s'), $opts{chdir});
 	}
 	# Redirect STDIN if needed
 	if ($opts{from_file}) {
-	    open(STDIN, "<", $opts{from_file}) ||
-		syserr(_g("cannot open %s"), $opts{from_file});
+	    open(STDIN, '<', $opts{from_file}) ||
+		syserr(_g('cannot open %s'), $opts{from_file});
 	} elsif ($opts{from_handle}) {
-	    open(STDIN, "<&", $opts{from_handle}) || syserr(_g("reopen stdin"));
+	    open(STDIN, '<&', $opts{from_handle}) || syserr(_g('reopen stdin'));
 	    close($opts{from_handle}); # has been duped, can be closed
 	}
 	# Redirect STDOUT if needed
 	if ($opts{to_file}) {
-	    open(STDOUT, ">", $opts{to_file}) ||
-		syserr(_g("cannot write %s"), $opts{to_file});
+	    open(STDOUT, '>', $opts{to_file}) ||
+		syserr(_g('cannot write %s'), $opts{to_file});
 	} elsif ($opts{to_handle}) {
-	    open(STDOUT, ">&", $opts{to_handle}) || syserr(_g("reopen stdout"));
+	    open(STDOUT, '>&', $opts{to_handle}) || syserr(_g('reopen stdout'));
 	    close($opts{to_handle}); # has been duped, can be closed
 	}
 	# Redirect STDERR if needed
 	if ($opts{error_to_file}) {
-	    open(STDERR, ">", $opts{error_to_file}) ||
-		syserr(_g("cannot write %s"), $opts{error_to_file});
+	    open(STDERR, '>', $opts{error_to_file}) ||
+		syserr(_g('cannot write %s'), $opts{error_to_file});
 	} elsif ($opts{error_to_handle}) {
-	    open(STDERR, ">&", $opts{error_to_handle}) || syserr(_g("reopen stdout"));
+	    open(STDERR, '>&', $opts{error_to_handle}) || syserr(_g('reopen stdout'));
 	    close($opts{error_to_handle}); # has been duped, can be closed
 	}
 	# Close some inherited filehandles
 	close($_) foreach (@{$opts{close_in_child}});
 	# Execute the program
-	exec({ $prog[0] } @prog) or syserr(_g("unable to execute %s"), "@prog");
+	exec({ $prog[0] } @prog) or syserr(_g('unable to execute %s'), "@prog");
     }
     # Close handle that we can't use any more
     close($opts{from_handle}) if exists $opts{from_handle};
@@ -335,12 +335,12 @@ with an error message.
 
 sub wait_child {
     my ($pid, %opts) = @_;
-    $opts{cmdline} ||= _g("child process");
-    internerr("no PID set, cannot wait end of process") unless $pid;
+    $opts{cmdline} ||= _g('child process');
+    internerr('no PID set, cannot wait end of process') unless $pid;
     eval {
         local $SIG{ALRM} = sub { die "alarm\n" };
         alarm($opts{timeout}) if defined($opts{timeout});
-        $pid == waitpid($pid, 0) or syserr(_g("wait for %s"), $opts{cmdline});
+        $pid == waitpid($pid, 0) or syserr(_g('wait for %s'), $opts{cmdline});
         alarm(0) if defined($opts{timeout});
     };
     if ($@) {

+ 7 - 7
scripts/Dpkg/Index.pm

@@ -18,7 +18,7 @@ package Dpkg::Index;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
@@ -100,18 +100,18 @@ sub set_options {
 	    $self->{get_key_func} = sub { return $_[0]->{Source}; };
         } elsif ($t == CTRL_CHANGELOG) {
 	    $self->{get_key_func} = sub {
-		return $_[0]->{Source} . "_" . $_[0]->{Version};
+		return $_[0]->{Source} . '_' . $_[0]->{Version};
 	    };
         } elsif ($t == CTRL_FILE_CHANGES) {
 	    $self->{get_key_func} = sub {
-		return $_[0]->{Source} . "_" . $_[0]->{Version} . "_" .
+		return $_[0]->{Source} . '_' . $_[0]->{Version} . '_' .
 		       $_[0]->{Architecture};
 	    };
         } elsif ($t == CTRL_FILE_VENDOR) {
 	    $self->{get_key_func} = sub { return $_[0]->{Vendor}; };
         } elsif ($t == CTRL_FILE_STATUS) {
 	    $self->{get_key_func} = sub {
-		return $_[0]->{Package} . "_" . $_[0]->{Architecture};
+		return $_[0]->{Package} . '_' . $_[0]->{Architecture};
 	    };
         }
     }
@@ -219,11 +219,11 @@ sub get_keys {
     my ($self, %crit) = @_;
     my @selected = @{$self->{order}};
     foreach my $s_crit (keys %crit) { # search criteria
-	if (ref($crit{$s_crit}) eq "Regexp") {
+	if (ref($crit{$s_crit}) eq 'Regexp') {
 	    @selected = grep {
 		$self->{items}{$_}{$s_crit} =~ $crit{$s_crit}
 	    } @selected;
-	} elsif (ref($crit{$s_crit}) eq "CODE") {
+	} elsif (ref($crit{$s_crit}) eq 'CODE') {
 	    @selected = grep {
 		&{$crit{$s_crit}}($self->{items}{$_}{$s_crit});
 	    } @selected;
@@ -330,7 +330,7 @@ Print the string representation of the index to a filehandle.
 
 sub output {
     my ($self, $fh) = @_;
-    my $str = "";
+    my $str = '';
     foreach my $key ($self->get_keys()) {
 	if (defined $fh) {
 	    print $fh $self->get_by_key($key) . "\n";

+ 16 - 16
scripts/Dpkg/Interface/Storable.pm

@@ -18,7 +18,7 @@ package Dpkg::Interface::Storable;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
@@ -75,20 +75,20 @@ standard input is read (no compression is allowed in that case).
 
 sub load {
     my ($self, $file, @options) = @_;
-    unless ($self->can("parse")) {
-	internerr("%s cannot be loaded, it lacks the parse method", ref($self));
+    unless ($self->can('parse')) {
+	internerr('%s cannot be loaded, it lacks the parse method', ref($self));
     }
     my ($desc, $fh) = ($file, undef);
-    if ($file eq "-") {
+    if ($file eq '-') {
 	$fh = \*STDIN;
-	$desc = _g("<standard input>");
+	$desc = _g('<standard input>');
     } else {
 	$fh = Dpkg::Compression::FileHandle->new();
-	open($fh, "<", $file) || syserr(_g("cannot read %s"), $file);
+	open($fh, '<', $file) || syserr(_g('cannot read %s'), $file);
     }
     my $res = $self->parse($fh, $desc, @options);
-    if ($file ne "-") {
-	close($fh) || syserr(_g("cannot close %s"), $file);
+    if ($file ne '-') {
+	close($fh) || syserr(_g('cannot close %s'), $file);
     }
     return $res;
 }
@@ -104,19 +104,19 @@ standard output is used (data are written uncompressed in that case).
 
 sub save {
     my ($self, $file, @options) = @_;
-    unless ($self->can("output")) {
-	internerr("%s cannot be saved, it lacks the output method", ref($self));
+    unless ($self->can('output')) {
+	internerr('%s cannot be saved, it lacks the output method', ref($self));
     }
     my $fh;
-    if ($file eq "-") {
+    if ($file eq '-') {
 	$fh = \*STDOUT;
     } else {
 	$fh = Dpkg::Compression::FileHandle->new();
-	open($fh, ">", $file) || syserr(_g("cannot write %s"), $file);
+	open($fh, '>', $file) || syserr(_g('cannot write %s'), $file);
     }
     $self->output($fh, @options);
-    if ($file ne "-") {
-	close($fh) || syserr(_g("cannot close %s"), $file);
+    if ($file ne '-') {
+	close($fh) || syserr(_g('cannot close %s'), $file);
     }
 }
 
@@ -128,8 +128,8 @@ Return a string representation of the object.
 
 sub _stringify {
     my ($self) = @_;
-    unless ($self->can("output")) {
-	internerr("%s cannot be stringified, it lacks the output method", ref($self));
+    unless ($self->can('output')) {
+	internerr('%s cannot be stringified, it lacks the output method', ref($self));
     }
     return $self->output();
 }

+ 3 - 3
scripts/Dpkg/Package.pm

@@ -19,7 +19,7 @@ package Dpkg::Package;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use Dpkg::Gettext;
 
@@ -30,11 +30,11 @@ sub pkg_name_is_illegal($) {
     my $name = shift || '';
 
     $name eq '' &&
-        return _g("may not be empty string");
+        return _g('may not be empty string');
     $name =~ m/[^-+.0-9a-z]/o &&
         return sprintf(_g("character '%s' not allowed"), $&);
     $name =~ m/^[0-9a-z]/o ||
-        return _g("must start with an alphanumeric character");
+        return _g('must start with an alphanumeric character');
 
     return;
 }

+ 9 - 9
scripts/Dpkg/Path.pm

@@ -19,7 +19,7 @@ package Dpkg::Path;
 use strict;
 use warnings;
 
-our $VERSION = "1.02";
+our $VERSION = '1.02';
 
 use base qw(Exporter);
 use File::Spec;
@@ -79,7 +79,7 @@ sub relative_to_pkg_root($) {
     my $file = shift;
     my $pkg_root = get_pkg_root_dir($file);
     if (defined $pkg_root) {
-	$pkg_root .= "/";
+	$pkg_root .= '/';
 	return $file if ($file =~ s/^\Q$pkg_root\E//);
     }
     return;
@@ -108,7 +108,7 @@ sub guess_pkg_root_dir($) {
     while ($file) {
 	$parent =~ s{/+[^/]+$}{};
 	last if not -d $parent;
-	return $file if check_files_are_the_same("debian", $parent);
+	return $file if check_files_are_the_same('debian', $parent);
 	$file = $parent;
 	last if $file !~ m{/};
     }
@@ -156,8 +156,8 @@ sub canonpath($) {
     my @new;
     foreach my $d (@dirs) {
 	if ($d eq '..') {
-	    if (scalar(@new) > 0 and $new[-1] ne "..") {
-		next if $new[-1] eq ""; # Root directory has no parent
+	    if (scalar(@new) > 0 and $new[-1] ne '..') {
+		next if $new[-1] eq ''; # Root directory has no parent
 		my $parent = File::Spec->catpath($v,
 			File::Spec->catdir(@new), '');
 		if (not -l $parent) {
@@ -191,7 +191,7 @@ sub resolve_symlink($) {
     } else {
 	my ($link_v, $link_d, $link_f) = File::Spec->splitpath($symlink);
 	my ($cont_v, $cont_d, $cont_f) = File::Spec->splitpath($content);
-	my $new = File::Spec->catpath($link_v, $link_d . "/" . $cont_d, $cont_f);
+	my $new = File::Spec->catpath($link_v, $link_d . '/' . $cont_d, $cont_f);
 	return canonpath($new);
     }
 }
@@ -231,15 +231,15 @@ Return the path of all available control files for the given package.
 sub get_control_path($;$) {
     my ($pkg, $filetype) = @_;
     my $control_file;
-    my @exec = ("dpkg-query", "--control-path", $pkg);
+    my @exec = ('dpkg-query', '--control-path', $pkg);
     push @exec, $filetype if defined $filetype;
     spawn(exec => \@exec, wait_child => 1, to_string => \$control_file);
     chomp($control_file);
     if (defined $filetype) {
-	return if $control_file eq "";
+	return if $control_file eq '';
 	return $control_file;
     }
-    return () if $control_file eq "";
+    return () if $control_file eq '';
     return split(/\n/, $control_file);
 }
 

+ 4 - 4
scripts/Dpkg/Shlibs.pm

@@ -18,7 +18,7 @@ package Dpkg::Shlibs;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use base qw(Exporter);
 our @EXPORT_OK = qw(@librarypaths find_library);
@@ -75,12 +75,12 @@ if ($ENV{LD_LIBRARY_PATH}) {
 }
 
 # Update library paths with ld.so config
-parse_ldso_conf("/etc/ld.so.conf") if -e "/etc/ld.so.conf";
+parse_ldso_conf('/etc/ld.so.conf') if -e '/etc/ld.so.conf';
 
 my %visited;
 sub parse_ldso_conf {
     my $file = shift;
-    open my $fh, "<", $file or syserr(_g("cannot open %s"), $file);
+    open my $fh, '<', $file or syserr(_g('cannot open %s'), $file);
     $visited{$file}++;
     while (<$fh>) {
 	next if /^\s*$/;
@@ -105,7 +105,7 @@ sub parse_ldso_conf {
 # find_library ($soname, \@rpath, $format, $root)
 sub find_library {
     my ($lib, $rpath, $format, $root) = @_;
-    $root //= "";
+    $root //= '';
     $root =~ s{/+$}{};
     my @rpath = @{$rpath};
     foreach my $dir (@rpath, @librarypaths) {

+ 5 - 5
scripts/Dpkg/Shlibs/Cppfilt.pm

@@ -18,7 +18,7 @@ package Dpkg::Shlibs::Cppfilt;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use base 'Exporter';
 
@@ -34,7 +34,7 @@ our @EXPORT_OK = qw(cppfilt_demangle);
 my %cppfilts;
 
 sub get_cppfilt {
-    my $type = shift || "auto";
+    my $type = shift || 'auto';
 
     # Fork c++filt process for demangling $type unless it is forked already.
     # Keeping c++filt running improves performance a lot.
@@ -43,11 +43,11 @@ sub get_cppfilt {
 	$filt = $cppfilts{$type};
     } else {
 	$filt = { from => undef, to => undef,
-	            last_symbol => "", last_result => "" };
+	            last_symbol => '', last_result => '' };
 	$filt->{pid} = spawn(exec => [ 'c++filt', "--format=$type" ],
 	                     from_pipe => \$filt->{from},
 	                     to_pipe => \$filt->{to});
-	internerr(_g("unable to execute %s"), "c++filt")
+	internerr(_g('unable to execute %s'), 'c++filt')
 	    unless defined $filt->{from};
 	$filt->{from}->autoflush(1);
 
@@ -95,7 +95,7 @@ sub terminate_cppfilts {
 	next if not defined $cppfilts{$_}{pid};
 	close $cppfilts{$_}{from};
 	close $cppfilts{$_}{to};
-	wait_child($cppfilts{$_}{pid}, cmdline => "c++filt",
+	wait_child($cppfilts{$_}{pid}, cmdline => 'c++filt',
 	                               nocheck => 1,
 	                               timeout => 5);
 	delete $cppfilts{$_};

+ 30 - 30
scripts/Dpkg/Shlibs/Objdump.pm

@@ -24,12 +24,12 @@ use Dpkg::Path qw(find_command);
 use Dpkg::Arch qw(debarch_to_gnutriplet get_build_arch get_host_arch);
 use Dpkg::IPC;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 # Decide which objdump to call
-our $OBJDUMP = "objdump";
+our $OBJDUMP = 'objdump';
 if (get_build_arch() ne get_host_arch()) {
-    my $od = debarch_to_gnutriplet(get_host_arch()) . "-objdump";
+    my $od = debarch_to_gnutriplet(get_host_arch()) . '-objdump';
     $OBJDUMP = $od if find_command($od);
 }
 
@@ -91,11 +91,11 @@ sub has_object {
 	    return $format{$file};
 	} else {
 	    my ($output, %opts, $pid, $res);
-	    if ($OBJDUMP ne "objdump") {
-		$opts{error_to_file} = "/dev/null";
+	    if ($OBJDUMP ne 'objdump') {
+		$opts{error_to_file} = '/dev/null';
 	    }
-	    $pid = spawn(exec => [ $OBJDUMP, "-a", "--", $file ],
-			 env => { LC_ALL => "C" },
+	    $pid = spawn(exec => [ $OBJDUMP, '-a', '--', $file ],
+			 env => { LC_ALL => 'C' },
 			 to_pipe => \$output, %opts);
 	    while (<$output>) {
 		chomp;
@@ -108,8 +108,8 @@ sub has_object {
 	    close($output);
 	    wait_child($pid, nocheck => 1);
 	    if ($?) {
-		subprocerr("objdump") if $OBJDUMP eq "objdump";
-		local $OBJDUMP = "objdump";
+		subprocerr('objdump') if $OBJDUMP eq 'objdump';
+		local $OBJDUMP = 'objdump';
 		$res = get_format($file);
 	    }
 	    return $res;
@@ -119,8 +119,8 @@ sub has_object {
 
 sub is_elf {
     my ($file) = @_;
-    open(my $file_fh, "<", $file) || syserr(_g("cannot read %s"), $file);
-    my ($header, $result) = ("", 0);
+    open(my $file_fh, '<', $file) || syserr(_g('cannot read %s'), $file);
+    my ($header, $result) = ('', 0);
     if (read($file_fh, $header, 4) == 4) {
 	$result = 1 if ($header =~ /^\177ELF$/);
     }
@@ -177,8 +177,8 @@ sub analyze {
     $self->{file} = $file;
 
     local $ENV{LC_ALL} = 'C';
-    open(my $objdump, "-|", $OBJDUMP, "-w", "-f", "-p", "-T", "-R", $file)
-	|| syserr(_g("cannot fork for %s"), $OBJDUMP);
+    open(my $objdump, '-|', $OBJDUMP, '-w', '-f', '-p', '-T', '-R', $file)
+	|| syserr(_g('cannot fork for %s'), $OBJDUMP);
     my $ret = $self->parse_objdump_output($objdump);
     close($objdump);
     return $ret;
@@ -187,41 +187,41 @@ sub analyze {
 sub parse_objdump_output {
     my ($self, $fh) = @_;
 
-    my $section = "none";
+    my $section = 'none';
     while (defined($_ = <$fh>)) {
 	chomp;
 	next if /^\s*$/;
 
 	if (/^DYNAMIC SYMBOL TABLE:/) {
-	    $section = "dynsym";
+	    $section = 'dynsym';
 	    next;
 	} elsif (/^DYNAMIC RELOCATION RECORDS/) {
-	    $section = "dynreloc";
+	    $section = 'dynreloc';
 	    $_ = <$fh>; # Skip header
 	    next;
 	} elsif (/^Dynamic Section:/) {
-	    $section = "dyninfo";
+	    $section = 'dyninfo';
 	    next;
 	} elsif (/^Program Header:/) {
-	    $section = "header";
+	    $section = 'header';
 	    next;
 	} elsif (/^Version definitions:/) {
-	    $section = "verdef";
+	    $section = 'verdef';
 	    next;
 	} elsif (/^Version References:/) {
-	    $section = "verref";
+	    $section = 'verref';
 	    next;
 	}
 
-	if ($section eq "dynsym") {
+	if ($section eq 'dynsym') {
 	    $self->parse_dynamic_symbol($_);
-	} elsif ($section eq "dynreloc") {
+	} elsif ($section eq 'dynreloc') {
 	    if (/^\S+\s+(\S+)\s+(\S+)\s*$/) {
 		$self->{dynrelocs}{$2} = $1;
 	    } else {
 		warning(_g("Couldn't parse dynamic relocation record: %s"), $_);
 	    }
-	} elsif ($section eq "dyninfo") {
+	} elsif ($section eq 'dyninfo') {
 	    if (/^\s*NEEDED\s+(\S+)/) {
 		push @{$self->{NEEDED}}, $1;
 	    } elsif (/^\s*SONAME\s+(\S+)/) {
@@ -240,7 +240,7 @@ sub parse_objdump_output {
                     $self->{RPATH} = [ split (/:/, $1) ];
                 }
 	    }
-	} elsif ($section eq "none") {
+	} elsif ($section eq 'none') {
 	    if (/^\s*.+:\s*file\s+format\s+(\S+)\s*$/) {
 		$self->{format} = $1;
 	    } elsif (/^architecture:\s*\S+,\s*flags\s*\S+:\s*$/) {
@@ -258,7 +258,7 @@ sub parse_objdump_output {
     # been parsed after the symbols...
     $self->apply_relocations();
 
-    return $section ne "none";
+    return $section ne 'none';
 }
 
 # Output format of objdump -w -T
@@ -310,12 +310,12 @@ sub parse_dynamic_symbol {
 		name => $name,
 		version => defined($ver) ? $ver : '',
 		section => $sect,
-		dynamic => substr($flags, 5, 1) eq "D",
-		debug => substr($flags, 5, 1) eq "d",
+		dynamic => substr($flags, 5, 1) eq 'D',
+		debug => substr($flags, 5, 1) eq 'd',
 		type => substr($flags, 6, 1),
-		weak => substr($flags, 1, 1) eq "w",
-		local => substr($flags, 0, 1) eq "l",
-		global => substr($flags, 0, 1) eq "g",
+		weak => substr($flags, 1, 1) eq 'w',
+		local => substr($flags, 0, 1) eq 'l',
+		global => substr($flags, 0, 1) eq 'g',
 		visibility => defined($vis) ? $vis : '',
 		hidden => '',
 		defined => $sect ne '*UND*'

+ 19 - 19
scripts/Dpkg/Shlibs/Symbol.pm

@@ -19,7 +19,7 @@ package Dpkg::Shlibs::Symbol;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use Dpkg::Gettext;
 use Dpkg::Deps;
@@ -66,7 +66,7 @@ sub parse_tagspec {
 	# (tag1=t1 value|tag2|...|tagN=tNp)
 	# Symbols ()|= cannot appear in the tag names and values
 	my $tagspec = $1;
-	my $rest = ($2) ? $2 : "";
+	my $rest = ($2) ? $2 : '';
 	my @tags = split(/\|/, $tagspec);
 
 	# Parse each tag
@@ -108,7 +108,7 @@ sub parse_symbolspec {
 		$rest = $2;
 	    }
 	}
-	error(_g("symbol name unspecified: %s"), $symbolspec) if (!$symbol);
+	error(_g('symbol name unspecified: %s'), $symbolspec) if (!$symbol);
     } else {
 	# No tag specification. Symbol name is up to the first space
 	# foobarsymbol@Base 1.0 1
@@ -155,8 +155,8 @@ sub initialize {
     # Support old style wildcard syntax. That's basically a symver
     # with an optional tag.
     if ($self->get_symbolname() =~ /^\*@(.*)$/) {
-	$self->add_tag("symver") unless $self->has_tag("symver");
-	$self->add_tag("optional") unless $self->has_tag("optional");
+	$self->add_tag('symver') unless $self->has_tag('symver');
+	$self->add_tag('optional') unless $self->has_tag('optional');
 	$self->{symbol} = $1;
     }
 
@@ -164,7 +164,7 @@ sub initialize {
 	# Each symbol is matched against its version rather than full
 	# name@version string.
 	$type = (defined $type) ? 'generic' : 'alias-symver';
-	if ($self->get_symbolname() eq "Base") {
+	if ($self->get_symbolname() eq 'Base') {
 	    error(_g("you can't use symver tag to catch unversioned symbols: %s"),
 	          $self->get_symbolspec(1));
 	}
@@ -282,12 +282,12 @@ sub equals {
 
 sub is_optional {
     my $self = shift;
-    return $self->has_tag("optional");
+    return $self->has_tag('optional');
 }
 
 sub is_arch_specific {
     my $self = shift;
-    return $self->has_tag("arch");
+    return $self->has_tag('arch');
 }
 
 sub arch_is_concerned {
@@ -297,7 +297,7 @@ sub arch_is_concerned {
     if (defined $arch && defined $arches) {
 	my $dep = Dpkg::Deps::Simple->new();
 	my @arches = split(/[\s,]+/, $arches);
-	$dep->{package} = "dummy";
+	$dep->{package} = 'dummy';
 	$dep->{arches} = \@arches;
 	return $dep->arch_is_concerned($arch);
     }
@@ -328,13 +328,13 @@ sub is_pattern {
 
 # Get pattern type if this symbol is a pattern.
 sub get_pattern_type {
-    return $_[0]->{pattern}{type} || "";
+    return $_[0]->{pattern}{type} || '';
 }
 
 # Get (sub)type of the alias pattern. Returns empty string if current
 # pattern is not alias.
 sub get_alias_type {
-    return ($_[0]->get_pattern_type() =~ /^alias-(.+)/ && $1) || "";
+    return ($_[0]->get_pattern_type() =~ /^alias-(.+)/ && $1) || '';
 }
 
 # Get a list of symbols matching this pattern if this symbol is a pattern
@@ -377,7 +377,7 @@ sub convert_to_alias {
 	    # In case of symver, alias is symbol version. Extract it from the
 	    # rawname.
 	    return "$1" if ($rawname =~ /\@([^@]+)$/);
-	} elsif ($rawname =~ /^_Z/ && $type eq "c++") {
+	} elsif ($rawname =~ /^_Z/ && $type eq 'c++') {
 	    return cppfilt_demangle_cpp($rawname);
 	}
     }
@@ -391,26 +391,26 @@ sub get_tagspec {
 	for my $tagname (@{$self->{tagorder}}) {
 	    my $tagval = $self->{tags}{$tagname};
 	    if (defined $tagval) {
-		push @tags, $tagname . "="  . $tagval;
+		push @tags, $tagname . '='  . $tagval;
 	    } else {
 		push @tags, $tagname;
 	    }
 	}
-	return "(". join("|", @tags) . ")";
+	return '(' . join('|', @tags) . ')';
     }
-    return "";
+    return '';
 }
 
 sub get_symbolspec {
     my $self = shift;
     my $template_mode = shift;
-    my $spec = "";
+    my $spec = '';
     $spec .= "#MISSING: $self->{deprecated}#" if $self->{deprecated};
-    $spec .= " ";
+    $spec .= ' ';
     if ($template_mode) {
 	if ($self->has_tags()) {
 	    $spec .= sprintf('%s%3$s%s%3$s', $self->get_tagspec(),
-		$self->get_symboltempl(), $self->{symbol_quoted} || "");
+		$self->get_symboltempl(), $self->{symbol_quoted} || '');
 	} else {
 	    $spec .= $self->get_symboltempl();
 	}
@@ -487,7 +487,7 @@ sub matches_rawname {
 	for my $tag (@{$self->{tagorder}}) {
 	    if (grep { $tag eq $_ } ALIAS_TYPES) {
 		$ok = not not ($target = $self->convert_to_alias($target, $tag));
-	    } elsif ($tag eq "regex") {
+	    } elsif ($tag eq 'regex') {
 		# Symbol name is a regex. Match it against the target
 		$do_eq_match = 0;
 		$ok = ($target =~ $self->{pattern}{regex});

+ 12 - 12
scripts/Dpkg/Shlibs/SymbolFile.pm

@@ -19,7 +19,7 @@ package Dpkg::Shlibs::SymbolFile;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
@@ -215,7 +215,7 @@ sub parse {
 
 	if (/^(?:\s+|#(?:DEPRECATED|MISSING): ([^#]+)#\s*)(.*)/) {
 	    if (not defined ($$obj_ref)) {
-		error(_g("symbol information must be preceded by a header (file %s, line %s)"), $file, $.);
+		error(_g('symbol information must be preceded by a header (file %s, line %s)'), $file, $.);
 	    }
 	    # Symbol specification
 	    my $deprecated = ($1) ? $1 : 0;
@@ -223,7 +223,7 @@ sub parse {
 	    if ($self->create_symbol($2, base => $sym)) {
 		$self->add_symbol($sym, $$obj_ref);
 	    } else {
-		warning(_g("Failed to parse line in %s: %s"), $file, $_);
+		warning(_g('Failed to parse line in %s: %s'), $file, $_);
 	    }
 	} elsif (/^(\(.*\))?#include\s+"([^"]+)"/) {
 	    my $tagspec = $1;
@@ -255,7 +255,7 @@ sub parse {
 		$self->create_object($$obj_ref, "$2");
 	    }
 	} else {
-	    warning(_g("Failed to parse a line in %s: %s"), $file, $_);
+	    warning(_g('Failed to parse a line in %s: %s'), $file, $_);
 	}
     }
     delete $seen->{$file};
@@ -268,7 +268,7 @@ sub merge_object_from_symfile {
     if (not $self->has_object($objid)) {
         $self->{objects}{$objid} = $src->get_object($objid);
     } else {
-        warning(_g("tried to merge the same object (%s) twice in a symfile"), $objid);
+        warning(_g('tried to merge the same object (%s) twice in a symfile'), $objid);
     }
 }
 
@@ -277,7 +277,7 @@ sub output {
     $opts{template_mode} = 0 unless exists $opts{template_mode};
     $opts{with_deprecated} = 1 unless exists $opts{with_deprecated};
     $opts{with_pattern_matches} = 0 unless exists $opts{with_pattern_matches};
-    my $res = "";
+    my $res = '';
     foreach my $soname (sort $self->get_sonames()) {
 	my @deps = $self->get_dependencies($soname);
 	my $dep = shift @deps;
@@ -320,8 +320,8 @@ sub output {
 		for my $match (sort { $a->get_symboltempl() cmp
 		                      $b->get_symboltempl() } $sym->get_pattern_matches())
 		{
-		    print $fh "#MATCH:", $match->get_symbolspec(0), "\n" if defined $fh;
-		    $res .= "#MATCH:" . $match->get_symbolspec(0) . "\n" if defined wantarray;
+		    print $fh '#MATCH:', $match->get_symbolspec(0), "\n" if defined $fh;
+		    $res .= '#MATCH:' . $match->get_symbolspec(0) . "\n" if defined wantarray;
 		}
 	    }
 	}
@@ -385,14 +385,14 @@ sub find_matching_pattern {
 # machinery
 sub merge_symbols {
     my ($self, $object, $minver) = @_;
-    my $soname = $object->{SONAME} || error(_g("cannot merge symbols from objects without SONAME"));
+    my $soname = $object->{SONAME} || error(_g('cannot merge symbols from objects without SONAME'));
     my %dynsyms;
     foreach my $sym ($object->get_exported_dynamic_symbols()) {
         my $name = $sym->{name} . '@' .
-                   ($sym->{version} ? $sym->{version} : "Base");
+                   ($sym->{version} ? $sym->{version} : 'Base');
         my $symobj = $self->lookup_symbol($name, $soname);
         if (exists $blacklist{$sym->{name}}) {
-            next unless (defined $symobj and $symobj->has_tag("ignore-blacklist"));
+            next unless (defined $symobj and $symobj->has_tag('ignore-blacklist'));
         }
         $dynsyms{$name} = $sym;
     }
@@ -544,7 +544,7 @@ sub lookup_pattern {
 		    if (exists $obj->{patterns}{aliases}{$type}) {
 			$pat = $obj->{patterns}{aliases}{$type}{$refpat->get_symbolname()};
 		    }
-		} elsif ($refpat->get_pattern_type() eq "generic") {
+		} elsif ($refpat->get_pattern_type() eq 'generic') {
 		    for my $p (@{$obj->{patterns}{generic}}) {
 			if (($inc_deprecated || !$p->{deprecated}) &&
 			    $p->equals($refpat, versioning => 0))

+ 15 - 15
scripts/Dpkg/Source/Archive.pm

@@ -18,7 +18,7 @@ package Dpkg::Source::Archive;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use Dpkg::Source::Functions qw(erasedir fixperms);
 use Dpkg::Gettext;
@@ -42,11 +42,11 @@ sub create {
         *$self->{chdir} = $opts{chdir};
     }
     # Redirect input/output appropriately
-    $self->ensure_open("w");
+    $self->ensure_open('w');
     $spawn_opts{to_handle} = $self->get_filehandle();
     $spawn_opts{from_pipe} = \*$self->{tar_input};
     # Call tar creation process
-    $spawn_opts{delete_env} = [ "TAR_OPTIONS" ];
+    $spawn_opts{delete_env} = [ 'TAR_OPTIONS' ];
     $spawn_opts{exec} = [ 'tar', '--null', '-T', '-', '--numeric-owner',
                             '--owner', '0', '--group', '0',
                             @{$opts{options}}, '-cf', '-' ];
@@ -57,10 +57,10 @@ sub create {
 sub _add_entry {
     my ($self, $file) = @_;
     my $cwd = *$self->{cwd};
-    internerr("call create() first") unless *$self->{tar_input};
+    internerr('call create() first') unless *$self->{tar_input};
     $file = $2 if ($file =~ /^\Q$cwd\E\/(.+)$/); # Relative names
     print({ *$self->{tar_input} } "$file\0") ||
-	    syserr(_g("write on tar input"));
+	    syserr(_g('write on tar input'));
 }
 
 sub add_file {
@@ -79,13 +79,13 @@ sub add_directory {
     if (*$self->{chdir}) {
         $testfile = File::Spec->catdir(*$self->{chdir}, $file);
     }
-    internerr("add_directory() only handles directories") unless not -l $testfile and -d _;
+    internerr('add_directory() only handles directories') unless not -l $testfile and -d _;
     $self->_add_entry($file);
 }
 
 sub finish {
     my ($self) = @_;
-    close(*$self->{tar_input}) or syserr(_g("close on tar input"));
+    close(*$self->{tar_input}) or syserr(_g('close on tar input'));
     wait_child(*$self->{pid}, cmdline => 'tar -cf -');
     delete *$self->{pid};
     delete *$self->{tar_input};
@@ -107,21 +107,21 @@ sub extract {
         $spawn_opts{chdir} = $dest;
         $tmp = $dest; # So that fixperms call works
     } else {
-        my $template = basename($self->get_filename()) .  ".tmp-extract.XXXXX";
+        my $template = basename($self->get_filename()) .  '.tmp-extract.XXXXX';
         unless (-e $dest) {
             # Kludge so that realpath works
-            mkdir($dest) || syserr(_g("cannot create directory %s"), $dest);
+            mkdir($dest) || syserr(_g('cannot create directory %s'), $dest);
         }
         $tmp = tempdir($template, DIR => Cwd::realpath("$dest/.."), CLEANUP => 1);
         $spawn_opts{chdir} = $tmp;
     }
 
     # Prepare stuff that handles the input of tar
-    $self->ensure_open("r");
+    $self->ensure_open('r');
     $spawn_opts{from_handle} = $self->get_filehandle();
 
     # Call tar extraction process
-    $spawn_opts{delete_env} = [ "TAR_OPTIONS" ];
+    $spawn_opts{delete_env} = [ 'TAR_OPTIONS' ];
     $spawn_opts{exec} = [ 'tar', '--no-same-owner', '--no-same-permissions',
                             @{$opts{options}}, '-xf', '-' ];
     spawn(%spawn_opts);
@@ -141,18 +141,18 @@ sub extract {
     return if $opts{in_place};
 
     # Rename extracted directory
-    opendir(my $dir_dh, $tmp) || syserr(_g("cannot opendir %s"), $tmp);
-    my @entries = grep { $_ ne "." && $_ ne ".." } readdir($dir_dh);
+    opendir(my $dir_dh, $tmp) || syserr(_g('cannot opendir %s'), $tmp);
+    my @entries = grep { $_ ne '.' && $_ ne '..' } readdir($dir_dh);
     closedir($dir_dh);
     my $done = 0;
     erasedir($dest);
     if (scalar(@entries) == 1 && ! -l "$tmp/$entries[0]" && -d _) {
 	rename("$tmp/$entries[0]", $dest) ||
-		syserr(_g("Unable to rename %s to %s"),
+		syserr(_g('Unable to rename %s to %s'),
 		       "$tmp/$entries[0]", $dest);
     } else {
 	rename($tmp, $dest) ||
-		syserr(_g("Unable to rename %s to %s"), $tmp, $dest);
+		syserr(_g('Unable to rename %s to %s'), $tmp, $dest);
     }
     erasedir($tmp);
 }

+ 6 - 6
scripts/Dpkg/Source/Functions.pm

@@ -16,7 +16,7 @@ package Dpkg::Source::Functions;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use base qw(Exporter);
 our @EXPORT_OK = qw(erasedir fixperms fs_time is_binary);
@@ -31,7 +31,7 @@ sub erasedir {
     my ($dir) = @_;
     if (not lstat($dir)) {
         return if $! == ENOENT;
-        syserr(_g("cannot stat directory %s (before removal)"), $dir);
+        syserr(_g('cannot stat directory %s (before removal)'), $dir);
     }
     system 'rm','-rf','--',$dir;
     subprocerr("rm -rf $dir") if $?;
@@ -75,14 +75,14 @@ sub fs_time($) {
     my ($file) = @_;
     my $is_temp = 0;
     if (not -e $file) {
-	open(my $temp_fh, ">", $file) or syserr(_g("cannot write %s"));
+	open(my $temp_fh, '>', $file) or syserr(_g('cannot write %s'));
 	close($temp_fh);
 	$is_temp = 1;
     } else {
 	utime(undef, undef, $file) or
-	    syserr(_g("cannot change timestamp for %s"), $file);
+	    syserr(_g('cannot change timestamp for %s'), $file);
     }
-    stat($file) or syserr(_g("cannot read timestamp from %s"), $file);
+    stat($file) or syserr(_g('cannot read timestamp from %s'), $file);
     my $mtime = (stat(_))[9];
     unlink($file) if $is_temp;
     return $mtime;
@@ -112,7 +112,7 @@ sub is_binary($) {
             last;
         }
     }
-    close($diffgen) or syserr("close on diff pipe");
+    close($diffgen) or syserr('close on diff pipe');
     wait_child($diff_pid, nocheck => 1, cmdline => "diff -u -- /dev/null $file");
     return $result;
 }

+ 38 - 38
scripts/Dpkg/Source/Package.pm

@@ -35,7 +35,7 @@ is the one that supports the extraction of the source package.
 use strict;
 use warnings;
 
-our $VERSION = "1.0";
+our $VERSION = '1.0';
 
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
@@ -175,8 +175,8 @@ sub init_options {
     } else {
         $self->{options}{tar_ignore} = [ @tar_ignore_default_pattern ];
     }
-    push @{$self->{options}{tar_ignore}}, "debian/source/local-options",
-         "debian/source/local-patch-header";
+    push @{$self->{options}{tar_ignore}}, 'debian/source/local-options',
+         'debian/source/local-patch-header';
     # Skip debianization while specific to some formats has an impact
     # on code common to all formats
     $self->{options}{skip_debianization} ||= 0;
@@ -185,12 +185,12 @@ sub init_options {
 sub initialize {
     my ($self, $filename) = @_;
     my ($fn, $dir) = fileparse($filename);
-    error(_g("%s is not the name of a file"), $filename) unless $fn;
-    $self->{basedir} = $dir || "./";
+    error(_g('%s is not the name of a file'), $filename) unless $fn;
+    $self->{basedir} = $dir || './';
     $self->{filename} = $fn;
 
     # Check if it contains a signature
-    open(my $dsc_fh, "<", $filename) || syserr(_g("cannot open %s"), $filename);
+    open(my $dsc_fh, '<', $filename) || syserr(_g('cannot open %s'), $filename);
     $self->{is_signed} = 0;
     while (<$dsc_fh>) {
         next if /^\s*$/o;
@@ -205,7 +205,7 @@ sub initialize {
 
     foreach my $f (qw(Source Version Files)) {
         unless (defined($fields->{$f})) {
-            error(_g("missing critical source control field %s"), $f);
+            error(_g('missing critical source control field %s'), $f);
         }
     }
 
@@ -286,12 +286,12 @@ sub get_basename {
     my ($self, $with_revision) = @_;
     my $f = $self->{fields};
     unless (exists $f->{'Source'} and exists $f->{'Version'}) {
-        error(_g("source and version are required to compute the source basename"));
+        error(_g('source and version are required to compute the source basename'));
     }
     my $v = Dpkg::Version->new($f->{'Version'});
-    my $basename = $f->{'Source'} . "_" . $v->version();
+    my $basename = $f->{'Source'} . '_' . $v->version();
     if ($with_revision and $f->{'Version'} =~ /-/) {
-        $basename .= "-" . $v->revision();
+        $basename .= '-' . $v->revision();
     }
     return $basename;
 }
@@ -303,9 +303,9 @@ sub find_original_tarballs {
     $opts{include_supplementary} = 1 unless exists $opts{include_supplementary};
     my $basename = $self->get_basename();
     my @tar;
-    foreach my $dir (".", $self->{basedir}, $self->{options}{origtardir}) {
+    foreach my $dir ('.', $self->{basedir}, $self->{options}{origtardir}) {
         next unless defined($dir) and -d $dir;
-        opendir(my $dir_dh, $dir) || syserr(_g("cannot opendir %s"), $dir);
+        opendir(my $dir_dh, $dir) || syserr(_g('cannot opendir %s'), $dir);
         push @tar, map { "$dir/$_" } grep {
 		($opts{include_main} and
 		 /^\Q$basename\E\.orig\.tar\.$opts{extension}$/) or
@@ -344,17 +344,17 @@ sub check_signature {
     my $dsc = $self->get_filename();
     my @exec;
     if (find_command('gpgv')) {
-        push @exec, "gpgv";
+        push @exec, 'gpgv';
     } elsif (find_command('gpg')) {
-        push @exec, "gpg", "--no-default-keyring", "-q", "--verify";
+        push @exec, 'gpg', '--no-default-keyring', '-q', '--verify';
     }
     if (scalar(@exec)) {
         if (defined $ENV{HOME} and -r "$ENV{HOME}/.gnupg/trustedkeys.gpg") {
-            push @exec, "--keyring", "$ENV{HOME}/.gnupg/trustedkeys.gpg";
+            push @exec, '--keyring', "$ENV{HOME}/.gnupg/trustedkeys.gpg";
         }
         foreach my $vendor_keyring (run_vendor_hook('keyrings')) {
             if (-r $vendor_keyring) {
-                push @exec, "--keyring", $vendor_keyring;
+                push @exec, '--keyring', $vendor_keyring;
             }
         }
         push @exec, $dsc;
@@ -369,9 +369,9 @@ sub check_signature {
             if ($gpg_status == 1 or ($gpg_status &&
                 $self->{options}{require_valid_signature}))
             {
-                error(_g("failed to verify signature on %s"), $dsc);
+                error(_g('failed to verify signature on %s'), $dsc);
             } elsif ($gpg_status) {
-                warning(_g("failed to verify signature on %s"), $dsc);
+                warning(_g('failed to verify signature on %s'), $dsc);
             }
         } else {
             subprocerr("@exec");
@@ -389,7 +389,7 @@ 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));
+            warning(_g('%s is not a valid option for %s'), $_, ref($self));
         }
     }
 }
@@ -416,7 +416,7 @@ sub extract {
     if ($self->{options}{copy_orig_tarballs}) {
         my $basename = $self->get_basename();
         my ($dirname, $destdir) = fileparse($newdirectory);
-        $destdir ||= "./";
+        $destdir ||= './';
 	my $ext = $compression_re_file_ext;
         foreach my $orig (grep { /^\Q$basename\E\.orig(-[[:alnum:]-]+)?\.tar\.$ext$/ }
                           $self->get_files())
@@ -438,40 +438,40 @@ sub extract {
     }
 
     # Store format if non-standard so that next build keeps the same format
-    if ($self->{fields}{'Format'} ne "1.0" and
+    if ($self->{fields}{'Format'} ne '1.0' and
         not $self->{options}{skip_debianization})
     {
-        my $srcdir = File::Spec->catdir($newdirectory, "debian", "source");
-        my $format_file = File::Spec->catfile($srcdir, "format");
+        my $srcdir = File::Spec->catdir($newdirectory, 'debian', 'source');
+        my $format_file = File::Spec->catfile($srcdir, 'format');
 	unless (-e $format_file) {
 	    mkdir($srcdir) unless -e $srcdir;
-	    open(my $format_fh, ">", $format_file) ||
-	        syserr(_g("cannot write %s"), $format_file);
+	    open(my $format_fh, '>', $format_file) ||
+	        syserr(_g('cannot write %s'), $format_file);
 	    print $format_fh $self->{fields}{'Format'} . "\n";
 	    close($format_fh);
 	}
     }
 
     # Make sure debian/rules is executable
-    my $rules = File::Spec->catfile($newdirectory, "debian", "rules");
+    my $rules = File::Spec->catfile($newdirectory, 'debian', 'rules');
     my @s = lstat($rules);
     if (not scalar(@s)) {
         unless ($! == ENOENT) {
-            syserr(_g("cannot stat %s"), $rules);
+            syserr(_g('cannot stat %s'), $rules);
         }
-        warning(_g("%s does not exist"), $rules)
+        warning(_g('%s does not exist'), $rules)
             unless $self->{options}{skip_debianization};
     } elsif (-f _) {
         chmod($s[2] | 0111, $rules) ||
-            syserr(_g("cannot make %s executable"), $rules);
+            syserr(_g('cannot make %s executable'), $rules);
     } else {
-        warning(_g("%s is not a plain file"), $rules);
+        warning(_g('%s is not a plain file'), $rules);
     }
 }
 
 sub do_extract {
     internerr("Dpkg::Source::Package doesn't know how to unpack a " .
-              "source package. Use one of the subclasses.");
+              'source package. Use one of the subclasses.');
 }
 
 # Function used specifically during creation of a source package
@@ -495,12 +495,12 @@ sub after_build {
 
 sub do_build {
     internerr("Dpkg::Source::Package doesn't know how to build a " .
-              "source package. Use one of the subclasses.");
+              'source package. Use one of the subclasses.');
 }
 
 sub can_build {
     my ($self, $dir) = @_;
-    return (0, "can_build() has not been overriden");
+    return (0, 'can_build() has not been overriden');
 }
 
 sub add_file {
@@ -526,7 +526,7 @@ sub commit {
 sub do_commit {
     my ($self, $dir) = @_;
     info(_g("'%s' is not supported by the source format '%s'"),
-         "dpkg-source --commit", $self->{fields}{'Format'});
+         'dpkg-source --commit', $self->{fields}{'Format'});
 }
 
 sub write_dsc {
@@ -540,12 +540,12 @@ sub write_dsc {
     unless($opts{nocheck}) {
         foreach my $f (qw(Source Version)) {
             unless (defined($fields->{$f})) {
-                error(_g("missing information for critical output field %s"), $f);
+                error(_g('missing information for critical output field %s'), $f);
             }
         }
         foreach my $f (qw(Maintainer Architecture Standards-Version)) {
             unless (defined($fields->{$f})) {
-                warning(_g("missing information for output field %s"), $f);
+                warning(_g('missing information for output field %s'), $f);
             }
         }
     }
@@ -556,9 +556,9 @@ sub write_dsc {
 
     my $filename = $opts{filename};
     unless (defined $filename) {
-        $filename = $self->get_basename(1) . ".dsc";
+        $filename = $self->get_basename(1) . '.dsc';
     }
-    open(my $dsc_fh, ">", $filename) || syserr(_g("cannot write %s"), $filename);
+    open(my $dsc_fh, '>', $filename) || syserr(_g('cannot write %s'), $filename);
     $fields->apply_substvars($opts{substvars});
     $fields->output($dsc_fh);
     close($dsc_fh);

+ 46 - 46
scripts/Dpkg/Source/Package/V1.pm

@@ -18,7 +18,7 @@ package Dpkg::Source::Package::V1;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use base 'Dpkg::Source::Package';
 
@@ -38,7 +38,7 @@ use File::Basename;
 use File::Temp qw(tempfile);
 use File::Spec;
 
-our $CURRENT_MINOR_VERSION = "0";
+our $CURRENT_MINOR_VERSION = '0';
 
 sub init_options {
     my ($self) = @_;
@@ -49,8 +49,8 @@ sub init_options {
     } else {
 	$self->{options}{diff_ignore_regexp} = '(?:^|/)debian/source/local-.*$';
     }
-    push @{$self->{options}{tar_ignore}}, "debian/source/local-options",
-         "debian/source/local-patch-header";
+    push @{$self->{options}{tar_ignore}}, 'debian/source/local-options',
+         'debian/source/local-patch-header';
     $self->{options}{sourcestyle} ||= 'X';
     $self->{options}{skip_debianization} ||= 0;
     $self->{options}{abort_on_upstream_changes} ||= 0;
@@ -60,7 +60,7 @@ sub parse_cmdline_option {
     my ($self, $opt) = @_;
     my $o = $self->{options};
     if ($opt =~ m/^-s([akpursnAKPUR])$/) {
-        warning(_g("-s%s option overrides earlier -s%s option"), $1,
+        warning(_g('-s%s option overrides earlier -s%s option'), $1,
                 $o->{sourcestyle}) if $o->{sourcestyle} ne 'X';
         $o->{sourcestyle} = $1;
         $o->{copy_orig_tarballs} = 0 if $1 eq 'n'; # Extract option -sn
@@ -82,7 +82,7 @@ sub do_extract {
 
     $sourcestyle =~ y/X/p/;
     $sourcestyle =~ m/[pun]/ ||
-	usageerr(_g("source handling style -s%s not allowed with -x"),
+	usageerr(_g('source handling style -s%s not allowed with -x'),
 	         $sourcestyle);
 
     my $dscdir = $self->{basedir};
@@ -94,20 +94,20 @@ sub do_extract {
     my ($tarfile, $difffile);
     foreach my $file ($self->get_files()) {
 	if ($file =~ /^(?:\Q$basename\E\.orig|\Q$basenamerev\E)\.tar\.gz$/) {
-            error(_g("multiple tarfiles in v1.0 source package")) if $tarfile;
+            error(_g('multiple tarfiles in v1.0 source package')) if $tarfile;
             $tarfile = $file;
 	} elsif ($file =~ /^\Q$basenamerev\E\.diff\.gz$/) {
 	    $difffile = $file;
 	} else {
-	    error(_g("unrecognized file for a %s source package: %s"),
-                  "v1.0", $file);
+	    error(_g('unrecognized file for a %s source package: %s'),
+                  'v1.0', $file);
 	}
     }
 
-    error(_g("no tarfile in Files field")) unless $tarfile;
+    error(_g('no tarfile in Files field')) unless $tarfile;
     my $native = $difffile ? 0 : 1;
     if ($native and ($tarfile =~ /\.orig\.tar\.gz$/)) {
-        warning(_g("native package with .orig.tar"));
+        warning(_g('native package with .orig.tar'));
         $native = 0; # V3::native doesn't handle orig.tar
     }
 
@@ -124,39 +124,39 @@ sub do_extract {
                            "$newdirectory.tmp-keep");
         }
 
-        info(_g("unpacking %s"), $tarfile);
+        info(_g('unpacking %s'), $tarfile);
         my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile");
         $tar->extract($expectprefix);
 
         if ($sourcestyle =~ /u/) {
             # -su: keep .orig directory unpacked
             if (-e "$newdirectory.tmp-keep") {
-                error(_g("unable to keep orig directory (already exists)"));
+                error(_g('unable to keep orig directory (already exists)'));
             }
             system('cp', '-ar', '--', $expectprefix, "$newdirectory.tmp-keep");
             subprocerr("cp $expectprefix to $newdirectory.tmp-keep") if $?;
         }
 
 	rename($expectprefix, $newdirectory) ||
-	    syserr(_g("failed to rename newly-extracted %s to %s"),
+	    syserr(_g('failed to rename newly-extracted %s to %s'),
 	           $expectprefix, $newdirectory);
 
 	# rename the copied .orig directory
 	if (-e "$newdirectory.tmp-keep") {
 	    rename("$newdirectory.tmp-keep", $expectprefix) ||
-                    syserr(_g("failed to rename saved %s to %s"),
+                    syserr(_g('failed to rename saved %s to %s'),
 	                   "$newdirectory.tmp-keep", $expectprefix);
         }
     }
 
     if ($difffile and not $self->{options}{skip_debianization}) {
         my $patch = "$dscdir$difffile";
-	info(_g("applying %s"), $difffile);
+	info(_g('applying %s'), $difffile);
 	my $patch_obj = Dpkg::Source::Patch->new(filename => $patch);
 	my $analysis = $patch_obj->apply($newdirectory, force_timestamp => 1);
 	my @files = grep { ! m{^\Q$newdirectory\E/debian/} }
 		    sort keys %{$analysis->{filepatched}};
-	info(_g("upstream files that have been modified: %s"),
+	info(_g('upstream files that have been modified: %s'),
 	     "\n " . join("\n ", @files)) if scalar @files;
     }
 }
@@ -165,8 +165,8 @@ sub can_build {
     my ($self, $dir) = @_;
     # As long as we can use gzip, we can do it as we have
     # native packages as fallback
-    return ($self->{options}{compression} eq "gzip",
-            _g("only supports gzip compression"));
+    return ($self->{options}{compression} eq 'gzip',
+            _g('only supports gzip compression'));
 }
 
 sub do_build {
@@ -177,13 +177,13 @@ sub do_build {
     my $diff_ignore_regexp = $self->{options}{diff_ignore_regexp};
 
     if (scalar(@argv) > 1) {
-        usageerr(_g("-b takes at most a directory and an orig source ".
-                    "argument (with v1.0 source package)"));
+        usageerr(_g('-b takes at most a directory and an orig source ' .
+                    'argument (with v1.0 source package)'));
     }
 
     $sourcestyle =~ y/X/A/;
     unless ($sourcestyle =~ m/[akpursnAKPUR]/) {
-        usageerr(_g("source handling style -s%s not allowed with -b"),
+        usageerr(_g('source handling style -s%s not allowed with -b'),
                  $sourcestyle);
     }
 
@@ -195,7 +195,7 @@ sub do_build {
 
     # Try to find a .orig tarball for the package
     my $origdir = "$dir.orig";
-    my $origtargz = $self->get_basename() . ".orig.tar.gz";
+    my $origtargz = $self->get_basename() . '.orig.tar.gz';
     if (-e $origtargz) {
         unless (-f $origtargz) {
             error(_g("packed orig `%s' exists but is not a plain file"), $origtargz);
@@ -210,33 +210,33 @@ sub do_build {
         my $origarg = shift(@argv);
         if (length($origarg)) {
             stat($origarg) ||
-                syserr(_g("cannot stat orig argument %s"), $origarg);
+                syserr(_g('cannot stat orig argument %s'), $origarg);
             if (-d _) {
                 $origdir = File::Spec->catdir($origarg);
 
                 $sourcestyle =~ y/aA/rR/;
                 unless ($sourcestyle =~ m/[ursURS]/) {
-                    error(_g("orig argument is unpacked but source handling " .
-                             "style -s%s calls for packed (.orig.tar.<ext>)"),
+                    error(_g('orig argument is unpacked but source handling ' .
+                             'style -s%s calls for packed (.orig.tar.<ext>)'),
                           $sourcestyle);
                 }
             } elsif (-f _) {
                 $origtargz = $origarg;
                 $sourcestyle =~ y/aA/pP/;
                 unless ($sourcestyle =~ m/[kpsKPS]/) {
-                    error(_g("orig argument is packed but source handling " .
-                             "style -s%s calls for unpacked (.orig/)"),
+                    error(_g('orig argument is packed but source handling ' .
+                             'style -s%s calls for unpacked (.orig/)'),
                           $sourcestyle);
                 }
             } else {
-                error(_g("orig argument %s is not a plain file or directory"),
+                error(_g('orig argument %s is not a plain file or directory'),
                       $origarg);
             }
         } else {
             $sourcestyle =~ y/aA/nn/;
             $sourcestyle =~ m/n/ ||
-                error(_g("orig argument is empty (means no orig, no diff) " .
-                         "but source handling style -s%s wants something"),
+                error(_g('orig argument is empty (means no orig, no diff) ' .
+                         'but source handling style -s%s wants something'),
                       $sourcestyle);
         }
     } elsif ($sourcestyle =~ m/[aA]/) {
@@ -271,8 +271,8 @@ sub do_build {
 	my ($origdirname, $origdirbase) = fileparse($origdir);
 
         if ($origdirname ne "$basedirname.orig") {
-            warning(_g(".orig directory name %s is not <package>" .
-	               "-<upstreamversion> (wanted %s)"),
+            warning(_g('.orig directory name %s is not <package>' .
+	               '-<upstreamversion> (wanted %s)'),
 	            $origdirname, "$basedirname.orig");
         }
         $tardirbase = $origdirbase;
@@ -280,26 +280,26 @@ sub do_build {
 
 	$tarname = $origtargz || "$basename.orig.tar.gz";
 	unless ($tarname =~ /\Q$basename\E\.orig\.tar\.gz/) {
-	    warning(_g(".orig.tar name %s is not <package>_<upstreamversion>" .
-	               ".orig.tar (wanted %s)"),
+	    warning(_g('.orig.tar name %s is not <package>_<upstreamversion>' .
+	               '.orig.tar (wanted %s)'),
 	            $tarname, "$basename.orig.tar.gz");
 	}
     }
 
-    if ($sourcestyle eq "n") {
+    if ($sourcestyle eq 'n') {
         $self->{options}{ARGV} = []; # ensure we have no error
         Dpkg::Source::Package::V3::native::do_build($self, $dir);
     } elsif ($sourcestyle =~ m/[nurUR]/) {
         if (stat($tarname)) {
             unless ($sourcestyle =~ m/[nUR]/) {
 		error(_g("tarfile `%s' already exists, not overwriting, " .
-		         "giving up; use -sU or -sR to override"), $tarname);
+		         'giving up; use -sU or -sR to override'), $tarname);
             }
         } elsif ($! != ENOENT) {
 	    syserr(_g("unable to check for existence of `%s'"), $tarname);
         }
 
-	info(_g("building %s in %s"),
+	info(_g('building %s in %s'),
 	     $sourcepackage, $tarname);
 
 	my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX",
@@ -316,7 +316,7 @@ sub do_build {
 	chmod(0666 &~ umask(), $tarname) ||
 	    syserr(_g("unable to change permission of `%s'"), $tarname);
     } else {
-	info(_g("building %s using existing %s"),
+	info(_g('building %s using existing %s'),
 	     $sourcepackage, $tarname);
     }
 
@@ -326,7 +326,7 @@ sub do_build {
         if (stat($origdir)) {
             unless ($sourcestyle =~ m/[KP]/) {
                 error(_g("orig dir `%s' already exists, not overwriting, ".
-                         "giving up; use -sA, -sK or -sP to override"),
+                         'giving up; use -sA, -sK or -sP to override'),
                       $origdir);
             }
 	    push @Dpkg::Exit::handlers, sub { erasedir($origdir) };
@@ -344,13 +344,13 @@ sub do_build {
     my $ur; # Unrepresentable changes
     if ($sourcestyle =~ m/[kpursKPUR]/) {
 	my $diffname = "$basenamerev.diff.gz";
-	info(_g("building %s in %s"),
+	info(_g('building %s in %s'),
 	     $sourcepackage, $diffname);
 	my ($ndfh, $newdiffgz) = tempfile("$diffname.new.XXXXXX",
 					DIR => getcwd(), UNLINK => 0);
         push @Dpkg::Exit::handlers, sub { unlink($newdiffgz) };
         my $diff = Dpkg::Source::Patch->new(filename => $newdiffgz,
-                                            compression => "gzip");
+                                            compression => 'gzip');
         $diff->create();
         $diff->add_diff_directory($origdir, $dir,
                 basedirname => $basedirname,
@@ -364,11 +364,11 @@ sub do_build {
 	my @files = grep { ! m{^debian/} } map { s{^[^/]+/+}{}; $_ }
 		    sort keys %{$analysis->{filepatched}};
 	if (scalar @files) {
-	    warning(_g("the diff modifies the following upstream files: %s"),
+	    warning(_g('the diff modifies the following upstream files: %s'),
 	            "\n " . join("\n ", @files));
 	    info(_g("use the '3.0 (quilt)' format to have separate and " .
-	            "documented changes to upstream files, see dpkg-source(1)"));
-	    error(_g("aborting due to --abort-on-upstream-changes"))
+	            'documented changes to upstream files, see dpkg-source(1)'));
+	    error(_g('aborting due to --abort-on-upstream-changes'))
 		if $self->{options}{abort_on_upstream_changes};
 	}
 
@@ -386,7 +386,7 @@ sub do_build {
     }
 
     if ($ur) {
-        printf(STDERR _g("%s: unrepresentable changes to source")."\n",
+        printf(STDERR _g('%s: unrepresentable changes to source') . "\n",
                $progname);
         exit(1);
     }

+ 98 - 98
scripts/Dpkg/Source/Package/V2.pm

@@ -18,7 +18,7 @@ package Dpkg::Source::Package::V2;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use base 'Dpkg::Source::Package';
 
@@ -43,7 +43,7 @@ use File::Spec;
 use File::Find;
 use File::Copy;
 
-our $CURRENT_MINOR_VERSION = "0";
+our $CURRENT_MINOR_VERSION = '0';
 
 sub init_options {
     my ($self) = @_;
@@ -120,7 +120,7 @@ sub do_extract {
     my $re_ext = $compression_re_file_ext;
     foreach my $file ($self->get_files()) {
         (my $uncompressed = $file) =~ s/\.$re_ext$//;
-        error(_g("duplicate files in %s source package: %s.*"), "v2.0",
+        error(_g('duplicate files in %s source package: %s.*'), 'v2.0',
               $uncompressed) if $seen{$uncompressed};
         $seen{$uncompressed} = 1;
         if ($file =~ /^\Q$basename\E\.orig\.tar\.$re_ext$/) {
@@ -130,23 +130,23 @@ sub do_extract {
         } elsif ($file =~ /^\Q$basenamerev\E\.debian\.tar\.$re_ext$/) {
             $debianfile = $file;
         } else {
-            error(_g("unrecognized file for a %s source package: %s"),
-            "v2.0", $file);
+            error(_g('unrecognized file for a %s source package: %s'),
+            'v2.0', $file);
         }
     }
 
     unless ($tarfile and $debianfile) {
-        error(_g("missing orig.tar or debian.tar file in v2.0 source package"));
+        error(_g('missing orig.tar or debian.tar file in v2.0 source package'));
     }
 
     erasedir($newdirectory);
 
     # Extract main tarball
-    info(_g("unpacking %s"), $tarfile);
+    info(_g('unpacking %s'), $tarfile);
     my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile");
     $tar->extract($newdirectory, no_fixperms => 1,
-                  options => [ "--anchored", "--no-wildcards-match-slash",
-                               "--exclude", "*/.pc", "--exclude", ".pc" ]);
+                  options => [ '--anchored', '--no-wildcards-match-slash',
+                               '--exclude', '*/.pc', '--exclude', '.pc' ]);
     # The .pc exclusion is only needed for 3.0 (quilt) and to avoid
     # having an upstream tarball provide a directory with symlinks
     # that would be blindly followed when applying the patches
@@ -154,7 +154,7 @@ sub do_extract {
     # Extract additional orig tarballs
     foreach my $subdir (keys %origtar) {
         my $file = $origtar{$subdir};
-        info(_g("unpacking %s"), $file);
+        info(_g('unpacking %s'), $file);
         if (-e "$newdirectory/$subdir") {
             warning(_g("required removal of `%s' installed by original tarball"), $subdir);
             erasedir("$newdirectory/$subdir");
@@ -167,7 +167,7 @@ sub do_extract {
     return if $self->{options}{skip_debianization};
 
     # Extract debian tarball after removing the debian directory
-    info(_g("unpacking %s"), $debianfile);
+    info(_g('unpacking %s'), $debianfile);
     erasedir("$newdirectory/debian");
     # Exclude existing symlinks from extraction of debian.tar.gz as we
     # don't want to overwrite something outside of $newdirectory due to a
@@ -176,7 +176,7 @@ sub do_extract {
     my $wanted = sub {
         return if not -l $_;
         my $fn = File::Spec->abs2rel($_, $newdirectory);
-        push @exclude_symlinks, "--exclude", $fn;
+        push @exclude_symlinks, '--exclude', $fn;
     };
     find({ wanted => $wanted, no_chdir => 1 }, $newdirectory);
     $tar = Dpkg::Source::Archive->new(filename => "$dscdir$debianfile");
@@ -190,7 +190,7 @@ sub do_extract {
 }
 
 sub get_autopatch_name {
-    return "zz_debian-diff-auto";
+    return 'zz_debian-diff-auto';
 }
 
 sub get_patches {
@@ -200,7 +200,7 @@ sub get_patches {
     my $pd = "$dir/debian/patches";
     my $auto_patch = $self->get_autopatch_name();
     if (-d $pd) {
-        opendir(my $dir_dh, $pd) || syserr(_g("cannot opendir %s"), $pd);
+        opendir(my $dir_dh, $pd) || syserr(_g('cannot opendir %s'), $pd);
         foreach my $patch (sort readdir($dir_dh)) {
             # patches match same rules as run-parts
             next unless $patch =~ /^[\w-]+$/ and -f "$pd/$patch";
@@ -217,14 +217,14 @@ sub apply_patches {
     $opts{skip_auto} //= 0;
     my @patches = $self->get_patches($dir, %opts);
     return unless scalar(@patches);
-    my $applied = File::Spec->catfile($dir, "debian", "patches", ".dpkg-source-applied");
+    my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
     open(my $applied_fh, '>', $applied) ||
-        syserr(_g("cannot write %s"), $applied);
+        syserr(_g('cannot write %s'), $applied);
     print $applied_fh "# During $opts{usage}\n";
     my $timestamp = fs_time($applied);
     foreach my $patch ($self->get_patches($dir, %opts)) {
-        my $path = File::Spec->catfile($dir, "debian", "patches", $patch);
-        info(_g("applying %s"), $patch) unless $opts{skip_auto};
+        my $path = File::Spec->catfile($dir, 'debian', 'patches', $patch);
+        info(_g('applying %s'), $patch) unless $opts{skip_auto};
         my $patch_obj = Dpkg::Source::Patch->new(filename => $path);
         $patch_obj->apply($dir, force_timestamp => 1,
                           timestamp => $timestamp,
@@ -238,11 +238,11 @@ sub unapply_patches {
     my ($self, $dir, %opts) = @_;
     my @patches = reverse($self->get_patches($dir, %opts));
     return unless scalar(@patches);
-    my $applied = File::Spec->catfile($dir, "debian", "patches", ".dpkg-source-applied");
+    my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
     my $timestamp = fs_time($applied);
     foreach my $patch (@patches) {
-        my $path = File::Spec->catfile($dir, "debian", "patches", $patch);
-        info(_g("unapplying %s"), $patch) unless $opts{quiet};
+        my $path = File::Spec->catfile($dir, 'debian', 'patches', $patch);
+        info(_g('unapplying %s'), $patch) unless $opts{quiet};
         my $patch_obj = Dpkg::Source::Patch->new(filename => $path);
         $patch_obj->apply($dir, force_timestamp => 1, verbose => 0,
                           timestamp => $timestamp,
@@ -253,11 +253,11 @@ sub unapply_patches {
 
 sub upstream_tarball_template {
     my ($self) = @_;
-    my $ext = "{" . join(",",
+    my $ext = '{' . join(',',
         sort map {
-            compression_get_property($_, "file_ext")
-        } compression_get_list()) . "}";
-    return "../" . $self->get_basename() . ".orig.tar.$ext";
+            compression_get_property($_, 'file_ext')
+        } compression_get_list()) . '}';
+    return '../' . $self->get_basename() . ".orig.tar.$ext";
 }
 
 sub can_build {
@@ -265,7 +265,7 @@ sub can_build {
     return 1 if $self->find_original_tarballs(include_supplementary => 0);
     return 1 if $self->{options}{create_empty_orig} and
                 $self->find_original_tarballs(include_main => 0);
-    return (0, sprintf(_g("no upstream tarball found at %s"),
+    return (0, sprintf(_g('no upstream tarball found at %s'),
                        $self->upstream_tarball_template()));
 }
 
@@ -276,17 +276,17 @@ sub before_build {
 
 sub after_build {
     my ($self, $dir) = @_;
-    my $applied = File::Spec->catfile($dir, "debian", "patches", ".dpkg-source-applied");
-    my $reason = "";
+    my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
+    my $reason = '';
     if (-e $applied) {
-        open(my $applied_fh, "<", $applied) ||
-            syserr(_g("cannot read %s"), $applied);
+        open(my $applied_fh, '<', $applied) ||
+            syserr(_g('cannot read %s'), $applied);
         $reason = <$applied_fh>;
         close($applied_fh);
     }
     my $opt_unapply = $self->{options}{unapply_patches};
-    if (($opt_unapply eq "auto" and $reason =~ /^# During preparation/) or
-        $opt_unapply eq "yes") {
+    if (($opt_unapply eq 'auto' and $reason =~ /^# During preparation/) or
+        $opt_unapply eq 'yes') {
         $self->unapply_patches($dir);
     }
 }
@@ -300,13 +300,13 @@ sub prepare_build {
         include_timestamp => $self->{options}{include_timestamp},
         use_dev_null => 1,
     };
-    push @{$self->{options}{tar_ignore}}, "debian/patches/.dpkg-source-applied";
+    push @{$self->{options}{tar_ignore}}, 'debian/patches/.dpkg-source-applied';
     $self->check_patches_applied($dir) if $self->{options}{preparation};
     if ($self->{options}{create_empty_orig} and
         not $self->find_original_tarballs(include_supplementary => 0))
     {
         # No main orig.tar, create a dummy one
-        my $filename = $self->get_basename() . ".orig.tar." .
+        my $filename = $self->get_basename() . '.orig.tar.' .
                        $self->{options}{comp_ext};
         my $tar = Dpkg::Source::Archive->new(filename => $filename);
         $tar->create();
@@ -316,9 +316,9 @@ sub prepare_build {
 
 sub check_patches_applied {
     my ($self, $dir) = @_;
-    my $applied = File::Spec->catfile($dir, "debian", "patches", ".dpkg-source-applied");
+    my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
     unless (-e $applied) {
-        info(_g("patches are not applied, applying them now"));
+        info(_g('patches are not applied, applying them now'));
         $self->apply_patches($dir, usage => 'preparation');
     }
 }
@@ -335,8 +335,8 @@ sub generate_patch {
     foreach (sort $self->find_original_tarballs()) {
         if (/\.orig\.tar\.$compression_re_file_ext$/) {
             if (defined($tarfile)) {
-                error(_g("several orig.tar files found (%s and %s) but only " .
-                         "one is allowed"), $tarfile, $_);
+                error(_g('several orig.tar files found (%s and %s) but only ' .
+                         'one is allowed'), $tarfile, $_);
             }
             $tarfile = $_;
             push @origtarballs, $_;
@@ -348,11 +348,11 @@ sub generate_patch {
         }
     }
 
-    error(_g("no upstream tarball found at %s"),
+    error(_g('no upstream tarball found at %s'),
           $self->upstream_tarball_template()) unless $tarfile;
 
-    if ($opts{usage} eq "build") {
-        info(_g("building %s using existing %s"),
+    if ($opts{usage} eq 'build') {
+        info(_g('building %s using existing %s'),
              $self->{fields}{'Source'}, "@origtarballs");
     }
 
@@ -373,19 +373,19 @@ sub generate_patch {
 
     # Copy over the debian directory
     erasedir("$tmp/debian");
-    system("cp", "-a", "--", "$dir/debian", "$tmp/");
-    subprocerr(_g("copy of the debian directory")) if $?;
+    system('cp', '-a', '--', "$dir/debian", "$tmp/");
+    subprocerr(_g('copy of the debian directory')) if $?;
 
     # Apply all patches except the last automatic one
     $opts{skip_auto} //= 0;
     $self->apply_patches($tmp, skip_auto => $opts{skip_auto}, usage => 'build');
 
     # Create a patch
-    my ($difffh, $tmpdiff) = tempfile($self->get_basename(1) . ".diff.XXXXXX",
+    my ($difffh, $tmpdiff) = tempfile($self->get_basename(1) . '.diff.XXXXXX',
                                       DIR => File::Spec->tmpdir(), UNLINK => 0);
     push @Dpkg::Exit::handlers, sub { unlink($tmpdiff) };
     my $diff = Dpkg::Source::Patch->new(filename => $tmpdiff,
-                                        compression => "none");
+                                        compression => 'none');
     $diff->create();
     if ($opts{header_from} and -e $opts{header_from}) {
         my $header_from = Dpkg::Source::Patch->new(
@@ -399,10 +399,10 @@ sub generate_patch {
             %{$self->{diff_options}},
             handle_binary_func => $opts{handle_binary},
             order_from => $opts{order_from});
-    error(_g("unrepresentable changes to source")) if not $diff->finish();
+    error(_g('unrepresentable changes to source')) if not $diff->finish();
 
     if (-s $tmpdiff) {
-        info(_g("local changes detected, the modified files are:"));
+        info(_g('local changes detected, the modified files are:'));
         my $analysis = $diff->analyze($dir, verbose => 0);
         foreach my $fn (sort keys %{$analysis->{filepatched}}) {
             print " $fn\n";
@@ -440,17 +440,17 @@ sub do_build {
             my $fn = File::Spec->abs2rel($_, $dir);
             $binaryfiles->new_binary_found($fn);
             unless ($include_binaries or $binaryfiles->binary_is_allowed($fn)) {
-                errormsg(_g("unwanted binary file: %s"), $fn);
+                errormsg(_g('unwanted binary file: %s'), $fn);
                 $unwanted_binaries++;
             }
         }
     };
-    my $tar_ignore_glob = "{" . join(",",
+    my $tar_ignore_glob = '{' . join(',',
         map {
             my $copy = $_;
             $copy =~ s/,/\\,/g;
             $copy;
-        } @{$self->{options}{tar_ignore}}) . "}";
+        } @{$self->{options}{tar_ignore}}) . '}';
     my $filter_ignore = sub {
         # Filter out files that are not going to be included in the debian
         # tarball due to ignores.
@@ -474,11 +474,11 @@ sub do_build {
         return @result;
     };
     find({ wanted => $check_binary, preprocess => $filter_ignore,
-           no_chdir => 1 }, File::Spec->catdir($dir, "debian"));
-    error(P_("detected %d unwanted binary file (add it in " .
-             "debian/source/include-binaries to allow its inclusion).",
-             "detected %d unwanted binary files (add them in " .
-             "debian/source/include-binaries to allow their inclusion).",
+           no_chdir => 1 }, File::Spec->catdir($dir, 'debian'));
+    error(P_('detected %d unwanted binary file (add it in ' .
+             'debian/source/include-binaries to allow its inclusion).',
+             'detected %d unwanted binary files (add them in ' .
+             'debian/source/include-binaries to allow their inclusion).',
              $unwanted_binaries), $unwanted_binaries)
          if $unwanted_binaries;
 
@@ -488,17 +488,17 @@ sub do_build {
         my $relfn = File::Spec->abs2rel($new, $dir);
         $binaryfiles->new_binary_found($relfn);
         unless ($include_binaries or $binaryfiles->binary_is_allowed($relfn)) {
-            errormsg(_g("cannot represent change to %s: %s"), $relfn,
-                     _g("binary file contents changed"));
-            errormsg(_g("add %s in debian/source/include-binaries if you want" .
-                     " to store the modified binary in the debian tarball"),
+            errormsg(_g('cannot represent change to %s: %s'), $relfn,
+                     _g('binary file contents changed'));
+            errormsg(_g('add %s in debian/source/include-binaries if you want ' .
+                        'to store the modified binary in the debian tarball'),
                      $relfn);
             $self->register_error();
         }
     };
 
     # Create a patch
-    my $autopatch = File::Spec->catfile($dir, "debian", "patches",
+    my $autopatch = File::Spec->catfile($dir, 'debian', 'patches',
                                         $self->get_autopatch_name());
     my $tmpdiff = $self->generate_patch($dir, order_from => $autopatch,
                                         header_from => $autopatch,
@@ -506,9 +506,9 @@ sub do_build {
                                         skip_auto => $self->{options}{auto_commit},
                                         usage => 'build');
     unless (-z $tmpdiff or $self->{options}{auto_commit}) {
-        info(_g("you can integrate the local changes with %s"),
-             "dpkg-source --commit");
-        error(_g("aborting due to unexpected upstream changes, see %s"),
+        info(_g('you can integrate the local changes with %s'),
+             'dpkg-source --commit');
+        error(_g('aborting due to unexpected upstream changes, see %s'),
               $tmpdiff);
     }
     push @Dpkg::Exit::handlers, sub { unlink($tmpdiff) };
@@ -516,22 +516,22 @@ sub do_build {
 
     # Install the diff as the new autopatch
     if ($self->{options}{auto_commit}) {
-        mkpath(File::Spec->catdir($dir, "debian", "patches"));
+        mkpath(File::Spec->catdir($dir, 'debian', 'patches'));
         $autopatch = $self->register_patch($dir, $tmpdiff,
                                            $self->get_autopatch_name());
-        info(_g("local changes have been recorded in a new patch: %s"),
+        info(_g('local changes have been recorded in a new patch: %s'),
              $autopatch) if -e $autopatch;
-        rmdir(File::Spec->catdir($dir, "debian", "patches")); # No check on purpose
+        rmdir(File::Spec->catdir($dir, 'debian', 'patches')); # No check on purpose
     }
-    unlink($tmpdiff) || syserr(_g("cannot remove %s"), $tmpdiff);
+    unlink($tmpdiff) || syserr(_g('cannot remove %s'), $tmpdiff);
     pop @Dpkg::Exit::handlers;
 
     # Create the debian.tar
     my $debianfile = "$basenamerev.debian.tar." . $self->{options}{comp_ext};
-    info(_g("building %s in %s"), $sourcepackage, $debianfile);
+    info(_g('building %s in %s'), $sourcepackage, $debianfile);
     my $tar = Dpkg::Source::Archive->new(filename => $debianfile);
     $tar->create(options => \@tar_ignore, chdir => $dir);
-    $tar->add_directory("debian");
+    $tar->add_directory('debian');
     foreach my $binary ($binaryfiles->get_seen_binaries()) {
         $tar->add_file($binary) unless $binary =~ m{^debian/};
     }
@@ -542,19 +542,19 @@ sub do_build {
 
 sub get_patch_header {
     my ($self, $dir) = @_;
-    my $ph = File::Spec->catfile($dir, "debian", "source", "local-patch-header");
+    my $ph = File::Spec->catfile($dir, 'debian', 'source', 'local-patch-header');
     unless (-f $ph) {
-        $ph = File::Spec->catfile($dir, "debian", "source", "patch-header");
+        $ph = File::Spec->catfile($dir, 'debian', 'source', 'patch-header');
     }
     my $text;
     if (-f $ph) {
-        open(my $ph_fh, "<", $ph) || syserr(_g("cannot read %s"), $ph);
-        $text = join("", <$ph_fh>);
+        open(my $ph_fh, '<', $ph) || syserr(_g('cannot read %s'), $ph);
+        $text = join('', <$ph_fh>);
         close($ph_fh);
         return $text;
     }
     my $ch_info = changelog_parse(offset => 0, count => 1,
-        file => File::Spec->catfile($dir, "debian", "changelog"));
+        file => File::Spec->catfile($dir, 'debian', 'changelog'));
     return '' if not defined $ch_info;
     my $header = Dpkg::Control->new(type => CTRL_UNKNOWN);
     $header->{'Description'} = "<short summary of the patch>\n";
@@ -567,7 +567,7 @@ it.\n";
     $header->{'Description'} .= $ch_info->{'Changes'} . "\n";
     $header->{'Author'} = $ch_info->{'Maintainer'};
     $text = "$header";
-    run_vendor_hook("extend-patch-header", \$text, $ch_info);
+    run_vendor_hook('extend-patch-header', \$text, $ch_info);
     $text .= "\n---
 The information above should follow the Patch Tagging Guidelines, please
 checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
@@ -585,19 +585,19 @@ Last-Update: <YYYY-MM-DD>\n\n";
 
 sub register_patch {
     my ($self, $dir, $patch_file, $patch_name) = @_;
-    my $patch = File::Spec->catfile($dir, "debian", "patches", $patch_name);
+    my $patch = File::Spec->catfile($dir, 'debian', 'patches', $patch_name);
     if (-s $patch_file) {
         copy($patch_file, $patch) ||
-            syserr(_g("failed to copy %s to %s"), $patch_file, $patch);
+            syserr(_g('failed to copy %s to %s'), $patch_file, $patch);
         chmod(0666 & ~ umask(), $patch) ||
                 syserr(_g("unable to change permission of `%s'"), $patch);
-        my $applied = File::Spec->catfile($dir, "debian", "patches", ".dpkg-source-applied");
+        my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied');
         open(my $applied_fh, '>>', $applied) ||
-            syserr(_g("cannot write %s"), $applied);
+            syserr(_g('cannot write %s'), $applied);
         print $applied_fh "$patch\n";
-        close($applied_fh) || syserr(_g("cannot close %s"), $applied);
+        close($applied_fh) || syserr(_g('cannot close %s'), $applied);
     } elsif (-e $patch) {
-        unlink($patch) || syserr(_g("cannot remove %s"), $patch);
+        unlink($patch) || syserr(_g('cannot remove %s'), $patch);
     }
     return $patch;
 }
@@ -608,9 +608,9 @@ sub _is_bad_patch_name {
     return 1 if not defined($patch_name);
     return 1 if not length($patch_name);
 
-    my $patch = File::Spec->catfile($dir, "debian", "patches", $patch_name);
+    my $patch = File::Spec->catfile($dir, 'debian', 'patches', $patch_name);
     if (-e $patch) {
-        warning(_g("cannot register changes in %s, this patch already exists"),
+        warning(_g('cannot register changes in %s, this patch already exists'),
                 $patch);
         return 1;
     }
@@ -639,28 +639,28 @@ sub do_commit {
 
     unless ($tmpdiff) {
         $tmpdiff = $self->generate_patch($dir, handle_binary => $handle_binary,
-                                         usage => "commit");
+                                         usage => 'commit');
         $binaryfiles->update_debian_source_include_binaries();
     }
     push @Dpkg::Exit::handlers, sub { unlink($tmpdiff) };
     unless (-s $tmpdiff) {
-        unlink($tmpdiff) || syserr(_g("cannot remove %s"), $tmpdiff);
-        info(_g("there are no local changes to record"));
+        unlink($tmpdiff) || syserr(_g('cannot remove %s'), $tmpdiff);
+        info(_g('there are no local changes to record'));
         return;
     }
     while (_is_bad_patch_name($dir, $patch_name)) {
         # Ask the patch name interactively
-        print STDOUT _g("Enter the desired patch name: ");
+        print STDOUT _g('Enter the desired patch name: ');
         chomp($patch_name = <STDIN>);
         $patch_name =~ s/\s+/-/g;
         $patch_name =~ s/\///g;
     }
-    mkpath(File::Spec->catdir($dir, "debian", "patches"));
+    mkpath(File::Spec->catdir($dir, 'debian', 'patches'));
     my $patch = $self->register_patch($dir, $tmpdiff, $patch_name);
-    system("sensible-editor", $patch);
-    unlink($tmpdiff) || syserr(_g("cannot remove %s"), $tmpdiff);
+    system('sensible-editor', $patch);
+    unlink($tmpdiff) || syserr(_g('cannot remove %s'), $tmpdiff);
     pop @Dpkg::Exit::handlers;
-    info(_g("local changes have been recorded in a new patch: %s"), $patch);
+    info(_g('local changes have been recorded in a new patch: %s'), $patch);
 }
 
 package Dpkg::Source::Package::V2::BinaryFiles;
@@ -679,7 +679,7 @@ sub new {
         allowed_binaries => {},
         seen_binaries => {},
         include_binaries_path =>
-            File::Spec->catfile($dir, "debian", "source", "include-binaries"),
+            File::Spec->catfile($dir, 'debian', 'source', 'include-binaries'),
     };
     bless $self, $class;
     $self->load_allowed_binaries();
@@ -696,8 +696,8 @@ sub load_allowed_binaries {
     my ($self) = @_;
     my $incbin_file = $self->{include_binaries_path};
     if (-f $incbin_file) {
-        open(my $incbin_fh, "<", $incbin_file) ||
-            syserr(_g("cannot read %s"), $incbin_file);
+        open(my $incbin_fh, '<', $incbin_file) ||
+            syserr(_g('cannot read %s'), $incbin_file);
         while (defined($_ = <$incbin_fh>)) {
             chomp; s/^\s*//; s/\s*$//;
             next if /^#/ or /^$/;
@@ -720,12 +720,12 @@ sub update_debian_source_include_binaries {
     return unless scalar(@unknown_binaries);
 
     my $incbin_file = $self->{include_binaries_path};
-    mkpath(File::Spec->catdir($self->{dir}, "debian", "source"));
-    open(my $incbin_fh, ">>", $incbin_file) ||
-        syserr(_g("cannot write %s"), $incbin_file);
+    mkpath(File::Spec->catdir($self->{dir}, 'debian', 'source'));
+    open(my $incbin_fh, '>>', $incbin_file) ||
+        syserr(_g('cannot write %s'), $incbin_file);
     foreach my $binary (@unknown_binaries) {
         print $incbin_fh "$binary\n";
-        info(_g("adding %s to %s"), $binary, "debian/source/include-binaries");
+        info(_g('adding %s to %s'), $binary, 'debian/source/include-binaries');
         $self->{allowed_binaries}{$binary} = 1;
     }
     close($incbin_fh);

+ 19 - 19
scripts/Dpkg/Source/Package/V3/bzr.pm

@@ -24,7 +24,7 @@ package Dpkg::Source::Package::V3::bzr;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use base 'Dpkg::Source::Package';
 
@@ -41,7 +41,7 @@ use Dpkg::Source::Archive;
 use Dpkg::Exit;
 use Dpkg::Source::Functions qw(erasedir);
 
-our $CURRENT_MINOR_VERSION = "0";
+our $CURRENT_MINOR_VERSION = '0';
 
 sub import {
     foreach my $dir (split(/:/, $ENV{PATH})) {
@@ -49,28 +49,28 @@ sub import {
             return 1;
         }
     }
-    error(_g("cannot unpack bzr-format source package because " .
-             "bzr is not in the PATH"));
+    error(_g('cannot unpack bzr-format source package because ' .
+             'bzr is not in the PATH'));
 }
 
 sub sanity_check {
     my $srcdir = shift;
 
     if (! -d "$srcdir/.bzr") {
-        error(_g("source directory is not the top directory of a bzr repository (%s/.bzr not present), but Format bzr was specified"),
+        error(_g('source directory is not the top directory of a bzr repository (%s/.bzr not present), but Format bzr was specified'),
               $srcdir);
     }
 
     # Symlinks from .bzr to outside could cause unpack failures, or
     # point to files they shouldn't, so check for and don't allow.
     if (-l "$srcdir/.bzr") {
-        error(_g("%s is a symlink"), "$srcdir/.bzr");
+        error(_g('%s is a symlink'), "$srcdir/.bzr");
     }
     my $abs_srcdir = Cwd::abs_path($srcdir);
     find(sub {
         if (-l $_) {
             if (Cwd::abs_path(readlink($_)) !~ /^\Q$abs_srcdir\E(\/|$)/) {
-                error(_g("%s is a symlink to outside %s"),
+                error(_g('%s is a symlink to outside %s'),
                       $File::Find::name, $srcdir);
             }
         }
@@ -114,8 +114,8 @@ sub do_build {
     # Check for uncommitted files.
     # To support dpkg-source -i, remove any ignored files from the
     # output of bzr status.
-    open(my $bzr_status_fh, '-|', "bzr", "status") ||
-            subprocerr("bzr status");
+    open(my $bzr_status_fh, '-|', 'bzr', 'status') ||
+            subprocerr('bzr status');
     my @files;
     while (<$bzr_status_fh>) {
         chomp;
@@ -125,10 +125,10 @@ sub do_build {
             push @files, $_;
         }
     }
-    close($bzr_status_fh) || syserr(_g("bzr status exited nonzero"));
+    close($bzr_status_fh) || syserr(_g('bzr status exited nonzero'));
     if (@files) {
-        error(_g("uncommitted, not-ignored changes in working directory: %s"),
-              join(" ", @files));
+        error(_g('uncommitted, not-ignored changes in working directory: %s'),
+              join(' ', @files));
     }
 
     chdir($old_cwd) ||
@@ -138,11 +138,11 @@ sub do_build {
     push @Dpkg::Exit::handlers, sub { erasedir($tmp) };
     my $tardir = "$tmp/$dirname";
 
-    system("bzr", "branch", $dir, $tardir);
+    system('bzr', 'branch', $dir, $tardir);
     $? && subprocerr("bzr branch $dir $tardir");
 
     # Remove the working tree.
-    system("bzr", "remove-tree", $tardir);
+    system('bzr', 'remove-tree', $tardir);
 
     # Some branch metadata files are unhelpful.
     unlink("$tardir/.bzr/branch/branch-name",
@@ -150,7 +150,7 @@ sub do_build {
 
     # Create the tar file
     my $debianfile = "$basenamerev.bzr.tar." . $self->{options}{comp_ext};
-    info(_g("building %s in %s"),
+    info(_g('building %s in %s'),
          $sourcepackage, $debianfile);
     my $tar = Dpkg::Source::Archive->new(filename => $debianfile,
                                          compression => $self->{options}{compression},
@@ -177,18 +177,18 @@ sub do_extract {
 
     my @files = $self->get_files();
     if (@files > 1) {
-        error(_g("format v3.0 uses only one source file"));
+        error(_g('format v3.0 uses only one source file'));
     }
     my $tarfile = $files[0];
     if ($tarfile !~ /^\Q$basenamerev\E\.bzr\.tar\.$compression_re_file_ext$/) {
-        error(_g("expected %s, got %s"),
+        error(_g('expected %s, got %s'),
               "$basenamerev.bzr.tar.$compression_re_file_ext", $tarfile);
     }
 
     erasedir($newdirectory);
 
     # Extract main tarball
-    info(_g("unpacking %s"), $tarfile);
+    info(_g('unpacking %s'), $tarfile);
     my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile");
     $tar->extract($newdirectory);
 
@@ -199,7 +199,7 @@ sub do_extract {
             syserr(_g("unable to chdir to `%s'"), $newdirectory);
 
     # Reconstitute the working tree.
-    system("bzr", "checkout");
+    system('bzr', 'checkout');
 
     chdir($old_cwd) ||
             syserr(_g("unable to chdir to `%s'"), $old_cwd);

+ 4 - 4
scripts/Dpkg/Source/Package/V3/custom.pm

@@ -18,7 +18,7 @@ package Dpkg::Source::Package::V3::custom;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use base 'Dpkg::Source::Package';
 
@@ -26,7 +26,7 @@ use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 
-our $CURRENT_MINOR_VERSION = "0";
+our $CURRENT_MINOR_VERSION = '0';
 
 sub parse_cmdline_option {
     my ($self, $opt) = @_;
@@ -43,14 +43,14 @@ sub do_extract {
 sub can_build {
     my ($self, $dir) = @_;
     return (scalar(@{$self->{options}{ARGV}}),
-            _g("no files indicated on command line"));
+            _g('no files indicated on command line'));
 }
 
 sub do_build {
     my ($self, $dir) = @_;
     # Update real target format
     my $format = $self->{options}{target_format};
-    error(_g("--target-format option is missing")) unless $format;
+    error(_g('--target-format option is missing')) unless $format;
     $self->{fields}{'Format'} = $format;
     # Add all files
     foreach my $file (@{$self->{options}{ARGV}}) {

+ 39 - 39
scripts/Dpkg/Source/Package/V3/git.pm

@@ -22,7 +22,7 @@ package Dpkg::Source::Package::V3::git;
 use strict;
 use warnings;
 
-our $VERSION = "0.02";
+our $VERSION = '0.02';
 
 use base 'Dpkg::Source::Package';
 
@@ -36,7 +36,7 @@ use Dpkg::ErrorHandling;
 use Dpkg::Exit;
 use Dpkg::Source::Functions qw(erasedir);
 
-our $CURRENT_MINOR_VERSION = "0";
+our $CURRENT_MINOR_VERSION = '0';
 
 # Remove variables from the environment that might cause git to do
 # something unexpected.
@@ -52,20 +52,20 @@ sub import {
             return 1;
         }
     }
-    error(_g("cannot unpack git-format source package because " .
-             "git is not in the PATH"));
+    error(_g('cannot unpack git-format source package because ' .
+             'git is not in the PATH'));
 }
 
 sub sanity_check {
     my $srcdir = shift;
 
     if (! -d "$srcdir/.git") {
-        error(_g("source directory is not the top directory of a git " .
-                 "repository (%s/.git not present), but Format git was " .
-                 "specified"), $srcdir);
+        error(_g('source directory is not the top directory of a git ' .
+                 'repository (%s/.git not present), but Format git was ' .
+                 'specified'), $srcdir);
     }
     if (-s "$srcdir/.gitmodules") {
-        error(_g("git repository %s uses submodules; this is not yet supported"),
+        error(_g('git repository %s uses submodules; this is not yet supported'),
               $srcdir);
     }
 
@@ -107,17 +107,17 @@ sub do_build {
     # To support dpkg-source -i, get a list of files
     # equivalent to the ones git status finds, and remove any
     # ignored files from it.
-    my @ignores = "--exclude-per-directory=.gitignore";
+    my @ignores = '--exclude-per-directory=.gitignore';
     my $core_excludesfile = `git config --get core.excludesfile`;
     chomp $core_excludesfile;
     if (length $core_excludesfile && -e $core_excludesfile) {
         push @ignores, "--exclude-from=$core_excludesfile";
     }
-    if (-e ".git/info/exclude") {
-        push @ignores, "--exclude-from=.git/info/exclude";
+    if (-e '.git/info/exclude') {
+        push @ignores, '--exclude-from=.git/info/exclude';
     }
-    open(my $git_ls_files_fh, '-|', "git", "ls-files", "--modified", "--deleted",
-         "-z", "--others", @ignores) || subprocerr("git ls-files");
+    open(my $git_ls_files_fh, '-|', 'git', 'ls-files', '--modified', '--deleted',
+         '-z', '--others', @ignores) || subprocerr('git ls-files');
     my @files;
     { local $/ = "\0";
       while (<$git_ls_files_fh>) {
@@ -128,10 +128,10 @@ sub do_build {
           }
       }
     }
-    close($git_ls_files_fh) || syserr(_g("git ls-files exited nonzero"));
+    close($git_ls_files_fh) || syserr(_g('git ls-files exited nonzero'));
     if (@files) {
-        error(_g("uncommitted, not-ignored changes in working directory: %s"),
-              join(" ", @files));
+        error(_g('uncommitted, not-ignored changes in working directory: %s'),
+              join(' ', @files));
     }
 
     # If a depth was specified, need to create a shallow clone and
@@ -146,29 +146,29 @@ sub do_build {
         my $clone_dir = "$tmp/repo.git";
         # file:// is needed to avoid local cloning, which does not
         # create a shallow clone.
-        info(_g("creating shallow clone with depth %s"),
+        info(_g('creating shallow clone with depth %s'),
                 $self->{options}{git_depth});
-        system("git", "clone", "--depth=" . $self->{options}{git_depth},
-                "--quiet", "--bare", "file://" . abs_path($dir), $clone_dir);
-        $? && subprocerr("git clone");
+        system('git', 'clone', '--depth=' . $self->{options}{git_depth},
+               '--quiet', '--bare', 'file://' . abs_path($dir), $clone_dir);
+        $? && subprocerr('git clone');
         chdir($clone_dir) ||
                 syserr(_g("unable to chdir to `%s'"), $clone_dir);
         $shallowfile = "$basenamerev.gitshallow";
-        system("cp", "-f", "shallow", "$old_cwd/$shallowfile");
-        $? && subprocerr("cp shallow");
+        system('cp', '-f', 'shallow', "$old_cwd/$shallowfile");
+        $? && subprocerr('cp shallow');
     }
 
     # Create the git bundle.
     my $bundlefile = "$basenamerev.git";
-    my @bundle_arg = $self->{options}{git_ref} ?
-        (@{$self->{options}{git_ref}}) : "--all";
-    info(_g("bundling: %s"), join(" ", @bundle_arg));
-    system("git", "bundle", "create", "$old_cwd/$bundlefile",
+    my @bundle_arg=$self->{options}{git_ref} ?
+        (@{$self->{options}{git_ref}}) : '--all';
+    info(_g('bundling: %s'), join(' ', @bundle_arg));
+    system('git', 'bundle', 'create', "$old_cwd/$bundlefile",
            @bundle_arg,
-           "HEAD", # ensure HEAD is included no matter what
-           "--", # avoids ambiguity error when referring to eg, a debian branch
+           'HEAD', # ensure HEAD is included no matter what
+           '--', # avoids ambiguity error when referring to eg, a debian branch
     );
-    $? && subprocerr("git bundle");
+    $? && subprocerr('git bundle');
 
     chdir($old_cwd) ||
         syserr(_g("unable to chdir to `%s'"), $old_cwd);
@@ -198,35 +198,35 @@ sub do_extract {
             if (! defined $bundle) {
                 $bundle = $file;
             } else {
-                error(_g("format v3.0 (git) uses only one .git file"));
+                error(_g('format v3.0 (git) uses only one .git file'));
             }
         } elsif ($file =~ /^\Q$basenamerev\E\.gitshallow$/) {
             if (! defined $shallow) {
                 $shallow = $file;
             } else {
-                error(_g("format v3.0 (git) uses only one .gitshallow file"));
+                error(_g('format v3.0 (git) uses only one .gitshallow file'));
             }
         } else {
-            error(_g("format v3.0 (git) unknown file: %s", $file));
+            error(_g('format v3.0 (git) unknown file: %s', $file));
         }
     }
     if (! defined $bundle) {
-        error(_g("format v3.0 (git) expected %s"), "$basenamerev.git");
+        error(_g('format v3.0 (git) expected %s'), "$basenamerev.git");
     }
 
     erasedir($newdirectory);
 
     # Extract git bundle.
-    info(_g("cloning %s"), $bundle);
-    system("git", "clone", "--quiet", $dscdir.$bundle, $newdirectory);
-    $? && subprocerr("git bundle");
+    info(_g('cloning %s'), $bundle);
+    system('git', 'clone', '--quiet', $dscdir . $bundle, $newdirectory);
+    $? && subprocerr('git bundle');
 
     if (defined $shallow) {
         # Move shallow info file into place, so git does not
         # try to follow parents of shallow refs.
-        info(_g("setting up shallow clone"));
-        system("cp", "-f",  $dscdir.$shallow, "$newdirectory/.git/shallow");
-        $? && subprocerr("cp");
+        info(_g('setting up shallow clone'));
+        system('cp', '-f',  $dscdir . $shallow, "$newdirectory/.git/shallow");
+        $? && subprocerr('cp');
     }
 
     sanity_check($newdirectory);

+ 7 - 7
scripts/Dpkg/Source/Package/V3/native.pm

@@ -18,7 +18,7 @@ package Dpkg::Source::Package::V3::native;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use base 'Dpkg::Source::Package';
 
@@ -34,7 +34,7 @@ use Cwd;
 use File::Basename;
 use File::Temp qw(tempfile);
 
-our $CURRENT_MINOR_VERSION = "0";
+our $CURRENT_MINOR_VERSION = '0';
 
 sub do_extract {
     my ($self, $newdirectory) = @_;
@@ -48,17 +48,17 @@ sub do_extract {
     my $tarfile;
     foreach my $file ($self->get_files()) {
 	if ($file =~ /^\Q$basenamerev\E\.tar\.$compression_re_file_ext$/) {
-            error(_g("multiple tarfiles in v1.0 source package")) if $tarfile;
+            error(_g('multiple tarfiles in v1.0 source package')) if $tarfile;
             $tarfile = $file;
 	} else {
-	    error(_g("unrecognized file for a native source package: %s"), $file);
+	    error(_g('unrecognized file for a native source package: %s'), $file);
 	}
     }
 
-    error(_g("no tarfile in Files field")) unless $tarfile;
+    error(_g('no tarfile in Files field')) unless $tarfile;
 
     erasedir($newdirectory);
-    info(_g("unpacking %s"), $tarfile);
+    info(_g('unpacking %s'), $tarfile);
     my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile");
     $tar->extract($newdirectory);
 }
@@ -81,7 +81,7 @@ sub do_build {
     my $basenamerev = $self->get_basename(1);
     my $tarname = "$basenamerev.tar." . $self->{options}{comp_ext};
 
-    info(_g("building %s in %s"), $sourcepackage, $tarname);
+    info(_g('building %s in %s'), $sourcepackage, $tarname);
 
     my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX",
                                    DIR => getcwd(), UNLINK => 0);

+ 24 - 24
scripts/Dpkg/Source/Package/V3/quilt.pm

@@ -18,7 +18,7 @@ package Dpkg::Source::Package::V3::quilt;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 # Based on wig&pen implementation
 use base 'Dpkg::Source::Package::V2';
@@ -34,7 +34,7 @@ use Dpkg::Exit;
 use File::Spec;
 use File::Copy;
 
-our $CURRENT_MINOR_VERSION = "0";
+our $CURRENT_MINOR_VERSION = '0';
 
 sub init_options {
     my ($self) = @_;
@@ -75,15 +75,15 @@ sub can_build {
     my $quilt = $self->build_quilt_object($dir);
     $msg = $quilt->find_problems();
     return (0, $msg) if $msg;
-    return (1, "");
+    return (1, '');
 }
 
 sub get_autopatch_name {
     my ($self) = @_;
     if ($self->{options}{single_debian_patch}) {
-        return "debian-changes";
+        return 'debian-changes';
     } else {
-        return "debian-changes-" . $self->{fields}{'Version'};
+        return 'debian-changes-' . $self->{fields}{'Version'};
     }
 }
 
@@ -107,8 +107,8 @@ sub apply_patches {
     # Update debian/patches/series symlink if needed to allow quilt usage
     my $series = $quilt->get_series_file();
     my $basename = (File::Spec->splitpath($series))[2];
-    if ($basename ne "series") {
-        my $dest = $quilt->get_patch_file("series");
+    if ($basename ne 'series') {
+        my $dest = $quilt->get_patch_file('series');
         unlink($dest) if -l $dest;
         unless (-f _) { # Don't overwrite real files
             symlink($basename, $dest) ||
@@ -118,18 +118,18 @@ sub apply_patches {
 
     return unless scalar($quilt->series());
 
-    if ($opts{usage} eq "preparation" and
+    if ($opts{usage} eq 'preparation' and
         $self->{options}{unapply_patches} eq 'auto') {
         # We're applying the patches in --before-build, remember to unapply
         # them afterwards in --after-build
-        my $pc_unapply = $quilt->get_db_file(".dpkg-source-unapply");
-        open(my $unapply_fh, ">", $pc_unapply) ||
-            syserr(_g("cannot write %s"), $pc_unapply);
+        my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply');
+        open(my $unapply_fh, '>', $pc_unapply) ||
+            syserr(_g('cannot write %s'), $pc_unapply);
         close($unapply_fh);
     }
 
     # Apply patches
-    my $pc_applied = $quilt->get_db_file("applied-patches");
+    my $pc_applied = $quilt->get_db_file('applied-patches');
     $opts{timestamp} = fs_time($pc_applied);
     if ($opts{skip_auto}) {
         my $auto_patch = $self->get_autopatch_name();
@@ -146,7 +146,7 @@ sub unapply_patches {
 
     $opts{verbose} //= 1;
 
-    my $pc_applied = $quilt->get_db_file("applied-patches");
+    my $pc_applied = $quilt->get_db_file('applied-patches');
     my @applied = $quilt->applied();
     $opts{timestamp} = fs_time($pc_applied) if @applied;
 
@@ -180,9 +180,9 @@ sub do_build {
         if (scalar grep { $version eq $_ }
             @{$self->{options}{allow_version_of_quilt_db}})
         {
-            warning(_g("unsupported version of the quilt metadata: %s"), $version);
+            warning(_g('unsupported version of the quilt metadata: %s'), $version);
         } else {
-            error(_g("unsupported version of the quilt metadata: %s"), $version);
+            error(_g('unsupported version of the quilt metadata: %s'), $version);
         }
     }
 
@@ -192,9 +192,9 @@ sub do_build {
 sub after_build {
     my ($self, $dir) = @_;
     my $quilt = $self->build_quilt_object($dir);
-    my $pc_unapply = $quilt->get_db_file(".dpkg-source-unapply");
+    my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply');
     my $opt_unapply = $self->{options}{unapply_patches};
-    if (($opt_unapply eq "auto" and -e $pc_unapply) or $opt_unapply eq "yes") {
+    if (($opt_unapply eq 'auto' and -e $pc_unapply) or $opt_unapply eq 'yes') {
         unlink($pc_unapply);
         $self->unapply_patches($dir);
     }
@@ -207,7 +207,7 @@ sub check_patches_applied {
     my $next = $quilt->next();
     return if not defined $next;
 
-    my $first_patch = File::Spec->catfile($dir, "debian", "patches", $next);
+    my $first_patch = File::Spec->catfile($dir, 'debian', 'patches', $next);
     my $patch_obj = Dpkg::Source::Patch->new(filename => $first_patch);
     return unless $patch_obj->check_apply($dir);
 
@@ -217,7 +217,7 @@ sub check_patches_applied {
 sub _add_line {
     my ($file, $line) = @_;
 
-    open(my $file_fh, ">>", $file) || syserr(_g("cannot write %s"), $file);
+    open(my $file_fh, '>>', $file) || syserr(_g('cannot write %s'), $file);
     print $file_fh "$line\n";
     close($file_fh);
 }
@@ -225,10 +225,10 @@ sub _add_line {
 sub _drop_line {
     my ($file, $re) = @_;
 
-    open(my $file_fh, "<", $file) || syserr(_g("cannot read %s"), $file);
+    open(my $file_fh, '<', $file) || syserr(_g('cannot read %s'), $file);
     my @lines = <$file_fh>;
     close($file_fh);
-    open($file_fh, ">", $file) || syserr(_g("cannot write %s"), $file);
+    open($file_fh, '>', $file) || syserr(_g('cannot write %s'), $file);
     print($file_fh $_) foreach grep { not /^\Q$re\E\s*$/ } @lines;
     close($file_fh);
 }
@@ -241,16 +241,16 @@ sub register_patch {
     my @patches = $quilt->series();
     my $has_patch = (grep { $_ eq $patch_name } @patches) ? 1 : 0;
     my $series = $quilt->get_series_file();
-    my $applied = $quilt->get_db_file("applied-patches");
+    my $applied = $quilt->get_db_file('applied-patches');
     my $patch = $quilt->get_patch_file($patch_name);
 
     if (-s $tmpdiff) {
         copy($tmpdiff, $patch) ||
-            syserr(_g("failed to copy %s to %s"), $tmpdiff, $patch);
+            syserr(_g('failed to copy %s to %s'), $tmpdiff, $patch);
         chmod(0666 & ~ umask(), $patch) ||
             syserr(_g("unable to change permission of `%s'"), $patch);
     } elsif (-e $patch) {
-        unlink($patch) || syserr(_g("cannot remove %s"), $patch);
+        unlink($patch) || syserr(_g('cannot remove %s'), $patch);
     }
 
     if (-e $patch) {

+ 59 - 59
scripts/Dpkg/Source/Patch.pm

@@ -18,7 +18,7 @@ package Dpkg::Source::Patch;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use Dpkg;
 use Dpkg::Gettext;
@@ -40,12 +40,12 @@ use base 'Dpkg::Compression::FileHandle';
 
 sub create {
     my ($self, %opts) = @_;
-    $self->ensure_open("w"); # Creates the file
+    $self->ensure_open('w'); # Creates the file
     *$self->{errors} = 0;
     *$self->{empty} = 1;
     if ($opts{old} and $opts{new}) {
-        $opts{old} = "/dev/null" unless -e $opts{old};
-        $opts{new} = "/dev/null" unless -e $opts{new};
+        $opts{old} = '/dev/null' unless -e $opts{old};
+        $opts{new} = '/dev/null' unless -e $opts{new};
         if (-d $opts{old} and -d $opts{new}) {
             $self->add_diff_directory($opts{old}, $opts{new}, %opts);
         } elsif (-f $opts{old} and -f $opts{new}) {
@@ -67,7 +67,7 @@ sub add_diff_file {
     $opts{include_timestamp} = 0 unless exists $opts{include_timestamp};
     my $handle_binary = $opts{handle_binary_func} || sub {
         my ($self, $old, $new) = @_;
-        $self->_fail_with_msg($new, _g("binary file contents changed"));
+        $self->_fail_with_msg($new, _g('binary file contents changed'));
     };
     # Optimization to avoid forking diff if unnecessary
     return 1 if compare($old, $new, 4096) == 0;
@@ -82,11 +82,11 @@ sub add_diff_file {
     if ($opts{label_old} and $opts{label_new}) {
 	if ($opts{include_timestamp}) {
 	    my $ts = (stat($old))[9];
-	    my $t = POSIX::strftime("%Y-%m-%d %H:%M:%S", gmtime($ts));
+	    my $t = POSIX::strftime('%Y-%m-%d %H:%M:%S', gmtime($ts));
 	    $opts{label_old} .= sprintf("\t%s.%09d +0000", $t,
 					    ($ts-int($ts))*1000000000);
 	    $ts = (stat($new))[9];
-	    $t = POSIX::strftime("%Y-%m-%d %H:%M:%S", gmtime($ts));
+	    $t = POSIX::strftime('%Y-%m-%d %H:%M:%S', gmtime($ts));
 	    $opts{label_new} .= sprintf("\t%s.%09d +0000", $t,
 					    ($ts-int($ts))*1000000000);
 	} else {
@@ -94,8 +94,8 @@ sub add_diff_file {
 	    $opts{label_old} .= "\t" if $opts{label_old} =~ / /;
 	    $opts{label_new} .= "\t" if $opts{label_new} =~ / /;
 	}
-        push @options, "-L", $opts{label_old},
-                       "-L", $opts{label_new};
+        push @options, '-L', $opts{label_old},
+                       '-L', $opts{label_new};
     }
     # Generate diff
     my $diffgen;
@@ -115,19 +115,19 @@ sub add_diff_file {
         } elsif (m/^[-+\@ ]/) {
             $difflinefound++;
         } elsif (m/^\\ /) {
-            warning(_g("file %s has no final newline (either " .
-                       "original or modified version)"), $new);
+            warning(_g('file %s has no final newline (either ' .
+                       'original or modified version)'), $new);
         } else {
             chomp;
             error(_g("unknown line from diff -u on %s: `%s'"), $new, $_);
         }
 	if (*$self->{empty} and defined(*$self->{header})) {
-	    $self->print(*$self->{header}) or syserr(_g("failed to write"));
+	    $self->print(*$self->{header}) or syserr(_g('failed to write'));
 	    *$self->{empty} = 0;
 	}
-        print $self $_ || syserr(_g("failed to write"));
+        print $self $_ || syserr(_g('failed to write'));
     }
-    close($diffgen) or syserr("close on diff pipe");
+    close($diffgen) or syserr('close on diff pipe');
     wait_child($diff_pid, nocheck => 1,
                cmdline => "diff -u @options -- $old $new");
     # Verify diff process ended successfully
@@ -135,7 +135,7 @@ sub add_diff_file {
     # Ignore error if binary content detected
     my $exit = WEXITSTATUS($?);
     unless (WIFEXITED($?) && ($exit == 0 || $exit == 1 || $binary)) {
-        subprocerr(_g("diff on %s"), $new);
+        subprocerr(_g('diff on %s'), $new);
     }
     return ($exit == 0 || $exit == 1);
 }
@@ -161,7 +161,7 @@ sub add_diff_directory {
         my $fn = (length > length($new)) ? substr($_, length($new) + 1) : '.';
         return if &$diff_ignore($fn);
         $files_in_new{$fn} = 1;
-        lstat("$new/$fn") || syserr(_g("cannot stat file %s"), "$new/$fn");
+        lstat("$new/$fn") || syserr(_g('cannot stat file %s'), "$new/$fn");
         my $mode = S_IMODE((lstat(_))[2]);
         my $size = (lstat(_))[7];
         if (-l _) {
@@ -170,9 +170,9 @@ sub add_diff_directory {
                 return;
             }
             defined(my $n = readlink("$new/$fn")) ||
-                syserr(_g("cannot read link %s"), "$new/$fn");
+                syserr(_g('cannot read link %s'), "$new/$fn");
             defined(my $n2 = readlink("$old/$fn")) ||
-                syserr(_g("cannot read link %s"), "$old/$fn");
+                syserr(_g('cannot read link %s'), "$old/$fn");
             unless ($n eq $n2) {
                 $self->_fail_not_same_type("$old/$fn", "$new/$fn");
             }
@@ -180,7 +180,7 @@ sub add_diff_directory {
             my $old_file = "$old/$fn";
             if (not lstat("$old/$fn")) {
                 $! == ENOENT ||
-                    syserr(_g("cannot stat file %s"), "$old/$fn");
+                    syserr(_g('cannot stat file %s'), "$old/$fn");
                 $old_file = '/dev/null';
             } elsif (not -f _) {
                 $self->_fail_not_same_type("$old/$fn", "$new/$fn");
@@ -199,34 +199,34 @@ sub add_diff_directory {
             }
         } elsif (-b _ || -c _ || -S _) {
             $self->_fail_with_msg("$new/$fn",
-                _g("device or socket is not allowed"));
+                _g('device or socket is not allowed'));
         } elsif (-d _) {
             if (not lstat("$old/$fn")) {
                 $! == ENOENT ||
-                    syserr(_g("cannot stat file %s"), "$old/$fn");
+                    syserr(_g('cannot stat file %s'), "$old/$fn");
             } elsif (not -d _) {
                 $self->_fail_not_same_type("$old/$fn", "$new/$fn");
             }
         } else {
-            $self->_fail_with_msg("$new/$fn", _g("unknown file type"));
+            $self->_fail_with_msg("$new/$fn", _g('unknown file type'));
         }
     };
     my $scan_old = sub {
         my $fn = (length > length($old)) ? substr($_, length($old) + 1) : '.';
         return if &$diff_ignore($fn);
         return if $files_in_new{$fn};
-        lstat("$old/$fn") || syserr(_g("cannot stat file %s"), "$old/$fn");
+        lstat("$old/$fn") || syserr(_g('cannot stat file %s'), "$old/$fn");
         if (-f _) {
             if ($inc_removal) {
-                push @diff_files, [$fn, 0, 0, "$old/$fn", "/dev/null",
-                                   "$basedir.orig/$fn", "/dev/null"];
+                push @diff_files, [$fn, 0, 0, "$old/$fn", '/dev/null',
+                                   "$basedir.orig/$fn", '/dev/null'];
             } else {
-                warning(_g("ignoring deletion of file %s"), $fn);
+                warning(_g('ignoring deletion of file %s'), $fn);
             }
         } elsif (-d _) {
-            warning(_g("ignoring deletion of directory %s"), $fn);
+            warning(_g('ignoring deletion of directory %s'), $fn);
         } elsif (-l _) {
-            warning(_g("ignoring deletion of symlink %s"), $fn);
+            warning(_g('ignoring deletion of symlink %s'), $fn);
         } else {
             $self->_fail_not_same_type("$old/$fn", "$new/$fn");
         }
@@ -266,19 +266,19 @@ sub add_diff_directory {
                                            label_old => $label_old,
                                            label_new => $label_new, %opts);
         if ($success and
-            $old_file eq "/dev/null" and $new_file ne "/dev/null") {
+            $old_file eq '/dev/null' and $new_file ne '/dev/null') {
             if (not $size) {
                 warning(_g("newly created empty file '%s' will not " .
-                           "be represented in diff"), $fn);
+                           'be represented in diff'), $fn);
             } else {
                 if ($mode & (S_IXUSR | S_IXGRP | S_IXOTH)) {
                     warning(_g("executable mode %04o of '%s' will " .
-                               "not be represented in diff"), $mode, $fn)
+                               'not be represented in diff'), $mode, $fn)
                         unless $fn eq 'debian/rules';
                 }
                 if ($mode & (S_ISUID | S_ISGID | S_ISVTX)) {
                     warning(_g("special mode %04o of '%s' will not " .
-                               "be represented in diff"), $mode, $fn);
+                               'be represented in diff'), $mode, $fn);
                 }
             }
         }
@@ -287,7 +287,7 @@ sub add_diff_directory {
 
 sub finish {
     my ($self) = @_;
-    close($self) || syserr(_g("cannot close %s"), $self->get_filename());
+    close($self) || syserr(_g('cannot close %s'), $self->get_filename());
     return not *$self->{errors};
 }
 
@@ -297,16 +297,16 @@ sub register_error {
 }
 sub _fail_with_msg {
     my ($self, $file, $msg) = @_;
-    errormsg(_g("cannot represent change to %s: %s"), $file, $msg);
+    errormsg(_g('cannot represent change to %s: %s'), $file, $msg);
     $self->register_error();
 }
 sub _fail_not_same_type {
     my ($self, $old, $new) = @_;
     my $old_type = get_type($old);
     my $new_type = get_type($new);
-    errormsg(_g("cannot represent change to %s:"), $new);
-    errormsg(_g("  new version is %s"), $new_type);
-    errormsg(_g("  old version is %s"), $old_type);
+    errormsg(_g('cannot represent change to %s:'), $new);
+    errormsg(_g('  new version is %s'), $new_type);
+    errormsg(_g('  old version is %s'), $old_type);
     $self->register_error();
 }
 
@@ -419,15 +419,15 @@ sub analyze {
 	}
 
 	# Safety checks on both filenames that patch could use
-	foreach my $key ("old", "new") {
+	foreach my $key ('old', 'new') {
 	    next unless defined $fn{$key};
 	    if ($path{$key} =~ m{/\.\./}) {
-		error(_g("%s contains an insecure path: %s"), $diff, $path{$key});
+		error(_g('%s contains an insecure path: %s'), $diff, $path{$key});
 	    }
 	    my $path = $fn{$key};
 	    while (1) {
 		if (-l $path) {
-		    error(_g("diff %s modifies file %s through a symlink: %s"),
+		    error(_g('diff %s modifies file %s through a symlink: %s'),
 			  $diff, $fn{$key}, $path);
 		}
 		last unless $path =~ s{/+[^/]*$}{};
@@ -442,7 +442,7 @@ sub analyze {
             error(_g("file removal without proper filename in diff `%s' (line %d)"),
                   $diff, $. - 1) unless defined $fn{old};
             if ($opts{verbose}) {
-                warning(_g("diff %s removes a non-existing file %s (line %d)"),
+                warning(_g('diff %s removes a non-existing file %s (line %d)'),
                         $diff, $fn{old}, $.) unless -e $fn{old};
             }
         }
@@ -516,7 +516,7 @@ sub prepare_apply {
     if ($opts{create_dirs}) {
 	foreach my $dir (keys %{$analysis->{dirtocreate}}) {
 	    eval { mkpath($dir, 0, 0777); };
-	    syserr(_g("cannot create directory %s"), $dir) if $@;
+	    syserr(_g('cannot create directory %s'), $dir) if $@;
 	}
     }
 }
@@ -535,7 +535,7 @@ sub apply {
     my $analysis = $self->analyze($destdir, %opts);
     $self->prepare_apply($analysis, %opts);
     # Apply the patch
-    $self->ensure_open("r");
+    $self->ensure_open('r');
     my ($stdout, $stderr) = ('', '');
     spawn(
 	exec => [ 'patch', @{$opts{options}} ],
@@ -551,8 +551,8 @@ sub apply {
     if ($?) {
 	print STDOUT $stdout;
 	print STDERR $stderr;
-	subprocerr("LC_ALL=C patch " . join(" ", @{$opts{options}}) .
-	           " < " . $self->get_filename());
+	subprocerr('LC_ALL=C patch ' . join(' ', @{$opts{options}}) .
+	           ' < ' . $self->get_filename());
     }
     $self->close();
     # Reset the timestamp of all the patched files
@@ -563,11 +563,11 @@ sub apply {
     foreach my $fn (@files) {
 	if ($opts{force_timestamp}) {
 	    utime($now, $now, $fn) || $! == ENOENT ||
-		syserr(_g("cannot change timestamp for %s"), $fn);
+		syserr(_g('cannot change timestamp for %s'), $fn);
 	}
 	if ($opts{remove_backup}) {
-	    $fn .= ".dpkg-orig";
-	    unlink($fn) || syserr(_g("remove patch backup file %s"), $fn);
+	    $fn .= '.dpkg-orig';
+	    unlink($fn) || syserr(_g('remove patch backup file %s'), $fn);
 	}
     }
     return $analysis;
@@ -586,7 +586,7 @@ sub check_apply {
     my $analysis = $self->analyze($destdir, %opts);
     $self->prepare_apply($analysis, %opts);
     # Apply the patch
-    $self->ensure_open("r");
+    $self->ensure_open('r');
     my $error;
     my $patch_pid = spawn(
 	exec => [ 'patch', @{$opts{options}} ],
@@ -599,7 +599,7 @@ sub check_apply {
     );
     wait_child($patch_pid, nocheck => 1);
     my $exit = WEXITSTATUS($?);
-    subprocerr("patch --dry-run") unless WIFEXITED($?);
+    subprocerr('patch --dry-run') unless WIFEXITED($?);
     $self->close();
     return ($exit == 0);
 }
@@ -608,16 +608,16 @@ sub check_apply {
 sub get_type {
     my $file = shift;
     if (not lstat($file)) {
-        return _g("nonexistent") if $! == ENOENT;
-        syserr(_g("cannot stat %s"), $file);
+        return _g('nonexistent') if $! == ENOENT;
+        syserr(_g('cannot stat %s'), $file);
     } else {
-        -f _ && return _g("plain file");
-        -d _ && return _g("directory");
-        -l _ && return sprintf(_g("symlink to %s"), readlink($file));
-        -b _ && return _g("block device");
-        -c _ && return _g("character device");
-        -p _ && return _g("named pipe");
-        -S _ && return _g("named socket");
+        -f _ && return _g('plain file');
+        -d _ && return _g('directory');
+        -l _ && return sprintf(_g('symlink to %s'), readlink($file));
+        -b _ && return _g('block device');
+        -c _ && return _g('character device');
+        -p _ && return _g('named pipe');
+        -S _ && return _g('named socket');
     }
 }
 

+ 30 - 30
scripts/Dpkg/Source/Quilt.pm

@@ -18,7 +18,7 @@ package Dpkg::Source::Quilt;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
@@ -51,26 +51,26 @@ sub setup_db {
     my ($self) = @_;
     my $db_dir = $self->get_db_file();
     if (not -d $db_dir) {
-        mkdir $db_dir or syserr(_g("cannot mkdir %s"), $db_dir);
+        mkdir $db_dir or syserr(_g('cannot mkdir %s'), $db_dir);
     }
-    my $file = $self->get_db_file(".version");
+    my $file = $self->get_db_file('.version');
     if (not -e $file) {
-        open(my $version_fh, ">", $file) or syserr(_g("cannot write %s"), $file);
+        open(my $version_fh, '>', $file) or syserr(_g('cannot write %s'), $file);
         print $version_fh "2\n";
         close($version_fh);
     }
     # The files below are used by quilt to know where patches are stored
     # and what file contains the patch list (supported by quilt >= 0.48-5
     # in Debian).
-    $file = $self->get_db_file(".quilt_patches");
+    $file = $self->get_db_file('.quilt_patches');
     if (not -e $file) {
-        open(my $qpatch_fh, ">", $file) or syserr(_g("cannot write %s"), $file);
+        open(my $qpatch_fh, '>', $file) or syserr(_g('cannot write %s'), $file);
         print $qpatch_fh "debian/patches\n";
         close($qpatch_fh);
     }
-    $file = $self->get_db_file(".quilt_series");
+    $file = $self->get_db_file('.quilt_series');
     if (not -e $file) {
-        open(my $qseries_fh, ">", $file) or syserr(_g("cannot write %s"), $file);
+        open(my $qseries_fh, '>', $file) or syserr(_g('cannot write %s'), $file);
         my $series = $self->get_series_file();
         $series = (File::Spec->splitpath($series))[2];
         print $qseries_fh "$series\n";
@@ -81,7 +81,7 @@ sub setup_db {
 sub load_db {
     my ($self) = @_;
 
-    my $pc_applied = $self->get_db_file("applied-patches");
+    my $pc_applied = $self->get_db_file('applied-patches');
     $self->{applied_patches} = [ $self->read_patch_list($pc_applied) ];
 }
 
@@ -89,9 +89,9 @@ sub write_db {
     my ($self) = @_;
 
     $self->setup_db();
-    my $pc_applied = $self->get_db_file("applied-patches");
-    open(my $applied_fh, ">", $pc_applied) or
-        syserr(_g("cannot write %s"), $pc_applied);
+    my $pc_applied = $self->get_db_file('applied-patches');
+    open(my $applied_fh, '>', $pc_applied) or
+        syserr(_g('cannot write %s'), $pc_applied);
     foreach my $patch (@{$self->{applied_patches}}) {
         print $applied_fh "$patch\n";
     }
@@ -141,7 +141,7 @@ sub push {
     my $path = $self->get_patch_file($patch);
     my $obj = Dpkg::Source::Patch->new(filename => $path);
 
-    info(_g("applying %s"), $patch) if $opts{verbose};
+    info(_g('applying %s'), $patch) if $opts{verbose};
     eval {
         $obj->apply($self->{dir}, timestamp => $opts{timestamp},
                     verbose => $opts{verbose},
@@ -151,9 +151,9 @@ sub push {
                                  '-B', ".pc/$patch/", '--reject-file=-' ]);
     };
     if ($@) {
-        info(_g("fuzz is not allowed when applying patches"));
+        info(_g('fuzz is not allowed when applying patches'));
         info(_g("if patch '%s' is correctly applied by quilt, use '%s' to update it"),
-             $patch, "quilt refresh");
+             $patch, 'quilt refresh');
         $self->restore_quilt_backup_files($patch, %opts);
         erasedir($self->get_db_file($patch));
         die $@;
@@ -171,7 +171,7 @@ sub pop {
     my $patch = $self->top();
     return unless defined $patch;
 
-    info(_g("unapplying %s"), $patch) if $opts{verbose};
+    info(_g('unapplying %s'), $patch) if $opts{verbose};
     my $backup_dir = $self->get_db_file($patch);
     if (-d $backup_dir and not $opts{reverse_apply}) {
         # Use the backup copies to restore
@@ -195,9 +195,9 @@ sub pop {
 
 sub get_db_version {
     my ($self) = @_;
-    my $pc_ver = $self->get_db_file(".version");
+    my $pc_ver = $self->get_db_file('.version');
     if (-f $pc_ver) {
-        open(my $ver_fh, "<", $pc_ver) || syserr(_g("cannot read %s"), $pc_ver);
+        open(my $ver_fh, '<', $pc_ver) || syserr(_g('cannot read %s'), $pc_ver);
         my $version = <$ver_fh>;
         chomp $version;
         close($ver_fh);
@@ -210,20 +210,20 @@ sub find_problems {
     my ($self) = @_;
     my $patch_dir = $self->get_patch_file();
     if (-e $patch_dir and not -d _) {
-        return sprintf(_g("%s should be a directory or non-existing"), $patch_dir);
+        return sprintf(_g('%s should be a directory or non-existing'), $patch_dir);
     }
     my $series = $self->get_series_file();
     if (-e $series and not -f _) {
-        return sprintf(_g("%s should be a file or non-existing"), $series);
+        return sprintf(_g('%s should be a file or non-existing'), $series);
     }
     return;
 }
 
 sub get_series_file {
     my ($self) = @_;
-    my $vendor = lc(get_current_vendor() || "debian");
+    my $vendor = lc(get_current_vendor() || 'debian');
     # Series files are stored alongside patches
-    my $default_series = $self->get_patch_file("series");
+    my $default_series = $self->get_patch_file('series');
     my $vendor_series = $self->get_patch_file("$vendor.series");
     return $vendor_series if -e $vendor_series;
     return $default_series;
@@ -231,7 +231,7 @@ sub get_series_file {
 
 sub get_db_file {
     my $self = shift;
-    return File::Spec->catfile($self->{dir}, ".pc", @_);
+    return File::Spec->catfile($self->{dir}, '.pc', @_);
 }
 
 sub get_db_dir {
@@ -241,7 +241,7 @@ sub get_db_dir {
 
 sub get_patch_file {
     my $self = shift;
-    return File::Spec->catfile($self->{dir}, "debian", "patches", @_);
+    return File::Spec->catfile($self->{dir}, 'debian', 'patches', @_);
 }
 
 sub get_patch_dir {
@@ -256,7 +256,7 @@ sub read_patch_list {
     return () if not defined $file or not -f $file;
     $opts{warn_options} //= 0;
     my @patches;
-    open(my $series_fh, "<" , $file) || syserr(_g("cannot read %s"), $file);
+    open(my $series_fh, '<' , $file) || syserr(_g('cannot read %s'), $file);
     while (defined($_ = <$series_fh>)) {
         chomp; s/^\s+//; s/\s+$//; # Strip leading/trailing spaces
         s/(^|\s+)#.*$//; # Strip comment
@@ -264,13 +264,13 @@ sub read_patch_list {
         if (/^(\S+)\s+(.*)$/) {
             $_ = $1;
             if ($2 ne '-p1') {
-                warning(_g("the series file (%s) contains unsupported " .
+                warning(_g('the series file (%s) contains unsupported ' .
                            "options ('%s', line %s); dpkg-source might " .
-                           "fail when applying patches"),
+                           'fail when applying patches'),
                         $file, $2, $.) if $opts{warn_options};
             }
         }
-        error(_g("%s contains an insecure path: %s"), $file, $_) if m{(^|/)\.\./};
+        error(_g('%s contains an insecure path: %s'), $file, $_) if m{(^|/)\.\./};
         CORE::push @patches, $_;
     }
     close($series_fh);
@@ -281,7 +281,7 @@ sub restore_quilt_backup_files {
     my ($self, $patch, %opts) = @_;
     my $patch_dir = $self->get_db_file($patch);
     return unless -d $patch_dir;
-    info(_g("restoring quilt backup files for %s"), $patch) if $opts{verbose};
+    info(_g('restoring quilt backup files for %s'), $patch) if $opts{verbose};
     find({
         no_chdir => 1,
         wanted => sub {
@@ -293,7 +293,7 @@ sub restore_quilt_backup_files {
                 make_path(dirname($target));
                 unless (link($_, $target)) {
                     copy($_, $target) ||
-                        syserr(_g("failed to copy %s to %s"), $_, $target);
+                        syserr(_g('failed to copy %s to %s'), $_, $target);
                     chmod($target, (stat(_))[2]) ||
                         syserr(_g("unable to change permission of `%s'"), $target);
                 }

+ 14 - 13
scripts/Dpkg/Substvars.pm

@@ -19,7 +19,7 @@ package Dpkg::Substvars;
 use strict;
 use warnings;
 
-our $VERSION = "1.02";
+our $VERSION = '1.02';
 
 use Dpkg qw($version);
 use Dpkg::Arch qw(get_host_arch);
@@ -67,14 +67,14 @@ sub new {
     my $class = ref($this) || $this;
     my $self = {
         vars => {
-            "Newline" => "\n",
-            "Space" => " ",
-            "Tab" => "\t",
-            "dpkg:Version" => $version,
-            "dpkg:Upstream-Version" => $version,
+            'Newline' => "\n",
+            'Space' => ' ',
+            'Tab' => "\t",
+            'dpkg:Version' => $version,
+            'dpkg:Upstream-Version' => $version,
             },
         used => {},
-	msg_prefix => "",
+	msg_prefix => '',
     };
     $self->{vars}{'dpkg:Upstream-Version'} =~ s/-[^-]+$//;
     bless $self, $class;
@@ -152,7 +152,7 @@ Obsolete function, use mark_as_used() instead.
 
 sub no_warn {
     my ($self, $key) = @_;
-    carp "obsolete no_warn() function, use mark_as_used() instead";
+    carp 'obsolete no_warn() function, use mark_as_used() instead';
     $self->mark_as_used($key);
 }
 
@@ -174,7 +174,7 @@ sub parse {
 	next if m/^\s*\#/ || !m/\S/;
 	s/\s*\n$//;
 	m/^(\w[-:0-9A-Za-z]*)\=(.*)$/ ||
-	    error(_g("bad line in substvars file %s at line %d"),
+	    error(_g('bad line in substvars file %s at line %d'),
 		  $varlistfile, $.);
 	$self->{vars}{$1} = $2;
     }
@@ -253,7 +253,7 @@ sub substvars {
             $self->mark_as_used($vn);
             $count++;
         } else {
-            warning($opts{msg_prefix} . _g("unknown substitution variable \${%s}"),
+            warning($opts{msg_prefix} . _g('unknown substitution variable ${%s}'),
 	            $vn) unless $opts{no_warn};
             $v = $lhs . $rhs;
         }
@@ -276,8 +276,9 @@ sub warn_about_unused {
         # Empty substitutions variables are ignored on the basis
         # that they are not required in the current situation
         # (example: debhelper's misc:Depends in many cases)
-        next if $self->{vars}{$vn} eq "";
-        warning($opts{msg_prefix} . _g("unused substitution variable \${%s}"), $vn);
+        next if $self->{vars}{$vn} eq '';
+        warning($opts{msg_prefix} . _g('unused substitution variable ${%s}'),
+                $vn);
     }
 }
 
@@ -312,7 +313,7 @@ filehandle and return the content written.
 
 sub output {
     my ($self, $fh) = @_;
-    my $str = "";
+    my $str = '';
     # Store all non-automatic substitutions only
     foreach my $vn (sort keys %{$self->{vars}}) {
 	next if /^(?:(?:dpkg|source|binary):(?:Source-)?Version|Space|Tab|Newline|Arch|Source-Version|F:.+)$/;

+ 2 - 2
scripts/Dpkg/Vars.pm

@@ -19,7 +19,7 @@ package Dpkg::Vars;
 use strict;
 use warnings;
 
-our $VERSION = "0.02";
+our $VERSION = '0.02';
 
 use Dpkg::ErrorHandling;
 use Dpkg::Gettext;
@@ -37,7 +37,7 @@ sub set_source_package {
 
     if (defined($sourcepackage)) {
         $v eq $sourcepackage ||
-            error(_g("source package has two conflicting values - %s and %s"),
+            error(_g('source package has two conflicting values - %s and %s'),
                   $sourcepackage, $v);
     } else {
         $sourcepackage = $v;

+ 8 - 8
scripts/Dpkg/Vendor.pm

@@ -18,7 +18,7 @@ package Dpkg::Vendor;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::ErrorHandling;
 use Dpkg::Gettext;
@@ -29,7 +29,7 @@ use base qw(Exporter);
 our @EXPORT_OK = qw(get_vendor_info get_current_vendor get_vendor_file
                     get_vendor_object run_vendor_hook);
 
-my $origins = "/etc/dpkg/origins";
+my $origins = '/etc/dpkg/origins';
 $origins = $ENV{DPKG_ORIGINS_DIR} if $ENV{DPKG_ORIGINS_DIR};
 
 =encoding utf8
@@ -70,11 +70,11 @@ if there's no file for the given vendor.
 =cut
 
 sub get_vendor_info(;$) {
-    my $vendor = shift || "default";
+    my $vendor = shift || 'default';
     my $file = get_vendor_file($vendor);
     return unless $file;
     my $fields = Dpkg::Control::Hash->new();
-    $fields->load($file) || error(_g("%s is empty"), $file);
+    $fields->load($file) || error(_g('%s is empty'), $file);
     return $fields;
 }
 
@@ -86,7 +86,7 @@ name.
 =cut
 
 sub get_vendor_file(;$) {
-    my $vendor = shift || "default";
+    my $vendor = shift || 'default';
     my $file;
     my @tries = ($vendor, lc($vendor), ucfirst($vendor), ucfirst(lc($vendor)));
     if ($vendor =~ s/\s+/-/) {
@@ -128,14 +128,14 @@ object.
 
 my %OBJECT_CACHE;
 sub get_vendor_object {
-    my $vendor = shift || get_current_vendor() || "Default";
+    my $vendor = shift || get_current_vendor() || 'Default';
     return $OBJECT_CACHE{$vendor} if exists $OBJECT_CACHE{$vendor};
 
     my ($obj, @names);
-    if ($vendor ne "Default") {
+    if ($vendor ne 'Default') {
         push @names, $vendor, lc($vendor), ucfirst($vendor), ucfirst(lc($vendor));
     }
-    foreach my $name (@names, "Default") {
+    foreach my $name (@names, 'Default') {
         eval qq{
             require Dpkg::Vendor::$name;
             \$obj = Dpkg::Vendor::$name->new();

+ 25 - 25
scripts/Dpkg/Vendor/Debian.pm

@@ -22,7 +22,7 @@ package Dpkg::Vendor::Debian;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use base qw(Dpkg::Vendor::Default);
 
@@ -48,11 +48,11 @@ for Debian specific actions.
 sub run_hook {
     my ($self, $hook, @params) = @_;
 
-    if ($hook eq "keyrings") {
+    if ($hook eq 'keyrings') {
         return ('/usr/share/keyrings/debian-keyring.gpg',
                 '/usr/share/keyrings/debian-maintainers.gpg');
-    } elsif ($hook eq "register-custom-fields") {
-    } elsif ($hook eq "extend-patch-header") {
+    } elsif ($hook eq 'register-custom-fields') {
+    } elsif ($hook eq 'extend-patch-header') {
         my ($textref, $ch_info) = @params;
 	if ($ch_info->{'Closes'}) {
 	    foreach my $bug (split(/\s+/, $ch_info->{'Closes'})) {
@@ -66,7 +66,7 @@ sub run_hook {
 	foreach my $bug (@$b) {
 	    $$textref .= "Bug-Ubuntu: https://bugs.launchpad.net/bugs/$bug\n";
 	}
-    } elsif ($hook eq "update-buildflags") {
+    } elsif ($hook eq 'update-buildflags') {
 	$self->add_hardening_flags(@params);
     } else {
         return $self->SUPER::run_hook($hook, @params);
@@ -80,7 +80,7 @@ sub add_hardening_flags {
 
     unless (defined $abi and defined $os and defined $cpu) {
         warning(_g("unknown host architecture '%s'"), $arch);
-        ($abi, $os, $cpu) = ("", "", "");
+        ($abi, $os, $cpu) = ('', '', '');
     }
 
     # Features enabled by default for all builds.
@@ -94,23 +94,23 @@ sub add_hardening_flags {
     );
 
     # Adjust features based on Maintainer's desires.
-    my $opts = Dpkg::BuildOptions->new(envvar => "DEB_BUILD_MAINT_OPTIONS");
-    foreach my $feature (split(",", $opts->get("hardening") // "")) {
+    my $opts = Dpkg::BuildOptions->new(envvar => 'DEB_BUILD_MAINT_OPTIONS');
+    foreach my $feature (split(',', $opts->get('hardening') // '')) {
 	$feature = lc($feature);
 	if ($feature =~ s/^([+-])//) {
-	    my $value = ($1 eq "+") ? 1 : 0;
-	    if ($feature eq "all") {
+	    my $value = ($1 eq '+') ? 1 : 0;
+	    if ($feature eq 'all') {
 		$use_feature{$_} = $value foreach keys %use_feature;
 	    } else {
 		if (exists $use_feature{$feature}) {
 		    $use_feature{$feature} = $value;
 		} else {
-		    warning(_g("unknown hardening feature: %s"), $feature);
+		    warning(_g('unknown hardening feature: %s'), $feature);
 		}
 	    }
 	} else {
-	    warning(_g("incorrect value in hardening option of " .
-	               "DEB_BUILD_MAINT_OPTIONS: %s"), $feature);
+	    warning(_g('incorrect value in hardening option of ' .
+	               'DEB_BUILD_MAINT_OPTIONS: %s'), $feature);
 	}
     }
 
@@ -122,7 +122,7 @@ sub add_hardening_flags {
 	#  (#574716).
 	$use_feature{pie} = 0;
     }
-    if ($cpu =~ /^(ia64|alpha|mips|mipsel|hppa)$/ or $arch eq "arm") {
+    if ($cpu =~ /^(ia64|alpha|mips|mipsel|hppa)$/ or $arch eq 'arm') {
 	# Stack protector disabled on ia64, alpha, mips, mipsel, hppa.
 	#   "warning: -fstack-protector not supported for this target"
 	# Stack protector disabled on arm (ok on armel).
@@ -149,41 +149,41 @@ sub add_hardening_flags {
 
     # PIE
     if ($use_feature{pie}) {
-	$flags->append("CFLAGS", "-fPIE");
-	$flags->append("CXXFLAGS", "-fPIE");
-	$flags->append("LDFLAGS", "-fPIE -pie");
+	$flags->append('CFLAGS', '-fPIE');
+	$flags->append('CXXFLAGS', '-fPIE');
+	$flags->append('LDFLAGS', '-fPIE -pie');
     }
 
     # Stack protector
     if ($use_feature{stackprotector}) {
-	$flags->append("CFLAGS", "-fstack-protector --param=ssp-buffer-size=4");
-	$flags->append("CXXFLAGS", "-fstack-protector --param=ssp-buffer-size=4");
+	$flags->append('CFLAGS', '-fstack-protector --param=ssp-buffer-size=4');
+	$flags->append('CXXFLAGS', '-fstack-protector --param=ssp-buffer-size=4');
     }
 
     # Fortify Source
     if ($use_feature{fortify}) {
-	$flags->append("CPPFLAGS", "-D_FORTIFY_SOURCE=2");
+	$flags->append('CPPFLAGS', '-D_FORTIFY_SOURCE=2');
     }
 
     # Format Security
     if ($use_feature{format}) {
-	$flags->append("CFLAGS", "-Wformat -Werror=format-security");
-	$flags->append("CXXFLAGS", "-Wformat -Werror=format-security");
+	$flags->append('CFLAGS', '-Wformat -Werror=format-security');
+	$flags->append('CXXFLAGS', '-Wformat -Werror=format-security');
     }
 
     # Read-only Relocations
     if ($use_feature{relro}) {
-	$flags->append("LDFLAGS", "-Wl,-z,relro");
+	$flags->append('LDFLAGS', '-Wl,-z,relro');
     }
 
     # Bindnow
     if ($use_feature{bindnow}) {
-	$flags->append("LDFLAGS", "-Wl,-z,now");
+	$flags->append('LDFLAGS', '-Wl,-z,now');
     }
 
     # Store the feature usage.
     while (my ($feature, $enabled) = each %use_feature) {
-	$flags->set_feature("hardening", $feature, $enabled);
+	$flags->set_feature('hardening', $feature, $enabled);
     }
 }
 

+ 7 - 7
scripts/Dpkg/Vendor/Default.pm

@@ -18,7 +18,7 @@ package Dpkg::Vendor::Default;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 # If you use this file as template to create a new vendor object, please
 # uncomment the following lines
@@ -111,17 +111,17 @@ Dpkg::BuildFlags object.
 sub run_hook {
     my ($self, $hook, @params) = @_;
 
-    if ($hook eq "before-source-build") {
+    if ($hook eq 'before-source-build') {
         my $srcpkg = shift @params;
-    } elsif ($hook eq "keyrings") {
+    } elsif ($hook eq 'keyrings') {
         return ();
-    } elsif ($hook eq "register-custom-fields") {
+    } elsif ($hook eq 'register-custom-fields') {
         return ();
-    } elsif ($hook eq "post-process-changelog-entry") {
+    } elsif ($hook eq 'post-process-changelog-entry') {
         my $fields = shift @params;
-    } elsif ($hook eq "extend-patch-header") {
+    } elsif ($hook eq 'extend-patch-header') {
 	my ($textref, $ch_info) = @params;
-    } elsif ($hook eq "update-buildflags") {
+    } elsif ($hook eq 'update-buildflags') {
 	my $flags = shift @params;
     }
 

+ 19 - 18
scripts/Dpkg/Vendor/Ubuntu.pm

@@ -22,7 +22,7 @@ package Dpkg::Vendor::Ubuntu;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = '0.01';
 
 use Dpkg::ErrorHandling;
 use Dpkg::Gettext;
@@ -49,7 +49,7 @@ to check that Maintainers have been modified if necessary.
 sub run_hook {
     my ($self, $hook, @params) = @_;
 
-    if ($hook eq "before-source-build") {
+    if ($hook eq 'before-source-build') {
         my $src = shift @params;
         my $fields = $src->{fields};
 
@@ -69,31 +69,31 @@ sub run_hook {
            }
         }
 
-    } elsif ($hook eq "keyrings") {
+    } elsif ($hook eq 'keyrings') {
         my @keyrings = $self->SUPER::run_hook($hook);
 
         push(@keyrings, '/usr/share/keyrings/ubuntu-archive-keyring.gpg');
         return @keyrings;
 
-    } elsif ($hook eq "register-custom-fields") {
+    } elsif ($hook eq 'register-custom-fields') {
         my @field_ops = $self->SUPER::run_hook($hook);
         push @field_ops,
-            [ "register", "Launchpad-Bugs-Fixed",
+            [ 'register', 'Launchpad-Bugs-Fixed',
               CTRL_FILE_CHANGES | CTRL_CHANGELOG  ],
-            [ "insert_after", CTRL_FILE_CHANGES, "Closes", "Launchpad-Bugs-Fixed" ],
-            [ "insert_after", CTRL_CHANGELOG, "Closes", "Launchpad-Bugs-Fixed" ];
+            [ 'insert_after', CTRL_FILE_CHANGES, 'Closes', 'Launchpad-Bugs-Fixed' ],
+            [ 'insert_after', CTRL_CHANGELOG, 'Closes', 'Launchpad-Bugs-Fixed' ];
         return @field_ops;
 
-    } elsif ($hook eq "post-process-changelog-entry") {
+    } elsif ($hook eq 'post-process-changelog-entry') {
         my $fields = shift @params;
 
         # Add Launchpad-Bugs-Fixed field
-        my $bugs = find_launchpad_closes($fields->{"Changes"} || "");
+        my $bugs = find_launchpad_closes($fields->{'Changes'} || '');
         if (scalar(@$bugs)) {
-            $fields->{"Launchpad-Bugs-Fixed"} = join(" ", @$bugs);
+            $fields->{'Launchpad-Bugs-Fixed'} = join(' ', @$bugs);
         }
 
-    } elsif ($hook eq "update-buildflags") {
+    } elsif ($hook eq 'update-buildflags') {
 	my $flags = shift @params;
 
 	if (debarch_eq(get_host_arch(), 'ppc64')) {
@@ -110,19 +110,19 @@ sub run_hook {
 	# Allow control of hardening-wrapper via dpkg-buildpackage DEB_BUILD_OPTIONS
 	my $build_opts = Dpkg::BuildOptions->new();
 	my $hardening;
-	if ($build_opts->has("hardening")) {
-	    $hardening = $build_opts->get("hardening") // 1;
+	if ($build_opts->has('hardening')) {
+	    $hardening = $build_opts->get('hardening') // 1;
 	}
-	if ($build_opts->has("nohardening")) {
+	if ($build_opts->has('nohardening')) {
 	    $hardening = 0;
 	}
 	if (defined $hardening) {
 	    my $flag = 'DEB_BUILD_HARDENING';
-	    if ($hardening ne "0") {
+	    if ($hardening ne '0') {
 		if (!find_command('hardened-cc')) {
 		    syserr(_g("'hardening' flag found but 'hardening-wrapper' not installed"));
 		}
-		if ($hardening ne "1") {
+		if ($hardening ne '1') {
 		    my @options = split(/,\s*/, $hardening);
 		    $hardening = 1;
 
@@ -132,14 +132,15 @@ sub run_hook {
 			my $upitem = uc($item);
 			foreach my $option (@options) {
 			    if ($option =~ /^(no)?$item$/) {
-				$flags->set($flag.'_'.$upitem, not defined $1 or $1 eq "", 'env');
+				$flags->set($flag . '_' . $upitem,
+				            not defined $1 or $1 eq '', 'env');
 			    }
 			}
 		    }
 		}
 	    }
 	    if (defined $ENV{$flag}) {
-		info(_g("overriding %s in environment: %s"), $flag, $hardening);
+		info(_g('overriding %s in environment: %s'), $flag, $hardening);
 	    }
 	    $flags->set($flag, $hardening, 'env');
 	}

+ 12 - 12
scripts/Dpkg/Version.pm

@@ -21,7 +21,7 @@ package Dpkg::Version;
 use strict;
 use warnings;
 
-our $VERSION = "1.00";
+our $VERSION = '1.00';
 
 use Dpkg::ErrorHandling;
 use Dpkg::Gettext;
@@ -155,7 +155,7 @@ its string representation is a version number.
 
 sub comparison {
     my ($a, $b, $inverted) = @_;
-    if (not ref($b) or not $b->isa("Dpkg::Version")) {
+    if (not ref($b) or not $b->isa('Dpkg::Version')) {
         $b = Dpkg::Version->new($b);
     }
     ($a, $b) = ($b, $a) if $inverted;
@@ -174,10 +174,10 @@ Returns the string representation of the version number.
 
 sub as_string {
     my ($self) = @_;
-    my $str = "";
-    $str .= $self->{epoch} . ":" unless $self->{no_epoch};
+    my $str = '';
+    $str .= $self->{epoch} . ':' unless $self->{no_epoch};
     $str .= $self->{version};
-    $str .= "-" . $self->{revision} unless $self->{no_revision};
+    $str .= '-' . $self->{revision} unless $self->{no_revision};
     return $str;
 }
 
@@ -201,9 +201,9 @@ If $a or $b are not valid version numbers, it dies with an error.
 sub version_compare($$) {
     my ($a, $b) = @_;
     my $va = Dpkg::Version->new($a, check => 1);
-    defined($va) || error(_g("%s is not a valid version"), "$a");
+    defined($va) || error(_g('%s is not a valid version'), "$a");
     my $vb = Dpkg::Version->new($b, check => 1);
-    defined($vb) || error(_g("%s is not a valid version"), "$b");
+    defined($vb) || error(_g('%s is not a valid version'), "$b");
     return $va <=> $vb;
 }
 
@@ -250,7 +250,7 @@ they are obsolete aliases of ">=" and "<=".
 sub version_normalize_relation($) {
     my $op = shift;
 
-    warning("relation %s is deprecated: use %s or %s",
+    warning('relation %s is deprecated: use %s or %s',
             $op, "$op$op", "$op=") if ($op eq '>' or $op eq '<');
 
     if ($op eq '>>' or $op eq 'gt') {
@@ -369,12 +369,12 @@ sub version_check($) {
         $version = Dpkg::Version->new($str) unless ref($version);
     }
     if (not defined($str) or not length($str)) {
-        my $msg = _g("version number cannot be empty");
+        my $msg = _g('version number cannot be empty');
         return (0, $msg) if wantarray;
         return 0;
     }
     if ($version->version() =~ m/^[^\d]/) {
-        my $msg = _g("version number does not start with digit");
+        my $msg = _g('version number does not start with digit');
         return (0, $msg) if wantarray;
         return 0;
     }
@@ -384,12 +384,12 @@ sub version_check($) {
         return 0;
     }
     if ($version->epoch() !~ /^\d*$/) {
-        my $msg = sprintf(_g("epoch part of the version number " .
+        my $msg = sprintf(_g('epoch part of the version number ' .
                              "is not a number: '%s'"), $version->epoch());
         return (0, $msg) if wantarray;
         return 0;
     }
-    return (1, "") if wantarray;
+    return (1, '') if wantarray;
     return 1;
 }
 

+ 4 - 4
scripts/Makefile.am

@@ -115,10 +115,10 @@ man3_MANS =
 
 do_perl_subst = $(AM_V_GEN) \
 		sed -e "s:^\#![[:space:]]*/usr/bin/perl:\#!$(PERL):" \
-		    -e "s:\$$dpkglibdir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$dpkglibdir=\"$(pkglibdir)\":" \
-		    -e "s:\$$pkgdatadir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$pkgdatadir=\"$(pkgdatadir)\":" \
-		    -e "s:\$$admindir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$admindir=\"$(admindir)\":" \
-		    -e "s:\$$version[[:space:]]*=[[:space:]]*['\"][^'\"]*[\"']:\$$version=\"$(PACKAGE_VERSION)\":"
+		    -e "s:\$$dpkglibdir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$dpkglibdir='$(pkglibdir)':" \
+		    -e "s:\$$pkgdatadir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$pkgdatadir='$(pkgdatadir)':" \
+		    -e "s:\$$admindir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$admindir='$(admindir)':" \
+		    -e "s:\$$version[[:space:]]*=[[:space:]]*['\"][^'\"]*[\"']:\$$version='$(PACKAGE_VERSION)':"
 
 do_shell_subst = $(AM_V_GEN) \
 		 sed -e "s:^version[[:space:]]*=[[:space:]]*['\"][^'\"]*[\"']:version=\"$(PACKAGE_VERSION)\":"

+ 19 - 18
scripts/changelog/debian.pl

@@ -29,17 +29,17 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 use Dpkg::Changelog::Debian;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 $progname = "parsechangelog/$progname";
 
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    printf _g("
+    printf _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
@@ -89,19 +89,20 @@ sub set_format {
     $format = $val;
 }
 
-GetOptions( "file=s" => \$file,
-	    "label|l=s" => \$label,
-	    "since|v=s" => \$since,
-	    "until|u=s" => \$until,
-	    "from|f=s" => \$from,
-	    "to|t=s" => \$to,
-	    "count|c|n=i" => \$count,
-	    "offset|o=i" => \$offset,
-	    "help|?" => sub{ usage(); exit(0) },
-	    "version|V" => sub{version();exit(0)},
-	    "format=s" => \&set_format,
-	    "all|a" => \$all,
-	    )
+GetOptions(
+    'file=s' => \$file,
+    'label|l=s' => \$label,
+    'since|v=s' => \$since,
+    'until|u=s' => \$until,
+    'from|f=s' => \$from,
+    'to|t=s' => \$to,
+    'count|c|n=i' => \$count,
+    'offset|o=i' => \$offset,
+    'help|?' => sub{ usage(); exit(0) },
+    'version|V' => sub{version();exit(0)},
+    'format=s' => \&set_format,
+    'all|a' => \$all,
+)
     or do { usage(); exit(2) };
 
 usageerr('too many arguments') if @ARGV > 1;
@@ -132,7 +133,7 @@ my $range = {
 my $changes = Dpkg::Changelog::Debian->new(reportfile => $label, range => $range);
 
 if ($file eq '-') {
-    $changes->parse(\*STDIN, _g("<standard input>"))
+    $changes->parse(\*STDIN, _g('<standard input>'))
 	or error(_g('fatal error occurred while parsing input'));
 } else {
     $changes->load($file)
@@ -144,5 +145,5 @@ eval qq{
     print \$output if defined \$output;
 };
 if ($@) {
-    error("%s", $@);
+    error('%s', $@);
 }

+ 20 - 20
scripts/dpkg-architecture.pl

@@ -31,28 +31,28 @@ use Dpkg::Arch qw(get_raw_build_arch get_raw_host_arch get_gcc_host_gnu_type
                   debarch_to_gnutriplet gnutriplet_to_debarch
                   debarch_to_multiarch);
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    printf _g("
+    printf _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<option>...] [<command>]")
+'Usage: %s [<option>...] [<command>]')
     . "\n\n" . _g(
-"Options:
+'Options:
   -a<debian-arch>    set current Debian architecture.
   -t<gnu-system>     set current GNU system type.
   -L                 list valid architectures.
-  -f                 force flag (override variables set in environment).")
+  -f                 force flag (override variables set in environment).')
     . "\n\n" . _g(
-"Commands:
+'Commands:
   -l                 list variables (default).
   -e<debian-arch>    compare with current Debian architecture.
   -i<arch-alias>     check if current Debian architecture is <arch-alias>.
@@ -62,7 +62,7 @@ sub usage {
   -c <command>       set environment and run the command in it.
   -?, --help         show this help message.
       --version      show the version.
-"), $progname;
+'), $progname;
 }
 
 sub list_arches()
@@ -144,7 +144,7 @@ while (@ARGV) {
         $force=1;
     } elsif (m/^-q/) {
 	my $varname = "$'";
-	error(_g("%s is not a supported variable name"), $varname)
+	error(_g('%s is not a supported variable name'), $varname)
 	    unless (exists $arch_vars{$varname});
 	$req_variable_to_print = "$varname";
 	$req_vars = $arch_vars{$varname};
@@ -196,25 +196,25 @@ if (action_needs(DEB_BUILD | DEB_GNU_INFO)) {
 
 if ($req_host_arch ne '' && $req_host_gnu_type eq '') {
     $req_host_gnu_type = debarch_to_gnutriplet($req_host_arch);
-    error(_g("unknown Debian architecture %s, you must specify " .
-             "GNU system type, too"), $req_host_arch)
+    error(_g('unknown Debian architecture %s, you must specify ' .
+             'GNU system type, too'), $req_host_arch)
         unless defined $req_host_gnu_type;
 }
 
 if ($req_host_gnu_type ne '' && $req_host_arch eq '') {
     $req_host_arch = gnutriplet_to_debarch($req_host_gnu_type);
-    error(_g("unknown GNU system type %s, you must specify " .
-             "Debian architecture, too"), $req_host_gnu_type)
+    error(_g('unknown GNU system type %s, you must specify ' .
+             'Debian architecture, too'), $req_host_gnu_type)
         unless defined $req_host_arch;
 }
 
 if ($req_host_gnu_type ne '' && $req_host_arch ne '') {
     my $dfl_host_gnu_type = debarch_to_gnutriplet($req_host_arch);
-    error(_g("unknown default GNU system type for Debian architecture %s"),
+    error(_g('unknown default GNU system type for Debian architecture %s'),
           $req_host_arch)
 	unless defined $dfl_host_gnu_type;
-    warning(_g("default GNU system type %s for Debian arch %s does not " .
-               "match specified GNU system type %s"), $dfl_host_gnu_type,
+    warning(_g('default GNU system type %s for Debian arch %s does not ' .
+               'match specified GNU system type %s'), $dfl_host_gnu_type,
             $req_host_arch, $req_host_gnu_type)
         if $dfl_host_gnu_type ne $req_host_gnu_type;
 }
@@ -246,8 +246,8 @@ if (action_needs(DEB_HOST | DEB_GNU_INFO)) {
 
     my $gcc = get_gcc_host_gnu_type();
 
-    warning(_g("specified GNU system type %s does not match gcc system " .
-               "type %s, try setting a correct CC environment variable"),
+    warning(_g('specified GNU system type %s does not match gcc system ' .
+               'type %s, try setting a correct CC environment variable'),
             $v{DEB_HOST_GNU_TYPE}, $gcc)
         if ($gcc ne '') && ($gcc ne $v{DEB_HOST_GNU_TYPE});
 }
@@ -265,9 +265,9 @@ if ($action eq 'l') {
     foreach my $k (sort keys %arch_vars) {
 	print "$k=$v{$k}; ";
     }
-    print "export " . join(" ", sort keys %arch_vars) . "\n";
+    print 'export ' . join(' ', sort keys %arch_vars) . "\n";
 } elsif ($action eq 'u') {
-    print "unset " . join(" ", sort keys %arch_vars) . "\n";
+    print 'unset ' . join(' ', sort keys %arch_vars) . "\n";
 } elsif ($action eq 'e') {
     exit !debarch_eq($v{DEB_HOST_ARCH}, $req_eq_arch);
 } elsif ($action eq 'i') {

+ 30 - 30
scripts/dpkg-buildflags.pl

@@ -27,22 +27,22 @@ use Dpkg::ErrorHandling qw(:DEFAULT report);
 use Dpkg::BuildFlags;
 use Dpkg::Vendor qw(get_current_vendor);
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    printf _g("
+    printf _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<command>]")
+'Usage: %s [<command>]')
     . "\n\n" . _g(
-"Commands:
+'Commands:
   --get <flag>       output the requested flag to stdout.
   --origin <flag>    output the origin of the flag to stdout:
                      value is one of vendor, system, user, env.
@@ -58,7 +58,7 @@ sub usage {
                      and their origin.
   --help             show this help message.
   --version          show the version.
-"), $progname;
+'), $progname;
 }
 
 my ($param, $action);
@@ -66,20 +66,20 @@ my ($param, $action);
 while (@ARGV) {
     $_ = shift(@ARGV);
     if (m/^--(get|origin|query-features)$/) {
-        usageerr(_g("two commands specified: --%s and --%s"), $1, $action)
+        usageerr(_g('two commands specified: --%s and --%s'), $1, $action)
             if defined($action);
         $action = $1;
         $param = shift(@ARGV);
-	usageerr(_g("%s needs a parameter"), $_) unless defined $param;
+	usageerr(_g('%s needs a parameter'), $_) unless defined $param;
     } elsif (m/^--export(?:=(sh|make|cmdline|configure))?$/) {
-        usageerr(_g("two commands specified: --%s and --%s"), "export", $action)
+        usageerr(_g('two commands specified: --%s and --%s'), 'export', $action)
             if defined($action);
-        my $type = $1 || "sh";
+        my $type = $1 || 'sh';
         # Map legacy aliases.
         $type = 'cmdline' if $type eq 'configure';
         $action = "export-$type";
     } elsif (m/^--(list|status|dump)$/) {
-        usageerr(_g("two commands specified: --%s and --%s"), $1, $action)
+        usageerr(_g('two commands specified: --%s and --%s'), $1, $action)
             if defined($action);
         $action = $1;
     } elsif (m/^-(\?|-help)$/) {
@@ -93,11 +93,11 @@ while (@ARGV) {
     }
 }
 
-$action //= "dump";
+$action //= 'dump';
 
 my $build_flags = Dpkg::BuildFlags->new();
 
-if ($action eq "list") {
+if ($action eq 'list') {
     foreach my $flag ($build_flags->list()) {
 	print "$flag\n";
     }
@@ -106,24 +106,24 @@ if ($action eq "list") {
 
 $build_flags->load_config();
 
-if ($action eq "get") {
+if ($action eq 'get') {
     if ($build_flags->has($param)) {
 	print $build_flags->get($param) . "\n";
 	exit(0);
     }
-} elsif ($action eq "origin") {
+} elsif ($action eq 'origin') {
     if ($build_flags->has($param)) {
 	print $build_flags->get_origin($param) . "\n";
 	exit(0);
     }
-} elsif ($action eq "query-features") {
+} elsif ($action eq 'query-features') {
     if ($build_flags->has_features($param)) {
 	my %features = $build_flags->get_features($param);
 	my $para_shown = 0;
 	foreach my $feature (sort keys %features) {
-	    print $para_shown++ ? "\n" : "";
+	    print $para_shown++ ? "\n" : '';
 	    printf "Feature: %s\n", $feature;
-	    printf "Enabled: %s\n", $features{$feature} ? "yes" : "no";
+	    printf "Enabled: %s\n", $features{$feature} ? 'yes' : 'no';
 	}
 	exit(0);
     }
@@ -132,24 +132,24 @@ if ($action eq "get") {
     foreach my $flag ($build_flags->list()) {
 	next unless $flag =~ /^[A-Z]/; # Skip flags starting with lowercase
 	my $value = $build_flags->get($flag);
-	if ($export_type eq "sh") {
+	if ($export_type eq 'sh') {
 	    $value =~ s/"/\"/g;
 	    print "export $flag=\"$value\"\n";
-	} elsif ($export_type eq "make") {
+	} elsif ($export_type eq 'make') {
 	    $value =~ s/\$/\$\$/g;
 	    print "export $flag := $value\n";
-	} elsif ($export_type eq "cmdline") {
+	} elsif ($export_type eq 'cmdline') {
 	    print "$flag=\"$value\" ";
 	}
     }
     exit(0);
-} elsif ($action eq "dump") {
+} elsif ($action eq 'dump') {
     foreach my $flag ($build_flags->list()) {
 	my $value = $build_flags->get($flag);
 	print "$flag=$value\n";
     }
     exit(0);
-} elsif ($action eq "status") {
+} elsif ($action eq 'status') {
     # Prefix everything with "dpkg-buildflags: status: " to allow easy
     # extraction from a build log. Thus we use report with a non-translated
     # type string.
@@ -160,27 +160,27 @@ if ($action eq "get") {
     my @envvars = Dpkg::BuildEnv::list_accessed();
     for my $envvar (@envvars) {
 	if (exists $ENV{$envvar}) {
-	    printf report("status", "environment variable %s=%s",
+	    printf report('status', 'environment variable %s=%s',
 	           $envvar, $ENV{$envvar});
 	}
     }
-    my $vendor = Dpkg::Vendor::get_current_vendor() || "undefined";
-    print report("status", "vendor is $vendor");
+    my $vendor = Dpkg::Vendor::get_current_vendor() || 'undefined';
+    print report('status', "vendor is $vendor");
     # Then the resulting features:
     foreach my $area (sort $build_flags->get_feature_areas()) {
 	my $fs;
 	my %features = $build_flags->get_features($area);
 	foreach my $feature (sort keys %features) {
-	    $fs .= sprintf(" %s=%s", $feature, $features{$feature} ? "yes" : "no");
+	    $fs .= sprintf(' %s=%s', $feature, $features{$feature} ? 'yes' : 'no');
 	}
-	print report("status", "$area features:$fs");
+	print report('status', "$area features:$fs");
     }
     # Then the resulting values (with their origin):
     foreach my $flag ($build_flags->list()) {
 	my $value = $build_flags->get($flag);
 	my $origin = $build_flags->get_origin($flag);
-	my $maintainer = $build_flags->is_maintainer_modified($flag) ? "+maintainer" : "";
-	print report("status", "$flag [$origin$maintainer]: $value");
+	my $maintainer = $build_flags->is_maintainer_modified($flag) ? '+maintainer' : '';
+	print report('status', "$flag [$origin$maintainer]: $value");
     }
     exit(0);
 }

+ 45 - 45
scripts/dpkg-buildpackage.pl

@@ -37,22 +37,22 @@ use Dpkg::Changelog::Parse;
 use Dpkg::Path qw(find_command);
 use Dpkg::IPC;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 sub showversion {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    print _g("
+    print _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<option>...]")
+'Usage: %s [<option>...]')
     . "\n\n" . _g(
-"Options:
+'Options:
   -F (default)   normal full build (binaries and sources).
   -b             binary-only, do not build source.
   -B             binary-only, no arch-indep files.
@@ -79,13 +79,13 @@ sub usage {
       --admindir=<directory>
                  change the administrative directory.
   -?, --help     show this help message.
-      --version  show the version.")
+      --version  show the version.')
     . "\n\n" . _g(
-"Options passed to dpkg-architecture:
+'Options passed to dpkg-architecture:
   -a<arch>       Debian architecture we build for.
-  -t<system>     set GNU system type.")
+  -t<system>     set GNU system type.')
     . "\n\n" . _g(
-"Options passed to dpkg-genchanges:
+'Options passed to dpkg-genchanges:
   -si (default)  source includes orig if new upstream.
   -sa            uploaded source always includes orig.
   -sd            uploaded source is diff and .dsc only.
@@ -94,9 +94,9 @@ sub usage {
   -e<maint>      maintainer for release is <maint>.
   -C<descfile>   changes are described in <descfile>.
       --changes-option=<opt>
-                 pass option <opt> to dpkg-genchanges.")
+                 pass option <opt> to dpkg-genchanges.')
     . "\n\n" . _g(
-"Options passed to dpkg-source:
+'Options passed to dpkg-source:
   -sn            force Debian native source format.
   -s[sAkurKUR]   see dpkg-source for explanation.
   -z<level>      compression level to use for source.
@@ -105,10 +105,10 @@ sub usage {
   -I[<pattern>]  filter out files when building tarballs.
       --source-option=<opt>
                  pass option <opt> to dpkg-source.
-"), $progname;
+'), $progname;
 }
 
-my @debian_rules = ("debian/rules");
+my @debian_rules = ('debian/rules');
 my @rootcommand = ();
 my $signcommand;
 my ($admindir, $signkey, $usepause, $noclean,
@@ -175,7 +175,7 @@ while (@ARGV) {
 	$checkbuilddep = ($1 eq 'D');
     } elsif (/^-s(gpg|pgp)$/) {
 	# Deprecated option
-	warning(_g("-s%s is deprecated; always using gpg style interface"), $1);
+	warning(_g('-s%s is deprecated; always using gpg style interface'), $1);
     } elsif (/^--force-sign$/) {
 	$signforce = 1;
     } elsif (/^-us$/) {
@@ -203,33 +203,33 @@ while (@ARGV) {
     } elsif (/^-nc$/) {
 	$noclean = 1;
     } elsif (/^-b$/) {
-	build_sourceonly && usageerr(_g("cannot combine %s and %s"), $_, "-S");
+	build_sourceonly && usageerr(_g('cannot combine %s and %s'), $_, '-S');
 	$include = BUILD_BINARY;
 	push @changes_opts, '-b';
 	@checkbuilddep_opts = ();
 	$buildtarget = 'build';
 	$binarytarget = 'binary';
     } elsif (/^-B$/) {
-	build_sourceonly && usageerr(_g("cannot combine %s and %s"), $_, "-S");
+	build_sourceonly && usageerr(_g('cannot combine %s and %s'), $_, '-S');
 	$include = BUILD_ARCH_DEP;
 	push @changes_opts, '-B';
 	@checkbuilddep_opts = ('-B');
 	$buildtarget = 'build-arch';
 	$binarytarget = 'binary-arch';
     } elsif (/^-A$/) {
-	build_sourceonly && usageerr(_g("cannot combine %s and %s"), $_, "-S");
+	build_sourceonly && usageerr(_g('cannot combine %s and %s'), $_, '-S');
 	$include = BUILD_ARCH_INDEP;
 	push @changes_opts, '-A';
 	@checkbuilddep_opts = ('-A');
 	$buildtarget = 'build-indep';
 	$binarytarget = 'binary-indep';
     } elsif (/^-S$/) {
-	build_binaryonly && usageerr(_g("cannot combine %s and %s"), build_opt, "-S");
+	build_binaryonly && usageerr(_g('cannot combine %s and %s'), build_opt, '-S');
 	$include = BUILD_SOURCE;
 	push @changes_opts, '-S';
 	@checkbuilddep_opts = ('-A', '-B');
     } elsif (/^-F$/) {
-	!build_normal && usageerr(_g("cannot combine %s and %s"), $_, build_opt);
+	!build_normal && usageerr(_g('cannot combine %s and %s'), $_, build_opt);
 	$include = BUILD_ALL;
 	@checkbuilddep_opts = ();
     } elsif (/^-v(.*)$/) {
@@ -242,11 +242,11 @@ while (@ARGV) {
 	$desc = $1;
     } elsif (m/^-[EW]$/) {
 	# Deprecated option
-	warning(_g("-E and -W are deprecated, they are without effect"));
+	warning(_g('-E and -W are deprecated, they are without effect'));
     } elsif (/^-R(.*)$/) {
 	@debian_rules = split /\s+/, $1;
     } else {
-	usageerr(_g("unknown option or argument %s"), $_);
+	usageerr(_g('unknown option or argument %s'), $_);
     }
 }
 
@@ -256,15 +256,15 @@ if ($noclean) {
 }
 
 if ($< == 0) {
-    warning(_g("using a gain-root-command while being root")) if (@rootcommand);
+    warning(_g('using a gain-root-command while being root')) if (@rootcommand);
 } else {
-    push @rootcommand, "fakeroot" unless @rootcommand;
+    push @rootcommand, 'fakeroot' unless @rootcommand;
 
     if (!find_command($rootcommand[0])) {
 	if ($rootcommand[0] eq 'fakeroot') {
 	    error(_g("fakeroot not found, either install the fakeroot\n" .
-	             "package, specify a command with the -r option, " .
-	             "or run this as root"));
+	             'package, specify a command with the -r option, ' .
+	             'or run this as root'));
 	} else {
 	    error(_g("gain-root-commmand '%s' not found"), $rootcommand[0]);
 	}
@@ -273,10 +273,10 @@ if ($< == 0) {
 
 my $build_opts = Dpkg::BuildOptions->new();
 if (defined $parallel) {
-    $parallel = $build_opts->get("parallel") if $build_opts->has("parallel");
+    $parallel = $build_opts->get('parallel') if $build_opts->has('parallel');
     $ENV{MAKEFLAGS} ||= '';
     $ENV{MAKEFLAGS} .= " -j$parallel";
-    $build_opts->set("parallel", $parallel);
+    $build_opts->set('parallel', $parallel);
     $build_opts->export();
 }
 
@@ -349,9 +349,9 @@ if (not $signcommand) {
 my $pv = "${pkg}_$sversion";
 my $pva = "${pkg}_${sversion}_$arch";
 
-if (not -x "debian/rules") {
-    warning(_g("debian/rules is not executable; fixing that"));
-    chmod(0755, "debian/rules"); # No checks of failures, non fatal
+if (not -x 'debian/rules') {
+    warning(_g('debian/rules is not executable; fixing that'));
+    chmod(0755, 'debian/rules'); # No checks of failures, non fatal
 }
 
 unless ($call_target) {
@@ -369,12 +369,12 @@ if ($checkbuilddep) {
     if (not WIFEXITED($?)) {
         subprocerr('dpkg-checkbuilddeps');
     } elsif (WEXITSTATUS($?)) {
-	warning(_g("build dependencies/conflicts unsatisfied; aborting"));
-	warning(_g("(Use -d flag to override.)"));
+	warning(_g('build dependencies/conflicts unsatisfied; aborting'));
+	warning(_g('(Use -d flag to override.)'));
 
 	if (build_sourceonly) {
-	    warning(_g("this is currently a non-fatal warning with -S, but " .
-	               "will probably become fatal in the future"));
+	    warning(_g('this is currently a non-fatal warning with -S, but ' .
+	               'will probably become fatal in the future'));
 	} else {
 	    exit 3;
 	}
@@ -396,19 +396,19 @@ unless ($noclean) {
     withecho(@rootcommand, @debian_rules, 'clean');
 }
 unless (build_binaryonly) {
-    warning(_g("building a source package without cleaning up as you asked; " .
-               "it might contain undesired files")) if $noclean;
+    warning(_g('building a source package without cleaning up as you asked; ' .
+               'it might contain undesired files')) if $noclean;
     chdir('..') or syserr('chdir ..');
     withecho('dpkg-source', @source_opts, '-b', $dir);
     chdir($dir) or syserr("chdir $dir");
 }
 
-unless ($buildtarget eq "build" or scalar(@debian_rules) > 1) {
+unless ($buildtarget eq 'build' or scalar(@debian_rules) > 1) {
     # Verify that build-{arch,indep} are supported. If not, fallback to build.
     # This is a temporary measure to not break too many packages on a flag day.
-    my $pid = spawn(exec => [ "make", "-f", @debian_rules, "-qn", $buildtarget ],
-                    from_file => "/dev/null", to_file => "/dev/null",
-                    error_to_file => "/dev/null");
+    my $pid = spawn(exec => [ 'make', '-f', @debian_rules, '-qn', $buildtarget ],
+                    from_file => '/dev/null', to_file => '/dev/null',
+                    error_to_file => '/dev/null');
     my $cmdline = "make -f @debian_rules -qn $buildtarget";
     wait_child($pid, nocheck => 1, cmdline => $cmdline);
     my $exitcode = WEXITSTATUS($?);
@@ -416,8 +416,8 @@ unless ($buildtarget eq "build" or scalar(@debian_rules) > 1) {
     if ($exitcode == 2) {
         warning(_g("%s must be updated to support the 'build-arch' and " .
                    "'build-indep' targets (at least '%s' seems to be " .
-                   "missing)"), "@debian_rules", $buildtarget);
-        $buildtarget = "build";
+                   'missing)'), "@debian_rules", $buildtarget);
+        $buildtarget = 'build';
     }
 }
 
@@ -434,7 +434,7 @@ if ($usepause &&
 my $signerrors;
 unless (build_binaryonly) {
     if ($signsource && signfile("$pv.dsc")) {
-	$signerrors = _g("Failed to sign .dsc and .changes file");
+	$signerrors = _g('Failed to sign .dsc and .changes file');
 	$signchanges = 0;
     }
 }
@@ -494,7 +494,7 @@ if (fileomitted '\.deb') {
 }
 
 if ($signchanges && signfile("$pva.changes")) {
-    $signerrors = _g("Failed to sign .changes file");
+    $signerrors = _g('Failed to sign .changes file');
 }
 
 if ($cleansource) {
@@ -516,7 +516,7 @@ if ($signerrors) {
 sub mustsetvar {
     my ($var, $text) = @_;
 
-    error(_g("unable to determine %s"), $text)
+    error(_g('unable to determine %s'), $text)
 	unless defined($var);
 
     print "$progname: $text $var\n";

+ 18 - 18
scripts/dpkg-checkbuilddeps.pl

@@ -31,7 +31,7 @@ use Dpkg::Arch qw(get_host_arch);
 use Dpkg::Deps;
 use Dpkg::Control::Info;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 sub version()
 {
@@ -41,9 +41,9 @@ sub version()
 
 sub usage {
 	printf _g(
-"Usage: %s [<option>...] [<control-file>]")
+'Usage: %s [<option>...] [<control-file>]')
 	. "\n\n" . _g(
-"Options:
+'Options:
   -A             ignore Build-Depends-Arch and Build-Conflicts-Arch.
   -B             ignore Build-Depends-Indep and Build-Conflicts-Indep.
   -d build-deps  use given string as build dependencies instead of
@@ -54,9 +54,9 @@ sub usage {
   --admindir=<directory>
                  change the administrative directory.
   -?, --help     show this help message.
-      --version  show the version.")
+      --version  show the version.')
 	. "\n\n" . _g(
-"<control-file> is the control file to process (default: debian/control).")
+'<control-file> is the control file to process (default: debian/control).')
 	. "\n", $progname;
 }
 
@@ -76,7 +76,7 @@ if (!GetOptions('A' => \$ignore_bd_arch,
 	exit(2);
 }
 
-my $controlfile = shift || "debian/control";
+my $controlfile = shift || 'debian/control';
 
 my $control = Dpkg::Control::Info->new($controlfile);
 my $fields = $control->get_source();
@@ -84,14 +84,14 @@ my $fields = $control->get_source();
 my $facts = parse_status("$admindir/status");
 
 unless (defined($bd_value) or defined($bc_value)) {
-    my @bd_list = ('build-essential:native', $fields->{"Build-Depends"});
-    push @bd_list, $fields->{"Build-Depends-Arch"} if not $ignore_bd_arch;
-    push @bd_list, $fields->{"Build-Depends-Indep"} if not $ignore_bd_indep;
+    my @bd_list = ('build-essential:native', $fields->{'Build-Depends'});
+    push @bd_list, $fields->{'Build-Depends-Arch'} if not $ignore_bd_arch;
+    push @bd_list, $fields->{'Build-Depends-Indep'} if not $ignore_bd_indep;
     $bd_value = deps_concat(@bd_list);
 
-    my @bc_list = ($fields->{"Build-Conflicts"});
-    push @bc_list, $fields->{"Build-Conflicts-Arch"} if not $ignore_bd_arch;
-    push @bc_list, $fields->{"Build-Conflicts-Indep"} if not $ignore_bd_indep;
+    my @bc_list = ($fields->{'Build-Conflicts'});
+    push @bc_list, $fields->{'Build-Conflicts-Arch'} if not $ignore_bd_arch;
+    push @bc_list, $fields->{'Build-Conflicts-Indep'} if not $ignore_bd_indep;
     $bc_value = deps_concat(@bc_list);
 }
 my (@unmet, @conflicts);
@@ -108,12 +108,12 @@ if ($bc_value) {
 }
 
 if (@unmet) {
-	printf STDERR _g("%s: Unmet build dependencies: "), $progname;
-	print STDERR join(" ", map { $_->output() } @unmet), "\n";
+	printf STDERR _g('%s: Unmet build dependencies: '), $progname;
+	print STDERR join(' ', map { $_->output() } @unmet), "\n";
 }
 if (@conflicts) {
-	printf STDERR _g("%s: Build conflicts: "), $progname;
-	print STDERR join(" ", map { $_->output() } @conflicts), "\n";
+	printf STDERR _g('%s: Build conflicts: '), $progname;
+	print STDERR join(' ', map { $_->output() } @conflicts), "\n";
 }
 exit 1 if @unmet || @conflicts;
 
@@ -124,7 +124,7 @@ sub parse_status {
 	my $facts = Dpkg::Deps::KnownFacts->new();
 	local $/ = '';
 	open(my $status_fh, '<', $status) ||
-		syserr(_g("cannot open %s"), $status);
+		syserr(_g('cannot open %s'), $status);
 	while (<$status_fh>) {
 		next unless /^Status: .*ok installed$/m;
 	
@@ -189,7 +189,7 @@ sub check_line {
 	my @unmet=();
 
 	unless(defined($dep_list)) {
-	    error(_g("error occurred while parsing %s"), $fieldname);
+	    error(_g('error occurred while parsing %s'), $fieldname);
 	}
 
 	if ($build_depends) {

+ 17 - 17
scripts/dpkg-distaddfile.pl

@@ -27,7 +27,7 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 use Dpkg::File;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 my $fileslistfile = 'debian/files';
 
@@ -35,21 +35,21 @@ my $fileslistfile = 'debian/files';
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    printf _g("
+    printf _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<option>...] <filename> <section> <priority>
+'Usage: %s [<option>...] <filename> <section> <priority>
 
 Options:
   -f<files-list-file>      write files here instead of debian/files.
   -?, --help               show this help message.
       --version            show the version.
-"), $progname;
+'), $progname;
 }
 
 while (@ARGV && $ARGV[0] =~ m/^-/) {
@@ -69,38 +69,38 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
     }
 }
 
-@ARGV == 3 || usageerr(_g("need exactly a filename, section and priority"));
+@ARGV == 3 || usageerr(_g('need exactly a filename, section and priority'));
 my ($file, $section, $priority) = @ARGV;
 
 ($file =~ m/\s/ || $section =~ m/\s/ || $priority =~ m/\s/) &&
-    error(_g("filename, section and priority may contain no whitespace"));
+    error(_g('filename, section and priority may contain no whitespace'));
 
 # Obtain a lock on debian/control to avoid simultaneous updates
 # of debian/files when parallel building is in use
 my $lockfh;
-sysopen($lockfh, "debian/control", O_WRONLY) ||
-    syserr(_g("cannot write %s"), "debian/control");
-file_lock($lockfh, "debian/control");
+sysopen($lockfh, 'debian/control', O_WRONLY) ||
+    syserr(_g('cannot write %s'), 'debian/control');
+file_lock($lockfh, 'debian/control');
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
 open(my $fileslistnew_fh, '>', "$fileslistfile.new") ||
-    syserr(_g("open new files list file"));
+    syserr(_g('open new files list file'));
 if (open(my $fileslist_fh, '<', $fileslistfile)) {
     while (<$fileslist_fh>) {
         s/\n$//;
         next if m/^(\S+) / && $1 eq $file;
         print($fileslistnew_fh "$_\n") ||
-            syserr(_g("copy old entry to new files list file"));
+            syserr(_g('copy old entry to new files list file'));
     }
     close $fileslist_fh or syserr(_g('cannot close %s'), $fileslistfile);
 } elsif ($! != ENOENT) {
-    syserr(_g("read old files list file"));
+    syserr(_g('read old files list file'));
 }
 print($fileslistnew_fh "$file $section $priority\n")
-    || syserr(_g("write new entry to new files list file"));
-close($fileslistnew_fh) || syserr(_g("close new files list file"));
+    || syserr(_g('write new entry to new files list file'));
+close($fileslistnew_fh) || syserr(_g('close new files list file'));
 rename("$fileslistfile.new", $fileslistfile) ||
-    syserr(_g("install new files list file"));
+    syserr(_g('install new files list file'));
 
 # Release the lock
-close($lockfh) || syserr(_g("cannot close %s"), "debian/control");
+close($lockfh) || syserr(_g('cannot close %s'), 'debian/control');

+ 62 - 62
scripts/dpkg-genchanges.pl

@@ -38,7 +38,7 @@ use Dpkg::Vars;
 use Dpkg::Changelog::Parse;
 use Dpkg::Version;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 my $controlfile = 'debian/control';
 my $changelogfile = 'debian/changelog';
@@ -48,7 +48,7 @@ my $uploadfilesdir = '..';
 my $sourcestyle = 'i';
 my $quiet = 0;
 my $host_arch = get_host_arch();
-my $changes_format = "1.8";
+my $changes_format = '1.8';
 
 my %f2p;           # - file to package map
 my %p2f;           # - package to file map, has entries for "packagename"
@@ -78,7 +78,7 @@ my $since;
 
 my $substvars_loaded = 0;
 my $substvars = Dpkg::Substvars->new();
-$substvars->set("Format", $changes_format);
+$substvars->set('Format', $changes_format);
 
 use constant SOURCE     => 1;
 use constant ARCH_DEP   => 2;
@@ -98,15 +98,15 @@ sub binary_opt() { return (($include == BIN) ? '-b' :
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    printf _g("
+    printf _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<option>...]")
+'Usage: %s [<option>...]')
     . "\n\n" . _g(
 "Options:
   -b                       binary-only build - no source files.
@@ -139,18 +139,18 @@ sub usage {
 while (@ARGV) {
     $_=shift(@ARGV);
     if (m/^-b$/) {
-	is_sourceonly && usageerr(_g("cannot combine %s and %s"), $_, "-S");
+	is_sourceonly && usageerr(_g('cannot combine %s and %s'), $_, '-S');
 	$include = BIN;
     } elsif (m/^-B$/) {
-	is_sourceonly && usageerr(_g("cannot combine %s and %s"), $_, "-S");
+	is_sourceonly && usageerr(_g('cannot combine %s and %s'), $_, '-S');
 	$include = ARCH_DEP;
-	printf STDERR _g("%s: arch-specific upload - not including arch-independent packages")."\n", $progname;
+	printf STDERR _g('%s: arch-specific upload - not including arch-independent packages') . "\n", $progname;
     } elsif (m/^-A$/) {
-	is_sourceonly && usageerr(_g("cannot combine %s and %s"), $_, "-S");
+	is_sourceonly && usageerr(_g('cannot combine %s and %s'), $_, '-S');
 	$include = ARCH_INDEP;
-	printf STDERR _g("%s: arch-indep upload - not including arch-specific packages")."\n", $progname;
+	printf STDERR _g('%s: arch-indep upload - not including arch-specific packages') . "\n", $progname;
     } elsif (m/^-S$/) {
-	is_binaryonly && usageerr(_g("cannot combine %s and %s"), binary_opt, "-S");
+	is_binaryonly && usageerr(_g('cannot combine %s and %s'), binary_opt, '-S');
 	$include = SOURCE;
     } elsif (m/^-s([iad])$/) {
         $sourcestyle= $1;
@@ -208,31 +208,31 @@ my $prev_changelog = changelog_parse(%options);
 my $control = Dpkg::Control::Info->new($controlfile);
 my $fields = Dpkg::Control->new(type => CTRL_FILE_CHANGES);
 
-my $sourceversion = $changelog->{"Binary-Only"} ?
-                    $prev_changelog->{"Version"} : $changelog->{"Version"};
-my $binaryversion = $changelog->{"Version"};
+my $sourceversion = $changelog->{'Binary-Only'} ?
+                    $prev_changelog->{'Version'} : $changelog->{'Version'};
+my $binaryversion = $changelog->{'Version'};
 
 $substvars->set_version_substvars($sourceversion, $binaryversion);
 $substvars->set_arch_substvars();
-$substvars->load("debian/substvars") if -e "debian/substvars" and not $substvars_loaded;
+$substvars->load('debian/substvars') if -e 'debian/substvars' and not $substvars_loaded;
 
 if (defined($prev_changelog) and
-    version_compare_relation($changelog->{"Version"}, REL_LT,
-                             $prev_changelog->{"Version"}))
+    version_compare_relation($changelog->{'Version'}, REL_LT,
+                             $prev_changelog->{'Version'}))
 {
-    warning(_g("the current version (%s) is earlier than the previous one (%s)"),
-	$changelog->{"Version"}, $prev_changelog->{"Version"})
+    warning(_g('the current version (%s) is earlier than the previous one (%s)'),
+	$changelog->{'Version'}, $prev_changelog->{'Version'})
         # ~bpo and ~vola are backports and have lower version number by definition
-        unless $changelog->{"Version"} =~ /~(?:bpo|vola)/;
+        unless $changelog->{'Version'} =~ /~(?:bpo|vola)/;
 }
 
 if (not is_sourceonly) {
-    open(my $fileslist_fh, "<", $fileslistfile) ||
-        syserr(_g("cannot read files list file"));
+    open(my $fileslist_fh, '<', $fileslistfile) ||
+        syserr(_g('cannot read files list file'));
     while(<$fileslist_fh>) {
 	if (m/^(([-+.0-9a-z]+)_([^_]+)_([-\w]+)\.u?deb) (\S+) (\S+)$/) {
 	    defined($p2f{"$2 $4"}) &&
-		warning(_g("duplicate files list entry for package %s (line %d)"),
+		warning(_g('duplicate files list entry for package %s (line %d)'),
 			$2, $.);
 	    $f2p{$1}= $2;
 	    $pa2f{"$2 $4"}= $1;
@@ -240,7 +240,7 @@ if (not is_sourceonly) {
 	    push @{$p2f{$2}}, $1;
 	    $p2ver{$2}= $3;
 	    defined($f2sec{$1}) &&
-		warning(_g("duplicate files list entry for file %s (line %d)"),
+		warning(_g('duplicate files list entry for file %s (line %d)'),
 			$1, $.);
 	    $f2sec{$1}= $5;
 	    $f2pri{$1}= $6;
@@ -254,13 +254,13 @@ if (not is_sourceonly) {
 	    push(@fileslistfiles,$1);
 	} elsif (m/^([-+.,_0-9a-zA-Z]+) (\S+) (\S+)$/) {
 	    defined($f2sec{$1}) &&
-		warning(_g("duplicate files list entry for file %s (line %d)"),
+		warning(_g('duplicate files list entry for file %s (line %d)'),
 			$1, $.);
 	    $f2sec{$1}= $2;
 	    $f2pri{$1}= $3;
 	    push(@fileslistfiles,$1);
 	} else {
-	    error(_g("badly formed line in files list file, line %d"), $.);
+	    error(_g('badly formed line in files list file, line %d'), $.);
 	}
     }
     close($fileslist_fh);
@@ -281,19 +281,19 @@ foreach $_ (keys %{$src_fields}) {
 
 # Scan control info of all binary packages
 foreach my $pkg ($control->get_packages()) {
-    my $p = $pkg->{"Package"};
-    my $a = $pkg->{"Architecture"} || "";
-    my $d = $pkg->{"Description"} || "no description available";
+    my $p = $pkg->{'Package'};
+    my $a = $pkg->{'Architecture'} || '';
+    my $d = $pkg->{'Description'} || 'no description available';
     $d = $1 if $d =~ /^(.*)\n/;
-    my $pkg_type = $pkg->{"Package-Type"} ||
-                   $pkg->get_custom_field("Package-Type") || "deb";
+    my $pkg_type = $pkg->{'Package-Type'} ||
+                   $pkg->get_custom_field('Package-Type') || 'deb';
 
     my @f; # List of files for this binary package
     push @f, @{$p2f{$p}} if defined $p2f{$p};
 
     # Add description of all binary packages
-    my $desc = encode_utf8(sprintf("%-10s - %-.65s", $p, decode_utf8($d)));
-    $desc .= " (udeb)" if $pkg_type eq "udeb";
+    my $desc = encode_utf8(sprintf('%-10s - %-.65s', $p, decode_utf8($d)));
+    $desc .= ' (udeb)' if $pkg_type eq 'udeb';
     push @descriptions, $desc;
 
     if (not defined($p2f{$p})) {
@@ -301,7 +301,7 @@ foreach my $pkg ($control->get_packages()) {
 	if ((debarch_eq('all', $a) and ($include & ARCH_INDEP)) ||
 	    (grep(debarch_is($host_arch, $_), split(/\s+/, $a))
 		  and ($include & ARCH_DEP))) {
-	    warning(_g("package %s in control file but not in files list"),
+	    warning(_g('package %s in control file but not in files list'),
 		    $p);
 	}
 	next; # and skip it
@@ -338,23 +338,23 @@ foreach $_ (keys %{$changelog}) {
     if (m/^Source$/i) {
 	set_source_package($v);
     } elsif (m/^Maintainer$/i) {
-	$fields->{"Changed-By"} = $v;
+	$fields->{'Changed-By'} = $v;
     } else {
         field_transfer_single($changelog, $fields);
     }
 }
 
 if ($changesdescription) {
-    open(my $changes_fh, "<", $changesdescription) ||
-        syserr(_g("read changesdescription"));
-    $fields->{'Changes'} = "\n" . join("", <$changes_fh>);
+    open(my $changes_fh, '<', $changesdescription) ||
+        syserr(_g('read changesdescription'));
+    $fields->{'Changes'} = "\n" . join('', <$changes_fh>);
     close($changes_fh);
 }
 
 for my $pa (keys %pa2f) {
     my ($pp, $aa) = (split / /, $pa);
     defined($control->get_pkg_by_name($pp)) ||
-	warning(_g("package %s listed in files list but not in control info"),
+	warning(_g('package %s listed in files list but not in control info'),
 	        $pp);
 }
 
@@ -368,8 +368,8 @@ for my $p (keys %p2f) {
 	    $sec = '-';
 	    warning(_g("missing Section for binary package %s; using '-'"), $p);
 	}
-	$sec eq $f2sec{$f} || error(_g("package %s has section %s in " .
-				       "control file but %s in files list"),
+	$sec eq $f2sec{$f} || error(_g('package %s has section %s in ' .
+				       'control file but %s in files list'),
 				    $p, $sec, $f2sec{$f});
 	my $pri = $f2pricf{$f};
 	$pri ||= $sourcedefault{'Priority'};
@@ -377,8 +377,8 @@ for my $p (keys %p2f) {
 	    $pri = '-';
 	    warning(_g("missing Priority for binary package %s; using '-'"), $p);
 	}
-	$pri eq $f2pri{$f} || error(_g("package %s has priority %s in " .
-				       "control file but %s in files list"),
+	$pri eq $f2pri{$f} || error(_g('package %s has priority %s in ' .
+				       'control file but %s in files list'),
 				    $p, $pri, $f2pri{$f});
     }
 }
@@ -389,19 +389,19 @@ if (!is_binaryonly) {
     my $sec = $sourcedefault{'Section'};
     if (!defined($sec)) {
 	$sec = '-';
-	warning(_g("missing Section for source files"));
+	warning(_g('missing Section for source files'));
     }
     my $pri = $sourcedefault{'Priority'};
     if (!defined($pri)) {
 	$pri = '-';
-	warning(_g("missing Priority for source files"));
+	warning(_g('missing Priority for source files'));
     }
 
     (my $sversion = $substvars->get('source:Version')) =~ s/^\d+://;
     $dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc";
 
     my $dsc_fields = Dpkg::Control->new(type => CTRL_PKG_SRC);
-    $dsc_fields->load($dsc) || error(_g("%s is empty", $dsc));
+    $dsc_fields->load($dsc) || error(_g('%s is empty', $dsc));
     $checksums->add_from_file($dsc, key => "$sourcepackage\_$sversion.dsc");
     $checksums->add_from_control($dsc_fields, use_files_for_md5 => 1);
 
@@ -414,8 +414,8 @@ if (!is_binaryonly) {
     # the .orig tarballs must be included
     my $include_tarball;
     if (defined($prev_changelog)) {
-	my $cur = Dpkg::Version->new($changelog->{"Version"});
-	my $prev = Dpkg::Version->new($prev_changelog->{"Version"});
+	my $cur = Dpkg::Version->new($changelog->{'Version'});
+	my $prev = Dpkg::Version->new($prev_changelog->{'Version'});
 	$include_tarball = ($cur->version() ne $prev->version()) ? 1 : 0;
     } else {
 	# No previous entry means first upload, tarball required
@@ -427,29 +427,29 @@ if (!is_binaryonly) {
 	 $sourcestyle =~ m/d/) &&
 	grep(m/\.(debian\.tar|diff)\.$ext$/, $checksums->get_files()))
     {
-	$origsrcmsg= _g("not including original source code in upload");
+	$origsrcmsg= _g('not including original source code in upload');
 	foreach my $f (grep m/\.orig(-.+)?\.tar\.$ext$/, $checksums->get_files()) {
 	    $checksums->remove_file($f);
 	}
     } else {
 	if ($sourcestyle =~ m/d/ &&
 	    !grep(m/\.(debian\.tar|diff)\.$ext$/, $checksums->get_files())) {
-	    warning(_g("ignoring -sd option for native Debian package"));
+	    warning(_g('ignoring -sd option for native Debian package'));
 	}
-        $origsrcmsg= _g("including full source code in upload");
+        $origsrcmsg= _g('including full source code in upload');
     }
 } else {
-    $origsrcmsg= _g("binary-only upload - not including any source code");
+    $origsrcmsg= _g('binary-only upload - not including any source code');
 }
 
 print(STDERR "$progname: $origsrcmsg\n") ||
-    syserr(_g("write original source message")) unless $quiet;
+    syserr(_g('write original source message')) unless $quiet;
 
-$fields->{'Format'} = $substvars->get("Format");
+$fields->{'Format'} = $substvars->get('Format');
 
 if (!defined($fields->{'Date'})) {
     chomp(my $date822 = `date -R`);
-    $? && subprocerr("date -R");
+    $? && subprocerr('date -R');
     $fields->{'Date'}= $date822;
 }
 
@@ -479,17 +479,17 @@ for my $f ($checksums->get_files(), @fileslistfiles) {
     next if $filedone{$f}++;
     my $uf = "$uploadfilesdir/$f";
     $checksums->add_from_file($uf, key => $f);
-    $fields->{'Files'} .= "\n" . $checksums->get_checksum($f, "md5") .
-			  " " . $checksums->get_size($f) .
+    $fields->{'Files'} .= "\n" . $checksums->get_checksum($f, 'md5') .
+			  ' ' . $checksums->get_size($f) .
 			  " $f2sec{$f} $f2pri{$f} $f";
 }
 $checksums->export_to_control($fields);
 # redundant with the Files field
-delete $fields->{"Checksums-Md5"};
+delete $fields->{'Checksums-Md5'};
 
 $fields->{'Source'}= $sourcepackage;
 if ($fields->{'Version'} ne $substvars->get('source:Version')) {
-    $fields->{'Source'} .= " (" . $substvars->get('source:Version') . ")";
+    $fields->{'Source'} .= ' (' . $substvars->get('source:Version') . ')';
 }
 
 $fields->{'Maintainer'} = $forcemaint if defined($forcemaint);
@@ -497,12 +497,12 @@ $fields->{'Changed-By'} = $forcechangedby if defined($forcechangedby);
 
 for my $f (qw(Version Distribution Maintainer Changes)) {
     defined($fields->{$f}) ||
-        error(_g("missing information for critical output field %s"), $f);
+        error(_g('missing information for critical output field %s'), $f);
 }
 
 for my $f (qw(Urgency)) {
     defined($fields->{$f}) ||
-        warning(_g("missing information for output field %s"), $f);
+        warning(_g('missing information for output field %s'), $f);
 }
 
 for my $f (keys %override) {

+ 49 - 49
scripts/dpkg-gencontrol.pl

@@ -37,7 +37,7 @@ use Dpkg::Substvars;
 use Dpkg::Vars;
 use Dpkg::Changelog::Parse;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 
 my $controlfile = 'debian/control';
@@ -61,17 +61,17 @@ my $substvars_loaded = 0;
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    printf _g("
+    printf _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<option>...]")
+'Usage: %s [<option>...]')
     . "\n\n" . _g(
-"Options:
+'Options:
   -p<package>              print control file for package.
   -c<control-file>         get control info from this file.
   -l<changelog-file>       get per-version info from this file.
@@ -88,7 +88,7 @@ sub usage {
   -T<substvars-file>       read variables here, not debian/substvars.
   -?, --help               show this help message.
       --version            show the version.
-"), $progname;
+'), $progname;
 }
 
 while (@ARGV) {
@@ -139,47 +139,47 @@ umask 0022; # ensure sane default permissions for created files
 my %options = (file => $changelogfile);
 $options{changelogformat} = $changelogformat if $changelogformat;
 my $changelog = changelog_parse(%options);
-if ($changelog->{"Binary-Only"}) {
+if ($changelog->{'Binary-Only'}) {
     $options{count} = 1;
     $options{offset} = 1;
     my $prev_changelog = changelog_parse(%options);
-    $sourceversion = $prev_changelog->{"Version"};
+    $sourceversion = $prev_changelog->{'Version'};
 } else {
-    $sourceversion = $changelog->{"Version"};
+    $sourceversion = $changelog->{'Version'};
 }
 
 if (defined $forceversion) {
     $binaryversion = $forceversion;
 } else {
-    $binaryversion = $changelog->{"Version"};
+    $binaryversion = $changelog->{'Version'};
 }
 
 $substvars->set_version_substvars($sourceversion, $binaryversion);
 $substvars->set_arch_substvars();
-$substvars->load("debian/substvars") if -e "debian/substvars" and not $substvars_loaded;
+$substvars->load('debian/substvars') if -e 'debian/substvars' and not $substvars_loaded;
 my $control = Dpkg::Control::Info->new($controlfile);
 my $fields = Dpkg::Control->new(type => CTRL_PKG_DEB);
 
 # Old-style bin-nmus change the source version submitted to
 # set_version_substvars()
-$sourceversion = $substvars->get("source:Version");
+$sourceversion = $substvars->get('source:Version');
 
 my $pkg;
 
 if (defined($oppackage)) {
     $pkg = $control->get_pkg_by_name($oppackage);
-    defined($pkg) || error(_g("package %s not in control info"), $oppackage);
+    defined($pkg) || error(_g('package %s not in control info'), $oppackage);
 } else {
     my @packages = map { $_->{'Package'} } $control->get_packages();
     if (@packages == 0) {
-        error(_g("no package stanza found in control info"));
+        error(_g('no package stanza found in control info'));
     } elsif (@packages > 1) {
-        error(_g("must specify package since control info has many (%s)"),
+        error(_g('must specify package since control info has many (%s)'),
               "@packages");
     }
     $pkg = $control->get_pkg_by_idx(1);
 }
-$substvars->set_msg_prefix(sprintf(_g("package %s: "), $pkg->{Package}));
+$substvars->set_msg_prefix(sprintf(_g('package %s: '), $pkg->{Package}));
 
 # Scan source package
 my $src_fields = $control->get_source();
@@ -244,8 +244,8 @@ $fields->{'Version'} = $binaryversion;
 my $facts = Dpkg::Deps::KnownFacts->new();
 $facts->add_installed_package($fields->{'Package'}, $fields->{'Version'},
                               $fields->{'Architecture'}, $fields->{'Multi-Arch'});
-if (exists $pkg->{"Provides"}) {
-    my $provides = deps_parse($substvars->substvars($pkg->{"Provides"}, no_warn => 1),
+if (exists $pkg->{'Provides'}) {
+    my $provides = deps_parse($substvars->substvars($pkg->{'Provides'}, no_warn => 1),
                               reduce_arch => 1, union => 1);
     if (defined $provides) {
 	foreach my $subdep ($provides->get_deps()) {
@@ -261,15 +261,15 @@ if (exists $pkg->{"Provides"}) {
 my (@seen_deps);
 foreach my $field (field_list_pkg_dep()) {
     # Arch: all can't be simplified as the host architecture is not known
-    my $reduce_arch = debarch_eq('all', $pkg->{Architecture} || "all") ? 0 : 1;
+    my $reduce_arch = debarch_eq('all', $pkg->{Architecture} || 'all') ? 0 : 1;
     if (exists $pkg->{$field}) {
 	my $dep;
 	my $field_value = $substvars->substvars($pkg->{$field},
-	    msg_prefix => sprintf(_g("%s field of package %s: "), $field, $pkg->{Package}));
+	    msg_prefix => sprintf(_g('%s field of package %s: '), $field, $pkg->{Package}));
 	if (field_get_dep_type($field) eq 'normal') {
 	    $dep = deps_parse($field_value, use_arch => 1,
 			      reduce_arch => $reduce_arch);
-	    error(_g("error occurred while parsing %s field: %s"), $field,
+	    error(_g('error occurred while parsing %s field: %s'), $field,
                   $field_value) unless defined $dep;
 	    $dep->simplify_deps($facts, @seen_deps);
 	    # Remember normal deps to simplify even further weaker deps
@@ -277,13 +277,13 @@ foreach my $field (field_list_pkg_dep()) {
 	} else {
 	    $dep = deps_parse($field_value, use_arch => 1,
                               reduce_arch => $reduce_arch, union => 1);
-	    error(_g("error occurred while parsing %s field: %s"), $field,
+	    error(_g('error occurred while parsing %s field: %s'), $field,
                   $field_value) unless defined $dep;
 	    $dep->simplify_deps($facts);
             $dep->sort();
 	}
-	error(_g("the %s field contains an arch-specific dependency but the " .
-	         "package is architecture all"), $field)
+	error(_g('the %s field contains an arch-specific dependency but the ' .
+	         'package is architecture all'), $field)
 	    if $dep->has_arch_restriction();
 	$fields->{$field} = $dep->output();
 	delete $fields->{$field} unless $fields->{$field}; # Delete empty field
@@ -291,10 +291,10 @@ foreach my $field (field_list_pkg_dep()) {
 }
 
 for my $f (qw(Package Version)) {
-    defined($fields->{$f}) || error(_g("missing information for output field %s"), $f);
+    defined($fields->{$f}) || error(_g('missing information for output field %s'), $f);
 }
 for my $f (qw(Maintainer Description Architecture)) {
-    defined($fields->{$f}) || warning(_g("missing information for output field %s"), $f);
+    defined($fields->{$f}) || warning(_g('missing information for output field %s'), $f);
 }
 $oppackage = $fields->{'Package'};
 
@@ -306,7 +306,7 @@ if ($pkg_type eq 'udeb') {
     delete $fields->{'Homepage'};
 } else {
     for my $f (qw(Subarchitecture Kernel-Version Installer-Menu-Item)) {
-        warning(_g("%s package with udeb specific field %s"), $pkg_type, $f)
+        warning(_g('%s package with udeb specific field %s'), $pkg_type, $f)
             if defined($fields->{$f});
     }
 }
@@ -314,17 +314,17 @@ if ($pkg_type eq 'udeb') {
 my $verdiff = $binaryversion ne $sourceversion;
 if ($oppackage ne $sourcepackage || $verdiff) {
     $fields->{'Source'} = $sourcepackage;
-    $fields->{'Source'} .= " (" . $sourceversion . ")" if $verdiff;
+    $fields->{'Source'} .= ' (' . $sourceversion . ')' if $verdiff;
 }
 
 if (!defined($substvars->get('Installed-Size'))) {
     my $du_fh;
-    defined(my $c = open($du_fh, "-|")) || syserr(_g("cannot fork for %s"), "du");
+    defined(my $c = open($du_fh, '-|')) || syserr(_g('cannot fork for %s'), 'du');
     if (!$c) {
         chdir("$packagebuilddir") ||
             syserr(_g("chdir for du to \`%s'"), $packagebuilddir);
-        exec("du", "-k", "-s", "--apparent-size", ".") or
-            syserr(_g("unable to execute %s"), "du");
+        exec('du', '-k', '-s', '--apparent-size', '.') or
+            syserr(_g('unable to execute %s'), 'du');
     }
     my $duo = '';
     while (<$du_fh>) {
@@ -354,52 +354,52 @@ for my $f (keys %remove) {
 # Obtain a lock on debian/control to avoid simultaneous updates
 # of debian/files when parallel building is in use
 my $lockfh;
-sysopen($lockfh, "debian/control", O_WRONLY) ||
-    syserr(_g("cannot write %s"), "debian/control");
-file_lock($lockfh, "debian/control");
+sysopen($lockfh, 'debian/control', O_WRONLY) ||
+    syserr(_g('cannot write %s'), 'debian/control');
+file_lock($lockfh, 'debian/control');
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
-open(my $fileslistnew_fh, ">", "$fileslistfile.new") ||
-    syserr(_g("open new files list file"));
+open(my $fileslistnew_fh, '>', "$fileslistfile.new") ||
+    syserr(_g('open new files list file'));
 binmode($fileslistnew_fh);
-if (open(my $fileslist_fh, "<", $fileslistfile)) {
+if (open(my $fileslist_fh, '<', $fileslistfile)) {
     binmode($fileslist_fh);
     while (<$fileslist_fh>) {
         chomp;
         next if m/^([-+0-9a-z.]+)_[^_]+_([\w-]+)\.(a-z+) /
                 && ($1 eq $oppackage)
 	        && ($3 eq $pkg_type)
-	        && (debarch_eq($2, $fields->{'Architecture'} || "")
+	        && (debarch_eq($2, $fields->{'Architecture'} || '')
 		    || debarch_eq($2, 'all'));
         print($fileslistnew_fh "$_\n") ||
-            syserr(_g("copy old entry to new files list file"));
+            syserr(_g('copy old entry to new files list file'));
     }
-    close($fileslist_fh) || syserr(_g("close old files list file"));
+    close($fileslist_fh) || syserr(_g('close old files list file'));
 } elsif ($! != ENOENT) {
-    syserr(_g("read old files list file"));
+    syserr(_g('read old files list file'));
 }
 my $sversion = $fields->{'Version'};
 $sversion =~ s/^\d+://;
-$forcefilename //= sprintf("%s_%s_%s.%s", $oppackage, $sversion,
-                           $fields->{'Architecture'} || "", $pkg_type);
+$forcefilename //= sprintf('%s_%s_%s.%s', $oppackage, $sversion,
+                           $fields->{'Architecture'} || '', $pkg_type);
 
 print($fileslistnew_fh $substvars->substvars(sprintf("%s %s %s\n",
                                              $forcefilename,
                                              $fields->{'Section'} || '-',
                                              $fields->{'Priority'} || '-')))
-    || syserr(_g("write new entry to new files list file"));
-close($fileslistnew_fh) || syserr(_g("close new files list file"));
-rename("$fileslistfile.new", $fileslistfile) || syserr(_g("install new files list file"));
+    || syserr(_g('write new entry to new files list file'));
+close($fileslistnew_fh) || syserr(_g('close new files list file'));
+rename("$fileslistfile.new", $fileslistfile) || syserr(_g('install new files list file'));
 
 # Release the lock
-close($lockfh) || syserr(_g("cannot close %s"), "debian/control");
+close($lockfh) || syserr(_g('cannot close %s'), 'debian/control');
 
 my $cf;
 my $fh_output;
 if (!$stdout) {
     $cf= "$packagebuilddir/DEBIAN/control";
     $cf= "./$cf" if $cf =~ m/^\s/;
-    open($fh_output, ">", "$cf.new") ||
+    open($fh_output, '>', "$cf.new") ||
         syserr(_g("cannot open new output control file \`%s'"), "$cf.new");
 } else {
     $fh_output = \*STDOUT;
@@ -409,7 +409,7 @@ $fields->apply_substvars($substvars);
 $fields->output($fh_output);
 
 if (!$stdout) {
-    close($fh_output) || syserr(_g("cannot close %s"), "$cf.new");
+    close($fh_output) || syserr(_g('cannot close %s'), "$cf.new");
     rename("$cf.new", "$cf") ||
         syserr(_g("cannot install output control file \`%s'"), $cf);
 }

+ 22 - 22
scripts/dpkg-gensymbols.pl

@@ -33,7 +33,7 @@ use Dpkg::Control::Info;
 use Dpkg::Changelog::Parse;
 use Dpkg::Path qw(check_files_are_the_same find_command);
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 my $packagebuilddir = 'debian/tmp';
 
@@ -52,17 +52,17 @@ my $host_arch = get_host_arch();
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    printf _g("
+    printf _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<option>...]")
+'Usage: %s [<option>...]')
     . "\n\n" . _g(
-"Options:
+'Options:
   -p<package>              generate symbols file for package.
   -P<package-build-dir>    temporary build dir instead of debian/tmp.
   -e<library>              explicitly list libraries to scan.
@@ -88,7 +88,7 @@ sub usage {
   -d                       display debug information during work.
   -?, --help               show this help message.
       --version            show the version.
-"), $progname;
+'), $progname;
 }
 
 my @files;
@@ -150,15 +150,15 @@ if (exists $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL}) {
 
 if (not defined($sourceversion)) {
     my $changelog = changelog_parse();
-    $sourceversion = $changelog->{"Version"};
+    $sourceversion = $changelog->{'Version'};
 }
 if (not defined($oppackage)) {
     my $control = Dpkg::Control::Info->new();
     my @packages = map { $_->{'Package'} } $control->get_packages();
     if (@packages == 0) {
-	error(_g("no package stanza found in control info"));
+	error(_g('no package stanza found in control info'));
     } elsif (@packages > 1) {
-	error(_g("must specify package since control info has many (%s)"),
+	error(_g('must specify package since control info has many (%s)'),
 	      "@packages");
     }
     $oppackage = $packages[0];
@@ -169,7 +169,7 @@ my $ref_symfile = Dpkg::Shlibs::SymbolFile->new(arch => $host_arch);
 # Load source-provided symbol information
 foreach my $file ($input, $output, "debian/$oppackage.symbols.$host_arch",
     "debian/symbols.$host_arch", "debian/$oppackage.symbols",
-    "debian/symbols")
+    'debian/symbols')
 {
     if (defined $file and -e $file) {
 	print "Using references symbols from $file\n" if $debug;
@@ -227,7 +227,7 @@ $symfile->clear_except(keys %{$od->{objects}});
 
 # Write out symbols files
 if ($stdout) {
-    $output = _g("<standard output>");
+    $output = _g('<standard output>');
     $symfile->output(\*STDOUT, package => $oppackage,
                      template_mode => $template_mode,
                      with_pattern_matches => $verbose_output,
@@ -255,23 +255,23 @@ my $exitcode = 0;
 if ($compare || ! $quiet) {
     # Compare
     if (my @libs = $symfile->get_new_libs($ref_symfile)) {
-	warning(_g("new libraries appeared in the symbols file: %s"), "@libs")
+	warning(_g('new libraries appeared in the symbols file: %s'), "@libs")
 	    unless $quiet;
 	$exitcode = 4 if ($compare >= 4);
     }
     if (my @libs = $symfile->get_lost_libs($ref_symfile)) {
-	warning(_g("some libraries disappeared in the symbols file: %s"), "@libs")
+	warning(_g('some libraries disappeared in the symbols file: %s'), "@libs")
 	    unless $quiet;
 	$exitcode = 3 if ($compare >= 3);
     }
     if ($symfile->get_new_symbols($ref_symfile)) {
-	warning(_g("some new symbols appeared in the symbols file: %s"),
-		_g("see diff output below")) unless $quiet;
+	warning(_g('some new symbols appeared in the symbols file: %s'),
+		_g('see diff output below')) unless $quiet;
 	$exitcode = 2 if ($compare >= 2);
     }
     if ($symfile->get_lost_symbols($ref_symfile)) {
-	warning(_g("some symbols or patterns disappeared in the symbols file: %s"),
-	        _g("see diff output below")) unless $quiet;
+	warning(_g('some symbols or patterns disappeared in the symbols file: %s'),
+	        _g('see diff output below')) unless $quiet;
 	$exitcode = 1 if ($compare >= 1);
     }
 }
@@ -291,19 +291,19 @@ unless ($quiet) {
     # Output diffs between symbols files if any
     if ($md5_before->hexdigest() ne $md5_after->hexdigest()) {
 	if (not defined($output)) {
-	    warning(_g("the generated symbols file is empty"));
+	    warning(_g('the generated symbols file is empty'));
 	} elsif (defined($ref_symfile->{file})) {
 	    warning(_g("%s doesn't match completely %s"),
 		    $output, $ref_symfile->{file});
 	} else {
-	    warning(_g("no debian/symbols file used as basis for generating %s"),
+	    warning(_g('no debian/symbols file used as basis for generating %s'),
 		    $output);
 	}
 	my ($a, $b) = ($before->filename, $after->filename);
-	my $diff_label = sprintf("%s (%s_%s_%s)",
-	($ref_symfile->{file}) ? $ref_symfile->{file} : "new_symbol_file",
+	my $diff_label = sprintf('%s (%s_%s_%s)',
+	($ref_symfile->{file}) ? $ref_symfile->{file} : 'new_symbol_file',
 	$oppackage, $sourceversion, $host_arch);
-	system("diff", "-u", "-L", $diff_label, $a, $b) if find_command("diff");
+	system('diff', '-u', '-L', $diff_label, $a, $b) if find_command('diff');
     }
 }
 exit($exitcode);

+ 20 - 20
scripts/dpkg-mergechangelogs.pl

@@ -28,7 +28,7 @@ use Dpkg::Version;
 use Getopt::Long qw(:config posix_default bundling no_ignorecase);
 use Scalar::Util qw(blessed);
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 sub merge_entries($$$);
 sub merge_block($$$;&);
@@ -54,9 +54,9 @@ sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
     printf "\n" . _g(
-"This is free software; see the GNU General Public License version 2 or
+'This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
@@ -124,10 +124,10 @@ while (1) {
     }
 }
 
-if (defined($out_file) and $out_file ne "-") {
-    open(my $out_fh, ">", $out_file) || syserr(_g("cannot write %s"), $out_file);
+if (defined($out_file) and $out_file ne '-') {
+    open(my $out_fh, '>', $out_file) || syserr(_g('cannot write %s'), $out_file);
     print $out_fh ((blessed $_) ? "$_" : "$_\n") foreach @result;
-    close($out_fh) || syserr(_g("cannot write %s"), $out_file);
+    close($out_fh) || syserr(_g('cannot write %s'), $out_file);
 } else {
     print ((blessed $_) ? "$_" : "$_\n") foreach @result;
 }
@@ -169,8 +169,8 @@ sub compare_versions {
     return 0 if not defined $a and not defined $b;
     return 1 if not defined $b;
     return -1 if not defined $a;
-    $a = $a->get_version() if ref($a) and $a->isa("Dpkg::Changelog::Entry");
-    $b = $b->get_version() if ref($b) and $b->isa("Dpkg::Changelog::Entry");
+    $a = $a->get_version() if ref($a) and $a->isa('Dpkg::Changelog::Entry');
+    $b = $b->get_version() if ref($b) and $b->isa('Dpkg::Changelog::Entry');
     # Backport and volatile are not real prereleases
     $a =~ s/~(bpo|vola)/+$1/;
     $b =~ s/~(bpo|vola)/+$1/;
@@ -190,16 +190,16 @@ sub merge_entries($$$) {
     # NOTE: Only $o can be undef
 
     # Merge the trailer line
-    unless (merge_entry_item("blank_after_trailer", $o, $a, $b)) {
-	unshift @result, "";
+    unless (merge_entry_item('blank_after_trailer', $o, $a, $b)) {
+	unshift @result, '';
     }
-    unless (merge_entry_item("trailer", $o, $a, $b)) {
+    unless (merge_entry_item('trailer', $o, $a, $b)) {
 	merge_conflict($a->get_part('trailer'), $b->get_part('trailer'));
     }
 
     # Merge the changes
-    unless (merge_entry_item("blank_after_changes", $o, $a, $b)) {
-	unshift @result, "";
+    unless (merge_entry_item('blank_after_changes', $o, $a, $b)) {
+	unshift @result, '';
     }
     my @merged = merge(defined $o ? $o->get_part('changes') : [],
 		       $a->get_part('changes'), $b->get_part('changes'),
@@ -212,17 +212,17 @@ sub merge_entries($$$) {
     unshift @result, @merged;
 
     # Merge the header line
-    unless (merge_entry_item("blank_after_header", $o, $a, $b)) {
-	unshift @result, "";
+    unless (merge_entry_item('blank_after_header', $o, $a, $b)) {
+	unshift @result, '';
     }
-    unless (merge_entry_item("header", $o, $a, $b)) {
+    unless (merge_entry_item('header', $o, $a, $b)) {
 	merge_conflict($a->get_part('header'), $b->get_part('header'));
     }
 }
 
 sub join_lines($) {
     my $array = shift;
-    return join("\n", @$array) if ref($array) eq "ARRAY";
+    return join("\n", @$array) if ref($array) eq 'ARRAY';
     return $array;
 }
 
@@ -285,7 +285,7 @@ sub get_conflict_block($$) {
     my (@a, @b);
     push @a, $a if defined $a;
     push @b, $b if defined $b;
-    @a = @{$a} if ref($a) eq "ARRAY";
-    @b = @{$b} if ref($b) eq "ARRAY";
-    return ("<<<<<<<", @a, "=======", @b, ">>>>>>>");
+    @a = @{$a} if ref($a) eq 'ARRAY';
+    @b = @{$b} if ref($b) eq 'ARRAY';
+    return ('<<<<<<<', @a, '=======', @b, '>>>>>>>');
 }

+ 12 - 12
scripts/dpkg-name.pl

@@ -30,11 +30,11 @@ use Dpkg::ErrorHandling;
 use Dpkg::Control;
 use Dpkg::Arch qw(get_host_arch);
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 my %options = (
     subdir => 0,
-    destdir => "",
+    destdir => '',
     createdir => 0,
     overwrite => 0,
     symlink => 0,
@@ -92,10 +92,10 @@ sub getfields($)
     my ($filename) = @_;
 
     # Read the fields
-    open(my $cdata_fh, '-|', "dpkg-deb", "-f", "--", $filename) ||
-        syserr(_g("cannot open %s"), $filename);
+    open(my $cdata_fh, '-|', 'dpkg-deb', '-f', '--', $filename) ||
+        syserr(_g('cannot open %s'), $filename);
     my $fields = Dpkg::Control->new(type => CTRL_PKG_DEB);
-    $fields->parse($cdata_fh, sprintf(_g("binary control file %s"), $filename));
+    $fields->parse($cdata_fh, sprintf(_g('binary control file %s'), $filename));
     close($cdata_fh);
 
     return $fields;
@@ -145,12 +145,12 @@ sub getdir($$$)
         if ($options{subdir}) {
             my $section = $fields->{Section};
             if (!$section) {
-                $section = "no-section";
+                $section = 'no-section';
                 warning(_g("assuming section '%s' for '%s'"), $section,
                         $filename);
             }
-            if ($section ne "non-free" and $section ne "contrib" and
-                $section ne "no-section") {
+            if ($section ne 'non-free' and $section ne 'contrib' and
+                $section ne 'no-section') {
                 $dir = "unstable/binary-$arch/$section";
             } else {
                 $dir = "$section/binary-$arch";
@@ -198,9 +198,9 @@ sub move($)
 
         my @command;
         if ($options{symlink}) {
-            @command = ("ln", "-s", "--");
+            @command = ('ln', '-s', '--');
         } else {
-            @command = ("mv", "--");
+            @command = ('mv', '--');
         }
 
         if (filesame($newname, $filename)) {
@@ -210,12 +210,12 @@ sub move($)
         } elsif (system(@command, $filename, $newname) == 0) {
             info(_g("moved '%s' to '%s'"), basename($filename), $newname);
         } else {
-            error(_g("mkdir can be used to create directory"));
+            error(_g('mkdir can be used to create directory'));
         }
     }
 }
 
-@ARGV || usageerr(_g("need at least a filename"));
+@ARGV || usageerr(_g('need at least a filename'));
 
 while (@ARGV) {
     $_ = shift(@ARGV);

+ 13 - 13
scripts/dpkg-parsechangelog.pl

@@ -27,7 +27,7 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 use Dpkg::Changelog::Parse;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 my %options;
 my $fieldname;
@@ -35,23 +35,23 @@ my $fieldname;
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    printf _g("
+    printf _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<option>...]")
+'Usage: %s [<option>...]')
     . "\n\n" . _g(
-"Options:
+'Options:
   -l<changelog-file>       get per-version info from this file.
   -F<changelog-format>     force changelog format.
   -L<libdir>               look for changelog parsers in <libdir>.
   -S, --show-field <field> show the values for <field>.
   -?, --help               show this help message.
-      --version            show the version.")
+      --version            show the version.')
     . "\n\n" . _g(
 "Parser options:
     --format <output-format>    see man page for list of available
@@ -88,17 +88,17 @@ while (@ARGV) {
     } elsif (m/^--$/) {
 	last;
     } elsif (m/^-([cfnostuv])(.*)$/) {
-	if (($1 eq "c") or ($1 eq "n")) {
+	if (($1 eq 'c') or ($1 eq 'n')) {
 	    $options{count} = $2;
-	} elsif ($1 eq "f") {
+	} elsif ($1 eq 'f') {
 	    $options{from} = $2;
-	} elsif ($1 eq "o") {
+	} elsif ($1 eq 'o') {
 	    $options{offset} = $2;
-	} elsif (($1 eq "s") or ($1 eq "v")) {
+	} elsif (($1 eq 's') or ($1 eq 'v')) {
 	    $options{since} = $2;
-	} elsif ($1 eq "t") {
+	} elsif ($1 eq 't') {
 	    $options{to} = $2;
-	} elsif ($1 eq "u") {
+	} elsif ($1 eq 'u') {
 	    ## no critic (ControlStructures::ProhibitUntilBlocks)
 	    $options{until} = $2;
 	    ## use critic
@@ -120,7 +120,7 @@ while (@ARGV) {
     }
 }
 
-@ARGV && usageerr(_g("takes no non-option arguments"));
+@ARGV && usageerr(_g('takes no non-option arguments'));
 
 my $count = 0;
 my @fields = changelog_parse(%options);

+ 22 - 22
scripts/dpkg-scanpackages.pl

@@ -33,7 +33,7 @@ use Dpkg::Checksums;
 use Dpkg::Compression::FileHandle;
 use Dpkg::IPC;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 # Do not pollute STDOUT with info messages
 report_options(info_fh => \*STDERR);
@@ -103,7 +103,7 @@ sub load_override
 		    my $debmaint = $$package{Maintainer};
 		    if (!grep($debmaint eq $_, split(m:\s*//\s*:, $oldmaint))) {
 			push(@changedmaint,
-			     sprintf(_g("  %s (package says %s, not %s)"),
+			     sprintf(_g('  %s (package says %s, not %s)'),
 			             $p, $$package{Maintainer}, $oldmaint));
 		    } else {
 			$$package{Maintainer} = $newmaint;
@@ -111,7 +111,7 @@ sub load_override
 		} elsif ($$package{Maintainer} eq $maintainer) {
 		    push(@samemaint, "  $p ($maintainer)");
 		} else {
-		    warning(_g("Unconditional maintainer override for %s"), $p);
+		    warning(_g('Unconditional maintainer override for %s'), $p);
 		    $$package{Maintainer} = $maintainer;
 		}
 	    }
@@ -149,7 +149,7 @@ sub load_override_extra
 usage() and exit 1 if not $result;
 
 if (not @ARGV >= 1 && @ARGV <= 3) {
-    usageerr(_g("one to three arguments expected"));
+    usageerr(_g('one to three arguments expected'));
 }
 
 my $type = defined($options{type}) ? $options{type} : 'deb';
@@ -166,9 +166,9 @@ else {
 
 my ($binarydir, $override, $pathprefix) = @ARGV;
 
--d $binarydir or error(_g("Binary dir %s not found"), $binarydir);
+-d $binarydir or error(_g('Binary dir %s not found'), $binarydir);
 defined($override) and (-e $override or
-    error(_g("Override file %s not found"), $override));
+    error(_g('Override file %s not found'), $override));
 
 $pathprefix //= '';
 
@@ -180,7 +180,7 @@ FILE:
 	chomp;
 	my $fn = $_;
 	my $output;
-	my $pid = spawn(exec => [ "dpkg-deb", "-I", $fn, "control" ],
+	my $pid = spawn(exec => [ 'dpkg-deb', '-I', $fn, 'control' ],
 	                to_pipe => \$output);
 	my $fields = Dpkg::Control->new(type => CTRL_INDEX_PKG);
 	$fields->parse($output, $fn)
@@ -193,7 +193,7 @@ FILE:
 	}
 	
 	defined($fields->{'Package'})
-	    or error(_g("No Package field in control file of %s"), $fn);
+	    or error(_g('No Package field in control file of %s'), $fn);
 	my $p = $fields->{'Package'};
 	
 	if (defined($packages{$p}) and not $options{multiversion}) {
@@ -201,20 +201,20 @@ FILE:
 		if (version_compare_relation($fields->{'Version'}, REL_GT,
 					     $_->{'Version'}))
                 {
-		    warning(_g("Package %s (filename %s) is repeat but newer version;"),
+		    warning(_g('Package %s (filename %s) is repeat but newer version;'),
 		            $p, $fn);
-		    warning(_g("used that one and ignored data from %s!"),
+		    warning(_g('used that one and ignored data from %s!'),
 		            $_->{Filename});
 		    $packages{$p} = [];
 		} else {
-		    warning(_g("Package %s (filename %s) is repeat;"), $p, $fn);
-		    warning(_g("ignored that one and using data from %s!"),
+		    warning(_g('Package %s (filename %s) is repeat;'), $p, $fn);
+		    warning(_g('ignored that one and using data from %s!'),
 		            $_->{Filename});
 		    next FILE;
 		}
 	    }
 	}
-	warning(_g("Package %s (filename %s) has Filename field!"), $p, $fn)
+	warning(_g('Package %s (filename %s) has Filename field!'), $p, $fn)
 	    if defined($fields->{'Filename'});
 	
 	$fields->{'Filename'} = "$pathprefix$fn";
@@ -222,7 +222,7 @@ FILE:
         my $sums = Dpkg::Checksums->new();
 	$sums->add_from_file($fn);
         foreach my $alg (checksums_get_list()) {
-            if ($alg eq "md5") {
+            if ($alg eq 'md5') {
 	        $fields->{'MD5sum'} = $sums->get_checksum($fn, $alg);
             } else {
                 $fields->{$alg} = $sums->get_checksum($fn, $alg);
@@ -246,27 +246,27 @@ for my $p (sort keys %packages) {
         push(@missingover,$p);
     }
     for my $package (@{$packages{$p}}) {
-	 print(STDOUT "$package\n") or syserr(_g("Failed when writing stdout"));
+	 print(STDOUT "$package\n") or syserr(_g('Failed when writing stdout'));
          $records_written++;
     }
 }
 close(STDOUT) or syserr(_g("Couldn't close stdout"));
 
 if (@changedmaint) {
-    warning(_g("Packages in override file with incorrect old maintainer value:"));
+    warning(_g('Packages in override file with incorrect old maintainer value:'));
     warning($_) foreach (@changedmaint);
 }
 if (@samemaint) {
-    warning(_g("Packages specifying same maintainer as override file:"));
+    warning(_g('Packages specifying same maintainer as override file:'));
     warning($_) foreach (@samemaint);
 }
 if (@missingover) {
-    warning(_g("Packages in archive but missing from override file:"));
-    warning("  %s", join(' ', @missingover));
+    warning(_g('Packages in archive but missing from override file:'));
+    warning('  %s', join(' ', @missingover));
 }
 if (@spuriousover) {
-    warning(_g("Packages in override file but not in archive:"));
-    warning("  %s", join(' ', @spuriousover));
+    warning(_g('Packages in override file but not in archive:'));
+    warning('  %s', join(' ', @spuriousover));
 }
 
-info(_g("Wrote %s entries to output Packages file."), $records_written);
+info(_g('Wrote %s entries to output Packages file.'), $records_written);

+ 10 - 10
scripts/dpkg-scansources.pl

@@ -30,7 +30,7 @@ use Dpkg::Checksums;
 use Dpkg::Compression::FileHandle;
 use Dpkg::Compression;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 # Errors with a single package are warned about but don't affect the
 # exit code. Only errors which affect everything cause a non-zero exit.
@@ -118,18 +118,18 @@ sub load_override {
 
 	my @data = split ' ', $_, 4;
 	unless (@data == 3 || @data == 4) {
-	    warning(_g("invalid override entry at line %d (%d fields)"),
+	    warning(_g('invalid override entry at line %d (%d fields)'),
 	            $., 0 + @data);
 	    next;
 	}
 	my ($package, $priority, $section, $maintainer) = @data;
 	if (exists $Override{$package}) {
-	    warning(_g("ignoring duplicate override entry for %s at line %d"),
+	    warning(_g('ignoring duplicate override entry for %s at line %d'),
 	            $package, $.);
 	    next;
 	}
 	if (!$Priority{$priority}) {
-	    warning(_g("ignoring override entry for %s, invalid priority %s"),
+	    warning(_g('ignoring override entry for %s, invalid priority %s'),
 	            $package, $priority);
 	    next;
 	}
@@ -163,7 +163,7 @@ sub load_src_override {
         my $comp = compression_guess_from_filename($regular_file);
         if (defined($comp)) {
 	    $file = $regular_file;
-	    my $ext = compression_get_property($comp, "file_ext");
+	    my $ext = compression_get_property($comp, 'file_ext');
             $file =~ s/\.$ext$/.src.$ext/;
         } else {
 	    $file = "$regular_file.src";
@@ -183,7 +183,7 @@ sub load_src_override {
 
 	my @data = split ' ', $_;
 	unless (@data == 2) {
-	    warning(_g("invalid source override entry at line %d (%d fields)"),
+	    warning(_g('invalid source override entry at line %d (%d fields)'),
 	            $., 0 + @data);
 	    next;
 	}
@@ -191,7 +191,7 @@ sub load_src_override {
 	my ($package, $section) = @data;
 	my $key = "source/$package";
 	if (exists $Override{$key}) {
-	    warning(_g("ignoring duplicate source override entry for %s at line %d"),
+	    warning(_g('ignoring duplicate source override entry for %s at line %d'),
 	            $package, $.);
 	    next;
 	}
@@ -241,7 +241,7 @@ sub process_dsc {
     my $source = $fields->{Source};
     my @binary = split /\s*,\s*/, $fields->{Binary};
 
-    error(_g("no binary packages specified in %s"), $file) unless (@binary);
+    error(_g('no binary packages specified in %s'), $file) unless (@binary);
 
     # Rename the source field to package.
     $fields->{Package} = $fields->{Source};
@@ -299,7 +299,7 @@ sub main {
     my (@out);
 
     GetOptions(@Option_spec) or usage;
-    @ARGV >= 1 && @ARGV <= 3 or usageerr(_g("one to three arguments expected"));
+    @ARGV >= 1 && @ARGV <= 3 or usageerr(_g('one to three arguments expected'));
 
     push @ARGV, undef		if @ARGV < 2;
     push @ARGV, ''		if @ARGV < 3;
@@ -310,7 +310,7 @@ sub main {
     load_override_extra $Extra_override_file if defined $Extra_override_file;
 
     open my $find_fh, '-|', "find -L \Q$dir\E -name '*.dsc' -print"
-        or syserr(_g("cannot fork for %s"), "find");
+        or syserr(_g('cannot fork for %s'), 'find');
     while (<$find_fh>) {
     	chomp;
 	s-^\./+--;

+ 61 - 61
scripts/dpkg-shlibdeps.pl

@@ -53,7 +53,7 @@ use constant {
 my @depfields = qw(Suggests Recommends Depends Pre-Depends);
 my $i = 0; my %depstrength = map { $_ => $i++ } @depfields;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 my $shlibsoverride = '/etc/dpkg/shlibs.override';
 my $shlibsdefault = '/etc/dpkg/shlibs.default';
@@ -70,7 +70,7 @@ my @pkg_dir_to_search = ();
 my $host_arch = get_host_arch();
 
 my (@pkg_shlibs, @pkg_symbols, @pkg_root_dirs);
-if (-d "debian") {
+if (-d 'debian') {
     push @pkg_symbols, glob 'debian/*/DEBIAN/symbols';
     push @pkg_shlibs, glob 'debian/*/DEBIAN/shlibs';
     my %uniq = map { guess_pkg_root_dir($_) => 1 } (@pkg_symbols, @pkg_shlibs);
@@ -135,13 +135,13 @@ foreach (@ARGV) {
     }
 }
 
-scalar keys %exec || usageerr(_g("need at least one executable"));
+scalar keys %exec || usageerr(_g('need at least one executable'));
 
 my $control = Dpkg::Control::Info->new();
 my $fields = $control->get_source();
-my $bd_value = deps_concat($fields->{"Build-Depends"}, $fields->{"Build-Depends-Arch"});
+my $bd_value = deps_concat($fields->{'Build-Depends'}, $fields->{'Build-Depends-Arch'});
 my $build_deps = deps_parse($bd_value, build_dep => 1, reduce_arch => 1);
-error(_("error occurred while parsing %s"), "Build-Depends/Build-Depends-Arch")
+error(_('error occurred while parsing %s'), 'Build-Depends/Build-Depends-Arch')
     unless defined $build_deps;
 
 my %dependencies;
@@ -182,10 +182,10 @@ foreach my $file (keys %exec) {
 	    my $msg = _g("couldn't find library %s needed by %s (ELF " .
 			 "format: '%s'; RPATH: '%s')");
 	    if (scalar(split_soname($soname))) {
-		errormsg($msg, $soname, $file, $obj->{format}, join(":", @{$obj->{RPATH}}));
+		errormsg($msg, $soname, $file, $obj->{format}, join(':', @{$obj->{RPATH}}));
 		$error_count++;
 	    } else {
-		warning($msg, $soname, $file, $obj->{format}, join(":", @{$obj->{RPATH}}));
+		warning($msg, $soname, $file, $obj->{format}, join(':', @{$obj->{RPATH}}));
 	    }
 	    next;
 	}
@@ -216,7 +216,7 @@ foreach my $file (keys %exec) {
 	    # it's because it's in the process of being built
 	    # Empty package name will lead to consideration of symbols
 	    # file from the package being built only
-	    $file2pkg->{$lib} = [""];
+	    $file2pkg->{$lib} = [''];
 	    print "No associated package found for $lib\n" if $debug;
 	}
 
@@ -229,7 +229,7 @@ foreach my $file (keys %exec) {
             {
                 $haslocaldep = 1;
             }
-            if ($packagetype eq "deb" and not $haslocaldep) {
+            if ($packagetype eq 'deb' and not $haslocaldep) {
 		# Use fine-grained dependencies only on real deb
                 # and only if the dependency is not provided by shlibs.local
 		$symfile_path = find_symbols_file($pkg, $soname, $lib);
@@ -266,7 +266,7 @@ foreach my $file (keys %exec) {
                 my $libobj = $objdump_cache{$lib};
                 my $id = $dumplibs_wo_symfile->add_object($libobj);
 		if (($id ne $soname) and ($id ne $lib)) {
-		    warning(_g("%s has an unexpected SONAME (%s)"), $lib, $id);
+		    warning(_g('%s has an unexpected SONAME (%s)'), $lib, $id);
 		    $alt_soname{$id} = $soname;
 		}
 		push @soname_wo_symfile, $soname;
@@ -287,8 +287,8 @@ foreach my $file (keys %exec) {
 		    $ignore++ unless scalar(split_soname($soname));
 		    # 3/ when we have been asked to do so
 		    $ignore++ if $ignore_missing_info;
-		    error(_g("no dependency information found for %s " .
-		             "(used by %s)"), $lib, $file)
+		    error(_g('no dependency information found for %s ' .
+		             '(used by %s)'), $lib, $file)
 		        unless $ignore;
 		}
 	    }
@@ -315,19 +315,19 @@ foreach my $file (keys %exec) {
     my $disable_warnings = scalar(keys(%soname_notfound));
     my $in_public_dir = 1;
     if (my $relname = relative_to_pkg_root($file)) {
-        my $parent_dir = "/" . dirname($relname);
+        my $parent_dir = '/' . dirname($relname);
         $in_public_dir = (grep { $parent_dir eq $_ } @librarypaths) ? 1 : 0;
     } else {
-        warning(_g("binaries to analyze should already be " .
+        warning(_g('binaries to analyze should already be ' .
                    "installed in their package's directory"));
     }
     print "Analyzing all undefined symbols\n" if $debug > 1;
     foreach my $sym ($obj->get_undefined_dynamic_symbols()) {
 	my $name = $sym->{name};
 	if ($sym->{version}) {
-	    $name .= "\@$sym->{version}";
+	    $name .= '@' . "$sym->{version}";
 	} else {
-	    $name .= "\@Base";
+	    $name .= '@' . 'Base';
 	}
         print " Looking up symbol $name\n" if $debug > 1;
 	my %symdep = $symfile->lookup_symbol($name, \@sonames);
@@ -361,10 +361,10 @@ foreach my $file (keys %exec) {
                             or (!$in_public_dir and $nb_warnings < 1))
                         {
                             if ($in_public_dir) {
-			        warning(_g("symbol %s used by %s found in none of the " .
-				           "libraries"), $print_name, $file);
+			        warning(_g('symbol %s used by %s found in none of the ' .
+				           'libraries'), $print_name, $file);
                             } else {
-			        warning(_g("%s contains an unresolvable reference to " .
+			        warning(_g('%s contains an unresolvable reference to ' .
                                            "symbol %s: it's probably a plugin"),
                                         $file, $print_name);
                             }
@@ -386,9 +386,9 @@ foreach my $file (keys %exec) {
 	    }
 	}
     }
-    warning(P_("%d similar warning has been skipped (use -v to see it)",
-               "%d other similar warnings have been skipped (use -v to see " .
-               "them all)", $nb_skipped_warnings), $nb_skipped_warnings)
+    warning(P_('%d similar warning has been skipped (use -v to see it)',
+               '%d other similar warnings have been skipped (use -v to see ' .
+               'them all)', $nb_skipped_warnings), $nb_skipped_warnings)
         if $nb_skipped_warnings;
     foreach my $soname (@sonames) {
 	# Adjust minimal version of dependencies with information
@@ -413,7 +413,7 @@ foreach my $file (keys %exec) {
 	    next if ($soname =~ /^libm\.so\.\d+$/ and
 		     scalar grep(/^libstdc\+\+\.so\.\d+/, @sonames));
             next unless ($warnings & WARN_NOT_NEEDED);
-	    warning(_g("%s should not be linked against %s (it uses none of " .
+	    warning(_g('%s should not be linked against %s (it uses none of ' .
 	               "the library's symbols)"), $file, $soname);
 	}
     }
@@ -426,22 +426,22 @@ foreach my $soname (keys %global_soname_needed) {
         next if ($soname =~ /^libm\.so\.\d+$/ and scalar(
                  grep(/^libstdc\+\+\.so\.\d+/, keys %global_soname_needed)));
         next unless ($warnings & WARN_DEP_AVOIDABLE);
-        warning(P_("package could avoid a useless dependency if %s was not " .
+        warning(P_('package could avoid a useless dependency if %s was not ' .
                    "linked against %s (it uses none of the library's symbols)",
-                   "package could avoid a useless dependency if %s were not " .
+                   'package could avoid a useless dependency if %s were not ' .
                    "linked against %s (they use none of the library's symbols)",
                    scalar @{$global_soname_needed{$soname}}),
-                join(" ", @{$global_soname_needed{$soname}}), $soname);
+                join(' ', @{$global_soname_needed{$soname}}), $soname);
     }
 }
 
 # Quit now if any missing libraries
 if ($error_count >= 1) {
-    my $note = _g("Note: libraries are not searched in other binary packages " .
+    my $note = _g('Note: libraries are not searched in other binary packages ' .
 	"that do not have any shlibs or symbols file.\nTo help dpkg-shlibdeps " .
-	"find private libraries, you might need to set LD_LIBRARY_PATH.");
-    error(P_("cannot continue due to the error above",
-             "cannot continue due to the errors listed above",
+	'find private libraries, you might need to set LD_LIBRARY_PATH.');
+    error(P_('cannot continue due to the error above',
+             'cannot continue due to the errors listed above',
              $error_count) . "\n" . $note);
 }
 
@@ -450,10 +450,10 @@ my $fh;
 if ($stdout) {
     $fh = \*STDOUT;
 } else {
-    open(my $new_fh, ">", "$varlistfile.new") ||
+    open(my $new_fh, '>', "$varlistfile.new") ||
 	syserr(_g("open new substvars file \`%s'"), "$varlistfile.new");
     if (-e $varlistfile) {
-	open(my $old_fh, "<", $varlistfile) ||
+	open(my $old_fh, '<', $varlistfile) ||
 	    syserr(_g("open old varlist file \`%s' for reading"), $varlistfile);
 	foreach my $entry (grep { not m/^\Q$varnameprefix\E:/ } (<$old_fh>)) {
 	    print($new_fh $entry) ||
@@ -504,9 +504,9 @@ sub filter_deps {
 }
 
 foreach my $field (reverse @depfields) {
-    my $dep = "";
+    my $dep = '';
     if (exists $dependencies{$field} and scalar keys %{$dependencies{$field}}) {
-	$dep = join ", ",
+	$dep = join ', ',
 	    map {
 		# Translate dependency templates into real dependencies
 		if ($dependencies{$field}{$_}) {
@@ -521,7 +521,7 @@ foreach my $field (reverse @depfields) {
     }
     if ($dep) {
         my $obj = deps_parse($dep);
-        error(_g("invalid dependency got generated: %s"), $dep) unless defined $obj;
+        error(_g('invalid dependency got generated: %s'), $dep) unless defined $obj;
         $obj->sort();
 	print $fh "$varnameprefix:$field=$obj\n";
     }
@@ -529,7 +529,7 @@ foreach my $field (reverse @depfields) {
 
 # Replace old file by new one
 if (!$stdout) {
-    close($fh) || syserr(_g("cannot close %s"), "$varlistfile.new");
+    close($fh) || syserr(_g('cannot close %s'), "$varlistfile.new");
     rename("$varlistfile.new",$varlistfile) ||
 	syserr(_g("install new varlist file \`%s'"), $varlistfile);
 }
@@ -541,15 +541,15 @@ if (!$stdout) {
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    printf _g("
+    printf _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<option>...] <executable>|-e<executable> [<option>...]")
+'Usage: %s [<option>...] <executable>|-e<executable> [<option>...]')
     . "\n\n" . _g(
 "Positional options (order is significant):
   <executable>             include dependencies for <executable>,
@@ -572,9 +572,9 @@ sub usage {
   -?, --help               show this help message.
       --version            show the version.")
     . "\n\n" . _g(
-"Dependency fields recognized are:
+'Dependency fields recognized are:
   %s
-"), $progname, join("/",@depfields);
+'), $progname, join('/', @depfields);
 }
 
 sub get_min_version_from_deps {
@@ -628,7 +628,7 @@ sub update_dependency_version {
 sub add_shlibs_dep {
     my ($soname, $pkg, $libfile) = @_;
     my @shlibs = ($shlibslocal, $shlibsoverride);
-    if ($pkg eq "") {
+    if ($pkg eq '') {
 	# If the file is not packaged, try to find out the shlibs file in
 	# the package being built where the lib has been found
 	my $pkg_root = guess_pkg_root_dir($libfile);
@@ -638,7 +638,7 @@ sub add_shlibs_dep {
 	# Fallback to other shlibs files but it shouldn't be necessary
 	push @shlibs, @pkg_shlibs;
     } else {
-	my $control_file = get_control_path($pkg, "shlibs");
+	my $control_file = get_control_path($pkg, 'shlibs');
 	push @shlibs, $control_file if defined $control_file;
     }
     push @shlibs, $shlibsdefault;
@@ -682,7 +682,7 @@ sub extract_from_shlibs {
     }
     # Open shlibs file
     $shlibfile = "./$shlibfile" if $shlibfile =~ m/^\s/;
-    open(my $shlibs_fh, "<", $shlibfile) ||
+    open(my $shlibs_fh, '<', $shlibfile) ||
         syserr(_g("unable to open shared libs info file \`%s'"), $shlibfile);
     my $dep;
     while (<$shlibs_fh>) {
@@ -716,7 +716,7 @@ sub extract_from_shlibs {
 sub find_symbols_file {
     my ($pkg, $soname, $libfile) = @_;
     my @files;
-    if ($pkg eq "") {
+    if ($pkg eq '') {
 	# If the file is not packaged, try to find out the symbols file in
 	# the package being built where the lib has been found
 	my $pkg_root = guess_pkg_root_dir($libfile);
@@ -728,7 +728,7 @@ sub find_symbols_file {
     } else {
 	push @files, "/etc/dpkg/symbols/$pkg.symbols.$host_arch",
 	    "/etc/dpkg/symbols/$pkg.symbols";
-	my $control_file = get_control_path($pkg, "symbols");
+	my $control_file = get_control_path($pkg, 'symbols');
 	push @files, $control_file if defined $control_file;
     }
 
@@ -747,8 +747,8 @@ sub symfile_has_soname {
         return $symfile_has_soname_cache{$file}{$soname};
     }
 
-    open(my $symfile_fh, "<", $file) ||
-        syserr(_g("cannot open file %s"), $file);
+    open(my $symfile_fh, '<', $file) ||
+        syserr(_g('cannot open file %s'), $file);
     my $result = 0;
     while (<$symfile_fh>) {
 	if (/^\Q$soname\E /) {
@@ -782,8 +782,8 @@ sub my_find_library {
 		$path =~ s/\$ORIGIN/$origin/g;
 		$path =~ s/\$\{ORIGIN\}/$origin/g;
 	    } else {
-		warning(_g("\$ORIGIN is used in RPATH of %s and the corresponding " .
-		"directory could not be identified due to lack of DEBIAN " .
+		warning(_g('$ORIGIN is used in RPATH of %s and the corresponding ' .
+		'directory could not be identified due to lack of DEBIAN ' .
 		"sub-directory in the root of package's build tree"), $execfile);
 	    }
 	}
@@ -811,7 +811,7 @@ sub my_find_library {
 
     # Fallback in the root directory if we have not found what we were
     # looking for in the packages
-    $file = find_library($lib, \@RPATH, $format, "");
+    $file = find_library($lib, \@RPATH, $format, '');
     return $file if defined($file);
 
     return;
@@ -828,28 +828,28 @@ sub find_packages {
 	    $pkgmatch->{$_} = $cached_pkgmatch{$_};
 	} else {
 	    push @files, $_;
-	    $cached_pkgmatch{$_} = [""]; # placeholder to cache misses too.
-	    $pkgmatch->{$_} = [""];        # might be replaced later on
+	    $cached_pkgmatch{$_} = ['']; # placeholder to cache misses too.
+	    $pkgmatch->{$_} = [''];        # might be replaced later on
 	}
     }
     return $pkgmatch unless scalar(@files);
 
-    my $pid = open(my $dpkg_fh, "-|");
-    syserr(_g("cannot fork for %s"), "dpkg --search") unless defined($pid);
+    my $pid = open(my $dpkg_fh, '-|');
+    syserr(_g('cannot fork for %s'), 'dpkg --search') unless defined($pid);
     if (!$pid) {
 	# Child process running dpkg --search and discarding errors
 	close STDERR;
-	open STDERR, ">", "/dev/null";
-	$ENV{LC_ALL} = "C";
-	exec("dpkg", "--search", "--", @files)
-	    || syserr(_g("unable to execute %s"), "dpkg");
+	open STDERR, '>', '/dev/null';
+	$ENV{LC_ALL} = 'C';
+	exec('dpkg', '--search', '--', @files)
+	    || syserr(_g('unable to execute %s'), 'dpkg');
     }
     while (defined($_ = <$dpkg_fh>)) {
 	chomp($_);
 	if (m/^local diversion |^diversion by/) {
-	    warning(_g("diversions involved - output may be incorrect"));
+	    warning(_g('diversions involved - output may be incorrect'));
 	    print(STDERR " $_\n")
-		|| syserr(_g("write diversion info to stderr"));
+		|| syserr(_g('write diversion info to stderr'));
 	} elsif (m/^([-a-z0-9+.:, ]+): (\/.*)$/) {
 	    $cached_pkgmatch{$2} = $pkgmatch->{$2} = [ split(/, /, $1) ];
 	} else {

+ 58 - 58
scripts/dpkg-source.pl

@@ -48,7 +48,7 @@ use Cwd;
 use File::Basename;
 use File::Spec;
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 my $controlfile;
 my $changelogfile;
@@ -59,7 +59,7 @@ my %options = (
     # Compression related
     compression => compression_get_default(),
     comp_level => compression_get_default_level(),
-    comp_ext => compression_get_property(compression_get_default(), "file_ext"),
+    comp_ext => compression_get_property(compression_get_default(), 'file_ext'),
     # Ignore files
     tar_ignore => [],
     diff_ignore_regexp => '',
@@ -100,20 +100,20 @@ my $dir;
 if (defined($options{opmode}) &&
     $options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/) {
     if (not scalar(@ARGV)) {
-	usageerr(_g("%s needs a directory"), $options{opmode})
-	    unless $1 eq "--commit";
-	$dir = ".";
+	usageerr(_g('%s needs a directory'), $options{opmode})
+	    unless $1 eq '--commit';
+	$dir = '.';
     } else {
 	$dir = File::Spec->catdir(shift(@ARGV));
     }
-    stat($dir) || syserr(_g("cannot stat directory %s"), $dir);
+    stat($dir) || syserr(_g('cannot stat directory %s'), $dir);
     if (not -d $dir) {
-	error(_g("directory argument %s is not a directory"), $dir);
+	error(_g('directory argument %s is not a directory'), $dir);
     }
-    if ($dir eq ".") {
+    if ($dir eq '.') {
 	# . is never correct, adjust automatically
 	$dir = basename(cwd());
-	chdir("..") || syserr(_g("unable to chdir to `%s'"), "..");
+	chdir('..') || syserr(_g("unable to chdir to `%s'"), '..');
     }
     # --format options are not allowed, they would take precedence
     # over real command line options, debian/source/format should be used
@@ -121,18 +121,18 @@ if (defined($options{opmode}) &&
     # --unapply-patches is only allowed in local-options as it's a matter
     # of personal taste and the default should be to keep patches applied
     my $forbidden_opts_re = {
-	"options" => qr/^--(?:format=|unapply-patches$|abort-on-upstream-changes$)/,
-	"local-options" => qr/^--format=/,
+	'options' => qr/^--(?:format=|unapply-patches$|abort-on-upstream-changes$)/,
+	'local-options' => qr/^--format=/,
     };
-    foreach my $filename ("local-options", "options") {
+    foreach my $filename ('local-options', 'options') {
 	my $conf = Dpkg::Conf->new();
-	my $optfile = File::Spec->catfile($dir, "debian", "source", $filename);
+	my $optfile = File::Spec->catfile($dir, 'debian', 'source', $filename);
 	next unless -f $optfile;
 	$conf->load($optfile);
 	$conf->filter(remove => sub { $_[0] =~ $forbidden_opts_re->{$filename} });
 	if (@$conf) {
-	    info(_g("using options from %s: %s"), $optfile, join(" ", @$conf))
-		unless $options{opmode} eq "--print-format";
+	    info(_g('using options from %s: %s'), $optfile, join(' ', @$conf))
+		unless $options{opmode} eq '--print-format';
 	    unshift @options, @$conf;
 	}
     }
@@ -145,14 +145,14 @@ while (@options) {
     } elsif (m/^-(?:Z|-compression=)(.*)$/) {
 	my $compression = $1;
 	$options{compression} = $compression;
-	$options{comp_ext} = compression_get_property($compression, "file_ext");
-	usageerr(_g("%s is not a supported compression"), $compression)
+	$options{comp_ext} = compression_get_property($compression, 'file_ext');
+	usageerr(_g('%s is not a supported compression'), $compression)
 	    unless compression_is_supported($compression);
 	compression_set_default($compression);
     } elsif (m/^-(?:z|-compression-level=)(.*)$/) {
 	my $comp_level = $1;
 	$options{comp_level} = $comp_level;
-	usageerr(_g("%s is not a compression level"), $comp_level)
+	usageerr(_g('%s is not a compression level'), $comp_level)
 	    unless compression_is_valid_level($comp_level);
 	compression_set_default_level($comp_level);
     } elsif (m/^-c(.*)$/) {
@@ -198,7 +198,7 @@ while (@options) {
         exit(0);
     } elsif (m/^-[EW]$/) {
         # Deprecated option
-        warning(_g("-E and -W are deprecated, they are without effect"));
+        warning(_g('-E and -W are deprecated, they are without effect'));
     } elsif (m/^-q$/) {
         report_options(quiet_warnings => 1);
         $options{quiet} = 1;
@@ -210,7 +210,7 @@ while (@options) {
 }
 
 unless (defined($options{opmode})) {
-    usageerr(_g("need a command (-x, -b, --before-build, --after-build, --print-format, --commit)"));
+    usageerr(_g('need a command (-x, -b, --before-build, --after-build, --print-format, --commit)'));
 }
 
 if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/) {
@@ -236,8 +236,8 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
     my $src_fields = $control->get_source();
     error(_g("%s doesn't contain any information about the source package"),
           $controlfile) unless defined $src_fields;
-    my $src_sect = $src_fields->{'Section'} || "unknown";
-    my $src_prio = $src_fields->{'Priority'} || "unknown";
+    my $src_sect = $src_fields->{'Section'} || 'unknown';
+    my $src_prio = $src_fields->{'Priority'} || 'unknown';
     foreach $_ (keys %{$src_fields}) {
 	my $v = $src_fields->{$_};
 	if (m/^Source$/i) {
@@ -249,7 +249,7 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
 	    my $dep;
 	    my $type = field_get_dep_type($_);
 	    $dep = deps_parse($v, build_dep => 1, union => $type eq 'union');
-	    error(_g("error occurred while parsing %s"), $_) unless defined $dep;
+	    error(_g('error occurred while parsing %s'), $_) unless defined $dep;
 	    my $facts = Dpkg::Deps::KnownFacts->new();
 	    $dep->simplify_deps($facts);
 	    $dep->sort() if $type eq 'union';
@@ -267,7 +267,7 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
 	my $prio = $pkg->{'Priority'} || $src_prio;
 	my $type = $pkg->{'Package-Type'} ||
 	        $pkg->get_custom_field('Package-Type') || 'deb';
-	push @pkglist, sprintf("%s %s %s %s", $p, $type, $sect, $prio);
+	push @pkglist, sprintf('%s %s %s %s', $p, $type, $sect, $prio);
 	push(@binarypackages,$p);
 	foreach $_ (keys %{$pkg}) {
 	    my $v = $pkg->{$_};
@@ -282,7 +282,7 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
                         error(_g("`%s' is not a legal architecture string"),
                               $a)
                             unless $a =~ /^[\w-]+$/;
-                        error(_g("architecture %s only allowed on its " .
+                        error(_g('architecture %s only allowed on its ' .
                                  "own (list for package %s is `%s')"),
                               $a, $p, $a)
                             if grep($a eq $_, 'any', 'all');
@@ -333,8 +333,8 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
             error($error) unless $ok;
 	    $fields->{$_} = $v;
 	} elsif (m/^Binary-Only$/) {
-	    error(_g("building source for a binary-only release"))
-	        if $v eq "yes" and $options{opmode} eq "-b";
+	    error(_g('building source for a binary-only release'))
+	        if $v eq 'yes' and $options{opmode} eq '-b';
 	} elsif (m/^Maintainer$/i) {
             # Do not replace the field coming from the source entry
 	} else {
@@ -351,18 +351,18 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
     # Select the format to use
     if (not defined $build_format) {
 	if (-e "$dir/debian/source/format") {
-	    open(my $format_fh, "<", "$dir/debian/source/format") ||
-		syserr(_g("cannot read %s"), "$dir/debian/source/format");
+	    open(my $format_fh, '<', "$dir/debian/source/format") ||
+		syserr(_g('cannot read %s'), "$dir/debian/source/format");
 	    $build_format = <$format_fh>;
 	    chomp($build_format) if defined $build_format;
-	    error(_g("%s is empty"), "$dir/debian/source/format")
+	    error(_g('%s is empty'), "$dir/debian/source/format")
 		unless defined $build_format and length $build_format;
 	    close($format_fh);
 	} else {
-	    warning(_g("no source format specified in %s, " .
-	               "see dpkg-source(1)"), "debian/source/format")
-		if $options{opmode} eq "-b";
-	    $build_format = "1.0";
+	    warning(_g('no source format specified in %s, ' .
+	               'see dpkg-source(1)'), 'debian/source/format')
+		if $options{opmode} eq '-b';
+	    $build_format = '1.0';
 	}
     }
     $fields->{'Format'} = $build_format;
@@ -371,16 +371,16 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
     $srcpkg->init_options();
     $srcpkg->parse_cmdline_options(@cmdline_options);
 
-    if ($options{opmode} eq "--print-format") {
+    if ($options{opmode} eq '--print-format') {
 	print $fields->{'Format'} . "\n";
 	exit(0);
-    } elsif ($options{opmode} eq "--before-build") {
+    } elsif ($options{opmode} eq '--before-build') {
 	$srcpkg->before_build($dir);
 	exit(0);
-    } elsif ($options{opmode} eq "--after-build") {
+    } elsif ($options{opmode} eq '--after-build') {
 	$srcpkg->after_build($dir);
 	exit(0);
-    } elsif ($options{opmode} eq "--commit") {
+    } elsif ($options{opmode} eq '--commit') {
 	$srcpkg->commit($dir);
 	exit(0);
     }
@@ -391,13 +391,13 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
 
     # Only -b left
     info(_g("using source format `%s'"), $fields->{'Format'});
-    run_vendor_hook("before-source-build", $srcpkg);
+    run_vendor_hook('before-source-build', $srcpkg);
     # Build the files (.tar.gz, .diff.gz, etc)
     $srcpkg->build($dir);
 
     # Write the .dsc
-    my $dscname = $srcpkg->get_basename(1) . ".dsc";
-    info(_g("building %s in %s"), $sourcepackage, $dscname);
+    my $dscname = $srcpkg->get_basename(1) . '.dsc';
+    info(_g('building %s in %s'), $sourcepackage, $dscname);
     $srcpkg->write_dsc(filename => $dscname,
 		       remove => \%remove,
 		       override => \%override,
@@ -408,14 +408,14 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
 
     # Check command line
     unless (scalar(@ARGV)) {
-	usageerr(_g("-x needs at least one argument, the .dsc"));
+	usageerr(_g('-x needs at least one argument, the .dsc'));
     }
     if (scalar(@ARGV) > 2) {
-	usageerr(_g("-x takes no more than two arguments"));
+	usageerr(_g('-x takes no more than two arguments'));
     }
     my $dsc = shift(@ARGV);
     if (-d $dsc) {
-	usageerr(_g("-x needs the .dsc file as first argument, not a directory"));
+	usageerr(_g('-x needs the .dsc file as first argument, not a directory'));
     }
 
     # Create the object that does everything
@@ -431,7 +431,7 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
     if (@ARGV) {
 	$newdirectory = File::Spec->catdir(shift(@ARGV));
 	if (-e $newdirectory) {
-	    error(_g("unpack target exists: %s"), $newdirectory);
+	    error(_g('unpack target exists: %s'), $newdirectory);
 	}
     }
 
@@ -443,14 +443,14 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
             if ($options{require_valid_signature}) {
                 error(_g("%s doesn't contain a valid OpenPGP signature"), $dsc);
             } else {
-                warning(_g("extracting unsigned source package (%s)"), $dsc);
+                warning(_g('extracting unsigned source package (%s)'), $dsc);
             }
         }
         $srcpkg->check_checksums();
     }
 
     # Unpack the source package (delegated to Dpkg::Source::Package::*)
-    info(_g("extracting %s in %s"), $srcpkg->{fields}{'Source'}, $newdirectory);
+    info(_g('extracting %s in %s'), $srcpkg->{fields}{'Source'}, $newdirectory);
     $srcpkg->extract($newdirectory);
 
     exit(0);
@@ -458,7 +458,7 @@ if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/)
 
 sub setopmode {
     if (defined($options{opmode})) {
-	usageerr(_g("only one of -x, -b or --print-format allowed, and only once"));
+	usageerr(_g('only one of -x, -b or --print-format allowed, and only once'));
     }
     $options{opmode} = $_[0];
 }
@@ -466,24 +466,24 @@ sub setopmode {
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    print _g("
+    print _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<option>...] <command>")
+'Usage: %s [<option>...] <command>')
     . "\n\n" . _g(
-"Commands:
+'Commands:
   -x <filename>.dsc [<output-dir>]
                            extract source package.
   -b <dir>                 build source package.
   --print-format <dir>     print the source format that would be
                            used to build the source package.
   --commit [<dir> [<patch-name>]]
-                           store upstream changes in a new patch.")
+                           store upstream changes in a new patch.')
     . "\n\n" . _g(
 "Build options:
   -c<control-file>         get control info from this file.
@@ -508,16 +508,16 @@ sub usage {
   --no-check               don't check signature and checksums before unpacking
   --require-valid-signature abort if the package doesn't have a valid signature")
     . "\n\n" . _g(
-"General options:
+'General options:
   -?, --help               show this help message.
-      --version            show the version.")
+      --version            show the version.')
     . "\n\n" . _g(
-"More options are available but they depend on the source package format.
-See dpkg-source(1) for more info.") . "\n",
+'More options are available but they depend on the source package format.
+See dpkg-source(1) for more info.') . "\n",
     $progname,
     $Dpkg::Source::Package::diff_ignore_default_regexp,
     join(' ', map { "-I$_" } @Dpkg::Source::Package::tar_ignore_default_pattern),
     compression_get_default(),
-    join(" ", compression_get_list()),
+    join(' ', compression_get_list()),
     compression_get_default_level();
 }

+ 13 - 13
scripts/dpkg-vendor.pl

@@ -26,31 +26,31 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 use Dpkg::Vendor qw(get_vendor_info get_current_vendor);
 
-textdomain("dpkg-dev");
+textdomain('dpkg-dev');
 
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
-    printf _g("
+    printf _g('
 This is free software; see the GNU General Public License version 2 or
 later for copying conditions. There is NO warranty.
-");
+');
 }
 
 sub usage {
     printf _g(
-"Usage: %s [<option>...] [<command>]")
+'Usage: %s [<option>...] [<command>]')
     . "\n\n" . _g(
-"Options:
-  --vendor <vendor>       assume <vendor> is the current vendor")
+'Options:
+  --vendor <vendor>       assume <vendor> is the current vendor')
     . "\n\n" . _g(
-"Commands:
+'Commands:
   --is <vendor>           returns true if current vendor is <vendor>.
   --derives-from <vendor> returns true if current vendor derives from <vendor>.
   --query <field>         print the content of the vendor-specific field.
   --help                  show this help message.
   --version               show the version.
-"), $progname;
+'), $progname;
 }
 
 my ($vendor, $param, $action);
@@ -59,13 +59,13 @@ while (@ARGV) {
     $_ = shift(@ARGV);
     if (m/^--vendor$/) {
         $vendor = shift(@ARGV);
-        usageerr(_g("%s needs a parameter"), $_) unless defined $vendor;
+        usageerr(_g('%s needs a parameter'), $_) unless defined $vendor;
     } elsif (m/^--(is|derives-from|query)$/) {
-        usageerr(_g("two commands specified: --%s and --%s"), $1, $action)
+        usageerr(_g('two commands specified: --%s and --%s'), $1, $action)
             if defined($action);
         $action = $1;
         $param = shift(@ARGV);
-        usageerr(_g("%s needs a parameter"), $_) unless defined $param;
+        usageerr(_g('%s needs a parameter'), $_) unless defined $param;
     } elsif (m/^-(\?|-help)$/) {
         usage();
         exit 0;
@@ -77,7 +77,7 @@ while (@ARGV) {
     }
 }
 
-usageerr(_g("need an action option")) unless defined($action);
+usageerr(_g('need an action option')) unless defined($action);
 
 # Uses $ENV{DEB_VENDOR} if set
 $vendor //= get_current_vendor();
@@ -85,7 +85,7 @@ $vendor //= get_current_vendor();
 my $info = get_vendor_info($vendor);
 unless (defined($info)) {
     error(_g("vendor %s doesn't exist in /etc/dpkg/origins/"),
-          $vendor || "default");
+          $vendor || 'default');
 }
 
 if ($action eq 'is') {

+ 48 - 48
scripts/t/100_Dpkg_Version.t

@@ -22,11 +22,11 @@ use warnings;
 report_options(quiet_warnings => 1);
 
 my @tests = <DATA>;
-my @ops = ("<", "<<", "lt",
-	   "<=", "le",
-	   "=", "eq",
-	   ">=", "ge",
-	   ">", ">>", "gt");
+my @ops = ('<', '<<', 'lt',
+	   '<=', 'le',
+	   '=', 'eq',
+	   '>=', 'ge',
+	   '>', '>>', 'gt');
 
 plan tests => scalar(@tests) * (3 * scalar(@ops) + 4) + 13;
 
@@ -37,70 +37,70 @@ sub dpkg_vercmp {
 
 sub obj_vercmp {
      my ($a, $cmp, $b) = @_;
-     return $a < $b  if $cmp eq "<<";
-     return $a lt $b if $cmp eq "lt";
-     return $a <= $b if $cmp eq "<=" or $cmp eq "<";
-     return $a le $b if $cmp eq "le";
-     return $a == $b if $cmp eq "=";
-     return $a eq $b if $cmp eq "eq";
-     return $a >= $b if $cmp eq ">=" or $cmp eq ">";
-     return $a ge $b if $cmp eq "ge";
-     return $a > $b  if $cmp eq ">>";
-     return $a gt $b if $cmp eq "gt";
+     return $a < $b  if $cmp eq '<<';
+     return $a lt $b if $cmp eq 'lt';
+     return $a <= $b if $cmp eq '<=' or $cmp eq '<';
+     return $a le $b if $cmp eq 'le';
+     return $a == $b if $cmp eq '=';
+     return $a eq $b if $cmp eq 'eq';
+     return $a >= $b if $cmp eq '>=' or $cmp eq '>';
+     return $a ge $b if $cmp eq 'ge';
+     return $a > $b  if $cmp eq '>>';
+     return $a gt $b if $cmp eq 'gt';
 }
 
 use_ok('Dpkg::Version');
 
 my $truth = {
-    "-1" => {
-	"<<" => 1, "lt" => 1,
-	"<=" => 1, "le" => 1, "<" => 1,
-	"=" => 0, "eq" => 0,
-	">=" => 0, "ge" => 0, ">" => 0,
-	">>" => 0, "gt" => 0,
+    '-1' => {
+	'<<' => 1, 'lt' => 1,
+	'<=' => 1, 'le' => 1, '<' => 1,
+	'=' => 0, 'eq' => 0,
+	'>=' => 0, 'ge' => 0, '>' => 0,
+	'>>' => 0, 'gt' => 0,
     },
-    "0" => {
-	"<<" => 0, "lt" => 0,
-	"<=" => 1, "le" => 1, "<" => 1,
-	"=" => 1, "eq" => 1,
-	">=" => 1, "ge" => 1, ">" => 1,
-	">>" => 0, "gt" => 0,
+    '0' => {
+	'<<' => 0, 'lt' => 0,
+	'<=' => 1, 'le' => 1, '<' => 1,
+	'=' => 1, 'eq' => 1,
+	'>=' => 1, 'ge' => 1, '>' => 1,
+	'>>' => 0, 'gt' => 0,
     },
-    "1" => {
-	"<<" => 0, "lt" => 0,
-	"<=" => 0, "le" => 0, "<" => 0,
-	"=" => 0, "eq" => 0,
-	">=" => 1, "ge" => 1, ">" => 1,
-	">>" => 1, "gt" => 1,
+    '1' => {
+	'<<' => 0, 'lt' => 0,
+	'<=' => 0, 'le' => 0, '<' => 0,
+	'=' => 0, 'eq' => 0,
+	'>=' => 1, 'ge' => 1, '>' => 1,
+	'>>' => 1, 'gt' => 1,
     },
 };
 
 # Handling of empty/invalid versions
-my $empty = Dpkg::Version->new("");
-ok($empty eq "", "Dpkg::Version->new('') eq ''");
-ok($empty->as_string() eq "", "Dpkg::Version->new('')->as_string() eq ''");
-ok(!$empty->is_valid(), "empty version is invalid");
-my $ver = Dpkg::Version->new("10a:5.2");
-ok(!$ver->is_valid(), "bad epoch is invalid");
-ok(!$ver, "bool eval of invalid leads to false");
-ok($ver eq '10a:5.2', "invalid still same string 1/2");
+my $empty = Dpkg::Version->new('');
+ok($empty eq '', "Dpkg::Version->new('') eq ''");
+ok($empty->as_string() eq '', "Dpkg::Version->new('')->as_string() eq ''");
+ok(!$empty->is_valid(), 'empty version is invalid');
+my $ver = Dpkg::Version->new('10a:5.2');
+ok(!$ver->is_valid(), 'bad epoch is invalid');
+ok(!$ver, 'bool eval of invalid leads to false');
+ok($ver eq '10a:5.2', 'invalid still same string 1/2');
 $ver = Dpkg::Version->new('5.2@3-2');
-ok($ver eq '5.2@3-2', "invalid still same string 2/2");
-ok(!$ver->is_valid(), "illegal character is invalid");
+ok($ver eq '5.2@3-2', 'invalid still same string 2/2');
+ok(!$ver->is_valid(), 'illegal character is invalid');
 $ver = Dpkg::Version->new('foo5.2');
-ok(!$ver->is_valid(), "version does not start with digit 1/2");
+ok(!$ver->is_valid(), 'version does not start with digit 1/2');
 $ver = Dpkg::Version->new('0:foo5.2');
-ok(!$ver->is_valid(), "version does not start with digit 2/2");
+ok(!$ver->is_valid(), 'version does not start with digit 2/2');
 
 # Other tests
 $ver = Dpkg::Version->new('1.2.3-4');
-is($ver || 'default', '1.2.3-4', "bool eval returns string representation");
+is($ver || 'default', '1.2.3-4', 'bool eval returns string representation');
 $ver = Dpkg::Version->new('0');
-is($ver || 'default', 'default', "bool eval of version 0 is still false...");
+is($ver || 'default', 'default', 'bool eval of version 0 is still false...');
 
 # Comparisons
 foreach my $case (@tests) {
-    my ($a, $b, $res) = split " ", $case;
+    my ($a, $b, $res) = split ' ', $case;
     my $va = Dpkg::Version->new($a, check => 1);
     my $vb = Dpkg::Version->new($b, check => 1);
 

+ 4 - 4
scripts/t/150_Dpkg_Package.t

@@ -21,9 +21,9 @@ use warnings;
 use_ok('Dpkg::Package');
 
 ok(pkg_name_is_illegal(undef));
-ok(pkg_name_is_illegal(""));
-ok(pkg_name_is_illegal("%_&"));
-ok(pkg_name_is_illegal("ABC"));
-ok(pkg_name_is_illegal("-abc"));
+ok(pkg_name_is_illegal(''));
+ok(pkg_name_is_illegal('%_&'));
+ok(pkg_name_is_illegal('ABC'));
+ok(pkg_name_is_illegal('-abc'));
 
 1;

+ 2 - 2
scripts/t/190_Dpkg_Shlibs_Cppfilt.t

@@ -18,7 +18,7 @@ use Test::More tests => 124;
 use strict;
 use warnings;
 
-use_ok("Dpkg::Shlibs::Cppfilt");
+use_ok('Dpkg::Shlibs::Cppfilt');
 
 # Simple C++ demangling tests
 is ( cppfilt_demangle_cpp('_ZNSt10istrstreamC1EPKcl'),
@@ -80,6 +80,6 @@ END
 for (my $try = 1; $try <= 7; $try++) {
     for (my $i = 0; $i <= $#mangledtext; $i++) {
 	my $demangled = cppfilt_demangle_cpp($mangledtext[$i]) || $mangledtext[$i];
-	is( $demangled, $demangledtext[$i], "mass c++ demangling (${try}x".(${i}+1).")");
+	is($demangled, $demangledtext[$i], "mass c++ demangling (${try}x" . (${i} + 1) . ')');
     }
 }

+ 47 - 47
scripts/t/200_Dpkg_Shlibs.t

@@ -37,13 +37,13 @@ my $datadir = $srcdir . '/t/200_Dpkg_Shlibs';
 # XXX: An alternative would be to make parse_ldso_conf relative path aware.
 my $cwd = cwd();
 chdir($srcdir);
-Dpkg::Shlibs::parse_ldso_conf("t/200_Dpkg_Shlibs/ld.so.conf");
+Dpkg::Shlibs::parse_ldso_conf('t/200_Dpkg_Shlibs/ld.so.conf');
 chdir($cwd);
 
 use Data::Dumper;
 is_deeply([qw(/nonexistant32 /nonexistant/lib64
 	     /usr/local/lib /nonexistant/lib128 )],
-	  \@Dpkg::Shlibs::librarypaths, "parsed library paths");
+	  \@Dpkg::Shlibs::librarypaths, 'parsed library paths');
 
 use_ok('Dpkg::Shlibs::Objdump');
 
@@ -131,12 +131,12 @@ my $sym_file = Dpkg::Shlibs::SymbolFile->new(file => "$datadir/symbol_file.tmp")
 my $sym_file_dup = Dpkg::Shlibs::SymbolFile->new(file => "$datadir/symbol_file.tmp");
 my $sym_file_old = Dpkg::Shlibs::SymbolFile->new(file => "$datadir/symbol_file.tmp");
 
-$sym_file->merge_symbols($obj_old, "2.3.6.ds1-13");
-$sym_file_old->merge_symbols($obj_old, "2.3.6.ds1-13");
+$sym_file->merge_symbols($obj_old, '2.3.6.ds1-13');
+$sym_file_old->merge_symbols($obj_old, '2.3.6.ds1-13');
 
 ok( $sym_file->has_object('libc.so.6'), 'SONAME in sym file' );
 
-$sym_file->merge_symbols($obj, "2.6-1");
+$sym_file->merge_symbols($obj, '2.6-1');
 
 ok( $sym_file->get_new_symbols($sym_file_old), 'has new symbols' );
 ok( $sym_file_old->get_lost_symbols($sym_file), 'has lost symbols' );
@@ -154,7 +154,7 @@ is_deeply(\%tmp, { symbol => Dpkg::Shlibs::Symbol->new(symbol => '_errno@GLIBC_2
 # Wildcard test
 my $pat = $sym_file_old->create_symbol('*@GLIBC_PRIVATE 2.3.6.wildcard');
 $sym_file_old->add_symbol($pat, 'libc.so.6');
-$sym_file_old->merge_symbols($obj, "2.6-1");
+$sym_file_old->merge_symbols($obj, '2.6-1');
 $sym = $sym_file_old->lookup_symbol('__nss_services_lookup@GLIBC_PRIVATE', 'libc.so.6');
 is_deeply($sym, Dpkg::Shlibs::Symbol->new(symbol => '__nss_services_lookup@GLIBC_PRIVATE',
 		  minver => '2.3.6.wildcard', dep_id => 0, deprecated => 0,
@@ -179,7 +179,7 @@ sub save_load_test {
     is_deeply($dup, $symfile, $comment);
     if (-f $symfile->{file}) {
 	is( system(sprintf("diff -u '%s' '%s' >&2", $symfile->{file}, $save_file->filename)), 0,
-	    basename($symfile->{file}) . " dumped identical" );
+	    basename($symfile->{file}) . ' dumped identical');
     }
 }
 
@@ -208,7 +208,7 @@ is_deeply($sym, Dpkg::Shlibs::Symbol->new(symbol => 'symbol3_fake1@Base',
 		  minver => '0', dep_id => 0, deprecated => 0),
 	    'overrides order with #include');
 
-is($sym_file->get_smallest_version('libfake.so.1'), "0",
+is($sym_file->get_smallest_version('libfake.so.1'), '0',
    'get_smallest_version with null version');
 
 $sym = $sym_file->lookup_symbol('symbol_in_libdivert@Base', ['libdivert.so.1']);
@@ -223,12 +223,12 @@ is_deeply($sym, Dpkg::Shlibs::Symbol->new(symbol => 'symbol1_fake2@Base',
 		  minver => '1.0', dep_id => 1, deprecated => 0),
 	    'overrides order with circular #include');
 
-is($sym_file->get_smallest_version('libfake.so.1'), "1.0",
+is($sym_file->get_smallest_version('libfake.so.1'), '1.0',
    'get_smallest_version');
 
 # Check dump output
 my $io = IO::String->new();
-$sym_file->output($io, package => "libfake1");
+$sym_file->output($io, package => 'libfake1');
 is(${$io->string_ref()},
 'libfake.so.1 libfake1 #MINVER#
 | libvirtualfake
@@ -274,7 +274,7 @@ is(${$io->string_ref()},
  symbol21_amd64@Base 2.1
  symbol31_randomtag@Base 3.1
  symbol51_untagged@Base 5.1
-', "template vs. non-template on amd64" );
+', 'template vs. non-template on amd64');
 
 # Dumping in non-template mode (i386) (test for arch tags)
 $io = IO::String->new();
@@ -289,10 +289,10 @@ is(${$io->string_ref()},
  symbol31_randomtag@Base 3.1
  symbol41_i386_and_optional@Base 4.1
  symbol51_untagged@Base 5.1
-', "template vs. non-template on i386" );
+', 'template vs. non-template on i386');
 
 ok (defined $sym_file->{objects}{'libbasictags.so.1'}{syms}{'symbol21_amd64@Base'},
-    "syms keys are symbol names without quotes");
+   'syms keys are symbol names without quotes');
 
 # Preload objdumps
 my $tags_obj_i386 = Dpkg::Shlibs::Objdump::Object->new();
@@ -301,7 +301,7 @@ open $objdump, '<', "$datadir/objdump.basictags-i386"
 $tags_obj_i386->parse_objdump_output($objdump);
 close $objdump;
 $sym_file->merge_symbols($tags_obj_i386, '100.MISSING');
-is_deeply($sym_file, $sym_file_dup, "is objdump.basictags-i386 and basictags.symbols in sync");
+is_deeply($sym_file, $sym_file_dup, 'is objdump.basictags-i386 and basictags.symbols in sync');
 
 my $tags_obj_amd64 = Dpkg::Shlibs::Objdump::Object->new();
 open $objdump, '<', "$datadir/objdump.basictags-amd64"
@@ -330,7 +330,7 @@ is_deeply($sym, Dpkg::Shlibs::Symbol->new(symbol => 'symbol11_optional@Base',
 		  tags => { optional => undef }, tagorder => [ 'optional' ]),
 	    'deprecated text of MISSING optional symbol gets rebumped each merge');
 
-is( scalar($sym_file->get_lost_symbols($sym_file_dup)), 0, "missing optional symbol is not LOST");
+is( scalar($sym_file->get_lost_symbols($sym_file_dup)), 0, 'missing optional symbol is not LOST');
 
 # - reappeared (undeprecate, minver should be 1.1, not 100.MISSED)
 $tags_obj_i386->add_dynamic_symbol($symbol11);
@@ -342,7 +342,7 @@ is_deeply($sym, Dpkg::Shlibs::Symbol->new(symbol => 'symbol11_optional@Base',
 		  tags => { optional => undef }, tagorder => [ 'optional' ]),
 	    'reappered optional symbol gets undeprecated + minver');
 is( scalar($sym_file->get_lost_symbols($sym_file_dup) +
-           $sym_file->get_new_symbols($sym_file_dup)), 0, "reappeared optional symbol: neither NEW nor LOST");
+           $sym_file->get_new_symbols($sym_file_dup)), 0, 'reappeared optional symbol: neither NEW nor LOST');
 
 # Merge/get_{new,lost} tests for arch tag:
 # - arch specific appears on wrong arch: 'arch' tag should be removed
@@ -355,7 +355,7 @@ is_deeply($sym, Dpkg::Shlibs::Symbol->new(symbol => 'symbol21_amd64@Base',
 		  minver => '2.1', dep_id => 0, deprecated => 0),
 	    'symbol appears on foreign arch, arch tag should be removed');
 @tmp = map { $_->{symbol}->get_symbolname() } $sym_file->get_new_symbols($sym_file_dup);
-is_deeply( \@tmp, [ 'symbol21_amd64@Base' ], "symbol from foreign arch is NEW");
+is_deeply( \@tmp, [ 'symbol21_amd64@Base' ], 'symbol from foreign arch is NEW');
 is( $sym->get_symbolspec(1), ' symbol21_amd64@Base 2.1', 'no tags => no quotes in the symbol name' );
 
 # - arch specific symbol disappears
@@ -434,24 +434,24 @@ load_patterns_symbols();
 save_load_test($sym_file, 'save -> load test of patterns template', template_mode => 1);
 
 isnt( $sym_file->get_patterns('libpatterns.so.1') , 0,
-    "patterns.symbols has patterns" );
+    'patterns.symbols has patterns');
 
 $sym_file->merge_symbols($obj, '100.MISSING');
 
 @tmp = map { $_->get_symbolname() } $sym_file->get_lost_symbols($sym_file_dup);
-is_deeply( \@tmp, [], "no LOST symbols if all patterns matched." );
+is_deeply(\@tmp, [], 'no LOST symbols if all patterns matched.');
 @tmp = map { $_->get_symbolname() } $sym_file->get_new_symbols($sym_file_dup);
-is_deeply( \@tmp, [], "no NEW symbols if all patterns matched." );
+is_deeply(\@tmp, [], 'no NEW symbols if all patterns matched.');
 
 # Pattern resolution order: aliases (c++, symver), generic
 $sym = $sym_file->lookup_symbol('SYMVER_1@SYMVER_1','libpatterns.so.1');
-is ( $sym->{minver}, '1', "specific SYMVER_1 symbol" );
+is($sym->{minver}, '1', 'specific SYMVER_1 symbol');
 
 $sym = $sym_file->lookup_symbol('_ZN3NSB6Symver14symver_method1Ev@SYMVER_1', 'libpatterns.so.1');
-is ( $sym->{minver}, '1.method1', "specific symbol preferred over pattern" );
+is($sym->{minver}, '1.method1', 'specific symbol preferred over pattern');
 
 $sym = $sym_file->lookup_symbol('_ZN3NSB6Symver14symver_method2Ev@SYMVER_1', 'libpatterns.so.1');
-is ( $sym->{minver}, '1.method2', "c++ alias pattern preferred over generic pattern" );
+is($sym->{minver}, '1.method2', 'c++ alias pattern preferred over generic pattern');
 is ( $sym->get_pattern()->get_symbolname(), 'NSB::Symver::symver_method2()@SYMVER_1' );
 
 $sym = $sym_file->lookup_symbol('_ZN3NSB6SymverD1Ev@SYMVER_1', 'libpatterns.so.1');
@@ -461,13 +461,13 @@ ok ( $sym->get_pattern()->equals($sym_file->create_symbol('(c++|symver)SYMVER_1
 # Test old style wildcard support
 load_patterns_symbols();
 $sym = $sym_file->create_symbol('*@SYMVEROPT_2 2');
-ok ( $sym->is_optional(), "Old style wildcard is optional");
-is ( $sym->get_alias_type(), "symver", "old style wildcard is a symver pattern" );
-is ( $sym->get_symbolname(), 'SYMVEROPT_2', "wildcard pattern got renamed" );
+ok($sym->is_optional(), 'Old style wildcard is optional');
+is($sym->get_alias_type(), 'symver', 'old style wildcard is a symver pattern');
+is($sym->get_symbolname(), 'SYMVEROPT_2', 'wildcard pattern got renamed');
 
 $pat = $sym_file->lookup_pattern('(symver|optional)SYMVEROPT_2', 'libpatterns.so.1');
 $sym->{symbol_templ} = $pat->{symbol_templ};
-is_deeply( $pat, $sym, "old style wildcard is the same as (symver|optional)" );
+is_deeply($pat, $sym, 'old style wildcard is the same as (symver|optional)');
 
 # Get rid of all SymverOptional symbols
 foreach my $tmp (keys %{$obj->{dynsyms}}) {
@@ -475,10 +475,10 @@ foreach my $tmp (keys %{$obj->{dynsyms}}) {
 }
 $sym_file->merge_symbols($obj, '100.MISSING');
 is_deeply ( [ map { $_->get_symbolname() } $pat->get_pattern_matches() ],
-    [], "old style wildcard matches nothing.");
-is ( $pat->{deprecated}, '100.MISSING', "old style wildcard gets deprecated." );
+    [], 'old style wildcard matches nothing.');
+is($pat->{deprecated}, '100.MISSING', 'old style wildcard gets deprecated.');
 @tmp = map { $_->{symbol}->get_symbolname() } $sym_file->get_lost_symbols($sym_file_dup);
-is_deeply( \@tmp, [], "but old style wildcard is not LOST." );
+is_deeply(\@tmp, [], 'but old style wildcard is not LOST.');
 
 # 'Internal' pattern covers all internal symbols
 load_patterns_obj();
@@ -486,7 +486,7 @@ load_patterns_obj();
 $sym = $sym_file->create_symbol('(regex|c++)^_Z(T[ISV])?N3NSA6ClassA8Internal.*@Base$ 1.internal'),
 $pat = $sym_file->lookup_pattern($sym, 'libpatterns.so.1');
 is_deeply ([ sort $pat->get_pattern_matches() ], [ sort @tmp ],
-    "Pattern covers all internal symbols");
+    'Pattern covers all internal symbols');
 is ( $tmp[0]->{minver}, '1.internal' );
 
 # Lookup private pattern
@@ -506,11 +506,11 @@ $sym = $sym_file->create_symbol('(c++|regex|optional)NSA::ClassA::Private(::.*)?
 $pat = $sym_file->lookup_pattern($sym, 'libpatterns.so.1');
 isnt( $pat, undef, 'pattern for private class has been found' );
 is_deeply( [ sort map { $_->get_symbolname() } $pat->get_pattern_matches() ],
-    \@private_symnames, "private pattern matched expected symbols" );
+    \@private_symnames, 'private pattern matched expected symbols');
 ok( ($pat->get_pattern_matches())[0]->is_optional(),
-    "private symbol is optional like its pattern" );
+   'private symbol is optional like its pattern');
 ok( $sym_file->lookup_symbol(($pat->get_pattern_matches())[0], 'libpatterns.so.1'),
-    "lookup_symbol() finds symbols matched by pattern (after merge)"),
+   'lookup_symbol() finds symbols matched by pattern (after merge)'),
 
 # Get rid of a private symbol, it should not be lost
 delete $obj->{dynsyms}{$private_symnames[0]};
@@ -519,8 +519,8 @@ $sym_file->merge_symbols($obj, '100.MISSING');
 
 $pat = $sym_file->lookup_pattern($sym, 'libpatterns.so.1');
 @tmp = map { $_->{symbol}->get_symbolname() } $sym_file->get_lost_symbols($sym_file_dup);
-is_deeply( \@tmp, [], "no LOST symbols when got rid of patterned optional symbol." );
-ok( ! $pat->{deprecated} , "there are still matches, pattern is not deprecated." );
+is_deeply(\@tmp, [], 'no LOST symbols when got rid of patterned optional symbol.');
+ok(!$pat->{deprecated}, 'there are still matches, pattern is not deprecated.');
 
 # Get rid of all private symbols, the pattern should be deprecated.
 foreach my $tmp (@private_symnames) {
@@ -532,16 +532,16 @@ $sym_file->merge_symbols($obj, '100.MISSING');
 $pat = $sym_file->lookup_pattern($sym, 'libpatterns.so.1', 1);
 @tmp = $sym_file->get_lost_symbols($sym_file_dup);
 is_deeply( \@tmp, [ ],
-    "All private symbols gone, but pattern is not LOST because it is optional." );
+   'All private symbols gone, but pattern is not LOST because it is optional.');
 is( $pat->{deprecated}, '100.MISSING',
-    "All private symbols gone - pattern deprecated." );
+   'All private symbols gone - pattern deprecated.');
 
 # Internal symbols. All covered by the pattern?
 @tmp = grep { $_->get_symbolname() =~ /Internal/ } values %{$sym_file->{objects}{'libpatterns.so.1'}{syms}};
 $sym = $sym_file->create_symbol('(regex|c++)^_Z(T[ISV])?N3NSA6ClassA8Internal.*@Base$ 1.internal'),
 $pat = $sym_file->lookup_pattern($sym, 'libpatterns.so.1');
 is_deeply ([ sort $pat->get_pattern_matches() ], [ sort @tmp ],
-    "Pattern covers all internal symbols");
+    'Pattern covers all internal symbols');
 is ( $tmp[0]->{minver}, '1.internal' );
 
 # Delete matches of the non-optional pattern
@@ -549,7 +549,7 @@ $sym = $sym_file->create_symbol('(c++)"non-virtual thunk to NSB::ClassD::generat
 $pat = $sym_file->lookup_pattern($sym, 'libpatterns.so.1');
 isnt( $pat, undef, 'lookup_pattern() finds alias-based pattern' );
 
-is( scalar($pat->get_pattern_matches()), 2, "two matches for the generate_vt pattern" );
+is(scalar($pat->get_pattern_matches()), 2, 'two matches for the generate_vt pattern');
 foreach my $tmp ($pat->get_pattern_matches()) {
     delete $obj->{dynsyms}{$tmp->get_symbolname()};
 }
@@ -559,9 +559,9 @@ $sym_file->merge_symbols($obj, '100.MISSING');
 $pat = $sym_file->lookup_pattern($sym, 'libpatterns.so.1', 1);
 @tmp = map { scalar $sym_file->lookup_pattern($_->{symbol}, 'libpatterns.so.1', 1) }
              $sym_file->get_lost_symbols($sym_file_dup);
-is_deeply( \@tmp, [ $pat ], "No matches - generate_vt() pattern is LOST." );
+is_deeply(\@tmp, [ $pat ], 'No matches - generate_vt() pattern is LOST.');
 is( $pat->{deprecated}, '100.MISSING',
-    "No matches - generate_vt() pattern is deprecated." );
+   'No matches - generate_vt() pattern is deprecated.');
 
 # Pattern undeprecation when matches are discovered
 load_patterns_obj();
@@ -574,13 +574,13 @@ $pat->{deprecated} = '0.1-1';
 
 $sym_file->merge_symbols($obj, '100.FOUND');
 ok( ! $pat->{deprecated},
-    "Previously deprecated pattern with matches got undeprecated" );
+   'Previously deprecated pattern with matches got undeprecated');
 is( $pat->{minver}, '100.FOUND',
-    "Previously deprecated pattern with matches got minver bumped" );
+   'Previously deprecated pattern with matches got minver bumped');
 @tmp = map { $_->{symbol}->get_symbolspec(1) } $sym_file->get_new_symbols($sym_file_dup);
 is_deeply( \@tmp, [ $pat->get_symbolspec(1) ],
-    "Previously deprecated pattern with matches is NEW. Matches themselves are not NEW." );
+    'Previously deprecated pattern with matches is NEW. Matches themselves are not NEW.');
 foreach my $sym ($pat->get_pattern_matches()) {
-    ok( ! $sym->{deprecated}, $sym->get_symbolname().": not deprecated" );
-    is( $sym->{minver}, '100.FOUND', $sym->get_symbolname().": version bumped" );
+    ok(!$sym->{deprecated}, $sym->get_symbolname() . ': not deprecated');
+    is($sym->{minver}, '100.FOUND', $sym->get_symbolname() . ': version bumped');
 }

+ 24 - 24
scripts/t/300_Dpkg_BuildOptions.t

@@ -31,42 +31,42 @@ use_ok('Dpkg::BuildOptions');
 $ENV{DEB_BUILD_OPTIONS} = 'noopt foonostripbar parallel=3 bazNOCHECK';
 
 my $dbo = Dpkg::BuildOptions->new();
-ok($dbo->has("noopt"), "has noopt");
-is($dbo->get("noopt"), undef, "noopt value");
-ok($dbo->has("foonostripbar"), "has foonostripbar");
-is($dbo->get("foonostripbar"), undef, "foonostripbar value");
-ok($dbo->has("parallel"), "has parallel");
-is($dbo->get("parallel"), 3, "parallel value");
-ok(!$dbo->has("bazNOCHECK"), "not has bazNOCHECK");
+ok($dbo->has('noopt'), 'has noopt');
+is($dbo->get('noopt'), undef, 'noopt value');
+ok($dbo->has('foonostripbar'), 'has foonostripbar');
+is($dbo->get('foonostripbar'), undef, 'foonostripbar value');
+ok($dbo->has('parallel'), 'has parallel');
+is($dbo->get('parallel'), 3, 'parallel value');
+ok(!$dbo->has('bazNOCHECK'), 'not has bazNOCHECK');
 
 $dbo->reset();
 $dbo->merge('no opt no-strip parallel = 5 nocheck', 'test');
-ok($dbo->has('no'), "has no");
-is($dbo->get('no'), undef, "no value");
-ok($dbo->has('opt'), "has opt");
-is($dbo->get('opt'), undef, "opt value");
-ok($dbo->has('no-strip'), "has no-strip");
-is($dbo->get('no-strip'), undef, "no-strip value");
-ok($dbo->has('parallel'), "has parallel");
-is($dbo->get('parallel'), '', "parallel value");
-ok($dbo->has('nocheck'), "has nocheck");
-is($dbo->get('nocheck'), undef, "nocheck value");
+ok($dbo->has('no'), 'has no');
+is($dbo->get('no'), undef, 'no value');
+ok($dbo->has('opt'), 'has opt');
+is($dbo->get('opt'), undef, 'opt value');
+ok($dbo->has('no-strip'), 'has no-strip');
+is($dbo->get('no-strip'), undef, 'no-strip value');
+ok($dbo->has('parallel'), 'has parallel');
+is($dbo->get('parallel'), '', 'parallel value');
+ok($dbo->has('nocheck'), 'has nocheck');
+is($dbo->get('nocheck'), undef, 'nocheck value');
 
 $dbo->reset();
 $dbo->set('parallel', 5);
 $dbo->set('noopt', undef);
 
 my $env = $dbo->export();
-is($env, "noopt parallel=5", "value of export");
+is($env, 'noopt parallel=5', 'value of export');
 is($ENV{DEB_BUILD_OPTIONS}, $env, 'env match return value of export');
-$env = $dbo->export("OTHER_VARIABLE");
+$env = $dbo->export('OTHER_VARIABLE');
 is($ENV{OTHER_VARIABLE}, $env, 'export to other variable');
 
 $ENV{DEB_BUILD_OPTIONS} = 'foobar';
 $dbo = Dpkg::BuildOptions->new();
-$dbo->set("noopt", 1);
-is($dbo->output(), "foobar noopt", "output");
+$dbo->set('noopt', 1);
+is($dbo->output(), 'foobar noopt', 'output');
 
-$dbo = Dpkg::BuildOptions->new(envvar => "OTHER_VARIABLE");
-is($dbo->get("parallel"), 5, "import from other variable, check parallel");
-ok($dbo->has("noopt"), "import from other variable, check noopt");
+$dbo = Dpkg::BuildOptions->new(envvar => 'OTHER_VARIABLE');
+is($dbo->get('parallel'), 5, 'import from other variable, check parallel');
+ok($dbo->has('noopt'), 'import from other variable, check noopt');

+ 51 - 51
scripts/t/400_Dpkg_Deps.t

@@ -21,83 +21,83 @@ use warnings;
 use Dpkg::Arch qw(get_host_arch);
 use_ok('Dpkg::Deps');
 
-my $field_multiline = " , , libgtk2.0-common (= 2.10.13-1)  , libatk1.0-0 (>=
+my $field_multiline = ' , , libgtk2.0-common (= 2.10.13-1)  , libatk1.0-0 (>=
 1.13.2), libc6 (>= 2.5-5), libcairo2 (>= 1.4.0), libcupsys2 (>= 1.2.7),
 libfontconfig1 (>= 2.4.0), libglib2.0-0  (  >= 2.12.9), libgnutls13 (>=
-1.6.3-0), libjpeg62, python (<< 2.5) , , ";
-my $field_multiline_sorted = "libatk1.0-0 (>= 1.13.2), libc6 (>= 2.5-5), libcairo2 (>= 1.4.0), libcupsys2 (>= 1.2.7), libfontconfig1 (>= 2.4.0), libglib2.0-0 (>= 2.12.9), libgnutls13 (>= 1.6.3-0), libgtk2.0-common (= 2.10.13-1), libjpeg62, python (<< 2.5)";
+1.6.3-0), libjpeg62, python (<< 2.5) , , ';
+my $field_multiline_sorted = 'libatk1.0-0 (>= 1.13.2), libc6 (>= 2.5-5), libcairo2 (>= 1.4.0), libcupsys2 (>= 1.2.7), libfontconfig1 (>= 2.4.0), libglib2.0-0 (>= 2.12.9), libgnutls13 (>= 1.6.3-0), libgtk2.0-common (= 2.10.13-1), libjpeg62, python (<< 2.5)';
 
 my $dep_multiline = deps_parse($field_multiline);
 $dep_multiline->sort();
-is($dep_multiline->output(), $field_multiline_sorted, "Parse, sort and output");
+is($dep_multiline->output(), $field_multiline_sorted, 'Parse, sort and output');
 
-my $dep_subset = deps_parse("libatk1.0-0 (>> 1.10), libc6, libcairo2");
-is($dep_multiline->implies($dep_subset), 1, "Dep implies subset of itself");
+my $dep_subset = deps_parse('libatk1.0-0 (>> 1.10), libc6, libcairo2');
+is($dep_multiline->implies($dep_subset), 1, 'Dep implies subset of itself');
 is($dep_subset->implies($dep_multiline), undef, "Subset doesn't imply superset");
-my $dep_opposite = deps_parse("python (>= 2.5)");
-is($dep_opposite->implies($dep_multiline), 0, "Opposite condition implies NOT the depends");
-
-my $dep_or1 = deps_parse("a|b (>=1.0)|c (>= 2.0)");
-my $dep_or2 = deps_parse("x|y|a|b|c (<= 0.5)|c (>=1.5)|d|e");
-is($dep_or1->implies($dep_or2), 1, "Implication between OR 1/2");
-is($dep_or2->implies($dep_or1), undef, "Implication between OR 2/2");
-
-my $dep_ma_any = deps_parse("libcairo2:any");
-my $dep_ma_native = deps_parse("libcairo2");
-#my $dep_ma_native2 = deps_parse("libcairo2:native");
-is($dep_ma_native->implies($dep_ma_any), 1, "foo -> foo:any");
-#is($dep_ma_native2->implies($dep_ma_any), 1, "foo:native -> foo:any");
-is($dep_ma_any->implies($dep_ma_native), undef, "foo:any !-> foo");
-#is($dep_ma_any->implies($dep_ma_native2), undef, "foo:any !-> foo:native");
-
-my $field_arch = "libc6 (>= 2.5) [!alpha !hurd-i386], libc6.1 [alpha], libc0.1 [hurd-i386]";
+my $dep_opposite = deps_parse('python (>= 2.5)');
+is($dep_opposite->implies($dep_multiline), 0, 'Opposite condition implies NOT the depends');
+
+my $dep_or1 = deps_parse('a|b (>=1.0)|c (>= 2.0)');
+my $dep_or2 = deps_parse('x|y|a|b|c (<= 0.5)|c (>=1.5)|d|e');
+is($dep_or1->implies($dep_or2), 1, 'Implication between OR 1/2');
+is($dep_or2->implies($dep_or1), undef, 'Implication between OR 2/2');
+
+my $dep_ma_any = deps_parse('libcairo2:any');
+my $dep_ma_native = deps_parse('libcairo2');
+#my $dep_ma_native2 = deps_parse('libcairo2:native');
+is($dep_ma_native->implies($dep_ma_any), 1, 'foo -> foo:any');
+#is($dep_ma_native2->implies($dep_ma_any), 1, 'foo:native -> foo:any');
+is($dep_ma_any->implies($dep_ma_native), undef, 'foo:any !-> foo');
+#is($dep_ma_any->implies($dep_ma_native2), undef, 'foo:any !-> foo:native');
+
+my $field_arch = 'libc6 (>= 2.5) [!alpha !hurd-i386], libc6.1 [alpha], libc0.1 [hurd-i386]';
 my $dep_i386 = deps_parse($field_arch, reduce_arch => 1, host_arch => 'i386');
 my $dep_alpha = deps_parse($field_arch, reduce_arch => 1, host_arch => 'alpha');
 my $dep_hurd = deps_parse($field_arch, reduce_arch => 1, host_arch => 'hurd-i386');
-is($dep_i386->output(), "libc6 (>= 2.5)", "Arch reduce 1/3");
-is($dep_alpha->output(), "libc6.1", "Arch reduce 2/3");
-is($dep_hurd->output(), "libc0.1", "Arch reduce 3/3");
+is($dep_i386->output(), 'libc6 (>= 2.5)', 'Arch reduce 1/3');
+is($dep_alpha->output(), 'libc6.1', 'Arch reduce 2/3');
+is($dep_hurd->output(), 'libc0.1', 'Arch reduce 3/3');
 
 
 my $facts = Dpkg::Deps::KnownFacts->new();
-$facts->add_installed_package("mypackage", "1.3.4-1", get_host_arch(), "no");
-$facts->add_installed_package("mypackage2", "1.3.4-1", "somearch", "no");
-$facts->add_installed_package("pkg-ma-foreign", "1.3.4-1", "somearch", "foreign");
-$facts->add_installed_package("pkg-ma-foreign2", "1.3.4-1", get_host_arch(), "foreign");
-$facts->add_installed_package("pkg-ma-allowed", "1.3.4-1", "somearch", "allowed");
-$facts->add_installed_package("pkg-ma-allowed2", "1.3.4-1", "somearch", "allowed");
-$facts->add_installed_package("pkg-ma-allowed3", "1.3.4-1", get_host_arch(), "allowed");
-$facts->add_provided_package("myvirtual", undef, undef, "mypackage");
-
-my $field_duplicate = "libc6 (>= 2.3), libc6 (>= 2.6-1), mypackage (>=
+$facts->add_installed_package('mypackage', '1.3.4-1', get_host_arch(), 'no');
+$facts->add_installed_package('mypackage2', '1.3.4-1', 'somearch', 'no');
+$facts->add_installed_package('pkg-ma-foreign', '1.3.4-1', 'somearch', 'foreign');
+$facts->add_installed_package('pkg-ma-foreign2', '1.3.4-1', get_host_arch(), 'foreign');
+$facts->add_installed_package('pkg-ma-allowed', '1.3.4-1', 'somearch', 'allowed');
+$facts->add_installed_package('pkg-ma-allowed2', '1.3.4-1', 'somearch', 'allowed');
+$facts->add_installed_package('pkg-ma-allowed3', '1.3.4-1', get_host_arch(), 'allowed');
+$facts->add_provided_package('myvirtual', undef, undef, 'mypackage');
+
+my $field_duplicate = 'libc6 (>= 2.3), libc6 (>= 2.6-1), mypackage (>=
 1.3), myvirtual | something, python (>= 2.5), mypackage2, pkg-ma-foreign,
-pkg-ma-foreign2, pkg-ma-allowed:any, pkg-ma-allowed2, pkg-ma-allowed3";
+pkg-ma-foreign2, pkg-ma-allowed:any, pkg-ma-allowed2, pkg-ma-allowed3';
 my $dep_dup = deps_parse($field_duplicate);
 $dep_dup->simplify_deps($facts, $dep_opposite);
-is($dep_dup->output(), "libc6 (>= 2.6-1), mypackage2, pkg-ma-allowed2", "Simplify deps");
+is($dep_dup->output(), 'libc6 (>= 2.6-1), mypackage2, pkg-ma-allowed2', 'Simplify deps');
 
-my $field_dup_union = "libc6 (>> 2.3), libc6 (>= 2.6-1), fake (<< 2.0),
-fake(>> 3.0), fake (= 2.5), python (<< 2.5), python (= 2.4)";
+my $field_dup_union = 'libc6 (>> 2.3), libc6 (>= 2.6-1), fake (<< 2.0),
+fake(>> 3.0), fake (= 2.5), python (<< 2.5), python (= 2.4)';
 my $dep_dup_union = deps_parse($field_dup_union, union => 1);
 $dep_dup_union->simplify_deps($facts);
-is($dep_dup_union->output(), "libc6 (>> 2.3), fake (<< 2.0), fake (>> 3.0), fake (= 2.5), python (<< 2.5)", "Simplify union deps");
+is($dep_dup_union->output(), 'libc6 (>> 2.3), fake (<< 2.0), fake (>> 3.0), fake (= 2.5), python (<< 2.5)', 'Simplify union deps');
 
-$dep_dup_union = deps_parse("sipsak (<= 0.9.6-2.1), sipsak (<= 0.9.6-2.2)", union => 1);
+$dep_dup_union = deps_parse('sipsak (<= 0.9.6-2.1), sipsak (<= 0.9.6-2.2)', union => 1);
 $dep_dup_union->simplify_deps($facts);
-is($dep_dup_union->output(), "sipsak (<= 0.9.6-2.2)", "Simplify union deps 2");
+is($dep_dup_union->output(), 'sipsak (<= 0.9.6-2.2)', 'Simplify union deps 2');
 
-my $dep_red = deps_parse("abc | xyz, two, abc");
+my $dep_red = deps_parse('abc | xyz, two, abc');
 $dep_red->simplify_deps($facts, $dep_opposite);
-is($dep_red->output(), "abc, two", "Simplification respect order");
-is("$dep_red", $dep_red->output(), "Stringification == output()");
+is($dep_red->output(), 'abc, two', 'Simplification respect order');
+is("$dep_red", $dep_red->output(), 'Stringification == output()');
 
-my $dep_empty1 = deps_parse("");
-is($dep_empty1->output(), "", "Empty dependency");
+my $dep_empty1 = deps_parse('');
+is($dep_empty1->output(), '', 'Empty dependency');
 
-my $dep_empty2 = deps_parse(" , , ", union => 1);
-is($dep_empty2->output(), "", "' , , ' is also an empty dependency");
+my $dep_empty2 = deps_parse(' , , ', union => 1);
+is($dep_empty2->output(), '', "' , , ' is also an empty dependency");
 
 $SIG{__WARN__} = sub {};
 my $dep_bad_multiline = deps_parse("a, foo\nbar, c");
-ok(!defined($dep_bad_multiline), "invalid dependency split over multiple line");
+ok(!defined($dep_bad_multiline), 'invalid dependency split over multiple line');
 delete $SIG{__WARN__};

+ 18 - 18
scripts/t/500_Dpkg_Path.t

@@ -33,28 +33,28 @@ mkdir "$tmpdir/debian";
 mkdir "$tmpdir/debian/a";
 mkdir "$tmpdir/debian/a/b";
 mkdir "$tmpdir/debian/a/b/c";
-symlink "a/b/c", "$tmpdir/cbis";
-symlink "/this/does/not/exist", "$tmpdir/tmp";
-symlink ".", "$tmpdir/here";
+symlink 'a/b/c', "$tmpdir/cbis";
+symlink '/this/does/not/exist', "$tmpdir/tmp";
+symlink '.', "$tmpdir/here";
 
-is(canonpath("$tmpdir/./a///b/c"), "$tmpdir/a/b/c", "canonpath basic test");
-is(canonpath("$tmpdir/a/b/../../a/b/c"), "$tmpdir/a/b/c", "canonpath and ..");
-is(canonpath("$tmpdir/a/b/c/../../"), "$tmpdir/a", "canonpath .. at end");
-is(canonpath("$tmpdir/cbis/../"), "$tmpdir/cbis/..", "canonpath .. after symlink");
+is(canonpath("$tmpdir/./a///b/c"), "$tmpdir/a/b/c", 'canonpath basic test');
+is(canonpath("$tmpdir/a/b/../../a/b/c"), "$tmpdir/a/b/c", 'canonpath and ..');
+is(canonpath("$tmpdir/a/b/c/../../"), "$tmpdir/a", 'canonpath .. at end');
+is(canonpath("$tmpdir/cbis/../"), "$tmpdir/cbis/..", 'canonpath .. after symlink');
 
-is(resolve_symlink("$tmpdir/here/cbis"), "$tmpdir/here/a/b/c", "resolve_symlink");
-is(resolve_symlink("$tmpdir/tmp"), "/this/does/not/exist", "resolve_symlink absolute");
-is(resolve_symlink("$tmpdir/here"), $tmpdir, "resolve_symlink .");
+is(resolve_symlink("$tmpdir/here/cbis"), "$tmpdir/here/a/b/c", 'resolve_symlink');
+is(resolve_symlink("$tmpdir/tmp"), '/this/does/not/exist', 'resolve_symlink absolute');
+is(resolve_symlink("$tmpdir/here"), $tmpdir, 'resolve_symlink .');
 
-ok(!check_files_are_the_same("$tmpdir/here", $tmpdir), "Symlink is not the same!");
-ok(check_files_are_the_same("$tmpdir/here/a", "$tmpdir/a"), "Same directory");
+ok(!check_files_are_the_same("$tmpdir/here", $tmpdir), 'Symlink is not the same!');
+ok(check_files_are_the_same("$tmpdir/here/a", "$tmpdir/a"), 'Same directory');
 
-is(get_pkg_root_dir("$tmpdir/a/b/c"), "$tmpdir/a", "get_pkg_root_dir");
-is(guess_pkg_root_dir("$tmpdir/a/b/c"), "$tmpdir/a", "guess_pkg_root_dir");
-is(relative_to_pkg_root("$tmpdir/a/b/c"), "b/c", "relative_to_pkg_root");
+is(get_pkg_root_dir("$tmpdir/a/b/c"), "$tmpdir/a", 'get_pkg_root_dir');
+is(guess_pkg_root_dir("$tmpdir/a/b/c"), "$tmpdir/a", 'guess_pkg_root_dir');
+is(relative_to_pkg_root("$tmpdir/a/b/c"), 'b/c', 'relative_to_pkg_root');
 
 chdir($tmpdir);
 
-ok(!defined(get_pkg_root_dir("debian/a/b/c")), "get_pkg_root_dir undef");
-ok(!defined(relative_to_pkg_root("debian/a/b/c")), "relative_to_pkg_root");
-is(guess_pkg_root_dir("debian/a/b/c"), "debian/a", "guess_pkg_root_dir fallback");
+ok(!defined(get_pkg_root_dir('debian/a/b/c')), 'get_pkg_root_dir undef');
+ok(!defined(relative_to_pkg_root('debian/a/b/c')), 'relative_to_pkg_root');
+is(guess_pkg_root_dir('debian/a/b/c'), 'debian/a', 'guess_pkg_root_dir fallback');

+ 22 - 22
scripts/t/600_Dpkg_Changelog.t

@@ -50,8 +50,8 @@ foreach my $file ("$datadir/countme", "$datadir/shadow", "$datadir/fields",
     my $changes = Dpkg::Changelog::Debian->new(verbose => 0);
     $changes->load($file);
 
-    open(my $clog_fh, "<", "$file") || die "Can't open $file\n";
-    my $content = join("", <$clog_fh>);
+    open(my $clog_fh, '<', "$file") || die "Can't open $file\n";
+    my $content = join('', <$clog_fh>);
     close($clog_fh);
     cmp_ok($content, 'eq', "$changes", "string output of Dpkg::Changelog on $file");
 
@@ -60,12 +60,12 @@ foreach my $file ("$datadir/countme", "$datadir/shadow", "$datadir/fields",
     is($errors, '', "Parse example changelog $file without errors" );
 
     my @data = @$changes;
-    ok(@data, "data is not empty");
+    ok(@data, 'data is not empty');
 
     my $str;
     if ($file eq "$datadir/countme") {
 	# test range options
-	cmp_ok( @data, '==', 7, "no options -> count" );
+	cmp_ok(@data, '==', 7, 'no options -> count');
 	my $all_versions = join( '/', map { $_->get_version() } @data);
 
 	sub check_options {
@@ -78,7 +78,7 @@ foreach my $file ("$datadir/countme", "$datadir/shadow", "$datadir/fields",
 		is_deeply( \@cnt, $data, "$check_name -> returns all" );
 
 	    } else {
-		is( join( "/", map { $_->get_version() } @cnt),
+		is( join( '/', map { $_->get_version() } @cnt),
 		    $versions, "$check_name -> versions" );
 	    }
 	}
@@ -214,7 +214,7 @@ Xc-Userfield: foobar
 	if ($vendor eq 'Ubuntu') {
 	    $expected =~ s/^(Closes:.*)/$1\nLaunchpad-Bugs-Fixed: 12345 54321 424242 2424242/m;
 	}
-	cmp_ok($str,'eq',$expected,"fields handling");
+	cmp_ok($str, 'eq', $expected, 'fields handling');
 
 	$str = $changes->dpkg({ offset => 1, count => 2 });
 	$expected = 'Source: fields
@@ -245,7 +245,7 @@ Xc-Userfield: foobar
 	if ($vendor eq 'Ubuntu') {
 	    $expected =~ s/^(Closes:.*)/$1\nLaunchpad-Bugs-Fixed: 12345 424242/m;
 	}
-	cmp_ok($str,'eq',$expected,"fields handling 2");
+	cmp_ok($str, 'eq', $expected, 'fields handling 2');
 
 	$str = $changes->rfc822({ offset => 2, count => 2 });
 	$expected = 'Source: fields
@@ -274,36 +274,36 @@ Changes:
 Xb-Userfield2: foobar
 
 ';
-	cmp_ok($str, 'eq', $expected, "fields handling 3");
+	cmp_ok($str, 'eq', $expected, 'fields handling 3');
 
 	# Test Dpkg::Changelog::Entry methods
-	is($data[1]->get_version(), "2.0-1", "get_version");
-	is($data[1]->get_source(), "fields", "get_source");
-	is(scalar $data[1]->get_distributions(), "unstable", "get_distribution");
-	is(join("|", $data[1]->get_distributions()), "unstable|frozen",
-	    "get_distributions");
+	is($data[1]->get_version(), '2.0-1', 'get_version');
+	is($data[1]->get_source(), 'fields', 'get_source');
+	is(scalar $data[1]->get_distributions(), 'unstable', 'get_distribution');
+	is(join('|', $data[1]->get_distributions()), 'unstable|frozen',
+	    'get_distributions');
 	is($data[3]->get_optional_fields(),
 	    "Urgency: high\nCloses: 1000000\nXb-Userfield2: foobar\n",
-	    "get_optional_fields");
+	    'get_optional_fields');
 	is($data[1]->get_maintainer(), 'Frank Lichtenheld <djpig@debian.org>',
-	    "get_maintainer");
+	    'get_maintainer');
 	is($data[1]->get_timestamp(), 'Sun, 12 Jan 2008 15:49:19 +0100',
-	    "get_timestamp");
+	    'get_timestamp');
 	my @items = $data[1]->get_change_items();
-	is($items[0], "  [ Frank Lichtenheld ]\n", "change items 1");
-	is($items[4], "  * New upstream release.
+	is($items[0], "  [ Frank Lichtenheld ]\n", 'change items 1');
+	is($items[4], '  * New upstream release.
     - implements a
     - implements b
-", "change items 2");
-	is($items[5], "  * Update S-V.\n", "change items 3");
+', 'change items 2');
+	is($items[5], "  * Update S-V.\n", 'change items 3');
     }
     if ($file eq "$datadir/regressions") {
 	my $f = $changes->dpkg();
-	is("$f->{Version}", "0", "version 0 correctly parsed");
+	is("$f->{Version}", '0', 'version 0 correctly parsed');
     }
 
     SKIP: {
-	skip("avoid spurious warning with only one entry", 2)
+	skip('avoid spurious warning with only one entry', 2)
 	    if @data == 1;
 
 	my $oldest_version = $data[-1]->{Version};

+ 6 - 6
scripts/t/700_Dpkg_Control.t

@@ -73,22 +73,22 @@ Description: short one
 is($value, $expected, "Dump of $datadir/control-1");
 
 my $src = $c->get_source();
-is($src, $c->[0], "array representation of Dpkg::Control::Info 1/2");
-is($src->{'my-field-one'}, 'myvalue1', "Access field through badly capitalized field name");
+is($src, $c->[0], 'array representation of Dpkg::Control::Info 1/2');
+is($src->{'my-field-one'}, 'myvalue1', 'Access field through badly capitalized field name');
 is($src->{'long-field'}, 
 'line1
 line 2 line 2 line 2
 
   line 3 line 3 line 3
 .
-line 4', "Get multi-line field");
-is($src->{'Empty-field'}, "", "Get empty field");
+line 4', 'Get multi-line field');
+is($src->{'Empty-field'}, '', 'Get empty field');
 
 my $pkg = $c->get_pkg_by_idx(1);
-is($pkg, $c->[1], "array representation of Dpkg::Control::Info 2/2");
+is($pkg, $c->[1], 'array representation of Dpkg::Control::Info 2/2');
 is($pkg->{package}, 'mypackage1', 'Name of first package');
 
-$pkg = $c->get_pkg_by_name("mypackage3");
+$pkg = $c->get_pkg_by_name('mypackage3');
 is($pkg->{package}, 'mypackage3', 'Name of third package');
 is($pkg->{Depends}, 'hello', 'Name of third package');
 

+ 21 - 21
scripts/t/750_Dpkg_Substvars.t

@@ -46,7 +46,7 @@ is($s->get('var3'), undef, 'var3 deleted');
 
 # default variables
 is($s->get('Newline'), "\n", 'newline');
-is($s->get('Space'), " ", 'space');
+is($s->get('Space'), ' ', 'space');
 is($s->get('Tab'), "\t", 'tab');
 is($s->get('dpkg:Version'), $version, 'dpkg version 1');
 
@@ -56,43 +56,43 @@ $s->set_arch_substvars();
 is($s->get('Arch'), get_host_arch(),'arch');
 
 is($s->get($_), undef, 'no ' . $_) for qw/binary:Version source:Version source:Upstream-Version/;
-$s->set_version_substvars("1:2.3.4~5-6.7.8~nmu9", "1:2.3.4~5-6.7.8~nmu9+bin0");
-is($s->get("binary:Version"), "1:2.3.4~5-6.7.8~nmu9+bin0", "binary:Version");
-is($s->get("source:Version"), "1:2.3.4~5-6.7.8~nmu9", "source:Version");
-is($s->get("source:Upstream-Version"), "1:2.3.4~5", "source:Upstream-Version");
-$s->set_version_substvars("2.3.4~5-6.7.8~nmu9+b1", "1:2.3.4~5-6.7.8~nmu9+b1");
-is($s->get("binary:Version"), "1:2.3.4~5-6.7.8~nmu9+b1", "binary:Version");
-is($s->get("source:Version"), "2.3.4~5-6.7.8~nmu9", "source:Version");
-is($s->get("source:Upstream-Version"), "2.3.4~5", "source:Upstream-Version");
-$s->set_version_substvars("1:2.3.4~5-6.7.8~nmu9+b0");
-is($s->get("binary:Version"), "1:2.3.4~5-6.7.8~nmu9+b0", "binary:Version");
-is($s->get("source:Version"), "1:2.3.4~5-6.7.8~nmu9", "source:Version");
-is($s->get("source:Upstream-Version"), "1:2.3.4~5", "source:Upstream-Version");
+$s->set_version_substvars('1:2.3.4~5-6.7.8~nmu9', '1:2.3.4~5-6.7.8~nmu9+bin0');
+is($s->get('binary:Version'), '1:2.3.4~5-6.7.8~nmu9+bin0', 'binary:Version');
+is($s->get('source:Version'), '1:2.3.4~5-6.7.8~nmu9', 'source:Version');
+is($s->get('source:Upstream-Version'), '1:2.3.4~5', 'source:Upstream-Version');
+$s->set_version_substvars('2.3.4~5-6.7.8~nmu9+b1', '1:2.3.4~5-6.7.8~nmu9+b1');
+is($s->get('binary:Version'), '1:2.3.4~5-6.7.8~nmu9+b1', 'binary:Version');
+is($s->get('source:Version'), '2.3.4~5-6.7.8~nmu9', 'source:Version');
+is($s->get('source:Upstream-Version'), '2.3.4~5', 'source:Upstream-Version');
+$s->set_version_substvars('1:2.3.4~5-6.7.8~nmu9+b0');
+is($s->get('binary:Version'), '1:2.3.4~5-6.7.8~nmu9+b0', 'binary:Version');
+is($s->get('source:Version'), '1:2.3.4~5-6.7.8~nmu9', 'source:Version');
+is($s->get('source:Upstream-Version'), '1:2.3.4~5', 'source:Upstream-Version');
 
 # Replace stuff
 is($s->substvars('This is a string ${var1} with variables ${binary:Version}'),
-                 "This is a string New value with variables 1:2.3.4~5-6.7.8~nmu9+b0",
-		 "substvars simple");
+                 'This is a string New value with variables 1:2.3.4~5-6.7.8~nmu9+b0',
+                 'substvars simple');
 
 my $output;
 $SIG{__WARN__} = sub { $output .= $_[0] };
 is($s->substvars('This is a string with unknown variable ${blubb}'),
-                 "This is a string with unknown variable ",
-		 "substvars missing");
+                 'This is a string with unknown variable ',
+                 'substvars missing');
 delete $SIG{__WARN__};
 is($output, '750_Dpkg_Substvars.t: warning: unknown substitution variable ${blubb}'."\n"
           , 'missing variables warning');
 
 # Recursive replace
-$s->set("rvar", 'recursive ${var1}');
+$s->set('rvar', 'recursive ${var1}');
 is($s->substvars('This is a string with ${rvar}'),
-                 "This is a string with recursive New value",
-		 "substvars recursive");
+                 'This is a string with recursive New value',
+                 'substvars recursive');
 
 # Strange input
 is($s->substvars('Nothing to $ ${substitute  here}, is it ${}?, it ${is'),
                  'Nothing to $ ${substitute  here}, is it ${}?, it ${is',
-		 "substvars strange");
+                 'substvars strange');
 
 # Warnings about unused variables
 $output = '';

+ 8 - 8
scripts/t/800_Dpkg_IPC.t

@@ -34,15 +34,15 @@ open $tmp_fh, '>', $tmp1_name;
 print $tmp_fh $string1;
 close $tmp_fh;
 
-my $pid = spawn(exec => "cat",
+my $pid = spawn(exec => 'cat',
 		from_string => \$string1,
 		to_string => \$string2);
 
 ok($pid);
 
-is($string2, $string1, "{from,to}_string");
+is($string2, $string1, '{from,to}_string');
 
-$pid = spawn(exec => "cat",
+$pid = spawn(exec => 'cat',
 	     from_handle => $tmp1_fh,
 	     to_handle => $tmp2_fh);
 
@@ -54,9 +54,9 @@ open $tmp_fh, '<', $tmp2_name;
 $string2 = <$tmp_fh>;
 close $tmp_fh;
 
-is($string2, $string1, "{from,to}_handle");
+is($string2, $string1, '{from,to}_handle');
 
-$pid = spawn(exec => "cat",
+$pid = spawn(exec => 'cat',
 	     from_file => $tmp1_name,
 	     to_file => $tmp2_name,
 	     wait_child => 1,
@@ -68,14 +68,14 @@ open $tmp_fh, '<', $tmp2_name;
 $string2 = <$tmp_fh>;
 close $tmp_fh;
 
-is($string2, $string1, "{from,to}_file");
+is($string2, $string1, '{from,to}_file');
 
 eval {
-    $pid = spawn(exec => ["sleep", "10"],
+    $pid = spawn(exec => ['sleep', '10'],
 	         wait_child => 1,
 	         timeout => 5);
 };
-ok($@, "fails on timeout");
+ok($@, 'fails on timeout');
 
 unlink($tmp1_name);
 unlink($tmp2_name);

+ 20 - 20
scripts/t/850_Dpkg_Compression.t

@@ -21,7 +21,7 @@ use warnings;
 use_ok('Dpkg::Compression');
 use_ok('Dpkg::Compression::FileHandle');
 
-my $tmpdir = "t.tmp/850_Dpkg_Compression";
+my $tmpdir = 't.tmp/850_Dpkg_Compression';
 mkdir $tmpdir;
 my @lines = ("One\n", "Two\n", "Three\n");
 my $fh;
@@ -30,39 +30,39 @@ sub test_write {
     my ($filename, $check_result) = @_;
 
     $fh = Dpkg::Compression::FileHandle->new();
-    open $fh, ">", $filename or die "open failed";
+    open $fh, '>', $filename or die 'open failed';
     print $fh $lines[0];
     syswrite($fh, $lines[1]);
-    printf $fh "%s", $lines[2];
-    close $fh or die "close failed";
+    printf $fh '%s', $lines[2];
+    close $fh or die 'close failed';
 
-    &$check_result($filename, "std functions");
+    &$check_result($filename, 'std functions');
 
     unlink $filename or die "cannot unlink $filename";
 
     $fh = Dpkg::Compression::FileHandle->new();
-    $fh->open($filename, "w");
+    $fh->open($filename, 'w');
     $fh->print($lines[0]);
     $fh->write($lines[1], length($lines[1]));
-    $fh->printf("%s", $lines[2]);
-    $fh->close() or die "close failed";
+    $fh->printf('%s', $lines[2]);
+    $fh->close() or die 'close failed';
 
-    &$check_result($filename, "IO::Handle methods");
+    &$check_result($filename, 'IO::Handle methods');
 }
 
 sub check_uncompressed {
     my ($filename, $method) = @_;
-    open(my $read_fh, "<", $filename) or die "cannot read $filename";
+    open(my $read_fh, '<', $filename) or die "cannot read $filename";
     my @read = <$read_fh>;
-    close $read_fh or die "cannot close";
+    close $read_fh or die 'cannot close';
     is_deeply(\@lines, \@read, "$filename correctly written ($method)");
 }
 
 sub check_compressed {
     my ($filename, $method) = @_;
-    open(my $read_fh, "-|", "zcat $tmpdir/myfile.gz") or die "cannot fork zcat";
+    open(my $read_fh, '-|', "zcat $tmpdir/myfile.gz") or die 'cannot fork zcat';
     my @read = <$read_fh>;
-    close $read_fh or die "cannot close";
+    close $read_fh or die 'cannot close';
     is_deeply(\@lines, \@read, "$filename correctly written ($method)");
 }
 
@@ -70,17 +70,17 @@ sub test_read {
     my ($filename) = @_;
 
     $fh = Dpkg::Compression::FileHandle->new();
-    open($fh, "<", $filename) or die "open failed";
+    open($fh, '<', $filename) or die 'open failed';
     my @read = <$fh>;
-    close $fh or die "close failed";
+    close $fh or die 'close failed';
 
     is_deeply(\@lines, \@read, "$filename correctly read (std functions)");
 
     @read = ();
     $fh = Dpkg::Compression::FileHandle->new();
-    $fh->open($filename, "r") or die "open failed";
+    $fh->open($filename, 'r') or die 'open failed';
     @read = $fh->getlines();
-    $fh->close() or die "close failed";
+    $fh->close() or die 'close failed';
 
     is_deeply(\@lines, \@read, "$filename correctly read (IO::Handle methods)");
 }
@@ -88,11 +88,11 @@ sub test_read {
 # Test changing the default compression levels
 my $old_level = compression_get_default_level();
 compression_set_default_level(1);
-is(compression_get_default_level(), 1, "change default compression level");
+is(compression_get_default_level(), 1, 'change default compression level');
 compression_set_default_level(5);
-is(compression_get_default_level(), 5, "change default compression level");
+is(compression_get_default_level(), 5, 'change default compression level');
 compression_set_default_level(undef);
-is(compression_get_default_level(), $old_level, "reset default compression level");
+is(compression_get_default_level(), $old_level, 'reset default compression level');
 
 # Test write on uncompressed file
 test_write("$tmpdir/myfile", \&check_uncompressed);

+ 3 - 3
scripts/t/910_merge_changelogs.t

@@ -32,7 +32,7 @@ sub test_merge {
     my ($expected_file, @options) = @_;
     my ($fh, $filename) = tempfile();
     spawn(exec => ["$srcdir/dpkg-mergechangelogs.pl", @options],
-	  to_handle => $fh, error_to_file => "/dev/null",
+	  to_handle => $fh, error_to_file => '/dev/null',
 	  wait_child => 1, nocheck => 1);
     my $res = compare($expected_file, $filename);
     if ($res) {
@@ -51,10 +51,10 @@ if ($@) {
 my @input = ("$datadir/ch-old", "$datadir/ch-a", "$datadir/ch-b");
 if ($has_alg_merge) {
     test_merge("$datadir/ch-merged", @input);
-    test_merge("$datadir/ch-merged-pr", "-m", @input);
+    test_merge("$datadir/ch-merged-pr", '-m', @input);
 } else {
     test_merge("$datadir/ch-merged-basic", @input);
-    test_merge("$datadir/ch-merged-pr-basic", "-m", @input);
+    test_merge("$datadir/ch-merged-pr-basic", '-m', @input);
 }
 test_merge("$datadir/ch-badver-merged",  ("$datadir/ch-badver-old",
     "$datadir/ch-badver-a", "$datadir/ch-badver-b"));

+ 62 - 62
src/t/100_dpkg_divert.t

@@ -33,7 +33,7 @@ my $testdir = File::Spec->rel2abs("$tmpdir/testdir");
 my @dd = ("$builddir/../src/dpkg-divert");
 
 if (! -x "@dd") {
-    plan skip_all => "dpkg-divert not available";
+    plan skip_all => 'dpkg-divert not available';
     exit(0);
 }
 
@@ -142,14 +142,14 @@ sub diversions_eq {
     my (@expected_pack) = diversions_pack(@expected);
     my (@contents_pack) = diversions_pack(@contents);
 
-    is_deeply(\@contents_pack, \@expected_pack, "diversions contents");
+    is_deeply(\@contents_pack, \@expected_pack, 'diversions contents');
 }
 
 ### Tests
 
 cleanup();
 
-note("Command line parsing testing");
+note('Command line parsing testing');
 
 my $usagere = qr/.*Usage.*dpkg-divert.*Commands.*Options.*/s;
 
@@ -166,7 +166,7 @@ call_divert(['--version'], expect_stdout_like => qr/.*dpkg-divert.*free software
 call_divert_badusage(['--jachsmitbju'], qr/unknown option/);
 call_divert_badusage(['--add', '--remove'], qr/(conflicting|two).*remove.*add.*/s);
 call_divert_badusage(['--divert'], qr/(takes a value|needs.*argument)/);
-call_divert_badusage(['--divert', "foo"], qr/absolute/);
+call_divert_badusage(['--divert', 'foo'], qr/absolute/);
 call_divert_badusage(['--divert', "/foo\nbar"], qr/newline/);
 call_divert_badusage(['--package'], qr/(takes a value|needs.*argument)/);
 call_divert_badusage(['--package', "foo\nbar"], qr/newline/);
@@ -177,7 +177,7 @@ call_divert_badusage(['--add',], qr/needs a single argument/);
 call_divert_badusage(['--add', 'foo'], qr/absolute/);
 call_divert_badusage(['--add', "/foo\nbar"], qr/newline/);
 call_divert_badusage(['--add', "$testdir"], qr/director(y|ies)/);
-call_divert_badusage(['--add', "--divert", "bar", "/foo/bar"], qr/absolute/);
+call_divert_badusage(['--add', '--divert', 'bar', '/foo/bar'], qr/absolute/);
 call_divert_badusage(['--remove'], qr/needs a single argument/);
 call_divert_badusage(['--remove', 'foo'], qr/absolute/);
 call_divert_badusage(['--remove', "/foo\nbar"], qr/newline/);
@@ -192,7 +192,7 @@ call([@dd, '--admindir'], [],
 
 cleanup();
 
-note("Querying information from diverts db (empty one)");
+note('Querying information from diverts db (empty one)');
 
 install_diversions('');
 
@@ -202,7 +202,7 @@ call_divert_sort(['--list', 'baz'], expect_stdout => '', expect_stderr => '');
 
 cleanup();
 
-note("Querying information from diverts db (1)");
+note('Querying information from diverts db (1)');
 
 install_diversions(<<'EOF');
 /bin/sh
@@ -238,7 +238,7 @@ call_divert_sort(['--list', '/bin/sh', '/usr/share/man/man1/sh.1.gz'], expect_st
 
 cleanup();
 
-note("Querying information from diverts db (2)");
+note('Querying information from diverts db (2)');
 
 install_diversions(<<'EOF');
 /bin/sh
@@ -260,7 +260,7 @@ call_divert(['--truename', '/bin/something'], expect_stdout => "/bin/something\n
 
 cleanup();
 
-note("Adding diversion");
+note('Adding diversion');
 
 my $diversions_added_foo_local = <<"EOF";
 $testdir/foo
@@ -274,13 +274,13 @@ system("touch $testdir/foo");
 call_divert(['--rename', '--add', "$testdir/foo"],
             expect_stdout_like => qr,Adding.*local.*diversion.*\Q$testdir\E/foo.*\Q$testdir\E/foo.distrib,,
             expect_stderr => '');
-ok(-e "$testdir/foo.distrib", "foo diverted");
-ok(!-e "$testdir/foo", "foo diverted");
+ok(-e "$testdir/foo.distrib", 'foo diverted');
+ok(!-e "$testdir/foo", 'foo diverted');
 diversions_eq($diversions_added_foo_local);
 
 cleanup();
 
-note("Adding diversion (2)");
+note('Adding diversion (2)');
 
 install_diversions('');
 
@@ -288,61 +288,61 @@ system("touch $testdir/foo");
 call_divert(['--add', "$testdir/foo"],
             expect_stdout_like => qr,Adding.*local.*diversion.*\Q$testdir\E/foo.*\Q$testdir\E/foo.distrib,,
             expect_stderr => '');
-ok(!-e "$testdir/foo.distrib", "foo diverted");
-ok(-e "$testdir/foo", "foo diverted");
+ok(!-e "$testdir/foo.distrib", 'foo diverted');
+ok(-e "$testdir/foo", 'foo diverted');
 diversions_eq($diversions_added_foo_local);
 
 cleanup();
 
-note("Adding diversion (3)");
+note('Adding diversion (3)');
 
 install_diversions('');
 
 system("touch $testdir/foo");
 call_divert(['--quiet', '--rename', '--add', "$testdir/foo"],
             expect_stdout => '', expect_stderr => '');
-ok(-e "$testdir/foo.distrib", "foo diverted");
-ok(!-e "$testdir/foo", "foo diverted");
+ok(-e "$testdir/foo.distrib", 'foo diverted');
+ok(!-e "$testdir/foo", 'foo diverted');
 diversions_eq($diversions_added_foo_local);
 
 cleanup();
 
-note("Adding diversion (4)");
+note('Adding diversion (4)');
 
 install_diversions('');
 system("touch $testdir/foo");
 call_divert(['--quiet', '--rename', '--test', "$testdir/foo"],
             expect_stdout => '', expect_stderr => '');
-ok(-e "$testdir/foo", "foo not diverted");
-ok(!-e "$testdir/foo.distrib", "foo diverted");
+ok(-e "$testdir/foo", 'foo not diverted');
+ok(!-e "$testdir/foo.distrib", 'foo diverted');
 diversions_eq('');
 
 cleanup();
 
-note("Adding diversion (5)");
+note('Adding diversion (5)');
 
 install_diversions('');
 call_divert(['--quiet', '--rename', "$testdir/foo"],
             expect_stdout => '', expect_stderr => '');
-ok(!-e "$testdir/foo", "foo does not exist");
-ok(!-e "$testdir/foo.distrib", "foo was not created out of thin air");
+ok(!-e "$testdir/foo", 'foo does not exist');
+ok(!-e "$testdir/foo.distrib", 'foo was not created out of thin air');
 
 cleanup();
 
-note("Adding diversion (6)");
+note('Adding diversion (6)');
 
 install_diversions('');
 system("touch $testdir/foo");
 call_divert(['--quiet', '--local', '--rename', "$testdir/foo"],
             expect_stdout => '', expect_stderr => '');
 
-ok(-e "$testdir/foo.distrib", "foo diverted");
-ok(!-e "$testdir/foo", "foo diverted");
+ok(-e "$testdir/foo.distrib", 'foo diverted');
+ok(!-e "$testdir/foo", 'foo diverted');
 diversions_eq($diversions_added_foo_local);
 
 cleanup();
 
-note("Adding diversion (7)");
+note('Adding diversion (7)');
 
 install_diversions('');
 call_divert(['--quiet', '--rename', '--package', 'bash', "$testdir/foo"],
@@ -353,28 +353,28 @@ $testdir/foo.distrib
 bash
 EOF
 
-note("Adding diversion (8)");
+note('Adding diversion (8)');
 
 install_diversions('');
 system("touch $testdir/foo; ln $testdir/foo $testdir/foo.distrib");
-call_divert(["--rename", "$testdir/foo"]);
+call_divert(['--rename', "$testdir/foo"]);
 diversions_eq($diversions_added_foo_local);
-ok(!-e "$testdir/foo", "foo diverted");
-ok(-e "$testdir/foo.distrib", "foo diverted");
+ok(!-e "$testdir/foo", 'foo diverted');
+ok(-e "$testdir/foo.distrib", 'foo diverted');
 
 cleanup();
 
-note("Adding diversion (9)");
+note('Adding diversion (9)');
 
 install_diversions('');
 system("touch $testdir/foo $testdir/foo.distrib");
-call_divert(["--rename", "$testdir/foo"], expect_failure => 1,
+call_divert(['--rename', "$testdir/foo"], expect_failure => 1,
             expect_stderr_like => qr/overwriting/);
 diversions_eq('');
 
 cleanup();
 
-note("Adding second diversion");
+note('Adding second diversion');
 
 install_diversions('');
 call_divert(["$testdir/foo"]);
@@ -394,7 +394,7 @@ call_divert(['--divert', "$testdir/foo", "$testdir/bar"],
 
 cleanup();
 
-note("Adding third diversion");
+note('Adding third diversion');
 
 install_diversions('');
 call_divert(["$testdir/foo"]);
@@ -406,7 +406,7 @@ call_divert(['--package', 'foobar', "$testdir/bar"], expect_failure => 1,
 
 cleanup();
 
-note("Adding diversion in non-existing directory");
+note('Adding diversion in non-existing directory');
 
 install_diversions('');
 
@@ -420,16 +420,16 @@ EOF
 
 cleanup();
 
-note("Adding diversion of file owned by --package");
+note('Adding diversion of file owned by --package');
 
-install_filelist("coreutils", "i386", "$testdir/foo");
+install_filelist('coreutils', 'i386', "$testdir/foo");
 install_diversions('');
 system("touch $testdir/foo");
 
 call_divert(['--quiet', '--rename', '--add', '--package', 'coreutils', "$testdir/foo"],
             expect_stderr => '', expect_stdout => '');
-ok(-e "$testdir/foo", "foo not renamed");
-ok(!-e "$testdir/foo.distrib", "foo renamed");
+ok(-e "$testdir/foo", 'foo not renamed');
+ok(!-e "$testdir/foo.distrib", 'foo renamed');
 diversions_eq(<<"EOF");
 $testdir/foo
 $testdir/foo.distrib
@@ -438,7 +438,7 @@ EOF
 
 cleanup();
 
-note("Remove diversions");
+note('Remove diversions');
 
 install_diversions('');
 
@@ -447,21 +447,21 @@ call_divert(['--remove', '--quiet', '/bin/sh'], expect_stdout => '', expect_stde
 
 cleanup();
 
-note("Remove diversion (2)");
+note('Remove diversion (2)');
 
 install_diversions('');
 call_divert(["$testdir/foo"]);
 call_divert(["$testdir/bar"]);
 call_divert(["$testdir/baz"]);
 
-call_divert(["--divert", "$testdir/foo.my", "--remove", "$testdir/foo"],
+call_divert(['--divert', "$testdir/foo.my", '--remove', "$testdir/foo"],
            expect_failure => 1, expect_stderr_like => qr/mismatch on divert-to/);
-call_divert(["--package", "baz", "--remove", "$testdir/foo"],
+call_divert(['--package', 'baz', '--remove', "$testdir/foo"],
             expect_failure => 1, expect_stderr_like => qr/mismatch on package/);
-call_divert(["--package", "baz", "--divert", "$testdir/foo.my", "--remove", "$testdir/foo"],
+call_divert(['--package', 'baz', '--divert', "$testdir/foo.my", '--remove', "$testdir/foo"],
             expect_failure => 1, expect_stderr_like =>qr/mismatch on (package|divert-to)/);
 
-call_divert(["--divert", "$testdir/foo.distrib", "--remove", "$testdir/foo"],
+call_divert(['--divert', "$testdir/foo.distrib", '--remove', "$testdir/foo"],
             expect_stdout_like => qr,Removing.*\Q$testdir\E/foo,);
 diversions_eq(<<"EOF");
 $testdir/bar
@@ -474,7 +474,7 @@ EOF
 
 cleanup();
 
-note("Remove diversion (3)");
+note('Remove diversion (3)');
 
 install_diversions('');
 
@@ -482,7 +482,7 @@ call_divert(["$testdir/foo"]);
 call_divert(["$testdir/bar"]);
 call_divert(["$testdir/baz"]);
 
-call_divert(["--remove", "$testdir/bar"],
+call_divert(['--remove', "$testdir/bar"],
             expect_stdout_like => qr,Removing.*\Q$testdir\E/bar,);
 diversions_eq(<<"EOF");
 $testdir/foo
@@ -495,15 +495,15 @@ EOF
 
 cleanup();
 
-note("Remove diversion (4)");
+note('Remove diversion (4)');
 
 install_diversions('');
 
 call_divert(["$testdir/foo"]);
 call_divert(["$testdir/bar"]);
-call_divert(["--package", "bash", "$testdir/baz"]);
+call_divert(['--package', 'bash', "$testdir/baz"]);
 
-call_divert(["--quiet", "--package", "bash", "--remove", "$testdir/baz"],
+call_divert(['--quiet', '--package', 'bash', '--remove', "$testdir/baz"],
             expect_stdout => '', expect_stderr => '');
 diversions_eq(<<"EOF");
 $testdir/foo
@@ -516,19 +516,19 @@ EOF
 
 cleanup();
 
-note("Remove diversion(5)");
+note('Remove diversion(5)');
 
 install_diversions('');
 system("touch $testdir/foo");
-call_divert(["--rename", "$testdir/foo"]);
+call_divert(['--rename', "$testdir/foo"]);
 
-call_divert(["--test", "--rename", "--remove", "$testdir/foo"],
+call_divert(['--test', '--rename', '--remove', "$testdir/foo"],
             expect_stdout_like => qr,Removing.*\Q$testdir\E/foo,, expect_stderr => '');
 ok(-e "$testdir/foo.distrib");
 ok(!-e "$testdir/foo");
 diversions_eq($diversions_added_foo_local);
 
-call_divert(["--quiet", "--rename", "--remove", "$testdir/foo"],
+call_divert(['--quiet', '--rename', '--remove', "$testdir/foo"],
             expect_stdout => '', expect_stderr => '');
 ok(-e "$testdir/foo");
 ok(!-e "$testdir/foo.distrib");
@@ -536,10 +536,10 @@ diversions_eq('');
 
 cleanup();
 
-note("Corrupted divertions db handling");
+note('Corrupted divertions db handling');
 
 SKIP: {
-    skip "running as root or similar", 3, if (defined($ENV{FAKEROOTKEY}) or $> == 0);
+    skip 'running as root or similar', 3, if (defined($ENV{FAKEROOTKEY}) or $> == 0);
 
     # An inexistent diversions db file should not be considered a failure,
     # but a failure to open it should be.
@@ -568,9 +568,9 @@ call_divert_sort(['--list'], expect_failure => 1,
 cleanup();
 
 SKIP: {
-    skip "running as root or similar", 10, if (defined($ENV{FAKEROOTKEY}) or $> == 0);
+    skip 'running as root or similar', 10, if (defined($ENV{FAKEROOTKEY}) or $> == 0);
 
-    note("R/O directory");
+    note('R/O directory');
 
     install_diversions('');
     system("mkdir $testdir/rodir && touch $testdir/rodir/foo $testdir/bar && chmod 500 $testdir/rodir");
@@ -583,7 +583,7 @@ SKIP: {
     system("chmod 755 $testdir/rodir");
     cleanup();
 
-    note("Unavailable file");
+    note('Unavailable file');
 
     install_diversions('');
     system("mkdir $testdir/nadir && chmod 000 $testdir/nadir");
@@ -597,12 +597,12 @@ SKIP: {
     cleanup();
 }
 
-note("Errors during saving diversions db");
+note('Errors during saving diversions db');
 
 install_diversions('');
 
 SKIP: {
-    skip "running as root or similar", 4, if (defined($ENV{FAKEROOTKEY}) or $> == 0);
+    skip 'running as root or similar', 4, if (defined($ENV{FAKEROOTKEY}) or $> == 0);
 
     system("chmod 500 $admindir");
     call_divert(["$testdir/foo"], expect_failure => 1, expect_stderr_like => qr/create.*new/);

+ 2 - 2
test/000_pod.t

@@ -18,7 +18,7 @@ use Test::More;
 use strict;
 use warnings;
 
-eval "use Test::Pod 1.00";
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+eval 'use Test::Pod 1.00';
+plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@;
 my @poddirs = ( $ENV{srcdir} || '.' );
 all_pod_files_ok( all_pod_files( @poddirs ) );

+ 1 - 0
test/100_critic.t

@@ -69,6 +69,7 @@ my @policies = qw(
     TestingAndDebugging::RequireUseStrict
     TestingAndDebugging::RequireUseWarnings
     ValuesAndExpressions::ProhibitComplexVersion
+    ValuesAndExpressions::ProhibitInterpolationOfLiterals
     ValuesAndExpressions::ProhibitLongChainsOfMethodCalls
     ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters
     ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator

+ 4 - 0
test/100_critic/perlcriticrc

@@ -5,6 +5,10 @@ verbose = %f %l:%c (Severity: %s)\n  %P (%s)\n  near '%r'\n%d\n
 #[RegularExpressions::RequireExtendedFormatting]
 #minimum_regex_length_to_complain_about = 60
 
+[ValuesAndExpressions::ProhibitInterpolationOfLiterals]
+# TODO: switch these to q{} ?
+allow_if_string_contains_single_quote = 1
+
 # Complex is not always bad.
 [-BuiltinFunctions::ProhibitComplexMappings]
 # Needed when generating code.

+ 141 - 141
utils/t/100_update_alternatives.t

@@ -26,25 +26,25 @@ my $tmpdir = 't.tmp/900_update_alternatives';
 my $admindir = File::Spec->rel2abs("$tmpdir/admindir"),
 my $altdir = File::Spec->rel2abs("$tmpdir/alternatives");
 my $bindir = File::Spec->rel2abs("$tmpdir/bin");
-my @ua = ("$ENV{builddir}/update-alternatives", "--log", "/dev/null",
-          "--quiet", "--admindir", "$admindir", "--altdir", "$altdir");
+my @ua = ("$ENV{builddir}/update-alternatives", '--log', '/dev/null',
+          '--quiet', '--admindir', "$admindir", '--altdir', "$altdir");
 
 my %paths = (
-    true => find_command("true"),
-    false => find_command("false"),
-    yes => find_command("yes"),
-    cat => find_command("cat"),
-    date => find_command("date"),
-    sleep => find_command("sleep"),
+    true => find_command('true'),
+    false => find_command('false'),
+    yes => find_command('yes'),
+    cat => find_command('cat'),
+    date => find_command('date'),
+    sleep => find_command('sleep'),
 );
 
 if (! -x "$ENV{builddir}/update-alternatives") {
-    plan skip_all => "update-alternatives not available";
+    plan skip_all => 'update-alternatives not available';
     exit(0);
 }
 
 my $main_link = "$bindir/generic-test";
-my $main_name = "generic-test";
+my $main_name = 'generic-test';
 my @choices = (
     {
 	path => $paths{true},
@@ -52,22 +52,22 @@ my @choices = (
 	slaves => [
 	    {
 		link => "$bindir/slave2",
-		name => "slave2",
+		name => 'slave2',
 		path => $paths{cat},
 	    },
 	    {
 		link => "$bindir/slave3",
-		name => "slave3",
+		name => 'slave3',
 		path => $paths{cat},
 	    },
 	    {
 		link => "$bindir/slave1",
-		name => "slave1",
+		name => 'slave1',
 		path => $paths{yes},
 	    },
 	    {
 		link => "$bindir/slave4",
-		name => "slave4",
+		name => 'slave4',
 		path => $paths{cat},
 	    },
 	],
@@ -78,7 +78,7 @@ my @choices = (
         slaves => [
 	    {
 		link => "$bindir/slave1",
-		name => "slave1",
+		name => 'slave1',
 		path => $paths{date},
 	    },
         ],
@@ -101,8 +101,8 @@ sub cleanup {
 sub call_ua {
     my ($params, %opts) = @_;
     spawn(exec => [ @ua, @$params ], nocheck => 1,
-	  wait_child => 1, env => { LC_ALL => "C" }, %opts);
-    my $test_id = "";
+	  wait_child => 1, env => { LC_ALL => 'C' }, %opts);
+    my $test_id = '';
     $test_id = "$opts{test_id}: " if defined $opts{test_id};
     if ($opts{expect_failure}) {
 	ok($? != 0, "${test_id}update-alternatives @$params should fail.") or
@@ -118,10 +118,10 @@ sub install_choice {
     my $alt = $choices[$id];
     my @params;
     push @params, @{$opts{params}} if exists $opts{params};
-    push @params, "--install", "$main_link", "$main_name",
+    push @params, '--install', "$main_link", "$main_name",
 		  $alt->{path}, $alt->{priority};
     foreach my $slave (@{ $alt->{slaves} }) {
-	push @params, "--slave", $slave->{link}, $slave->{name}, $slave->{path};
+	push @params, '--slave', $slave->{link}, $slave->{name}, $slave->{path};
     }
     call_ua(\@params, %opts);
 }
@@ -131,7 +131,7 @@ sub remove_choice {
     my $alt = $choices[$id];
     my @params;
     push @params, @{$opts{params}} if exists $opts{params};
-    push @params, "--remove", $main_name, $alt->{path};
+    push @params, '--remove', $main_name, $alt->{path};
     call_ua(\@params, %opts);
 }
 
@@ -139,7 +139,7 @@ sub remove_all_choices {
     my (%opts) = @_;
     my @params;
     push @params, @{$opts{params}} if exists $opts{params};
-    push @params, "--remove-all", $main_name;
+    push @params, '--remove-all', $main_name;
     call_ua(\@params, %opts);
 }
 
@@ -148,25 +148,25 @@ sub set_choice {
     my $alt = $choices[$id];
     my @params;
     push @params, @{$opts{params}} if exists $opts{params};
-    push @params, "--set", $main_name, $alt->{path};
+    push @params, '--set', $main_name, $alt->{path};
     call_ua(\@params, %opts);
 }
 
 sub config_choice {
     my ($id, %opts) = @_;
-    my ($input,	$output) = ("", "");
+    my ($input, $output) = ('', '');
     if ($id >= 0) {
 	my $alt = $choices[$id];
 	$input = $alt->{path};
     } else {
-	$input = "0";
+	$input = '0';
     }
     $input .= "\n";
     $opts{from_string} = \$input;
     $opts{to_string} = \$output;
     my @params;
     push @params, @{$opts{params}} if exists $opts{params};
-    push @params, "--config", $main_name;
+    push @params, '--config', $main_name;
     call_ua(\@params, %opts);
 }
 
@@ -204,7 +204,7 @@ sub check_no_link {
     my ($link, $msg) = @_;
     lstat($link);
     ok(!-e _, "$msg: $link still exists.");
-    ok(1, "fake test"); # Same number of tests as check_link
+    ok(1, 'fake test'); # Same number of tests as check_link
 }
 
 sub check_slaves {
@@ -225,7 +225,7 @@ sub check_choice {
     my $output;
     if (defined $id) {
 	# Check status
-	call_ua([ "--query", "$main_name" ], to_string => \$output, test_id => $msg);
+	call_ua([ '--query', "$main_name" ], to_string => \$output, test_id => $msg);
 	$output =~ /^Status: (.*)$/im;
 	is($1, $mode, "$msg: status is not $mode.");
 	# Check links
@@ -234,7 +234,7 @@ sub check_choice {
 	check_link($main_link, "$altdir/$main_name", $msg);
 	check_slaves($id, $msg);
     } else {
-	call_ua([ "--query", "$main_name" ], error_to_string => \$output,
+	call_ua([ '--query', "$main_name" ], error_to_string => \$output,
 	        expect_failure => 1, test_id => $msg);
 	ok($output =~ /no alternatives/, "$msg: bad error message for --query.");
 	# Check that all links have disappeared
@@ -250,16 +250,16 @@ cleanup();
 remove_choice(0);
 # successive install in auto mode
 install_choice(1);
-check_choice(1, "auto", "initial install 1");
+check_choice(1, 'auto', 'initial install 1');
 install_choice(2); # 2 is lower prio, stays at 1
-check_choice(1, "auto", "initial install 2");
+check_choice(1, 'auto', 'initial install 2');
 install_choice(0); # 0 is higher priority
-check_choice(0, "auto", "initial install 3");
+check_choice(0, 'auto', 'initial install 3');
 
 # verify that the administrative file is sorted properly
 {
     local $/ = undef;
-    open(my $db_fh, "<", "$admindir/generic-test") or die $!;
+    open(my $db_fh, '<', "$admindir/generic-test") or die $!;
     my $content = <$db_fh>;
     close($db_fh);
 
@@ -290,69 +290,69 @@ $bindir/slave4
         $expected .= $alt->{path} . "\n";
         $expected .= $alt->{priority} . "\n";
         foreach my $slave_name (sort keys %slaves) {
-            $expected .= $slaves{$slave_name}{$alt->{path}}{path} || "";
+            $expected .= $slaves{$slave_name}{$alt->{path}}{path} || '';
             $expected .= "\n";
         }
     }
     $expected .= "\n";
 
-    is($content, $expected, "administrative file is as expected");
+    is($content, $expected, 'administrative file is as expected');
 }
 
 # manual change with --set-selections
 my $input = "doesntexist auto $paths{date}\ngeneric-test manual $paths{false}\n";
-my $output = "";
-call_ua(["--set-selections"], from_string => \$input,
-        to_string => \$output, test_id => "manual update with --set-selections");
-check_choice(1, "manual", "manual update with --set-selections");
+my $output = '';
+call_ua(['--set-selections'], from_string => \$input,
+        to_string => \$output, test_id => 'manual update with --set-selections');
+check_choice(1, 'manual', 'manual update with --set-selections');
 $input = "generic-test auto $paths{true}\n";
-call_ua(["--set-selections"], from_string => \$input,
-        to_string => \$output, test_id => "auto update with --set-selections");
-check_choice(0, "auto", "auto update with --set-selections");
+call_ua(['--set-selections'], from_string => \$input,
+        to_string => \$output, test_id => 'auto update with --set-selections');
+check_choice(0, 'auto', 'auto update with --set-selections');
 # manual change with set
-set_choice(2, test_id => "manual update with --set");
-check_choice(2, "manual", "manual update with --set"); # test #388313
-remove_choice(2, test_id => "remove manual, back to auto");
-check_choice(0, "auto", "remove manual, back to auto");
-remove_choice(0, test_id => "remove best");
-check_choice(1, "auto", "remove best");
-remove_choice(1, test_id => "no alternative left");
-check_choice(undef, "", "no alternative left");
+set_choice(2, test_id => 'manual update with --set');
+check_choice(2, 'manual', 'manual update with --set'); # test #388313
+remove_choice(2, test_id => 'remove manual, back to auto');
+check_choice(0, 'auto', 'remove manual, back to auto');
+remove_choice(0, test_id => 'remove best');
+check_choice(1, 'auto', 'remove best');
+remove_choice(1, test_id => 'no alternative left');
+check_choice(undef, '', 'no alternative left');
 # single choice in manual mode, to be removed
 install_choice(1);
 set_choice(1);
-check_choice(1, "manual", "single manual choice");
+check_choice(1, 'manual', 'single manual choice');
 remove_choice(1);
-check_choice(undef, "", "removal single manual");
+check_choice(undef, '', 'removal single manual');
 # test --remove-all
 install_choice(0);
 install_choice(1);
 install_choice(2);
-remove_all_choices(test_id => "remove all");
-check_choice(undef, "", "no alternative left");
+remove_all_choices(test_id => 'remove all');
+check_choice(undef, '', 'no alternative left');
 # check auto-recovery of user mistakes (#100135)
 install_choice(1);
-ok(unlink("$bindir/generic-test"), "failed removal");
-ok(unlink("$bindir/slave1"), "failed removal");
+ok(unlink("$bindir/generic-test"), 'failed removal');
+ok(unlink("$bindir/slave1"), 'failed removal');
 install_choice(1);
-check_choice(1, "auto", "recreate links in auto mode");
+check_choice(1, 'auto', 'recreate links in auto mode');
 set_choice(1);
-ok(unlink("$bindir/generic-test"), "failed removal");
-ok(unlink("$bindir/slave1"), "failed removal");
+ok(unlink("$bindir/generic-test"), 'failed removal');
+ok(unlink("$bindir/slave1"), 'failed removal');
 install_choice(1);
-check_choice(1, "manual", "recreate links in manual mode");
+check_choice(1, 'manual', 'recreate links in manual mode');
 # check recovery of /etc/alternatives/*
 install_choice(0);
-ok(unlink("$altdir/generic-test"), "failed removal");
+ok(unlink("$altdir/generic-test"), 'failed removal');
 install_choice(1);
-check_choice(0, "auto", "<altdir>/generic-test lost, back to auto");
+check_choice(0, 'auto', '<altdir>/generic-test lost, back to auto');
 # test --config
 config_choice(0);
-check_choice(0, "manual", "config to best but manual");
+check_choice(0, 'manual', 'config to best but manual');
 config_choice(1);
-check_choice(1, "manual", "config to manual");
+check_choice(1, 'manual', 'config to manual');
 config_choice(-1);
-check_choice(0, "auto", "config auto");
+check_choice(0, 'auto', 'config auto');
 
 # test rename of links
 install_choice(0);
@@ -361,30 +361,30 @@ my $old_link = $main_link;
 $choices[0]{slaves}[0]{link} = "$bindir/more/generic-slave";
 $main_link = "$bindir/more/mytest";
 install_choice(0);
-check_choice(0, "auto", "test rename of links");
-check_no_link($old_link, "test rename of links");
-check_no_link($old_slave, "test rename of links");
+check_choice(0, 'auto', 'test rename of links');
+check_no_link($old_link, 'test rename of links');
+check_no_link($old_slave, 'test rename of links');
 # rename with installing other alternatives
 $old_link = $main_link;
 $main_link = "$bindir/generic-test";
 install_choice(1);
-check_choice(0, "auto", "rename link");
-check_no_link($old_link, "rename link");
+check_choice(0, 'auto', 'rename link');
+check_no_link($old_link, 'rename link');
 # rename with lost file
 unlink($old_slave);
 $old_slave = $choices[0]{slaves}[0]{link};
 $choices[0]{slaves}[0]{link} = "$bindir/generic-slave-bis";
 install_choice(0);
-check_choice(0, "auto", "rename lost file");
-check_no_link($old_slave, "rename lost file");
+check_choice(0, 'auto', 'rename lost file');
+check_no_link($old_slave, 'rename lost file');
 # update of alternative with many slaves not currently installed
 # and the link of the renamed slave exists while it should not
 set_choice(1);
 symlink("$paths{cat}", "$bindir/generic-slave-bis");
 $choices[0]{slaves}[0]{link} = "$bindir/slave2";
-install_choice(0, test_id => "update with non-installed slaves");
+install_choice(0, test_id => 'update with non-installed slaves');
 check_no_link("$bindir/generic-slave-bis",
-              "drop renamed symlink that should not be installed");
+              'drop renamed symlink that should not be installed');
 
 # test install with empty admin file (#457863)
 cleanup();
@@ -393,56 +393,56 @@ install_choice(0);
 # test install with garbage admin file
 cleanup();
 system("echo garbage > $admindir/generic-test");
-install_choice(0, error_to_file => "/dev/null", expect_failure => 1);
+install_choice(0, error_to_file => '/dev/null', expect_failure => 1);
 
 # test invalid usages
 cleanup();
 install_choice(0);
 # try to install a slave alternative as new master
-call_ua(["--install", "$bindir/testmaster", "slave1", "$paths{date}", "10"],
-        expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', "$bindir/testmaster", 'slave1', "$paths{date}", '10'],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 # try to install a master alternative as slave
-call_ua(["--install", "$bindir/testmaster", "testmaster", "$paths{date}", "10",
-	 "--slave", "$bindir/testslave", "generic-test", "$paths{true}" ],
-	expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', "$bindir/testmaster", 'testmaster', "$paths{date}", '10',
+         '--slave', "$bindir/testslave", 'generic-test', "$paths{true}" ],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 # try to reuse master link in slave
-call_ua(["--install", "$bindir/testmaster", "testmaster", "$paths{date}", "10",
-	 "--slave", "$bindir/testmaster", "testslave", "$paths{true}" ],
-	expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', "$bindir/testmaster", 'testmaster', "$paths{date}", '10',
+         '--slave', "$bindir/testmaster", 'testslave', "$paths{true}" ],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 # try to reuse links in master alternative
-call_ua(["--install", "$bindir/slave1", "testmaster", "$paths{date}", "10"],
-        expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', "$bindir/slave1", 'testmaster', "$paths{date}", '10'],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 # try to reuse links in slave alternative
-call_ua(["--install", "$bindir/testmaster", "testmaster", "$paths{date}", "10",
-	 "--slave", "$bindir/generic-test", "testslave", "$paths{true}" ],
-	expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', "$bindir/testmaster", 'testmaster', "$paths{date}", '10',
+         '--slave', "$bindir/generic-test", 'testslave', "$paths{true}" ],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 # try to reuse slave link in another slave alternative of another choice of
 # the same main alternative
-call_ua(["--install", $main_link, $main_name, "$paths{date}", "10",
-	 "--slave", "$bindir/slave1", "testslave", "$paths{true}" ],
-	expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', $main_link, $main_name, "$paths{date}", '10',
+         '--slave', "$bindir/slave1", 'testslave', "$paths{true}" ],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 # lack of absolute filenames in links or file path, non-existing path,
-call_ua(["--install", "../testmaster", "testmaster", "$paths{date}", "10"],
-        expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
-call_ua(["--install", "$bindir/testmaster", "testmaster", "./update-alternatives.pl", "10"],
-        expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', '../testmaster', 'testmaster', "$paths{date}", '10'],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
+call_ua(['--install', "$bindir/testmaster", 'testmaster', './update-alternatives.pl', '10'],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 # non-existing alternative path
-call_ua(["--install", "$bindir/testmaster", "testmaster", "$bindir/doesntexist", "10"],
-        expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', "$bindir/testmaster", 'testmaster', "$bindir/doesntexist", '10'],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 # invalid alternative name in master
-call_ua(["--install", "$bindir/testmaster", "test/master", "$paths{date}", "10"],
-        expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', "$bindir/testmaster", 'test/master', "$paths{date}", '10'],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 # invalid alternative name in slave
-call_ua(["--install", "$bindir/testmaster", "testmaster", "$paths{date}", "10",
-	 "--slave", "$bindir/testslave", "test slave", "$paths{true}" ],
-	expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', "$bindir/testmaster", 'testmaster', "$paths{date}", '10',
+         '--slave', "$bindir/testslave", 'test slave', "$paths{true}" ],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 # install in non-existing dir should fail
-call_ua(["--install", "$bindir/doesntexist/testmaster", "testmaster", "$paths{date}", "10",
-	 "--slave", "$bindir/testslave", "testslave", "$paths{true}" ],
-	expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
-call_ua(["--install", "$bindir/testmaster", "testmaster", "$paths{date}", "10",
-	 "--slave", "$bindir/doesntexist/testslave", "testslave", "$paths{true}" ],
-	expect_failure => 1, to_file => "/dev/null", error_to_file => "/dev/null");
+call_ua(['--install', "$bindir/doesntexist/testmaster", 'testmaster', "$paths{date}", '10',
+         '--slave', "$bindir/testslave", 'testslave', "$paths{true}" ],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
+call_ua(['--install', "$bindir/testmaster", 'testmaster', "$paths{date}", '10',
+         '--slave', "$bindir/doesntexist/testslave", 'testslave', "$paths{true}" ],
+        expect_failure => 1, to_file => '/dev/null', error_to_file => '/dev/null');
 
 # non-existing alternative path in slave is not a failure
 my $old_path = $choices[0]{slaves}[0]{path};
@@ -452,51 +452,51 @@ $choices[0]{slaves}[0]{link} = "$bindir/baddir/slave2";
 # test rename of slave link that existed but that doesn't anymore
 # and link is moved into non-existing dir at the same time
 install_choice(0);
-check_choice(0, "auto", "optional renamed slave2 in non-existing dir");
+check_choice(0, 'auto', 'optional renamed slave2 in non-existing dir');
 # same but on fresh install
 cleanup();
 install_choice(0);
-check_choice(0, "auto", "optional slave2 in non-existing dir");
+check_choice(0, 'auto', 'optional slave2 in non-existing dir');
 $choices[0]{slaves}[0]{link} = $old_slave;
 # test fresh install with a non-existing slave file
 cleanup();
 install_choice(0);
-check_choice(0, "auto", "optional slave2");
+check_choice(0, 'auto', 'optional slave2');
 $choices[0]{slaves}[0]{path} = $old_path;
 
 # test management of pre-existing files
 cleanup();
 system("touch $main_link $bindir/slave1");
 install_choice(0);
-ok(!-l $main_link, "install preserves files that should be links");
-ok(!-l "$bindir/slave1", "install preserves files that should be slave links");
+ok(!-l $main_link, 'install preserves files that should be links');
+ok(!-l "$bindir/slave1", 'install preserves files that should be slave links');
 remove_choice(0);
-ok(-f $main_link, "removal keeps real file installed as master link");
-ok(-f "$bindir/slave1", "removal keeps real files installed as slave links");
-install_choice(0, params => ["--force"]);
-check_choice(0, "auto", "install --force replaces files with links");
+ok(-f $main_link, 'removal keeps real file installed as master link');
+ok(-f "$bindir/slave1", 'removal keeps real files installed as slave links');
+install_choice(0, params => ['--force']);
+check_choice(0, 'auto', 'install --force replaces files with links');
 
 # test management of pre-existing files #2
 cleanup();
 system("touch $main_link $bindir/slave2");
 install_choice(0);
 install_choice(1);
-ok(!-l $main_link, "inactive install preserves files that should be links");
-ok(!-l "$bindir/slave2", "inactive install preserves files that should be slave links");
-ok(-f $main_link, "inactive install keeps real file installed as master link");
-ok(-f "$bindir/slave2", "inactive install keeps real files installed as slave links");
+ok(!-l $main_link, 'inactive install preserves files that should be links');
+ok(!-l "$bindir/slave2", 'inactive install preserves files that should be slave links');
+ok(-f $main_link, 'inactive install keeps real file installed as master link');
+ok(-f "$bindir/slave2", 'inactive install keeps real files installed as slave links');
 set_choice(1);
-ok(!-l $main_link, "manual switching preserves files that should be links");
-ok(!-l "$bindir/slave2", "manual switching preserves files that should be slave links");
-ok(-f $main_link, "manual switching keeps real file installed as master link");
-ok(-f "$bindir/slave2", "manual switching keeps real files installed as slave links");
+ok(!-l $main_link, 'manual switching preserves files that should be links');
+ok(!-l "$bindir/slave2", 'manual switching preserves files that should be slave links');
+ok(-f $main_link, 'manual switching keeps real file installed as master link');
+ok(-f "$bindir/slave2", 'manual switching keeps real files installed as slave links');
 remove_choice(1);
-ok(!-l $main_link, "auto switching preserves files that should be links");
-ok(!-l "$bindir/slave2", "auto switching preserves files that should be slave links");
-ok(-f $main_link, "auto switching keeps real file installed as master link");
-ok(-f "$bindir/slave2", "auto switching keeps real files installed as slave links");
-remove_all_choices(params => ["--force"]);
-ok(!-e "$bindir/slave2", "forced removeall drops real files installed as slave links");
+ok(!-l $main_link, 'auto switching preserves files that should be links');
+ok(!-l "$bindir/slave2", 'auto switching preserves files that should be slave links');
+ok(-f $main_link, 'auto switching keeps real file installed as master link');
+ok(-f "$bindir/slave2", 'auto switching keeps real files installed as slave links');
+remove_all_choices(params => ['--force']);
+ok(!-e "$bindir/slave2", 'forced removeall drops real files installed as slave links');
 
 # test management of pre-existing files #3
 cleanup();
@@ -504,15 +504,15 @@ system("touch $main_link $bindir/slave2");
 install_choice(0);
 install_choice(1);
 remove_choice(0);
-ok(!-l $main_link, "removal + switching preserves files that should be links");
-ok(!-l "$bindir/slave2", "removal + switching preserves files that should be slave links");
-ok(-f $main_link, "removal + switching keeps real file installed as master link");
-ok(-f "$bindir/slave2", "removal + switching keeps real files installed as slave links");
+ok(!-l $main_link, 'removal + switching preserves files that should be links');
+ok(!-l "$bindir/slave2", 'removal + switching preserves files that should be slave links');
+ok(-f $main_link, 'removal + switching keeps real file installed as master link');
+ok(-f "$bindir/slave2", 'removal + switching keeps real files installed as slave links');
 install_choice(0);
-ok(!-l $main_link, "install + switching preserves files that should be links");
-ok(!-l "$bindir/slave2", "install + switching preserves files that should be slave links");
-ok(-f $main_link, "install + switching keeps real file installed as master link");
-ok(-f "$bindir/slave2", "install + switching keeps real files installed as slave links");
-set_choice(1, params => ["--force"]);
-ok(!-e "$bindir/slave2", "forced switching w/o slave drops real files installed as slave links");
-check_choice(1, "manual", "set --force replaces files with links");
+ok(!-l $main_link, 'install + switching preserves files that should be links');
+ok(!-l "$bindir/slave2", 'install + switching preserves files that should be slave links');
+ok(-f $main_link, 'install + switching keeps real file installed as master link');
+ok(-f "$bindir/slave2", 'install + switching keeps real files installed as slave links');
+set_choice(1, params => ['--force']);
+ok(!-e "$bindir/slave2", 'forced switching w/o slave drops real files installed as slave links');
+check_choice(1, 'manual', 'set --force replaces files with links');