jens/File-DirWalk
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compare commits

base: jens:version-0.5
Branches Tags
jens:master jens:version-0.5
jens:release-0.5 jens:release-0.4
..
compare: jens:master
Branches Tags
jens:master jens:version-0.5
jens:release-0.5 jens:release-0.4

5 Commits
version-0. ... master

Author SHA1 Message Date
Jens Luedicke
9492cfde50 M: Added more test-cases. 2013-03-10 21:56:40 +01:00
Jens Luedicke
d0319851f3 M: Added more test-cases. 2013-03-10 20:14:25 +01:00
Jens Luedicke
6ca6dad45b M: Code style (no tabs). 2013-03-10 19:37:50 +01:00
Jens Luedicke
395907e53b M: Pass directory and basename to callback functions. 2013-03-10 19:35:57 +01:00
Jens Luedicke
dcd092f5aa M: Increased version number. 2013-03-10 19:01:11 +01:00
5 changed files with 137 additions and 95 deletions
Expand all files Collapse all files

13
lib/File/DirWalk.pm
View File

@@ -11,7 +11,7 @@
package File::DirWalk; package File::DirWalk;
use base qw(Exporter); use base qw(Exporter);
our $VERSION = '0.5'; our $VERSION = '0.6';
our @EXPORT = qw(FAILED SUCCESS ABORTED PRUNE); our @EXPORT = qw(FAILED SUCCESS ABORTED PRUNE);
use warnings; use warnings;
@@ -128,7 +128,6 @@ sub entryList {
sub walk { sub walk {
my ($self,$path) = @_; my ($self,$path) = @_;
my $currentDir = dirname($path); my $currentDir = dirname($path);
my $currentBasename = basename($path); my $currentBasename = basename($path);
my $currentPath = $path; my $currentPath = $path;
@@ -137,13 +136,13 @@ sub walk {
$self->{currentBasename} = $currentBasename; $self->{currentBasename} = $currentBasename;
$self->{currentPath} = $path; $self->{currentPath} = $path;
if ((my $r = $self->{onBeginWalk}->($path)) != SUCCESS) { if ((my $r = $self->{onBeginWalk}->($path,$currentDir,$currentBasename)) != SUCCESS) {
return $r; return $r;
} }
if (-l $path) { if (-l $path) {
if ((my $r = $self->{onLink}->($path)) != SUCCESS) { if ((my $r = $self->{onLink}->($path,$currentDir,$currentBasename)) != SUCCESS) {
return $r; return $r;
} }
@@ -158,7 +157,7 @@ sub walk {
$self->{count} = scalar @{$self->{entryList}}; $self->{count} = scalar @{$self->{entryList}};
++$self->{currentDepth}; ++$self->{currentDepth};
if ((my $r = $self->{onDirEnter}->($path)) != SUCCESS) { if ((my $r = $self->{onDirEnter}->($path,$currentDir,$currentBasename)) != SUCCESS) {
return $r; return $r;
} }
@@ -183,12 +182,12 @@ sub walk {
$self->{currentBasename} = $currentBasename; $self->{currentBasename} = $currentBasename;
$self->{currentPath} = $path; $self->{currentPath} = $path;
if ((my $r = $self->{onDirLeave}->($path)) != SUCCESS) { if ((my $r = $self->{onDirLeave}->($path,$currentDir,$currentBasename)) != SUCCESS) {
return $r; return $r;
} }
--$self->{currentDepth}; --$self->{currentDepth};
} else { } else {
if ((my $r = $self->{onFile}->($path)) != SUCCESS) { if ((my $r = $self->{onFile}->($path,$currentDir,$currentBasename)) != SUCCESS) {
return $r; return $r;
} }
} }

7
t/1.t
View File

@@ -1,4 +1,4 @@
use Test::More tests => 29; use Test::More tests => 33;
use Test::Exception; use Test::Exception;
BEGIN { use_ok( 'File::DirWalk' ); } BEGIN { use_ok( 'File::DirWalk' ); }
@@ -7,6 +7,11 @@ require_ok( 'File::DirWalk' );
$dw = new File::DirWalk(); $dw = new File::DirWalk();
is(ref($dw), 'File::DirWalk' ); is(ref($dw), 'File::DirWalk' );
is(SUCCESS, 1);
is(FAILED, 0);
is(ABORTED, -1);
is(PRUNE, -10);
is ($dw->getDepth(), 0); is ($dw->getDepth(), 0);
dies_ok { $dw->setDepth(-1) }; dies_ok { $dw->setDepth(-1) };
is ($dw->getDepth(), 0); is ($dw->getDepth(), 0);

29
t/2.t
View File

@@ -10,20 +10,25 @@ ok(-e "t/");
ok(-d "t/"); ok(-d "t/");
foreach my $f qw(1.t 2.t 3.t 4.t) { foreach my $f qw(1.t 2.t 3.t 4.t) {
$dw = new File::DirWalk(); $dw = new File::DirWalk();
$dw->setDepth(1); $dw->setDepth(1);
$dw->onFile(sub { $dw->onFile(sub {
my ($path) = @_; my ($path,$dir,$basename) = @_;
ok(-e $path); ok(-e $path);
ok(-f $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) { if (($dw->currentBasename() eq $f) and ($basename eq $f)) {
return 42; return 42;
} }
return SUCCESS; return SUCCESS;
}); });
is($dw->walk("t/"), 42); is($dw->walk("t/"), 42);
} }

42
t/3.t
View File

@@ -11,45 +11,45 @@ my $perl_interpreter = basename($^X);
$dw = new File::DirWalk(); $dw = new File::DirWalk();
$dw->onDirEnter(sub { $dw->onDirEnter(sub {
my ($path) = @_; my ($path) = @_;
ok(-e $path); ok(-e $path);
ok(-d $path); ok(-d $path);
if ($dw->currentPath() eq $perl_path) { if ($dw->currentPath() eq $perl_path) {
return 42; return 42;
} }
return SUCCESS; return SUCCESS;
}); });
is( $dw->walk($perl_path), 42 ); is( $dw->walk($perl_path), 42 );
$dw = new File::DirWalk(); $dw = new File::DirWalk();
$dw->onDirEnter(sub { $dw->onDirEnter(sub {
my ($path) = @_; my ($path) = @_;
ok(-e $path); ok(-e $path);
ok(-d $path); ok(-d $path);
if ($dw->currentDir() eq $perl_path) { if ($dw->currentDir() eq $perl_path) {
return 42; return 42;
} }
return SUCCESS; return SUCCESS;
}); });
is( $dw->walk($perl_path), 42 ); is( $dw->walk($perl_path), 42 );
$dw = new File::DirWalk(); $dw = new File::DirWalk();
$dw->onFile(sub { $dw->onFile(sub {
my ($path) = @_; my ($path) = @_;
ok(-e $path); ok(-e $path);
ok(-f $path); ok(-f $path);
if ($dw->currentBasename() eq $perl_interpreter) { if ($dw->currentBasename() eq $perl_interpreter) {
return 42; return 42;
} }
return SUCCESS; return SUCCESS;
}); });
is( $dw->walk($perl_path), 42 ); is( $dw->walk($perl_path), 42 );

137
t/4.t
View File

@@ -13,75 +13,108 @@ ok( -e "t/tree" );
ok( -d "t/tree" ); ok( -d "t/tree" );
foreach my $subdir (qw(dir1 dir2 dir3 dir4 dir5)) { foreach my $subdir (qw(dir1 dir2 dir3 dir4 dir5)) {
ok( -e "t/tree/$subdir" ); ok( -e "t/tree/$subdir" );
ok( -d "t/tree/$subdir" ); ok( -d "t/tree/$subdir" );
$dw = new File::DirWalk(); $dw = new File::DirWalk();
$dw->onBeginWalk(sub { $dw->onBeginWalk(sub {
my ($path) = @_; my ($path,$dir,$basename) = @_;
ok(-e $path); ok(-e $path);
ok(-d $dir);
is($dw->currentDir(), $dir);
is($dw->currentBasename(), $basename);
if ($dw->currentBasename() eq $subdir) { if (($dw->currentBasename() eq $subdir) and ($basename eq $subdir)) {
return 42; return 42;
} }
return SUCCESS; return SUCCESS;
}); });
is( $dw->walk("t/tree"), 42 ); is( $dw->walk("t/tree"), 42 );
$dw = new File::DirWalk(); $dw = new File::DirWalk();
$dw->onDirEnter(sub { $dw->onDirEnter(sub {
my ($path) = @_; my ($path,$dir,$basename) = @_;
ok(-e $path); ok(-e $path);
ok(-d $path); ok(-d $path);
ok(-d $dir);
is($dw->currentDir(), $dir);
is($dw->currentBasename(), $basename);
if ($dw->currentBasename() eq $subdir) { if (($dw->currentBasename() eq $subdir) and ($basename eq $subdir)) {
is( $dw->count(), 10 ); is( $dw->currentDepth(), 2 );
is( $dw->currentDepth(), 2 ); is( @{$dw->entryList()}, 10);
return 42; is( $dw->count(), 10 );
}
return SUCCESS; foreach my $expected (qw(file0 file1 file2 file3 file4 file5 file6 file7 file8 file9)) {
}); my @foo = grep(/$expected/, @{$dw->entryList()});
is( $dw->walk("t/tree"), 42 ); is(@foo, 1);
is($foo[0], $expected);
}
$dw = new File::DirWalk(); return 42;
$dw->onDirLeave(sub { }
my ($path) = @_;
ok(-e $path);
ok(-d $path);
if ($dw->currentBasename() eq $subdir) { return SUCCESS;
is( $dw->count(), 10 ); });
is( $dw->currentDepth(), 2 ); is( $dw->walk("t/tree"), 42 );
return 42;
}
return SUCCESS; $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);
is( $dw->walk("t/tree"), 42 ); if (($dw->currentBasename() eq $subdir) and ($basename eq $subdir)) {
is( $dw->currentDepth(), 2 );
is( @{$dw->entryList()}, 10);
is( $dw->count(), 10 );
$dw = new File::DirWalk(); foreach my $expected (qw(file0 file1 file2 file3 file4 file5 file6 file7 file8 file9)) {
$dw->onFile(sub { my @foo = grep(/$expected/, @{$dw->entryList()});
my ($path) = @_; is(@foo, 1);
ok(-e $path); is($foo[0], $expected);
ok(-f $path); }
return SUCCESS;
});
is( $dw->walk("t/tree/$subdir"), SUCCESS ); return 42;
is( $dw->count(), 10 ); }
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; $files = 0;
$dw = new File::DirWalk(); $dw = new File::DirWalk();
$dw->onFile(sub { $dw->onFile(sub {
my ($path) = @_; my ($path,$dir,$basename) = @_;
ok(-e $path); ok(-e $path);
ok(-f $path); ok(-f $path);
++$files; ok(-d $dir);
return SUCCESS; is($dw->currentDir(), $dir);
is($dw->currentBasename(), $basename);
++$files;
return SUCCESS;
}); });
is( $dw->walk("t/tree"), SUCCESS ); is( $dw->walk("t/tree"), SUCCESS );