diff options
Diffstat (limited to 'scripts')
43 files changed, 781 insertions, 775 deletions
diff --git a/scripts/Dpkg/BuildFlags.pm b/scripts/Dpkg/BuildFlags.pm index f999eb5d6..d61cba0d3 100644 --- a/scripts/Dpkg/BuildFlags.pm +++ b/scripts/Dpkg/BuildFlags.pm @@ -67,11 +67,11 @@ Reset the flags stored to the default set provided by the vendor. sub load_vendor_defaults { my ($self) = @_; - $self->{'options'} = {}; - $self->{'source'} = {}; - $self->{'features'} = {}; + $self->{options} = {}; + $self->{source} = {}; + $self->{features} = {}; my $build_opts = Dpkg::BuildOptions->new(); - $self->{'build_options'} = $build_opts; + $self->{build_options} = $build_opts; my $default_flags = $build_opts->has("noopt") ? "-g -O0" : "-g -O2"; $self->{flags} = { CPPFLAGS => '', @@ -117,8 +117,8 @@ 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'}; + my $confdir = $ENV{XDG_CONFIG_HOME}; + $confdir ||= $ENV{HOME} . "/.config" if defined $ENV{HOME}; if (defined $confdir) { $self->update_from_conffile("$confdir/dpkg/buildflags.conf", "user"); } @@ -224,7 +224,7 @@ feature area has been enabled. The only currently known feature area is sub set_feature { my ($self, $area, $feature, $enabled) = @_; - $self->{'features'}{$area}{$feature} = $enabled; + $self->{features}{$area}{$feature} = $enabled; } =item $bf->strip($flag, $value, $source, $maint) @@ -334,7 +334,7 @@ flag doesn't exist. sub get { my ($self, $key) = @_; - return $self->{'flags'}{$key}; + return $self->{flags}{$key}; } =item $bf->get_feature_areas() @@ -346,7 +346,7 @@ true for). sub get_feature_areas { my ($self) = @_; - return keys %{$self->{'features'}}; + return keys %{$self->{features}}; } =item $bf->get_features($area) @@ -358,7 +358,7 @@ as booleans indicating whether the feature is enabled or not. sub get_features { my ($self, $area) = @_; - return %{$self->{'features'}{$area}}; + return %{$self->{features}{$area}}; } =item $bf->get_origin($flag) @@ -370,7 +370,7 @@ flag doesn't exist. sub get_origin { my ($self, $key) = @_; - return $self->{'origin'}{$key}; + return $self->{origin}{$key}; } =item $bf->is_maintainer_modified($flag) @@ -381,7 +381,7 @@ Return true if the flag is modified by the maintainer. sub is_maintainer_modified { my ($self, $key) = @_; - return $self->{'maintainer'}{$key}; + return $self->{maintainer}{$key}; } =item $bf->has_features($area) @@ -393,7 +393,7 @@ The only currently recognized area is "hardening". sub has_features { my ($self, $area) = @_; - return exists $self->{'features'}{$area}; + return exists $self->{features}{$area}; } =item $bf->has($option) @@ -404,7 +404,7 @@ Returns a boolean indicating whether the flags exists in the object. sub has { my ($self, $key) = @_; - return exists $self->{'flags'}{$key}; + return exists $self->{flags}{$key}; } =item my @flags = $bf->list() @@ -415,7 +415,7 @@ Returns the list of flags stored in the object. sub list { my ($self) = @_; - my @list = sort keys %{$self->{'flags'}}; + my @list = sort keys %{$self->{flags}}; return @list; } diff --git a/scripts/Dpkg/BuildOptions.pm b/scripts/Dpkg/BuildOptions.pm index 48f72af14..15a6cd649 100644 --- a/scripts/Dpkg/BuildOptions.pm +++ b/scripts/Dpkg/BuildOptions.pm @@ -44,7 +44,7 @@ DEB_BUILD_MAINT_OPTIONS. =item my $bo = Dpkg::BuildOptions->new(%opts) Create a new Dpkg::BuildOptions object. It will be initialized based -on the value of the environment variable named $opts{'envvar'} (or +on the value of the environment variable named $opts{envvar} (or DEB_BUILD_OPTIONS if that option is not set). =cut @@ -56,10 +56,10 @@ 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'}); + $self->merge(Dpkg::BuildEnv::get($self->{envvar}), $self->{envvar}); return $self; } @@ -71,8 +71,8 @@ Reset the object to not have any option (it's empty). sub reset { my ($self) = @_; - $self->{'options'} = {}; - $self->{'source'} = {}; + $self->{options} = {}; + $self->{source} = {}; } =item $bo->merge($content, $source) @@ -124,8 +124,8 @@ sub set { return 0 if $value !~ /^\d*$/; } - $self->{'options'}{$key} = $value; - $self->{'source'}{$key} = $source; + $self->{options}{$key} = $value; + $self->{source}{$key} = $source; return 1; } @@ -140,7 +140,7 @@ the option is stored in the object. sub get { my ($self, $key) = @_; - return $self->{'options'}{$key}; + return $self->{options}{$key}; } =item $bo->has($option) @@ -151,7 +151,7 @@ Returns a boolean indicating whether the option is stored in the object. sub has { my ($self, $key) = @_; - return exists $self->{'options'}{$key}; + return exists $self->{options}{$key}; } =item $string = $bo->output($fh) @@ -164,7 +164,7 @@ the given filehandle. sub output { my ($self, $fh) = @_; - my $o = $self->{'options'}; + my $o = $self->{options}; my $res = join(" ", map { defined($o->{$_}) ? $_ . "=" . $o->{$_} : $_ } sort keys %$o); print $fh $res if defined $fh; return $res; @@ -180,7 +180,7 @@ set to the variable is also returned. sub export { my ($self, $var) = @_; - $var = $self->{'envvar'} unless defined $var; + $var = $self->{envvar} unless defined $var; my $content = $self->output(); Dpkg::BuildEnv::set($var, $content); return $content; diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm index 624fc161c..627b824ec 100644 --- a/scripts/Dpkg/Changelog.pm +++ b/scripts/Dpkg/Changelog.pm @@ -86,7 +86,7 @@ whether parse errors are displayed as warnings by default. "reportfile" is a string to use instead of the name of the file parsed, in particular in error messages. "range" defines the range of entries that we want to parse, the parser will stop as soon as it has parsed enough data to -satisfy $c->get_range($opts{'range'}). +satisfy $c->get_range($opts{range}). =cut @@ -191,12 +191,12 @@ entries. Returns undef if there's no such thing. sub set_unparsed_tail { my ($self, $tail) = @_; - $self->{'unparsed_tail'} = $tail; + $self->{unparsed_tail} = $tail; } sub get_unparsed_tail { my ($self) = @_; - return $self->{'unparsed_tail'}; + return $self->{unparsed_tail}; } =item @{$c} @@ -222,23 +222,24 @@ sub __sanity_check_range { delete $r->{offset}; } + ## no critic (ControlStructures::ProhibitUntilBlocks) if ((defined($r->{count}) || defined($r->{offset})) && (defined($r->{from}) || defined($r->{since}) || - defined($r->{to}) || defined($r->{'until'}))) + defined($r->{to}) || defined($r->{until}))) { warning(_g("you can't combine 'count' or 'offset' with any other " . "range option")) if $self->{verbose}; delete $r->{from}; delete $r->{since}; delete $r->{to}; - delete $r->{'until'}; + delete $r->{until}; } if (defined($r->{from}) && defined($r->{since})) { warning(_g("you can only specify one of 'from' and 'since', using " . "'since'")) if $self->{verbose}; delete $r->{from}; } - if (defined($r->{to}) && defined($r->{'until'})) { + if (defined($r->{to}) && defined($r->{until})) { warning(_g("you can only specify one of 'to' and 'until', using " . "'until'")) if $self->{verbose}; delete $r->{to}; @@ -282,20 +283,20 @@ sub __sanity_check_range { delete $r->{from}; # No version was oldest } } - if (defined($r->{'until'}) and not exists $versions{$r->{'until'}}) { + 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")); my $oldest; foreach my $v (@versions) { - if (version_compare_relation($v, REL_GT, $r->{'until'})) { + if (version_compare_relation($v, REL_GT, $r->{until})) { $oldest = $v; } } if (defined($oldest)) { - $r->{'until'} = $oldest; + $r->{until} = $oldest; } else { warning(_g("no such entry found, ignoring '%s' parameter"), "until"); - delete $r->{'until'}; # No version was oldest + delete $r->{until}; # No version was oldest } } if (defined($r->{to}) and not exists $versions{$r->{to}}) { @@ -318,10 +319,11 @@ sub __sanity_check_range { warning(_g("'since' option specifies most recent version, ignoring")); delete $r->{since}; } - if (defined($r->{'until'}) and $data->[-1]->get_version() eq $r->{'until'}) { + if (defined($r->{until}) and $data->[-1]->get_version() eq $r->{until}) { warning(_g("'until' option specifies oldest version, ignoring")); - delete $r->{'until'}; + delete $r->{until}; } + ## use critic } sub get_range { @@ -373,9 +375,10 @@ sub _data_range { return [ @{$data}[$start .. $end] ]; } + ## no critic (ControlStructures::ProhibitUntilBlocks) my @result; my $include = 1; - $include = 0 if defined($range->{to}) or defined($range->{'until'}); + $include = 0 if defined($range->{to}) or defined($range->{until}); foreach (@$data) { my $v = $_->get_version(); $include = 1 if defined($range->{to}) and $v eq $range->{to}; @@ -383,9 +386,10 @@ sub _data_range { push @result, $_ if $include; - $include = 1 if defined($range->{'until'}) and $v eq $range->{'until'}; + $include = 1 if defined($range->{until}) and $v eq $range->{until}; last if defined($range->{from}) and $v eq $range->{from}; } + ## use critic return \@result if scalar(@result); return; diff --git a/scripts/Dpkg/Changelog/Parse.pm b/scripts/Dpkg/Changelog/Parse.pm index 3b76ca987..f01cce14f 100644 --- a/scripts/Dpkg/Changelog/Parse.pm +++ b/scripts/Dpkg/Changelog/Parse.pm @@ -83,17 +83,17 @@ sub changelog_parse { # Extract and remove options that do not concern the changelog parser # itself (and that we shouldn't forward) - if (exists $options{"libdir"}) { - unshift @parserpath, $options{"libdir"}; - delete $options{"libdir"}; + if (exists $options{libdir}) { + unshift @parserpath, $options{libdir}; + delete $options{libdir}; } - if (exists $options{"file"}) { - $changelogfile = $options{"file"}; - delete $options{"file"}; + if (exists $options{file}) { + $changelogfile = $options{file}; + delete $options{file}; } - if (exists $options{"changelogformat"}) { - $format = $options{"changelogformat"}; - delete $options{"changelogformat"}; + if (exists $options{changelogformat}) { + $format = $options{changelogformat}; + delete $options{changelogformat}; $force = 1; } diff --git a/scripts/Dpkg/Checksums.pm b/scripts/Dpkg/Checksums.pm index 07b96da9b..cef5e0a20 100644 --- a/scripts/Dpkg/Checksums.pm +++ b/scripts/Dpkg/Checksums.pm @@ -176,8 +176,8 @@ sub add_from_file { $self->{size}{$key} = $s[7]; foreach my $alg (@alg) { - my @exec = (@{$CHECKSUMS->{$alg}{"program"}}, $file); - my $regex = $CHECKSUMS->{$alg}{"regex"}; + my @exec = (@{$CHECKSUMS->{$alg}{program}}, $file); + my $regex = $CHECKSUMS->{$alg}{regex}; my $output; spawn(exec => \@exec, to_string => \$output); if ($output =~ /^($regex)(\s|$)/m) { @@ -292,9 +292,9 @@ Remove all checksums of the given file. sub remove_file { my ($self, $file) = @_; return unless $self->has_file($file); - delete $self->{'checksums'}{$file}; - delete $self->{'size'}{$file}; - @{$self->{'files'}} = grep { $_ ne $file } $self->get_files(); + delete $self->{checksums}{$file}; + delete $self->{size}{$file}; + @{$self->{files}} = grep { $_ ne $file } $self->get_files(); } =item $checksum = $ck->get_checksum($file, $alg) diff --git a/scripts/Dpkg/Compression.pm b/scripts/Dpkg/Compression.pm index 64087bcea..1f2af3ea7 100644 --- a/scripts/Dpkg/Compression.pm +++ b/scripts/Dpkg/Compression.pm @@ -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 diff --git a/scripts/Dpkg/Compression/FileHandle.pm b/scripts/Dpkg/Compression/FileHandle.pm index 3c8bfd056..fdf20cad3 100644 --- a/scripts/Dpkg/Compression/FileHandle.pm +++ b/scripts/Dpkg/Compression/FileHandle.pm @@ -127,19 +127,19 @@ sub new { tie *$self, $class, $self; bless $self, $class; # Initializations - *$self->{"compression"} = "auto"; - *$self->{"compressor"} = Dpkg::Compression::Process->new(); - *$self->{"add_comp_ext"} = $args{"add_compression_extension"} || - $args{"add_comp_ext"} || 0; - *$self->{"allow_sigpipe"} = 0; - if (exists $args{"filename"}) { - $self->set_filename($args{"filename"}); + *$self->{compression} = "auto"; + *$self->{compressor} = Dpkg::Compression::Process->new(); + *$self->{add_comp_ext} = $args{add_compression_extension} || + $args{add_comp_ext} || 0; + *$self->{allow_sigpipe} = 0; + if (exists $args{filename}) { + $self->set_filename($args{filename}); } - if (exists $args{"compression"}) { - $self->set_compression($args{"compression"}); + if (exists $args{compression}) { + $self->set_compression($args{compression}); } - if (exists $args{"compression_level"}) { - $self->set_compression_level($args{"compression_level"}); + if (exists $args{compression_level}) { + $self->set_compression_level($args{compression_level}); } return $self; } @@ -154,8 +154,8 @@ is already open but not in the requested mode, then it errors out. sub ensure_open { my ($self, $mode) = @_; - if (exists *$self->{"mode"}) { - return if *$self->{"mode"} eq $mode; + if (exists *$self->{mode}) { + return if *$self->{mode} eq $mode; internerr("ensure_open requested incompatible mode: $mode"); } else { if ($mode eq "w") { @@ -179,20 +179,20 @@ sub TIEHANDLE { sub WRITE { my ($self, $scalar, $length, $offset) = @_; $self->ensure_open("w"); - return *$self->{'file'}->write($scalar, $length, $offset); + return *$self->{file}->write($scalar, $length, $offset); } sub READ { my ($self, $scalar, $length, $offset) = @_; $self->ensure_open("r"); - return *$self->{'file'}->read($scalar, $length, $offset); + return *$self->{file}->read($scalar, $length, $offset); } sub READLINE { my ($self) = shift; $self->ensure_open("r"); - return *$self->{"file"}->getlines() if wantarray; - return *$self->{"file"}->getline(); + return *$self->{file}->getlines() if wantarray; + return *$self->{file}->getline(); } sub OPEN { @@ -216,8 +216,8 @@ sub OPEN { sub CLOSE { my ($self) = shift; my $ret = 1; - if (defined *$self->{'file'}) { - $ret = *$self->{'file'}->close(@_) if *$self->{'file'}->opened(); + if (defined *$self->{file}) { + $ret = *$self->{file}->close(@_) if *$self->{file}->opened(); } else { $ret = 0; } @@ -227,7 +227,7 @@ sub CLOSE { sub FILENO { my ($self) = shift; - return *$self->{"file"}->fileno(@_) if defined *$self->{"file"}; + return *$self->{file}->fileno(@_) if defined *$self->{file}; return; } @@ -235,25 +235,25 @@ sub EOF { # Since perl 5.12, an integer parameter is passed describing how the # function got called, just ignore it. my ($self, $param) = (shift, shift); - return *$self->{"file"}->eof(@_) if defined *$self->{"file"}; + return *$self->{file}->eof(@_) if defined *$self->{file}; return 1; } sub SEEK { my ($self) = shift; - return *$self->{"file"}->seek(@_) if defined *$self->{"file"}; + return *$self->{file}->seek(@_) if defined *$self->{file}; return 0; } sub TELL { my ($self) = shift; - return *$self->{"file"}->tell(@_) if defined *$self->{"file"}; + return *$self->{file}->tell(@_) if defined *$self->{file}; return -1; } sub BINMODE { my ($self) = shift; - return *$self->{"file"}->binmode(@_) if defined *$self->{"file"}; + return *$self->{file}->binmode(@_) if defined *$self->{file}; return; } @@ -273,9 +273,9 @@ on the filename extension used. sub set_compression { my ($self, $method) = @_; if ($method ne "none" and $method ne "auto") { - *$self->{"compressor"}->set_compression($method); + *$self->{compressor}->set_compression($method); } - *$self->{"compression"} = $method; + *$self->{compression} = $method; } =item $fh->set_compression_level($level) @@ -287,7 +287,7 @@ by the function C<compression_is_valid_level> of B<Dpkg::Compression>. sub set_compression_level { my ($self, $level) = @_; - *$self->{"compressor"}->set_compression_level($level); + *$self->{compressor}->set_compression_level($level); } =item $fh->set_filename($name, [$add_comp_ext]) @@ -301,12 +301,12 @@ of the compression method must be automatically added to the filename sub set_filename { my ($self, $filename, $add_comp_ext) = @_; - *$self->{"filename"} = $filename; + *$self->{filename} = $filename; # Automatically add compression extension to filename if (defined($add_comp_ext)) { - *$self->{"add_comp_ext"} = $add_comp_ext; + *$self->{add_comp_ext} = $add_comp_ext; } - if (*$self->{"add_comp_ext"} and $filename =~ /\.$compression_re_file_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); } @@ -324,19 +324,19 @@ method if "add_comp_ext" is enabled. sub get_filename { my $self = shift; - my $comp = *$self->{"compression"}; - if (*$self->{'add_comp_ext'}) { + 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") { - return *$self->{"filename"}; + return *$self->{filename}; } else { - return *$self->{"filename"} . "." . + return *$self->{filename} . "." . compression_get_property($comp, "file_ext"); } } else { - return *$self->{"filename"}; + return *$self->{filename}; } } @@ -351,12 +351,12 @@ method. sub use_compression { my ($self) = @_; - my $comp = *$self->{"compression"}; + my $comp = *$self->{compression}; if ($comp eq "none") { return 0; } elsif ($comp eq "auto") { $comp = compression_guess_from_filename($self->get_filename()); - *$self->{"compressor"}->set_compression($comp) if $comp; + *$self->{compressor}->set_compression($comp) if $comp; } return $comp; } @@ -370,54 +370,54 @@ along in a derived object. sub get_filehandle { my ($self) = @_; - return *$self->{"file"} if exists *$self->{"file"}; + return *$self->{file} if exists *$self->{file}; } ## INTERNAL METHODS sub open_for_write { my ($self) = @_; - error("Can't reopen an already opened compressed file") if exists *$self->{"mode"}; + error("Can't reopen an already opened compressed file") if exists *$self->{mode}; my $filehandle; if ($self->use_compression()) { - *$self->{'compressor'}->compress(from_pipe => \$filehandle, + *$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()); } - *$self->{"mode"} = "w"; - *$self->{"file"} = $filehandle; + *$self->{mode} = "w"; + *$self->{file} = $filehandle; } sub open_for_read { my ($self) = @_; - error("Can't reopen an already opened compressed file") if exists *$self->{"mode"}; + error("Can't reopen an already opened compressed file") if exists *$self->{mode}; my $filehandle; if ($self->use_compression()) { - *$self->{'compressor'}->uncompress(to_pipe => \$filehandle, + *$self->{compressor}->uncompress(to_pipe => \$filehandle, from_file => $self->get_filename()); - *$self->{'allow_sigpipe'} = 1; + *$self->{allow_sigpipe} = 1; } else { CORE::open($filehandle, "<", $self->get_filename) || syserr(_g("cannot read %s"), $self->get_filename()); } - *$self->{"mode"} = "r"; - *$self->{"file"} = $filehandle; + *$self->{mode} = "r"; + *$self->{file} = $filehandle; } sub cleanup { my ($self) = @_; - my $cmdline = *$self->{"compressor"}{"cmdline"} || ""; - *$self->{"compressor"}->wait_end_process(nocheck => *$self->{'allow_sigpipe'}); - if (*$self->{'allow_sigpipe'}) { + my $cmdline = *$self->{compressor}{cmdline} || ""; + *$self->{compressor}->wait_end_process(nocheck => *$self->{allow_sigpipe}); + if (*$self->{allow_sigpipe}) { unless (($? == 0) || (WIFSIGNALED($?) && (WTERMSIG($?) == SIGPIPE))) { subprocerr($cmdline); } - *$self->{'allow_sigpipe'} = 0; + *$self->{allow_sigpipe} = 0; } - delete *$self->{"mode"}; - delete *$self->{"file"}; + delete *$self->{mode}; + delete *$self->{file}; } =back @@ -434,7 +434,7 @@ C<*$self->{...}> to access the associated hash like in the example below: sub set_option { my ($self, $value) = @_; - *$self->{"option"} = $value; + *$self->{option} = $value; } diff --git a/scripts/Dpkg/Compression/Process.pm b/scripts/Dpkg/Compression/Process.pm index 52007813e..38773d28c 100644 --- a/scripts/Dpkg/Compression/Process.pm +++ b/scripts/Dpkg/Compression/Process.pm @@ -52,8 +52,8 @@ sub new { my $class = ref($this) || $this; my $self = {}; bless $self, $class; - $self->set_compression($args{"compression"} || compression_get_default()); - $self->set_compression_level($args{"compression_level"} || + $self->set_compression($args{compression} || compression_get_default()); + $self->set_compression_level($args{compression_level} || compression_get_default_level()); return $self; } @@ -70,7 +70,7 @@ sub set_compression { my ($self, $method) = @_; error(_g("%s is not a supported compression method"), $method) unless compression_is_supported($method); - $self->{"compression"} = $method; + $self->{compression} = $method; } =item $proc->set_compression_level($level) @@ -85,7 +85,7 @@ sub set_compression_level { my ($self, $level) = @_; error(_g("%s is not a compression level"), $level) unless compression_is_valid_level($level); - $self->{"compression_level"} = $level; + $self->{compression_level} = $level; } =item my @exec = $proc->get_compress_cmdline() @@ -103,24 +103,24 @@ 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"} - if $self->{"compression_level"} !~ m/^[1-9]$/; + 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; } 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")) - if $self->{"pid"}; + if $self->{pid}; # Check options my $to = my $from = 0; foreach (qw(file handle string pipe)) { @@ -148,10 +148,10 @@ sub compress { my $self = shift; my %opts = $self->_sanity_check(@_); my @prog = $self->get_compress_cmdline(); - $opts{"exec"} = \@prog; - $self->{"cmdline"} = "@prog"; - $self->{"pid"} = spawn(%opts); - delete $self->{"pid"} if $opts{"to_string"}; # wait_child already done + $opts{exec} = \@prog; + $self->{cmdline} = "@prog"; + $self->{pid} = spawn(%opts); + delete $self->{pid} if $opts{to_string}; # wait_child already done } =item $proc->uncompress(%opts) @@ -170,10 +170,10 @@ sub uncompress { my $self = shift; my %opts = $self->_sanity_check(@_); my @prog = $self->get_uncompress_cmdline(); - $opts{"exec"} = \@prog; - $self->{"cmdline"} = "@prog"; - $self->{"pid"} = spawn(%opts); - delete $self->{"pid"} if $opts{"to_string"}; # wait_child already done + $opts{exec} = \@prog; + $self->{cmdline} = "@prog"; + $self->{pid} = spawn(%opts); + delete $self->{pid} if $opts{to_string}; # wait_child already done } =item $proc->wait_end_process(%opts) @@ -188,10 +188,10 @@ it for you. sub wait_end_process { my ($self, %opts) = @_; - $opts{"cmdline"} ||= $self->{"cmdline"}; - wait_child($self->{"pid"}, %opts) if $self->{'pid'}; - delete $self->{"pid"}; - delete $self->{"cmdline"}; + $opts{cmdline} ||= $self->{cmdline}; + wait_child($self->{pid}, %opts) if $self->{pid}; + delete $self->{pid}; + delete $self->{cmdline}; } =back diff --git a/scripts/Dpkg/Conf.pm b/scripts/Dpkg/Conf.pm index 871fe63c9..98475db62 100644 --- a/scripts/Dpkg/Conf.pm +++ b/scripts/Dpkg/Conf.pm @@ -79,7 +79,7 @@ Returns the list of options that can be parsed like @ARGV. sub get_options { my ($self) = @_; - return @{$self->{'options'}}; + return @{$self->{options}}; } =item $conf->load($file) @@ -101,7 +101,7 @@ sub parse { s/\s+=\s+/=/; # Remove spaces around the first = s/\s+/=/ unless m/=/; # First spaces becomes = if no = next if /^#/ or /^$/; # Skip empty lines and comments - if (/^-[^-]/ and not $self->{'allow_short'}) { + if (/^-[^-]/ and not $self->{allow_short}) { warning(_g("short option not allowed in %s, line %d"), $desc, $.); next; } @@ -110,9 +110,9 @@ sub parse { $name = "--$name" unless $name =~ /^-/; if (defined $value) { $value =~ s/^"(.*)"$/$1/ or $value =~ s/^'(.*)'$/$1/; - push @{$self->{'options'}}, "$name=$value"; + push @{$self->{options}}, "$name=$value"; } else { - push @{$self->{'options'}}, $name; + push @{$self->{options}}, $name; } $count++; } else { @@ -133,13 +133,13 @@ return true when &$rmfunc($option) or &keepfunc($option) is called. sub filter { my ($self, %opts) = @_; - if (defined($opts{'remove'})) { - @{$self->{'options'}} = grep { not &{$opts{'remove'}}($_) } - @{$self->{'options'}}; + if (defined($opts{remove})) { + @{$self->{options}} = grep { not &{$opts{remove}}($_) } + @{$self->{options}}; } - if (defined($opts{'keep'})) { - @{$self->{'options'}} = grep { &{$opts{'keep'}}($_) } - @{$self->{'options'}}; + if (defined($opts{keep})) { + @{$self->{options}} = grep { &{$opts{keep}}($_) } + @{$self->{options}}; } } diff --git a/scripts/Dpkg/Control.pm b/scripts/Dpkg/Control.pm index 01d8d282e..5efa17cb6 100644 --- a/scripts/Dpkg/Control.pm +++ b/scripts/Dpkg/Control.pm @@ -142,32 +142,32 @@ Dpkg::Control::Fields::field_ordered_list($type). sub set_options { my ($self, %opts) = @_; - if (exists $opts{'type'}) { - my $t = $opts{'type'}; - $$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 (exists $opts{type}) { + my $t = $opts{type}; + $$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"); + $$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"); + $$self->{name} = _g("entry in dpkg's status file"); } - $self->set_output_order(field_ordered_list($opts{'type'})); + $self->set_output_order(field_ordered_list($opts{type})); } # Options set by the user override default values @@ -183,7 +183,7 @@ set during new(). sub get_type { my ($self) = @_; - return $$self->{'type'}; + return $$self->{type}; } =back diff --git a/scripts/Dpkg/Control/Fields.pm b/scripts/Dpkg/Control/Fields.pm index f8db7d453..0adc75733 100644 --- a/scripts/Dpkg/Control/Fields.pm +++ b/scripts/Dpkg/Control/Fields.pm @@ -413,7 +413,7 @@ sub field_is_allowed_in($@) { return 0 if not scalar(@types); foreach my $type (@types) { next if $type == CTRL_UNKNOWN; # Always allowed - return 0 unless $FIELDS{$field}{'allowed'} & $type; + return 0 unless $FIELDS{$field}{allowed} & $type; } return 1; } @@ -513,10 +513,10 @@ Debian package. sub field_list_src_dep() { my @list = sort { - $FIELDS{$a}{'dep_order'} <=> $FIELDS{$b}{'dep_order'} + $FIELDS{$a}{dep_order} <=> $FIELDS{$b}{dep_order} } grep { field_is_allowed_in($_, CTRL_PKG_SRC) and - exists $FIELDS{$_}{'dependency'} + exists $FIELDS{$_}{dependency} } keys %FIELDS; return @list; } @@ -532,10 +532,10 @@ the stronger to the weaker. sub field_list_pkg_dep() { my @keys = keys %FIELDS; my @list = sort { - $FIELDS{$a}{'dep_order'} <=> $FIELDS{$b}{'dep_order'} + $FIELDS{$a}{dep_order} <=> $FIELDS{$b}{dep_order} } grep { field_is_allowed_in($_, CTRL_PKG_DEB) and - exists $FIELDS{$_}{'dependency'} + exists $FIELDS{$_}{dependency} } @keys; return @list; } @@ -552,7 +552,7 @@ Breaks, ...). Returns undef for fields which are not dependencies. sub field_get_dep_type($) { my $field = field_capitalize($_[0]); return unless field_is_official($field); - return $FIELDS{$field}{'dependency'} if exists $FIELDS{$field}{'dependency'}; + return $FIELDS{$field}{dependency} if exists $FIELDS{$field}{dependency}; return; } diff --git a/scripts/Dpkg/Control/Hash.pm b/scripts/Dpkg/Control/Hash.pm index 6084d3a97..eee6dc350 100644 --- a/scripts/Dpkg/Control/Hash.pm +++ b/scripts/Dpkg/Control/Hash.pm @@ -31,7 +31,7 @@ use Dpkg::ErrorHandling; use base qw(Dpkg::Interface::Storable); use overload - '%{}' => sub { ${$_[0]}->{'fields'} }, + '%{}' => sub { ${$_[0]}->{fields} }, 'eq' => sub { "$_[0]" eq "$_[1]" }; =encoding utf8 @@ -111,7 +111,7 @@ sub new { }; bless $self, $class; - $$self->{'fields'} = Dpkg::Control::Hash::Tie->new($self); + $$self->{fields} = Dpkg::Control::Hash::Tie->new($self); # Options set by the user override default values $$self->{$_} = $opts{$_} foreach keys %opts; @@ -126,7 +126,7 @@ sub new { sub DESTROY { my ($self) = @_; - delete $$self->{'fields'}; + delete $$self->{fields}; } =item $c->set_options($option, %opts) @@ -182,7 +182,7 @@ sub parse { if (m/^(\S+?)\s*:\s*(.*)$/) { $parabody = 1; if (exists $self->{$1}) { - unless ($$self->{'allow_duplicate'}) { + unless ($$self->{allow_duplicate}) { syntaxerr($desc, sprintf(_g("duplicate field %s found"), $1)); } } @@ -199,7 +199,7 @@ sub parse { $self->{$cf} .= "\n$line"; } elsif (m/^-----BEGIN PGP SIGNED MESSAGE-----$/) { $expect_pgp_sig = 1; - if ($$self->{'allow_pgp'} and not $parabody) { + if ($$self->{allow_pgp} and not $parabody) { # Skip PGP headers while (<$fh>) { last if m/^\s*$/; @@ -298,10 +298,10 @@ sub output { my ($self, $fh) = @_; my $str = ""; my @keys; - if (@{$$self->{'out_order'}}) { + if (@{$$self->{out_order}}) { my $i = 1; my $imp = {}; - $imp->{$_} = $i++ foreach @{$$self->{'out_order'}}; + $imp->{$_} = $i++ foreach @{$$self->{out_order}}; @keys = sort { if (defined $imp->{$a} && defined $imp->{$b}) { $imp->{$a} <=> $imp->{$b}; @@ -314,14 +314,14 @@ sub output { } } keys %$self; } else { - @keys = @{$$self->{'in_order'}}; + @keys = @{$$self->{in_order}}; } foreach my $key (@keys) { if (exists $self->{$key}) { my $value = $self->{$key}; # Skip whitespace-only fields - next if $$self->{'drop_empty'} and $value !~ m/\S/; + 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 : ""; @@ -353,7 +353,7 @@ Define the order in which fields will be displayed in the output() method. sub set_output_order { my ($self, @fields) = @_; - $$self->{'out_order'} = [@fields]; + $$self->{out_order} = [@fields]; } =item $c->apply_substvars($substvars) @@ -450,7 +450,7 @@ sub STORE { my $parent = $self->[1]; $key = lc($key); if (not exists $self->[0]->{$key}) { - push @{$parent->{'in_order'}}, field_capitalize($key); + push @{$parent->{in_order}}, field_capitalize($key); } $self->[0]->{$key} = $value; } @@ -464,7 +464,7 @@ sub EXISTS { sub DELETE { my ($self, $key) = @_; my $parent = $self->[1]; - my $in_order = $parent->{'in_order'}; + my $in_order = $parent->{in_order}; $key = lc($key); if (exists $self->[0]->{$key}) { delete $self->[0]->{$key}; @@ -478,7 +478,7 @@ sub DELETE { sub FIRSTKEY { my $self = shift; my $parent = $self->[1]; - foreach (@{$parent->{'in_order'}}) { + foreach (@{$parent->{in_order}}) { return $_ if exists $self->[0]->{lc($_)}; } } @@ -487,7 +487,7 @@ sub NEXTKEY { my ($self, $last) = @_; my $parent = $self->[1]; my $found = 0; - foreach (@{$parent->{'in_order'}}) { + foreach (@{$parent->{in_order}}) { if ($found) { return $_ if exists $self->[0]->{lc($_)}; } else { diff --git a/scripts/Dpkg/Deps.pm b/scripts/Dpkg/Deps.pm index f57528822..b5ba17131 100644 --- a/scripts/Dpkg/Deps.pm +++ b/scripts/Dpkg/Deps.pm @@ -568,11 +568,11 @@ sub new { sub reset { my ($self) = @_; - $self->{'package'} = undef; - $self->{'relation'} = undef; - $self->{'version'} = undef; - $self->{'arches'} = undef; - $self->{'archqual'} = undef; + $self->{package} = undef; + $self->{relation} = undef; + $self->{version} = undef; + $self->{arches} = undef; + $self->{archqual} = undef; } sub parse { @@ -627,7 +627,7 @@ sub output { if (defined($self->{relation})) { $res .= " (" . $self->{relation} . " " . $self->{version} . ")"; } - if (defined($self->{'arches'})) { + if (defined($self->{arches})) { $res .= " [" . join(" ", @{$self->{arches}}) . "]"; } if (defined($fh)) { @@ -846,7 +846,7 @@ sub new { sub reset { my ($self) = @_; - $self->{'list'} = []; + $self->{list} = []; } sub add { @@ -1279,8 +1279,8 @@ sub _find_package { my $host_arch = $dep->{host_arch}; my $build_arch = $dep->{build_arch}; foreach my $p (@{$self->{pkg}{$pkg}}) { - my $a = $p->{"architecture"}; - my $ma = $p->{"multiarch"}; + my $a = $p->{architecture}; + my $ma = $p->{multiarch}; if (not defined $a) { $$lackinfos = 1; next; diff --git a/scripts/Dpkg/Exit.pm b/scripts/Dpkg/Exit.pm index 28de118c0..d69d37f28 100644 --- a/scripts/Dpkg/Exit.pm +++ b/scripts/Dpkg/Exit.pm @@ -26,8 +26,8 @@ sub exit_handler { exit(127); } -$SIG{'INT'} = \&exit_handler; -$SIG{'HUP'} = \&exit_handler; -$SIG{'QUIT'} = \&exit_handler; +$SIG{INT} = \&exit_handler; +$SIG{HUP} = \&exit_handler; +$SIG{QUIT} = \&exit_handler; 1; diff --git a/scripts/Dpkg/IPC.pm b/scripts/Dpkg/IPC.pm index 8a9f2099b..41182bc60 100644 --- a/scripts/Dpkg/IPC.pm +++ b/scripts/Dpkg/IPC.pm @@ -134,7 +134,7 @@ sub _sanity_check_opts { my (%opts) = @_; internerr("exec parameter is mandatory in spawn()") - unless $opts{"exec"}; + unless $opts{exec}; my $to = my $error_to = my $from = 0; foreach (qw(file handle string pipe)) { @@ -164,16 +164,16 @@ sub _sanity_check_opts { } } - if (exists $opts{"timeout"} and defined($opts{"timeout"}) and - $opts{"timeout"} !~ /^\d+$/) { + if (exists $opts{timeout} and defined($opts{timeout}) and + $opts{timeout} !~ /^\d+$/) { internerr("parameter timeout must be an integer"); } - if (exists $opts{"env"} and ref($opts{"env"}) ne 'HASH') { + if (exists $opts{env} and ref($opts{env}) ne 'HASH') { internerr("parameter env must be a hash reference"); } - if (exists $opts{"delete_env"} and ref($opts{"delete_env"}) ne 'ARRAY') { + if (exists $opts{delete_env} and ref($opts{delete_env}) ne 'ARRAY') { internerr("parameter delete_env must be an array reference"); } @@ -182,119 +182,119 @@ sub _sanity_check_opts { sub spawn { my (%opts) = _sanity_check_opts(@_); - $opts{"close_in_child"} ||= []; + $opts{close_in_child} ||= []; my @prog; - if (ref($opts{"exec"}) =~ /ARRAY/) { - push @prog, @{$opts{"exec"}}; - } elsif (not ref($opts{"exec"})) { - push @prog, $opts{"exec"}; + if (ref($opts{exec}) =~ /ARRAY/) { + push @prog, @{$opts{exec}}; + } elsif (not ref($opts{exec})) { + push @prog, $opts{exec}; } else { internerr("invalid exec parameter in spawn()"); } my ($from_string_pipe, $to_string_pipe, $error_to_string_pipe); - if ($opts{"to_string"}) { - $opts{"to_pipe"} = \$to_string_pipe; - $opts{"wait_child"} = 1; + if ($opts{to_string}) { + $opts{to_pipe} = \$to_string_pipe; + $opts{wait_child} = 1; } - if ($opts{"error_to_string"}) { - $opts{"error_to_pipe"} = \$error_to_string_pipe; - $opts{"wait_child"} = 1; + if ($opts{error_to_string}) { + $opts{error_to_pipe} = \$error_to_string_pipe; + $opts{wait_child} = 1; } - if ($opts{"from_string"}) { - $opts{"from_pipe"} = \$from_string_pipe; + if ($opts{from_string}) { + $opts{from_pipe} = \$from_string_pipe; } # Create pipes if needed my ($input_pipe, $output_pipe, $error_pipe); - if ($opts{"from_pipe"}) { - pipe($opts{"from_handle"}, $input_pipe) || + if ($opts{from_pipe}) { + pipe($opts{from_handle}, $input_pipe) || syserr(_g("pipe for %s"), "@prog"); - ${$opts{"from_pipe"}} = $input_pipe; - push @{$opts{"close_in_child"}}, $input_pipe; + ${$opts{from_pipe}} = $input_pipe; + push @{$opts{close_in_child}}, $input_pipe; } - if ($opts{"to_pipe"}) { - pipe($output_pipe, $opts{"to_handle"}) || + if ($opts{to_pipe}) { + pipe($output_pipe, $opts{to_handle}) || syserr(_g("pipe for %s"), "@prog"); - ${$opts{"to_pipe"}} = $output_pipe; - push @{$opts{"close_in_child"}}, $output_pipe; + ${$opts{to_pipe}} = $output_pipe; + push @{$opts{close_in_child}}, $output_pipe; } - if ($opts{"error_to_pipe"}) { - pipe($error_pipe, $opts{"error_to_handle"}) || + if ($opts{error_to_pipe}) { + pipe($error_pipe, $opts{error_to_handle}) || syserr(_g("pipe for %s"), "@prog"); - ${$opts{"error_to_pipe"}} = $error_pipe; - push @{$opts{"close_in_child"}}, $error_pipe; + ${$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; if (not $pid) { # Define environment variables - if ($opts{"env"}) { - foreach (keys %{$opts{"env"}}) { - $ENV{$_} = $opts{"env"}{$_}; + if ($opts{env}) { + foreach (keys %{$opts{env}}) { + $ENV{$_} = $opts{env}{$_}; } } - if ($opts{"delete_env"}) { - delete $ENV{$_} foreach (@{$opts{"delete_env"}}); + if ($opts{delete_env}) { + delete $ENV{$_} foreach (@{$opts{delete_env}}); } # Change the current directory - if ($opts{"chdir"}) { - chdir($opts{"chdir"}) || syserr(_g("chdir to %s"), $opts{"chdir"}); + if ($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"}); - } elsif ($opts{"from_handle"}) { - open(STDIN, "<&", $opts{"from_handle"}) || syserr(_g("reopen stdin")); - close($opts{"from_handle"}); # has been duped, can be closed + if ($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")); + 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"}); - } elsif ($opts{"to_handle"}) { - open(STDOUT, ">&", $opts{"to_handle"}) || syserr(_g("reopen stdout")); - close($opts{"to_handle"}); # has been duped, can be closed + if ($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")); + 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"}); - } elsif ($opts{"error_to_handle"}) { - open(STDERR, ">&", $opts{"error_to_handle"}) || syserr(_g("reopen stdout")); - close($opts{"error_to_handle"}); # has been duped, can be closed + if ($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")); + close($opts{error_to_handle}); # has been duped, can be closed } # Close some inherited filehandles - close($_) foreach (@{$opts{"close_in_child"}}); + close($_) foreach (@{$opts{close_in_child}}); # Execute the program 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"}; - close($opts{"to_handle"}) if exists $opts{"to_handle"}; - close($opts{"error_to_handle"}) if exists $opts{"error_to_handle"}; + close($opts{from_handle}) if exists $opts{from_handle}; + close($opts{to_handle}) if exists $opts{to_handle}; + close($opts{error_to_handle}) if exists $opts{error_to_handle}; - if ($opts{"from_string"}) { - print $from_string_pipe ${$opts{"from_string"}}; + if ($opts{from_string}) { + print $from_string_pipe ${$opts{from_string}}; close($from_string_pipe); } - if ($opts{"to_string"}) { + if ($opts{to_string}) { local $/ = undef; - ${$opts{"to_string"}} = readline($to_string_pipe); + ${$opts{to_string}} = readline($to_string_pipe); } - if ($opts{"error_to_string"}) { + if ($opts{error_to_string}) { local $/ = undef; - ${$opts{"error_to_string"}} = readline($error_to_string_pipe); + ${$opts{error_to_string}} = readline($error_to_string_pipe); } - if ($opts{"wait_child"}) { + if ($opts{wait_child}) { my $cmdline = "@prog"; - if ($opts{"env"}) { - foreach (keys %{$opts{"env"}}) { - $cmdline = "$_=\"" . $opts{"env"}{$_} . "\" $cmdline"; + if ($opts{env}) { + foreach (keys %{$opts{env}}) { + $cmdline = "$_=\"" . $opts{env}{$_} . "\" $cmdline"; } } - wait_child($pid, nocheck => $opts{"nocheck"}, - timeout => $opts{"timeout"}, cmdline => $cmdline); + wait_child($pid, nocheck => $opts{nocheck}, + timeout => $opts{timeout}, cmdline => $cmdline); return 1; } @@ -335,23 +335,23 @@ with an error message. sub wait_child { my ($pid, %opts) = @_; - $opts{"cmdline"} ||= _g("child process"); + $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"}); - alarm(0) if defined($opts{"timeout"}); + alarm($opts{timeout}) if defined($opts{timeout}); + $pid == waitpid($pid, 0) or syserr(_g("wait for %s"), $opts{cmdline}); + alarm(0) if defined($opts{timeout}); }; if ($@) { die $@ unless $@ eq "alarm\n"; error(ngettext("%s didn't complete in %d second", "%s didn't complete in %d seconds", - $opts{"timeout"}), - $opts{"cmdline"}, $opts{"timeout"}); + $opts{timeout}), + $opts{cmdline}, $opts{timeout}); } - unless ($opts{"nocheck"}) { - subprocerr($opts{"cmdline"}) if $?; + unless ($opts{nocheck}) { + subprocerr($opts{cmdline}) if $?; } } diff --git a/scripts/Dpkg/Index.pm b/scripts/Dpkg/Index.pm index 7dd650fd9..9d54bb771 100644 --- a/scripts/Dpkg/Index.pm +++ b/scripts/Dpkg/Index.pm @@ -28,7 +28,7 @@ use Dpkg::Compression::FileHandle; use base qw(Dpkg::Interface::Storable); use overload - '@{}' => sub { return $_[0]->{'order'} }, + '@{}' => sub { return $_[0]->{order} }, fallback => 1; =encoding utf8 @@ -63,8 +63,8 @@ sub new { }; bless $self, $class; $self->set_options(%opts); - if (exists $opts{'load'}) { - $self->load($opts{'load'}); + if (exists $opts{load}) { + $self->load($opts{load}); } return $self; @@ -91,8 +91,8 @@ sub set_options { my ($self, %opts) = @_; # Default values based on type - if (exists $opts{'type'}) { - my $t = $opts{'type'}; + if (exists $opts{type}) { + my $t = $opts{type}; if ($t == CTRL_INFO_PKG or $t == CTRL_INDEX_SRC or $t == CTRL_INDEX_PKG or $t == CTRL_PKG_DEB) { $self->{get_key_func} = sub { return $_[0]->{Package}; }; @@ -129,7 +129,7 @@ set during new(). sub get_type { my ($self) = @_; - return $self->{'type'}; + return $self->{type}; } =item $index->add($item, [$key]) @@ -143,12 +143,12 @@ details). sub add { my ($self, $item, $key) = @_; unless (defined $key) { - $key = $self->{'get_key_func'}($item); + $key = $self->{get_key_func}($item); } - if (not exists $self->{'items'}{$key}) { - push @{$self->{'order'}}, $key; + if (not exists $self->{items}{$key}) { + push @{$self->{order}}, $key; } - $self->{'items'}{$key} = $item; + $self->{items}{$key} = $item; } =item $index->load($file) @@ -190,7 +190,7 @@ object. sub new_item { my ($self) = @_; - return Dpkg::Control->new(type => $self->{'type'}); + return Dpkg::Control->new(type => $self->{type}); } =item my $item = $index->get_by_key($key) @@ -201,7 +201,7 @@ Returns the item identified by $key or undef. sub get_by_key { my ($self, $key) = @_; - return $self->{'items'}{$key} if exists $self->{'items'}{$key}; + return $self->{items}{$key} if exists $self->{items}{$key}; return; } @@ -221,15 +221,15 @@ sub get_keys { foreach my $s_crit (keys %crit) { # search criteria if (ref($crit{$s_crit}) eq "Regexp") { @selected = grep { - $self->{'items'}{$_}{$s_crit} =~ $crit{$s_crit} + $self->{items}{$_}{$s_crit} =~ $crit{$s_crit} } @selected; } elsif (ref($crit{$s_crit}) eq "CODE") { @selected = grep { - &{$crit{$s_crit}}($self->{'items'}{$_}{$s_crit}); + &{$crit{$s_crit}}($self->{items}{$_}{$s_crit}); } @selected; } else { @selected = grep { - $self->{'items'}{$_}{$s_crit} eq $crit{$s_crit} + $self->{items}{$_}{$s_crit} eq $crit{$s_crit} } @selected; } } @@ -244,7 +244,7 @@ Returns all the items that matches all the criteria. sub get { my ($self, %crit) = @_; - return map { $self->{'items'}{$_} } $self->get_keys(%crit); + return map { $self->{items}{$_} } $self->get_keys(%crit); } =item $index->remove_by_key($key) @@ -255,8 +255,8 @@ Remove the item identified by the given key. sub remove_by_key { my ($self, $key) = @_; - @{$self->{'order'}} = grep { $_ ne $key } @{$self->{'order'}}; - return delete $self->{'items'}{$key}; + @{$self->{order}} = grep { $_ ne $key } @{$self->{order}}; + return delete $self->{items}{$key}; } =item my @items = $index->remove(%criteria) @@ -271,10 +271,10 @@ sub remove { my (%keys, @ret); foreach my $key (@keys) { $keys{$key} = 1; - push @ret, $self->{'items'}{$key} if defined wantarray; - delete $self->{'items'}{$key}; + push @ret, $self->{items}{$key} if defined wantarray; + delete $self->{items}{$key}; } - @{$self->{'order'}} = grep { not exists $keys{$_} } @{$self->{'order'}}; + @{$self->{order}} = grep { not exists $keys{$_} } @{$self->{order}}; return @ret; } @@ -289,9 +289,9 @@ computed with the same function. sub merge { my ($self, $other, %opts) = @_; - $opts{'keep_keys'} = 1 unless exists $opts{'keep_keys'}; + $opts{keep_keys} = 1 unless exists $opts{keep_keys}; foreach my $key ($other->get_keys()) { - $self->add($other->get_by_key($key), $opts{'keep_keys'} ? $key : undef); + $self->add($other->get_by_key($key), $opts{keep_keys} ? $key : undef); } } @@ -306,11 +306,11 @@ items themselves as parameters and not the keys. sub sort { my ($self, $func) = @_; if (defined $func) { - @{$self->{'order'}} = sort { - &$func($self->{'items'}{$a}, $self->{'items'}{$b}) - } @{$self->{'order'}}; + @{$self->{order}} = sort { + &$func($self->{items}{$a}, $self->{items}{$b}) + } @{$self->{order}}; } else { - @{$self->{'order'}} = sort @{$self->{'order'}}; + @{$self->{order}} = sort @{$self->{order}}; } } diff --git a/scripts/Dpkg/Path.pm b/scripts/Dpkg/Path.pm index 5a8977037..3c75ef6f2 100644 --- a/scripts/Dpkg/Path.pm +++ b/scripts/Dpkg/Path.pm @@ -210,7 +210,7 @@ sub find_command($) { if ($cmd =~ m{/}) { return "$cmd" if -x "$cmd"; } else { - foreach my $dir (split(/:/, $ENV{'PATH'})) { + foreach my $dir (split(/:/, $ENV{PATH})) { return "$dir/$cmd" if -x "$dir/$cmd"; } } diff --git a/scripts/Dpkg/Shlibs/Objdump.pm b/scripts/Dpkg/Shlibs/Objdump.pm index 594b8a367..80f13c939 100644 --- a/scripts/Dpkg/Shlibs/Objdump.pm +++ b/scripts/Dpkg/Shlibs/Objdump.pm @@ -92,7 +92,7 @@ sub has_object { } else { my ($output, %opts, $pid, $res); if ($OBJDUMP ne "objdump") { - $opts{"error_to_file"} = "/dev/null"; + $opts{error_to_file} = "/dev/null"; } $pid = spawn(exec => [ $OBJDUMP, "-a", "--", $file ], env => { LC_ALL => "C" }, @@ -345,10 +345,10 @@ sub apply_relocations { foreach my $sym (values %{$self->{dynsyms}}) { # We want to mark as undefined symbols those which are currently # defined but that depend on a copy relocation - next if not $sym->{'defined'}; + next if not $sym->{defined}; next if not exists $self->{dynrelocs}{$sym->{name}}; if ($self->{dynrelocs}{$sym->{name}} =~ /^R_.*_COPY$/) { - $sym->{'defined'} = 0; + $sym->{defined} = 0; } } } diff --git a/scripts/Dpkg/Source/Archive.pm b/scripts/Dpkg/Source/Archive.pm index 5ce625a14..7146d8a97 100644 --- a/scripts/Dpkg/Source/Archive.pm +++ b/scripts/Dpkg/Source/Archive.pm @@ -34,40 +34,40 @@ use base 'Dpkg::Compression::FileHandle'; sub create { my ($self, %opts) = @_; - $opts{"options"} ||= []; + $opts{options} ||= []; my %spawn_opts; # Possibly run tar from another directory - if ($opts{"chdir"}) { - $spawn_opts{"chdir"} = $opts{"chdir"}; - *$self->{"chdir"} = $opts{"chdir"}; + if ($opts{chdir}) { + $spawn_opts{chdir} = $opts{chdir}; + *$self->{chdir} = $opts{chdir}; } # Redirect input/output appropriately $self->ensure_open("w"); - $spawn_opts{"to_handle"} = $self->get_filehandle(); - $spawn_opts{"from_pipe"} = \*$self->{'tar_input'}; + $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{'exec'} = [ 'tar', '--null', '-T', '-', '--numeric-owner', + $spawn_opts{delete_env} = [ "TAR_OPTIONS" ]; + $spawn_opts{exec} = [ 'tar', '--null', '-T', '-', '--numeric-owner', '--owner', '0', '--group', '0', - @{$opts{"options"}}, '-cf', '-' ]; - *$self->{"pid"} = spawn(%spawn_opts); - *$self->{"cwd"} = getcwd(); + @{$opts{options}}, '-cf', '-' ]; + *$self->{pid} = spawn(%spawn_opts); + *$self->{cwd} = getcwd(); } sub _add_entry { my ($self, $file) = @_; - my $cwd = *$self->{'cwd'}; - internerr("call create() first") unless *$self->{"tar_input"}; + my $cwd = *$self->{cwd}; + internerr("call create() first") unless *$self->{tar_input}; $file = $2 if ($file =~ /^\Q$cwd\E\/(.+)$/); # Relative names - print({ *$self->{'tar_input'} } "$file\0") || + print({ *$self->{tar_input} } "$file\0") || syserr(_g("write on tar input")); } sub add_file { my ($self, $file) = @_; my $testfile = $file; - if (*$self->{"chdir"}) { - $testfile = File::Spec->catfile(*$self->{"chdir"}, $file); + if (*$self->{chdir}) { + $testfile = File::Spec->catfile(*$self->{chdir}, $file); } internerr("add_file() doesn't handle directories") if not -l $testfile and -d _; $self->_add_entry($file); @@ -76,8 +76,8 @@ sub add_file { sub add_directory { my ($self, $file) = @_; my $testfile = $file; - if (*$self->{"chdir"}) { - $testfile = File::Spec->catdir(*$self->{"chdir"}, $file); + if (*$self->{chdir}) { + $testfile = File::Spec->catdir(*$self->{chdir}, $file); } internerr("add_directory() only handles directories") unless not -l $testfile and -d _; $self->_add_entry($file); @@ -85,26 +85,26 @@ sub add_directory { sub finish { my ($self) = @_; - 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'}; - delete *$self->{'cwd'}; - delete *$self->{'chdir'}; + 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}; + delete *$self->{cwd}; + delete *$self->{chdir}; $self->close(); } sub extract { my ($self, $dest, %opts) = @_; - $opts{"options"} ||= []; - $opts{"in_place"} ||= 0; - $opts{"no_fixperms"} ||= 0; + $opts{options} ||= []; + $opts{in_place} ||= 0; + $opts{no_fixperms} ||= 0; my %spawn_opts = (wait_child => 1); # Prepare destination my $tmp; - if ($opts{"in_place"}) { - $spawn_opts{"chdir"} = $dest; + if ($opts{in_place}) { + $spawn_opts{chdir} = $dest; $tmp = $dest; # So that fixperms call works } else { my $template = basename($self->get_filename()) . ".tmp-extract.XXXXX"; @@ -113,17 +113,17 @@ sub extract { mkdir($dest) || syserr(_g("cannot create directory %s"), $dest); } $tmp = tempdir($template, DIR => Cwd::realpath("$dest/.."), CLEANUP => 1); - $spawn_opts{"chdir"} = $tmp; + $spawn_opts{chdir} = $tmp; } # Prepare stuff that handles the input of tar $self->ensure_open("r"); - $spawn_opts{"from_handle"} = $self->get_filehandle(); + $spawn_opts{from_handle} = $self->get_filehandle(); # Call tar extraction process - $spawn_opts{"delete_env"} = [ "TAR_OPTIONS" ]; - $spawn_opts{'exec'} = [ 'tar', '--no-same-owner', '--no-same-permissions', - @{$opts{"options"}}, '-xf', '-' ]; + $spawn_opts{delete_env} = [ "TAR_OPTIONS" ]; + $spawn_opts{exec} = [ 'tar', '--no-same-owner', '--no-same-permissions', + @{$opts{options}}, '-xf', '-' ]; spawn(%spawn_opts); $self->close(); @@ -135,10 +135,10 @@ sub extract { # extracted); we need --no-same-owner because putting the owner # back is tedious - in particular, correct group ownership would # have to be calculated using mount options and other madness. - fixperms($tmp) unless $opts{"no_fixperms"}; + fixperms($tmp) unless $opts{no_fixperms}; # Stop here if we extracted in-place as there's nothing to move around - return if $opts{"in_place"}; + return if $opts{in_place}; # Rename extracted directory opendir(my $dir_dh, $tmp) || syserr(_g("cannot opendir %s"), $tmp); diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm index 10b29c78d..63f28cfa8 100644 --- a/scripts/Dpkg/Source/Package.pm +++ b/scripts/Dpkg/Source/Package.pm @@ -153,11 +153,11 @@ sub new { checksums => Dpkg::Checksums->new(), }; bless $self, $class; - if (exists $args{'options'}) { - $self->{'options'} = $args{'options'}; + if (exists $args{options}) { + $self->{options} = $args{options}; } - if (exists $args{"filename"}) { - $self->initialize($args{"filename"}); + if (exists $args{filename}) { + $self->initialize($args{filename}); $self->init_options(); } return $self; @@ -167,41 +167,41 @@ sub init_options { my ($self) = @_; # Use full ignore list by default # note: this function is not called by V1 packages - $self->{'options'}{'diff_ignore_regexp'} ||= $diff_ignore_default_regexp; - $self->{'options'}{'diff_ignore_regexp'} .= '|(?:^|/)debian/source/local-.*$'; - if (defined $self->{'options'}{'tar_ignore'}) { - $self->{'options'}{'tar_ignore'} = [ @tar_ignore_default_pattern ] - unless @{$self->{'options'}{'tar_ignore'}}; + $self->{options}{diff_ignore_regexp} ||= $diff_ignore_default_regexp; + $self->{options}{diff_ignore_regexp} .= '|(?:^|/)debian/source/local-.*$'; + if (defined $self->{options}{tar_ignore}) { + $self->{options}{tar_ignore} = [ @tar_ignore_default_pattern ] + unless @{$self->{options}{tar_ignore}}; } else { - $self->{'options'}{'tar_ignore'} = [ @tar_ignore_default_pattern ]; + $self->{options}{tar_ignore} = [ @tar_ignore_default_pattern ]; } - push @{$self->{'options'}{'tar_ignore'}}, "debian/source/local-options", + 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; + $self->{options}{skip_debianization} ||= 0; } 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 || "./"; - $self->{'filename'} = $fn; + $self->{basedir} = $dir || "./"; + $self->{filename} = $fn; # Check if it contains a signature open(my $dsc_fh, "<", $filename) || syserr(_g("cannot open %s"), $filename); - $self->{'is_signed'} = 0; + $self->{is_signed} = 0; while (<$dsc_fh>) { next if /^\s*$/o; - $self->{'is_signed'} = 1 if /^-----BEGIN PGP SIGNED MESSAGE-----\s*$/o; + $self->{is_signed} = 1 if /^-----BEGIN PGP SIGNED MESSAGE-----\s*$/o; last; } close($dsc_fh); # Read the fields my $fields = Dpkg::Control->new(type => CTRL_PKG_SRC); $fields->load($filename); - $self->{'fields'} = $fields; + $self->{fields} = $fields; foreach my $f (qw(Source Version Files)) { unless (defined($fields->{$f})) { @@ -209,7 +209,7 @@ sub initialize { } } - $self->{'checksums'}->add_from_control($fields, use_files_for_md5 => 1); + $self->{checksums}->add_from_control($fields, use_files_for_md5 => 1); $self->upgrade_object_type(0); } @@ -217,9 +217,9 @@ sub initialize { sub upgrade_object_type { my ($self, $update_format) = @_; $update_format //= 1; - $self->{'fields'}{'Format'} = '1.0' - unless exists $self->{'fields'}{'Format'}; - my $format = $self->{'fields'}{'Format'}; + $self->{fields}{'Format'} = '1.0' + unless exists $self->{fields}{'Format'}; + my $format = $self->{fields}{'Format'}; if ($format =~ /^([\d\.]+)(?:\s+\((.*)\))?$/) { my ($version, $variant, $major, $minor) = ($1, $2, $1, undef); @@ -229,8 +229,8 @@ sub upgrade_object_type { eval "require $module; \$minor = \$${module}::CURRENT_MINOR_VERSION;"; $minor //= 0; if ($update_format) { - $self->{'fields'}{'Format'} = "$major.$minor"; - $self->{'fields'}{'Format'} .= " ($variant)" if defined $variant; + $self->{fields}{'Format'} = "$major.$minor"; + $self->{fields}{'Format'} .= " ($variant)" if defined $variant; } if ($@) { error(_g("source package format '%s' is not supported: %s"), @@ -250,7 +250,7 @@ Returns the filename of the DSC file. sub get_filename { my ($self) = @_; - return $self->{'basedir'} . $self->{'filename'}; + return $self->{basedir} . $self->{filename}; } =item $p->get_files() @@ -262,7 +262,7 @@ usually do not have any path information. sub get_files { my ($self) = @_; - return $self->{'checksums'}->get_files(); + return $self->{checksums}->get_files(); } =item $p->check_checksums() @@ -275,16 +275,16 @@ discovered, it immediately errors out. sub check_checksums { my ($self) = @_; - my $checksums = $self->{'checksums'}; + my $checksums = $self->{checksums}; # add_from_file verify the checksums if they are already existing foreach my $file ($checksums->get_files()) { - $checksums->add_from_file($self->{'basedir'} . $file, key => $file); + $checksums->add_from_file($self->{basedir} . $file, key => $file); } } sub get_basename { my ($self, $with_revision) = @_; - my $f = $self->{'fields'}; + my $f = $self->{fields}; unless (exists $f->{'Source'} and exists $f->{'Version'}) { error(_g("source and version are required to compute the source basename")); } @@ -303,7 +303,7 @@ 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); push @tar, map { "$dir/$_" } grep { @@ -326,7 +326,7 @@ Otherwise returns 0. sub is_signed { my $self = shift; - return $self->{'is_signed'}; + return $self->{is_signed}; } =item $p->check_signature() @@ -349,8 +349,8 @@ sub check_signature { 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"; + if (defined $ENV{HOME} and -r "$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) { @@ -367,7 +367,7 @@ sub check_signature { my $gpg_status = WEXITSTATUS($?); print STDERR "$stdout$stderr" if $gpg_status; if ($gpg_status == 1 or ($gpg_status && - $self->{'options'}{'require_valid_signature'})) + $self->{options}{require_valid_signature})) { error(_g("failed to verify signature on %s"), $dsc); } elsif ($gpg_status) { @@ -377,7 +377,7 @@ sub check_signature { subprocerr("@exec"); } } else { - if ($self->{'options'}{'require_valid_signature'}) { + if ($self->{options}{require_valid_signature}) { error(_g("could not verify signature on %s since gpg isn't installed"), $dsc); } else { warning(_g("could not verify signature on %s since gpg isn't installed"), $dsc); @@ -409,11 +409,11 @@ sub extract { my $self = shift; my $newdirectory = $_[0]; - my ($ok, $error) = version_check($self->{'fields'}{'Version'}); + my ($ok, $error) = version_check($self->{fields}{'Version'}); error($error) unless $ok; # Copy orig tarballs - if ($self->{'options'}{'copy_orig_tarballs'}) { + if ($self->{options}{copy_orig_tarballs}) { my $basename = $self->get_basename(); my ($dirname, $destdir) = fileparse($newdirectory); $destdir ||= "./"; @@ -421,7 +421,7 @@ sub extract { foreach my $orig (grep { /^\Q$basename\E\.orig(-[[:alnum:]-]+)?\.tar\.$ext$/ } $self->get_files()) { - my $src = File::Spec->catfile($self->{'basedir'}, $orig); + my $src = File::Spec->catfile($self->{basedir}, $orig); my $dst = File::Spec->catfile($destdir, $orig); if (not check_files_are_the_same($src, $dst, 1)) { system('cp', '--', $src, $dst); @@ -438,8 +438,8 @@ sub extract { } # Store format if non-standard so that next build keeps the same format - if ($self->{'fields'}{'Format'} ne "1.0" and - not $self->{'options'}{'skip_debianization'}) + 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"); @@ -447,7 +447,7 @@ sub extract { mkdir($srcdir) unless -e $srcdir; open(my $format_fh, ">", $format_file) || syserr(_g("cannot write %s"), $format_file); - print $format_fh $self->{'fields'}{'Format'} . "\n"; + print $format_fh $self->{fields}{'Format'} . "\n"; close($format_fh); } } @@ -460,7 +460,7 @@ sub extract { syserr(_g("cannot stat %s"), $rules); } warning(_g("%s does not exist"), $rules) - unless $self->{'options'}{'skip_debianization'}; + unless $self->{options}{skip_debianization}; } elsif (-f _) { chmod($s[2] | 0111, $rules) || syserr(_g("cannot make %s executable"), $rules); @@ -506,11 +506,11 @@ sub can_build { sub add_file { my ($self, $filename) = @_; my ($fn, $dir) = fileparse($filename); - if ($self->{'checksums'}->has_file($fn)) { + if ($self->{checksums}->has_file($fn)) { internerr("tried to add file '%s' twice", $fn); } - $self->{'checksums'}->add_from_file($filename, key => $fn); - $self->{'checksums'}->export_to_control($self->{'fields'}, + $self->{checksums}->add_from_file($filename, key => $fn); + $self->{checksums}->export_to_control($self->{fields}, use_files_for_md5 => 1); } @@ -526,18 +526,18 @@ 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 { my ($self, %opts) = @_; - my $fields = $self->{'fields'}; + my $fields = $self->{fields}; - foreach my $f (keys %{$opts{'override'}}) { - $fields->{$f} = $opts{'override'}{$f}; + foreach my $f (keys %{$opts{override}}) { + $fields->{$f} = $opts{override}{$f}; } - unless($opts{'nocheck'}) { + unless($opts{nocheck}) { foreach my $f (qw(Source Version)) { unless (defined($fields->{$f})) { error(_g("missing information for critical output field %s"), $f); @@ -550,16 +550,16 @@ sub write_dsc { } } - foreach my $f (keys %{$opts{'remove'}}) { + foreach my $f (keys %{$opts{remove}}) { delete $fields->{$f}; } - my $filename = $opts{'filename'}; + my $filename = $opts{filename}; unless (defined $filename) { $filename = $self->get_basename(1) . ".dsc"; } open(my $dsc_fh, ">", $filename) || syserr(_g("cannot write %s"), $filename); - $fields->apply_substvars($opts{'substvars'}); + $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 f278c5c46..314ae0f16 100644 --- a/scripts/Dpkg/Source/Package/V1.pm +++ b/scripts/Dpkg/Source/Package/V1.pm @@ -44,32 +44,32 @@ sub init_options { my ($self) = @_; # Don't call $self->SUPER::init_options() on purpose, V1.0 has no # ignore by default - if ($self->{'options'}{'diff_ignore_regexp'}) { - $self->{'options'}{'diff_ignore_regexp'} .= '|(?:^|/)debian/source/local-.*$'; + if ($self->{options}{diff_ignore_regexp}) { + $self->{options}{diff_ignore_regexp} .= '|(?:^|/)debian/source/local-.*$'; } else { - $self->{'options'}{'diff_ignore_regexp'} = '(?:^|/)debian/source/local-.*$'; + $self->{options}{diff_ignore_regexp} = '(?:^|/)debian/source/local-.*$'; } - push @{$self->{'options'}{'tar_ignore'}}, "debian/source/local-options", + 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; + $self->{options}{sourcestyle} ||= 'X'; + $self->{options}{skip_debianization} ||= 0; + $self->{options}{abort_on_upstream_changes} ||= 0; } sub parse_cmdline_option { my ($self, $opt) = @_; - my $o = $self->{'options'}; + my $o = $self->{options}; if ($opt =~ m/^-s([akpursnAKPUR])$/) { 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 + $o->{sourcestyle}) if $o->{sourcestyle} ne 'X'; + $o->{sourcestyle} = $1; + $o->{copy_orig_tarballs} = 0 if $1 eq 'n'; # Extract option -sn return 1; } elsif ($opt =~ m/^--skip-debianization$/) { - $o->{'skip_debianization'} = 1; + $o->{skip_debianization} = 1; return 1; } elsif ($opt =~ m/^--abort-on-upstream-changes$/) { - $o->{'abort_on_upstream_changes'} = 1; + $o->{abort_on_upstream_changes} = 1; return 1; } return 0; @@ -77,15 +77,15 @@ sub parse_cmdline_option { sub do_extract { my ($self, $newdirectory) = @_; - my $sourcestyle = $self->{'options'}{'sourcestyle'}; - my $fields = $self->{'fields'}; + my $sourcestyle = $self->{options}{sourcestyle}; + my $fields = $self->{fields}; $sourcestyle =~ y/X/p/; $sourcestyle =~ m/[pun]/ || usageerr(_g("source handling style -s%s not allowed with -x"), $sourcestyle); - my $dscdir = $self->{'basedir'}; + my $dscdir = $self->{basedir}; my $basename = $self->get_basename(); my $basenamerev = $self->get_basename(1); @@ -149,13 +149,13 @@ sub do_extract { } } - if ($difffile and not $self->{'options'}{'skip_debianization'}) { + if ($difffile and not $self->{options}{skip_debianization}) { my $patch = "$dscdir$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'}}; + sort keys %{$analysis->{filepatched}}; info(_g("upstream files that have been modified: %s"), "\n " . join("\n ", @files)) if scalar @files; } @@ -165,16 +165,16 @@ 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", + return ($self->{options}{compression} eq "gzip", _g("only supports gzip compression")); } sub do_build { my ($self, $dir) = @_; - my $sourcestyle = $self->{'options'}{'sourcestyle'}; - my @argv = @{$self->{'options'}{'ARGV'}}; - my @tar_ignore = map { "--exclude=$_" } @{$self->{'options'}{'tar_ignore'}}; - my $diff_ignore_regexp = $self->{'options'}{'diff_ignore_regexp'}; + my $sourcestyle = $self->{options}{sourcestyle}; + my @argv = @{$self->{options}{ARGV}}; + my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; + 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 ". @@ -187,7 +187,7 @@ sub do_build { $sourcestyle); } - my $sourcepackage = $self->{'fields'}{'Source'}; + my $sourcepackage = $self->{fields}{'Source'}; my $basenamerev = $self->get_basename(1); my $basename = $self->get_basename(); my $basedirname = $basename; @@ -287,7 +287,7 @@ sub do_build { } if ($sourcestyle eq "n") { - $self->{'options'}{'ARGV'} = []; # ensure we have no error + $self->{options}{ARGV} = []; # ensure we have no error Dpkg::Source::Package::V3::native::do_build($self, $dir); } elsif ($sourcestyle =~ m/[nurUR]/) { if (stat($tarname)) { @@ -306,7 +306,7 @@ sub do_build { DIR => getcwd(), UNLINK => 0); my $tar = Dpkg::Source::Archive->new(filename => $newtar, compression => compression_guess_from_filename($tarname), - compression_level => $self->{'options'}{'comp_level'}); + compression_level => $self->{options}{comp_level}); $tar->create(options => \@tar_ignore, chdir => $tardirbase); $tar->add_directory($tardirname); $tar->finish(); @@ -362,14 +362,14 @@ sub do_build { my $analysis = $diff->analyze($origdir); my @files = grep { ! m{^debian/} } map { s{^[^/]+/+}{}; $_ } - sort keys %{$analysis->{'filepatched'}}; + sort keys %{$analysis->{filepatched}}; if (scalar @files) { 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")) - if $self->{'options'}{'abort_on_upstream_changes'}; + if $self->{options}{abort_on_upstream_changes}; } rename($newdiffgz, $diffname) || diff --git a/scripts/Dpkg/Source/Package/V2.pm b/scripts/Dpkg/Source/Package/V2.pm index ee9687386..4da8bdae2 100644 --- a/scripts/Dpkg/Source/Package/V2.pm +++ b/scripts/Dpkg/Source/Package/V2.pm @@ -48,60 +48,60 @@ our $CURRENT_MINOR_VERSION = "0"; sub init_options { my ($self) = @_; $self->SUPER::init_options(); - $self->{'options'}{'include_removal'} = 0 - unless exists $self->{'options'}{'include_removal'}; - $self->{'options'}{'include_timestamp'} = 0 - unless exists $self->{'options'}{'include_timestamp'}; - $self->{'options'}{'include_binaries'} = 0 - unless exists $self->{'options'}{'include_binaries'}; - $self->{'options'}{'preparation'} = 1 - unless exists $self->{'options'}{'preparation'}; - $self->{'options'}{'skip_patches'} = 0 - unless exists $self->{'options'}{'skip_patches'}; - $self->{'options'}{'unapply_patches'} = 'auto' - unless exists $self->{'options'}{'unapply_patches'}; - $self->{'options'}{'skip_debianization'} = 0 - unless exists $self->{'options'}{'skip_debianization'}; - $self->{'options'}{'create_empty_orig'} = 0 - unless exists $self->{'options'}{'create_empty_orig'}; - $self->{'options'}{'auto_commit'} = 0 - unless exists $self->{'options'}{'auto_commit'}; + $self->{options}{include_removal} = 0 + unless exists $self->{options}{include_removal}; + $self->{options}{include_timestamp} = 0 + unless exists $self->{options}{include_timestamp}; + $self->{options}{include_binaries} = 0 + unless exists $self->{options}{include_binaries}; + $self->{options}{preparation} = 1 + unless exists $self->{options}{preparation}; + $self->{options}{skip_patches} = 0 + unless exists $self->{options}{skip_patches}; + $self->{options}{unapply_patches} = 'auto' + unless exists $self->{options}{unapply_patches}; + $self->{options}{skip_debianization} = 0 + unless exists $self->{options}{skip_debianization}; + $self->{options}{create_empty_orig} = 0 + unless exists $self->{options}{create_empty_orig}; + $self->{options}{auto_commit} = 0 + unless exists $self->{options}{auto_commit}; } sub parse_cmdline_option { my ($self, $opt) = @_; if ($opt =~ /^--include-removal$/) { - $self->{'options'}{'include_removal'} = 1; + $self->{options}{include_removal} = 1; return 1; } elsif ($opt =~ /^--include-timestamp$/) { - $self->{'options'}{'include_timestamp'} = 1; + $self->{options}{include_timestamp} = 1; return 1; } elsif ($opt =~ /^--include-binaries$/) { - $self->{'options'}{'include_binaries'} = 1; + $self->{options}{include_binaries} = 1; return 1; } elsif ($opt =~ /^--no-preparation$/) { - $self->{'options'}{'preparation'} = 0; + $self->{options}{preparation} = 0; return 1; } elsif ($opt =~ /^--skip-patches$/) { - $self->{'options'}{'skip_patches'} = 1; + $self->{options}{skip_patches} = 1; return 1; } elsif ($opt =~ /^--unapply-patches$/) { - $self->{'options'}{'unapply_patches'} = 'yes'; + $self->{options}{unapply_patches} = 'yes'; return 1; } elsif ($opt =~ /^--no-unapply-patches$/) { - $self->{'options'}{'unapply_patches'} = 'no'; + $self->{options}{unapply_patches} = 'no'; return 1; } elsif ($opt =~ /^--skip-debianization$/) { - $self->{'options'}{'skip_debianization'} = 1; + $self->{options}{skip_debianization} = 1; return 1; } elsif ($opt =~ /^--create-empty-orig$/) { - $self->{'options'}{'create_empty_orig'} = 1; + $self->{options}{create_empty_orig} = 1; return 1; } elsif ($opt =~ /^--abort-on-upstream-changes$/) { - $self->{'options'}{'auto_commit'} = 0; + $self->{options}{auto_commit} = 0; return 1; } elsif ($opt =~ /^--auto-commit$/) { - $self->{'options'}{'auto_commit'} = 1; + $self->{options}{auto_commit} = 1; return 1; } return 0; @@ -109,9 +109,9 @@ sub parse_cmdline_option { sub do_extract { my ($self, $newdirectory) = @_; - my $fields = $self->{'fields'}; + my $fields = $self->{fields}; - my $dscdir = $self->{'basedir'}; + my $dscdir = $self->{basedir}; my $basename = $self->get_basename(); my $basenamerev = $self->get_basename(1); @@ -164,7 +164,7 @@ sub do_extract { } # Stop here if debianization is not wanted - return if $self->{'options'}{'skip_debianization'}; + return if $self->{options}{skip_debianization}; # Extract debian tarball after removing the debian directory info(_g("unpacking %s"), $debianfile); @@ -186,7 +186,7 @@ sub do_extract { # Apply patches (in a separate method as it might be overriden) $self->apply_patches($newdirectory, usage => 'unpack') - unless $self->{'options'}{'skip_patches'}; + unless $self->{options}{skip_patches}; } sub get_autopatch_name { @@ -195,7 +195,7 @@ sub get_autopatch_name { sub get_patches { my ($self, $dir, %opts) = @_; - $opts{"skip_auto"} //= 0; + $opts{skip_auto} //= 0; my @patches; my $pd = "$dir/debian/patches"; my $auto_patch = $self->get_autopatch_name(); @@ -204,7 +204,7 @@ sub get_patches { foreach my $patch (sort readdir($dir_dh)) { # patches match same rules as run-parts next unless $patch =~ /^[\w-]+$/ and -f "$pd/$patch"; - next if $opts{"skip_auto"} and $patch eq $auto_patch; + next if $opts{skip_auto} and $patch eq $auto_patch; push @patches, $patch; } closedir($dir_dh); @@ -214,17 +214,17 @@ sub get_patches { sub apply_patches { my ($self, $dir, %opts) = @_; - $opts{"skip_auto"} //= 0; + $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"); open(my $applied_fh, '>', $applied) || syserr(_g("cannot write %s"), $applied); - print $applied_fh "# During $opts{'usage'}\n"; + 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"}; + 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, @@ -242,7 +242,7 @@ sub unapply_patches { 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"}; + 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, @@ -263,7 +263,7 @@ sub upstream_tarball_template { sub can_build { my ($self, $dir) = @_; return 1 if $self->find_original_tarballs(include_supplementary => 0); - return 1 if $self->{'options'}{'create_empty_orig'} and + 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"), $self->upstream_tarball_template())); @@ -271,7 +271,7 @@ sub can_build { sub before_build { my ($self, $dir) = @_; - $self->check_patches_applied($dir) if $self->{'options'}{'preparation'}; + $self->check_patches_applied($dir) if $self->{options}{preparation}; } sub after_build { @@ -284,7 +284,7 @@ sub after_build { $reason = <$applied_fh>; close($applied_fh); } - my $opt_unapply = $self->{'options'}{'unapply_patches'}; + my $opt_unapply = $self->{options}{unapply_patches}; if (($opt_unapply eq "auto" and $reason =~ /^# During preparation/) or $opt_unapply eq "yes") { $self->unapply_patches($dir); @@ -293,21 +293,21 @@ sub after_build { sub prepare_build { my ($self, $dir) = @_; - $self->{'diff_options'} = { - diff_ignore_regexp => $self->{'options'}{'diff_ignore_regexp'} . + $self->{diff_options} = { + diff_ignore_regexp => $self->{options}{diff_ignore_regexp} . '|(^|/)debian/patches/.dpkg-source-applied$', - include_removal => $self->{'options'}{'include_removal'}, - include_timestamp => $self->{'options'}{'include_timestamp'}, + include_removal => $self->{options}{include_removal}, + include_timestamp => $self->{options}{include_timestamp}, use_dev_null => 1, }; - 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 + 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." . - $self->{'options'}{'comp_ext'}; + $self->{options}{comp_ext}; my $tar = Dpkg::Source::Archive->new(filename => $filename); $tar->create(); $tar->finish(); @@ -351,9 +351,9 @@ sub generate_patch { error(_g("no upstream tarball found at %s"), $self->upstream_tarball_template()) unless $tarfile; - if ($opts{'usage'} eq "build") { + if ($opts{usage} eq "build") { info(_g("building %s using existing %s"), - $self->{'fields'}{'Source'}, "@origtarballs"); + $self->{fields}{'Source'}, "@origtarballs"); } # Unpack a second copy for comparison @@ -377,8 +377,8 @@ sub generate_patch { 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'); + $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", @@ -387,24 +387,24 @@ sub generate_patch { my $diff = Dpkg::Source::Patch->new(filename => $tmpdiff, compression => "none"); $diff->create(); - if ($opts{'header_from'} and -e $opts{'header_from'}) { + if ($opts{header_from} and -e $opts{header_from}) { my $header_from = Dpkg::Source::Patch->new( - filename => $opts{'header_from'}); + filename => $opts{header_from}); my $analysis = $header_from->analyze($dir, verbose => 0); - $diff->set_header($analysis->{'patchheader'}); + $diff->set_header($analysis->{patchheader}); } else { $diff->set_header($self->get_patch_header($dir)); } $diff->add_diff_directory($tmp, $dir, basedirname => $basedirname, - %{$self->{'diff_options'}}, - handle_binary_func => $opts{'handle_binary'}, - order_from => $opts{'order_from'}); + %{$self->{diff_options}}, + handle_binary_func => $opts{handle_binary}, + order_from => $opts{order_from}); error(_g("unrepresentable changes to source")) if not $diff->finish(); if (-s $tmpdiff) { info(_g("local changes detected, the modified files are:")); my $analysis = $diff->analyze($dir, verbose => 0); - foreach my $fn (sort keys %{$analysis->{'filepatched'}}) { + foreach my $fn (sort keys %{$analysis->{filepatched}}) { print " $fn\n"; } } @@ -419,17 +419,17 @@ sub generate_patch { sub do_build { my ($self, $dir) = @_; - my @argv = @{$self->{'options'}{'ARGV'}}; + my @argv = @{$self->{options}{ARGV}}; if (scalar(@argv)) { usageerr(_g("-b takes only one parameter with format `%s'"), - $self->{'fields'}{'Format'}); + $self->{fields}{'Format'}); } $self->prepare_build($dir); - my $include_binaries = $self->{'options'}{'include_binaries'}; - my @tar_ignore = map { "--exclude=$_" } @{$self->{'options'}{'tar_ignore'}}; + my $include_binaries = $self->{options}{include_binaries}; + my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; - my $sourcepackage = $self->{'fields'}{'Source'}; + my $sourcepackage = $self->{fields}{'Source'}; my $basenamerev = $self->get_basename(1); # Check if the debian directory contains unwanted binary files @@ -450,7 +450,7 @@ sub do_build { 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. @@ -503,9 +503,9 @@ sub do_build { my $tmpdiff = $self->generate_patch($dir, order_from => $autopatch, header_from => $autopatch, handle_binary => $handle_binary, - skip_auto => $self->{'options'}{'auto_commit'}, + skip_auto => $self->{options}{auto_commit}, usage => 'build'); - unless (-z $tmpdiff or $self->{'options'}{'auto_commit'}) { + 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"), @@ -515,7 +515,7 @@ sub do_build { $binaryfiles->update_debian_source_include_binaries() if $include_binaries; # Install the diff as the new autopatch - if ($self->{'options'}{'auto_commit'}) { + if ($self->{options}{auto_commit}) { mkpath(File::Spec->catdir($dir, "debian", "patches")); $autopatch = $self->register_patch($dir, $tmpdiff, $self->get_autopatch_name()); @@ -527,7 +527,7 @@ sub do_build { pop @Dpkg::Exit::handlers; # Create the debian.tar - my $debianfile = "$basenamerev.debian.tar." . $self->{'options'}{'comp_ext'}; + my $debianfile = "$basenamerev.debian.tar." . $self->{options}{comp_ext}; info(_g("building %s in %s"), $sourcepackage, $debianfile); my $tar = Dpkg::Source::Archive->new(filename => $debianfile); $tar->create(options => \@tar_ignore, chdir => $dir); @@ -619,7 +619,7 @@ sub _is_bad_patch_name { sub do_commit { my ($self, $dir) = @_; - my ($patch_name, $tmpdiff) = @{$self->{'options'}{'ARGV'}}; + my ($patch_name, $tmpdiff) = @{$self->{options}{ARGV}}; $self->prepare_build($dir); @@ -689,19 +689,19 @@ sub new { sub new_binary_found { my ($self, $path) = @_; - $self->{'seen_binaries'}{$path} = 1; + $self->{seen_binaries}{$path} = 1; } sub load_allowed_binaries { my ($self) = @_; - my $incbin_file = $self->{'include_binaries_path'}; + my $incbin_file = $self->{include_binaries_path}; if (-f $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 /^$/; - $self->{'allowed_binaries'}{$_} = 1; + $self->{allowed_binaries}{$_} = 1; } close($incbin_fh); } @@ -709,7 +709,7 @@ sub load_allowed_binaries { sub binary_is_allowed { my ($self, $path) = @_; - return 1 if exists $self->{'allowed_binaries'}{$path}; + return 1 if exists $self->{allowed_binaries}{$path}; return 0; } @@ -719,14 +719,14 @@ sub update_debian_source_include_binaries { my @unknown_binaries = $self->get_unknown_binaries(); return unless scalar(@unknown_binaries); - my $incbin_file = $self->{'include_binaries_path'}; - mkpath(File::Spec->catdir($self->{'dir'}, "debian", "source")); + 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); foreach my $binary (@unknown_binaries) { print $incbin_fh "$binary\n"; info(_g("adding %s to %s"), $binary, "debian/source/include-binaries"); - $self->{'allowed_binaries'}{$binary} = 1; + $self->{allowed_binaries}{$binary} = 1; } close($incbin_fh); } @@ -738,7 +738,7 @@ sub get_unknown_binaries { sub get_seen_binaries { my ($self) = @_; - my @seen = sort keys %{$self->{'seen_binaries'}}; + my @seen = sort keys %{$self->{seen_binaries}}; return @seen; } diff --git a/scripts/Dpkg/Source/Package/V3/bzr.pm b/scripts/Dpkg/Source/Package/V3/bzr.pm index bba97fb21..28c9935a8 100644 --- a/scripts/Dpkg/Source/Package/V3/bzr.pm +++ b/scripts/Dpkg/Source/Package/V3/bzr.pm @@ -86,20 +86,20 @@ sub can_build { sub do_build { my ($self, $dir) = @_; - my @argv = @{$self->{'options'}{'ARGV'}}; + my @argv = @{$self->{options}{ARGV}}; # TODO: warn here? - #my @tar_ignore = map { "--exclude=$_" } @{$self->{'options'}{'tar_ignore'}}; - my $diff_ignore_regexp = $self->{'options'}{'diff_ignore_regexp'}; + #my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; + my $diff_ignore_regexp = $self->{options}{diff_ignore_regexp}; $dir =~ s{/+$}{}; # Strip trailing / my ($dirname, $updir) = fileparse($dir); if (scalar(@argv)) { usageerr(_g("-b takes only one parameter with format `%s'"), - $self->{'fields'}{'Format'}); + $self->{fields}{'Format'}); } - my $sourcepackage = $self->{'fields'}{'Source'}; + my $sourcepackage = $self->{fields}{'Source'}; my $basenamerev = $self->get_basename(1); my $basename = $self->get_basename(); my $basedirname = $basename; @@ -149,12 +149,12 @@ sub do_build { "$tardir/.bzr/branch/parent"); # Create the tar file - my $debianfile = "$basenamerev.bzr.tar." . $self->{'options'}{'comp_ext'}; + my $debianfile = "$basenamerev.bzr.tar." . $self->{options}{comp_ext}; info(_g("building %s in %s"), $sourcepackage, $debianfile); my $tar = Dpkg::Source::Archive->new(filename => $debianfile, - compression => $self->{'options'}{'compression'}, - compression_level => $self->{'options'}{'comp_level'}); + compression => $self->{options}{compression}, + compression_level => $self->{options}{comp_level}); $tar->create(chdir => $tmp); $tar->add_directory($dirname); $tar->finish(); @@ -168,9 +168,9 @@ sub do_build { # Called after a tarball is unpacked, to check out the working copy. sub do_extract { my ($self, $newdirectory) = @_; - my $fields = $self->{'fields'}; + my $fields = $self->{fields}; - my $dscdir = $self->{'basedir'}; + my $dscdir = $self->{basedir}; my $basename = $self->get_basename(); my $basenamerev = $self->get_basename(1); diff --git a/scripts/Dpkg/Source/Package/V3/custom.pm b/scripts/Dpkg/Source/Package/V3/custom.pm index e27cdc68a..9ba8d5874 100644 --- a/scripts/Dpkg/Source/Package/V3/custom.pm +++ b/scripts/Dpkg/Source/Package/V3/custom.pm @@ -31,7 +31,7 @@ our $CURRENT_MINOR_VERSION = "0"; sub parse_cmdline_option { my ($self, $opt) = @_; if ($opt =~ /^--target-format=(.*)$/) { - $self->{'options'}{'target_format'} = $1; + $self->{options}{target_format} = $1; return 1; } return 0; @@ -42,18 +42,18 @@ sub do_extract { sub can_build { my ($self, $dir) = @_; - return (scalar(@{$self->{'options'}{'ARGV'}}), + return (scalar(@{$self->{options}{ARGV}}), _g("no files indicated on command line")); } sub do_build { my ($self, $dir) = @_; # Update real target format - my $format = $self->{'options'}{'target_format'}; + my $format = $self->{options}{target_format}; error(_g("--target-format option is missing")) unless $format; - $self->{'fields'}{'Format'} = $format; + $self->{fields}{'Format'} = $format; # Add all files - foreach my $file (@{$self->{'options'}{'ARGV'}}) { + foreach my $file (@{$self->{options}{ARGV}}) { $self->add_file($file); } } diff --git a/scripts/Dpkg/Source/Package/V3/git.pm b/scripts/Dpkg/Source/Package/V3/git.pm index b1e4a0dbc..863576f86 100644 --- a/scripts/Dpkg/Source/Package/V3/git.pm +++ b/scripts/Dpkg/Source/Package/V3/git.pm @@ -76,10 +76,10 @@ sub parse_cmdline_option { my ($self, $opt) = @_; return 1 if $self->SUPER::parse_cmdline_option($opt); if ($opt =~ /^--git-ref=(.*)$/) { - push @{$self->{'options'}{'git_ref'}}, $1; + push @{$self->{options}{git_ref}}, $1; return 1; } elsif ($opt =~ /^--git-depth=(\d+)$/) { - $self->{'options'}{'git_depth'} = $1; + $self->{options}{git_depth} = $1; return 1; } return 0; @@ -92,7 +92,7 @@ sub can_build { sub do_build { my ($self, $dir) = @_; - my $diff_ignore_regexp = $self->{'options'}{'diff_ignore_regexp'}; + my $diff_ignore_regexp = $self->{options}{diff_ignore_regexp}; $dir =~ s{/+$}{}; # Strip trailing / my ($dirname, $updir) = fileparse($dir); @@ -138,7 +138,7 @@ sub do_build { # bundle that. my $tmp; my $shallowfile; - if ($self->{'options'}{'git_depth'}) { + if ($self->{options}{git_depth}) { chdir($old_cwd) || syserr(_g("unable to chdir to `%s'"), $old_cwd); $tmp = tempdir("$dirname.git.XXXXXX", DIR => $updir); @@ -147,8 +147,8 @@ sub do_build { # file:// is needed to avoid local cloning, which does not # create a shallow clone. info(_g("creating shallow clone with depth %s"), - $self->{'options'}{'git_depth'}); - system("git", "clone", "--depth=" . $self->{'options'}{'git_depth'}, + $self->{options}{git_depth}); + system("git", "clone", "--depth=" . $self->{options}{git_depth}, "--quiet", "--bare", "file://" . abs_path($dir), $clone_dir); $? && subprocerr("git clone"); chdir($clone_dir) || @@ -160,8 +160,8 @@ sub do_build { # Create the git bundle. my $bundlefile = "$basenamerev.git"; - my @bundle_arg = $self->{'options'}{'git_ref'} ? - (@{$self->{'options'}{'git_ref'}}) : "--all"; + 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, @@ -186,9 +186,9 @@ sub do_build { sub do_extract { my ($self, $newdirectory) = @_; - my $fields = $self->{'fields'}; + my $fields = $self->{fields}; - my $dscdir = $self->{'basedir'}; + my $dscdir = $self->{basedir}; my $basenamerev = $self->get_basename(1); my @files = $self->get_files(); diff --git a/scripts/Dpkg/Source/Package/V3/native.pm b/scripts/Dpkg/Source/Package/V3/native.pm index de0b43c5f..726bc3905 100644 --- a/scripts/Dpkg/Source/Package/V3/native.pm +++ b/scripts/Dpkg/Source/Package/V3/native.pm @@ -38,10 +38,10 @@ our $CURRENT_MINOR_VERSION = "0"; sub do_extract { my ($self, $newdirectory) = @_; - my $sourcestyle = $self->{'options'}{'sourcestyle'}; - my $fields = $self->{'fields'}; + my $sourcestyle = $self->{options}{sourcestyle}; + my $fields = $self->{fields}; - my $dscdir = $self->{'basedir'}; + my $dscdir = $self->{basedir}; my $basename = $self->get_basename(); my $basenamerev = $self->get_basename(1); @@ -69,17 +69,17 @@ sub can_build { sub do_build { my ($self, $dir) = @_; - my @tar_ignore = map { "--exclude=$_" } @{$self->{'options'}{'tar_ignore'}}; - my @argv = @{$self->{'options'}{'ARGV'}}; + my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; + my @argv = @{$self->{options}{ARGV}}; if (scalar(@argv)) { usageerr(_g("-b takes only one parameter with format `%s'"), - $self->{'fields'}{'Format'}); + $self->{fields}{'Format'}); } - my $sourcepackage = $self->{'fields'}{'Source'}; + my $sourcepackage = $self->{fields}{'Source'}; my $basenamerev = $self->get_basename(1); - my $tarname = "$basenamerev.tar." . $self->{'options'}{'comp_ext'}; + my $tarname = "$basenamerev.tar." . $self->{options}{comp_ext}; info(_g("building %s in %s"), $sourcepackage, $tarname); @@ -90,7 +90,7 @@ sub do_build { my ($dirname, $dirbase) = fileparse($dir); my $tar = Dpkg::Source::Archive->new(filename => $newtar, compression => compression_guess_from_filename($tarname), - compression_level => $self->{'options'}{'comp_level'}); + compression_level => $self->{options}{comp_level}); $tar->create(options => \@tar_ignore, chdir => $dirbase); $tar->add_directory($dirname); $tar->finish(); diff --git a/scripts/Dpkg/Source/Package/V3/quilt.pm b/scripts/Dpkg/Source/Package/V3/quilt.pm index dee4c1760..7ebee244f 100644 --- a/scripts/Dpkg/Source/Package/V3/quilt.pm +++ b/scripts/Dpkg/Source/Package/V3/quilt.pm @@ -38,10 +38,10 @@ our $CURRENT_MINOR_VERSION = "0"; sub init_options { my ($self) = @_; - $self->{'options'}{'single_debian_patch'} = 0 - unless exists $self->{'options'}{'single_debian_patch'}; - $self->{'options'}{'allow_version_of_quilt_db'} = [] - unless exists $self->{'options'}{'allow_version_of_quilt_db'}; + $self->{options}{single_debian_patch} = 0 + unless exists $self->{options}{single_debian_patch}; + $self->{options}{allow_version_of_quilt_db} = [] + unless exists $self->{options}{allow_version_of_quilt_db}; $self->SUPER::init_options(); } @@ -50,12 +50,12 @@ sub parse_cmdline_option { my ($self, $opt) = @_; return 1 if $self->SUPER::parse_cmdline_option($opt); if ($opt =~ /^--single-debian-patch$/) { - $self->{'options'}{'single_debian_patch'} = 1; + $self->{options}{single_debian_patch} = 1; # For backwards compatibility. - $self->{'options'}{'auto_commit'} = 1; + $self->{options}{auto_commit} = 1; return 1; } elsif ($opt =~ /^--allow-version-of-quilt-db=(.*)$/) { - push @{$self->{'options'}{'allow_version_of_quilt_db'}}, $1; + push @{$self->{options}{allow_version_of_quilt_db}}, $1; return 1; } return 0; @@ -63,9 +63,9 @@ sub parse_cmdline_option { sub build_quilt_object { my ($self, $dir) = @_; - return $self->{'quilt'}{$dir} if exists $self->{'quilt'}{$dir}; - $self->{'quilt'}{$dir} = Dpkg::Source::Quilt->new($dir); - return $self->{'quilt'}{$dir}; + return $self->{quilt}{$dir} if exists $self->{quilt}{$dir}; + $self->{quilt}{$dir} = Dpkg::Source::Quilt->new($dir); + return $self->{quilt}{$dir}; } sub can_build { @@ -80,25 +80,25 @@ sub can_build { sub get_autopatch_name { my ($self) = @_; - if ($self->{'options'}{'single_debian_patch'}) { + if ($self->{options}{single_debian_patch}) { return "debian-changes"; } else { - return "debian-changes-" . $self->{'fields'}{'Version'}; + return "debian-changes-" . $self->{fields}{'Version'}; } } sub apply_patches { my ($self, $dir, %opts) = @_; - if ($opts{'usage'} eq 'unpack') { - $opts{'verbose'} = 1; - } elsif ($opts{'usage'} eq 'build') { - $opts{'warn_options'} = 1; - $opts{'verbose'} = 0; + if ($opts{usage} eq 'unpack') { + $opts{verbose} = 1; + } elsif ($opts{usage} eq 'build') { + $opts{warn_options} = 1; + $opts{verbose} = 0; } my $quilt = $self->build_quilt_object($dir); - $quilt->load_series(%opts) if $opts{'warn_options'}; # Trigger warnings + $quilt->load_series(%opts) if $opts{warn_options}; # Trigger warnings # Always create the quilt db so that if the maintainer calls quilt to # create a patch, it's stored in the right directory @@ -118,8 +118,8 @@ sub apply_patches { return unless scalar($quilt->series()); - if ($opts{'usage'} eq "preparation" and - $self->{'options'}{'unapply_patches'} eq 'auto') { + 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"); @@ -130,8 +130,8 @@ sub apply_patches { # Apply patches my $pc_applied = $quilt->get_db_file("applied-patches"); - $opts{"timestamp"} = fs_time($pc_applied); - if ($opts{"skip_auto"}) { + $opts{timestamp} = fs_time($pc_applied); + if ($opts{skip_auto}) { my $auto_patch = $self->get_autopatch_name(); $quilt->push(%opts) while ($quilt->next() and $quilt->next() ne $auto_patch); } else { @@ -144,11 +144,11 @@ sub unapply_patches { my $quilt = $self->build_quilt_object($dir); - $opts{'verbose'} //= 1; + $opts{verbose} //= 1; my $pc_applied = $quilt->get_db_file("applied-patches"); my @applied = $quilt->applied(); - $opts{"timestamp"} = fs_time($pc_applied) if @applied; + $opts{timestamp} = fs_time($pc_applied) if @applied; $quilt->pop(%opts) while $quilt->top(); @@ -164,10 +164,10 @@ sub prepare_build { my $func = sub { return 1 if $_[0] =~ m{^debian/patches/series$} and -l $_[0]; return 1 if $_[0] =~ /^\.pc(\/|$)/; - return 1 if $_[0] =~ /$self->{'options'}{'diff_ignore_regexp'}/; + return 1 if $_[0] =~ /$self->{options}{diff_ignore_regexp}/; return 0; }; - $self->{'diff_options'}{'diff_ignore_func'} = $func; + $self->{diff_options}{diff_ignore_func} = $func; } sub do_build { @@ -178,7 +178,7 @@ sub do_build { if (defined($version) and $version != 2) { if (scalar grep { $version eq $_ } - @{$self->{'options'}{'allow_version_of_quilt_db'}}) + @{$self->{options}{allow_version_of_quilt_db}}) { warning(_g("unsupported version of the quilt metadata: %s"), $version); } else { @@ -193,7 +193,7 @@ sub after_build { my ($self, $dir) = @_; my $quilt = $self->build_quilt_object($dir); my $pc_unapply = $quilt->get_db_file(".dpkg-source-unapply"); - my $opt_unapply = $self->{'options'}{'unapply_patches'}; + my $opt_unapply = $self->{options}{unapply_patches}; if (($opt_unapply eq "auto" and -e $pc_unapply) or $opt_unapply eq "yes") { unlink($pc_unapply); $self->unapply_patches($dir); diff --git a/scripts/Dpkg/Source/Patch.pm b/scripts/Dpkg/Source/Patch.pm index a43983bb5..97bdc788b 100644 --- a/scripts/Dpkg/Source/Patch.pm +++ b/scripts/Dpkg/Source/Patch.pm @@ -41,31 +41,31 @@ use base 'Dpkg::Compression::FileHandle'; sub create { my ($self, %opts) = @_; $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'}; - 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'}) { - $self->add_diff_file($opts{'old'}, $opts{'new'}, %opts); + *$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}; + 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}) { + $self->add_diff_file($opts{old}, $opts{new}, %opts); } else { - $self->_fail_not_same_type($opts{'old'}, $opts{'new'}); + $self->_fail_not_same_type($opts{old}, $opts{new}); } - $self->finish() unless $opts{"nofinish"}; + $self->finish() unless $opts{nofinish}; } } sub set_header { my ($self, $header) = @_; - *$self->{'header'} = $header; + *$self->{header} = $header; } sub add_diff_file { my ($self, $old, $new, %opts) = @_; - $opts{"include_timestamp"} = 0 unless exists $opts{"include_timestamp"}; - my $handle_binary = $opts{"handle_binary_func"} || sub { + $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")); }; @@ -73,29 +73,29 @@ sub add_diff_file { return 1 if compare($old, $new, 4096) == 0; # Default diff options my @options; - if ($opts{"options"}) { - push @options, @{$opts{"options"}}; + if ($opts{options}) { + push @options, @{$opts{options}}; } else { push @options, '-p'; } # Add labels - if ($opts{"label_old"} and $opts{"label_new"}) { - if ($opts{"include_timestamp"}) { + 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)); - $opts{"label_old"} .= sprintf("\t%s.%09d +0000", $t, + $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)); - $opts{"label_new"} .= sprintf("\t%s.%09d +0000", $t, + $opts{label_new} .= sprintf("\t%s.%09d +0000", $t, ($ts-int($ts))*1000000000); } else { # Space in filenames need special treatment - $opts{"label_old"} .= "\t" if $opts{"label_old"} =~ / /; - $opts{"label_new"} .= "\t" if $opts{"label_new"} =~ / /; + $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; @@ -121,9 +121,9 @@ sub add_diff_file { 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->{'empty'} = 0; + if (*$self->{empty} and defined(*$self->{header})) { + $self->print(*$self->{header}) or syserr(_g("failed to write")); + *$self->{empty} = 0; } print $self $_ || syserr(_g("failed to write")); } @@ -144,13 +144,13 @@ sub add_diff_directory { my ($self, $old, $new, %opts) = @_; # TODO: make this function more configurable # - offer to disable some checks - my $basedir = $opts{"basedirname"} || basename($new); - my $inc_removal = $opts{"include_removal"} || 0; + my $basedir = $opts{basedirname} || basename($new); + my $inc_removal = $opts{include_removal} || 0; my $diff_ignore; - if ($opts{"diff_ignore_func"}) { - $diff_ignore = $opts{"diff_ignore_func"}; - } elsif ($opts{"diff_ignore_regexp"}) { - $diff_ignore = sub { return $_[0] =~ /$opts{"diff_ignore_regexp"}/o }; + if ($opts{diff_ignore_func}) { + $diff_ignore = $opts{diff_ignore_func}; + } elsif ($opts{diff_ignore_regexp}) { + $diff_ignore = sub { return $_[0] =~ /$opts{diff_ignore_regexp}/o }; } else { $diff_ignore = sub { return 0 }; } @@ -188,7 +188,7 @@ sub add_diff_directory { } my $label_old = "$basedir.orig/$fn"; - if ($opts{'use_dev_null'}) { + if ($opts{use_dev_null}) { $label_old = $old_file if $old_file eq '/dev/null'; } push @diff_files, [$fn, $mode, $size, $old_file, "$new/$fn", @@ -235,13 +235,13 @@ sub add_diff_directory { find({ wanted => $scan_new, no_chdir => 1 }, $new); find({ wanted => $scan_old, no_chdir => 1 }, $old); - if ($opts{"order_from"} and -e $opts{"order_from"}) { + if ($opts{order_from} and -e $opts{order_from}) { my $order_from = Dpkg::Source::Patch->new( - filename => $opts{"order_from"}); + filename => $opts{order_from}); my $analysis = $order_from->analyze($basedir, verbose => 0); my %patchorder; my $i = 0; - foreach my $fn (@{$analysis->{"patchorder"}}) { + foreach my $fn (@{$analysis->{patchorder}}) { $fn =~ s{^[^/]+/}{}; $patchorder{$fn} = $i++; } @@ -288,12 +288,12 @@ sub add_diff_directory { sub finish { my ($self) = @_; close($self) || syserr(_g("cannot close %s"), $self->get_filename()); - return not *$self->{'errors'}; + return not *$self->{errors}; } sub register_error { my ($self) = @_; - *$self->{'errors'}++; + *$self->{errors}++; } sub _fail_with_msg { my ($self, $file, $msg) = @_; @@ -371,7 +371,7 @@ sub _intuit_file_patched { sub analyze { my ($self, $destdir, %opts) = @_; - $opts{"verbose"} //= 1; + $opts{verbose} //= 1; my $diff = $self->get_filename(); my %filepatched; my %dirtocreate; @@ -398,8 +398,8 @@ sub analyze { unless(s/^--- //) { error(_g("expected ^--- in line %d of diff `%s'"), $., $diff); } - $path{'old'} = $_ = _strip_ts($_); - $fn{'old'} = $_ if $_ ne '/dev/null' and s{^[^/]*/+}{$destdir/}; + $path{old} = $_ = _strip_ts($_); + $fn{old} = $_ if $_ ne '/dev/null' and s{^[^/]*/+}{$destdir/}; if (/\.dpkg-orig$/) { error(_g("diff `%s' patches file with name ending .dpkg-orig"), $diff); } @@ -410,10 +410,10 @@ sub analyze { unless (s/^\+\+\+ //) { error(_g("line after --- isn't as expected in diff `%s' (line %d)"), $diff, $.); } - $path{'new'} = $_ = _strip_ts($_); - $fn{'new'} = $_ if $_ ne '/dev/null' and s{^[^/]*/+}{$destdir/}; + $path{new} = $_ = _strip_ts($_); + $fn{new} = $_ if $_ ne '/dev/null' and s{^[^/]*/+}{$destdir/}; - unless (defined $fn{'old'} or defined $fn{'new'}) { + unless (defined $fn{old} or defined $fn{new}) { error(_g("none of the filenames in ---/+++ are valid in diff '%s' (line %d)"), $diff, $.); } @@ -435,18 +435,18 @@ sub analyze { } } - if ($path{'old'} eq '/dev/null' and $path{'new'} eq '/dev/null') { + if ($path{old} eq '/dev/null' and $path{new} eq '/dev/null') { error(_g("original and modified files are /dev/null in diff `%s' (line %d)"), $diff, $.); - } elsif ($path{'new'} eq '/dev/null') { + } elsif ($path{new} eq '/dev/null') { error(_g("file removal without proper filename in diff `%s' (line %d)"), - $diff, $. - 1) unless defined $fn{'old'}; - if ($opts{"verbose"}) { + $diff, $. - 1) unless defined $fn{old}; + if ($opts{verbose}) { warning(_g("diff %s removes a non-existing file %s (line %d)"), - $diff, $fn{'old'}, $.) unless -e $fn{'old'}; + $diff, $fn{old}, $.) unless -e $fn{old}; } } - my $fn = _intuit_file_patched($fn{'old'}, $fn{'new'}); + my $fn = _intuit_file_patched($fn{old}, $fn{new}); my $dirname = $fn; if ($dirname =~ s{/[^/]+$}{} && not -d $dirname) { @@ -459,7 +459,7 @@ sub analyze { if ($filepatched{$fn}) { warning(_g("diff `%s' patches file %s twice"), $diff, $fn) - if $opts{"verbose"}; + if $opts{verbose}; } else { $filepatched{$fn} = 1; push @patchorder, $fn; @@ -477,7 +477,7 @@ sub analyze { unless (defined($_ = _getline($self))) { if (($olines == $nlines) and ($olines < 3)) { warning(_g("unexpected end of diff `%s'"), $diff) - if $opts{"verbose"}; + if $opts{verbose}; last; } else { error(_g("unexpected end of diff `%s'"), $diff); @@ -502,19 +502,19 @@ sub analyze { close($self); unless ($diff_count) { warning(_g("diff `%s' doesn't contain any patch"), $diff) - if $opts{"verbose"}; + if $opts{verbose}; } - *$self->{'analysis'}{$destdir}{"dirtocreate"} = \%dirtocreate; - *$self->{'analysis'}{$destdir}{"filepatched"} = \%filepatched; - *$self->{'analysis'}{$destdir}{"patchorder"} = \@patchorder; - *$self->{'analysis'}{$destdir}{"patchheader"} = $patch_header; - return *$self->{'analysis'}{$destdir}; + *$self->{analysis}{$destdir}{dirtocreate} = \%dirtocreate; + *$self->{analysis}{$destdir}{filepatched} = \%filepatched; + *$self->{analysis}{$destdir}{patchorder} = \@patchorder; + *$self->{analysis}{$destdir}{patchheader} = $patch_header; + return *$self->{analysis}{$destdir}; } sub prepare_apply { my ($self, $analysis, %opts) = @_; - if ($opts{"create_dirs"}) { - foreach my $dir (keys %{$analysis->{'dirtocreate'}}) { + if ($opts{create_dirs}) { + foreach my $dir (keys %{$analysis->{dirtocreate}}) { eval { mkpath($dir, 0, 0777); }; syserr(_g("cannot create directory %s"), $dir) if $@; } @@ -524,13 +524,13 @@ sub prepare_apply { sub apply { my ($self, $destdir, %opts) = @_; # Set default values to options - $opts{"force_timestamp"} = 1 unless exists $opts{"force_timestamp"}; - $opts{"remove_backup"} = 1 unless exists $opts{"remove_backup"}; - $opts{"create_dirs"} = 1 unless exists $opts{"create_dirs"}; - $opts{"options"} ||= [ '-t', '-F', '0', '-N', '-p1', '-u', + $opts{force_timestamp} = 1 unless exists $opts{force_timestamp}; + $opts{remove_backup} = 1 unless exists $opts{remove_backup}; + $opts{create_dirs} = 1 unless exists $opts{create_dirs}; + $opts{options} ||= [ '-t', '-F', '0', '-N', '-p1', '-u', '-V', 'never', '-g0', '-b', '-z', '.dpkg-orig']; - $opts{"add_options"} ||= []; - push @{$opts{"options"}}, @{$opts{"add_options"}}; + $opts{add_options} ||= []; + push @{$opts{options}}, @{$opts{add_options}}; # Check the diff and create missing directories my $analysis = $self->analyze($destdir, %opts); $self->prepare_apply($analysis, %opts); @@ -538,7 +538,7 @@ sub apply { $self->ensure_open("r"); my ($stdout, $stderr) = ('', ''); spawn( - exec => [ 'patch', @{$opts{"options"}} ], + exec => [ 'patch', @{$opts{options}} ], chdir => $destdir, env => { LC_ALL => 'C', LANG => 'C' }, delete_env => [ 'POSIXLY_CORRECT' ], # ensure expected patch behaviour @@ -551,21 +551,21 @@ sub apply { if ($?) { print STDOUT $stdout; print STDERR $stderr; - subprocerr("LC_ALL=C patch " . join(" ", @{$opts{"options"}}) . + subprocerr("LC_ALL=C patch " . join(" ", @{$opts{options}}) . " < " . $self->get_filename()); } $self->close(); # Reset the timestamp of all the patched files # and remove .dpkg-orig files - my @files = keys %{$analysis->{'filepatched'}}; - my $now = $opts{"timestamp"}; - $now ||= fs_time($files[0]) if $opts{"force_timestamp"} and scalar @files; + my @files = keys %{$analysis->{filepatched}}; + my $now = $opts{timestamp}; + $now ||= fs_time($files[0]) if $opts{force_timestamp} and scalar @files; foreach my $fn (@files) { - if ($opts{"force_timestamp"}) { + if ($opts{force_timestamp}) { utime($now, $now, $fn) || $! == ENOENT || syserr(_g("cannot change timestamp for %s"), $fn); } - if ($opts{"remove_backup"}) { + if ($opts{remove_backup}) { $fn .= ".dpkg-orig"; unlink($fn) || syserr(_g("remove patch backup file %s"), $fn); } @@ -577,11 +577,11 @@ sub apply { sub check_apply { my ($self, $destdir, %opts) = @_; # Set default values to options - $opts{"create_dirs"} = 1 unless exists $opts{"create_dirs"}; - $opts{"options"} ||= [ '--dry-run', '-s', '-t', '-F', '0', '-N', '-p1', '-u', + $opts{create_dirs} = 1 unless exists $opts{create_dirs}; + $opts{options} ||= [ '--dry-run', '-s', '-t', '-F', '0', '-N', '-p1', '-u', '-V', 'never', '-g0', '-b', '-z', '.dpkg-orig']; - $opts{"add_options"} ||= []; - push @{$opts{"options"}}, @{$opts{"add_options"}}; + $opts{add_options} ||= []; + push @{$opts{options}}, @{$opts{add_options}}; # Check the diff and create missing directories my $analysis = $self->analyze($destdir, %opts); $self->prepare_apply($analysis, %opts); @@ -589,7 +589,7 @@ sub check_apply { $self->ensure_open("r"); my $error; my $patch_pid = spawn( - exec => [ 'patch', @{$opts{"options"}} ], + exec => [ 'patch', @{$opts{options}} ], chdir => $destdir, env => { LC_ALL => 'C', LANG => 'C' }, delete_env => [ 'POSIXLY_CORRECT' ], # ensure expected patch behaviour diff --git a/scripts/Dpkg/Source/Quilt.pm b/scripts/Dpkg/Source/Quilt.pm index 2edb14824..9c7c949ea 100644 --- a/scripts/Dpkg/Source/Quilt.pm +++ b/scripts/Dpkg/Source/Quilt.pm @@ -82,7 +82,7 @@ sub load_db { my ($self) = @_; my $pc_applied = $self->get_db_file("applied-patches"); - $self->{'applied_patches'} = [ $self->read_patch_list($pc_applied) ]; + $self->{applied_patches} = [ $self->read_patch_list($pc_applied) ]; } sub write_db { @@ -92,7 +92,7 @@ sub write_db { 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'}}) { + foreach my $patch (@{$self->{applied_patches}}) { print $applied_fh "$patch\n"; } close($applied_fh); @@ -102,38 +102,38 @@ sub load_series { my ($self, %opts) = @_; my $series = $self->get_series_file(); - $self->{'series'} = [ $self->read_patch_list($series, %opts) ]; + $self->{series} = [ $self->read_patch_list($series, %opts) ]; } sub series { my ($self) = @_; - return @{$self->{'series'}}; + return @{$self->{series}}; } sub applied { my ($self) = @_; - return @{$self->{'applied_patches'}}; + return @{$self->{applied_patches}}; } sub top { my ($self) = @_; - my $count = scalar @{$self->{'applied_patches'}}; - return $self->{'applied_patches'}[$count - 1] if $count; + my $count = scalar @{$self->{applied_patches}}; + return $self->{applied_patches}[$count - 1] if $count; return; } sub next { my ($self) = @_; - my $count_applied = scalar @{$self->{'applied_patches'}}; - my $count_series = scalar @{$self->{'series'}}; - return $self->{'series'}[$count_applied] if ($count_series > $count_applied); + my $count_applied = scalar @{$self->{applied_patches}}; + my $count_series = scalar @{$self->{series}}; + return $self->{series}[$count_applied] if ($count_series > $count_applied); return; } sub push { my ($self, %opts) = @_; - $opts{"verbose"} //= 0; - $opts{"timestamp"} //= fs_time($self->{'dir'}); + $opts{verbose} //= 0; + $opts{timestamp} //= fs_time($self->{dir}); my $patch = $self->next(); return unless defined $patch; @@ -141,10 +141,10 @@ 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"}, + $obj->apply($self->{dir}, timestamp => $opts{timestamp}, + verbose => $opts{verbose}, force_timestamp => 1, create_dirs => 1, remove_backup => 0, options => [ '-t', '-F', '0', '-N', '-p1', '-u', '-V', 'never', '-g0', '-E', '-b', @@ -158,22 +158,22 @@ sub push { erasedir($self->get_db_file($patch)); die $@; } - CORE::push @{$self->{'applied_patches'}}, $patch; + CORE::push @{$self->{applied_patches}}, $patch; $self->write_db(); } sub pop { my ($self, %opts) = @_; - $opts{"verbose"} //= 0; - $opts{"timestamp"} //= fs_time($self->{'dir'}); - $opts{"reverse_apply"} //= 0; + $opts{verbose} //= 0; + $opts{timestamp} //= fs_time($self->{dir}); + $opts{reverse_apply} //= 0; 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"}) { + if (-d $backup_dir and not $opts{reverse_apply}) { # Use the backup copies to restore $self->restore_quilt_backup_files($patch); } else { @@ -181,7 +181,7 @@ sub pop { my $path = $self->get_patch_file($patch); my $obj = Dpkg::Source::Patch->new(filename => $path); - $obj->apply($self->{'dir'}, timestamp => $opts{"timestamp"}, + $obj->apply($self->{dir}, timestamp => $opts{timestamp}, verbose => 0, force_timestamp => 1, remove_backup => 0, options => [ '-R', '-t', '-N', '-p1', '-u', '-V', 'never', '-g0', '-E', @@ -189,7 +189,7 @@ sub pop { } erasedir($backup_dir); - pop @{$self->{'applied_patches'}}; + pop @{$self->{applied_patches}}; $self->write_db(); } @@ -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 { @@ -254,7 +254,7 @@ sub get_patch_dir { sub read_patch_list { my ($self, $file, %opts) = @_; return () if not defined $file or not -f $file; - $opts{"warn_options"} //= 0; + $opts{warn_options} //= 0; my @patches; open(my $series_fh, "<" , $file) || syserr(_g("cannot read %s"), $file); while (defined($_ = <$series_fh>)) { @@ -267,7 +267,7 @@ sub read_patch_list { warning(_g("the series file (%s) contains unsupported " . "options ('%s', line %s); dpkg-source might " . "fail when applying patches"), - $file, $2, $.) if $opts{"warn_options"}; + $file, $2, $.) if $opts{warn_options}; } } error(_g("%s contains an insecure path: %s"), $file, $_) if m{(^|/)\.\./}; @@ -281,13 +281,13 @@ 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 { return if -d $_; my $relpath_in_srcpkg = File::Spec->abs2rel($_, $patch_dir); - my $target = File::Spec->catfile($self->{'dir'}, $relpath_in_srcpkg); + my $target = File::Spec->catfile($self->{dir}, $relpath_in_srcpkg); if (-s $_) { unlink($target); make_path(dirname($target)); diff --git a/scripts/Dpkg/Substvars.pm b/scripts/Dpkg/Substvars.pm index d01f66320..ee775569d 100644 --- a/scripts/Dpkg/Substvars.pm +++ b/scripts/Dpkg/Substvars.pm @@ -76,9 +76,9 @@ sub new { used => {}, msg_prefix => "", }; - $self->{'vars'}{'dpkg:Upstream-Version'} =~ s/-[^-]+$//; + $self->{vars}{'dpkg:Upstream-Version'} =~ s/-[^-]+$//; bless $self, $class; - $self->mark_as_used($_) foreach keys %{$self->{'vars'}}; + $self->mark_as_used($_) foreach keys %{$self->{vars}}; if ($arg) { $self->load($arg) if -e $arg; } @@ -93,7 +93,7 @@ Add/replace a substitution. sub set { my ($self, $key, $value) = @_; - $self->{'vars'}{$key} = $value; + $self->{vars}{$key} = $value; } =item $s->set_as_used($key, $value) @@ -117,7 +117,7 @@ Get the value of a given substitution. sub get { my ($self, $key) = @_; - return $self->{'vars'}{$key}; + return $self->{vars}{$key}; } =item $s->delete($key) @@ -128,8 +128,8 @@ Remove a given substitution. sub delete { my ($self, $key) = @_; - delete $self->{'used'}{$key}; - return delete $self->{'vars'}{$key}; + delete $self->{used}{$key}; + return delete $self->{vars}{$key}; } =item $s->mark_as_used($key) @@ -141,7 +141,7 @@ default. sub mark_as_used { my ($self, $key) = @_; - $self->{'used'}{$key}++; + $self->{used}{$key}++; } =item $s->no_warn($key) @@ -176,7 +176,7 @@ sub parse { m/^(\w[-:0-9A-Za-z]*)\=(.*)$/ || error(_g("bad line in substvars file %s at line %d"), $varlistfile, $.); - $self->{'vars'}{$1} = $2; + $self->{vars}{$1} = $2; } } @@ -199,13 +199,13 @@ sub set_version_substvars { # field on the changelog, always fix up the source version. $sourceversion =~ s/\+b[0-9]+$//; - $self->{'vars'}{'binary:Version'} = $binaryversion; - $self->{'vars'}{'source:Version'} = $sourceversion; - $self->{'vars'}{'source:Upstream-Version'} = $sourceversion; - $self->{'vars'}{'source:Upstream-Version'} =~ s/-[^-]*$//; + $self->{vars}{'binary:Version'} = $binaryversion; + $self->{vars}{'source:Version'} = $sourceversion; + $self->{vars}{'source:Upstream-Version'} = $sourceversion; + $self->{vars}{'source:Upstream-Version'} =~ s/-[^-]*$//; # XXX: Source-Version is now deprecated, remove in the future. - $self->{'vars'}{'Source-Version'} = $binaryversion; + $self->{vars}{'Source-Version'} = $binaryversion; $self->mark_as_used($_) foreach qw/binary:Version source:Version source:Upstream-Version Source-Version/; } @@ -248,8 +248,8 @@ sub substvars { error($opts{msg_prefix} . _g("too many substitutions - recursive ? - in \`%s'"), $v); $lhs = $1; $vn = $2; $rhs = $3; - if (defined($self->{'vars'}{$vn})) { - $v = $lhs . $self->{'vars'}{$vn} . $rhs; + if (defined($self->{vars}{$vn})) { + $v = $lhs . $self->{vars}{$vn} . $rhs; $self->mark_as_used($vn); $count++; } else { @@ -271,12 +271,12 @@ sub warn_about_unused { my ($self, %opts) = @_; $opts{msg_prefix} = $self->{msg_prefix} unless exists $opts{msg_prefix}; - foreach my $vn (keys %{$self->{'vars'}}) { - next if $self->{'used'}{$vn}; + foreach my $vn (keys %{$self->{vars}}) { + next if $self->{used}{$vn}; # 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 ""; + next if $self->{vars}{$vn} eq ""; warning($opts{msg_prefix} . _g("unused substitution variable \${%s}"), $vn); } } @@ -314,7 +314,7 @@ sub output { my ($self, $fh) = @_; my $str = ""; # Store all non-automatic substitutions only - foreach my $vn (sort keys %{$self->{'vars'}}) { + foreach my $vn (sort keys %{$self->{vars}}) { next if /^(?:(?:dpkg|source|binary):(?:Source-)?Version|Space|Tab|Newline|Arch|Source-Version|F:.+)$/; my $line = "$vn=" . $self->{vars}{$vn} . "\n"; print $fh $line if defined $fh; diff --git a/scripts/Dpkg/Vendor/Debian.pm b/scripts/Dpkg/Vendor/Debian.pm index a26e809fa..3e4b8cb2c 100644 --- a/scripts/Dpkg/Vendor/Debian.pm +++ b/scripts/Dpkg/Vendor/Debian.pm @@ -120,64 +120,64 @@ sub add_hardening_flags { # Disabled on non-linux/knetbsd/hurd (see #430455 and #586215). # Disabled on hppa, mips/mipsel (#532821), avr32 # (#574716). - $use_feature{"pie"} = 0; + $use_feature{pie} = 0; } 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). # compiler supports it incorrectly (leads to SEGV) - $use_feature{"stackprotector"} = 0; + $use_feature{stackprotector} = 0; } if ($cpu =~ /^(ia64|hppa|avr32)$/) { # relro not implemented on ia64, hppa, avr32. - $use_feature{"relro"} = 0; + $use_feature{relro} = 0; } # Mask features that might be influenced by other flags. - if ($flags->{'build_options'}->has('noopt')) { + if ($flags->{build_options}->has('noopt')) { # glibc 2.16 and later warn when using -O0 and _FORTIFY_SOURCE. - $use_feature{'fortify'} = 0; + $use_feature{fortify} = 0; } # Handle logical feature interactions. - if ($use_feature{"relro"} == 0) { + if ($use_feature{relro} == 0) { # Disable bindnow if relro is not enabled, since it has no # hardening ability without relro and may incur load penalties. - $use_feature{"bindnow"} = 0; + $use_feature{bindnow} = 0; } # PIE - if ($use_feature{"pie"}) { + if ($use_feature{pie}) { $flags->append("CFLAGS", "-fPIE"); $flags->append("CXXFLAGS", "-fPIE"); $flags->append("LDFLAGS", "-fPIE -pie"); } # Stack protector - if ($use_feature{"stackprotector"}) { + if ($use_feature{stackprotector}) { $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"}) { + if ($use_feature{fortify}) { $flags->append("CPPFLAGS", "-D_FORTIFY_SOURCE=2"); } # Format Security - if ($use_feature{"format"}) { + if ($use_feature{format}) { $flags->append("CFLAGS", "-Wformat -Werror=format-security"); $flags->append("CXXFLAGS", "-Wformat -Werror=format-security"); } # Read-only Relocations - if ($use_feature{"relro"}) { + if ($use_feature{relro}) { $flags->append("LDFLAGS", "-Wl,-z,relro"); } # Bindnow - if ($use_feature{"bindnow"}) { + if ($use_feature{bindnow}) { $flags->append("LDFLAGS", "-Wl,-z,now"); } diff --git a/scripts/Dpkg/Vendor/Ubuntu.pm b/scripts/Dpkg/Vendor/Ubuntu.pm index 2c878c975..309078033 100644 --- a/scripts/Dpkg/Vendor/Ubuntu.pm +++ b/scripts/Dpkg/Vendor/Ubuntu.pm @@ -51,14 +51,14 @@ sub run_hook { if ($hook eq "before-source-build") { my $src = shift @params; - my $fields = $src->{'fields'}; + my $fields = $src->{fields}; # check that Maintainer/XSBC-Original-Maintainer comply to # https://wiki.ubuntu.com/DebianMaintainerField if (defined($fields->{'Version'}) and defined($fields->{'Maintainer'}) and $fields->{'Version'} =~ /ubuntu/) { if ($fields->{'Maintainer'} !~ /ubuntu/i) { - if (defined ($ENV{'DEBEMAIL'}) and $ENV{'DEBEMAIL'} =~ /\@ubuntu\.com/) { + if (defined ($ENV{DEBEMAIL}) and $ENV{DEBEMAIL} =~ /\@ubuntu\.com/) { error(_g('Version number suggests Ubuntu changes, but Maintainer: does not have Ubuntu address')); } else { warning(_g('Version number suggests Ubuntu changes, but Maintainer: does not have Ubuntu address')); diff --git a/scripts/Dpkg/Version.pm b/scripts/Dpkg/Version.pm index 2957404b5..420c12fd1 100644 --- a/scripts/Dpkg/Version.pm +++ b/scripts/Dpkg/Version.pm @@ -83,25 +83,25 @@ sub new { my $class = ref($this) || $this; $ver = "$ver" if ref($ver); # Try to stringify objects - if ($opts{'check'}) { + if ($opts{check}) { return unless version_check($ver); } my $self = {}; if ($ver =~ /^([^:]*):(.+)$/) { - $self->{'epoch'} = $1; + $self->{epoch} = $1; $ver = $2; } else { - $self->{'epoch'} = 0; - $self->{'no_epoch'} = 1; + $self->{epoch} = 0; + $self->{no_epoch} = 1; } if ($ver =~ /(.*)-(.*)$/) { - $self->{'version'} = $1; - $self->{'revision'} = $2; + $self->{version} = $1; + $self->{revision} = $2; } else { - $self->{'version'} = $ver; - $self->{'revision'} = 0; - $self->{'no_revision'} = 1; + $self->{version} = $ver; + $self->{revision} = 0; + $self->{no_revision} = 1; } return bless $self, $class; @@ -132,17 +132,17 @@ Returns the corresponding part of the full version string. sub epoch { my $self = shift; - return $self->{'epoch'}; + return $self->{epoch}; } sub version { my $self = shift; - return $self->{'version'}; + return $self->{version}; } sub revision { my $self = shift; - return $self->{'revision'}; + return $self->{revision}; } =item $v1 <=> $v2, $v1 < $v2, $v1 <= $v2, $v1 > $v2, $v1 >= $v2 diff --git a/scripts/dpkg-buildpackage.pl b/scripts/dpkg-buildpackage.pl index 78485cb27..ba1d4a543 100755 --- a/scripts/dpkg-buildpackage.pl +++ b/scripts/dpkg-buildpackage.pl @@ -320,7 +320,7 @@ if (build_sourceonly) { } elsif (build_binaryindep) { $arch = 'all'; } else { - $arch = mustsetvar($ENV{'DEB_HOST_ARCH'}, _g('host architecture')); + $arch = mustsetvar($ENV{DEB_HOST_ARCH}, _g('host architecture')); } if (!defined $signcommand && diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl index e61c8c863..b91d80197 100755 --- a/scripts/dpkg-genchanges.pl +++ b/scripts/dpkg-genchanges.pl @@ -196,13 +196,13 @@ while (@ARGV) { # Retrieve info from the current changelog entry my %options = (file => $changelogfile); -$options{"changelogformat"} = $changelogformat if $changelogformat; -$options{"since"} = $since if defined($since); +$options{changelogformat} = $changelogformat if $changelogformat; +$options{since} = $since if defined($since); my $changelog = changelog_parse(%options); # Change options to retrieve info of the former changelog entry -delete $options{"since"}; -$options{"count"} = 1; -$options{"offset"} = 1; +delete $options{since}; +$options{count} = 1; +$options{offset} = 1; my $prev_changelog = changelog_parse(%options); # Other initializations my $control = Dpkg::Control::Info->new($controlfile); diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl index 516a593a3..f032b6138 100755 --- a/scripts/dpkg-gencontrol.pl +++ b/scripts/dpkg-gencontrol.pl @@ -137,11 +137,11 @@ while (@ARGV) { umask 0022; # ensure sane default permissions for created files my %options = (file => $changelogfile); -$options{"changelogformat"} = $changelogformat if $changelogformat; +$options{changelogformat} = $changelogformat if $changelogformat; my $changelog = changelog_parse(%options); if ($changelog->{"Binary-Only"}) { - $options{"count"} = 1; - $options{"offset"} = 1; + $options{count} = 1; + $options{offset} = 1; my $prev_changelog = changelog_parse(%options); $sourceversion = $prev_changelog->{"Version"}; } else { diff --git a/scripts/dpkg-parsechangelog.pl b/scripts/dpkg-parsechangelog.pl index 8b980db2b..774265146 100755 --- a/scripts/dpkg-parsechangelog.pl +++ b/scripts/dpkg-parsechangelog.pl @@ -78,28 +78,30 @@ while (@ARGV) { last unless $ARGV[0] =~ m/^-/; $_ = shift(@ARGV); if (m/^-L(.+)$/) { - $options{"libdir"} = $1; + $options{libdir} = $1; } elsif (m/^-F([0-9a-z]+)$/) { - $options{"changelogformat"} = $1; + $options{changelogformat} = $1; } elsif (m/^-l(.+)$/) { - $options{"file"} = $1; + $options{file} = $1; } elsif (m/^-(?:S|-show-field)(?:=(.+))?$/) { $fieldname = $1 // shift(@ARGV); } elsif (m/^--$/) { last; } elsif (m/^-([cfnostuv])(.*)$/) { if (($1 eq "c") or ($1 eq "n")) { - $options{"count"} = $2; + $options{count} = $2; } elsif ($1 eq "f") { - $options{"from"} = $2; + $options{from} = $2; } elsif ($1 eq "o") { - $options{"offset"} = $2; + $options{offset} = $2; } elsif (($1 eq "s") or ($1 eq "v")) { - $options{"since"} = $2; + $options{since} = $2; } elsif ($1 eq "t") { - $options{"to"} = $2; + $options{to} = $2; } elsif ($1 eq "u") { - $options{"until"} = $2; + ## no critic (ControlStructures::ProhibitUntilBlocks) + $options{until} = $2; + ## use critic } } elsif (m/^--(count|file|format|from|offset|since|to|until)(.*)$/) { if ($2) { @@ -108,7 +110,7 @@ while (@ARGV) { $options{$1} = shift(@ARGV); } } elsif (m/^--all$/) { - $options{"all"} = undef; + $options{all} = undef; } elsif (m/^-(\?|-help)$/) { usage(); exit(0); } elsif (m/^--version$/) { diff --git a/scripts/dpkg-shlibdeps.pl b/scripts/dpkg-shlibdeps.pl index 8e5c543d6..06df8c2cb 100755 --- a/scripts/dpkg-shlibdeps.pl +++ b/scripts/dpkg-shlibdeps.pl @@ -97,7 +97,7 @@ foreach (@ARGV) { $admindir = $1; -d $admindir || error(_g("administrative directory '%s' does not exist"), $admindir); - $ENV{'DPKG_ADMINDIR'} = $admindir; + $ENV{DPKG_ADMINDIR} = $admindir; } elsif (m/^-d(.*)$/) { $dependencyfield = field_capitalize($1); defined($depstrength{$dependencyfield}) || diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl index 5df9711f0..8d395ba88 100755 --- a/scripts/dpkg-source.pl +++ b/scripts/dpkg-source.pl @@ -97,10 +97,10 @@ while (@ARGV && $ARGV[0] =~ m/^-/) { } my $dir; -if (defined($options{'opmode'}) && - $options{'opmode'} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/) { +if (defined($options{opmode}) && + $options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/) { if (not scalar(@ARGV)) { - usageerr(_g("%s needs a directory"), $options{'opmode'}) + usageerr(_g("%s needs a directory"), $options{opmode}) unless $1 eq "--commit"; $dir = "."; } else { @@ -132,7 +132,7 @@ if (defined($options{'opmode'}) && $conf->filter(remove => sub { $_[0] =~ $forbidden_opts_re->{$filename} }); if (@$conf) { info(_g("using options from %s: %s"), $optfile, join(" ", @$conf)) - unless $options{'opmode'} eq "--print-format"; + unless $options{opmode} eq "--print-format"; unshift @options, @$conf; } } @@ -144,14 +144,14 @@ while (@options) { $build_format //= $1; } elsif (m/^-(?:Z|-compression=)(.*)$/) { my $compression = $1; - $options{'compression'} = $compression; - $options{'comp_ext'} = compression_get_property($compression, "file_ext"); + $options{compression} = $compression; + $options{comp_ext} = compression_get_property($compression, "file_ext"); usageerr(_g("%s is not a supported compression"), $compression) unless compression_is_supported($compression); compression_set_default($compression); } elsif (m/^-(?:z|-compression-level=)(.*)$/) { my $comp_level = $1; - $options{'comp_level'} = $comp_level; + $options{comp_level} = $comp_level; usageerr(_g("%s is not a compression level"), $comp_level) unless compression_is_valid_level($comp_level); compression_set_default_level($comp_level); @@ -166,26 +166,26 @@ while (@options) { } elsif (m/^-U([^\=:]+)$/) { $remove{$1} = 1; } elsif (m/^-(?:i|-diff-ignore(?:$|=))(.*)$/) { - $options{'diff_ignore_regexp'} = $1 ? $1 : $Dpkg::Source::Package::diff_ignore_default_regexp; + $options{diff_ignore_regexp} = $1 ? $1 : $Dpkg::Source::Package::diff_ignore_default_regexp; } elsif (m/^--extend-diff-ignore=(.+)$/) { $Dpkg::Source::Package::diff_ignore_default_regexp .= "|$1"; - if ($options{'diff_ignore_regexp'}) { - $options{'diff_ignore_regexp'} .= "|$1"; + if ($options{diff_ignore_regexp}) { + $options{diff_ignore_regexp} .= "|$1"; } } elsif (m/^-(?:I|-tar-ignore=)(.+)$/) { - push @{$options{'tar_ignore'}}, $1; + push @{$options{tar_ignore}}, $1; } elsif (m/^-(?:I|-tar-ignore)$/) { unless ($tar_ignore_default_pattern_done) { - push @{$options{'tar_ignore'}}, @Dpkg::Source::Package::tar_ignore_default_pattern; + push @{$options{tar_ignore}}, @Dpkg::Source::Package::tar_ignore_default_pattern; # Prevent adding multiple times $tar_ignore_default_pattern_done = 1; } } elsif (m/^--no-copy$/) { - $options{'copy_orig_tarballs'} = 0; + $options{copy_orig_tarballs} = 0; } elsif (m/^--no-check$/) { - $options{'no_check'} = 1; + $options{no_check} = 1; } elsif (m/^--require-valid-signature$/) { - $options{'require_valid_signature'} = 1; + $options{require_valid_signature} = 1; } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:](.*)$/s) { $substvars->set($1, $2); } elsif (m/^-T(.*)$/) { @@ -201,7 +201,7 @@ while (@options) { warning(_g("-E and -W are deprecated, they are without effect")); } elsif (m/^-q$/) { report_options(quiet_warnings => 1); - $options{'quiet'} = 1; + $options{quiet} = 1; } elsif (m/^--$/) { last; } else { @@ -209,24 +209,24 @@ while (@options) { } } -unless (defined($options{'opmode'})) { +unless (defined($options{opmode})) { usageerr(_g("need a command (-x, -b, --before-build, --after-build, --print-format, --commit)")); } -if ($options{'opmode'} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/) { +if ($options{opmode} =~ /^(-b|--print-format|--(before|after)-build|--commit)$/) { - $options{'ARGV'} = \@ARGV; + $options{ARGV} = \@ARGV; $changelogfile ||= "$dir/debian/changelog"; $controlfile ||= "$dir/debian/control"; my %ch_options = (file => $changelogfile); - $ch_options{"changelogformat"} = $changelogformat if $changelogformat; + $ch_options{changelogformat} = $changelogformat if $changelogformat; my $changelog = changelog_parse(%ch_options); my $control = Dpkg::Control::Info->new($controlfile); my $srcpkg = Dpkg::Source::Package->new(options => \%options); - my $fields = $srcpkg->{'fields'}; + my $fields = $srcpkg->{fields}; my @sourcearch; my %archadded; @@ -334,7 +334,7 @@ if ($options{'opmode'} =~ /^(-b|--print-format|--(before|after)-build|--commit)$ $fields->{$_} = $v; } elsif (m/^Binary-Only$/) { error(_g("building source for a binary-only release")) - if $v eq "yes" and $options{'opmode'} eq "-b"; + if $v eq "yes" and $options{opmode} eq "-b"; } elsif (m/^Maintainer$/i) { # Do not replace the field coming from the source entry } else { @@ -361,7 +361,7 @@ if ($options{'opmode'} =~ /^(-b|--print-format|--(before|after)-build|--commit)$ } else { warning(_g("no source format specified in %s, " . "see dpkg-source(1)"), "debian/source/format") - if $options{'opmode'} eq "-b"; + if $options{opmode} eq "-b"; $build_format = "1.0"; } } @@ -371,16 +371,16 @@ if ($options{'opmode'} =~ /^(-b|--print-format|--(before|after)-build|--commit)$ $srcpkg->init_options(); $srcpkg->parse_cmdline_options(@cmdline_options); - if ($options{'opmode'} eq "--print-format") { + if ($options{opmode} eq "--print-format") { print $fields->{'Format'} . "\n"; exit(0); - } elsif ($options{'opmode'} eq "--before-build") { + } elsif ($options{opmode} eq "--before-build") { $srcpkg->before_build($dir); exit(0); - } elsif ($options{'opmode'} eq "--after-build") { + } elsif ($options{opmode} eq "--after-build") { $srcpkg->after_build($dir); exit(0); - } elsif ($options{'opmode'} eq "--commit") { + } elsif ($options{opmode} eq "--commit") { $srcpkg->commit($dir); exit(0); } @@ -404,7 +404,7 @@ if ($options{'opmode'} =~ /^(-b|--print-format|--(before|after)-build|--commit)$ substvars => $substvars); exit(0); -} elsif ($options{'opmode'} eq '-x') { +} elsif ($options{opmode} eq '-x') { # Check command line unless (scalar(@ARGV)) { @@ -436,11 +436,11 @@ if ($options{'opmode'} =~ /^(-b|--print-format|--(before|after)-build|--commit)$ } # Various checks before unpacking - unless ($options{'no_check'}) { + unless ($options{no_check}) { if ($srcpkg->is_signed()) { $srcpkg->check_signature(); } else { - if ($options{'require_valid_signature'}) { + if ($options{require_valid_signature}) { error(_g("%s doesn't contain a valid OpenPGP signature"), $dsc); } else { warning(_g("extracting unsigned source package (%s)"), $dsc); @@ -450,17 +450,17 @@ if ($options{'opmode'} =~ /^(-b|--print-format|--(before|after)-build|--commit)$ } # Unpack the source package (delegated to Dpkg::Source::Package::*) - info(_g("extracting %s in %s"), $srcpkg->{'fields'}{'Source'}, $newdirectory); + info(_g("extracting %s in %s"), $srcpkg->{fields}{'Source'}, $newdirectory); $srcpkg->extract($newdirectory); exit(0); } sub setopmode { - if (defined($options{'opmode'})) { + if (defined($options{opmode})) { usageerr(_g("only one of -x, -b or --print-format allowed, and only once")); } - $options{'opmode'} = $_[0]; + $options{opmode} = $_[0]; } sub version { diff --git a/scripts/t/200_Dpkg_Shlibs.t b/scripts/t/200_Dpkg_Shlibs.t index 3b1b93479..b8a64284b 100644 --- a/scripts/t/200_Dpkg_Shlibs.t +++ b/scripts/t/200_Dpkg_Shlibs.t @@ -66,7 +66,7 @@ ok($obj->is_executable(), 'ls is an executable'); my $sym = $obj->get_symbol('optarg@GLIBC_2.0'); ok($sym, 'optarg@GLIBC_2.0 exists'); -ok(!$sym->{'defined'}, 'R_*_COPY relocations are taken into account'); +ok(!$sym->{defined}, 'R_*_COPY relocations are taken into account'); open $objdump, '<', "$datadir/objdump.space" or die "$datadir/objdump.space: $!"; diff --git a/scripts/t/400_Dpkg_Deps.t b/scripts/t/400_Dpkg_Deps.t index 80ca1e3e1..24a37f3f5 100644 --- a/scripts/t/400_Dpkg_Deps.t +++ b/scripts/t/400_Dpkg_Deps.t @@ -97,7 +97,7 @@ is($dep_empty1->output(), "", "Empty dependency"); my $dep_empty2 = deps_parse(" , , ", union => 1); is($dep_empty2->output(), "", "' , , ' is also an empty dependency"); -$SIG{'__WARN__'} = sub {}; +$SIG{__WARN__} = sub {}; my $dep_bad_multiline = deps_parse("a, foo\nbar, c"); ok(!defined($dep_bad_multiline), "invalid dependency split over multiple line"); -delete $SIG{'__WARN__'}; +delete $SIG{__WARN__}; diff --git a/scripts/t/600_Dpkg_Changelog.t b/scripts/t/600_Dpkg_Changelog.t index f9052d0f5..012d4b95d 100644 --- a/scripts/t/600_Dpkg_Changelog.t +++ b/scripts/t/600_Dpkg_Changelog.t @@ -157,11 +157,11 @@ foreach my $file ("$datadir/countme", "$datadir/shadow", "$datadir/fields", { since => '1:2.0~rc2-1sarge3' }, 3, '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2', 'since => "1:2.0~rc2-1sarge3"' ); - $SIG{'__WARN__'} = sub {}; + $SIG{__WARN__} = sub {}; check_options( $changes, \@data, { since => 0 }, 7, '', 'since => 0 returns all'); - delete $SIG{'__WARN__'}; + delete $SIG{__WARN__}; check_options( $changes, \@data, { to => '1:2.0~rc2-1sarge2' }, 3, '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1', diff --git a/scripts/t/750_Dpkg_Substvars.t b/scripts/t/750_Dpkg_Substvars.t index 713d41b7a..0f792f45d 100644 --- a/scripts/t/750_Dpkg_Substvars.t +++ b/scripts/t/750_Dpkg_Substvars.t @@ -75,11 +75,11 @@ is($s->substvars('This is a string ${var1} with variables ${binary:Version}'), "substvars simple"); my $output; -$SIG{'__WARN__'} = sub { $output .= $_[0] }; +$SIG{__WARN__} = sub { $output .= $_[0] }; is($s->substvars('This is a string with unknown variable ${blubb}'), "This is a string with unknown variable ", "substvars missing"); -delete $SIG{'__WARN__'}; +delete $SIG{__WARN__}; is($output, '750_Dpkg_Substvars.t: warning: unknown substitution variable ${blubb}'."\n" , 'missing variables warning'); @@ -96,16 +96,16 @@ is($s->substvars('Nothing to $ ${substitute here}, is it ${}?, it ${is'), # Warnings about unused variables $output = ''; -$SIG{'__WARN__'} = sub { $output .= $_[0] }; +$SIG{__WARN__} = sub { $output .= $_[0] }; $s->warn_about_unused(); -delete $SIG{'__WARN__'}; +delete $SIG{__WARN__}; is($output, "750_Dpkg_Substvars.t: warning: unused substitution variable \${var2}\n", , 'unused variables warnings'); # Disable warnings for a certain variable $s->mark_as_used('var2'); $output = ''; -$SIG{'__WARN__'} = sub { $output .= $_[0] }; +$SIG{__WARN__} = sub { $output .= $_[0] }; $s->warn_about_unused(); -delete $SIG{'__WARN__'}; +delete $SIG{__WARN__}; is($output, '', 'disabled unused variables warnings'); |