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 /scripts/Dpkg/Source | |
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
Diffstat (limited to 'scripts/Dpkg/Source')
-rw-r--r-- | scripts/Dpkg/Source/Archive.pm | 30 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Functions.pm | 12 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package.pm | 76 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package/V1.pm | 92 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package/V2.pm | 196 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package/V3/bzr.pm | 38 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package/V3/custom.pm | 8 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package/V3/git.pm | 78 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package/V3/native.pm | 14 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Package/V3/quilt.pm | 48 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Patch.pm | 118 | ||||
-rw-r--r-- | scripts/Dpkg/Source/Quilt.pm | 60 |
12 files changed, 385 insertions, 385 deletions
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); } |