Commits

Anonymous committed 896c897

Got rid of UNIXisms in the test files and improved their quality.

- hopefully got rid of all UNIXisms (and incompatibilities with Win32), and
problems such as running when having temporary files (*~) in the test
files:
- now holding a pristine copy of the test tree under
./t/sample-data/to-copy-from/
and copying it and processing it using File::Find::Object::TreeCreate
which was borrowed from the File::Find::Object code.
- Converted all the paths constant to variables, which are generated
using $tree_creator->get_path().
- Removed some non-portable assertions or ones that are hard to
reproduce with File::Spec.
- Added Test::Count annotations to the tests' code.

Comments (0)

Files changed (9)

File-Find-Object-Rule/Changes

 ChangeLog for File-Find-Object-Rule:
 ------------------------------------
 
+    - hopefully got rid of all UNIXisms (and incompatibilities with Win32), and 
+    problems such as running when having temporary files (*~) in the test 
+    files:
+        - now holding a pristine copy of the test tree under
+            ./t/sample-data/to-copy-from/
+        and copying it and processing it using File::Find::Object::TreeCreate
+        which was borrowed from the File::Find::Object code.
+        - Converted all the paths constant to variables, which are generated
+        using $tree_creator->get_path().
+        - Removed some non-portable assertions or ones that are hard to 
+        reproduce with File::Spec.
+        - Added Test::Count annotations to the tests' code.
+
 0.0101      Sun Feb 22 14:29:06 IST 2009
     - fixed the dependencies in Build.PL (especially File::Find::Object)
     - moved findrule to scripts/findorule

File-Find-Object-Rule/MANIFEST

 t/findorule.t
 t/foobar
 t/lib/File/Find/Object/Rule/Test/ATeam.pm
+t/lib/File/Find/Object/TreeCreate.pm
+t/sample-data/to-copy-from/File-Find-Rule.t
+t/sample-data/to-copy-from/findorule.t
+t/sample-data/to-copy-from/foobar
+t/sample-data/to-copy-from/lib/File/Find/Object/Rule/Test/ATeam.pm

File-Find-Object-Rule/t/File-Find-Rule.t

-#!perl -w
+#!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 => 41;
 
