Group :: Development/Perl
RPM: perl-File-Find-Rule
Navigation
Main Changelog Spec Patches Sources Download Gear Bugs and FR Repocop
pax_global_header 0000666 0000000 0000000 00000000064 10437605046 0014517 g ustar 00root root 0000000 0000000 52 comment=b1235042a08d485034c718b6636d18245ded3598
File-Find-Rule-0.30/ 0000755 0000000 0000000 00000000000 10437605046 0014101 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/Build.PL 0000644 0000000 0000000 00000000675 10437605046 0015405 0 ustar 00root root 0000000 0000000 use strict;
use Module::Build;
Module::Build->new(
module_name => "File::Find::Rule",
license => 'perl',
script_files => [ 'findrule' ],
requires => {
'Test::More' => 0,
'Number::Compare' => 0,
'Text::Glob' => 0,
'File::Find' => 0,
'File::Spec' => 0,
'Cwd' => 0,
},
create_makefile_pl => 'traditional',
)
->create_build_script;
File-Find-Rule-0.30/Changes 0000644 0000000 0000000 00000007403 10437605046 0015400 0 ustar 00root root 0000000 0000000 0.30 Wednesday 1st June, 2006
Made './//././././///.//././/////./blah' be treated the same
as './blah' (it gets turned into 'blah')
0.29 Tuesday 16th May, 2006
Kludged around {min,max}depth and trailing slashes in path
names.
0.28 Tuesday 18th May, 2004
exposed %X_tests and @stat_tests as package variables, and make a
_call_find method for File::Find::Rule::Filesys::Virtual
0.27 Wednesday 25th February, 2004
Changed to write_makefile_pl to 'traditional' from
'passthrough'. Fixes INDIRECTLY REPORTED install problems
caused by new Module::Build being backwards incompatible.
0.26 Monday 10th November, 2003
Typo/thinko in File::Find::Rule::Extending corrected (spotted
by Jim Cromie)
Optimization to the stat-based tests. They now compile to code
fragments saving much subroutine dispatch.
0.25 Wednesday 22nd October, 2003
applied a patch from Leon Brocard to make the tests ignore CVS dirs
as well as .svn dirs.
reworked part of t/File-Find-Rule.t to not assume that t/foobar will
always be 10 bytes in size. (rt.cpan.org #3838)
now we install the findrule script
0.24 Monday 6th October, 2003
when you specify an extra of C<{ follow => 1 }> File::Find stops
populating $File::Find::topdir. This leads to warnings noise so
instead we now track $topdir ourselves.
0.23 Friday 3rd October, 2003
make the extras hash work and add a proper test for it. (Doh!)
0.22 Friday 3rd October, 2003
add in ->extras hash for passing things through to File::Find::find
0.21 Monday 15th September, 2003
pod glitch in File::Find::Rule::Procedural spotted and fixed
by Tom Hukins
0.20 8th September, 2003
- relative flag
- Fix maxdepth? - this is undertested.
- MANIFEST fixes (thanks to the cpan smokers)
- split the documentation of the procedural interface out to
File::Find::Rule::Procedural, as people often seem to get
confused that the method calls don't take anonymous arrays
after seeing the procedural code that did
- Chunky internal restructure. Now we compile a match sub
from code fragments. Though more complex, this is a big
speed win as it eliminates a lot of the subroutine dispatch.
- During the restructure we lost the ->test method. I hope
that it's not missed, since maintining it through a
deprecation cycle would be fiddly with the current _compile code.
- Split the findrule tests into their own file, and just skip
the tricky ones on Win32.
0.11 29th July, 2003
- Fix Win32 test failures (rt.cpan.org #3047)
0.10 10th March 2003
- fixup an accidental warning in the stat-based tests. Caught
by Alex Gough (rt.cpan.org #2138)
- make the findrule tests more win32 safe/shell independent (picked
up by Philip Newton)
- autogenerate READMEs from bits and pieces
0.09 21st January 2003
- Fix to the stat-based tests (spotted by Randal L. Schwartz)
- implemented our own import sub so we can bootstrap
extensions more easily
- added some documentation about using extensions.
0.08 28th October, 2002
- ->not_* and implicit s#^\./## (based on suggestions by Tony
Bowden)
- Sketchy first cut of findrule (suggestion from Tatsuhiko Miyagawa)
0.07 25th October, 2002
- Tweaks required to let extensions work
0.06 22nd October, 2002
-> Fix the code example for the ->grep clause (again from
Douglas Wilson)
0.05 21st October, 2002
- ->grep clause - from original code from Douglas Wilson
- Bugfix the demo code in the synopsis - pointed out by Barbie
0.04 10th September, 2002
- create a correctly spelled writable rule (thanks to Iain
Truskett for this one)
0.03 24th August, 2002
- backport to 5.00503 (hadn't tested before this point)
0.02 14th August, 2002
- bugfix ->exec subrule invocation (thanks to Chris Carline
for pointing this out)
0.01 26th July, 2002
- Inital release
File-Find-Rule-0.30/MANIFEST 0000644 0000000 0000000 00000000344 10437605046 0015233 0 ustar 00root root 0000000 0000000 MANIFEST
README
Changes
Makefile.PL
Build.PL
META.yml
lib/File/Find/Rule.pm
lib/File/Find/Rule/Extending.pod
lib/File/Find/Rule/Procedural.pod
t/File-Find-Rule.t
t/findrule.t
t/foobar
t/lib/File/Find/Rule/Test/ATeam.pm
findrule
File-Find-Rule-0.30/META.yml 0000644 0000000 0000000 00000001124 10437605046 0015350 0 ustar 00root root 0000000 0000000 ---
name: File-Find-Rule
version: 0.30
author:
- |-
Richard Clamp <richardc@unixbeard.net> with input gained from this
use.perl discussion: http://use.perl.org/~richardc/journal/6467
- |-
Additional proofreading and input provided by Kake, Greg McCarroll,
and Andy Lester andy@petdance.com.
abstract: Alternative interface to File::Find
license: perl
requires:
Cwd: 0
File::Find: 0
File::Spec: 0
Number::Compare: 0
Test::More: 0
Text::Glob: 0
provides:
File::Find::Rule:
file: lib/File/Find/Rule.pm
version: 0.30
generated_by: Module::Build version 0.25
File-Find-Rule-0.30/Makefile.PL 0000644 0000000 0000000 00000001314 10437605046 0016052 0 ustar 00root root 0000000 0000000 # Note: this file was auto-generated by Module::Build::Compat version 0.03
use ExtUtils::MakeMaker;
WriteMakefile
(
'NAME' => 'File::Find::Rule',
'VERSION_FROM' => 'lib/File/Find/Rule.pm',
'PREREQ_PM' => {
'Cwd' => '0',
'File::Find' => '0',
'File::Spec' => '0',
'Number::Compare' => '0',
'Test::More' => '0',
'Text::Glob' => '0'
},
'INSTALLDIRS' => 'site',
'EXE_FILES' => [
'findrule'
],
'PL_FILES' => {}
)
;
File-Find-Rule-0.30/README 0000644 0000000 0000000 00000003741 10437605046 0014766 0 ustar 00root root 0000000 0000000 README for File::Find::Rule 0.30
=head1 NAME
File::Find::Rule - Alternative interface to File::Find
=head1 SYNOPSIS
use File::Find::Rule;
# find all the subdirectories of a given directory
my @subdirs = File::Find::Rule->directory->in( $directory );
# find all the .pm files in @INC
my @files = File::Find::Rule->file()
->name( '*.pm' )
->in( @INC );
# as above, but without method chaining
my $rule = File::Find::Rule->new;
$rule->file;
$rule->name( '*.pm' );
my @files = $rule->in( @INC );
=head1 DEPENDENCIES
This module has external dependencies on the following modules:
Cwd
File::Find
File::Spec
Number::Compare
Test::More
Text::Glob
=head1 INSTALLATION
perl Build.PL
perl Build test
and if all goes well
perl Build install
=head1 HISTORY
What changed over the last 3 revisions
=over
=item 0.30 Wednesday 1st June, 2006
Made './//././././///.//././/////./blah' be treated the same
as './blah' (it gets turned into 'blah')
=item 0.29 Tuesday 16th May, 2006
Kludged around {min,max}depth and trailing slashes in path
names.
=item 0.28 Tuesday 18th May, 2004
exposed %X_tests and @stat_tests as package variables, and make a
_call_find method for File::Find::Rule::Filesys::Virtual
=back
=head1 AUTHOR
Richard Clamp <richardc@unixbeard.net> with input gained from this
use.perl discussion: http://use.perl.org/~richardc/journal/6467
Additional proofreading and input provided by Kake, Greg McCarroll,
and Andy Lester andy@petdance.com.
=head1 COPYRIGHT
Copyright (C) 2002, 2003, 2004, 2006 Richard Clamp. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<File::Find>, L<Text::Glob>, L<Number::Compare>, find(1)
If you want to know about the procedural interface, see
L<File::Find::Rule::Procedural>, and if you have an idea for a neat
extension L<File::Find::Rule::Extending>
File-Find-Rule-0.30/findrule 0000644 0000000 0000000 00000006366 10437605046 0015647 0 ustar 00root root 0000000 0000000 #!perl -w
use strict;
use File::Find::Rule;
use File::Spec::Functions qw(catdir);
# bootstrap extensions
for (@INC) {
my $dir = catdir($_, qw( File Find Rule ) );
next unless -d $dir;
my @pm = find( name => '*.pm', maxdepth => 1,
exec => sub { (my $name = $_) =~ s/\.pm$//;
eval "require File::Find::Rule::$name"; },
in => $dir );
}
# what directories are we searching in?
my @where;
while (@ARGV) {
local $_ = shift @ARGV;
if (/^-/) {
unshift @ARGV, $_;
last;
}
push @where, $_;
}
# parse arguments, build a rule object
my $rule = new File::Find::Rule;
while (@ARGV) {
my $clause = shift @ARGV;
unless ( $clause =~ s/^-// && $rule->can( $clause ) ) {
# not a known rule - complain about this
die "unknown option '$clause'\n"
}
# it was the last switch
unless (@ARGV) {
$rule->$clause();
next;
}
# consume the parameters
my $param = shift @ARGV;
if ($param =~ /^-/) {
# it's the next switch - put it back, and add one with no params
unshift @ARGV, $param;
$rule->$clause();
next;
}
if ($param eq '(') {
# multiple values - just look for the closing parenthesis
my @p;
while (@ARGV) {
my $val = shift @ARGV;
last if $val eq ')';
push @p, $val;
}
$rule->$clause( @p );
next;
}
# a single argument
$rule->$clause( $param );
}
# add a print rule so things happen faster
$rule->exec( sub { print "$_[2]\n"; return; } );
# profit
$rule->in( @where ? @where : '.' );
exit 0;
__END__
=head1 NAME
findrule - command line wrapper to File::Find::Rule
=head1 USAGE
findrule [path...] [expression]
=head1 DESCRIPTION
C<findrule> mostly borrows the interface from GNU find(1) to provide a
command-line interface onto the File::Find::Rule heirarchy of modules.
The syntax for expressions is the rule name, preceded by a dash,
followed by an optional argument. If the argument is an opening
parenthesis it is taken as a list of arguments, terminated by a
closing parenthesis.
Some examples:
find -file -name ( foo bar )
files named C<foo> or C<bar>, below the current directory.
find -file -name foo -bar
files named C<foo>, that have pubs (for this is what our ficticious
C<bar> clause specifies), below the current directory.
find -file -name ( -bar )
files named C<-bar>, below the current directory. In this case if
we'd have omitted the parenthesis it would have parsed as a call to
name with no arguments, followed by a call to -bar.
=head2 Supported switches
I'm very slack. Please consult the File::Find::Rule manpage for now,
and prepend - to the commands that you want.
=head2 Extra bonus switches
findrule automatically loads all of your installed File::Find::Rule::*
extension modules, so check the documentation to see what those would be.
=head1 AUTHOR
Richard Clamp <richardc@unixbeard.net> from a suggestion by Tatsuhiko Miyagawa
=head1 COPYRIGHT
Copyright (C) 2002 Richard Clamp. All Rights Reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<File::Find::Rule>
=cut
File-Find-Rule-0.30/lib/ 0000755 0000000 0000000 00000000000 10437605046 0014647 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/lib/File/ 0000755 0000000 0000000 00000000000 10437605046 0015526 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/lib/File/Find/ 0000755 0000000 0000000 00000000000 10437605046 0016406 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/lib/File/Find/Rule.pm 0000644 0000000 0000000 00000046623 10437605046 0017666 0 ustar 00root root 0000000 0000000 # $Id: /mirror/lab/perl/File-Find-Rule/lib/File/Find/Rule.pm 2102 2006-06-01T15:39:03.942922Z richardc $
package File::Find::Rule;
use strict;
use vars qw/$VERSION $AUTOLOAD/;
use File::Spec;
use Text::Glob 'glob_to_regex';
use Number::Compare;
use Carp qw/croak/;
use File::Find (); # we're only wrapping for now
use Cwd; # 5.00503s File::Find goes screwy with max_depth == 0
$VERSION = '0.30';
# we'd just inherit from Exporter, but I want the colon
sub import {
my $pkg = shift;
my $to = caller;
for my $sym ( qw( find rule ) ) {
no strict 'refs';
*{"$to\::$sym"} = \&{$sym};
}
for (grep /^:/, @_) {
my ($extension) = /^:(.*)/;
eval "require File::Find::Rule::$extension";
croak "couldn't bootstrap File::Find::Rule::$extension: $@" if $@;
}
}
=head1 NAME
File::Find::Rule - Alternative interface to File::Find
=head1 SYNOPSIS
use File::Find::Rule;
# find all the subdirectories of a given directory
my @subdirs = File::Find::Rule->directory->in( $directory );
# find all the .pm files in @INC
my @files = File::Find::Rule->file()
->name( '*.pm' )
->in( @INC );
# as above, but without method chaining
my $rule = File::Find::Rule->new;
$rule->file;
$rule->name( '*.pm' );
my @files = $rule->in( @INC );
=head1 DESCRIPTION
File::Find::Rule is a friendlier interface to File::Find. It allows
you to build rules which specify the desired files and directories.
=cut
# the procedural shim
*rule = \&find;
sub find {
my $object = __PACKAGE__->new();
my $not = 0;
while (@_) {
my $method = shift;
my @args;
if ($method =~ s/^\!//) {
# jinkies, we're really negating this
unshift @_, $method;
$not = 1;
next;
}
unless (defined prototype $method) {
my $args = shift;
@args = ref $args eq 'ARRAY' ? @$args : $args;
}
if ($not) {
$not = 0;
@args = $object->new->$method(@args);
$method = "not";
}
my @return = $object->$method(@args);
return @return if $method eq 'in';
}
$object;
}
=head1 METHODS
=over
=item C<new>
A constructor. You need not invoke C<new> manually unless you wish
to, as each of the rule-making methods will auto-create a suitable
object if called as class methods.
=cut
sub new {
my $referent = shift;
my $class = ref $referent || $referent;
bless {
rules => [], # [0]
subs => [], # [1]
iterator => [],
extras => {},
maxdepth => undef,
mindepth => undef,
}, $class;
}
sub _force_object {
my $object = shift;
$object = $object->new()
unless ref $object;
$object;
}
=back
=head2 Matching Rules
=over
=item C<name( @patterns )>
Specifies names that should match. May be globs or regular
expressions.
$set->name( '*.mp3', '*.ogg' ); # mp3s or oggs
$set->name( qr/\.(mp3|ogg)$/ ); # the same as a regex
$set->name( 'foo.bar' ); # just things named foo.bar
=cut
sub _flatten {
my @flat;
while (@_) {
my $item = shift;
ref $item eq 'ARRAY' ? push @_, @{ $item } : push @flat, $item;
}
return @flat;
}
sub name {
my $self = _force_object shift;
my @names = map { ref $_ eq "Regexp" ? $_ : glob_to_regex $_ } _flatten( @_ );
push @{ $self->{rules} }, {
rule => 'name',
code => join( ' || ', map { "m($_)" } @names ),
args => \@_,
};
$self;
}
=item -X tests
Synonyms are provided for each of the -X tests. See L<perlfunc/-X> for
details. None of these methods take arguments.
Test | Method Test | Method
------|------------- ------|----------------
-r | readable -R | r_readable
-w | writeable -W | r_writeable
-w | writable -W | r_writable
-x | executable -X | r_executable
-o | owned -O | r_owned
| |
-e | exists -f | file
-z | empty -d | directory
-s | nonempty -l | symlink
| -p | fifo
-u | setuid -S | socket
-g | setgid -b | block
-k | sticky -c | character
| -t | tty
-M | modified |
-A | accessed -T | ascii
-C | changed -B | binary
Though some tests are fairly meaningless as binary flags (C<modified>,
C<accessed>, C<changed>), they have been included for completeness.
# find nonempty files
$rule->file,
->nonempty;
=cut
use vars qw( %X_tests );
%X_tests = (
-r => readable => -R => r_readable =>
-w => writeable => -W => r_writeable =>
-w => writable => -W => r_writable =>
-x => executable => -X => r_executable =>
-o => owned => -O => r_owned =>
-e => exists => -f => file =>
-z => empty => -d => directory =>
-s => nonempty => -l => symlink =>
=> -p => fifo =>
-u => setuid => -S => socket =>
-g => setgid => -b => block =>
-k => sticky => -c => character =>
=> -t => tty =>
-M => modified =>
-A => accessed => -T => ascii =>
-C => changed => -B => binary =>
);
for my $test (keys %X_tests) {
my $sub = eval 'sub () {
my $self = _force_object shift;
push @{ $self->{rules} }, {
code => "' . $test . ' \$_",
rule => "'.$X_tests{$test}.'",
};
$self;
} ';
no strict 'refs';
*{ $X_tests{$test} } = $sub;
}
=item stat tests
The following C<stat> based methods are provided: C<dev>, C<ino>,
C<mode>, C<nlink>, C<uid>, C<gid>, C<rdev>, C<size>, C<atime>,
C<mtime>, C<ctime>, C<blksize>, and C<blocks>. See L<perlfunc/stat>
for details.
Each of these can take a number of targets, which will follow
L<Number::Compare> semantics.
$rule->size( 7 ); # exactly 7
$rule->size( ">7Ki" ); # larger than 7 * 1024 * 1024 bytes
$rule->size( ">=7" )
->size( "<=90" ); # between 7 and 90, inclusive
$rule->size( 7, 9, 42 ); # 7, 9 or 42
=cut
use vars qw( @stat_tests );
@stat_tests = qw( dev ino mode nlink uid gid rdev
size atime mtime ctime blksize blocks );
{
my $i = 0;
for my $test (@stat_tests) {
my $index = $i++; # to close over
my $sub = sub {
my $self = _force_object shift;
my @tests = map { Number::Compare->parse_to_perl($_) } @_;
push @{ $self->{rules} }, {
rule => $test,
args => \@_,
code => 'do { my $val = (stat $_)['.$index.'] || 0;'.
join ('||', map { "(\$val $_)" } @tests ).' }',
};
$self;
};
no strict 'refs';
*$test = $sub;
}
}
=item C<any( @rules )>
=item C<or( @rules )>
Allows shortcircuiting boolean evaluation as an alternative to the
default and-like nature of combined rules. C<any> and C<or> are
interchangeable.
# find avis, movs, things over 200M and empty files
$rule->any( File::Find::Rule->name( '*.avi', '*.mov' ),
File::Find::Rule->size( '>200M' ),
File::Find::Rule->file->empty,
);
=cut
sub any {
my $self = _force_object shift;
my @rulesets = @_;
push @{ $self->{rules} }, {
rule => 'any',
code => '(' . join( ' || ', map {
"( " . $_->_compile( $self->{subs} ) . " )"
} @_ ) . ")",
args => \@_,
};
$self;
}
*or = \&any;
=item C<none( @rules )>
=item C<not( @rules )>
Negates a rule. (The inverse of C<any>.) C<none> and C<not> are
interchangeable.
# files that aren't 8.3 safe
$rule->file
->not( $rule->new->name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ ) );
=cut
sub not {
my $self = _force_object shift;
my @rulesets = @_;
push @{ $self->{rules} }, {
rule => 'not',
args => \@rulesets,
code => '(' . join ( ' && ', map {
"!(". $_->_compile( $self->{subs} ) . ")"
} @_ ) . ")",
};
$self;
}
*none = \¬
=item C<prune>
Traverse no further. This rule always matches.
=cut
sub prune () {
my $self = _force_object shift;
push @{ $self->{rules} },
{
rule => 'prune',
code => '$File::Find::prune = 1'
};
$self;
}
=item C<discard>
Don't keep this file. This rule always matches.
=cut
sub discard () {
my $self = _force_object shift;
push @{ $self->{rules} }, {
rule => 'discard',
code => '$discarded = 1',
};
$self;
}
=item C<exec( \&subroutine( $shortname, $path, $fullname ) )>
Allows user-defined rules. Your subroutine will be invoked with C<$_>
set to the current short name, and with parameters of the name, the
path you're in, and the full relative filename.
Return a true value if your rule matched.
# get things with long names
$rules->exec( sub { length > 20 } );
=cut
sub exec {
my $self = _force_object shift;
my $code = shift;
push @{ $self->{rules} }, {
rule => 'exec',
code => $code,
};
$self;
}
=item ->grep( @specifiers );
Opens a file and tests it each line at a time.
For each line it evaluates each of the specifiers, stopping at the
first successful match. A specifier may be a regular expression or a
subroutine. The subroutine will be invoked with the same parameters
as an ->exec subroutine.
It is possible to provide a set of negative specifiers by enclosing
them in anonymous arrays. Should a negative specifier match the
iteration is aborted and the clause is failed. For example:
$rule->grep( qr/^#!.*\bperl/, [ sub { 1 } ] );
Is a passing clause if the first line of a file looks like a perl
shebang line.
=cut
sub grep {
my $self = _force_object shift;
my @pattern = map {
ref $_
? ref $_ eq 'ARRAY'
? map { [ ( ref $_ ? $_ : qr/$_/ ) => 0 ] } @$_
: [ $_ => 1 ]
: [ qr/$_/ => 1 ]
} @_;
$self->exec( sub {
local *FILE;
open FILE, $_ or return;
local ($_, $.);
while (<FILE>) {
for my $p (@pattern) {
my ($rule, $ret) = @$p;
return $ret
if ref $rule eq 'Regexp'
? /$rule/
: $rule->(@_);
}
}
return;
} );
}
=item C<maxdepth( $level )>
Descend at most C<$level> (a non-negative integer) levels of directories
below the starting point.
May be invoked many times per rule, but only the most recent value is
used.
=item C<mindepth( $level )>
Do not apply any tests at levels less than C<$level> (a non-negative
integer).
=item C<extras( \%extras )>
Specifies extra values to pass through to C<File::File::find> as part
of the options hash.
For example this allows you to specify following of symlinks like so:
my $rule = File::Find::Rule->extras({ follow => 1 });
May be invoked many times per rule, but only the most recent value is
used.
=cut
for my $setter (qw( maxdepth mindepth extras )) {
my $sub = sub {
my $self = _force_object shift;
$self->{$setter} = shift;
$self;
};
no strict 'refs';
*$setter = $sub;
}
=item C<relative>
Trim the leading portion of any path found
=cut
sub relative () {
my $self = _force_object shift;
$self->{relative} = 1;
$self;
}
=item C<not_*>
Negated version of the rule. An effective shortand related to ! in
the procedural interface.
$foo->not_name('*.pl');
$foo->not( $foo->new->name('*.pl' ) );
=cut
sub DESTROY {}
sub AUTOLOAD {
$AUTOLOAD =~ /::not_([^:]*)$/
or croak "Can't locate method $AUTOLOAD";
my $method = $1;
my $sub = sub {
my $self = _force_object shift;
$self->not( $self->new->$method(@_) );
};
{
no strict 'refs';
*$AUTOLOAD = $sub;
}
&$sub;
}
=back
=head2 Query Methods
=over
=item C<in( @directories )>
Evaluates the rule, returns a list of paths to matching files and
directories.
=cut
sub in {
my $self = _force_object shift;
my @found;
my $fragment = $self->_compile( $self->{subs} );
my @subs = @{ $self->{subs} };
warn "relative mode handed multiple paths - that's a bit silly\n"
if $self->{relative} && @_ > 1;
my $topdir;
my $code = 'sub {
(my $path = $File::Find::name) =~ s#^(?:\./+)+##;
my @args = ($_, $File::Find::dir, $path);
my $maxdepth = $self->{maxdepth};
my $mindepth = $self->{mindepth};
my $relative = $self->{relative};
# figure out the relative path and depth
my $relpath = $File::Find::name;
$relpath =~ s{^\Q$topdir\E/?}{};
my $depth = scalar File::Spec->splitdir($relpath);
#print "name: \'$File::Find::name\' ";
#print "relpath: \'$relpath\' depth: $depth relative: $relative\n";
defined $maxdepth && $depth >= $maxdepth
and $File::Find::prune = 1;
defined $mindepth && $depth < $mindepth
and return;
#print "Testing \'$_\'\n";
my $discarded;
return unless ' . $fragment . ';
return if $discarded;
if ($relative) {
push @found, $relpath if $relpath ne "";
}
else {
push @found, $path;
}
}';
#use Data::Dumper;
#print Dumper \@subs;
#warn "Compiled sub: '$code'\n";
my $sub = eval "$code" or die "compile error '$code' $@";
my $cwd = getcwd;
for my $path (@_) {
# $topdir is used for relative and maxdepth
$topdir = $path;
# slice off the trailing slash if there is one (the
# maxdepth/mindepth code is fussy)
$topdir =~ s{/?$}{}
unless $topdir eq '/';
$self->_call_find( { %{ $self->{extras} }, wanted => $sub }, $path );
}
chdir $cwd;
return @found;
}
sub _call_find {
my $self = shift;
File::Find::find( @_ );
}
sub _compile {
my $self = shift;
my $subs = shift; # [1]
return '1' unless @{ $self->{rules} };
my $code = join " && ", map {
if (ref $_->{code}) {
push @$subs, $_->{code};
"\$subs[$#{$subs}]->(\@args) # $_->{rule}\n";
}
else {
"( $_->{code} ) # $_->{rule}\n";
}
} @{ $self->{rules} };
return $code;
}
=item C<start( @directories )>
Starts a find across the specified directories. Matching items may
then be queried using L</match>. This allows you to use a rule as an
iterator.
my $rule = File::Find::Rule->file->name("*.jpeg")->start( "/web" );
while ( my $image = $rule->match ) {
...
}
=cut
sub start {
my $self = _force_object shift;
$self->{iterator} = [ $self->in( @_ ) ];
$self;
}
=item C<match>
Returns the next file which matches, false if there are no more.
=cut
sub match {
my $self = _force_object shift;
return shift @{ $self->{iterator} };
}
1;
__END__
=back
=head2 Extensions
Extension modules are available from CPAN in the File::Find::Rule
namespace. In order to use these extensions either use them directly:
use File::Find::Rule::ImageSize;
use File::Find::Rule::MMagic;
# now your rules can use the clauses supplied by the ImageSize and
# MMagic extension
or, specify that File::Find::Rule should load them for you:
use File::Find::Rule qw( :ImageSize :MMagic );
For notes on implementing your own extensions, consult
L<File::Find::Rule::Extending>
=head2 Further examples
=over
=item Finding perl scripts
my $finder = File::Find::Rule->or
(
File::Find::Rule->name( '*.pl' ),
File::Find::Rule->exec(
sub {
if (open my $fh, $_) {
my $shebang = <$fh>;
close $fh;
return $shebang =~ /^#!.*\bperl/;
}
return 0;
} ),
);
Based upon this message http://use.perl.org/comments.pl?sid=7052&cid=10842
=item ignore CVS directories
my $rule = File::Find::Rule->new;
$rule->or($rule->new
->directory
->name('CVS')
->prune
->discard,
$rule->new);
Note here the use of a null rule. Null rules match anything they see,
so the effect is to match (and discard) directories called 'CVS' or to
match anything.
=back
=head1 TWO FOR THE PRICE OF ONE
File::Find::Rule also gives you a procedural interface. This is
documented in L<File::Find::Rule::Procedural>
=head1 EXPORTS
L</find>, L</rule>
=head1 BUGS
The code relies on qr// compiled regexes, therefore this module
requires perl version 5.005_03 or newer.
Currently it isn't possible to remove a clause from a rule object. If
this becomes a significant issue it will be addressed.
=head1 AUTHOR
Richard Clamp <richardc@unixbeard.net> with input gained from this
use.perl discussion: http://use.perl.org/~richardc/journal/6467
Additional proofreading and input provided by Kake, Greg McCarroll,
and Andy Lester andy@petdance.com.
=head1 COPYRIGHT
Copyright (C) 2002, 2003, 2004, 2006 Richard Clamp. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<File::Find>, L<Text::Glob>, L<Number::Compare>, find(1)
If you want to know about the procedural interface, see
L<File::Find::Rule::Procedural>, and if you have an idea for a neat
extension L<File::Find::Rule::Extending>
=cut
Implementation notes:
[0] Currently we use an array of anonymous subs, and call those
repeatedly from match. It'll probably be way more effecient to
instead eval-string compile a dedicated matching sub, and call that to
avoid the repeated sub dispatch.
[1] Though [0] isn't as true as it once was, I'm not sure that the
subs stack is exposed in quite the right way. Maybe it'd be better as
a private global hash. Something like $subs{$self} = []; and in
C<DESTROY>, delete $subs{$self}.
That'd make compiling subrules really much easier (no need to pass
@subs in for context), and things that work via a mix of callbacks and
code fragments are possible (you'd probably want this for the stat
tests).
Need to check this currently working version in before I play with
that though.
[*] There's probably a win to be made with the current model in making
stat calls use C<_>. For
find( file => size => "> 20M" => size => "< 400M" );
up to 3 stats will happen for each candidate. Adding a priming _
would be a bit blind if the first operation was C< name => 'foo' >,
since that can be tested by a single regex. Simply checking what the
next type of operation doesn't work since any arbritary exec sub may
or may not stat. Potentially worse, they could stat something else
like so:
# extract from the worlds stupidest make(1)
find( exec => sub { my $f = $_; $f =~ s/\.c$/.o/ && !-e $f } );
Maybe the best way is to treat C<_> as invalid after calling an exec,
and doc that C<_> will only be meaningful after stat and -X tests if
they're wanted in exec blocks.
File-Find-Rule-0.30/lib/File/Find/Rule/ 0000755 0000000 0000000 00000000000 10437605046 0017315 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/lib/File/Find/Rule/Extending.pod 0000644 0000000 0000000 00000004347 10437605046 0021756 0 ustar 00root root 0000000 0000000 =head1 NAME
File::Find::Rule::Extending - the mini-guide to extending File::Find::Rule
=head1 SYNOPSIS
package File::Find::Rule::Random;
use strict;
# take useful things from File::Find::Rule
use base 'File::Find::Rule';
# and force our crack into the main namespace
sub File::Find::Rule::random () {
my $self = shift()->_force_object;
$self->exec( sub { rand > 0.5 } );
}
1;
=head1 DESCRIPTION
File::Find::Rule went down so well with the buying public that
everyone wanted to add extra features. With the 0.07 release this
became a possibility, using the following conventions.
=head2 Declare your package
package File::Find::Rule::Random;
use strict;
=head2 Inherit methods from File::Find::Rule
# take useful things from File::Find::Rule
use base 'File::Find::Rule';
=head3 Force your madness into the main package
# and force our crack into the main namespace
sub File::Find::Rule::random () {
my $self = shift()->_force_object;
$self->exec( sub { rand > 0.5 } );
}
Yes, we're being very cavalier here and defining things into the main
File::Find::Rule namespace. This is due to lack of imaginiation on my
part - I simply can't find a way for the functional and oo interface
to work without doing this or some kind of inheritance, and
inheritance stops you using two File::Find::Rule::Foo modules
together.
For this reason try and pick distinct names for your extensions. If
this becomes a problem then I may institute a semi-official registry
of taken names.
=head2 Taking no arguments.
Note the null prototype on random. This is a cheat for the procedural
interface to know that your sub takes no arguments, and so allows this
to happen:
find( random => in => '.' );
If you hadn't declared C<random> with a null prototype it would have
consumed C<in> as a parameter to it, then got all confused as it
doesn't know about a C<'.'> rule.
=head1 AUTHOR
Richard Clamp <richardc@unixbeard.net>
=head1 COPYRIGHT
Copyright (C) 2002 Richard Clamp. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<File::Find::Rule>
L<File::Find::Rule::MMagic> was the first extension module, so maybe
check that out.
=cut
File-Find-Rule-0.30/lib/File/Find/Rule/Procedural.pod 0000644 0000000 0000000 00000003431 10437605046 0022122 0 ustar 00root root 0000000 0000000 =head1 NAME
File::Find::Rule::Procedural - File::Find::Rule's procedural interface
=head1 SYNOPSIS
use File::Find::Rule;
# find all .pm files, procedurally
my @files = find(file => name => '*.pm', in => \@INC);
=head1 DESCRIPTION
In addition to the regular object-oriented interface,
L<File::Find::Rule> provides two subroutines for you to use.
=over
=item C<find( @clauses )>
=item C<rule( @clauses )>
C<find> and C<rule> can be used to invoke any methods available to the
OO version. C<rule> is a synonym for C<find>
=back
Passing more than one value to a clause is done with an anonymous
array:
my $finder = find( name => [ '*.mp3', '*.ogg' ] );
C<find> and C<rule> both return a File::Find::Rule instance, unless
one of the arguments is C<in>, in which case it returns a list of
things that match the rule.
my @files = find( name => [ '*.mp3', '*.ogg' ], in => $ENV{HOME} );
Please note that C<in> will be the last clause evaluated, and so this
code will search for mp3s regardless of size.
my @files = find( name => '*.mp3', in => $ENV{HOME}, size => '<2k' );
^
|
Clause processing stopped here ------/
It is also possible to invert a single rule by prefixing it with C<!>
like so:
# large files that aren't videos
my @files = find( file =>
'!name' => [ '*.avi', '*.mov' ],
size => '>20M',
in => $ENV{HOME} );
=head1 AUTHOR
Richard Clamp <richardc@unixbeard.net>
=head1 COPYRIGHT
Copyright (C) 2003 Richard Clamp. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<File::Find::Rule>
=cut
File-Find-Rule-0.30/t/ 0000755 0000000 0000000 00000000000 10437605046 0014344 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/t/File-Find-Rule.t 0000644 0000000 0000000 00000020624 10437605046 0017177 0 ustar 00root root 0000000 0000000 #!perl -w
# $Id: /mirror/lab/perl/File-Find-Rule/t/File-Find-Rule.t 2100 2006-05-28T16:06:50.725367Z richardc $
use strict;
use Test::More tests => 41;
my $class;
my @tests = qw( t/File-Find-Rule.t t/findrule.t );
BEGIN {
$class = 'File::Find::Rule';
use_ok($class)
}
# on win32 systems the t/foobar file isn't 10 bytes it's 11, so the
# previous tests on the magic number 10 failed. rt.cpan.org #3838
my $foobar_size = -s 't/foobar';
my $f = $class->new;
isa_ok($f, $class);
# name
$f = $class->name( qr/\.t$/ );
is_deeply( [ sort $f->in('t') ],
[ @tests ],
"name( qr/\\.t\$/ )" );
$f = $class->name( 'foobar' );
is_deeply( [ $f->in('t') ],
[ 't/foobar' ],
"name( 'foobar' )" );
$f = $class->name( '*.t' );
is_deeply( [ sort $f->in('t') ],
\@tests,
"name( '*.t' )" );
$f = $class->name( 'foobar', '*.t' );
is_deeply( [ sort $f->in('t') ],
[ @tests, 't/foobar' ],
"name( 'foobar', '*.t' )" );
$f = $class->name( [ 'foobar', '*.t' ] );
is_deeply( [ sort $f->in('t') ],
[ @tests, 't/foobar' ],
"name( [ 'foobar', '*.t' ] )" );
# exec
$f = $class->exec(sub { length == 6 })->maxdepth(1);
is_deeply( [ $f->in('t') ],
[ 't/foobar' ],
"exec (short)" );
$f = $class->exec(sub { length > $foobar_size })->maxdepth(1);
is_deeply( [ $f->in('t') ],
[ 't/File-Find-Rule.t' ],
"exec (long)" );
is_deeply( [ find( maxdepth => 1, exec => sub { $_[2] eq 't/foobar' }, in => 't' ) ],
[ 't/foobar' ],
"exec (check arg 2)" );
# name and exec, chained
$f = $class
->exec(sub { length > $foobar_size })
->name( qr/\.t$/ );
is_deeply( [ $f->in('t') ],
[ 't/File-Find-Rule.t' ],
"exec(match) and name(match)" );
$f = $class
->exec(sub { length > $foobar_size })
->name( qr/foo/ )
->maxdepth(1);
is_deeply( [ $f->in('t') ],
[ ],
"exec(match) and name(fail)" );
# directory
$f = $class
->directory
->maxdepth(1)
->exec(sub { $_ !~ /(\.svn|CVS)/ }); # ignore .svn/CVS dirs
is_deeply( [ $f->in('t') ],
[ qw( t t/lib ) ],
"directory autostub" );
# any/or
$f = $class->any( $class->exec( sub { length == 6 } ),
$class->name( qr/\.t$/ )
->exec( sub { length > $foobar_size } )
)->maxdepth(1);
is_deeply( [ sort $f->in('t') ],
[ 't/File-Find-Rule.t', 't/foobar' ],
"any" );
$f = $class->or( $class->exec( sub { length == 6 } ),
$class->name( qr/\.t$/ )
->exec( sub { length > $foobar_size } )
)->maxdepth(1);
is_deeply( [ sort $f->in('t') ],
[ 't/File-Find-Rule.t', 't/foobar' ],
"or" );
# not/none
$f = $class
->file
->not( $class->name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ ) )
->maxdepth(1)
->exec(sub { length == 6 || length > 10 });
is_deeply( [ $f->in('t') ],
[ 't/File-Find-Rule.t' ],
"not" );
# not as not_*
$f = $class
->file
->not_name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ )
->maxdepth(1)
->exec(sub { length == 6 || length > 10 });
is_deeply( [ $f->in('t') ],
[ 't/File-Find-Rule.t' ],
"not_*" );
# prune/discard (.svn demo)
# this test may be a little meaningless for a cpan release, but it
# fires perfectly in my dev sandbox
$f = $class->or( $class->directory
->name(qr/(\.svn|CVS)/)
->prune
->discard,
$class->new->file );
is_deeply( [ sort $f->in('t') ],
[ @tests, 't/foobar', 't/lib/File/Find/Rule/Test/ATeam.pm' ],
"prune/discard .svn"
);
# procedural form of the CVS demo
$f = find(or => [ find( directory =>
name => qr/(\.svn|CVS)/,
prune =>
discard => ),
find( file => ) ]);
is_deeply( [ sort $f->in('t') ],
[ @tests, 't/foobar', 't/lib/File/Find/Rule/Test/ATeam.pm' ],
"procedural prune/discard .svn"
);
# size (stat test)
is_deeply( [ find( maxdepth => 1, file => size => $foobar_size, in => 't' ) ],
[ 't/foobar' ],
"size $foobar_size (stat)" );
is_deeply( [ find( maxdepth => 1, file => size => "<= $foobar_size",
in => 't' ) ],
[ 't/foobar' ],
"size <= $foobar_size (stat)" );
is_deeply( [ find( maxdepth => 1, file => size => "<".($foobar_size + 1),
in => 't' ) ],
[ 't/foobar' ],
"size <($foobar_size + 1) (stat)" );
is_deeply( [ find( maxdepth => 1, file => size => "<1K",
exec => sub { length == 6 },
in => 't' ) ],
[ 't/foobar' ],
"size <1K (stat)" );
is_deeply( [ find( maxdepth => 1, file => size => ">3K", in => 't' ) ],
[ 't/File-Find-Rule.t' ],
"size >3K (stat)" );
# these next two should never fail. if they do then the testing fairy
# went mad
is_deeply( [ find( file => size => ">3M", in => 't' ) ],
[ ],
"size >3M (stat)" );
is_deeply( [ find( file => size => ">3G", in => 't' ) ],
[ ],
"size >3G (stat)" );
#min/maxdepth
is_deeply( [ find( maxdepth => 0, in => 't' ) ],
[ 't' ],
"maxdepth == 0" );
my $rule = find( or => [ find( name => qr/(\.svn|CVS)/,
discard =>),
find(),
],
maxdepth => 1 );
is_deeply( [ sort $rule->in( 't' ) ],
[ 't', @tests, 't/foobar', 't/lib' ],
"maxdepth == 1" );
is_deeply( [ sort $rule->in( 't/' ) ],
[ 't', @tests, 't/foobar', 't/lib' ],
"maxdepth == 1, trailing slash on the path" );
is_deeply( [ sort $rule->in( './t' ) ],
[ 't', @tests, 't/foobar', 't/lib' ],
"maxdepth == 1, ./t" );
is_deeply( [ sort $rule->in( './././///./t' ) ],
[ 't', @tests, 't/foobar', 't/lib' ],
"maxdepth == 1, ./././///./t" );
my @ateam_path = qw( t/lib
t/lib/File
t/lib/File/Find
t/lib/File/Find/Rule
t/lib/File/Find/Rule/Test
t/lib/File/Find/Rule/Test/ATeam.pm );
is_deeply( [ sort +find( or => [ find( name => qr/(\.svn|CVS)/,
prune =>
discard =>),
find( ),
],
mindepth => 1,
in => 't' ) ],
[ @tests, 't/foobar', @ateam_path ],
"mindepth == 1" );
is_deeply( [ sort +find( or => [ find( name => qr/(\.svn|CVS)/,
discard =>),
find(),
],
maxdepth => 1,
mindepth => 1,
in => 't' ) ],
[ @tests, 't/foobar', 't/lib' ],
"maxdepth = 1 mindepth == 1" );
# extras
my $ok = 0;
find( extras => { preprocess => sub { $ok = 1 } }, in => 't' );
ok( $ok, "extras preprocess fired" );
#iterator
$f = find( or => [ find( name => qr/(\.svn|CVS)/,
prune =>
discard =>),
find(),
],
start => 't' );
{
my @found;
while ($_ = $f->match) { push @found, $_ }
is_deeply( [ sort @found ], [ 't', @tests, 't/foobar', @ateam_path ], "iterator" );
}
# negating in the procedural interface
is_deeply( [ find( file => '!name' => qr/^[^.]{1,8}(\.[^.]{0,3})?$/,
maxdepth => 1,
in => 't' ) ],
[ 't/File-Find-Rule.t' ],
"negating in the procedural interface" );
# grep
is_deeply( [ find( maxdepth => 1, file => grep => [ qr/bytes./, [ qr/.?/ ] ], in => 't' ) ],
[ 't/foobar' ],
"grep" );
# relative
is_deeply( [ find( 'relative', maxdepth => 1, name => 'foobar', in => 't' ) ],
[ 'foobar' ],
'relative' );
# bootstrapping extensions via import
use lib qw(t/lib);
eval { $class->import(':Test::Elusive') };
like( $@, qr/^couldn't bootstrap File::Find::Rule::Test::Elusive/,
"couldn't find the Elusive extension" );
eval { $class->import(':Test::ATeam') };
is ($@, "", "if you can find them, maybe you can hire the A-Team" );
can_ok( $class, 'ba' );
File-Find-Rule-0.30/t/findrule.t 0000644 0000000 0000000 00000001675 10437605046 0016352 0 ustar 00root root 0000000 0000000 #!perl -w
use strict;
use Test::More tests => 6;
# extra tests for findrule. these are more for testing the parsing code.
sub run ($) {
my $expr = shift;
[ sort split /\n/, `$^X -Iblib/lib -Iblib/arch findrule $expr 2>&1` ];
}
is_deeply(run 't -file -name foobar', [ 't/foobar' ],
'-file -name foobar');
is_deeply(run 't -maxdepth 0 -directory',
[ 't' ], 'last clause has no args');
{
local $TODO = "Win32 cmd.exe hurts my brane"
if ($^O =~ m/Win32/ || $^O eq 'dos');
is_deeply(run 't -file -name \( foobar \*.t \)',
[ qw( t/File-Find-Rule.t t/findrule.t t/foobar ) ],
'grouping ()');
is_deeply(run 't -name \( -foo foobar \)',
[ 't/foobar' ], 'grouping ( -literal )');
}
is_deeply(run 't -file -name foobar baz',
[ "unknown option 'baz'" ], 'no implicit grouping');
is_deeply(run 't -maxdepth 0 -name -file',
[], 'terminate at next -');
File-Find-Rule-0.30/t/foobar 0000644 0000000 0000000 00000000012 10437605046 0015530 0 ustar 00root root 0000000 0000000 10 bytes.
File-Find-Rule-0.30/t/lib/ 0000755 0000000 0000000 00000000000 10437605046 0015112 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/t/lib/File/ 0000755 0000000 0000000 00000000000 10437605046 0015771 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/t/lib/File/Find/ 0000755 0000000 0000000 00000000000 10437605046 0016651 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/t/lib/File/Find/Rule/ 0000755 0000000 0000000 00000000000 10437605046 0017560 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/t/lib/File/Find/Rule/Test/ 0000755 0000000 0000000 00000000000 10437605046 0020477 5 ustar 00root root 0000000 0000000 File-Find-Rule-0.30/t/lib/File/Find/Rule/Test/ATeam.pm 0000644 0000000 0000000 00000000374 10437605046 0022030 0 ustar 00root root 0000000 0000000 package File::Find::Rule::Test::ATeam;
use strict;
use File::Find::Rule;
use base 'File::Find::Rule';
sub File::Find::Rule::ba {
my $self = shift()->_force_object;
$self->exec( sub { die "I pity the fool who uses this in production" });
}
1;