#!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.txt"),
            },
            {
                'name'     => "findorule.t",
                'contents' => $tree_creator->cat(
                    "./t/sample-data/to-copy-from/findorule.txt"),
            },
            {
                '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") );
