File Coverage

blib/lib/App/Grepl.pm
Criterion Covered Total %
statement 148 168 88.1
branch 61 74 82.4
condition 15 18 83.3
subroutine 22 24 91.6
pod 8 8 100.0
total 254 292 86.9


line stmt bran cond sub pod time code
1             package App::Grepl;
2              
3 6     6   114429 use warnings;
  6         11  
  6         194  
4 6     6   28 use strict;
  6         12  
  6         173  
5              
6 6     6   29 use base 'App::Grepl::Base';
  6         15  
  6         2780  
7 6     6   1936 use App::Grepl::Results;
  6         14  
  6         147  
8              
9 6     6   5746 use File::Next;
  6         14244  
  6         201  
10 6     6   5923 use PPI; # we'll need to cache
  6         988840  
  6         262  
11 6     6   65 use Scalar::Util 'reftype';
  6         19  
  6         1671  
12              
13             =head1 NAME
14              
15             App::Grepl - PPI-powered grep
16              
17             =head1 VERSION
18              
19             Version 0.01
20              
21             =cut
22              
23             our $VERSION = '0.01';
24              
25             my %HANDLER_FOR;
26              
27             BEGIN {
28             %HANDLER_FOR = (
29 9         49 quote => { stringify => sub { shift->string } },
30             heredoc => {
31             class => 'Token::HereDoc',
32             stringify => sub {
33            
34             # heredoc lines are terminated with newlines
35 2         10 my @strings = shift->heredoc;
36 2         20 return join '' => @strings;
37             },
38             },
39             pod => {
40             stringify => sub {
41            
42             # pod lines lines are *not* terminated with newlines
43 1         7 my @strings = shift->lines;
44 1         30 return join "\n" => @strings;
45             },
46             },
47 2         11 comment => { stringify => sub { shift->content } }
48 6     6   100 );
49 6         30 foreach my $token ( keys %HANDLER_FOR ) {
50 24   66     135 $HANDLER_FOR{$token}{class} ||= "Token::\u$token";
51              
52             # let them make it plural if they want
53 24         88 $HANDLER_FOR{ $token . 's' }{class} = $HANDLER_FOR{$token}{class};
54 24         13769 $HANDLER_FOR{ $token . 's' }{stringify} =
55             $HANDLER_FOR{$token}{stringify};
56             }
57             }
58              
59             =head1 SYNOPSIS
60              
61             Use PPI to search through Perl documents.
62              
63             use App::Grepl;
64              
65             my $grepl = App::Grepl->new( {
66             dir => $some_dir,
67             look_for => [ 'pod', 'heredoc' ],
68             pattern => $some_regex,
69             } );
70             $grepl->search;
71              
72             =head1 DESCRIPTION
73              
74             This is B code. Probably has bugs and the output format of C is
75             likely to change at some point. Also, we'll add more things you can search
76             for in the future. Right now, you should just need to add them to the
77             C<%HANDLER_FOR> hash.
78              
79             This software allows you to 'grep' through Perl documents. Further, you can
80             specify which I of the documents you wish to search through. While you
81             can use the class API directly, generally you'll use the C program
82             which is automatically installed. For example, to search all comments for
83             'XXX' or 'xxx':
84              
85             grepl --dir lib/ --pattern '(?i:XXX)' --search comments
86              
87             See C for more examples of that interface.
88              
89             See L for what you can search through. This will be expanded
90             as time goes on. Patches very welcome.
91              
92             =head1 METHODS
93              
94             =head2 Class Methods
95              
96             =head3 C
97              
98             my $grepl = App::Grepl->new( {
99             dir => $some_dir,
100             look_for => [ 'pod', 'heredoc' ],
101             } );
102              
103             The constructor takes a hashref of a rich variety of arguments. This is
104             because the nature of what we're looking for can be quite complex.
105              
106             The following keys are allowed (all are optional).
107              
108             =over 4
109              
110             =item * C
111              
112             Specify the directory to search in. Cannot be used with the C
113             argument.
114              
115             =item * C
116              
117             Specify an exact list of files to search in. Cannot be used with the C
118             argument.
119              
120             =item * C
121              
122             A scalar or array ref of the items (referred to as 'tokens') in Perl files to
123             look for. If this key is omitted, default to:
124              
125             [ 'quote', 'heredoc' ]
126              
127             See L for a list of which tokens you can search against.
128              
129             =item * C
130              
131             Specify a pattern to search against. This may be any valid Perl regular
132             expression. Only results matching the pattern will be returned.
133              
134             Will C if the pattern is not a valid regular expression.
135              
136             =item * C
137              
138             By default, warnings are off. Passing this a true value will enable warnings.
139             Currently, the only warning generated is when C cannot parse the file.
140             This may be useful for debugging.
141              
142             =item * C
143              
144             By default, this value is false. If passed a true value, only filenames whose
145             contents match the pattern for the tokens will be returned.
146              
147             Note that This is optimized internally. Once I match is found, we stop
148             searching the document. Thus, individual results are not available if
149             C is true.
150              
151             =back
152              
153             Additional keys may be added in the future.
154              
155             =head3 C
156              
157             The following token types are currently searchable:
158              
159             =over 4
160              
161             =item * C
162              
163             Matches quoted strings (but not heredocs).
164              
165             =item * C
166              
167             Matches heredocs.
168              
169             =item * C
170              
171             Matches POD.
172              
173             =item * C
174              
175             Matches comments.
176              
177             =back
178              
179             Note that for convenience, you may specify a plural version of each token type
180             ('heredocs' instead of 'heredoc').
181              
182             =cut
183              
184             sub _initialize {
185 14     14   29 my ( $self, $arg_for ) = @_;
186              
187 14         52 $self->dir( delete $arg_for->{dir} );
188 13         49 $self->files( delete $arg_for->{files} );
189 11         49 $self->look_for( delete $arg_for->{look_for} );
190 10         40 $self->pattern( delete $arg_for->{pattern} );
191 10         33 $self->warnings( delete $arg_for->{warnings} );
192 10         33 $self->filename_only( delete $arg_for->{filename_only} );
193 10 100       14 unless ( @{ $self->look_for } ) {
  10         27  
194 8         42 $self->look_for( [qw/ quote heredoc /] );
195             }
196              
197 10 100       67 if ( my @keys = sort keys %$arg_for ) {
198 1         4 local $" = ", ";
199 1         7 $self->_croak("Unknown keys to new: (@keys)");
200             }
201 9 100 66     27 if ( !$self->dir and !@{ $self->files } ) {
  6         19  
202 3         10 $self->dir('.');
203             }
204 9 100 100     26 if ( $self->dir and @{ $self->files } ) {
  6         13  
205 1         65 $self->_croak('You cannot specify both "dir" and "files"');
206             }
207 8         26 return $self;
208             }
209              
210             =head3 C
211              
212             if ( App::Grepl->handler_for('heredoc') ) {
213             ...
214             }
215              
216             Returns a boolean value indicating whether or not a particular token type can
217             be handled. Generally used internally..
218              
219             =cut
220              
221             sub handler_for {
222 53     53 1 79 my ( $class, $token ) = @_;
223 53         243 return $HANDLER_FOR{$token};
224             }
225              
226             sub _class_for {
227 9     9   66 my ( $class, $token_name ) = @_;
228 9 50       26 if ( my $class_for = $class->handler_for($token_name)->{class} ) {
229 9         61 return $class_for;
230             }
231 0         0 $class->_croak("Cannot determine class for token ($token_name)");
232             }
233              
234             sub _to_string {
235 14     14   27 my ( $class, $token_name, $token ) = @_;
236 14 50       32 if ( my $to_string = $class->handler_for($token_name)->{stringify} ) {
237 14         35 return $to_string->($token);
238             }
239 0         0 $class->_croak("Cannot determine to_string method for ($token_name)");
240             }
241              
242             =head2 Instance Methods
243              
244             =head3 C
245              
246             my $dir = $grepl->dir;
247             $grepl->dir($dir);
248              
249             Getter/setter for the directory to search in.
250              
251             Will C if the directory cannot be found.
252              
253             =cut
254              
255             sub dir {
256 46     46 1 69 my $self = shift;
257 46 100       205 return $self->{dir} unless @_;
258 19         28 my $dir = shift;
259 19 100       50 if ( !defined $dir ) {
260 11         39 $self->{dir} = undef;
261 11         23 return $self;
262             }
263 8 100       189 unless ( -d $dir ) {
264 1         7 $self->_croak("Cannot find directory ($dir)");
265             }
266 7         33 $self->{dir} = $dir;
267 7         17 return $self;
268             }
269              
270             =head3 C
271              
272             my $files = $grepl->files; # array ref
273             my @files = $grepl->files;
274             $grepl->files(\@files);
275             $grepl->files($file); # convenience
276              
277             Getter/setter for files to search in.
278              
279             Will C if any of the files cannot be found or read.
280              
281             =cut
282              
283             sub files {
284 28     28 1 39 my $self = shift;
285 28 100       68 unless (@_) {
286 15 100       83 return wantarray ? @{ $self->{files} } : $self->{files};
  1         7  
287             }
288 13         21 my $files = shift;
289 13 100       35 if ( !defined $files ) {
290 7         18 $self->{files} = [];
291 7         16 return $self;
292             }
293              
294 6 100 100     53 $files = [$files] unless 'ARRAY' eq ( reftype $files || '' );
295 6         15 foreach my $file (@$files) {
296 7 100 66     161 unless ( -e $file && -r _ ) {
297 2         9 $self->_croak("Cannot find or read file ($file)");
298             }
299             }
300 4         13 $self->{files} = $files;
301             }
302              
303             =head3 C
304              
305             my $look_for = $grepl->look_for; # array ref
306             my @look_for = $grepl->look_for;
307             $grepl->look_for( [qw/ pod heredoc /] );
308             $grepl->look_for('pod'); # convenience
309              
310             Getter/setter for the token types to search.
311              
312             Will C if any of the token types cannot be found.
313              
314             =cut
315              
316             sub look_for {
317 34     34 1 57 my $self = shift;
318 34 100       95 unless (@_) {
319 15 100       75 return wantarray ? @{ $self->{look_for} } : $self->{look_for};
  5         24  
320             }
321 19         28 my $look_for = shift;
322 19 100       44 if ( !defined $look_for ) {
323 8         17 $self->{look_for} = [];
324 8         18 return $self;
325             }
326              
327 11 100 100     90 $look_for = [$look_for] unless 'ARRAY' eq ( reftype $look_for || '' );
328 11         25 foreach my $look_for (@$look_for) {
329 20 100       52 unless ( $self->handler_for($look_for) ) {
330 1         5 $self->_croak("Don't know how to look_for ($look_for)");
331             }
332             }
333 10         86 $self->{look_for} = $look_for;
334             }
335              
336             =head3 C
337              
338             my $pattern = $grepl->pattern;
339             $grepl->pattern($patten);
340              
341             Getter/setter for the pattern to search for. Defaults to the empty string.
342             The pattern must be a valid Perl regular expression.
343              
344             Will C if if supplied with an invalid pattern.
345              
346             =cut
347              
348             sub pattern {
349 17     17 1 33 my $self = shift;
350 17 100       57 return $self->{pattern} unless @_;
351 12         20 my $test_pattern = shift;
352 12   100     55 $test_pattern ||= '';
353 12         16 my $pattern = eval { qr/$test_pattern/ };
  12         126  
354 12 100       40 if ( my $error = $@ ) {
355 1         6 $self->_croak("Could not search on ($test_pattern): $error");
356             }
357 11         23 $self->{pattern} = $pattern;
358 11         21 return $self;
359             }
360              
361             =head3 C
362              
363             if ( $grepl->warnings ) {
364             warn $some_message;
365             }
366             $grepl->warnings(0); # turn warnings off
367             $grepl->warnings(1); # turn warnings on
368              
369             Turn warnings on or off. By defalt, warnings are off.
370              
371             =cut
372              
373             sub warnings {
374 15     15 1 1078 my $self = shift;
375 15 100       60 return $self->{warnings} unless @_;
376 12         25 $self->{warnings} = shift;
377 12         25 return $self;
378             }
379              
380             =head3 C
381              
382             if ( $grepl->filename_only ) { ... }
383             $grepl->filename_only(1);
384              
385             Boolean getter/setter for whether to only report matching filenames. If true,
386             result objects returned from C will only report a matching filename
387             and attempting to fetch results from the will C.
388              
389             =cut
390              
391             sub filename_only {
392 26     26 1 45 my $self = shift;
393 26 100       114 return $self->{filename_only} unless @_;
394 10         28 $self->{filename_only} = shift;
395             }
396              
397             =head3 C
398              
399             $grepl->search;
400              
401             This method searches the chosen directories or files for the chosen
402             C. Only tokens listed in C will be searched.
403              
404             If called in void context, will print the results, if any to C. If
405             C is true, will only print the filenames of matching files.
406              
407             If results are found, returns a list or array reference (depending upon
408             whether it's called in list or scalar context) of C
409             objects. If you prefer to use the C API instead of the C
410             program, you can process the results as follows:
411              
412             my @results = $grepl->search;
413             foreach my $found (@results) {
414             print $found->file, "\n";
415             while ( my $result = $found->next ) {
416             print $result->token, "matched:\n";
417             while ( my $item = $result->next ) {
418             print "\t$item\n";
419             }
420             }
421             }
422              
423             =cut
424              
425             sub search {
426 4     4 1 10 my $self = shift;
427 4         19 my $files = $self->_file_iterator;
428 4         309 my @search;
429 4 50       18 if ( !defined wantarray ) {
430              
431             # called in void context so they want results sent to C.
432 0         0 require Data::Dumper;
433 0         0 $Data::Dumper::Terse = 1;
434             }
435 4         15 while ( defined ( my $file = $files->() ) ) {
436 5         508 my $found = $self->_search_for_tokens_in($file);
437 5 50       2156 next unless $found;
438 5 50       20 if ( !defined wantarray ) {
439 0         0 $self->_print_results($found);
440             }
441             else {
442 5         25 push @search => $found;
443             }
444             }
445 4 50       90 return wantarray ? @search : \@search;
446             }
447              
448             sub _print_results {
449 0     0   0 my ( $self, $found ) = @_;
450 0         0 print $found->file."\n";
451 0 0       0 next if $self->filename_only;
452              
453 0         0 while ( my $result = $found->next ) {
454 0         0 print " '". $result->token, "' matched:\n";
455 0         0 while ( my $item = $result->next ) {
456 0         0 $item =~ s/\n/\n /g;
457 0         0 print " ".Data::Dumper::Dumper($item);
458             }
459             }
460 0         0 return $self;
461             }
462              
463             sub _search_for_tokens_in {
464 5     5   10 my ( $self, $file ) = @_;
465 5         18 my $pattern = $self->pattern;
466 5         60 my $doc = PPI::Document->new( $file, readonly => 1 );
467 5 50       38759 unless ($doc) {
468 0         0 $self->_warn("Cannot create a PPI document for ($file). Skipping.");
469 0         0 return;
470             }
471 5         79 my $found = App::Grepl::Results->new( { file => $file } );
472 5         77 $found->filename_only( $self->filename_only );
473 5         19 foreach my $token ( $self->look_for ) {
474 9         33 my $class = $self->_class_for($token);
475 9 100       15 my @found = @{ $doc->find($class) || [] };
  9         53  
476 9         15995 my @results;
477 9         20 foreach my $result (@found) {
478 14         41 $result = $self->_to_string( $token, $result );
479 14 100       204 next unless $result =~ $pattern;
480              
481             # a tiny optimization
482 11 100       26 if ( $self->filename_only ) {
483 1         12 return $found;
484             }
485 10         26 push @results => $result;
486             }
487 8 100       44 $found->add_results( $token => \@results ) if @results;
488             }
489 4 50       19 return unless $found->have_results;
490 4         33 return $found;
491             }
492              
493             sub _file_iterator {
494 4     4   9 my $self = shift;
495 4 100       40 if ( my $dir = $self->dir ) {
    50          
496 3         19 return File::Next::files($dir);
497             }
498             elsif ( my $files = $self->files ) {
499 1     3   7 return sub { shift @$files };
  3         14  
500             }
501 0           $self->_croak("No files or directories to search in!");
502             }
503              
504             sub _warn {
505 0     0     my ( $self, $message ) = @_;
506 0 0         return unless $self->warnings;
507 0           warn "$message\n";
508             }
509              
510             =head1 AUTHOR
511              
512             Curtis Poe, C<< >>
513              
514             =head1 BUGS
515              
516             Please report any bugs or feature requests to
517             C, or through the web interface at
518             L.
519             I will be notified, and then you'll automatically be notified of progress on
520             your bug as I make changes.
521              
522             =over 4
523              
524             =item * Currently line numbers are not available.
525              
526             =back
527              
528             =head1 SUPPORT
529              
530             You can find documentation for this module with the perldoc command.
531              
532             perldoc App::Grepl
533              
534             You can also look for information at:
535              
536             =over 4
537              
538             =item * AnnoCPAN: Annotated CPAN documentation
539              
540             L
541              
542             =item * CPAN Ratings
543              
544             L
545              
546             =item * RT: CPAN's request tracker
547              
548             L
549              
550             =item * Search CPAN
551              
552             L
553              
554             =back
555              
556             =head1 ACKNOWLEDGEMENTS
557              
558             =head1 COPYRIGHT & LICENSE
559              
560             Copyright 2007 Curtis Poe, all rights reserved.
561              
562             This program is free software; you can redistribute it and/or modify it
563             under the same terms as Perl itself.
564              
565             =cut
566              
567             1; # End of App::Grepl