package Perl::Critic::Policy::ControlStructures::ProhibitShiftLoopCondition;
use strict;
use warnings;
use PPIx::XPath;
use Tree::XPathEngine;

sub PPI::Structure::For::initialization {
    ( grep { $_->isa( 'PPI::Statement' ) } $_[0]->children )[0];
}

sub PPI::Structure::For::condition {
    ( grep { $_->isa( 'PPI::Statement' ) } $_[0]->children )[1];
}

sub PPI::Structure::For::afterthought {
    ( grep { $_->isa( 'PPI::Statement' ) } $_[0]->children )[2];
}
sub PPI::Token::xf { goto &PPI::Node::xf }

sub PPI::Node::xf {
    my( $node, $query ) = @_;
    $query = PPIx::XPath->clean_xpath_expr( $query );
    $::pxp ||= Tree::XPathEngine->new();
    return $::pxp->findnodes( $query, $node );
}

use Readonly;

use Perl::Critic::Utils qw{ :severities };
use base 'Perl::Critic::Policy';

our $VERSION = '0.01';

Readonly::Scalar my $DESC =>
q{don't write while(my $foo = shift @bar){...} instead write while(@bar){my $foo = shift@bar;...} };
Readonly::Scalar my $EXPL =>
q{@bar can contain undef and shift returns undef when @bar empty};

sub supported_parameters { return() }
sub default_severity     { return $SEVERITY_MEDIUM }
sub default_themes       { return qw< bugs maintenance > }
sub applies_to           { return qw/PPI::Document/ }

sub violates {
    my( $policy, $doc, $criticdoc ) = @_;
    my @violas;
    for my $node (
        $doc->xf(
            q{
  //Statement-Compound[ @type = 'for' or @type = 'foreach' or @type = 'while'   ] 
| //Statement[  ./Token-Word[.='do'] ]
                              }
        )
      )
    {
        push @violas, _violas( $policy, $node, undef );
    }
    return @violas;
} ## end sub violates

sub _violas {
    my( $self, $elem, undef ) = @_;
    my @violas;
    for my $for ( $elem->xf( q{    .//Structure-For    } ) ) {
        my $condition = $for->condition;
        my( $evil ) = $condition->xf(
            q{
    .//Token-Word[ . = 'shift' or . = 'pop' ]
    }
        );
        if( $evil ) {
            push @violas, $self->violation( $DESC, $EXPL, $condition );
        }
    }

#~ "while"   /Statement-Compound[1]/Token-Word[1]
#~ "="       /Statement-Compound[1]/Structure-Condition[1]/Statement-Variable[1]/Token-Operator[1]
#~ "shift"   /Statement-Compound[1]/Structure-Condition[1]/Statement-Variable[1]/Token-Word[2]
#~ "\$array" /Statement-Compound[1]/Structure-Condition[1]/Statement-Variable[1]/Token-Symbol[2]

    for my $while_shift_array (
        $elem->xf(
            q{
./Token-Word[ . = 'while' ]
/following-sibling::Structure-Condition
/Statement-Variable
//Token-Word[ . = 'shift' or . = 'pop' ]

                                           }
        )
      )
    {
        for my $var (
            $while_shift_array->xf(
                q{
./following-sibling::Token-Symbol[ @raw_type = '$' or @raw_type = '@' ]
| ./following-sibling::Token-Cast[ . = '@' ]
        }
            )
          )
        {
            push @violas, $self->violation( $DESC, $EXPL, $while_shift_array );
            last;
        }
    }
    return @violas;
} ## end sub _violas
1;
1;
__END__

=pod

=head1 NAME

Perl::Critic::Policy::ControlStructures::ProhibitShiftLoopCondition - don't write while(my $foo = shift @bar){...} instead write while(@bar){my $foo = shift@bar;...} 

=head1 DESCRIPTION

don't write

    while( my $foo = shift @bar ){
        ...
    }

instead write

    while( @bar ){
        my $foo = shift @bar;
        ...
    }


=head1 VERSION

Version 0.01


=head1 EVERYTHING ELSE

license, terms and EVERYTHING ELSE, same as Perl/Perl::Critic...

=cut