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 |