App::Grepl - PPI-powered grep

    use App::Grepl;

    my $grepl = App::Grepl->new( {
        dir      => $some_dir,
        look_for => [ 'pod', 'heredoc' ],
        pattern  => $some_regex,
    } );
    $grepl->search;

 grepl --dir lib/ --pattern '(?i:XXX)' --search comments

    my $grepl = App::Grepl->new( {
        dir     => $some_dir,
        look_for => [ 'pod', 'heredoc' ],
    } );

 if ( App::Grepl->handler_for('heredoc') ) {
    ...
 }

 my $dir = $grepl->dir;
 $grepl->dir($dir);

 my $files = $grepl->files;   # array ref
 my @files = $grepl->files;
 $grepl->files(\@files);
 $grepl->files($file);        # convenience

 my $look_for = $grepl->look_for;   # array ref
 my @look_for = $grepl->look_for;
 $grepl->look_for( [qw/ pod heredoc /] );
 $grepl->look_for('pod');        # convenience

 my $pattern = $grepl->pattern;
 $grepl->pattern($patten);

 if ( $grepl->warnings ) {
      warn $some_message;
 }
 $grepl->warnings(0);   # turn warnings off
 $grepl->warnings(1);   # turn warnings on

 if ( $grepl->filename_only ) { ... }
 $grepl->filename_only(1);

 $grepl->search;

 my @results = $grepl->search;
 foreach my $found (@results) {
     print $found->file, "\n";
     while ( my $result = $found->next ) {
         print $result->token, "matched:\n";
         while ( my $item = $result->next ) {
             print "\t$item\n";
         }
     }
 }

    perldoc App::Grepl

package App::Grepl;

use warnings;
use strict;

use base 'App::Grepl::Base';
use App::Grepl::Results;

use File::Next;
use PPI;    # we'll need to cache
use Scalar::Util 'reftype';

our $VERSION = '0.01';

my %HANDLER_FOR;

BEGIN {
    %HANDLER_FOR = (
        quote   => { stringify => sub { shift->string } },
        heredoc => {
            class     => 'Token::HereDoc',
            stringify => sub {
                
                # heredoc lines are terminated with newlines
                my @strings = shift->heredoc;
                return join '' => @strings;
            },
        },
        pod     => { 
            stringify => sub {
                
                # pod lines lines are *not* terminated with newlines
                my @strings = shift->lines;
                return join "\n" => @strings;
            },
        },
        comment => { stringify => sub { shift->content } }
    );
    foreach my $token ( keys %HANDLER_FOR ) {
        $HANDLER_FOR{$token}{class} ||= "Token::\u$token";

        # let them make it plural if they want
        $HANDLER_FOR{ $token . 's' }{class} = $HANDLER_FOR{$token}{class};
        $HANDLER_FOR{ $token . 's' }{stringify} =
          $HANDLER_FOR{$token}{stringify};
    }
}

sub _initialize {
    my ( $self, $arg_for ) = @_;

    $self->dir( delete $arg_for->{dir} );
    $self->files( delete $arg_for->{files} );
    $self->look_for( delete $arg_for->{look_for} );
    $self->pattern( delete $arg_for->{pattern} );
    $self->warnings( delete $arg_for->{warnings} );
    $self->filename_only( delete $arg_for->{filename_only} );
    unless ( @{ $self->look_for } ) {
        $self->look_for( [qw/ quote heredoc /] );
    }

    if ( my @keys = sort keys %$arg_for ) {
        local $" = ", ";
        $self->_croak("Unknown keys to new:  (@keys)");
    }
    if ( !$self->dir and !@{ $self->files } ) {
        $self->dir('.');
    }
    if ( $self->dir and @{ $self->files } ) {
        $self->_croak('You cannot specify both "dir" and "files"');
    }
    return $self;
}

sub handler_for {
    my ( $class, $token ) = @_;
    return $HANDLER_FOR{$token};
}

sub _class_for {
    my ( $class, $token_name ) = @_;
    if  ( my $class_for = $class->handler_for($token_name)->{class} ) {
        return $class_for;
    }
    $class->_croak("Cannot determine class for token ($token_name)");
}

sub _to_string {
    my ( $class, $token_name, $token ) = @_;
    if  ( my $to_string = $class->handler_for($token_name)->{stringify} ) {
        return $to_string->($token);
    }
    $class->_croak("Cannot determine to_string method for ($token_name)");
}

