M: Added more test-cases.

The getDepth() method will return the default (or user-specified) directory traversel depth. Calling the setDepth method with a negative value will make the method die.

Build.PL

@@ -10,11 +10,8 @@ Module::Build->new( module_name => 'File::DirWalk',
                         'Carp'           => '1.08',
                         'File::Spec'     => '3.2501',
                         'File::Basename' => '2.76',
-                    },
-                    recommends => {
                         'Test::More'   => '0.72',
                         'Test::Exception' => '0.27'
                     },
-                    sign        => 1,
+                    sign        => 1
-                    create_makefile_pl => 'traditional',
                   )->create_build_script;

MANIFEST

@@ -1,8 +1,65 @@
+Build.PL
 lib/File/DirWalk.pm
 examples/find-perl-binary.pl
 examples/ls.pl
+SIGNATURE
 MANIFEST
-META.yml
+MANIFEST.SKIP
 README
+Copying.txt
+Artistic.txt
 t/1.t
-Makefile.PL
+t/2.t
+t/3.t
+t/4.t
+t/tree/dir1/file0
+t/tree/dir1/file1
+t/tree/dir1/file2
+t/tree/dir1/file3
+t/tree/dir1/file4
+t/tree/dir1/file5
+t/tree/dir1/file6
+t/tree/dir1/file7
+t/tree/dir1/file8
+t/tree/dir1/file9
+t/tree/dir2/file0
+t/tree/dir2/file1
+t/tree/dir2/file2
+t/tree/dir2/file3
+t/tree/dir2/file4
+t/tree/dir2/file5
+t/tree/dir2/file6
+t/tree/dir2/file7
+t/tree/dir2/file8
+t/tree/dir2/file9
+t/tree/dir3/file0
+t/tree/dir3/file1
+t/tree/dir3/file2
+t/tree/dir3/file3
+t/tree/dir3/file4
+t/tree/dir3/file5
+t/tree/dir3/file6
+t/tree/dir3/file7
+t/tree/dir3/file8
+t/tree/dir3/file9
+t/tree/dir4/file0
+t/tree/dir4/file1
+t/tree/dir4/file2
+t/tree/dir4/file3
+t/tree/dir4/file4
+t/tree/dir4/file5
+t/tree/dir4/file6
+t/tree/dir4/file7
+t/tree/dir4/file8
+t/tree/dir4/file9
+t/tree/dir5/file0
+t/tree/dir5/file1
+t/tree/dir5/file2
+t/tree/dir5/file3
+t/tree/dir5/file4
+t/tree/dir5/file5
+t/tree/dir5/file6
+t/tree/dir5/file7
+t/tree/dir5/file8
+t/tree/dir5/file9
+META.yml

MANIFEST.SKIP

@@ -1 +1,6 @@
 ^MYMETA.yml$
+.git
+.DS_Store
+Build
+_build
+blib

META.yml

@@ -1,26 +0,0 @@
----
-abstract: "walk through a directory tree and run callbacks\non files, symlinks and directories."
-author:
-  - 'Jens Luedicke E<lt>jensl@cpan.orgE<gt>'
-configure_requires:
-  Module::Build: 0.36
-generated_by: 'Module::Build version 0.3603'
-license: perl
-meta-spec:
-  url: http://module-build.sourceforge.net/META-spec-v1.4.html
-  version: 1.4
-name: File-DirWalk
-provides:
-  File::DirWalk:
-    file: lib/File/DirWalk.pm
-    version: 0.4
-recommends:
-  Test::Exception: 0.27
-  Test::More: 0.72
-requires:
-  Carp: 1.08
-  File::Basename: 2.76
-  File::Spec: 3.2501
-resources:
-  license: http://dev.perl.org/licenses/
-version: 0.4

MYMETA.yml

@@ -1,12 +0,0 @@
----
-configure_requires:
-  Module::Build: 0.36
-dynamic_config: 0
-generated_by: 'Module::Build version 0.3603'
-recommends:
-  Test::Exception: 0.27
-  Test::More: 0.72
-requires:
-  Carp: 1.08
-  File::Basename: 2.76
-  File::Spec: 3.2501

README

