Perl-Critic / PPI

53 stars 44 forks source link

new policies (please someone release these if they want them): #204

Closed karenetheridge closed 7 years ago

karenetheridge commented 7 years ago

In my $work's codebase I was cleaning out some old code and found these policy modules which I am removing. Please someone feel free to adopt this code and release it (as separate distributions, not part of PPI core) if they interest you.

Credit should to go Ray Goldberger (no known current email address), 2009.

package Perl::Critic::Policy::ProhibitLoopControlInGrepOrMap;

use strict;
use warnings;
use base 'Perl::Critic::Policy';

use Perl::Critic::Utils qw(:severities :classification :ppi :data_conversion);
use Perl::Critic::Exception::Fatal::Internal qw(throw_internal);
use Readonly;

#-----------------------------------------------------------------------------

Readonly::Scalar my $DESC => q(loop control used from within 'grep' or 'map');
Readonly::Scalar my $EXPL => q(Use a for loop);

#-----------------------------------------------------------------------------

sub supported_parameters { return ()                  }
sub default_severity     { return $SEVERITY_HIGHEST   }
sub default_themes       { return qw(core bugs)       }
sub applies_to           { return 'PPI::Token::Word'  }

#-----------------------------------------------------------------------------

sub violates {
    my ($self, $elem, undef) = @_;

    return unless 'grep' eq $elem or 'map' eq $elem;
    return unless is_function_call($elem);

    my $arg = first_arg($elem) or return;
    return unless $arg->isa('PPI::Structure::Block');

    return unless $self->_node_has_loop_control($arg);

    return $self->violation($DESC, $EXPL, $elem);
}

Readonly::Hash my %LOOP_CONTROLLERS => hashify qw(last next redo);

sub _node_has_loop_control {
    my ($self, $node) = @_;

    return 1 if $node->isa('PPI::Token::Word') and $LOOP_CONTROLLERS{$node};

    return unless $node->can('schildren');
    for my $child ($node->schildren) {
        return 1 if $self->_node_has_loop_control($child);
    }
}

1;

__END__

=head1 NAME

Perl::Critic::Policy::ProhibitLoopControlInGrepOrMap

=head1 DESCRIPTION

Loop control (last, next, or redo) should not be used from within C<grep>
or C<map>.

=cut
package Perl::Critic::Policy::BuiltinFunctions::ProhibitReturnInBlockArg;

use strict;
use warnings;
use base 'Perl::Critic::Policy';

use Perl::Critic::Utils qw(:severities :classification :ppi);
use Perl::Critic::Exception::Fatal::Internal qw(throw_internal);
use Readonly;

#-----------------------------------------------------------------------------

Readonly::Scalar my $DESC =>
    q{"return" used in a block that is not a subroutine or eval};
Readonly::Scalar my $EXPL => q{Don't do it!};

#-----------------------------------------------------------------------------

sub supported_parameters { return ()                  }
sub default_severity     { return $SEVERITY_HIGHEST   }
sub default_themes       { return qw(core bugs)       }
sub applies_to           { return 'PPI::Token::Word'  }

#-----------------------------------------------------------------------------

sub violates {
    my ($self, $elem, undef) = @_;

    return unless is_function_call($elem);
    return if 'sub' eq $elem or 'eval' eq $elem;

    my $arg = first_arg($elem) or return;
    return unless $arg->isa('PPI::Structure::Block');

    return unless $self->_node_has_return($arg);

    return $self->violation($DESC, $EXPL, $elem);
}

sub _node_has_return {
    my ($self, $node) = @_;

    return 1 if $node->isa('PPI::Token::Word') and 'return' eq $node;

    return unless $node->can('schildren');
    for my $child ($node->schildren) {
        return 1 if $self->_node_has_return($child);
    }
}

1;

__END__

=head1 NAME

Perl::Critic::Policy::BuiltinFunctions::ProhibitReturnInBlockArg

=head1 DESCRIPTION

Only a subroutine, subref or eval block should call C<return>.

=cut
karenetheridge commented 7 years ago

oops, this isn't the Perl-Critic queue! moved to https://github.com/Perl-Critic/Perl-Critic/issues/770