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.

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;
 }
 

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;
 	    }
 	}

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

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);

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');

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");

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));

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];
         }

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)",

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;
             }
         }