File Coverage

blib/lib/File/CodeSearch.pm
Criterion Covered Total %
statement 109 120 90.8
branch 40 64 62.5
condition 25 58 43.1
subroutine 17 17 100.0
pod 2 2 100.0
total 193 261 73.9


line stmt bran cond sub pod time code
1             package File::CodeSearch;
2              
3             # Created on: 2009-08-07 18:32:44
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 2     2   61252 use Moose;
  2         378327  
  2         13  
10 2     2   12304 use warnings;
  2         4  
  2         57  
11 2     2   568 use version;
  2         1510  
  2         15  
12 2     2   713 use autodie;
  2         21771  
  2         10  
13 2     2   11960 use English qw/ -no_match_vars /;
  2         2670  
  2         15  
14 2     2   1306 use IO::Handle;
  2         11337  
  2         118  
15 2     2   778 use File::chdir;
  2         4752  
  2         176  
16 2     2   551 use File::TypeCategories;
  2         268961  
  2         75  
17 2     2   754 use Clone qw/clone/;
  2         3752  
  2         115  
18 2     2   1018 use Path::Tiny;
  2         15941  
  2         2481  
19              
20             our $VERSION = version->new('0.7.5');
21              
22             has regex => (
23             is => 'rw',
24             isa => 'File::CodeSearch::RegexBuilder',
25             required => 1,
26             );
27             has files => (
28             is => 'rw',
29             isa => 'File::TypeCategories',
30             default => sub { File::TypeCategories->new },
31             );
32             has recurse => (
33             is => 'rw',
34             isa => 'Bool',
35             default => 1,
36             );
37             has breadth => (
38             is => 'rw',
39             isa => 'Bool',
40             default => 0,
41             );
42             has depth => (
43             is => 'rw',
44             isa => 'Bool',
45             default => 0,
46             );
47             has quiet => (
48             is => 'rw',
49             isa => 'Bool',
50             default => 0,
51             );
52             has suround_before => (
53             is => 'rw',
54             isa => 'Int',
55             default => 0,
56             );
57             has suround_after => (
58             is => 'rw',
59             isa => 'Int',
60             default => 0,
61             );
62             has limit => (
63             is => 'rw',
64             isa => 'Int',
65             default => 0,
66             );
67             has links => (
68             is => 'rw',
69             isa => 'HashRef',
70             default => sub{{}},
71             init_arg => undef,
72             );
73             has found => (
74             is => 'ro',
75             isa => 'Int',
76             default => 0,
77             writer => '_found',
78             init_arg => undef,
79             );
80              
81             sub search {
82 5     5 1 4370 my ($self, $search, @dirs) = @_;
83              
84 5         12 for my $dir (@dirs) {
85 5         15 $self->_find($search, $dir);
86             }
87              
88 5         14 return;
89             }
90              
91             sub _find {
92 11     11   34 my ($self, $search, $dir, $parent) = @_;
93 11         14 my @files;
94 11         24 $dir =~ s{/$}{};
95              
96             # check if we have a directory and we can change into it
97 11 50 66     283 return if !-d $dir || !-r $dir || !-x $dir;
      33        
98              
99             {
100 10         21 local $CWD = $dir;
  10         60  
101 10         390 opendir my $dirh, '.';
102 10 100       1437 @files = sort _alpha_num grep { $_ ne '.' && $_ ne '..' } readdir $dirh;
  50         189  
103              
104 10 100       275 if ($self->breadth) {
    100          
105 3         28 @files = sort _breadth @files;
106             }
107             elsif ($self->depth) {
108 3         23 @files = sort _depth @files;
109             }
110             }
111              
112 10 50       227 $dir = $dir eq '.' ? '' : "$dir/";
113              
114             FILE:
115 10         27 for my $file (@files) {
116 30 50       828 next FILE if !$self->files->file_ok("$dir$file");
117 30 50 33     29559 last FILE if $self->limit && $self->found >= $self->limit;
118              
119 30 50       317 if (-l "$dir$file") {
120 0 0       0 next FILE if !$self->files->symlinks;
121              
122 0         0 my $real = path("$dir$file");
123 0         0 $real = $real->realpath;
124 0   0     0 $self->links->{$real} ||= 0;
125              
126 0 0       0 next FILE if $self->links->{$real}++;
127             }
128 30 100       198 if (-d "$dir$file") {
129 6 50       170 if ($self->recurse) {
130 6   66     39 $self->_find( $search, "$dir$file", $parent || $dir );
131             }
132             }
133             else {
134 24   66     153 $self->search_file( $search, "$dir$file", $parent || $dir );
135             }
136             }
137              
138 10         40 return;
139             }
140              
141             sub _alpha_num {
142 42     42   53 my $a1 = $a;
143 42         50 my $b1 = $b;
144 42         69 $a1 =~ s/(\d+)/sprintf "%5d", $1/exms;
  3         13  
145 42         53 $b1 =~ s/(\d+)/sprintf "%5d", $1/exms;
  1         4  
146 42         76 return $a1 cmp $b1;
147             }
148             sub _breadth {
149             return
150 4 100 66 4   83 -f $a && -d $b ? 1
    50 66        
151             : -d $a && -f $b ? -1
152             : 0;
153             }
154             sub _depth {
155             return
156 4 100 66 4   100 -f $a && -d $b ? -1
    50 66        
157             : -d $a && -f $b ? 1
158             : 0;
159             }
160              
161             sub search_file {
162 24     24 1 61 my ($self, $search, $file, $parent) = @_;
163              
164 24 50 0     111 open my $fh, '<', $file or $self->_message(file => $file, $OS_ERROR) and return;
165              
166 24         4492 $self->regex->reset_file;
167 24         594 $self->regex->current_file($file);
168 24         597 my $before_max = $self->suround_before;
169 24         575 my $after_max = $self->suround_after;
170 24         63 my @before;
171             my @after;
172 24         0 my @lines;
173 24         30 my $found = undef;
174 24         166 my %args = ( codesearch => $self, before => \@before, after => \@after, lines => \@lines, parent => $parent );
175 24         46 my @sub_matches;
176             my $post;
177              
178             LINE:
179 24         442 while ( my $line = <$fh> ) {
180 4508 50       108318 if ( $self->regex->isa('File::CodeSearch::Replacer') ) {
181 0         0 push @lines, $line;
182             }
183 4508 100       10764 if (!defined $found) {
    50          
184 1219         2539 push @before, $line;
185 1219 100       2416 shift @before if @before > $before_max + 1;
186             }
187             elsif ($found) {
188 3289         6306 push @after, $line;
189 3289 50       5762 if (@after > $after_max) {
190 3289         4297 undef $found;
191             }
192             }
193              
194 4508 50 33     5567 last LINE if @{$self->regex->sub_not_matches} && $self->regex->sub_not_match;
  4508         103248  
195              
196 4508 100       100789 next LINE if !$self->regex->match($line);
197              
198 3312         5745 pop @before;
199 3312 100 66     10204 pop @after if $args{last_line_no} && $fh->input_line_number - $args{last_line_no} > $after_max - 1;
200              
201 3312 50       54795 if (@{$self->regex->sub_matches}) {
  3312         82169  
202 0         0 push @sub_matches, clone [ $line, $file, $fh->input_line_number, %args ];
203             }
204             else {
205 3312         74323 $self->_found( $self->found + 1 );
206 3312         7464 $post = $search->($line, $file, $fh->input_line_number, %args);
207 3312 50 33     138523 last LINE if $self->limit && $self->found >= $self->limit;
208             }
209              
210 3312         7581 $args{last_line_no} = $fh->input_line_number;
211 3312         44623 @after = ();
212 3312         10409 $found = 1;
213             }
214              
215 24 50 33     51 if ( @{$self->regex->sub_matches} && $self->regex->sub_match ) {
  24         672  
216             SUB:
217 0         0 for my $args (@sub_matches) {
218 0         0 $self->_found( $self->found + 1 );
219 0         0 $post = $search->( @$args );
220 0 0 0     0 last SUB if $self->limit && $self->found >= $self->limit;
221             }
222             }
223              
224             # check if the line is an after match
225 24 50 0     99 if (
      33        
      66        
226             $post
227             || (
228             @after
229             && (
230             ! @{$self->regex->sub_matches}
231             || $self->regex->sub_match
232             )
233             )
234             ) {
235 11 50 33     46 pop @after if $args{last_line_no} && $fh->input_line_number - $args{last_line_no} > $after_max - 1;
236 11         177 @before = ();
237 11         245 $self->_found( $self->found + 1 );
238 11         28 $search->(undef, $file, $fh->input_line_number, %args);
239             }
240              
241 24         673 return;
242             }
243              
244             sub _message {
245 2     2   1034 my ($self, $type, $name, $error) = @_;
246              
247 2 100       51 if ( !$self->quiet ) {
248 1         15 warn "Could not open the $type '$name': $error\n";
249             }
250              
251 2         12 return 1;
252             }
253              
254             1;
255              
256             __END__
257              
258             =head1 NAME
259              
260             File::CodeSearch - Search file contents in code repositories
261              
262             =head1 VERSION
263              
264             This documentation refers to File::CodeSearch version 0.7.5.
265              
266             =head1 SYNOPSIS
267              
268             use File::CodeSearch;
269              
270             # Simple usage
271             code_search {
272             my ($file, $line) = @_;
273             # do stuff
274             },
275             @dirs;
276              
277             # More control
278             my $cs = File::CodeSearch->new();
279             $cs->code_search(sub {}, @dirs);
280              
281             =head1 DESCRIPTION
282              
283             =head1 SUBROUTINES/METHODS
284              
285             =head2 C<new ( %params )>
286              
287             B<Parameters>:
288              
289             =over 4
290              
291             =item C<regex> - L<File::CodeSearch::RegexBuilder>
292              
293             This is the object that handles the testing of individual lines in a file
294             and must be created with the search options desired, note you can also use
295             the C<F::C::Highlighter> and C<F::C::Replacer> modules interchangeably with
296             C<F::C::RegexBuilder>.
297              
298             =item C<files> - L<File::TypeCategories>
299              
300             If you desire to limit files by file type, name, symlink status pass this
301             object, other wise a default object will be created.
302              
303             =item C<recurse> - Bool
304              
305             Set to false to not recurse into sub directories.
306              
307             =item C<breadth> - Bool
308              
309             Changes the search order to breadth first i.e. the searching will search all
310             the ordinary files in a directory before searching the directories. The
311             default is to search directories when they are found.
312              
313             =item C<depth> - Bool
314              
315             Changes the search order to depth first i.e. the searching will search all the
316             sub directories in a directory before searching the ordinary files. The
317             default is to search directories when they are found. If both C<breadth> and
318             C<depth> are both true C<breadth> will be used.
319              
320             =item C<suround_before> - Int
321              
322             Specifies the maximum number of lines before a match is found that should be
323             passed to the searching code reference.
324              
325             =item C<suround_after> - Int
326              
327             Specifies the maximum number of lines after a match is found that should be
328             passed to the searching code reference. B<Note> the after match lines are
329             passed to the next matched line in a file or to a call at the end of a file
330             with matches.
331              
332             =item C<limit> - Int
333              
334             Stops matching after C<limit> matches have been found across all files that
335             have been searched.
336              
337             =back
338              
339             B<Return>: C<File::CodeSearch> - new object
340              
341             B<Description>: Creates & configure a C<File::CodeSearch> object.
342              
343             =head2 C<search ( $search, @dirs )>
344              
345             B<Arguments>:
346              
347             =over 4
348              
349             =item C<$search> - code ref
350              
351             Subroutine to be executed each time a match in a file is found.
352              
353             The subroutine should have accept parameters as
354              
355             $search->($line, $file, $line_number, %named);
356              
357             =over 4
358              
359             =item C<$line> - string
360              
361             The line from the file that was matched by C<regex>. If searching with
362             C<after> set this may be undefined when called with the lines found after
363             the last match at the end of the file.
364              
365             =item C<$file>
366              
367             The file name that the line was found in (relative to the supplied directory
368              
369             =item C<$line_number>
370              
371             The line number in the said file
372              
373             =item C<%named>
374              
375             This contains all the other helpful values
376              
377             =over 4
378              
379             =item C<codesearch> - C<F::CodeSearch>
380              
381             The object that is doing the searching.
382              
383             =item C<before> - ArrayRef
384              
385             An array of lines that were found before the matched line.
386              
387             =item C<after> - ArrayRef
388              
389             An array of lines that were found after the last matched line.
390              
391             =item C<lines> - ArrayRef
392              
393             An array of lines of the file. This is only present if C<regex> is a
394             C<F::C::Replacer> object.
395              
396             =item C<parent> - path
397              
398             The parent path from @path
399              
400             =back
401              
402             =back
403              
404             =item C<@dir> - paths
405              
406             An array of the directory paths to search through.
407              
408             =back
409              
410             B<Return>:
411              
412             B<Description>:
413              
414             =head2 C<search_file ( $search, $file, $parent )>
415              
416             B<Param>:
417              
418             =over 4
419              
420             =item C<$search> - CodeRef
421              
422             See C<search> above for details.
423              
424             =item C<$file> - file
425              
426             A file to search through line by line
427              
428             =item C<$parent> - path
429              
430             The directory from @dirs which the file was found in
431              
432             =back
433              
434             B<Description>: Searches an individual file for matches.
435              
436             =head1 DIAGNOSTICS
437              
438             =head1 CONFIGURATION AND ENVIRONMENT
439              
440             =head1 DEPENDENCIES
441              
442             =head1 INCOMPATIBILITIES
443              
444             =head1 BUGS AND LIMITATIONS
445              
446             There are no known bugs in this module.
447              
448             Please report problems to Ivan Wills (ivan.wills@gmail.com).
449              
450             Patches are welcome.
451              
452             =head1 AUTHOR
453              
454             Ivan Wills - (ivan.wills@gmail.com)
455              
456             =head1 LICENSE AND COPYRIGHT
457              
458             Copyright (c) 2009-2011 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
459             All rights reserved.
460              
461             This module is free software; you can redistribute it and/or modify it under
462             the same terms as Perl itself. See L<perlartistic>. This program is
463             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
464             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
465             PARTICULAR PURPOSE.
466              
467             =cut