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

Compare commits

base: jens:release-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
release-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;
use base qw(Exporter);
our $VERSION = '0.5';
our $VERSION = '0.6';
our @EXPORT = qw(FAILED SUCCESS ABORTED PRUNE);
use warnings;
@@ -128,7 +128,6 @@ sub entryList {
sub walk {
my ($self,$path) = @_;
my $currentDir = dirname($path);
my $currentBasename = basename($path);
my $currentPath = $path;
@@ -137,13 +136,13 @@ sub walk {
$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;
}
@@ -158,7 +157,7 @@ sub walk {
$self->{count} = scalar @{$self->{entryList}};
++$self->{currentDepth};
if ((my $r = $self->{onDirEnter}->($path)) != SUCCESS) {
if ((my $r = $self->{onDirEnter}->($path,$currentDir,$currentBasename)) != SUCCESS) {
return $r;
}
@@ -183,12 +182,12 @@ sub walk {
$self->{currentBasename} = $currentBasename;
$self->{currentPath} = $path;
if ((my $r = $self->{onDirLeave}->($path)) != SUCCESS) {
if ((my $r = $self->{onDirLeave}->($path,$currentDir,$currentBasename)) != SUCCESS) {
return $r;
}
--$self->{currentDepth};
} else {
if ((my $r = $self->{onFile}->($path)) != SUCCESS) {
if ((my $r = $self->{onFile}->($path,$currentDir,$currentBasename)) != SUCCESS) {
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;
BEGIN { use_ok( 'File::DirWalk' ); }
@@ -7,6 +7,11 @@ require_ok( 'File::DirWalk' );
$dw = new File::DirWalk();
is(ref($dw), 'File::DirWalk' );
is(SUCCESS, 1);
is(FAILED, 0);
is(ABORTED, -1);
is(PRUNE, -10);
is ($dw->getDepth(), 0);
dies_ok { $dw->setDepth(-1) };
is ($dw->getDepth(), 0);

29
t/2.t
View File

@@ -10,20 +10,25 @@ 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 = new File::DirWalk();
$dw->setDepth(1);
$dw->onFile(sub {
my ($path) = @_;
ok(-e $path);
ok(-f $path);
$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) {
return 42;
}
if (($dw->currentBasename() eq $f) and ($basename eq $f)) {
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->onDirEnter(sub {
my ($path) = @_;
ok(-e $path);
ok(-d $path);
my ($path) = @_;
ok(-e $path);
ok(-d $path);
if ($dw->currentPath() eq $perl_path) {
return 42;
}
if ($dw->currentPath() eq $perl_path) {
return 42;
}
return SUCCESS;
return SUCCESS;
});
is( $dw->walk($perl_path), 42 );
$dw = new File::DirWalk();
$dw->onDirEnter(sub {
my ($path) = @_;
ok(-e $path);
ok(-d $path);
my ($path) = @_;
ok(-e $path);
ok(-d $path);
if ($dw->currentDir() eq $perl_path) {
return 42;
}
if ($dw->currentDir() eq $perl_path) {
return 42;
}
return SUCCESS;
return SUCCESS;
});
is( $dw->walk($perl_path), 42 );
$dw = new File::DirWalk();
$dw->onFile(sub {
my ($path) = @_;
ok(-e $path);
ok(-f $path);
my ($path) = @_;
ok(-e $path);
ok(-f $path);
if ($dw->currentBasename() eq $perl_interpreter) {
return 42;
}
if ($dw->currentBasename() eq $perl_interpreter) {
return 42;
}
return SUCCESS;
return SUCCESS;
});
is( $dw->walk($perl_path), 42 );

137
t/4.t
View File

@@ -13,75 +13,108 @@ 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" );
ok( -e "t/tree/$subdir" );
ok( -d "t/tree/$subdir" );
$dw = new File::DirWalk();
$dw->onBeginWalk(sub {
my ($path) = @_;
ok(-e $path);
$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) {
return 42;
}
if (($dw->currentBasename() eq $subdir) and ($basename eq $subdir)) {
return 42;
}
return SUCCESS;
});
is( $dw->walk("t/tree"), 42 );
return SUCCESS;
});
is( $dw->walk("t/tree"), 42 );
$dw = new File::DirWalk();
$dw->onDirEnter(sub {
my ($path) = @_;
ok(-e $path);
ok(-d $path);
$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) {
is( $dw->count(), 10 );
is( $dw->currentDepth(), 2 );
return 42;
}
if (($dw->currentBasename() eq $subdir) and ($basename eq $subdir)) {
is( $dw->currentDepth(), 2 );
is( @{$dw->entryList()}, 10);
is( $dw->count(), 10 );
return SUCCESS;
});
is( $dw->walk("t/tree"), 42 );
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);
}
$dw = new File::DirWalk();
$dw->onDirLeave(sub {
my ($path) = @_;
ok(-e $path);
ok(-d $path);
return 42;
}
if ($dw->currentBasename() eq $subdir) {
is( $dw->count(), 10 );
is( $dw->currentDepth(), 2 );
return 42;
}
return SUCCESS;
});
is( $dw->walk("t/tree"), 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();
$dw->onFile(sub {
my ($path) = @_;
ok(-e $path);
ok(-f $path);
return SUCCESS;
});
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);
}
is( $dw->walk("t/tree/$subdir"), SUCCESS );
is( $dw->count(), 10 );
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) = @_;
ok(-e $path);
ok(-f $path);
++$files;
return SUCCESS;
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 );