diff options
| author | Guillem Jover <guillem@debian.org> | 2012-12-31 21:43:39 +0100 |
|---|---|---|
| committer | Guillem Jover <guillem@debian.org> | 2013-05-04 19:03:13 +0200 |
| commit | 6a73e3078b01a71d4a6ea90c85da16523ed56f1d (patch) | |
| tree | 4cc7a210e7e851395f7ba4989e3aac4aa9d32710 | |
| parent | 62bc788a45e4a641c28ca9c8c5b9bb08f29faed8 (diff) | |
| download | dpkg-6a73e3078b01a71d4a6ea90c85da16523ed56f1d.tar.gz | |
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
95 files changed, 1970 insertions, 1960 deletions
diff --git a/dselect/methods/Dselect/Ftp.pm b/dselect/methods/Dselect/Ftp.pm index 5c995d512..dc0cc3a53 100644 --- a/dselect/methods/Dselect/Ftp.pm +++ b/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'; } } diff --git a/dselect/methods/ftp/install b/dselect/methods/ftp/install index 615fa8f75..de365e334 100755 --- a/dselect/methods/ftp/install +++ b/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"); } diff --git a/dselect/methods/ftp/setup b/dselect/methods/ftp/setup index a5cc9af62..26da50d36 100755 --- a/dselect/methods/ftp/setup +++ b/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"; diff --git a/dselect/methods/ftp/update b/dselect/methods/ftp/update index 92b82782c..bb3050c0b 100755 --- a/dselect/methods/ftp/update +++ b/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; } diff --git a/dselect/mkcurkeys.pl b/dselect/mkcurkeys.pl index d4d4093d5..d2f5783be 100755 --- a/dselect/mkcurkeys.pl +++ b/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(); } diff --git a/scripts/Dpkg.pm b/scripts/Dpkg.pm index 0d92916fd..ba41ede34 100644 --- a/scripts/Dpkg.pm +++ b/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; diff --git a/scripts/Dpkg/Arch.pm b/scripts/Dpkg/Arch.pm index 2c1471f9c..231b9bb3f 100644 --- a/scripts/Dpkg/Arch.pm +++ b/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($) diff --git a/scripts/Dpkg/BuildEnv.pm b/scripts/Dpkg/BuildEnv.pm index a69d35233..16deec011 100644 --- a/scripts/Dpkg/BuildEnv.pm +++ b/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 = (); diff --git a/scripts/Dpkg/BuildFlags.pm b/scripts/Dpkg/BuildFlags.pm index d61cba0d3..689926e71 100644 --- a/scripts/Dpkg/BuildFlags.pm +++ b/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); diff --git a/scripts/Dpkg/BuildOptions.pm b/scripts/Dpkg/BuildOptions.pm index 15a6cd649..270525240 100644 --- a/scripts/Dpkg/BuildOptions.pm +++ b/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; } diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm index 627b824ec..a0911f418 100644 --- a/scripts/Dpkg/Changelog.pm +++ b/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); } diff --git a/scripts/Dpkg/Changelog/Debian.pm b/scripts/Dpkg/Changelog/Debian.pm index fdc4180a6..bad97a671 100644 --- a/scripts/Dpkg/Changelog/Debian.pm +++ b/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) { diff --git a/scripts/Dpkg/Changelog/Entry.pm b/scripts/Dpkg/Changelog/Entry.pm index 1f6907f65..f41444de7 100644 --- a/scripts/Dpkg/Changelog/Entry.pm +++ b/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 diff --git a/scripts/Dpkg/Changelog/Entry/Debian.pm b/scripts/Dpkg/Changelog/Entry/Debian.pm index 48e21ce9d..89da916f4 100644 --- a/scripts/Dpkg/Changelog/Entry/Debian.pm +++ b/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; } diff --git a/scripts/Dpkg/Changelog/Parse.pm b/scripts/Dpkg/Changelog/Parse.pm index f01cce14f..538301273 100644 --- a/scripts/Dpkg/Changelog/Parse.pm +++ b/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 { diff --git a/scripts/Dpkg/Checksums.pm b/scripts/Dpkg/Checksums.pm index cef5e0a20..82a196a10 100644 --- a/scripts/Dpkg/Checksums.pm +++ b/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); } } diff --git a/scripts/Dpkg/Compression.pm b/scripts/Dpkg/Compression.pm index 1f2af3ea7..43bf5cf88 100644 --- a/scripts/Dpkg/Compression.pm +++ b/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; } diff --git a/scripts/Dpkg/Compression/FileHandle.pm b/scripts/Dpkg/Compression/FileHandle.pm index fdf20cad3..9ef57167a 100644 --- a/scripts/Dpkg/Compression/FileHandle.pm +++ b/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))) { diff --git a/scripts/Dpkg/Compression/Process.pm b/scripts/Dpkg/Compression/Process.pm index 38773d28c..a7dd97690 100644 --- a/scripts/Dpkg/Compression/Process.pm +++ b/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; } diff --git a/scripts/Dpkg/Conf.pm b/scripts/Dpkg/Conf.pm index 98475db62..8e11d49ca 100644 --- a/scripts/Dpkg/Conf.pm +++ b/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 = "/) { diff --git a/scripts/Dpkg/Control.pm b/scripts/Dpkg/Control.pm index 5efa17cb6..31149116a 100644 --- a/scripts/Dpkg/Control.pm +++ b/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"); } diff --git a/scripts/Dpkg/Control/Changelog.pm b/scripts/Dpkg/Control/Changelog.pm index affa096ec..420ffc943 100644 --- a/scripts/Dpkg/Control/Changelog.pm +++ b/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'; diff --git a/scripts/Dpkg/Control/Fields.pm b/scripts/Dpkg/Control/Fields.pm index 0adc75733..2494eaee3 100644 --- a/scripts/Dpkg/Control/Fields.pm +++ b/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; } diff --git a/scripts/Dpkg/Control/Hash.pm b/scripts/Dpkg/Control/Hash.pm index eee6dc350..038ac539a 100644 --- a/scripts/Dpkg/Control/Hash.pm +++ b/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; } diff --git a/scripts/Dpkg/Control/Info.pm b/scripts/Dpkg/Control/Info.pm index 8e28446b0..41fbb3352 100644 --- a/scripts/Dpkg/Control/Info.pm +++ b/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'); } } diff --git a/scripts/Dpkg/Deps.pm b/scripts/Dpkg/Deps.pm index b5ba17131..fe26a6d59 100644 --- a/scripts/Dpkg/Deps.pm +++ b/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; } diff --git a/scripts/Dpkg/ErrorHandling.pm b/scripts/Dpkg/ErrorHandling.pm index bdb3fe3dc..0584add61 100644 --- a/scripts/Dpkg/ErrorHandling.pm +++ b/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; diff --git a/scripts/Dpkg/Exit.pm b/scripts/Dpkg/Exit.pm index d69d37f28..333bda38d 100644 --- a/scripts/Dpkg/Exit.pm +++ b/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 { diff --git a/scripts/Dpkg/File.pm b/scripts/Dpkg/File.pm index 46717a44e..f56c1e2cf 100644 --- a/scripts/Dpkg/File.pm +++ b/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); } } } diff --git a/scripts/Dpkg/Gettext.pm b/scripts/Dpkg/Gettext.pm index 25868697d..e4724d0e0 100644 --- a/scripts/Dpkg/Gettext.pm +++ b/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'; diff --git a/scripts/Dpkg/IPC.pm b/scripts/Dpkg/IPC.pm index 41182bc60..ba2aca5f6 100644 --- a/scripts/Dpkg/IPC.pm +++ b/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 ($@) { diff --git a/scripts/Dpkg/Index.pm b/scripts/Dpkg/Index.pm index 9d54bb771..60d4b9167 100644 --- a/scripts/Dpkg/Index.pm +++ b/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"; diff --git a/scripts/Dpkg/Interface/Storable.pm b/scripts/Dpkg/Interface/Storable.pm index f0d3b73b4..c92010595 100644 --- a/scripts/Dpkg/Interface/Storable.pm +++ b/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(); } diff --git a/scripts/Dpkg/Package.pm b/scripts/Dpkg/Package.pm index f3ed4698c..719e3941e 100644 --- a/scripts/Dpkg/Package.pm +++ b/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; } diff --git a/scripts/Dpkg/Path.pm b/scripts/Dpkg/Path.pm index 3c75ef6f2..f3e072cbb 100644 --- a/scripts/Dpkg/Path.pm +++ b/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); } diff --git a/scripts/Dpkg/Shlibs.pm b/scripts/Dpkg/Shlibs.pm index 1eae995d4..aa804c282 100644 --- a/scripts/Dpkg/Shlibs.pm +++ b/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) { diff --git a/scripts/Dpkg/Shlibs/Cppfilt.pm b/scripts/Dpkg/Shlibs/Cppfilt.pm index 235fae76c..c6df2bbc3 100644 --- a/scripts/Dpkg/Shlibs/Cppfilt.pm +++ b/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{$_}; diff --git a/scripts/Dpkg/Shlibs/Objdump.pm b/scripts/Dpkg/Shlibs/Objdump.pm index 80f13c939..563bea3b7 100644 --- a/scripts/Dpkg/Shlibs/Objdump.pm +++ b/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*' diff --git a/scripts/Dpkg/Shlibs/Symbol.pm b/scripts/Dpkg/Shlibs/Symbol.pm index 8e5bfcf28..ae53e43ce 100644 --- a/scripts/Dpkg/Shlibs/Symbol.pm +++ b/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}); diff --git a/scripts/Dpkg/Shlibs/SymbolFile.pm b/scripts/Dpkg/Shlibs/SymbolFile.pm index b6bacf9c6..6328f4b0f 100644 --- a/scripts/Dpkg/Shlibs/SymbolFile.pm +++ b/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)) diff --git a/scripts/Dpkg/Source/Archive.pm b/scripts/Dpkg/Source/Archive.pm index 7146d8a97..7046c3b3d 100644 --- a/scripts/Dpkg/Source/Archive.pm +++ b/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); } diff --git a/scripts/Dpkg/Source/Functions.pm b/scripts/Dpkg/Source/Functions.pm index 10a9d7af0..d830b0b5f 100644 --- a/scripts/Dpkg/Source/Functions.pm +++ b/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; } diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm index 63f28cfa8..3b543afe2 100644 --- a/scripts/Dpkg/Source/Package.pm +++ b/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); diff --git a/scripts/Dpkg/Source/Package/V1.pm b/scripts/Dpkg/Source/Package/V1.pm index 314ae0f16..a8829e9a0 100644 --- a/scripts/Dpkg/Source/Package/V1.pm +++ b/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); } diff --git a/scripts/Dpkg/Source/Package/V2.pm b/scripts/Dpkg/Source/Package/V2.pm index 4da8bdae2..be1d363a7 100644 --- a/scripts/Dpkg/Source/Package/V2.pm +++ b/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); diff --git a/scripts/Dpkg/Source/Package/V3/bzr.pm b/scripts/Dpkg/Source/Package/V3/bzr.pm index 28c9935a8..9bc69f23e 100644 --- a/scripts/Dpkg/Source/Package/V3/bzr.pm +++ b/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); diff --git a/scripts/Dpkg/Source/Package/V3/custom.pm b/scripts/Dpkg/Source/Package/V3/custom.pm index 9ba8d5874..475a7cf46 100644 --- a/scripts/Dpkg/Source/Package/V3/custom.pm +++ b/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}}) { diff --git a/scripts/Dpkg/Source/Package/V3/git.pm b/scripts/Dpkg/Source/Package/V3/git.pm index 863576f86..5bb83ed3c 100644 --- a/scripts/Dpkg/Source/Package/V3/git.pm +++ b/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); diff --git a/scripts/Dpkg/Source/Package/V3/native.pm b/scripts/Dpkg/Source/Package/V3/native.pm index 726bc3905..de706f39a 100644 --- a/scripts/Dpkg/Source/Package/V3/native.pm +++ b/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); diff --git a/scripts/Dpkg/Source/Package/V3/quilt.pm b/scripts/Dpkg/Source/Package/V3/quilt.pm index 7ebee244f..bca916b6b 100644 --- a/scripts/Dpkg/Source/Package/V3/quilt.pm +++ b/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) { diff --git a/scripts/Dpkg/Source/Patch.pm b/scripts/Dpkg/Source/Patch.pm index 97bdc788b..051eb9eaa 100644 --- a/scripts/Dpkg/Source/Patch.pm +++ b/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'); } } diff --git a/scripts/Dpkg/Source/Quilt.pm b/scripts/Dpkg/Source/Quilt.pm index 9c7c949ea..fb42cb5cf 100644 --- a/scripts/Dpkg/Source/Quilt.pm +++ b/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); } diff --git a/scripts/Dpkg/Substvars.pm b/scripts/Dpkg/Substvars.pm index ee775569d..43eb1ad1c 100644 --- a/scripts/Dpkg/Substvars.pm +++ b/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:.+)$/; diff --git a/scripts/Dpkg/Vars.pm b/scripts/Dpkg/Vars.pm index d0ccb29f2..944e61511 100644 --- a/scripts/Dpkg/Vars.pm +++ b/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; diff --git a/scripts/Dpkg/Vendor.pm b/scripts/Dpkg/Vendor.pm index e3ec1679c..1f654a16f 100644 --- a/scripts/Dpkg/Vendor.pm +++ b/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(); diff --git a/scripts/Dpkg/Vendor/Debian.pm b/scripts/Dpkg/Vendor/Debian.pm index 3e4b8cb2c..6f5b67823 100644 --- a/scripts/Dpkg/Vendor/Debian.pm +++ b/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); } } diff --git a/scripts/Dpkg/Vendor/Default.pm b/scripts/Dpkg/Vendor/Default.pm index 4bc44c211..2b91b239a 100644 --- a/scripts/Dpkg/Vendor/Default.pm +++ b/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; } diff --git a/scripts/Dpkg/Vendor/Ubuntu.pm b/scripts/Dpkg/Vendor/Ubuntu.pm index 309078033..039fd5a68 100644 --- a/scripts/Dpkg/Vendor/Ubuntu.pm +++ b/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'); } diff --git a/scripts/Dpkg/Version.pm b/scripts/Dpkg/Version.pm index 420c12fd1..e588e0406 100644 --- a/scripts/Dpkg/Version.pm +++ b/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; } diff --git a/scripts/Makefile.am b/scripts/Makefile.am index 1008e9b85..e81f309eb 100644 --- a/scripts/Makefile.am +++ b/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)\":" diff --git a/scripts/changelog/debian.pl b/scripts/changelog/debian.pl index 0fb2fff62..cf6e9bf24 100755 --- a/scripts/changelog/debian.pl +++ b/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', $@); } diff --git a/scripts/dpkg-architecture.pl b/scripts/dpkg-architecture.pl index 66a4e5624..769aaffd0 100755 --- a/scripts/dpkg-architecture.pl +++ b/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') { diff --git a/scripts/dpkg-buildflags.pl b/scripts/dpkg-buildflags.pl index 77acc6fee..b43bc9e78 100755 --- a/scripts/dpkg-buildflags.pl +++ b/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); } diff --git a/scripts/dpkg-buildpackage.pl b/scripts/dpkg-buildpackage.pl index ba1d4a543..2c76aaf7f 100755 --- a/scripts/dpkg-buildpackage.pl +++ b/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"; diff --git a/scripts/dpkg-checkbuilddeps.pl b/scripts/dpkg-checkbuilddeps.pl index d90710df0..dd2fad94e 100755 --- a/scripts/dpkg-checkbuilddeps.pl +++ b/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) { diff --git a/scripts/dpkg-distaddfile.pl b/scripts/dpkg-distaddfile.pl index 1229b22fa..272f75435 100755 --- a/scripts/dpkg-distaddfile.pl +++ b/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'); diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl index b91d80197..808bc756c 100755 --- a/scripts/dpkg-genchanges.pl +++ b/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) { diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl index f032b6138..16afebb44 100755 --- a/scripts/dpkg-gencontrol.pl +++ b/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); } diff --git a/scripts/dpkg-gensymbols.pl b/scripts/dpkg-gensymbols.pl index e553623f9..1c3cfb44c 100755 --- a/scripts/dpkg-gensymbols.pl +++ b/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); diff --git a/scripts/dpkg-mergechangelogs.pl b/scripts/dpkg-mergechangelogs.pl index 683314bc7..203e560af 100755 --- a/scripts/dpkg-mergechangelogs.pl +++ b/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, '>>>>>>>'); } diff --git a/scripts/dpkg-name.pl b/scripts/dpkg-name.pl index 85d95ec2a..ed6173096 100755 --- a/scripts/dpkg-name.pl +++ b/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); diff --git a/scripts/dpkg-parsechangelog.pl b/scripts/dpkg-parsechangelog.pl index 774265146..ef94982a0 100755 --- a/scripts/dpkg-parsechangelog.pl +++ b/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); diff --git a/scripts/dpkg-scanpackages.pl b/scripts/dpkg-scanpackages.pl index 3b6b6423a..bce37b9fc 100755 --- a/scripts/dpkg-scanpackages.pl +++ b/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); diff --git a/scripts/dpkg-scansources.pl b/scripts/dpkg-scansources.pl index 056b53267..a0432d65c 100755 --- a/scripts/dpkg-scansources.pl +++ b/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-^\./+--; diff --git a/scripts/dpkg-shlibdeps.pl b/scripts/dpkg-shlibdeps.pl index 06df8c2cb..625c59991 100755 --- a/scripts/dpkg-shlibdeps.pl +++ b/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 { diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl index 8d395ba88..ac08e6a2f 100755 --- a/scripts/dpkg-source.pl +++ b/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(); } diff --git a/scripts/dpkg-vendor.pl b/scripts/dpkg-vendor.pl index 1e95c4859..469a2208f 100755 --- a/scripts/dpkg-vendor.pl +++ b/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') { diff --git a/scripts/t/100_Dpkg_Version.t b/scripts/t/100_Dpkg_Version.t index 52d0befbc..db7b2dda0 100644 --- a/scripts/t/100_Dpkg_Version.t +++ b/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); diff --git a/scripts/t/150_Dpkg_Package.t b/scripts/t/150_Dpkg_Package.t index 04962a422..5ea298842 100644 --- a/scripts/t/150_Dpkg_Package.t +++ b/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; diff --git a/scripts/t/190_Dpkg_Shlibs_Cppfilt.t b/scripts/t/190_Dpkg_Shlibs_Cppfilt.t index a4a52463c..acacf153a 100644 --- a/scripts/t/190_Dpkg_Shlibs_Cppfilt.t +++ b/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) . ')'); } } diff --git a/scripts/t/200_Dpkg_Shlibs.t b/scripts/t/200_Dpkg_Shlibs.t index b8a64284b..545905278 100644 --- a/scripts/t/200_Dpkg_Shlibs.t +++ b/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'); } diff --git a/scripts/t/300_Dpkg_BuildOptions.t b/scripts/t/300_Dpkg_BuildOptions.t index 5892f1807..cd1d7d7d2 100644 --- a/scripts/t/300_Dpkg_BuildOptions.t +++ b/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'); diff --git a/scripts/t/400_Dpkg_Deps.t b/scripts/t/400_Dpkg_Deps.t index 24a37f3f5..93a53cedd 100644 --- a/scripts/t/400_Dpkg_Deps.t +++ b/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__}; diff --git a/scripts/t/500_Dpkg_Path.t b/scripts/t/500_Dpkg_Path.t index dd79ea2f7..930c8cdc6 100644 --- a/scripts/t/500_Dpkg_Path.t +++ b/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'); diff --git a/scripts/t/600_Dpkg_Changelog.t b/scripts/t/600_Dpkg_Changelog.t index 012d4b95d..fa3d17fb6 100644 --- a/scripts/t/600_Dpkg_Changelog.t +++ b/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}; diff --git a/scripts/t/700_Dpkg_Control.t b/scripts/t/700_Dpkg_Control.t index 3d98fab78..712a759f1 100644 --- a/scripts/t/700_Dpkg_Control.t +++ b/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'); diff --git a/scripts/t/750_Dpkg_Substvars.t b/scripts/t/750_Dpkg_Substvars.t index 0f792f45d..ddfae716f 100644 --- a/scripts/t/750_Dpkg_Substvars.t +++ b/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 = ''; diff --git a/scripts/t/800_Dpkg_IPC.t b/scripts/t/800_Dpkg_IPC.t index 8c14f6d57..4af1d7b72 100644 --- a/scripts/t/800_Dpkg_IPC.t +++ b/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); diff --git a/scripts/t/850_Dpkg_Compression.t b/scripts/t/850_Dpkg_Compression.t index a4f99f0eb..4bac076f6 100644 --- a/scripts/t/850_Dpkg_Compression.t +++ b/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); diff --git a/scripts/t/910_merge_changelogs.t b/scripts/t/910_merge_changelogs.t index cbe7c2761..662405db2 100644 --- a/scripts/t/910_merge_changelogs.t +++ b/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")); diff --git a/src/t/100_dpkg_divert.t b/src/t/100_dpkg_divert.t index b4c6b43d6..5b976a78b 100644 --- a/src/t/100_dpkg_divert.t +++ b/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/); diff --git a/test/000_pod.t b/test/000_pod.t index 2af85713f..0282a7d0e 100644 --- a/test/000_pod.t +++ b/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 ) ); diff --git a/test/100_critic.t b/test/100_critic.t index cae188f0b..9b3e9e1bd 100644 --- a/test/100_critic.t +++ b/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 diff --git a/test/100_critic/perlcriticrc b/test/100_critic/perlcriticrc index 486bcf030..8fa73d6f9 100644 --- a/test/100_critic/perlcriticrc +++ b/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. diff --git a/utils/t/100_update_alternatives.t b/utils/t/100_update_alternatives.t index afadf8423..1a46e3d65 100644 --- a/utils/t/100_update_alternatives.t +++ b/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'); |