← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/pan_genome_post_analysis
  Run on Fri Mar 27 10:01:31 2015
Reported on Fri Mar 27 10:03:11 2015

Filename/Users/ap13/perl5/lib/perl5/File/Find/Rule.pm
StatementsExecuted 143 statements in 4.27ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1113.83ms4.03msFile::Find::Rule::::BEGIN@9File::Find::Rule::BEGIN@9
111602µs827µsFile::Find::Rule::::BEGIN@6File::Find::Rule::BEGIN@6
111319µs400µsFile::Find::Rule::::BEGIN@7File::Find::Rule::BEGIN@7
11119µs19µsFile::Find::Rule::::importFile::Find::Rule::import
11115µs34µsFile::Find::Rule::::BEGIN@4File::Find::Rule::BEGIN@4
11110µs38µsFile::Find::Rule::::BEGIN@195File::Find::Rule::BEGIN@195
1119µs21µsFile::Find::Rule::::BEGIN@18File::Find::Rule::BEGIN@18
1118µs19µsFile::Find::Rule::::BEGIN@471File::Find::Rule::BEGIN@471
1118µs18µsFile::Find::Rule::::BEGIN@511File::Find::Rule::BEGIN@511
1118µs18µsFile::Find::Rule::::BEGIN@225File::Find::Rule::BEGIN@225
1117µs30µsFile::Find::Rule::::BEGIN@248File::Find::Rule::BEGIN@248
1117µs29µsFile::Find::Rule::::BEGIN@8File::Find::Rule::BEGIN@8
1117µs18µsFile::Find::Rule::::BEGIN@268File::Find::Rule::BEGIN@268
1116µs6µsFile::Find::Rule::::BEGIN@5File::Find::Rule::BEGIN@5
0000s0sFile::Find::Rule::::AUTOLOADFile::Find::Rule::AUTOLOAD
0000s0sFile::Find::Rule::::DESTROYFile::Find::Rule::DESTROY
0000s0sFile::Find::Rule::::__ANON__[:267]File::Find::Rule::__ANON__[:267]
0000s0sFile::Find::Rule::::__ANON__[:435]File::Find::Rule::__ANON__[:435]
0000s0sFile::Find::Rule::::__ANON__[:470]File::Find::Rule::__ANON__[:470]
0000s0sFile::Find::Rule::::__ANON__[:509]File::Find::Rule::__ANON__[:509]
0000s0sFile::Find::Rule::::_call_findFile::Find::Rule::_call_find
0000s0sFile::Find::Rule::::_compileFile::Find::Rule::_compile
0000s0sFile::Find::Rule::::_flattenFile::Find::Rule::_flatten
0000s0sFile::Find::Rule::::_force_objectFile::Find::Rule::_force_object
0000s0sFile::Find::Rule::::anyFile::Find::Rule::any
0000s0sFile::Find::Rule::::discardFile::Find::Rule::discard
0000s0sFile::Find::Rule::::execFile::Find::Rule::exec
0000s0sFile::Find::Rule::::findFile::Find::Rule::find
0000s0sFile::Find::Rule::::grepFile::Find::Rule::grep
0000s0sFile::Find::Rule::::inFile::Find::Rule::in
0000s0sFile::Find::Rule::::matchFile::Find::Rule::match
0000s0sFile::Find::Rule::::nameFile::Find::Rule::name
0000s0sFile::Find::Rule::::newFile::Find::Rule::new
0000s0sFile::Find::Rule::::notFile::Find::Rule::not
0000s0sFile::Find::Rule::::pruneFile::Find::Rule::prune
0000s0sFile::Find::Rule::::relativeFile::Find::Rule::relative
0000s0sFile::Find::Rule::::startFile::Find::Rule::start
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# $Id$
2
3package File::Find::Rule;
4226µs252µs
# spent 34µs (15+19) within File::Find::Rule::BEGIN@4 which was called: # once (15µs+19µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 4
use strict;
# spent 34µs making 1 call to File::Find::Rule::BEGIN@4 # spent 19µs making 1 call to strict::import
5224µs16µs
# spent 6µs within File::Find::Rule::BEGIN@5 which was called: # once (6µs+0s) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 5
use File::Spec;
# spent 6µs making 1 call to File::Find::Rule::BEGIN@5
6296µs2865µs
# spent 827µs (602+225) within File::Find::Rule::BEGIN@6 which was called: # once (602µs+225µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 6
use Text::Glob 'glob_to_regex';
# spent 827µs making 1 call to File::Find::Rule::BEGIN@6 # spent 38µs making 1 call to Exporter::import
72100µs1400µs
# spent 400µs (319+82) within File::Find::Rule::BEGIN@7 which was called: # once (319µs+82µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 7
use Number::Compare;
# spent 400µs making 1 call to File::Find::Rule::BEGIN@7
8222µs251µs
# spent 29µs (7+22) within File::Find::Rule::BEGIN@8 which was called: # once (7µs+22µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 8
use Carp qw/croak/;
# spent 29µs making 1 call to File::Find::Rule::BEGIN@8 # spent 22µs making 1 call to Exporter::import
92151µs14.03ms
# spent 4.03ms (3.83+207µs) within File::Find::Rule::BEGIN@9 which was called: # once (3.83ms+207µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 9
use File::Find (); # we're only wrapping for now
# spent 4.03ms making 1 call to File::Find::Rule::BEGIN@9
10
111800nsour $VERSION = '0.33';
12
13# we'd just inherit from Exporter, but I want the colon
14
# spent 19µs within File::Find::Rule::import which was called: # once (19µs+0s) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 14 of lib/Bio/Roary/CommandLine/RoaryPostAnalysis.pm
sub import {
15622µs my $pkg = shift;
16 my $to = caller;
17 for my $sym ( qw( find rule ) ) {
182445µs234µs
# spent 21µs (9+12) within File::Find::Rule::BEGIN@18 which was called: # once (9µs+12µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 18
no strict 'refs';
# spent 21µs making 1 call to File::Find::Rule::BEGIN@18 # spent 12µs making 1 call to strict::unimport
19 *{"$to\::$sym"} = \&{$sym};
20 }
21 for (grep /^:/, @_) {
22 my ($extension) = /^:(.*)/;
23 eval "require File::Find::Rule::$extension";
24 croak "couldn't bootstrap File::Find::Rule::$extension: $@" if $@;
25 }
26}
27
28=head1 NAME
29
30File::Find::Rule - Alternative interface to File::Find
31
32=head1 SYNOPSIS
33
34 use File::Find::Rule;
35 # find all the subdirectories of a given directory
36 my @subdirs = File::Find::Rule->directory->in( $directory );
37
38 # find all the .pm files in @INC
39 my @files = File::Find::Rule->file()
40 ->name( '*.pm' )
41 ->in( @INC );
42
43 # as above, but without method chaining
44 my $rule = File::Find::Rule->new;
45 $rule->file;
46 $rule->name( '*.pm' );
47 my @files = $rule->in( @INC );
48
49=head1 DESCRIPTION
50
51File::Find::Rule is a friendlier interface to File::Find. It allows
52you to build rules which specify the desired files and directories.
53
54=cut
55
56# the procedural shim
57
5811µs*rule = \&find;
59sub find {
60 my $object = __PACKAGE__->new();
61 my $not = 0;
62
63 while (@_) {
64 my $method = shift;
65 my @args;
66
67 if ($method =~ s/^\!//) {
68 # jinkies, we're really negating this
69 unshift @_, $method;
70 $not = 1;
71 next;
72 }
73 unless (defined prototype $method) {
74 my $args = shift;
75 @args = ref $args eq 'ARRAY' ? @$args : $args;
76 }
77 if ($not) {
78 $not = 0;
79 @args = $object->new->$method(@args);
80 $method = "not";
81 }
82
83 my @return = $object->$method(@args);
84 return @return if $method eq 'in';
85 }
86 $object;
87}
88
89
90=head1 METHODS
91
92=over
93
94=item C<new>
95
96A constructor. You need not invoke C<new> manually unless you wish
97to, as each of the rule-making methods will auto-create a suitable
98object if called as class methods.
99
100=cut
101
102sub new {
103 my $referent = shift;
104 my $class = ref $referent || $referent;
105 bless {
106 rules => [],
107 subs => {},
108 iterator => [],
109 extras => {},
110 maxdepth => undef,
111 mindepth => undef,
112 }, $class;
113}
114
115sub _force_object {
116 my $object = shift;
117 $object = $object->new()
118 unless ref $object;
119 $object;
120}
121
122=back
123
124=head2 Matching Rules
125
126=over
127
128=item C<name( @patterns )>
129
130Specifies names that should match. May be globs or regular
131expressions.
132
133 $set->name( '*.mp3', '*.ogg' ); # mp3s or oggs
134 $set->name( qr/\.(mp3|ogg)$/ ); # the same as a regex
135 $set->name( 'foo.bar' ); # just things named foo.bar
136
137=cut
138
139sub _flatten {
140 my @flat;
141 while (@_) {
142 my $item = shift;
143 ref $item eq 'ARRAY' ? push @_, @{ $item } : push @flat, $item;
144 }
145 return @flat;
146}
147
148sub name {
149 my $self = _force_object shift;
150 my @names = map { ref $_ eq "Regexp" ? $_ : glob_to_regex $_ } _flatten( @_ );
151
152 push @{ $self->{rules} }, {
153 rule => 'name',
154 code => join( ' || ', map { "m{$_}" } @names ),
155 args => \@_,
156 };
157
158 $self;
159}
160
161=item -X tests
162
163Synonyms are provided for each of the -X tests. See L<perlfunc/-X> for
164details. None of these methods take arguments.
165
166 Test | Method Test | Method
167 ------|------------- ------|----------------
168 -r | readable -R | r_readable
169 -w | writeable -W | r_writeable
170 -w | writable -W | r_writable
171 -x | executable -X | r_executable
172 -o | owned -O | r_owned
173 | |
174 -e | exists -f | file
175 -z | empty -d | directory
176 -s | nonempty -l | symlink
177 | -p | fifo
178 -u | setuid -S | socket
179 -g | setgid -b | block
180 -k | sticky -c | character
181 | -t | tty
182 -M | modified |
183 -A | accessed -T | ascii
184 -C | changed -B | binary
185
186Though some tests are fairly meaningless as binary flags (C<modified>,
187C<accessed>, C<changed>), they have been included for completeness.
188
189 # find nonempty files
190 $rule->file,
191 ->nonempty;
192
193=cut
194
1952101µs266µs
# spent 38µs (10+28) within File::Find::Rule::BEGIN@195 which was called: # once (10µs+28µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 195
use vars qw( %X_tests );
# spent 38µs making 1 call to File::Find::Rule::BEGIN@195 # spent 28µs making 1 call to vars::import
196119µs%X_tests = (
197 -r => readable => -R => r_readable =>
198 -w => writeable => -W => r_writeable =>
199 -w => writable => -W => r_writable =>
200 -x => executable => -X => r_executable =>
201 -o => owned => -O => r_owned =>
202
203 -e => exists => -f => file =>
204 -z => empty => -d => directory =>
205 -s => nonempty => -l => symlink =>
206 => -p => fifo =>
207 -u => setuid => -S => socket =>
208 -g => setgid => -b => block =>
209 -k => sticky => -c => character =>
210 => -t => tty =>
211 -M => modified =>
212 -A => accessed => -T => ascii =>
213 -C => changed => -B => binary =>
214 );
215
21615µsfor my $test (keys %X_tests) {
217271.77ms my $sub = eval 'sub () {
# spent 15µs executing statements in string eval # spent 8µs executing statements in string eval # spent 7µs executing statements in string eval # spent 7µs executing statements in string eval # spent 6µs executing statements in string eval # spent 6µs executing statements in string eval # spent 5µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 4µs executing statements in string eval # spent 3µs executing statements in string eval # spent 3µs executing statements in string eval # spent 3µs executing statements in string eval # spent 3µs executing statements in string eval # spent 3µs executing statements in string eval # spent 3µs executing statements in string eval # spent 3µs executing statements in string eval
218 my $self = _force_object shift;
219 push @{ $self->{rules} }, {
220 code => "' . $test . ' \$_",
221 rule => "'.$X_tests{$test}.'",
222 };
223 $self;
224 } ';
225241µs228µs
# spent 18µs (8+10) within File::Find::Rule::BEGIN@225 which was called: # once (8µs+10µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 225
no strict 'refs';
# spent 18µs making 1 call to File::Find::Rule::BEGIN@225 # spent 10µs making 1 call to strict::unimport
2262783µs *{ $X_tests{$test} } = $sub;
227}
228
229
230=item stat tests
231
232The following C<stat> based methods are provided: C<dev>, C<ino>,
233C<mode>, C<nlink>, C<uid>, C<gid>, C<rdev>, C<size>, C<atime>,
234C<mtime>, C<ctime>, C<blksize>, and C<blocks>. See L<perlfunc/stat>
235for details.
236
237Each of these can take a number of targets, which will follow
238L<Number::Compare> semantics.
239
240 $rule->size( 7 ); # exactly 7
241 $rule->size( ">7Ki" ); # larger than 7 * 1024 * 1024 bytes
242 $rule->size( ">=7" )
243 ->size( "<=90" ); # between 7 and 90, inclusive
244 $rule->size( 7, 9, 42 ); # 7, 9 or 42
245
246=cut
247
2482134µs253µs
# spent 30µs (7+23) within File::Find::Rule::BEGIN@248 which was called: # once (7µs+23µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 248
use vars qw( @stat_tests );
# spent 30µs making 1 call to File::Find::Rule::BEGIN@248 # spent 23µs making 1 call to vars::import
24914µs@stat_tests = qw( dev ino mode nlink uid gid rdev
250 size atime mtime ctime blksize blocks );
251{
2522900ns my $i = 0;
2531800ns for my $test (@stat_tests) {
254133µs my $index = $i++; # to close over
255 my $sub = sub {
256 my $self = _force_object shift;
257
258 my @tests = map { Number::Compare->parse_to_perl($_) } @_;
259
260 push @{ $self->{rules} }, {
261 rule => $test,
262 args => \@_,
263 code => 'do { my $val = (stat $_)['.$index.'] || 0;'.
264 join ('||', map { "(\$val $_)" } @tests ).' }',
265 };
266 $self;
2671337µs };
2682497µs228µs
# spent 18µs (7+10) within File::Find::Rule::BEGIN@268 which was called: # once (7µs+10µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 268
no strict 'refs';
# spent 18µs making 1 call to File::Find::Rule::BEGIN@268 # spent 10µs making 1 call to strict::unimport
2691322µs *$test = $sub;
270 }
271}
272
273=item C<any( @rules )>
274
275=item C<or( @rules )>
276
277Allows shortcircuiting boolean evaluation as an alternative to the
278default and-like nature of combined rules. C<any> and C<or> are
279interchangeable.
280
281 # find avis, movs, things over 200M and empty files
282 $rule->any( File::Find::Rule->name( '*.avi', '*.mov' ),
283 File::Find::Rule->size( '>200M' ),
284 File::Find::Rule->file->empty,
285 );
286
287=cut
288
289sub any {
290 my $self = _force_object shift;
291 # compile all the subrules to code fragments
292 push @{ $self->{rules} }, {
293 rule => "any",
294 code => '(' . join( ' || ', map '( ' . $_->_compile . ' )', @_ ). ')',
295 args => \@_,
296 };
297
298 # merge all the subs hashes of the kids into ourself
299 %{ $self->{subs} } = map { %{ $_->{subs} } } $self, @_;
300 $self;
301}
302
3031900ns*or = \&any;
304
305=item C<none( @rules )>
306
307=item C<not( @rules )>
308
309Negates a rule. (The inverse of C<any>.) C<none> and C<not> are
310interchangeable.
311
312 # files that aren't 8.3 safe
313 $rule->file
314 ->not( $rule->new->name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ ) );
315
316=cut
317
318sub not {
319 my $self = _force_object shift;
320
321 push @{ $self->{rules} }, {
322 rule => 'not',
323 args => \@_,
324 code => '(' . join ( ' && ', map { "!(". $_->_compile . ")" } @_ ) . ")",
325 };
326
327 # merge all the subs hashes into us
328 %{ $self->{subs} } = map { %{ $_->{subs} } } $self, @_;
329 $self;
330}
331
3321400ns*none = \&not;
333
334=item C<prune>
335
336Traverse no further. This rule always matches.
337
338=cut
339
340sub prune () {
341 my $self = _force_object shift;
342
343 push @{ $self->{rules} },
344 {
345 rule => 'prune',
346 code => '$File::Find::prune = 1'
347 };
348 $self;
349}
350
351=item C<discard>
352
353Don't keep this file. This rule always matches.
354
355=cut
356
357sub discard () {
358 my $self = _force_object shift;
359
360 push @{ $self->{rules} }, {
361 rule => 'discard',
362 code => '$discarded = 1',
363 };
364 $self;
365}
366
367=item C<exec( \&subroutine( $shortname, $path, $fullname ) )>
368
369Allows user-defined rules. Your subroutine will be invoked with C<$_>
370set to the current short name, and with parameters of the name, the
371path you're in, and the full relative filename.
372
373Return a true value if your rule matched.
374
375 # get things with long names
376 $rules->exec( sub { length > 20 } );
377
378=cut
379
380sub exec {
381 my $self = _force_object shift;
382 my $code = shift;
383
384 push @{ $self->{rules} }, {
385 rule => 'exec',
386 code => $code,
387 };
388 $self;
389}
390
391=item C<grep( @specifiers )>
392
393Opens a file and tests it each line at a time.
394
395For each line it evaluates each of the specifiers, stopping at the
396first successful match. A specifier may be a regular expression or a
397subroutine. The subroutine will be invoked with the same parameters
398as an ->exec subroutine.
399
400It is possible to provide a set of negative specifiers by enclosing
401them in anonymous arrays. Should a negative specifier match the
402iteration is aborted and the clause is failed. For example:
403
404 $rule->grep( qr/^#!.*\bperl/, [ sub { 1 } ] );
405
406Is a passing clause if the first line of a file looks like a perl
407shebang line.
408
409=cut
410
411sub grep {
412 my $self = _force_object shift;
413 my @pattern = map {
414 ref $_
415 ? ref $_ eq 'ARRAY'
416 ? map { [ ( ref $_ ? $_ : qr/$_/ ) => 0 ] } @$_
417 : [ $_ => 1 ]
418 : [ qr/$_/ => 1 ]
419 } @_;
420
421 $self->exec( sub {
422 local *FILE;
423 open FILE, $_ or return;
424 local ($_, $.);
425 while (<FILE>) {
426 for my $p (@pattern) {
427 my ($rule, $ret) = @$p;
428 return $ret
429 if ref $rule eq 'Regexp'
430 ? /$rule/
431 : $rule->(@_);
432 }
433 }
434 return;
435 } );
436}
437
438=item C<maxdepth( $level )>
439
440Descend at most C<$level> (a non-negative integer) levels of directories
441below the starting point.
442
443May be invoked many times per rule, but only the most recent value is
444used.
445
446=item C<mindepth( $level )>
447
448Do not apply any tests at levels less than C<$level> (a non-negative
449integer).
450
451=item C<extras( \%extras )>
452
453Specifies extra values to pass through to C<File::File::find> as part
454of the options hash.
455
456For example this allows you to specify following of symlinks like so:
457
458 my $rule = File::Find::Rule->extras({ follow => 1 });
459
460May be invoked many times per rule, but only the most recent value is
461used.
462
463=cut
464
4651700nsfor my $setter (qw( maxdepth mindepth extras )) {
466 my $sub = sub {
467 my $self = _force_object shift;
468 $self->{$setter} = shift;
469 $self;
47034µs };
4712143µs230µs
# spent 19µs (8+11) within File::Find::Rule::BEGIN@471 which was called: # once (8µs+11µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 471
no strict 'refs';
# spent 19µs making 1 call to File::Find::Rule::BEGIN@471 # spent 11µs making 1 call to strict::unimport
47235µs *$setter = $sub;
473}
474
475
476=item C<relative>
477
478Trim the leading portion of any path found
479
480=cut
481
482sub relative () {
483 my $self = _force_object shift;
484 $self->{relative} = 1;
485 $self;
486}
487
488=item C<not_*>
489
490Negated version of the rule. An effective shortand related to ! in
491the procedural interface.
492
493 $foo->not_name('*.pl');
494
495 $foo->not( $foo->new->name('*.pl' ) );
496
497=cut
498
499sub DESTROY {}
500sub AUTOLOAD {
501 our $AUTOLOAD;
502 $AUTOLOAD =~ /::not_([^:]*)$/
503 or croak "Can't locate method $AUTOLOAD";
504 my $method = $1;
505
506 my $sub = sub {
507 my $self = _force_object shift;
508 $self->not( $self->new->$method(@_) );
509 };
510 {
5112451µs228µs
# spent 18µs (8+10) within File::Find::Rule::BEGIN@511 which was called: # once (8µs+10µs) by Bio::Roary::CommandLine::RoaryPostAnalysis::BEGIN@14 at line 511
no strict 'refs';
# spent 18µs making 1 call to File::Find::Rule::BEGIN@511 # spent 10µs making 1 call to strict::unimport
512 *$AUTOLOAD = $sub;
513 }
514 &$sub;
515}
516
517=back
518
519=head2 Query Methods
520
521=over
522
523=item C<in( @directories )>
524
525Evaluates the rule, returns a list of paths to matching files and
526directories.
527
528=cut
529
530sub in {
531 my $self = _force_object shift;
532
533 my @found;
534 my $fragment = $self->_compile;
535 my %subs = %{ $self->{subs} };
536
537 warn "relative mode handed multiple paths - that's a bit silly\n"
538 if $self->{relative} && @_ > 1;
539
540 my $topdir;
541 my $code = 'sub {
542 (my $path = $File::Find::name) =~ s#^(?:\./+)+##;
543 my @args = ($_, $File::Find::dir, $path);
544 my $maxdepth = $self->{maxdepth};
545 my $mindepth = $self->{mindepth};
546 my $relative = $self->{relative};
547
548 # figure out the relative path and depth
549 my $relpath = $File::Find::name;
550 $relpath =~ s{^\Q$topdir\E/?}{};
551 my $depth = scalar File::Spec->splitdir($relpath);
552 #print "name: \'$File::Find::name\' ";
553 #print "relpath: \'$relpath\' depth: $depth relative: $relative\n";
554
555 defined $maxdepth && $depth >= $maxdepth
556 and $File::Find::prune = 1;
557
558 defined $mindepth && $depth < $mindepth
559 and return;
560
561 #print "Testing \'$_\'\n";
562
563 my $discarded;
564 return unless ' . $fragment . ';
565 return if $discarded;
566 if ($relative) {
567 push @found, $relpath if $relpath ne "";
568 }
569 else {
570 push @found, $path;
571 }
572 }';
573
574 #use Data::Dumper;
575 #print Dumper \%subs;
576 #warn "Compiled sub: '$code'\n";
577
578 my $sub = eval "$code" or die "compile error '$code' $@";
579 for my $path (@_) {
580 # $topdir is used for relative and maxdepth
581 $topdir = $path;
582 # slice off the trailing slash if there is one (the
583 # maxdepth/mindepth code is fussy)
584 $topdir =~ s{/?$}{}
585 unless $topdir eq '/';
586 $self->_call_find( { %{ $self->{extras} }, wanted => $sub }, $path );
587 }
588
589 return @found;
590}
591
592sub _call_find {
593 my $self = shift;
594 File::Find::find( @_ );
595}
596
597sub _compile {
598 my $self = shift;
599
600 return '1' unless @{ $self->{rules} };
601 my $code = join " && ", map {
602 if (ref $_->{code}) {
603 my $key = "$_->{code}";
604 $self->{subs}{$key} = $_->{code};
605 "\$subs{'$key'}->(\@args) # $_->{rule}\n";
606 }
607 else {
608 "( $_->{code} ) # $_->{rule}\n";
609 }
610 } @{ $self->{rules} };
611
612 #warn $code;
613 return $code;
614}
615
616=item C<start( @directories )>
617
618Starts a find across the specified directories. Matching items may
619then be queried using L</match>. This allows you to use a rule as an
620iterator.
621
622 my $rule = File::Find::Rule->file->name("*.jpeg")->start( "/web" );
623 while ( defined ( my $image = $rule->match ) ) {
624 ...
625 }
626
627=cut
628
629sub start {
630 my $self = _force_object shift;
631
632 $self->{iterator} = [ $self->in( @_ ) ];
633 $self;
634}
635
636=item C<match>
637
638Returns the next file which matches, false if there are no more.
639
640=cut
641
642sub match {
643 my $self = _force_object shift;
644
645 return shift @{ $self->{iterator} };
646}
647
648155µs1;
649
650__END__