package Perl::Critic::Policy::BuiltinFunctions::GrepWithSimpleValue;
use warnings;
use strict;
use base 'Perl::Critic::Policy';
use Perl::Critic::Utils qw/:severities is_function_call/;
use Perl::Critic::Utils::PPI qw/is_ppi_constant_element/;

our $VERSION = '0.001';
sub supported_parameters { return }
sub default_severity { return $SEVERITY_MEDIUM }
sub default_themes { return qw/core bugs/ }
sub applies_to { return 'PPI::Token::Word' }

=head1 DESCRIPTION

A C<grep> with a constant value as the last thing in its block will
either return all or none of the items in the list (depending on
whether the value is true or false).
You may have accidentally said C<grep {123}> when you meant
C<grep {$_==123}>, or C<grep {"foo"}> when you meant
C<grep {$_ eq "foo"}> or C<grep {/foo/}>.

=cut

my $DESC = q{"grep" with constant value};
my $EXPL = q{Will return all or none of the values};

# based partially on
# Perl::Critic::Policy::BuiltinFunctions::ProhibitComplexMappings

sub violates {
    my ($self, $elem) = @_;
    return if $elem->content() ne 'grep';
    return if !is_function_call($elem);
    my $sib = $elem->snext_sibling();
    return $self->violation('Nothing following "grep"?',
        'It seems there is a lone "grep" in your code?',
        $elem) if !$sib;
    my $arg = $sib;
    if ( $arg->isa('PPI::Structure::List') ) {
        $arg = $arg->schild(0);
        $arg && $arg->isa('PPI::Statement::Expression')
            and $arg = $arg->schild(0);
    }
    if ($arg && $arg->isa('PPI::Structure::Block')) {
        my $stmt = $arg->schild(-1);
        return $self->violation($DESC,$EXPL,$sib)
            if !$stmt
            || $stmt->isa('PPI::Statement')
            && (   $stmt->schildren()==1
                || $stmt->schildren()==2
                    && $stmt->schild(1)->isa('PPI::Token::Structure')
                    && $stmt->schild(1)->content eq ';' )
            && is_ppi_constant_element($stmt->schild(0));
    }
    elsif ($arg && is_ppi_constant_element($arg))
        { return $self->violation($DESC,$EXPL,$sib) }
    return;
}

1;
[download]

Tests:

#!/usr/bin/env perl
use warnings;
use strict;

# tests for Perl::Critic::Policy::BuiltinFunctions::GrepWithSimpleValu
+e
# run me with e.g.: perl -c greptest.pl && perlcritic -3 greptest.pl

my @array = qw/a b c 1 2 3/;
my (@out,$foo);
## no critic (RequireBlockGrep)

@out = grep "foo", @array;          # bad
@out = grep /foo/, @array;          # good
@out = grep $_ eq "foo", @array;    # good

@out = grep {;} @array;             # bad
@out = grep {"foo"} @array;         # bad
@out = grep {/foo/} @array;         # good
@out = grep {123} @array;           # bad
@out = grep {0x123} @array;         # bad
@out = grep {$_ eq "foo"} @array;   # good
@out = grep {'$foo1'} @array;       # bad
@out = grep {'$foo2';} @array;      # bad
@out = grep {"$foo"} @array;        # good
@out = grep {'$foo3';;} @array;     # bad
@out = grep {'$foo4';'bar'} @array; # bad

my @ary;
push @ary, "foo" unless grep { "foo" } @ary;       # bad
push @ary, "foo" unless grep { $_ eq "foo" } @ary; # good
[download]