@@ -1,6 +1,6 @@
-Copyright (c) 2005-2012 Jens Luedicke <jensl@cpan.org>.
+Copyright (c) 2005-2013 Jens Luedicke <jensl@cpan.org>.
 
-File-DirWalk version 0.4
+File-DirWalk version 0.5
 =========================
 
 File::DirWalk is a Perl module to walk through a directory tree
@@ -19,10 +19,12 @@ DEPENDENCIES
 
 This module requires these other modules which can be obtained from
 the CPAN <http://cpan.org> if they are not allready installed on
-your system :
+your system:
 
   File::Basename
   File::Spec
+  Test::More
+  Test::Exception
 
 LICENCE INFORMATION
 

examples/find-perl-binary.pl

@@ -3,7 +3,6 @@
 use strict;
 use warnings;
 
-use File::Basename;
 use File::DirWalk;
 
 my $dw = new File::DirWalk();
@@ -11,21 +10,20 @@ my $dw = new File::DirWalk();
 $dw->onDirEnter(sub {
 	my ($path) = @_;
 
-	print "$path\n";
+	if ($dw->currentBasename() =~ /sbin|lib|share|local|include|libexec|X11/) {
-	
-	if (basename($path) =~ /sbin|lib|share|local|include|libexec|X11/) {
 		return PRUNE;
 	}
 
 	return SUCCESS;
 });
 
+my $found = "";
+
 $dw->onFile(sub {
 	my ($path) = @_;
 
-	print "$path\n";
+	if ($dw->currentBasename() eq "perl") {
-	
+        $found = $path;
-	if (basename($path) eq "perl") {
 		return ABORTED;
 	}
 
@@ -33,3 +31,5 @@ $dw->onFile(sub {
 });
 
 $dw->walk("/usr");
+
+print "perl is in $found\n";

examples/ls.pl

@@ -31,9 +31,10 @@ $dw->onDirLeave(sub {
 	return SUCCESS;
 });
 
-if (-e $ARGV[0]) {
+my $path = cwd();
-	$dw->walk($ARGV[0]);
+
-} else {
+if ((defined $ARGV[0]) and (-e $ARGV[0])) {
- 	my $cwd = getcwd();
+    $path = $ARGV[0];
- 	$dw->walk($cwd);
 }
+
+$dw->walk($path);

lib/File/DirWalk.pm

@@ -1,4 +1,4 @@
-# Copyright (c) 2005-2012 Jens Luedicke <jensl@cpan.org>.
+# Copyright (c) 2005-2013 Jens Luedicke <jensl@cpan.org>.
 #
 # This module is free software; you can redistribute it and/or modify
 # it under the same terms as Perl 5.10.0. For more details, see the
@@ -11,7 +11,7 @@
 package File::DirWalk;
 use base qw(Exporter);
 
-our $VERSION = '0.4';
+our $VERSION = '0.6';
 our @EXPORT = qw(FAILED SUCCESS ABORTED PRUNE);
 
 use warnings;
@@ -19,7 +19,7 @@ use strict;
 use Carp;
 
 use File::Basename;
-use File::Spec;
+use File::Spec::Functions qw(no_upwards splitdir catfile);
 
 use constant SUCCESS    => 1;
 use constant FAILED     => 0;
@@ -30,18 +30,15 @@ sub new {
     my ($class) = @_;
     my $self = bless {}, $class;
 
-	$self->{onBeginWalk} = sub { SUCCESS };
+    foreach my $action (qw/onBeginWalk onLink onFile onDirEnter onDirLeave/) {
-	$self->{onLink}      = sub { SUCCESS };
+        $self->{$action} = sub { SUCCESS };
-	$self->{onFile}      = sub { SUCCESS };
+    }
-	$self->{onDirEnter}  = sub { SUCCESS };
-	$self->{onDirLeave}  = sub { SUCCESS };
 
     $self->{depth}         = 0;
-	$self->{depth_count} = 0;
+    $self->{currentDepth}  = 0;
 
-	$self->{filesInDir}  = 0;
+    $self->{entryList}   = [];
-
+    $self->{count}       = 0;
-# 	$self->{customResponse} = {};
 
     return $self;
 }
@@ -49,6 +46,10 @@ sub new {
 sub setHandler {
     my ($self,$action,$func) = @_;
 
+    if (not exists $self->{$action}) {
+        croak("Invalid action argument: $action");
+    }
+
     if (ref($func) ne 'CODE') {
         croak("Second argument must be CODE reference.");
     }
@@ -83,12 +84,21 @@ sub onDirLeave {
 
 sub setDepth {
     my ($self,$v) = @_;
+    if ($v < 0) {
+        croak("Directory depth is negative: $v");
+    }
+
     $self->{depth} = $v;
 }
 
 sub getDepth {
     my ($self) = @_;
-	return $self->{depth_count};
+    return $self->{depth};
+}
+
+sub currentDepth {
+    my ($self) = @_;
+    return $self->{currentDepth};
 }
 
 sub currentDir {
@@ -106,53 +116,56 @@ sub currentBasename {
     return $self->{currentBasename};
 }
 
-sub filesInDir {
+sub count {
     my ($self) = @_;
-	return $self->{filesInDir};
+    return $self->{count};
+}
+
+sub entryList {
+    my ($self) = @_;
+    return $self->{entryList};
 }
 
 sub walk {
     my ($self,$path) = @_;
+    my $currentDir      = dirname($path);
+    my $currentBasename = basename($path);
+    my $currentPath     = $path;
 
-	$self->{currentDir}      = dirname($path);
+    $self->{currentDir}      = $currentDir;
-	$self->{currentBasename} = basename($path);
+    $self->{currentBasename} = $currentBasename;
     $self->{currentPath}     = $path;
 
-	if ((my $r = $self->{onBeginWalk}->($path)) != SUCCESS) {
+    if ((my $r = $self->{onBeginWalk}->($path,$currentDir,$currentBasename)) != SUCCESS) {
         return $r;
     }
 
     if (-l $path) {
 
-		if ((my $r = $self->{onLink}->($path)) != SUCCESS) {
+        if ((my $r = $self->{onLink}->($path,$currentDir,$currentBasename)) != SUCCESS) {
             return $r;
         }
 
     } elsif (-d $path) {
 
-		if ($self->{depth} != 0) {
+        if (($self->{depth} > 0) and ($self->{currentDepth} == $self->{depth})) {
-			if ($self->{depth_count} == $self->{depth}) {
             return SUCCESS;
         }
-		}
 
-		opendir my $dirh, $path || return FAILED;
+        opendir (my $dirh, $path) || return FAILED;
-		my @dir_contents = readdir $dirh;
+        $self->{entryList}    = [ no_upwards(readdir $dirh) ];
-		@dir_contents    = File::Spec->no_upwards(@dir_contents);
+        $self->{count}        = scalar @{$self->{entryList}};
 
-		$self->{filesInDir} = scalar @dir_contents;
+        ++$self->{currentDepth};
-
+        if ((my $r = $self->{onDirEnter}->($path,$currentDir,$currentBasename)) != SUCCESS) {
-		if ((my $r = $self->{onDirEnter}->($path)) != SUCCESS) {
             return $r;
         }
-		++$self->{depth_count};
 
         # be portable.
-		my @dirs = File::Spec->splitdir($path);
+        my @dirs = splitdir($path);
-
+        foreach my $f (@{$self->{entryList}}) {
-		foreach my $f (@dir_contents) {
             # be portable.
-			my $path = File::Spec->catfile(@dirs, $f);
+            my $path = catfile(@dirs, $f);
 
             my $r = $self->walk($path);
 
@@ -165,12 +178,16 @@ sub walk {
 
         closedir $dirh;
 
-		if ((my $r = $self->{onDirLeave}->($path)) != SUCCESS) {
+        $self->{currentDir}      = $currentDir;
+        $self->{currentBasename} = $currentBasename;
+        $self->{currentPath}     = $path;
+
+        if ((my $r = $self->{onDirLeave}->($path,$currentDir,$currentBasename)) != SUCCESS) {
             return $r;
         }
-		--$self->{depth_count};
+        --$self->{currentDepth};
     } else {
-		if ((my $r = $self->{onFile}->($path)) != SUCCESS) {
+        if ((my $r = $self->{onFile}->($path,$currentDir,$currentBasename)) != SUCCESS) {
             return $r;
         }
     }
@@ -264,10 +281,16 @@ Specify a function to be run when leaving a directory.
 
 Set the directory traversal depth. Once the specified directory depth
 has been reached, the C<walk> method returns. The default value is 0.
+Precondition: The value has to be positive. The method will die
+if called with a negative value.
 
 =item getDepth
 
-Returns the directory traversal depth.
+Returns the user-specified directory traversal depth. The default value is 0.
+
+=item currentDepth
+
+Returns the current directory traversal depth.
 
 =item currentDir
 
@@ -309,9 +332,14 @@ Returns the current base name of the current path:
         return SUCCESS;
     });
 
-=item filesInDir
+=item count
 
-Returns the number of files wthin the current directory.
+Returns the number of elements wthin the current directory.
+Excludes . and ..
+
+=item entryList
+
+Returns an array reference to the elements wthin the current directory.
 Excludes . and ..
 
 =item walk($path)
@@ -358,12 +386,15 @@ as return values:
 
 =back
 
-=head1 BUGS
+=head1 DEVELOPMENT
 
-Please mail the author if you encounter any bugs.
+Please mail the author if you encounter any bugs. The most recent development
+version can be found on GitHub: L<https://github.com/nullmedium/File-DirWalk>
 
 =head1 CHANGES
 
+Version 0.5: bugfixes, improved testing, new currentDepth() method.
+
 Version 0.4: add more methods, better testing, more documentation.
 
 Version 0.3: add PRUNE constant. add option to specify the directory depth.
@@ -384,7 +415,7 @@ Jens Luedicke E<lt>jensl@cpan.orgE<gt>
 
 =head1 COPYRIGHT AND LICENCE
 
-Copyright (c) 2005-2012 Jens Luedicke <jensl@cpan.org>.
+Copyright (c) 2005-2013 Jens Luedicke <jensl@cpan.org>.
 
 This module is free software; you can redistribute it and/or modify
 it under the same terms as Perl 5.10.0. For more details, see the

t/1.t

@@ -1,84 +1,42 @@
-use Test::More qw(no_plan);
+use Test::More tests => 33;
 use Test::Exception;
 
-use File::Basename;
+BEGIN { use_ok( 'File::DirWalk' ); }
-use File::DirWalk;
+require_ok( 'File::DirWalk' );
-
-my $perl_path        = dirname($^X);
-my $perl_interpreter = basename($^X);
 
 $dw = new File::DirWalk();
+is(ref($dw), 'File::DirWalk' );
 
-ok( ref($dw) eq 'File::DirWalk' );
+is(SUCCESS, 1);
+is(FAILED,  0);
+is(ABORTED, -1);
+is(PRUNE,  -10);
 
-dies_ok { $dw->setHandler(Foo => 0); }
+is ($dw->getDepth(), 0);
+dies_ok { $dw->setDepth(-1) };
+is ($dw->getDepth(), 0);
+ok ($dw->setDepth(1));
+is ($dw->getDepth(), 1);
 
-$dw->onFile(sub {
+ok ($dw->onBeginWalk(sub {}));
-	my ($path) = @_;
+ok ($dw->onLink(sub {}));
+ok ($dw->onFile(sub {}));
+ok ($dw->onDirEnter(sub {}));
+ok ($dw->onDirLeave(sub {}));
+dies_ok {$dw->onBeginWalk(0)};
+dies_ok {$dw->onLink(0)};
+dies_ok {$dw->onFile(0)};
+dies_ok {$dw->onDirEnter(0)};
+dies_ok {$dw->onDirLeave(0)};
 
-	if (basename($path) eq "1.t") {
+ok ($dw->setHandler(onBeginWalk => sub {}));
-		return ABORTED;
+ok ($dw->setHandler(onLink      => sub {}));
-	}
+ok ($dw->setHandler(onFile      => sub {}));
-
+ok ($dw->setHandler(onDirEnter  => sub {}));
-	return SUCCESS;
+ok ($dw->setHandler(onDirLeave  => sub {}));
-});
+dies_ok {$dw->setHandler(onBeginWalk => 0)};
-
+dies_ok {$dw->setHandler(onLink      => 0)};
-ok( $dw->walk($0) == ABORTED );
+dies_ok {$dw->setHandler(onFile      => 0)};
-
+dies_ok {$dw->setHandler(onDirEnter  => 0)};
-$dw->onDirEnter(sub {
+dies_ok {$dw->setHandler(onDirLeave  => 0)};
-	my ($path) = @_;
+dies_ok {$dw->setHandler(Foo => sub {})};
-
-	if ($path eq $perl_path) {
-		return FAILED;
-	}
-		
-	return SUCCESS;
-});
-
-ok( $dw->walk($perl_path) == FAILED );
-
-$dw->onBeginWalk(sub {
-	my ($path) = @_;
-	if (dirname($path) eq $dw->currentDir) {
-		return ABORTED;
-	}
-
-	return SUCCESS;
-});
-
-ok( $dw->walk($perl_path) == ABORTED );
-
-$dw->onBeginWalk(sub {
-	my ($path) = @_;
-	if ($path eq $dw->currentPath) {
-		return ABORTED;
-	}
-
-	return SUCCESS;
-});
-
-ok( $dw->walk($perl_path) == ABORTED );
-
-$dw->onFile(sub {
-	my ($path) = @_;
-
-	if (basename($path) eq $perl_interpreter) {
-		return ABORTED;
-	}
-
-	return SUCCESS;
-});
-
-ok( $dw->walk($perl_path) == ABORTED );
-
-$dw->onFile(sub {
-	my ($path) = @_;
-	
-	if (basename($path) eq "sh") {
-		return ABORTED;
-	}
-
-	return SUCCESS;
-});
-
-ok( $dw->walk("/bin") == ABORTED );

t/2.t

@@ -0,0 +1,34 @@
+use Test::More qw(no_plan);
+use Test::Exception;
+
+use File::Basename;
+
+BEGIN { use_ok( 'File::DirWalk' ); }
+require_ok( 'File::DirWalk' );
+
+ok(-e "t/");
+ok(-d "t/");
+
+foreach my $f qw(1.t 2.t 3.t 4.t) {
+    $dw = new File::DirWalk();
+    $dw->setDepth(1);
+
+    $dw->onFile(sub {
+        my ($path,$dir,$basename) = @_;
+        ok(-e $path);
+        ok(-f $path);
+        ok(-d $dir);
+        is($dir, "t");
+        is($dw->currentDir(), "t");
+        is($dw->currentDir(), $dir);
+        is($dw->currentBasename(), $basename);
+
+        if (($dw->currentBasename() eq $f) and ($basename eq $f)) {
+            return 42;
+        }
+
+        return SUCCESS;
+    });
+
+    is($dw->walk("t/"), 42);
+}

t/3.t

@@ -0,0 +1,55 @@
+use Test::More qw(no_plan);
+use Test::Exception;
+
+use File::Basename;
+
+BEGIN { use_ok( 'File::DirWalk' ); }
+require_ok( 'File::DirWalk' );
+
+my $perl_path        = dirname($^X);
+my $perl_interpreter = basename($^X);
+
+$dw = new File::DirWalk();
+$dw->onDirEnter(sub {
+    my ($path) = @_;
+    ok(-e $path);
+    ok(-d $path);
+
+    if ($dw->currentPath() eq $perl_path) {
+        return 42;
+    }
+        
+    return SUCCESS;
+});
+
+is( $dw->walk($perl_path), 42 );
+
+$dw = new File::DirWalk();
+$dw->onDirEnter(sub {
+    my ($path) = @_;
+    ok(-e $path);
+    ok(-d $path);
+
+    if ($dw->currentDir() eq $perl_path) {
+        return 42;
+    }
+        
+    return SUCCESS;
+});
+
+is( $dw->walk($perl_path), 42 );
+
+$dw = new File::DirWalk();
+$dw->onFile(sub {
+    my ($path) = @_;
+    ok(-e $path);
+    ok(-f $path);
+
+    if ($dw->currentBasename() eq $perl_interpreter) {
+        return 42;
+    }
+
+    return SUCCESS;
+});
+
+is( $dw->walk($perl_path), 42 );

t/4.t

@@ -0,0 +1,121 @@
+use Test::More qw(no_plan);
+use Test::Exception;
+
+use File::Basename;
+use File::Spec::Functions;
+
+BEGIN { use_ok( 'File::DirWalk' ); }
+require_ok( 'File::DirWalk' );
+
+$dw = new File::DirWalk();
+
+ok( -e "t/tree" );
+ok( -d "t/tree" );
+
+foreach my $subdir (qw(dir1 dir2 dir3 dir4 dir5)) {
+    ok( -e "t/tree/$subdir" );
+    ok( -d "t/tree/$subdir" );
+
+    $dw = new File::DirWalk();
+    $dw->onBeginWalk(sub {
+        my ($path,$dir,$basename) = @_;
+        ok(-e $path);
+        ok(-d $dir);
+        is($dw->currentDir(), $dir);
+        is($dw->currentBasename(), $basename);
+
+        if (($dw->currentBasename() eq $subdir) and ($basename eq $subdir)) {
+            return 42;
+        }
+
+        return SUCCESS;
+    });
+    is( $dw->walk("t/tree"), 42 );
+
+    $dw = new File::DirWalk();
+    $dw->onDirEnter(sub {
+        my ($path,$dir,$basename) = @_;
+        ok(-e $path);
+        ok(-d $path);
+        ok(-d $dir);
+        is($dw->currentDir(), $dir);
+        is($dw->currentBasename(), $basename);
+
+        if (($dw->currentBasename() eq $subdir) and ($basename eq $subdir)) {
+            is( $dw->currentDepth(), 2 );
+            is( @{$dw->entryList()}, 10);
+            is( $dw->count(), 10 );
+
+            foreach my $expected (qw(file0 file1 file2 file3 file4 file5 file6 file7 file8 file9)) {
+                my @foo = grep(/$expected/, @{$dw->entryList()});
+                is(@foo, 1);
+                is($foo[0], $expected);
+            }
+            
+            return 42;
+        }
+
+        return SUCCESS;
+    });
+    is( $dw->walk("t/tree"), 42 );
+
+    $dw = new File::DirWalk();
+    $dw->onDirLeave(sub {
+        my ($path,$dir,$basename) = @_;
+        ok(-e $path);
+        ok(-d $path);
+        ok(-d $dir);
+        is($dw->currentDir(), $dir);
+        is($dw->currentBasename(), $basename);
+
+        if (($dw->currentBasename() eq $subdir) and ($basename eq $subdir)) {
+            is( $dw->currentDepth(), 2 );
+            is( @{$dw->entryList()}, 10);
+            is( $dw->count(), 10 );
+
+            foreach my $expected (qw(file0 file1 file2 file3 file4 file5 file6 file7 file8 file9)) {
+                my @foo = grep(/$expected/, @{$dw->entryList()});
+                is(@foo, 1);
+                is($foo[0], $expected);
+            }
+            
+            return 42;
+        }
+
+        return SUCCESS;
+    });
+
+    is( $dw->walk("t/tree"), 42 );
+
+    $dw = new File::DirWalk();
+    $dw->onFile(sub {
+        my ($path,$dir,$basename) = @_;
+        ok(-e $path);
+        ok(-f $path);
+        ok(-d $dir);
+        is($dir, "t/tree/$subdir");
+        is($dw->currentDir(), "t/tree/$subdir");
+        is($dw->currentDir(), $dir);
+        is($dw->currentBasename(), $basename);
+        return SUCCESS;
+    });
+
+    is( $dw->walk("t/tree/$subdir"), SUCCESS );
+    is( $dw->count(), 10 );
+}
+
+$files = 0;
+$dw = new File::DirWalk();
+$dw->onFile(sub {
+    my ($path,$dir,$basename) = @_;
+    ok(-e $path);
+    ok(-f $path);
+    ok(-d $dir);
+    is($dw->currentDir(), $dir);
+    is($dw->currentBasename(), $basename);
+    ++$files;
+    return SUCCESS;
+});
+
+is( $dw->walk("t/tree"), SUCCESS );
+is( $files, 50 );