sub dir {
    my $self = shift;
    return $self->{dir} unless @_;
    my $dir = shift;
    if ( !defined $dir ) {
        $self->{dir} = undef;
        return $self;
    }
    unless ( -d $dir ) {
        $self->_croak("Cannot find directory ($dir)");
    }
    $self->{dir} = $dir;
    return $self;
}

sub files {
    my $self = shift;
    unless (@_) {
        return wantarray ? @{ $self->{files} } : $self->{files};
    }
    my $files = shift;
    if ( !defined $files ) {
        $self->{files} = [];
        return $self;
    }

    $files = [$files] unless 'ARRAY' eq ( reftype $files || '' );
    foreach my $file (@$files) {
        unless ( -e $file && -r _ ) {
            $self->_croak("Cannot find or read file ($file)");
        }
    }
    $self->{files} = $files;
}

sub look_for {
    my $self = shift;
    unless (@_) {
        return wantarray ? @{ $self->{look_for} } : $self->{look_for};
    }
    my $look_for = shift;
    if ( !defined $look_for ) {
        $self->{look_for} = [];
        return $self;
    }

    $look_for = [$look_for] unless 'ARRAY' eq ( reftype $look_for || '' );
    foreach my $look_for (@$look_for) {
        unless ( $self->handler_for($look_for) ) {
            $self->_croak("Don't know how to look_for ($look_for)");
        }
    }
    $self->{look_for} = $look_for;
}

sub pattern {
    my $self = shift;
    return $self->{pattern} unless @_;
    my $test_pattern = shift;
    $test_pattern ||= '';
    my $pattern = eval { qr/$test_pattern/ };
    if ( my $error = $@ ) {
        $self->_croak("Could not search on ($test_pattern):  $error");
    }
    $self->{pattern} = $pattern;
    return $self;
}

sub warnings {
    my $self = shift;
    return $self->{warnings} unless @_;
    $self->{warnings} = shift;
    return $self;
}

sub filename_only {
    my $self = shift;
    return $self->{filename_only} unless @_;
    $self->{filename_only} = shift;
}

sub search {
    my $self = shift;
    my $files = $self->_file_iterator;
    my @search;
    if ( !defined wantarray ) {

        # called in void context so they want results sent to C<STDOUT>.
        require Data::Dumper;
        $Data::Dumper::Terse = 1;
    }
    while ( defined ( my $file = $files->() ) ) {
        my $found = $self->_search_for_tokens_in($file);
        next unless $found;
        if ( !defined wantarray ) {
            $self->_print_results($found);
        }
        else {
            push @search => $found;
        }
    }
    return wantarray ? @search : \@search;
}

sub _print_results {
    my ( $self, $found ) = @_;
    print $found->file."\n";
    next if $self->filename_only;

    while ( my $result = $found->next ) {
        print "  '". $result->token, "' matched:\n";
        while ( my $item = $result->next ) {
            $item =~ s/\n/\n    /g;
            print "    ".Data::Dumper::Dumper($item);
        }
    }
    return $self;
}

sub _search_for_tokens_in {
    my ( $self, $file ) = @_;
    my $pattern = $self->pattern;
    my $doc = PPI::Document->new( $file, readonly => 1 );
    unless ($doc) {
        $self->_warn("Cannot create a PPI document for ($file).  Skipping.");
        return;
    }
    my $found = App::Grepl::Results->new( { file => $file } );
    $found->filename_only( $self->filename_only );
    foreach my $token ( $self->look_for ) {
        my $class     = $self->_class_for($token);
        my @found = @{ $doc->find($class) || [] };
        my @results;
        foreach my $result (@found) {
            $result = $self->_to_string( $token, $result );
            next unless $result =~ $pattern;

            # a tiny optimization
            if ( $self->filename_only ) {
                return $found;
            }
            push @results => $result;
        }
        $found->add_results( $token => \@results ) if @results;
    }
    return unless $found->have_results; 
    return $found;
}

sub _file_iterator {
    my $self = shift;
    if ( my $dir = $self->dir ) {
        return File::Next::files($dir);
    }
    elsif ( my $files = $self->files ) {
        return sub { shift @$files };
    }
    $self->_croak("No files or directories to search in!");
}

sub _warn {
    my ( $self, $message ) = @_;
    return unless $self->warnings;
    warn "$message\n";
}

1;    # End of App::Grepl