1#       $Id: /mirror/lab/perl/File-Find-Rule/lib/File/Find/Rule.pm 2102 2006-06-01T15:39:03.942922Z richardc  $
2
3package File::Find::Object::Rule;
4$File::Find::Object::Rule::VERSION = '0.0313';
5use strict;
6use warnings;
7
8use 5.008;
9
10use vars qw/$AUTOLOAD/;
11use File::Spec;
12use Text::Glob 'glob_to_regex';
13use Number::Compare;
14use Carp qw/croak/;
15use File::Find::Object;    # we're only wrapping for now
16use File::Basename;
17use Cwd;                   # 5.00503s File::Find goes screwy with max_depth == 0
18
19use Class::XSAccessor accessors => {
20    "extras"    => "extras",
21    "finder"    => "finder",
22    "_match_cb" => "_match_cb",
23    "rules"     => "rules",
24    "_relative" => "_relative",
25    "_subs"     => "_subs",
26    "_maxdepth" => "_maxdepth",
27    "_mindepth" => "_mindepth",
28};
29
30# we'd just inherit from Exporter, but I want the colon
31sub import
32{
33    my $pkg = shift;
34    my $to  = caller;
35    for my $sym (qw( find rule ))
36    {
37        no strict 'refs';
38        *{"$to\::$sym"} = \&{$sym};
39    }
40    for ( grep /^:/, @_ )
41    {
42        my ($extension) = /^:(.*)/;
43        eval "require File::Find::Object::Rule::$extension";
44        croak "couldn't bootstrap File::Find::Object::Rule::$extension: $@"
45            if $@;
46    }
47}
48
49
50# the procedural shim
51
52*rule = \&find;
53
54sub find
55{
56    my $object = __PACKAGE__->new();
57    my $not    = 0;
58
59    while (@_)
60    {
61        my $method = shift;
62        my @args;
63
64        if ( $method =~ s/^\!// )
65        {
66            # jinkies, we're really negating this
67            unshift @_, $method;
68            $not = 1;
69            next;
70        }
71        unless ( defined prototype $method )
72        {
73            my $args = shift;
74            @args = ref $args eq 'ARRAY' ? @$args : $args;
75        }
76        if ($not)
77        {
78            $not    = 0;
79            @args   = ref($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
90sub new
91{
92    # We need this to maintain compatibility with File-Find-Object.
93    # However, Randal Schwartz recommends against this practice in general:
94    # http://www.stonehenge.com/merlyn/UnixReview/col52.html
95    my $referent = shift;
96    my $class    = ref $referent || $referent;
97
98    return bless {
99        rules     => [],      # [0]
100        _subs     => [],      # [1]
101        iterator  => [],
102        extras    => {},
103        _maxdepth => undef,
104        _mindepth => undef,
105        _relative => 0,
106    }, $class;
107}
108
109sub _force_object
110{
111    my $object = shift;
112    if ( !ref($object) )
113    {
114        $object = $object->new();
115    }
116    return $object;
117}
118
119
120sub _flatten
121{
122    my @flat;
123    while (@_)
124    {
125        my $item = shift;
126        ref $item eq 'ARRAY' ? push @_, @{$item} : push @flat, $item;
127    }
128    return @flat;
129}
130
131sub _add_rule
132{
133    my $self     = shift;
134    my $new_rule = shift;
135
136    push @{ $self->rules() }, $new_rule;
137
138    return;
139}
140
141sub name
142{
143    my $self  = _force_object shift;
144    my @names = map { ref $_ eq "Regexp" ? $_ : glob_to_regex $_ } _flatten(@_);
145
146    $self->_add_rule(
147        {
148            rule => 'name',
149            code => join( ' || ', map { "m($_)" } @names ),
150            args => \@_,
151        }
152    );
153
154    $self;
155}
156
157
158use vars qw( %X_tests );
159%X_tests = (
160    -r              => readable => -R => r_readable => -w => writeable  => -W =>
161        r_writeable => -w       => writable => -W   => r_writable => -x =>
162        executable  => -X => r_executable   => -o   => owned => -O => r_owned =>
163
164        -e => exists    => -f => file => -z => empty => -d => directory => -s =>
165        nonempty  => -l => symlink => => -p => fifo   => -u => setuid   => -S =>
166        socket    => -g => setgid  => -b    => block  => -k => sticky   => -c =>
167        character => => -t => tty  => -M => modified  => -A => accessed => -T =>
168        ascii     => -C    => changed => -B => binary =>
169);
170
171for my $test ( keys %X_tests )
172{
173    my $sub = eval 'sub () {
174        my $self = _force_object shift;
175        $self->_add_rule({
176            code => "' . $test . ' \$path",
177            rule => "' . $X_tests{$test} . '",
178        });
179        $self;
180    } ';
181    no strict 'refs';
182    *{ $X_tests{$test} } = $sub;
183}
184
185
186use vars qw( @stat_tests );
187@stat_tests = qw( dev ino mode nlink uid gid rdev
188    size atime mtime ctime blksize blocks );
189{
190    my $i = 0;
191    for my $test (@stat_tests)
192    {
193        my $index = $i++;    # to close over
194        my $sub   = sub {
195            my $self = _force_object shift;
196
197            my @tests = map { Number::Compare->parse_to_perl($_) } @_;
198
199            $self->_add_rule(
200                {
201                    rule => $test,
202                    args => \@_,
203                    code => 'do { my $val = (stat $path)['
204                        . $index
205                        . '] || 0;'
206                        . join( '||', map { "(\$val $_)" } @tests ) . ' }',
207                }
208            );
209            $self;
210        };
211        no strict 'refs';
212        *$test = $sub;
213    }
214}
215
216
217sub any
218{
219    my $self     = _force_object shift;
220    my @rulesets = @_;
221
222    $self->_add_rule(
223        {
224            rule => 'any',
225            code => '('
226                . join( ' || ',
227                map { "( " . $_->_compile( $self->_subs() ) . " )" } @rulesets )
228                . ")",
229            args => \@rulesets,
230        }
231    );
232    $self;
233}
234
235*or = \&any;
236
237
238sub not
239{
240    my $self     = _force_object shift;
241    my @rulesets = @_;
242
243    $self->_add_rule(
244        {
245            rule => 'not',
246            args => \@rulesets,
247            code => '('
248                . join( ' && ',
249                map { "!(" . $_->_compile( $self->_subs() ) . ")" } @_ )
250                . ")",
251        }
252    );
253    $self;
254}
255
256*none = \¬
257
258
259sub prune ()
260{
261    my $self = _force_object shift;
262
263    $self->_add_rule(
264        {
265            rule => 'prune',
266            code => 'do { $self->finder->prune(); 1 }'
267        },
268    );
269
270    return $self;
271}
272
273
274sub discard ()
275{
276    my $self = _force_object shift;
277
278    $self->_add_rule(
279        {
280            rule => 'discard',
281            code => '$discarded = 1',
282        }
283    );
284
285    return $self;
286}
287
288
289sub exec
290{
291    my $self = _force_object shift;
292    my $code = shift;
293
294    $self->_add_rule(
295        {
296            rule => 'exec',
297            code => $code,
298        }
299    );
300
301    return $self;
302}
303
304
305sub grep
306{
307    my $self    = _force_object shift;
308    my @pattern = map {
309              ref $_
310            ? ref $_ eq 'ARRAY'
311                ? map { [ ( ref $_ ? $_ : qr/$_/ ) => 0 ] } @$_
312                : [ $_ => 1 ]
313            : [ qr/$_/ => 1 ]
314    } @_;
315
316    $self->exec(
317        sub {
318            local *FILE;
319            open FILE, $self->finder->item() or return;
320            local ( $_, $. );
321            while (<FILE>)
322            {
323                for my $p (@pattern)
324                {
325                    my ( $rule, $ret ) = @$p;
326                    return $ret
327                        if ref $rule eq 'Regexp'
328                        ? /$rule/
329                        : $rule->(@_);
330                }
331            }
332            return;
333        }
334    );
335}
336
337
338sub maxdepth
339{
340    my $self = _force_object shift;
341    $self->_maxdepth(shift);
342    return $self;
343}
344
345sub mindepth
346{
347    my $self = _force_object shift;
348    $self->_mindepth(shift);
349    return $self;
350}
351
352
353sub relative ()
354{
355    my $self = _force_object shift;
356    $self->_relative(1);
357
358    return $self;
359}
360
361
362sub DESTROY { }
363
364sub AUTOLOAD
365{
366    $AUTOLOAD =~ /::not_([^:]*)$/
367        or croak "Can't locate method $AUTOLOAD";
368    my $method = $1;
369
370    my $sub = sub {
371        my $self = _force_object shift;
372        $self->not( $self->new->$method(@_) );
373    };
374    {
375        no strict 'refs';
376        *$AUTOLOAD = $sub;
377    }
378    &$sub;
379}
380
381
382sub _call_find
383{
384    my $self  = shift;
385    my $paths = shift;
386
387    my $finder = File::Find::Object->new( $self->extras(), @$paths );
388
389    $self->finder($finder);
390
391    return;
392}
393
394sub _compile
395{
396    my $self = shift;
397    my $subs = shift;
398
399    return '1' unless @{ $self->rules() };
400
401    my $code = join " && ", map {
402        if ( ref $_->{code} )
403        {
404            push @$subs, $_->{code};
405            "\$subs->[$#{$subs}]->(\@args) # $_->{rule}\n";
406        }
407        else
408        {
409            "( $_->{code} ) # $_->{rule}\n";
410        }
411    } @{ $self->rules() };
412
413    return $code;
414}
415
416sub in
417{
418    my $self  = _force_object shift;
419    my @paths = @_;
420
421    $self->start(@paths);
422
423    my @results;
424
425    while ( defined( my $match = $self->match() ) )
426    {
427        push @results, $match;
428    }
429
430    return @results;
431}
432
433
434sub start
435{
436    my $self  = _force_object shift;
437    my @paths = @_;
438
439    my $fragment = $self->_compile( $self->_subs() );
440
441    my $subs = $self->_subs();
442
443    warn "relative mode handed multiple paths - that's a bit silly\n"
444        if $self->_relative() && @paths > 1;
445
446    my $code = 'sub {
447        my $path_obj = shift;
448        my $path = shift;
449
450        if (!defined($path_obj))
451        {
452            return;
453        }
454
455        $path =~ s#^(?:\./+)+##;
456        my $path_dir = dirname($path);
457        my $path_base = fileparse($path);
458        my @args = ($path_base, $path_dir, $path);
459        local $_ = $path_base;
460        my $maxdepth = $self->_maxdepth;
461        my $mindepth = $self->_mindepth;
462
463        my $comps = $path_obj->full_components();
464
465        my $depth = scalar(@$comps);
466
467        defined $maxdepth && $depth >= $maxdepth
468           and $self->finder->prune();
469
470        defined $mindepth && $depth < $mindepth
471           and return;
472
473        #print "Testing \'$_\'\n";
474
475        my $discarded;
476        return unless ' . $fragment . ';
477        return if $discarded;
478        return $path;
479    }';
480
481    #use Data::Dumper;
482    #print Dumper \@subs;
483    #warn "Compiled sub: '$code'\n";
484
485    my $callback = eval "$code" or die "compile error '$code' $@";
486
487    $self->_match_cb($callback);
488    $self->_call_find( \@paths );
489
490    return $self;
491}
492
493
494sub match
495{
496    my $self = _force_object shift;
497
498    my $finder = $self->finder();
499
500    my $match_cb   = $self->_match_cb();
501    my $preproc_cb = $self->extras()->{'preprocess'};
502
503    while ( defined( my $next_obj = $finder->next_obj() ) )
504    {
505        if ( defined($preproc_cb) && $next_obj->is_dir() )
506        {
507            $finder->set_traverse_to(
508                $preproc_cb->(
509                    $self, [ @{ $finder->get_current_node_files_list() } ]
510                )
511            );
512        }
513
514        if ( defined( my $path = $match_cb->( $next_obj, $next_obj->path() ) ) )
515        {
516            if ( $self->_relative )
517            {
518                my $comps = $next_obj->full_components();
519                if (@$comps)
520                {
521                    return (
522                        $next_obj->is_dir()
523                        ? File::Spec->catdir(@$comps)
524                        : File::Spec->catfile(@$comps)
525                    );
526                }
527            }
528            else
529            {
530                return $path;
531            }
532        }
533
534    }
535
536    return;
537}
538
5391;
540
541__END__
542
543=pod
544
545=encoding UTF-8
546
547=head1 NAME
548
549File::Find::Object::Rule - Alternative interface to File::Find::Object
550
551=head1 VERSION
552
553version 0.0313
554
555=head1 SYNOPSIS
556
557  use File::Find::Object::Rule;
558  # find all the subdirectories of a given directory
559  my @subdirs = File::Find::Object::Rule->directory->in( $directory );
560
561  # find all the .pm files in @INC
562  my @files = File::Find::Object::Rule->file()
563                              ->name( '*.pm' )
564                              ->in( @INC );
565
566  # as above, but without method chaining
567  my $rule =  File::Find::Object::Rule->new;
568  $rule->file;
569  $rule->name( '*.pm' );
570  my @files = $rule->in( @INC );
571
572=head1 DESCRIPTION
573
574File::Find::Object::Rule is a friendlier interface to L<File::Find::Object> .
575It allows you to build rules which specify the desired files and directories.
576
577B<WARNING> : This module is a fork of version 0.30 of L<File::Find::Rule>
578(which has been unmaintained for several years as of February, 2009), and may
579still have some bugs due to its reliance on File::Find'isms. As such it is
580considered Alpha software. Please report any problems with
581L<File::Find::Object::Rule> to its RT CPAN Queue.
582
583=head1 METHODS
584
585=over
586
587=item C<new>
588
589A constructor.  You need not invoke C<new> manually unless you wish
590to, as each of the rule-making methods will auto-create a suitable
591object if called as class methods.
592
593=back
594
595=head2 finder
596
597The L<File::Find::Object> finder instance itself.
598
599=head2 my @rules = @{$ffor->rules()};
600
601The rules to match against. For internal use only.
602
603=head2 Matching Rules
604
605=over
606
607=item C<name( @patterns )>
608
609Specifies names that should match.  May be globs or regular
610expressions.
611
612 $set->name( '*.mp3', '*.ogg' ); # mp3s or oggs
613 $set->name( qr/\.(mp3|ogg)$/ ); # the same as a regex
614 $set->name( 'foo.bar' );        # just things named foo.bar
615
616=item -X tests
617
618Synonyms are provided for each of the -X tests. See L<perlfunc/-X> for
619details.  None of these methods take arguments.
620
621  Test | Method               Test |  Method
622 ------|-------------        ------|----------------
623   -r  |  readable             -R  |  r_readable
624   -w  |  writeable            -W  |  r_writeable
625   -w  |  writable             -W  |  r_writable
626   -x  |  executable           -X  |  r_executable
627   -o  |  owned                -O  |  r_owned
628       |                           |
629   -e  |  exists               -f  |  file
630   -z  |  empty                -d  |  directory
631   -s  |  nonempty             -l  |  symlink
632       |                       -p  |  fifo
633   -u  |  setuid               -S  |  socket
634   -g  |  setgid               -b  |  block
635   -k  |  sticky               -c  |  character
636       |                       -t  |  tty
637   -M  |  modified                 |
638   -A  |  accessed             -T  |  ascii
639   -C  |  changed              -B  |  binary
640
641Though some tests are fairly meaningless as binary flags (C<modified>,
642C<accessed>, C<changed>), they have been included for completeness.
643
644 # find nonempty files
645 $rule->file,
646      ->nonempty;
647
648=item stat tests
649
650The following C<stat> based methods are provided: C<dev>, C<ino>,
651C<mode>, C<nlink>, C<uid>, C<gid>, C<rdev>, C<size>, C<atime>,
652C<mtime>, C<ctime>, C<blksize>, and C<blocks>.  See L<perlfunc/stat>
653for details.
654
655Each of these can take a number of targets, which will follow
656L<Number::Compare> semantics.
657
658 $rule->size( 7 );         # exactly 7
659 $rule->size( ">7Ki" );    # larger than 7 * 1024 * 1024 bytes
660 $rule->size( ">=7" )
661      ->size( "<=90" );    # between 7 and 90, inclusive
662 $rule->size( 7, 9, 42 );  # 7, 9 or 42
663
664=item C<any( @rules )>
665
666=item C<or( @rules )>
667
668Allows shortcircuiting boolean evaluation as an alternative to the
669default and-like nature of combined rules.  C<any> and C<or> are
670interchangeable.
671
672 # find avis, movs, things over 200M and empty files
673 $rule->any( File::Find::Object::Rule->name( '*.avi', '*.mov' ),
674             File::Find::Object::Rule->size( '>200M' ),
675             File::Find::Object::Rule->file->empty,
676           );
677
678=item C<none( @rules )>
679
680=item C<not( @rules )>
681
682Negates a rule.  (The inverse of C<any>.)  C<none> and C<not> are
683interchangeable.
684
685  # files that aren't 8.3 safe
686  $rule->file
687       ->not( $rule->new->name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ ) );
688
689=item C<prune>
690
691Traverse no further.  This rule always matches.
692
693=item C<discard>
694
695Don't keep this file.  This rule always matches.
696
697=item C<exec( \&subroutine( $shortname, $path, $fullname ) )>
698
699Allows user-defined rules.  Your subroutine will be invoked with parameters of
700the name, the path you're in, and the full relative filename.
701In addition, C<$_> is set to the current short name, but its use is
702discouraged since as opposed to File::Find::Rule, File::Find::Object::Rule
703does not cd to the containing directory.
704
705Return a true value if your rule matched.
706
707 # get things with long names
708 $rules->exec( sub { length > 20 } );
709
710=item ->grep( @specifiers );
711
712Opens a file and tests it each line at a time.
713
714For each line it evaluates each of the specifiers, stopping at the
715first successful match.  A specifier may be a regular expression or a
716subroutine.  The subroutine will be invoked with the same parameters
717as an ->exec subroutine.
718
719It is possible to provide a set of negative specifiers by enclosing
720them in anonymous arrays.  Should a negative specifier match the
721iteration is aborted and the clause is failed.  For example:
722
723 $rule->grep( qr/^#!.*\bperl/, [ sub { 1 } ] );
724
725Is a passing clause if the first line of a file looks like a perl
726shebang line.
727
728=item C<maxdepth( $level )>
729
730Descend at most C<$level> (a non-negative integer) levels of directories
731below the starting point.
732
733May be invoked many times per rule, but only the most recent value is
734used.
735
736=item C<mindepth( $level )>
737
738Do not apply any tests at levels less than C<$level> (a non-negative
739integer).
740
741=item C<extras( \%extras )>
742
743Specifies extra values to pass through to C<File::File::find> as part
744of the options hash.
745
746For example this allows you to specify following of symlinks like so:
747
748 my $rule = File::Find::Object::Rule->extras({ follow => 1 });
749
750May be invoked many times per rule, but only the most recent value is
751used.
752
753=item C<relative>
754
755Trim the leading portion of any path found
756
757=item C<not_*>
758
759Negated version of the rule.  An effective shortand related to ! in
760the procedural interface.
761
762 $foo->not_name('*.pl');
763
764 $foo->not( $foo->new->name('*.pl' ) );
765
766=back
767
768=head2 Query Methods
769
770=over
771
772=item C<in( @directories )>
773
774Evaluates the rule, returns a list of paths to matching files and
775directories.
776
777=item C<start( @directories )>
778
779Starts a find across the specified directories.  Matching items may
780then be queried using L</match>.  This allows you to use a rule as an
781iterator.
782
783 my $rule = File::Find::Object::Rule->file->name("*.jpeg")->start( "/web" );
784 while ( my $image = $rule->match ) {
785     ...
786 }
787
788=item C<match>
789
790Returns the next file which matches, false if there are no more.
791
792=back
793
794=head2 Extensions
795
796Extension modules are available from CPAN in the File::Find::Object::Rule
797namespace.  In order to use these extensions either use them directly:
798
799 use File::Find::Object::Rule::ImageSize;
800 use File::Find::Object::Rule::MMagic;
801
802 # now your rules can use the clauses supplied by the ImageSize and
803 # MMagic extension
804
805or, specify that File::Find::Object::Rule should load them for you:
806
807 use File::Find::Object::Rule qw( :ImageSize :MMagic );
808
809For notes on implementing your own extensions, consult
810L<File::Find::Object::Rule::Extending>
811
812=head2 Further examples
813
814=over
815
816=item Finding perl scripts
817
818 my $finder = File::Find::Object::Rule->or
819  (
820   File::Find::Object::Rule->name( '*.pl' ),
821   File::Find::Object::Rule->exec(
822                          sub {
823                              if (open my $fh, $_) {
824                                  my $shebang = <$fh>;
825                                  close $fh;
826                                  return $shebang =~ /^#!.*\bperl/;
827                              }
828                              return 0;
829                          } ),
830  );
831
832Based upon this message http://use.perl.org/comments.pl?sid=7052&cid=10842
833
834=item ignore CVS directories
835
836 my $rule = File::Find::Object::Rule->new;
837 $rule->or($rule->new
838                ->directory
839                ->name('CVS')
840                ->prune
841                ->discard,
842           $rule->new);
843
844Note here the use of a null rule.  Null rules match anything they see,
845so the effect is to match (and discard) directories called 'CVS' or to
846match anything.
847
848=back
849
850=head1 TWO FOR THE PRICE OF ONE
851
852File::Find::Object::Rule also gives you a procedural interface.  This is
853documented in L<File::Find::Object::Rule::Procedural>
854
855=head1 EXPORTS
856
857=head2 find
858
859=head2 rule
860
861=head1 Tests
862
863=head2 accessed
864
865Corresponds to C<-A>.
866
867=head2 ascii
868
869Corresponds to C<-T>.
870
871=head2 atime
872
873See "stat tests".
874
875=head2 binary
876
877Corresponds to C<-b>.
878
879=head2 blksize
880
881See "stat tests".
882
883=head2 block
884
885Corresponds to C<-b>.
886
887=head2 blocks
888
889See "stat tests".
890
891=head2 changed
892
893Corresponds to C<-C>.
894
895=head2 character
896
897Corresponds to C<-c>.
898
899=head2 ctime
900
901See "stat tests".
902
903=head2 dev
904
905See "stat tests".
906
907=head2 directory
908
909Corresponds to C<-d>.
910
911=head2 empty
912
913Corresponds to C<-z>.
914
915=head2 executable
916
917Corresponds to C<-x>.
918
919=head2 exists
920
921Corresponds to C<-e>.
922
923=head2 fifo
924
925Corresponds to C<-p>.
926
927=head2 file
928
929Corresponds to C<-f>.
930
931=head2 gid
932
933See "stat tests".
934
935=head2 ino
936
937See "stat tests".
938
939=head2 mode
940
941See "stat tests".
942
943=head2 modified
944
945Corresponds to C<-M>.
946
947=head2 mtime
948
949See "stat tests".
950
951=head2 nlink
952
953See "stat tests".
954
955=head2 r_executable
956
957Corresponds to C<-X>.
958
959=head2 r_owned
960
961Corresponds to C<-O>.
962
963=head2 nonempty
964
965A predicate that determines if the file is empty. Uses C<-s>.
966
967=head2 owned
968
969Corresponds to C<-o>.
970
971=head2 r_readable
972
973Corresponds to C<-R>.
974
975=head2 r_writeable
976
977=head2 r_writable
978
979Corresponds to C<-W>.
980
981=head2 rdev
982
983See "stat tests".
984
985=head2 readable
986
987Corresponds to C<-r>.
988
989=head2 setgid
990
991Corresponds to C<-g>.
992
993=head2 setuid
994
995Corresponds to C<-u>.
996
997=head2 size
998
999See stat tests.
1000
1001=head2 socket
1002
1003Corresponds to C<-S>.
1004
1005=head2 sticky
1006
1007Corresponds to C<-k>.
1008
1009=head2 symlink
1010
1011Corresponds to C<-l>.
1012
1013=head2 uid
1014
1015See "stat tests".
1016
1017=head2 tty
1018
1019Corresponds to C<-t>.
1020
1021=head2 writable()
1022
1023Corresponds to C<-w>.
1024
1025=head1 BUGS
1026
1027The code relies on qr// compiled regexes, therefore this module
1028requires perl version 5.005_03 or newer.
1029
1030Currently it isn't possible to remove a clause from a rule object.  If
1031this becomes a significant issue it will be addressed.
1032
1033=head1 AUTHOR
1034
1035Richard Clamp <richardc@unixbeard.net> with input gained from this
1036use.perl discussion: http://use.perl.org/~richardc/journal/6467
1037
1038Additional proofreading and input provided by Kake, Greg McCarroll,
1039and Andy Lester andy@petdance.com.
1040
1041Ported to use L<File::Find::Object> as File::Find::Object::Rule by
1042Shlomi Fish.
1043
1044=head1 COPYRIGHT
1045
1046Copyright (C) 2002, 2003, 2004, 2006 Richard Clamp.  All Rights Reserved.
1047
1048This module is free software; you can redistribute it and/or modify it
1049under the same terms as Perl itself.
1050
1051=head1 SEE ALSO
1052
1053L<File::Find::Object>, L<Text::Glob>, L<Number::Compare>, find(1)
1054
1055If you want to know about the procedural interface, see
1056L<File::Find::Object::Rule::Procedural>, and if you have an idea for a neat
1057extension, see  L<File::Find::Object::Rule::Extending> .
1058
1059L<Path::Class::Rule> ’s SEE ALSO contains a review of many directory traversal
1060modules on CPAN, including L<File::Find::Object::Rule> and L<File::Find::Rule>
1061(on which this module is based).
1062
1063=head1 KNOWN BUGS
1064
1065The tests don't run successfully when directly inside an old Subversion
1066checkout, due to the presence of C<.svn> directories. C<./Build disttest> or
1067C<./Build distruntest> run fine.
1068
1069=begin Developers
1070
1071Implementation notes:
1072
1073[0] Currently we use an array of anonymous subs, and call those
1074repeatedly from match.  It'll probably be way more effecient to
1075instead eval-string compile a dedicated matching sub, and call that to
1076avoid the repeated sub dispatch.
1077
1078[1] Though [0] isn't as true as it once was, I'm not sure that the
1079subs stack is exposed in quite the right way.  Maybe it'd be better as
1080a private global hash.  Something like $subs{$self} = []; and in
1081C<DESTROY>, delete $subs{$self}.
1082
1083That'd make compiling subrules really much easier (no need to pass
1084@subs in for context), and things that work via a mix of callbacks and
1085code fragments are possible (you'd probably want this for the stat
1086tests).
1087
1088Need to check this currently working version in before I play with
1089that though.
1090
1091[*] There's probably a win to be made with the current model in making
1092stat calls use C<_>.  For
1093
1094  find( file => size => "> 20M" => size => "< 400M" );
1095
1096up to 3 stats will happen for each candidate.  Adding a priming _
1097would be a bit blind if the first operation was C< name => 'foo' >,
1098since that can be tested by a single regex.  Simply checking what the
1099next type of operation doesn't work since any arbritary exec sub may
1100or may not stat.  Potentially worse, they could stat something else
1101like so:
1102
1103  # extract from the worlds stupidest make(1)
1104  find( exec => sub { my $f = $_; $f =~ s/\.c$/.o/ && !-e $f } );
1105
1106Maybe the best way is to treat C<_> as invalid after calling an exec,
1107and doc that C<_> will only be meaningful after stat and -X tests if
1108they're wanted in exec blocks.
1109
1110=end Developers
1111
1112=for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
1113
1114=head1 SUPPORT
1115
1116=head2 Websites
1117
1118The following websites have more information about this module, and may be of help to you. As always,
1119in addition to those websites please use your favorite search engine to discover more resources.
1120
1121=over 4
1122
1123=item *
1124
1125MetaCPAN
1126
1127A modern, open-source CPAN search engine, useful to view POD in HTML format.
1128
1129L<https://metacpan.org/release/File-Find-Object-Rule>
1130
1131=item *
1132
1133RT: CPAN's Bug Tracker
1134
1135The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN.
1136
1137L<https://rt.cpan.org/Public/Dist/Display.html?Name=File-Find-Object-Rule>
1138
1139=item *
1140
1141CPANTS
1142
1143The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.
1144
1145L<http://cpants.cpanauthors.org/dist/File-Find-Object-Rule>
1146
1147=item *
1148
1149CPAN Testers
1150
1151The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions.
1152
1153L<http://www.cpantesters.org/distro/F/File-Find-Object-Rule>
1154
1155=item *
1156
1157CPAN Testers Matrix
1158
1159The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms.
1160
1161L<http://matrix.cpantesters.org/?dist=File-Find-Object-Rule>
1162
1163=item *
1164
1165CPAN Testers Dependencies
1166
1167The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution.
1168
1169L<http://deps.cpantesters.org/?module=File::Find::Object::Rule>
1170
1171=back
1172
1173=head2 Bugs / Feature Requests
1174
1175Please report any bugs or feature requests by email to C<bug-file-find-object-rule at rt.cpan.org>, or through
1176the web interface at L<https://rt.cpan.org/Public/Bug/Report.html?Queue=File-Find-Object-Rule>. You will be automatically notified of any
1177progress on the request by the system.
1178
1179=head2 Source Code
1180
1181The code is open to the world, and available for you to hack on. Please feel free to browse it and play
1182with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
1183from your repository :)
1184
1185L<https://github.com/shlomif/http://bitbucket.org/shlomif/perl-file-find-object-rule>
1186
1187  git clone git://github.com/shlomif/http://bitbucket.org/shlomif/perl-file-find-object-rule.git
1188
1189=head1 AUTHORS
1190
1191=over 4
1192
1193=item *
1194
1195Richard Clamp <richardc@unixbeard.net>
1196
1197=item *
1198
1199Andy Lester andy@petdance.com.
1200
1201=back
1202
1203=head1 BUGS
1204
1205Please report any bugs or feature requests on the bugtracker website
1206L<https://github.com/shlomif/http://bitbucket.org/shlomif/perl-file-find-object-rule/issues>
1207
1208When submitting a bug or request, please include a test-file or a
1209patch to an existing test-file that illustrates the bug or desired
1210feature.
1211
1212=head1 COPYRIGHT AND LICENSE
1213
1214This software is copyright (c) 2021 by Richard Clamp.
1215
1216This is free software; you can redistribute it and/or modify it under
1217the same terms as the Perl 5 programming language system itself.
1218
1219=cut
1220