+use lib './t/lib';
+
+use File::Find::Object::TreeCreate;
+
+use File::Path;
+
+my $tree_creator = File::Find::Object::TreeCreate->new();
+
+{
+    my $tree =
+    {
+        'name' => "copy-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 @tests = qw( t/File-Find-Rule.t t/findorule.t );
+my $copy_fn = $tree_creator->get_path(
+    "./t/sample-data/copy-to/"
+);
+
+my $lib_fn = $tree_creator->get_path(
+    "./t/sample-data/copy-to/lib/"
+);
+
+my $FFR_t = $tree_creator->get_path(
+    "./t/sample-data/copy-to/File-Find-Rule.t"
+);
+my $findorule_t = $tree_creator->get_path(
+    "./t/sample-data/copy-to/findorule.t"
+);
+my $foobar_fn = $tree_creator->get_path(
+    "./t/sample-data/copy-to/foobar"
+);
+
+my @tests = ($FFR_t, $findorule_t);
+
+my @ateam_path =
+    map { $tree_creator->get_path("./t/sample-data/copy-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 't/foobar';
+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$/ );
-is_deeply( [ sort $f->in('t') ],
+# TEST
+is_deeply( _run_find($f),
            [ @tests ],
            "name( qr/\\.t\$/ )" );
 
 $f = $class->name( 'foobar' );
-is_deeply( [ $f->in('t') ],
-           [ 't/foobar' ],
+# TEST
+is_deeply( _run_find($f),
+           [ $foobar_fn ],
            "name( 'foobar' )" );
 
 $f = $class->name( '*.t' );
-is_deeply( [ sort $f->in('t') ],
+# TEST
+is_deeply( _run_find($f),
           \@tests,
           "name( '*.t' )" );
 
 $f = $class->name( 'foobar', '*.t' );
-is_deeply( [ sort $f->in('t') ],
-           [ @tests, 't/foobar' ],
+# TEST
+is_deeply( _run_find($f),
+           [ @tests, $foobar_fn ],
            "name( 'foobar', '*.t' )" );
 
 $f = $class->name( [ 'foobar', '*.t' ] );
-is_deeply( [ sort $f->in('t') ],
-           [ @tests, 't/foobar' ],
+# TEST
+is_deeply( _run_find($f),
+           [ @tests, $foobar_fn ],
            "name( [ 'foobar', '*.t' ] )" );
 
 
 
 # exec
 $f = $class->exec(sub { length($_[0]) == 6 })->maxdepth(1);
-is_deeply( [ $f->in('t') ],
-           [ 't/foobar' ],
+# TEST
+is_deeply( _run_find($f),
+           [ $foobar_fn ],
            "exec (short)" );
 
 $f = $class->exec(sub { length($_[0]) > $foobar_size })->maxdepth(1);
-is_deeply( [ $f->in('t') ],
-           [ 't/File-Find-Rule.t' ],
+# TEST
+is_deeply( _run_find($f),
+           [ $FFR_t ],
            "exec (long)" );
 
-is_deeply( [ find( maxdepth => 1, exec => sub { $_[2] eq 't/foobar' }, in => 't' ) ],
-           [ 't/foobar' ],
+# 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
   ->exec(sub { length > $foobar_size })
   ->name( qr/\.t$/ );
 
-is_deeply( [ $f->in('t') ],
-           [ 't/File-Find-Rule.t' ],
+# TEST
+is_deeply( _run_find($f),
+           [ $FFR_t ],
            "exec(match) and name(match)" );
 
 $f = $class
   ->name( qr/foo/ )
   ->maxdepth(1);
 
-is_deeply( [ $f->in('t') ],
+# TEST
+is_deeply( _run_find($f),
            [ ],
            "exec(match) and name(fail)" );
 
   ->maxdepth(1)
   ->exec(sub { $_ !~ /(\.svn|CVS)/ }); # ignore .svn/CVS dirs
 
-is_deeply( [ $f->in('t') ],
-           [ qw( t t/lib  ) ],
+# TEST
+is_deeply( _run_find($f),
+           [ $copy_fn,$lib_fn,],
            "directory autostub" );
 
 
                         ->exec( sub { length > $foobar_size } )
                 )->maxdepth(1);
 
-is_deeply( [ sort $f->in('t') ],
-           [ 't/File-Find-Rule.t', 't/foobar' ],
+# TEST
+is_deeply( _run_find($f),
+           [ $FFR_t, $foobar_fn ],
            "any" );
 
 $f = $class->or( $class->exec( sub { length == 6 } ),
                        ->exec( sub { length > $foobar_size } )
                )->maxdepth(1);
 
-is_deeply( [ sort $f->in('t') ],
-           [ 't/File-Find-Rule.t', 't/foobar' ],
+# TEST
+is_deeply( _run_find($f),
+           [ $FFR_t, $foobar_fn ],
            "or" );
 
 
   ->not( $class->name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ ) )
   ->maxdepth(1)
   ->exec(sub { length == 6 || length > 11 });
-is_deeply( [ $f->in('t') ],
-           [ 't/File-Find-Rule.t' ],
+# TEST
+is_deeply( _run_find($f),
+           [ $FFR_t ],
            "not" );
 
 # not as not_*
   ->not_name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ )
   ->maxdepth(1)
   ->exec(sub { length == 6 || length > 11 });
-is_deeply( [ $f->in('t') ],
-           [ 't/File-Find-Rule.t' ],
+# TEST
+is_deeply( _run_find($f),
+           [ $FFR_t ],
            "not_*" );
 
 # prune/discard (.svn demo)
                         ->discard,
                  $class->new->file );
 
-is_deeply( [ sort $f->in('t') ],
-           [ @tests, 't/foobar', 't/lib/File/Find/Object/Rule/Test/ATeam.pm' ],
+# TEST
+is_deeply( _run_find($f),
+           [ @tests, $foobar_fn, $ATeam_pm_fn ],
            "prune/discard .svn"
          );
 
                         discard   => ),
                   find( file => ) ]);
 
-is_deeply( [ sort $f->in('t') ],
-           [ @tests, 't/foobar', 't/lib/File/Find/Object/Rule/Test/ATeam.pm' ],
+# TEST
+is_deeply( _run_find($f),
+           [ @tests, $foobar_fn, $ATeam_pm_fn ],
            "procedural prune/discard .svn"
          );
 
 # size (stat test)
-is_deeply( [ find( maxdepth => 1, file => size => $foobar_size, in => 't' ) ],
-           [ 't/foobar' ],
+# 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 => 't' ) ],
-           [ 't/foobar' ],
+                   in => $copy_fn ) ],
+           [ $foobar_fn ],
            "size <= $foobar_size (stat)" );
-
+# TEST
 is_deeply( [ find( maxdepth => 1, file => size => "<".($foobar_size + 1),
-                   in => 't' ) ],
-           [ 't/foobar' ],
+                   in => $copy_fn ) ],
+           [ $foobar_fn ],
            "size <($foobar_size + 1) (stat)" );
 
+# TEST
 is_deeply( [ find( maxdepth => 1, file => size => "<1K",
                    exec => sub { length == 6 },
-                   in => 't' ) ],
-           [ 't/foobar' ],
+                   in => $copy_fn ) ],
+           [ $foobar_fn ],
            "size <1K (stat)" );
 
-is_deeply( [ find( maxdepth => 1, file => size => ">3K", in => 't' ) ],
-           [ 't/File-Find-Rule.t' ],
+# 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
-is_deeply( [ find( file => size => ">3M", in => 't' ) ],
+# TEST
+is_deeply( [ find( file => size => ">3M", in => $copy_fn ) ],
            [ ],
            "size >3M (stat)" );
 
-is_deeply( [ find( file => size => ">3G", in => 't' ) ],
+# TEST
+is_deeply( [ find( file => size => ">3G", in => $copy_fn ) ],
            [ ],
            "size >3G (stat)" );
 
 
 #min/maxdepth
 
-is_deeply( [ find( maxdepth => 0, in => 't' ) ],
-           [ 't' ],
+# TEST
+is_deeply( [ find( maxdepth => 0, in => $copy_fn ) ],
+           [ $copy_fn ],
            "maxdepth == 0" );
 
 
                         ],
                  maxdepth => 1 );
 
-is_deeply( [ sort $rule->in( 't' ) ],
-           [ 't', @tests, 't/foobar', 't/lib' ],
+# TEST
+is_deeply( _run_find($rule),
+           [ $copy_fn, @tests, $foobar_fn, $lib_fn ],
            "maxdepth == 1" );
-is_deeply( [ sort $rule->in( 't/' ) ],
-           [ 't', @tests, 't/foobar', 't/lib' ],
+# TEST
+is_deeply( _run_find($rule),
+           [ $copy_fn, @tests, $foobar_fn, $lib_fn ],
            "maxdepth == 1, trailing slash on the path" );
 
-is_deeply( [ sort $rule->in( './t' ) ],
-           [ 't', @tests, 't/foobar', 't/lib' ],
+# TEST
+is_deeply( _run_find($rule),
+           [ $copy_fn, @tests, $foobar_fn, $lib_fn ],
            "maxdepth == 1, ./t" );
-is_deeply( [ sort $rule->in( './././///./t' ) ],
-           [ 't', @tests, 't/foobar', 't/lib' ],
+# TEST
+is_deeply( _run_find($rule),
+           [ $copy_fn, @tests, $foobar_fn, $lib_fn ],
            "maxdepth == 1, ./././///./t" );
 
-my @ateam_path = qw( t/lib
-                     t/lib/File
-                     t/lib/File/Find
-                     t/lib/File/Find/Object
-                     t/lib/File/Find/Object/Rule
-                     t/lib/File/Find/Object/Rule/Test
-                     t/lib/File/Find/Object/Rule/Test/ATeam.pm );
-
+# TEST
 is_deeply( [ sort +find( or => [ find( name => qr/(\.svn|CVS)/,
                                        prune =>
                                        discard =>),
                                  find( ),
                                ],
                          mindepth => 1,
-                         in => 't' ) ],
-           [ @tests, 't/foobar', @ateam_path ],
+                         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 => 't' ) ],
-           [ @tests, 't/foobar', 't/lib' ],
+                         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 => 't' );
+find( extras => { preprocess => sub { my ($self, $list) = @_; $ok = 1; return $list; } }, in => $copy_fn );
+# TEST
 ok( $ok, "extras preprocess fired" );
 
 #iterator
                          discard =>),
                    find(),
                  ],
-           start => 't' );
+           start => $copy_fn );
 
 {
 my @found;
 while ($_ = $f->match) { push @found, $_ }
-is_deeply( [ sort @found ], [ 't', @tests, 't/foobar', @ateam_path ], "iterator" );
+# 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 => 't' ) ],
-           [ 't/File-Find-Rule.t' ],
+                   in => $copy_fn ) ],
+           [ $FFR_t ],
            "negating in the procedural interface" );
 
 # grep
-is_deeply( [ find( maxdepth => 1, file => grep => [ qr/bytes./, [ qr/.?/ ] ], in => 't' ) ],
-           [ 't/foobar' ],
+# TEST
+is_deeply( [ find( maxdepth => 1, file => grep => [ qr/bytes./, [ qr/.?/ ] ], in => $copy_fn ) ],
+           [ $foobar_fn ],
            "grep" );
 
 
 
 # relative
-is_deeply( [ find( 'relative', maxdepth => 1, name => 'foobar', in => 't' ) ],
+# TEST
+is_deeply( [ find( 'relative', maxdepth => 1, name => 'foobar', in => $copy_fn ) ],
            [ 'foobar' ],
            'relative' );
 
 
 # bootstrapping extensions via import
 
-use lib qw(t/lib);
-
 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/copy-to"));

File-Find-Object-Rule/t/findorule.t

 use strict;
 use warnings;
 
-use Test::More tests => 6;
+use lib './t/lib';
+
+use Test::More tests => 5;
 use File::Spec;
 
+use File::Path;
+use File::Find::Object::TreeCreate;
+
+my $tree_creator = File::Find::Object::TreeCreate->new();
+
+{
+    my $tree =
+    {
+        'name' => "copy-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);
+}
+
 # extra tests for findorule.  these are more for testing the parsing code.
 
 sub run ($) {
         File::Spec->curdir(), "scripts", "findorule"
     );
 
-    [ sort split /\n/, `$^X -Mblib $script $expr 2>&1` ];
+    [ sort split /\n/, `$^X -Mblib $script $expr` ];
 }
 
-is_deeply(run 't -file -name foobar', [ 't/foobar' ],
+my $copy_fn = $tree_creator->get_path(
+    "./t/sample-data/copy-to/"
+);
+
+my $FFR_t = $tree_creator->get_path(
+    "./t/sample-data/copy-to/File-Find-Rule.t"
+);
+my $findorule_t = $tree_creator->get_path(
+    "./t/sample-data/copy-to/findorule.t"
+);
+my $foobar_fn = $tree_creator->get_path(
+    "./t/sample-data/copy-to/foobar"
+);
+
+# TEST
+is_deeply(run $copy_fn . ' -file -name foobar', [ $foobar_fn ],
           '-file -name foobar');
 
-is_deeply(run 't -maxdepth 0 -directory',
-          [ 't' ], 'last clause has no args');
+# TEST
+is_deeply(run $copy_fn . ' -maxdepth 0 -directory',
+          [ $copy_fn ], '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/findorule.t t/foobar ) ],
+    # TEST
+    is_deeply(run $copy_fn . ' -file -name \( foobar \*.t \)',
+              [ $FFR_t, $findorule_t, $foobar_fn ],
               'grouping ()');
 
-    is_deeply(run 't -name \( -foo foobar \)',
-              [ 't/foobar' ], 'grouping ( -literal )');
+    # TEST
+    is_deeply(run $copy_fn . ' -name \( -foo foobar \)',
+              [ $foobar_fn ], 'grouping ( -literal )');
 }
 
-is_deeply(run 't -file -name foobar baz',
-          [ "unknown option 'baz'" ], 'no implicit grouping');
+# Remming out due to capturing STDERR using unixisms. In the future, we 
+# may implement this using Test::Trap.
+# is_deeply(run $copy_fn . ' -file -name foobar baz',
+#          [ "unknown option 'baz'" ], 'no implicit grouping');
 
-is_deeply(run 't -maxdepth 0 -name -file',
+# TEST
+is_deeply(run $copy_fn . ' -maxdepth 0 -name -file',
           [], 'terminate at next -');
+
+rmtree($copy_fn);

File-Find-Object-Rule/t/lib/File/Find/Object/TreeCreate.pm

+package File::Find::Object::TreeCreate;
+
+use strict;
+use warnings;
+
+use File::Spec;
+
+sub new
+{
+    my $class = shift;
+    my $self = {};
+    bless $self, $class;
+    $self->_initialize(@_);
+    return $self;
+}
+
+sub _initialize
+{
+}
+
+sub get_path
+{
+    my $self = shift;
+    my $path = shift;
+
+    my @components;
+
+    if ($path =~ s{^\./}{})
+    {
+        push @components, File::Spec->curdir();
+    }
+    
+    my $is_dir = ($path =~ s{/$}{});
+    push @components, split(/\//, $path);
+    if ($is_dir)
+    {
+        return File::Spec->catdir(@components);
+    }
+    else
+    {
+        return File::Spec->catfile(@components);
+    }
+}
+
+sub exist
+{
+    my $self = shift;
+    return (-e $self->get_path(@_));
+}
+
+sub is_file
+{
+    my $self = shift;
+    return (-f $self->get_path(@_));
+}
+
+sub is_dir
+{
+    my $self = shift;
+    return (-d $self->get_path(@_));
+}
+
+sub cat
+{
+    my $self = shift;
+    open my $in, "<", $self->get_path(@_) or
+        return 0;
+    my $data;
+    {
+        local $/;
+        $data = <$in>;
+    }
+    close($in);
+    return $data;
+}
+
+sub ls
+{
+    my $self = shift;
+    opendir my $dir, $self->get_path(@_) or
+        return undef;
+    my @files = 
+        sort { $a cmp $b } 
+        grep { !(($_ eq ".") || ($_ eq "..")) }
+        readdir($dir);
+    closedir($dir);    
+    return \@files;
+}
+
+sub create_tree
+{
+    my ($self, $unix_init_path, $tree) = @_;
+    my $real_init_path = $self->get_path($unix_init_path);
+    return $self->_real_create_tree($real_init_path, $tree);
+}
+
+sub _real_create_tree
+{
+    my ($self, $init_path, $tree) = @_;
+    my $name = $tree->{'name'};
+    if ($name =~ s{/$}{})
+    {
+        my $dir_name = File::Spec->catfile($init_path, $name);
+        mkdir($dir_name);
+        if (exists($tree->{'subs'}))
+        {
+            foreach my $sub (@{$tree->{'subs'}})
+            {
+                $self->_real_create_tree($dir_name, $sub);
+            }
+        }
+    }
+    else
+    {
+        open my $out, ">", File::Spec->catfile($init_path, $name);
+        print {$out} +(exists($tree->{'contents'}) ? $tree->{'contents'} : "");
+        close($out);
+    }
+    return 0;
+}
+1;
+

File-Find-Object-Rule/t/sample-data/to-copy-from/File-Find-Rule.t

+#!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/findorule.t );
+BEGIN {
+    $class = 'File::Find::Object::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($_[0]) == 6 })->maxdepth(1);
+is_deeply( [ $f->in('t') ],
+           [ 't/foobar' ],
+           "exec (short)" );
+
+$f = $class->exec(sub { length($_[0]) > $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 > 11 });
+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 > 11 });
+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/Object/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/Object/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/Object
+                     t/lib/File/Find/Object/Rule
+                     t/lib/File/Find/Object/Rule/Test
+                     t/lib/File/Find/Object/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 { my ($self, $list) = @_; $ok = 1; return $list; } }, 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,9}(\.[^.]{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::Object::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-Object-Rule/t/sample-data/to-copy-from/findorule.t

+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+use File::Spec;
+
+# extra tests for findorule.  these are more for testing the parsing code.
+
+sub run ($) {
+    my $expr = shift;
+    my $script = File::Spec->catfile(
+        File::Spec->curdir(), "scripts", "findorule"
+    );
+
+    [ sort split /\n/, `$^X -Mblib $script $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/findorule.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-Object-Rule/t/sample-data/to-copy-from/foobar

+10 bytess.

File-Find-Object-Rule/t/sample-data/to-copy-from/lib/File/Find/Object/Rule/Test/ATeam.pm

+package File::Find::Object::Rule::Test::ATeam;
+use strict;
+use File::Find::Object::Rule;
+use base 'File::Find::Object::Rule';
+
+sub File::Find::Object::Rule::ba {
+    my $self = shift()->_force_object;
+    $self->exec( sub { die "I pity the fool who uses this in production" });
+}
+
+1;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.