This is an automated email from the git hooks/post-receive script. guillem pushed a commit to branch main in repository dpkg.
View the commit online: https://git.dpkg.org/cgit/dpkg/dpkg.git/commit/?id=309123b9e76a44cd8e394d87295e2d244d7e354c commit 309123b9e76a44cd8e394d87295e2d244d7e354c Author: Guillem Jover <guil...@debian.org> AuthorDate: Thu Mar 2 01:22:09 2023 +0100 scripts: Unpack function arguments Unpack the arguments into variables to make the core more readable, and avoid aliasing issues. Warned-by: perlcritic Fixes: Subroutines::RequireArgUnpacking --- scripts/Dpkg/Compression/FileHandle.pm | 36 +++++++++++++++++------------ scripts/Dpkg/Control/Changelog.pm | 4 ++-- scripts/Dpkg/Control/HashCore.pm | 4 ++-- scripts/Dpkg/Control/HashCore/Tie.pm | 4 ++-- scripts/Dpkg/Deps/Multiple.pm | 8 +++---- scripts/Dpkg/ErrorHandling.pm | 42 ++++++++++++++++++++++------------ scripts/Dpkg/Source/Package.pm | 8 +++---- scripts/Dpkg/Source/Quilt.pm | 10 ++++---- scripts/Dpkg/Vendor.pm | 4 +++- scripts/dpkg-buildpackage.pl | 6 +++-- scripts/dpkg-fsys-usrunmess.pl | 4 ++-- scripts/dpkg-genbuildinfo.pl | 8 ++++--- scripts/dpkg-shlibdeps.pl | 4 +++- t/critic.t | 1 + t/critic/perlcriticrc | 3 +++ 15 files changed, 89 insertions(+), 57 deletions(-) diff --git a/scripts/Dpkg/Compression/FileHandle.pm b/scripts/Dpkg/Compression/FileHandle.pm index 50ce6f556..26d78260f 100644 --- a/scripts/Dpkg/Compression/FileHandle.pm +++ b/scripts/Dpkg/Compression/FileHandle.pm @@ -209,9 +209,10 @@ sub READLINE { } sub OPEN { - my ($self) = shift; - if (scalar(@_) == 2) { - my ($mode, $filename) = @_; + my ($self, @args) = @_; + + if (scalar @args == 2) { + my ($mode, $filename) = @args; $self->set_filename($filename); if ($mode eq '>') { $self->_open_for_write(); @@ -229,10 +230,10 @@ sub OPEN { } sub CLOSE { - my ($self) = shift; + my ($self, @args) = @_; my $ret = 1; if (defined *$self->{file}) { - $ret = *$self->{file}->close(@_) if *$self->{file}->opened(); + $ret = *$self->{file}->close(@args) if *$self->{file}->opened(); } else { $ret = 0; } @@ -241,34 +242,39 @@ sub CLOSE { } sub FILENO { - my ($self) = shift; - return *$self->{file}->fileno(@_) if defined *$self->{file}; + my ($self, @args) = @_; + + return *$self->{file}->fileno(@args) if defined *$self->{file}; return; } 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}; + my ($self, $param, @args) = @_; + + return *$self->{file}->eof(@args) if defined *$self->{file}; return 1; } sub SEEK { - my ($self) = shift; - return *$self->{file}->seek(@_) if defined *$self->{file}; + my ($self, @args) = @_; + + return *$self->{file}->seek(@args) if defined *$self->{file}; return 0; } sub TELL { - my ($self) = shift; - return *$self->{file}->tell(@_) if defined *$self->{file}; + my ($self, @args) = @_; + + return *$self->{file}->tell(@args) if defined *$self->{file}; return -1; } sub BINMODE { - my ($self) = shift; - return *$self->{file}->binmode(@_) if defined *$self->{file}; + my ($self, @args) = @_; + + return *$self->{file}->binmode(@args) if defined *$self->{file}; return; } diff --git a/scripts/Dpkg/Control/Changelog.pm b/scripts/Dpkg/Control/Changelog.pm index 08e230de3..39e31a7ab 100644 --- a/scripts/Dpkg/Control/Changelog.pm +++ b/scripts/Dpkg/Control/Changelog.pm @@ -48,9 +48,9 @@ Create a new empty set of changelog related fields. =cut sub new { - my $this = shift; + my ($this, @args) = @_; my $class = ref($this) || $this; - my $self = Dpkg::Control->new(type => CTRL_CHANGELOG, @_); + my $self = Dpkg::Control->new(type => CTRL_CHANGELOG, @args); return bless $self, $class; } diff --git a/scripts/Dpkg/Control/HashCore.pm b/scripts/Dpkg/Control/HashCore.pm index 61a1aeedb..58c8e1f22 100644 --- a/scripts/Dpkg/Control/HashCore.pm +++ b/scripts/Dpkg/Control/HashCore.pm @@ -179,9 +179,9 @@ Prints an error message and dies on syntax parse errors. =cut sub parse_error { - my ($self, $file, $msg) = (shift, shift, shift); + my ($self, $file, $msg, @args) = @_; - $msg = sprintf($msg, @_) if (@_); + $msg = sprintf $msg, @args if @args; error(g_('syntax error in %s at line %d: %s'), $file, $., $msg); } diff --git a/scripts/Dpkg/Control/HashCore/Tie.pm b/scripts/Dpkg/Control/HashCore/Tie.pm index b0216037c..eacd702da 100644 --- a/scripts/Dpkg/Control/HashCore/Tie.pm +++ b/scripts/Dpkg/Control/HashCore/Tie.pm @@ -64,10 +64,10 @@ Return a reference to a tied hash implementing storage of simple =cut sub new { - my $class = shift; + my ($class, @args) = @_; my $hash = {}; - tie %{$hash}, $class, @_; ## no critic (Miscellanea::ProhibitTies) + tie %{$hash}, $class, @args; ## no critic (Miscellanea::ProhibitTies) return $hash; } diff --git a/scripts/Dpkg/Deps/Multiple.pm b/scripts/Dpkg/Deps/Multiple.pm index a32a223dd..6cf66b30e 100644 --- a/scripts/Dpkg/Deps/Multiple.pm +++ b/scripts/Dpkg/Deps/Multiple.pm @@ -56,9 +56,9 @@ Creates a new object. =cut sub new { - my $this = shift; + my ($this, @deps) = @_; my $class = ref($this) || $this; - my $self = { list => [ @_ ] }; + my $self = { list => [ @deps ] }; bless $self, $class; return $self; @@ -84,9 +84,9 @@ Adds new dependency objects at the end of the list. =cut sub add { - my $self = shift; + my ($self, @deps) = @_; - push @{$self->{list}}, @_; + push @{$self->{list}}, @deps; } =item $dep->get_deps() diff --git a/scripts/Dpkg/ErrorHandling.pm b/scripts/Dpkg/ErrorHandling.pm index fdb84d8eb..43776ada9 100644 --- a/scripts/Dpkg/ErrorHandling.pm +++ b/scripts/Dpkg/ErrorHandling.pm @@ -189,9 +189,9 @@ sub _typename_prefix sub report(@) { - my ($type, $msg) = (shift, shift); + my ($type, $msg, @args) = @_; - $msg = sprintf($msg, @_) if (@_); + $msg = sprintf $msg, @args if @args; my $progname = _progname_prefix(); my $typename = _typename_prefix($type); @@ -201,39 +201,51 @@ sub report(@) sub debug { - my $level = shift; - print report(REPORT_DEBUG, @_) if $level <= $debug_level; + my ($level, @args) = @_; + + print report(REPORT_DEBUG, @args) if $level <= $debug_level; } sub info($;@) { - print { $info_fh } report(REPORT_INFO, @_) if not $quiet_warnings; + my @args = @_; + + print { $info_fh } report(REPORT_INFO, @args) if not $quiet_warnings; } sub notice { - warn report(REPORT_NOTICE, @_) if not $quiet_warnings; + my @args = @_; + + warn report(REPORT_NOTICE, @args) if not $quiet_warnings; } sub warning($;@) { - warn report(REPORT_WARN, @_) if not $quiet_warnings; + my @args = @_; + + warn report(REPORT_WARN, @args) if not $quiet_warnings; } sub syserr($;@) { - my $msg = shift; - die report(REPORT_ERROR, "$msg: $!", @_); + my ($msg, @args) = @_; + + die report(REPORT_ERROR, "$msg: $!", @args); } sub error($;@) { - die report(REPORT_ERROR, @_); + my @args = @_; + + die report(REPORT_ERROR, @args); } sub errormsg($;@) { - print { *STDERR } report(REPORT_ERROR, @_); + my @args = @_; + + print { *STDERR } report(REPORT_ERROR, @args); } sub printcmd @@ -245,9 +257,9 @@ sub printcmd sub subprocerr(@) { - my ($p) = (shift); + my ($p, @args) = @_; - $p = sprintf($p, @_) if (@_); + $p = sprintf $p, @args if @args; require POSIX; @@ -264,11 +276,11 @@ sub subprocerr(@) sub usageerr(@) { - my ($msg) = (shift); + my ($msg, @args) = @_; state $printforhelp = g_('Use --help for program usage information.'); - $msg = sprintf($msg, @_) if (@_); + $msg = sprintf $msg, @args if @args; warn report(REPORT_ERROR, $msg); warn "\n$printforhelp\n"; exit(2); diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm index 3eb2e8d14..773200768 100644 --- a/scripts/Dpkg/Source/Package.pm +++ b/scripts/Dpkg/Source/Package.pm @@ -621,9 +621,9 @@ sub before_build { } sub build { - my $self = shift; + my ($self, @args) = @_; - $self->do_build(@_); + $self->do_build(@args); } sub after_build { @@ -652,9 +652,9 @@ sub add_file { } sub commit { - my $self = shift; + my ($self, @args) = @_; - $self->do_commit(@_); + $self->do_commit(@args); } sub do_commit { diff --git a/scripts/Dpkg/Source/Quilt.pm b/scripts/Dpkg/Source/Quilt.pm index 99b11958a..943c23ff7 100644 --- a/scripts/Dpkg/Source/Quilt.pm +++ b/scripts/Dpkg/Source/Quilt.pm @@ -271,8 +271,9 @@ sub get_series_file { } sub get_db_file { - my $self = shift; - return File::Spec->catfile($self->{dir}, '.pc', @_); + my ($self, $file) = @_; + + return File::Spec->catfile($self->{dir}, '.pc', $file); } sub get_db_dir { @@ -281,8 +282,9 @@ sub get_db_dir { } sub get_patch_file { - my $self = shift; - return File::Spec->catfile($self->{dir}, 'debian', 'patches', @_); + my ($self, $file) = @_; + + return File::Spec->catfile($self->{dir}, 'debian', 'patches', $file); } sub get_patch_dir { diff --git a/scripts/Dpkg/Vendor.pm b/scripts/Dpkg/Vendor.pm index 85eac5cf7..8e862a6d7 100644 --- a/scripts/Dpkg/Vendor.pm +++ b/scripts/Dpkg/Vendor.pm @@ -260,8 +260,10 @@ Run a hook implemented by the current vendor object. =cut sub run_vendor_hook { + my @args = @_; my $vendor_obj = get_vendor_object(); - $vendor_obj->run_hook(@_); + + $vendor_obj->run_hook(@args); } =back diff --git a/scripts/dpkg-buildpackage.pl b/scripts/dpkg-buildpackage.pl index eca544c5a..408a7a9aa 100755 --- a/scripts/dpkg-buildpackage.pl +++ b/scripts/dpkg-buildpackage.pl @@ -830,8 +830,10 @@ sub parse_rules_requires_root { } sub run_cmd { - printcmd(@_); - system @_ and subprocerr("@_"); + my @cmd = @_; + + printcmd(@cmd); + system @cmd and subprocerr("@cmd"); } sub rules_requires_root { diff --git a/scripts/dpkg-fsys-usrunmess.pl b/scripts/dpkg-fsys-usrunmess.pl index f59d65017..1c72153d4 100755 --- a/scripts/dpkg-fsys-usrunmess.pl +++ b/scripts/dpkg-fsys-usrunmess.pl @@ -623,11 +623,11 @@ sub usage sub usageerr { - my $msg = shift; + my ($msg, @args) = @_; state $printforhelp = 'Use --help for program usage information.'; - $msg = sprintf $msg, @_ if @_; + $msg = sprintf $msg, @args if @args; warn "$PROGNAME: error: $msg\n"; warn "$printforhelp\n"; exit 2; diff --git a/scripts/dpkg-genbuildinfo.pl b/scripts/dpkg-genbuildinfo.pl index f26e396fa..8b53df0a6 100755 --- a/scripts/dpkg-genbuildinfo.pl +++ b/scripts/dpkg-genbuildinfo.pl @@ -142,9 +142,9 @@ sub parse_status { } sub append_deps { - my $pkgs = shift; + my ($pkgs, @deps) = @_; - foreach my $dep_str (@_) { + foreach my $dep_str (@deps) { next unless $dep_str; my $deps = deps_parse($dep_str, reduce_restrictions => 1, @@ -154,8 +154,10 @@ sub append_deps { # We add every sub-dependencies as we cannot know which package in # an OR dependency has been effectively used. deps_iterate($deps, sub { + my $pkg = shift; + push @{$pkgs}, - $_[0]->{package} . (defined $_[0]->{archqual} ? ':' . $_[0]->{archqual} : ''); + $pkg->{package} . (defined $pkg->{archqual} ? ':' . $pkg->{archqual} : ''); 1 }); } diff --git a/scripts/dpkg-shlibdeps.pl b/scripts/dpkg-shlibdeps.pl index 557a66fd9..b31c14f9d 100755 --- a/scripts/dpkg-shlibdeps.pl +++ b/scripts/dpkg-shlibdeps.pl @@ -891,10 +891,12 @@ sub my_find_library { my %cached_pkgmatch = (); sub find_packages { + my @paths = @_; + my @files; my $pkgmatch = {}; - foreach my $path (@_) { + foreach my $path (@paths) { if (exists $cached_pkgmatch{$path}) { $pkgmatch->{$path} = $cached_pkgmatch{$path}; } else { diff --git a/t/critic.t b/t/critic.t index e0aa45d4e..6650df983 100644 --- a/t/critic.t +++ b/t/critic.t @@ -90,6 +90,7 @@ my @policies = qw( Subroutines::ProhibitReturnSort Subroutines::ProhibitUnusedPrivateSubroutines Subroutines::ProtectPrivateSubs + Subroutines::RequireArgUnpacking TestingAndDebugging::ProhibitNoStrict TestingAndDebugging::ProhibitNoWarnings TestingAndDebugging::ProhibitProlongedStrictureOverride diff --git a/t/critic/perlcriticrc b/t/critic/perlcriticrc index 3fe963794..d5ef6f3fd 100644 --- a/t/critic/perlcriticrc +++ b/t/critic/perlcriticrc @@ -20,6 +20,9 @@ allow_all_brackets = 1 [RegularExpressions::RequireExtendedFormatting] minimum_regex_length_to_complain_about = 60 +[Subroutines::RequireArgUnpacking] +allow_delegation_to = new clone + [ValuesAndExpressions::ProhibitInterpolationOfLiterals] # TODO: switch these to q{} ? allow_if_string_contains_single_quote = 1 -- Dpkg.Org's dpkg
