diff options
Diffstat (limited to 'scripts/Dpkg')
53 files changed, 890 insertions, 888 deletions
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; } |