File Coverage

blib/lib/App/File/Grepper.pm
Criterion Covered Total %
statement 15 71 21.1
branch 0 54 0.0
condition 0 12 0.0
subroutine 5 9 55.5
pod 0 1 0.0
total 20 147 13.6


line stmt bran cond sub pod time code
1             #! perl
2              
3             package App::File::Grepper;
4              
5 1     1   72549 use warnings;
  1         3  
  1         35  
6 1     1   5 use strict;
  1         2  
  1         100  
7              
8             =head1 NAME
9              
10             App::File::Grepper - Greps files for pattern
11              
12             =cut
13              
14             our $VERSION = '1.01';
15              
16             =head1 SYNOPSIS
17              
18             Runs a File::Find on the specified directories, and greps all text
19             files for a pattern.
20              
21             use App::File::Grepper;
22             App::File::Grepper->main( $options, @dirs );
23              
24             =head1 RATIONALE
25              
26             There are many tools that can do this, e.g. C. However none of
27             these can call an editor when a file matches the search argument and
28             that is something B often need.
29              
30             =head1 OPTIONS
31              
32             The first argument to the main() method is a reference to a hash with
33             options.
34              
35             =over 4
36              
37             =item pattern
38              
39             The pattern to grep. If it starts with a slash it is interpreted as a
40             perl pattern. Otherwise it is assumed to be a literal text to grep
41             for.
42              
43             If the text does not contain any uppercase letters, matching will be
44             done case-insensitive unless overridden by option ignorecase.
45              
46             =item ignorecase
47              
48             If defined, matching will be case-insensitive according to the value
49             of ignorecase.
50              
51             =item edit-with-emacs
52              
53             Pass each file where the pattern is found to the emacs editor client.
54              
55             =item edit-with-vi
56              
57             Pass each file where the pattern is found to the vi editor.
58              
59             =item view
60              
61             Pass each file where the pattern is found to the less viewer.
62              
63             =item filter
64              
65             A perl pattern to select which files must be processed. Note that this
66             pattern is applied to the basename of each file, not the full path.
67              
68             =item exclude
69              
70             A perl pattern to select which files must be rejected. Note that this
71             pattern is applied to the basename of each file, not the full path.
72             Also, this pattern is applied before the filter pattern.
73              
74             Version control directories C, C, C<.svn>, C<.git> and
75             C<.hg> are always excluded, as are common editor backups.
76              
77             =back
78              
79             =cut
80              
81 1     1   8 use File::Find;
  1         2  
  1         70  
82 1     1   701 use Term::ANSIColor;
  1         8669  
  1         599  
