The following commit has been merged in the master branch:
commit ac704f9d15a93b2f8e0c42fea0fe5137e95b1962
Author: Guillem Jover <[email protected]>
Date: Wed Jan 9 19:23:01 2013 +0100
scripts: Use Dpkg::Util list functions instead of grep
This avoids using the grep builtin on scalar context, which is
suboptimal as it does not short-circuit on first match, and it's
intended to produce an output array.
Ideally we'd directly use the functions from List::MoreUtils, because
they might be more performant, but not being a core module is a show
stopper.
Addresses BuiltinFunctions::ProhibitBooleanGrep.
diff --git a/scripts/Dpkg/Arch.pm b/scripts/Dpkg/Arch.pm
index abcf0b2..39725aa 100644
--- a/scripts/Dpkg/Arch.pm
+++ b/scripts/Dpkg/Arch.pm
@@ -34,6 +34,7 @@ use POSIX qw(:errno_h);
use Dpkg qw();
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
+use Dpkg::Util qw(:list);
use Dpkg::BuildEnv;
my (@cpu, @os);
@@ -436,7 +437,7 @@ sub debarch_is_wildcard($)
my @triplet = debwildcard_to_debtriplet($arch);
return 0 if scalar @triplet != 3;
- return 1 if (grep { $_ eq 'any' } @triplet);
+ return 1 if any { $_ eq 'any' } @triplet;
return 0;
}
diff --git a/scripts/Dpkg/Shlibs.pm b/scripts/Dpkg/Shlibs.pm
index f449f33..df0ebee 100644
--- a/scripts/Dpkg/Shlibs.pm
+++ b/scripts/Dpkg/Shlibs.pm
@@ -28,6 +28,7 @@ use File::Spec;
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Shlibs::Objdump;
+use Dpkg::Util qw(:list);
use Dpkg::Path qw(resolve_symlink canonpath);
use Dpkg::Arch qw(debarch_to_gnutriplet get_build_arch get_host_arch
gnutriplet_to_multiarch debarch_to_multiarch);
@@ -94,7 +95,7 @@ sub parse_ldso_conf {
} elsif (m{^\s*/}) {
s/^\s+//;
my $libdir = $_;
- unless (scalar grep { $_ eq $libdir } @librarypaths) {
+ if (none { $_ eq $libdir } @librarypaths) {
push @librarypaths, $libdir;
}
}
@@ -116,7 +117,7 @@ sub find_library {
# is /usr/lib64 -> /usr/lib on amd64.
if (-l $checkdir) {
my $newdir = resolve_symlink($checkdir);
- if (grep { "$root$_" eq "$newdir" } (@rpath, @librarypaths)) {
+ if (any { "$root$_" eq "$newdir" } (@rpath, @librarypaths)) {
$checkdir = $newdir;
}
}
diff --git a/scripts/Dpkg/Shlibs/Symbol.pm b/scripts/Dpkg/Shlibs/Symbol.pm
index ea767cf..0da68b6 100644
--- a/scripts/Dpkg/Shlibs/Symbol.pm
+++ b/scripts/Dpkg/Shlibs/Symbol.pm
@@ -24,6 +24,7 @@ our $VERSION = '0.01';
use Dpkg::Gettext;
use Dpkg::Deps;
use Dpkg::ErrorHandling;
+use Dpkg::Util qw(:list);
use Dpkg::Version;
use Storable qw();
use Dpkg::Shlibs::Cppfilt;
@@ -485,7 +486,7 @@ sub matches_rawname {
if ($self->is_pattern()) {
# Process pattern tags in the order they were specified.
for my $tag (@{$self->{tagorder}}) {
- if (grep { $tag eq $_ } ALIAS_TYPES) {
+ if (any { $tag eq $_ } ALIAS_TYPES) {
$ok = not not ($target = $self->convert_to_alias($target,
$tag));
} elsif ($tag eq 'regex') {
# Symbol name is a regex. Match it against the target
diff --git a/scripts/Dpkg/Source/Package/V3/Quilt.pm
b/scripts/Dpkg/Source/Package/V3/Quilt.pm
index 5041201..6c597d0 100644
--- a/scripts/Dpkg/Source/Package/V3/Quilt.pm
+++ b/scripts/Dpkg/Source/Package/V3/Quilt.pm
@@ -26,6 +26,7 @@ use parent qw(Dpkg::Source::Package::V2);
use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
+use Dpkg::Util qw(:list);
use Dpkg::Version;
use Dpkg::Source::Patch;
use Dpkg::Source::Functions qw(erasedir fs_time);
@@ -182,7 +183,7 @@ sub do_build {
my $version = $quilt->get_db_version();
if (defined($version) and $version != 2) {
- if (scalar grep { $version eq $_ }
+ if (any { $version eq $_ }
@{$self->{options}{allow_version_of_quilt_db}})
{
warning(_g('unsupported version of the quilt metadata: %s'),
$version);
diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl
index 5162758..bfe6ccf 100755
--- a/scripts/dpkg-genchanges.pl
+++ b/scripts/dpkg-genchanges.pl
@@ -26,6 +26,7 @@ use Encode;
use POSIX qw(:errno_h);
use Dpkg qw();
use Dpkg::Gettext;
+use Dpkg::Util qw(:list);
use Dpkg::File;
use Dpkg::Checksums;
use Dpkg::ErrorHandling;
@@ -300,7 +301,7 @@ foreach my $pkg ($control->get_packages()) {
if (not defined($p2f{$p})) {
# No files for this package... warn if it's unexpected
if ((debarch_eq('all', $a) and ($include & ARCH_INDEP)) ||
- (grep(debarch_is($host_arch, $_), split(/\s+/, $a))
+ ((any { debarch_is($host_arch, $_) } split /\s+/, $a)
and ($include & ARCH_DEP))) {
warning(_g('package %s in control file but not in files list'),
$p);
@@ -318,7 +319,7 @@ foreach my $pkg ($control->get_packages()) {
} elsif (m/^Priority$/) {
$f2pricf{$_} = $v foreach (@f);
} elsif (m/^Architecture$/) {
- if (grep(debarch_is($host_arch, $_), split(/\s+/, $v))
+ if ((any { debarch_is($host_arch, $_) } split /\s+/, $v)
and ($include & ARCH_DEP)) {
$v = $host_arch;
} elsif (!debarch_eq('all', $v)) {
@@ -426,7 +427,7 @@ if (!is_binaryonly) {
my $ext = $compression_re_file_ext;
if ((($sourcestyle =~ m/i/ && !$include_tarball) ||
$sourcestyle =~ m/d/) &&
- grep(m/\.(debian\.tar|diff)\.$ext$/, $checksums->get_files()))
+ any { m/\.(debian\.tar|diff)\.$ext$/ } $checksums->get_files())
{
$origsrcmsg= _g('not including original source code in upload');
foreach my $f (grep m/\.orig(-.+)?\.tar\.$ext$/,
$checksums->get_files()) {
@@ -434,7 +435,7 @@ if (!is_binaryonly) {
}
} else {
if ($sourcestyle =~ m/d/ &&
- !grep(m/\.(debian\.tar|diff)\.$ext$/, $checksums->get_files())) {
+ none { m/\.(debian\.tar|diff)\.$ext$/ } $checksums->get_files()) {
warning(_g('ignoring -sd option for native Debian package'));
}
$origsrcmsg= _g('including full source code in upload');
diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl
index 4116da4..878d762 100755
--- a/scripts/dpkg-gencontrol.pl
+++ b/scripts/dpkg-gencontrol.pl
@@ -26,6 +26,7 @@ use POSIX qw(:errno_h :fcntl_h);
use Dpkg qw();
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
+use Dpkg::Util qw(:list);
use Dpkg::File;
use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
use Dpkg::Package;
@@ -209,7 +210,7 @@ foreach (keys %{$pkg}) {
scalar(@invalid_archs)),
join("' `", @invalid_archs))
if @invalid_archs >= 1;
- if (! grep(debarch_is($host_arch, $_), @archlist)) {
+ if (none { debarch_is($host_arch, $_) } @archlist) {
error(_g("current host architecture '%s' does not " .
"appear in package's architecture list (%s)"),
$host_arch, "@archlist");
diff --git a/scripts/dpkg-scanpackages.pl b/scripts/dpkg-scanpackages.pl
index 0277b9c..283e403 100755
--- a/scripts/dpkg-scanpackages.pl
+++ b/scripts/dpkg-scanpackages.pl
@@ -27,6 +27,7 @@ use Getopt::Long qw(:config posix_default bundling
no_ignorecase);
use Dpkg qw();
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
+use Dpkg::Util qw(:list);
use Dpkg::Control;
use Dpkg::Version;
use Dpkg::Checksums;
@@ -106,7 +107,7 @@ sub load_override
my $oldmaint = $1;
my $newmaint = $2;
my $debmaint = $$package{Maintainer};
- if (!grep($debmaint eq $_, split(m{\s*//\s*}, $oldmaint))) {
+ if (none { $debmaint eq $_ } split m{\s*//\s*}, $oldmaint) {
push(@changedmaint,
sprintf(_g(' %s (package says %s, not %s)'),
$p, $$package{Maintainer}, $oldmaint));
diff --git a/scripts/dpkg-scansources.pl b/scripts/dpkg-scansources.pl
index 671863b..42372f0 100755
--- a/scripts/dpkg-scansources.pl
+++ b/scripts/dpkg-scansources.pl
@@ -25,6 +25,7 @@ use Getopt::Long qw(:config posix_default bundling
no_ignorecase);
use Dpkg qw();
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
+use Dpkg::Util qw(:list);
use Dpkg::Control;
use Dpkg::Checksums;
use Dpkg::Compression::FileHandle;
@@ -271,7 +272,7 @@ sub process_dsc {
my $maintainer_override = $override{$binary[0]};
if ($maintainer_override && defined $maintainer_override->[O_MAINT_TO]) {
if (!defined $maintainer_override->[O_MAINT_FROM] ||
- grep { $fields->{Maintainer} eq $_ }
+ any { $fields->{Maintainer} eq $_ }
@{ $maintainer_override->[O_MAINT_FROM] }) {
$fields->{Maintainer} = $maintainer_override->[O_MAINT_TO];
}
diff --git a/scripts/dpkg-shlibdeps.pl b/scripts/dpkg-shlibdeps.pl
index 10d5bc5..ca4fce2 100755
--- a/scripts/dpkg-shlibdeps.pl
+++ b/scripts/dpkg-shlibdeps.pl
@@ -31,6 +31,7 @@ use File::Basename qw(dirname);
use Dpkg qw();
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
+use Dpkg::Util qw(:list);
use Dpkg::Path qw(relative_to_pkg_root guess_pkg_root_dir
check_files_are_the_same get_control_path);
use Dpkg::Version;
@@ -202,7 +203,8 @@ foreach my $file (keys %exec) {
my @soname_wo_symfile;
foreach my $lib (keys %libfiles) {
my $soname = $libfiles{$lib};
- if (not scalar(grep { $_ ne '' } @{$file2pkg->{$lib}})) {
+
+ if (none { $_ ne '' } @{$file2pkg->{$lib}}) {
# The path of the library as calculated is not the
# official path of a packaged file, try to fallback on
# on the realpath() first, maybe this one is part of a package
@@ -211,7 +213,7 @@ foreach my $file (keys %exec) {
$file2pkg->{$lib} = $file2pkg->{$reallib};
}
}
- if (not scalar(grep { $_ ne '' } @{$file2pkg->{$lib}})) {
+ if (none { $_ ne '' } @{$file2pkg->{$lib}}) {
# If the library is really not available in an installed package,
# it's because it's in the process of being built
# Empty package name will lead to consideration of symbols
@@ -316,7 +318,7 @@ foreach my $file (keys %exec) {
my $in_public_dir = 1;
if (my $relname = relative_to_pkg_root($file)) {
my $parent_dir = '/' . dirname($relname);
- $in_public_dir = (grep { $parent_dir eq $_ } @librarypaths) ? 1 : 0;
+ $in_public_dir = any { $parent_dir eq $_ } @librarypaths;
} else {
warning(_g('binaries to analyze should already be ' .
"installed in their package's directory"));
@@ -411,7 +413,7 @@ foreach my $file (keys %exec) {
unless ($soname_notfound{$soname} or $soname_used{$soname}) {
# Ignore warning for libm.so.6 if also linked against libstdc++
next if ($soname =~ /^libm\.so\.\d+$/ and
- scalar grep(/^libstdc\+\+\.so\.\d+/, @sonames));
+ any { m/^libstdc\+\+\.so\.\d+/ } @sonames);
next unless ($warnings & WARN_NOT_NEEDED);
warning(_g('%s should not be linked against %s (it uses none of ' .
"the library's symbols)"), $file, $soname);
@@ -423,8 +425,8 @@ foreach my $file (keys %exec) {
# binaries that we have inspected)
foreach my $soname (keys %global_soname_needed) {
unless ($global_soname_notfound{$soname} or $global_soname_used{$soname}) {
- next if ($soname =~ /^libm\.so\.\d+$/ and scalar(
- grep(/^libstdc\+\+\.so\.\d+/, keys %global_soname_needed)));
+ next if ($soname =~ /^libm\.so\.\d+$/ and
+ any { m/^libstdc\+\+\.so\.\d+/ } keys %global_soname_needed);
next unless ($warnings & WARN_DEP_AVOIDABLE);
warning(P_('package could avoid a useless dependency if %s was not ' .
"linked against %s (it uses none of the library's symbols)",
diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl
index 4ba4de8..a3e4f40 100755
--- a/scripts/dpkg-source.pl
+++ b/scripts/dpkg-source.pl
@@ -31,6 +31,7 @@ use warnings;
use Dpkg qw();
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
+use Dpkg::Util qw(:list);
use Dpkg::Arch qw(debarch_eq debarch_is debarch_is_wildcard);
use Dpkg::Deps;
use Dpkg::Compression;
@@ -299,10 +300,10 @@ if ($options{opmode} =~
/^(-b|--print-format|--(before|after)-build|--commit)$/)
unless (scalar(@pkglist)) {
error(_g("%s doesn't list any binary package"), $controlfile);
}
- if (grep($_ eq 'any', @sourcearch)) {
+ if (any { $_ eq 'any' } @sourcearch) {
# If we encounter one 'any' then the other arches become insignificant
# except for 'all' that must also be kept
- if (grep($_ eq 'all', @sourcearch)) {
+ if (any { $_ eq 'all' } @sourcearch) {
@sourcearch = qw(any all);
} else {
@sourcearch = qw(any);
@@ -312,7 +313,7 @@ if ($options{opmode} =~
/^(-b|--print-format|--(before|after)-build|--commit)$/)
my @arch_wildcards = grep(debarch_is_wildcard($_), @sourcearch);
my @mini_sourcearch = @arch_wildcards;
foreach my $arch (@sourcearch) {
- if (!grep(debarch_is($arch, $_), @arch_wildcards)) {
+ if (none { debarch_is($arch, $_) } @arch_wildcards) {
push @mini_sourcearch, $arch;
}
}
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
