#!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"));