83              
84             sub main {
85              
86 0     0 0   my $self = shift;
87 0 0         unshift(@_, $self) unless UNIVERSAL::isa( $self, __PACKAGE__ );
88 0           my $opts = shift;
89 0           my @dirs = @_;
90              
91 0           my $pat = $opts->{pattern};
92 0           my $edit = "";
93 0 0         if ( $opts->{'edit-with-emacs'} ) {
    0          
    0          
94 0           $edit = 'emacs';
95             }
96             elsif ( $opts->{'edit-with-vi'} ) {
97 0           $edit = 'vi';
98             }
99             elsif ( $opts->{'view'} ) {
100 0           $edit = 'less';
101             }
102              
103             my $ignorecase =
104             defined($opts->{ignorecase})
105             ? $opts->{ignorecase}
106 0 0         : $pat !~ /[A-Z]/;
107              
108 0           my $opat = $pat;
109              
110 0 0         $pat = $pat =~ m;^/(.*); ? qr/$1/ :
    0          
111             $ignorecase ? qr/\Q$pat\E/i : qr/\Q$pat\E/;
112              
113             *hilite = ( !$edit && -t STDOUT )
114 0     0     ? sub { color('red bold').$_[0].color('reset') }
115 0 0 0 0     : sub { $_[0] };
  0            
116              
117 0           my $filter;
118 0 0         if ( defined $opts->{filter} ) {
119 0           $filter = $opts->{filter};
120 0           $filter = qr/$filter/;
121             }
122 0           my $exclude;
123 0 0         if ( defined $opts->{exclude} ) {
124 0           $exclude = $opts->{exclude};
125 0           $exclude = qr/$exclude/;
126             }
127             else {
128 0           $exclude = qr{ (?: ^\# | ^\.\.?(?!/) | ~$ ) }x;
129             }
130              
131 0           binmode( STDOUT, ":utf8" );
132              
133             my $grepper = sub {
134              
135             # Prune VC dirs. Always.
136 0 0 0 0     if ( -d $_ && $_ =~ /^(RCS|CVS|\.svn|\.git|\.hg)$/ ) {
137 0           $File::Find::prune = 1;
138 0           return;
139             }
140              
141             # Files only.
142 0 0         return unless -f $_;
143              
144             # Handle include/exclude filters.
145 0 0 0       if ( $exclude && ( $_ =~ $exclude ) ) {
146 0 0         warn("EXCL: $_\n") if $opts->{debug};
147 0           return;
148             }
149 0 0 0       if ( $filter && ( $_ !~ $filter ) ) {
150 0 0         warn("FLTR: $_\n") if $opts->{debug};
151 0           return;
152             }
153              
154 0           my $file = $_;
155              
156             # Okay, we've got one.
157 0 0         open( my $fh, '<', $file )
158             or warn("$File::Find::name: $!\n"), return;
159              
160 0 0         unless ( -T $fh ) {
161 0 0         warn("[Binary: $File::Find::name]\n") if $opts->{verbose};
162 0           return;
163             }
164              
165 0           binmode( $fh, 'raw' );
166              
167 1     1   668 use Encode qw(decode);
  1         10999  
  1         399  
168              
169 0           while ( <$fh> ) {
170              
171 0 0         eval {
172 0           $_ = decode( 'UTF-8', $_, 1 );
173             }
174             or $_ = decode( 'iso-8859-1', $_ );
175              
176 0 0         next unless s/^(.*?)($pat)/"$1".hilite($2)/ge;
  0            
177              
178 0 0         if ( $edit eq 'vi') {
    0          
    0          
179 0 0         system( "vi",
180             $ignorecase ? ( "+set ignorecase" ) : (),
181             "+/$opat",
182             $file );
183             }
184             elsif ( $edit eq 'emacs') {
185 0           system( "emacsclient",
186             "+$.:" . (1+length($1)),
187             $file );
188             }
189             elsif ( $edit eq 'view') {
190 0 0         system( "less",
191             $ignorecase ? ( "-i" ) : (),
192             "+/$opat",
193             $file );
194             }
195 0 0         last if $edit;
196              
197 0           print( $File::Find::name, ':',
198             $., ':',
199             1+length($1), ':',
200             $_
201             );
202             }
203              
204 0           close($fh);
205 0           };
206              
207 0           find( { wanted => $grepper,
208             no_chdir => 1,
209             }, @dirs );
210             }
211              
212             =head1 AUTHOR
213              
214             Johan Vromans, C<< >>
215              
216             =head1 BUGS
217              
218             Please report any bugs or feature requests to C, or through
219             the web interface at L. I will be notified, and then you'll
220             automatically be notified of progress on your bug as I make changes.
221              
222             =head1 SUPPORT
223              
224             You can find documentation for this module with the perldoc command.
225              
226             perldoc App::File::Grepper
227              
228              
229             You can also look for information at:
230              
231             =over 4
232              
233             =item * RT: CPAN's request tracker
234              
235             L
236              
237             =item * CPAN Ratings
238              
239             L
240              
241             =item * Search CPAN
242              
243             L
244              
245             =back
246              
247             =head1 ACKNOWLEDGEMENTS
248              
249             This program was inspired by C not having a B<-e> option.
250              
251             =head1 COPYRIGHT & LICENSE
252              
253             Copyright 2012,2016 Johan Vromans, all rights reserved.
254              
255             This program is free software; you can redistribute it and/or modify it
256             under the same terms as Perl itself.
257              
258              
259             =cut
260              
261             1; # End of App::File::Grepper