#!perl
# $Id: /mirror/lab/perl/File-Find-Rule/t/File-Find-Rule.t 2100 2006-05-28T16:06:50.725367Z richardc $
use strict;
use warnings;
use Test::More tests => 42;
use lib './t/lib';
use File::Find::Object::TreeCreate;
use File::Path;
my $tree_creator = File::Find::Object::TreeCreate->new();
{
my $tree =
{
'name' => "FFRt-to/",
'subs' =>
[
{
'name' => "File-Find-Rule.t",
'contents' => $tree_creator->cat(
"./t/sample-data/to-copy-from/File-Find-Rule.t"
),
},
{
'name' => "findorule.t",
'contents' => $tree_creator->cat(
"./t/sample-data/to-copy-from/findorule.t"
),
},
{
'name' => "foobar",
'contents' => $tree_creator->cat(
"./t/sample-data/to-copy-from/foobar"
),
},
{
'name' => "lib/",
'subs' =>
[
{
'name' => "File/",
'subs' =>
[
{
name => "Find/",
subs =>
[
{
name => "Object/",
subs =>
[
{
name => "Rule/",
subs =>
[
{
name => "Test/",
subs =>
[
{
name => "ATeam.pm",
content => $tree_creator->cat(
"./t/sample-data/to-copy-from/lib/File/Find/Object/Rule/Test/ATeam.pm"
),
}
],
},
],
}
],
},
],
},
],
},
],
},
],
};
$tree_creator->create_tree("./t/sample-data/", $tree);
}
my $class;
my $copy_fn = $tree_creator->get_path(
"./t/sample-data/FFRt-to/"
);
my $lib_fn = $tree_creator->get_path(
"./t/sample-data/FFRt-to/lib/"
);
my $FFR_t = $tree_creator->get_path(
"./t/sample-data/FFRt-to/File-Find-Rule.t"
);
my $findorule_t = $tree_creator->get_path(
"./t/sample-data/FFRt-to/findorule.t"
);
my $foobar_fn = $tree_creator->get_path(
"./t/sample-data/FFRt-to/foobar"
);
my @tests = ($FFR_t, $findorule_t);
my @ateam_path =
map { $tree_creator->get_path("./t/sample-data/FFRt-to/$_") }
qw(
lib
lib/File
lib/File/Find
lib/File/Find/Object
lib/File/Find/Object/Rule
lib/File/Find/Object/Rule/Test
lib/File/Find/Object/Rule/Test/ATeam.pm
);
my $ATeam_pm_fn = $ateam_path[-1];
BEGIN {
$class = 'File::Find::Object::Rule';
# TEST
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 $foobar_fn;
my $f = $class->new;
# TEST
isa_ok($f, $class);
sub _run_find
{
my $finder = shift;
return [ sort $finder->in($copy_fn) ];
}
# name
$f = $class->name( qr/\.t$/ );
# TEST
is_deeply( _run_find($f),
[ @tests ],
"name( qr/\\.t\$/ )" );
{
# This test that starts returns the rule object.
# See: http://www.nntp.perl.org/group/perl.beginners/2012/04/msg120670.html
my $rule = $class->name( qr/\.t$/ )->start($copy_fn);
my @results;
while (my $item = $rule->match()) {
push @results, $item;
}
# TEST
is_deeply(
[ @results ],
[ @tests ],
"->start() Test."
);
}
$f = $class->name( 'foobar' );
# TEST
is_deeply( _run_find($f),
[ $foobar_fn ],
"name( 'foobar' )" );
$f = $class->name( '*.t' );
# TEST
is_deeply( _run_find($f),
\@tests,
"name( '*.t' )" );
$f = $class->name( 'foobar', '*.t' );
# TEST
is_deeply( _run_find($f),
[ @tests, $foobar_fn ],
"name( 'foobar', '*.t' )" );
$f = $class->name( [ 'foobar', '*.t' ] );
# TEST
is_deeply( _run_find($f),
[ @tests, $foobar_fn ],
"name( [ 'foobar', '*.t' ] )" );
# exec
$f = $class->exec(sub { length($_[0]) == 6 })->maxdepth(1);
# TEST
is_deeply( _run_find($f),
[ $foobar_fn ],
"exec (short)" );
$f = $class->exec(sub { length($_[0]) > $foobar_size })->maxdepth(1);
# TEST
is_deeply( _run_find($f),
[ $FFR_t ],
"exec (long)" );
# TEST
is_deeply( [ find( maxdepth => 1, exec => sub { $_[2] eq $foobar_fn }, in => $copy_fn ) ],
[ $foobar_fn ],
"exec (check arg 2)" );
# name and exec, chained
$f = $class
->exec(sub { length > $foobar_size })
->name( qr/\.t$/ );
# TEST
is_deeply( _run_find($f),
[ $FFR_t ],
"exec(match) and name(match)" );
$f = $class
->exec(sub { length > $foobar_size })
->name( qr/foo/ )
->maxdepth(1);
# TEST
is_deeply( _run_find($f),
[ ],
"exec(match) and name(fail)" );
# directory
$f = $class
->directory
->maxdepth(1)
->exec(sub { $_ !~ /(\.svn|CVS)/ }); # ignore .svn/CVS dirs
# TEST
is_deeply( _run_find($f),
[ $copy_fn,$lib_fn,],
"directory autostub" );
# any/or
$f = $class->any( $class->exec( sub { length == 6 } ),
$class->name( qr/\.t$/ )
->exec( sub { length > $foobar_size } )
)->maxdepth(1);
# TEST
is_deeply( _run_find($f),
[ $FFR_t, $foobar_fn ],
"any" );
$f = $class->or( $class->exec( sub { length == 6 } ),
$class->name( qr/\.t$/ )
->exec( sub { length > $foobar_size } )
)->maxdepth(1);
# TEST
is_deeply( _run_find($f),
[ $FFR_t, $foobar_fn ],
"or" );
# not/none
$f = $class
->file
->not( $class->name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ ) )
->maxdepth(1)
->exec(sub { length == 6 || length > 11 });
# TEST
is_deeply( _run_find($f),
[ $FFR_t ],
"not" );
# not as not_*
$f = $class
->file
->not_name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ )
->maxdepth(1)
->exec(sub { length == 6 || length > 11 });
# TEST
is_deeply( _run_find($f),
[ $FFR_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 );
# TEST
is_deeply( _run_find($f),
[ @tests, $foobar_fn, $ATeam_pm_fn ],
"prune/discard .svn"
);
# procedural form of the CVS demo
$f = find(or => [ find( directory =>
name => qr/(\.svn|CVS)/,
prune =>
discard => ),
find( file => ) ]);
# TEST
is_deeply( _run_find($f),
[ @tests, $foobar_fn, $ATeam_pm_fn ],
"procedural prune/discard .svn"
);
# size (stat test)
# TEST
is_deeply( [ find( maxdepth => 1, file => size => $foobar_size, in => $copy_fn, ) ],
[ $foobar_fn ],
"size $foobar_size (stat)" );
# TEST
is_deeply( [ find( maxdepth => 1, file => size => "<= $foobar_size",
in => $copy_fn ) ],
[ $foobar_fn ],
"size <= $foobar_size (stat)" );
# TEST
is_deeply( [ find( maxdepth => 1, file => size => "<".($foobar_size + 1),
in => $copy_fn ) ],
[ $foobar_fn ],
"size <($foobar_size + 1) (stat)" );
# TEST
is_deeply( [ find( maxdepth => 1, file => size => "<1K",
exec => sub { length == 6 },
in => $copy_fn ) ],
[ $foobar_fn ],
"size <1K (stat)" );
# TEST
is_deeply( [ find( maxdepth => 1, file => size => ">3K", in => $copy_fn ) ],
[ $FFR_t ],
"size >3K (stat)" );
# these next two should never fail. if they do then the testing fairy
# went mad
# TEST
is_deeply( [ find( file => size => ">3M", in => $copy_fn ) ],
[ ],
"size >3M (stat)" );
# TEST
is_deeply( [ find( file => size => ">3G", in => $copy_fn ) ],
[ ],
"size >3G (stat)" );
#min/maxdepth
# TEST
is_deeply( [ find( maxdepth => 0, in => $copy_fn ) ],
[ $copy_fn ],
"maxdepth == 0" );
my $rule = find( or => [ find( name => qr/(\.svn|CVS)/,
discard =>),
find(),
],
maxdepth => 1 );
# TEST
is_deeply( _run_find($rule),
[ $copy_fn, @tests, $foobar_fn, $lib_fn ],
"maxdepth == 1" );
# TEST
is_deeply( _run_find($rule),
[ $copy_fn, @tests, $foobar_fn, $lib_fn ],
"maxdepth == 1, trailing slash on the path" );
# TEST
is_deeply( _run_find($rule),
[ $copy_fn, @tests, $foobar_fn, $lib_fn ],
"maxdepth == 1, ./t" );
# TEST
is_deeply( _run_find($rule),
[ $copy_fn, @tests, $foobar_fn, $lib_fn ],
"maxdepth == 1, ./././///./t" );
# TEST
is_deeply( [ sort +find( or => [ find( name => qr/(\.svn|CVS)/,
prune =>
discard =>),
find( ),
],
mindepth => 1,
in => $copy_fn, ) ],
[ @tests, $foobar_fn, @ateam_path ],
"mindepth == 1" );
# TEST
is_deeply( [ sort +find( or => [ find( name => qr/(\.svn|CVS)/,
discard =>),
find(),
],
maxdepth => 1,
mindepth => 1,
in => $copy_fn, ) ],
[ @tests, $foobar_fn, $lib_fn ],
"maxdepth = 1 mindepth == 1" );
# extras
my $ok = 0;
find( extras => { preprocess => sub { my ($self, $list) = @_; $ok = 1; return $list; } }, in => $copy_fn );
# TEST
ok( $ok, "extras preprocess fired" );
#iterator
$f = find( or => [ find( name => qr/(\.svn|CVS)/,
prune =>
discard =>),
find(),
],
start => $copy_fn );
{
my @found;
while ($_ = $f->match) { push @found, $_ }
# TEST
is_deeply( [ sort @found ], [ $copy_fn, @tests, $foobar_fn, @ateam_path ], "iterator" );
}
# negating in the procedural interface
# TEST
is_deeply( [ find( file => '!name' => qr/^[^.]{1,9}(\.[^.]{0,3})?$/,
maxdepth => 1,
in => $copy_fn ) ],
[ $FFR_t ],
"negating in the procedural interface" );
# grep
# TEST
is_deeply( [ find( maxdepth => 1, file => grep => [ qr/bytes./, [ qr/.?/ ] ], in => $copy_fn ) ],
[ $foobar_fn ],
"grep" );
# relative
# TEST
is_deeply( [ find( 'relative', maxdepth => 1, name => 'foobar', in => $copy_fn ) ],
[ 'foobar' ],
'relative' );
# bootstrapping extensions via import
eval { $class->import(':Test::Elusive') };
# TEST
like( $@, qr/^couldn't bootstrap File::Find::Object::Rule::Test::Elusive/,
"couldn't find the Elusive extension" );
eval { $class->import(':Test::ATeam') };
# TEST
is ($@, "", "if you can find them, maybe you can hire the A-Team" );
# TEST
can_ok( $class, 'ba' );
rmtree($tree_creator->get_path("./t/sample-data/FFRt-to"));