M: Changed tabs to spaces.
This commit is contained in:
Jens Luedicke
@@ -21,183 +21,183 @@ use Carp;
|
|||||||
use File::Basename;
|
use File::Basename;
|
||||||
use File::Spec::Functions qw(no_upwards splitdir catfile);
|
use File::Spec::Functions qw(no_upwards splitdir catfile);
|
||||||
|
|
||||||
use constant SUCCESS => 1;
|
use constant SUCCESS => 1;
|
||||||
use constant FAILED => 0;
|
use constant FAILED => 0;
|
||||||
use constant ABORTED => -1;
|
use constant ABORTED => -1;
|
||||||
use constant PRUNE => -10;
|
use constant PRUNE => -10;
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my ($class) = @_;
|
my ($class) = @_;
|
||||||
my $self = bless {}, $class;
|
my $self = bless {}, $class;
|
||||||
|
|
||||||
$self->{onBeginWalk} = sub { SUCCESS };
|
$self->{onBeginWalk} = sub { SUCCESS };
|
||||||
$self->{onLink} = sub { SUCCESS };
|
$self->{onLink} = sub { SUCCESS };
|
||||||
$self->{onFile} = sub { SUCCESS };
|
$self->{onFile} = sub { SUCCESS };
|
||||||
$self->{onDirEnter} = sub { SUCCESS };
|
$self->{onDirEnter} = sub { SUCCESS };
|
||||||
$self->{onDirLeave} = sub { SUCCESS };
|
$self->{onDirLeave} = sub { SUCCESS };
|
||||||
|
|
||||||
$self->{depth} = 0;
|
$self->{depth} = 0;
|
||||||
$self->{currentDepth} = 0;
|
$self->{currentDepth} = 0;
|
||||||
|
|
||||||
$self->{entryList} = [];
|
$self->{entryList} = [];
|
||||||
$self->{count} = 0;
|
$self->{count} = 0;
|
||||||
|
|
||||||
return $self;
|
return $self;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub setHandler {
|
sub setHandler {
|
||||||
my ($self,$action,$func) = @_;
|
my ($self,$action,$func) = @_;
|
||||||
|
|
||||||
if ($action !~ /onBeginWalk|onLink|onFile|onDirEnter|onDirLeave/) {
|
if ($action !~ /onBeginWalk|onLink|onFile|onDirEnter|onDirLeave/) {
|
||||||
croak("Invalid action argument: $action");
|
croak("Invalid action argument: $action");
|
||||||
}
|
}
|
||||||
|
|
||||||
if (ref($func) ne 'CODE') {
|
if (ref($func) ne 'CODE') {
|
||||||
croak("Second argument must be CODE reference.");
|
croak("Second argument must be CODE reference.");
|
||||||
}
|
}
|
||||||
|
|
||||||
$self->{$action} = $func;
|
$self->{$action} = $func;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub onBeginWalk {
|
sub onBeginWalk {
|
||||||
my ($self,$func) = @_;
|
my ($self,$func) = @_;
|
||||||
$self->setHandler(onBeginWalk => $func);
|
$self->setHandler(onBeginWalk => $func);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub onLink {
|
sub onLink {
|
||||||
my ($self,$func) = @_;
|
my ($self,$func) = @_;
|
||||||
$self->setHandler(onLink => $func);
|
$self->setHandler(onLink => $func);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub onFile {
|
sub onFile {
|
||||||
my ($self,$func) = @_;
|
my ($self,$func) = @_;
|
||||||
$self->setHandler(onFile => $func);
|
$self->setHandler(onFile => $func);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub onDirEnter {
|
sub onDirEnter {
|
||||||
my ($self,$func) = @_;
|
my ($self,$func) = @_;
|
||||||
$self->setHandler(onDirEnter => $func);
|
$self->setHandler(onDirEnter => $func);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub onDirLeave {
|
sub onDirLeave {
|
||||||
my ($self,$func) = @_;
|
my ($self,$func) = @_;
|
||||||
$self->setHandler(onDirLeave => $func);
|
$self->setHandler(onDirLeave => $func);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub setDepth {
|
sub setDepth {
|
||||||
my ($self,$v) = @_;
|
my ($self,$v) = @_;
|
||||||
if ($v < 0) {
|
if ($v < 0) {
|
||||||
croak("Directory depth is negative: $v");
|
croak("Directory depth is negative: $v");
|
||||||
}
|
}
|
||||||
|
|
||||||
$self->{depth} = $v;
|
$self->{depth} = $v;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub getDepth {
|
sub getDepth {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
return $self->{depth};
|
return $self->{depth};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub currentDepth {
|
sub currentDepth {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
return $self->{currentDepth};
|
return $self->{currentDepth};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub currentDir {
|
sub currentDir {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
return $self->{currentDir};
|
return $self->{currentDir};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub currentPath {
|
sub currentPath {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
return $self->{currentPath};
|
return $self->{currentPath};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub currentBasename {
|
sub currentBasename {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
return $self->{currentBasename};
|
return $self->{currentBasename};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub count {
|
sub count {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
return $self->{count};
|
return $self->{count};
|
||||||
}
|
}
|
||||||
|
|
||||||
sub entryList {
|
sub entryList {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
return $self->{entryList};
|
return $self->{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;
|
||||||
|
|
||||||
$self->{currentDir} = $currentDir;
|
$self->{currentDir} = $currentDir;
|
||||||
$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)) != SUCCESS) {
|
||||||
return $r;
|
return $r;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (-l $path) {
|
if (-l $path) {
|
||||||
|
|
||||||
if ((my $r = $self->{onLink}->($path)) != SUCCESS) {
|
if ((my $r = $self->{onLink}->($path)) != SUCCESS) {
|
||||||
return $r;
|
return $r;
|
||||||
}
|
}
|
||||||
|
|
||||||
} elsif (-d $path) {
|
} elsif (-d $path) {
|
||||||
|
|
||||||
if ($self->{depth} != 0) {
|
if ($self->{depth} != 0) {
|
||||||
if ($self->{currentDepth} == $self->{depth}) {
|
if ($self->{currentDepth} == $self->{depth}) {
|
||||||
return SUCCESS;
|
return SUCCESS;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
opendir (my $dirh, $path) || return FAILED;
|
opendir (my $dirh, $path) || return FAILED;
|
||||||
$self->{entryList} = [ no_upwards(readdir $dirh) ];
|
$self->{entryList} = [ no_upwards(readdir $dirh) ];
|
||||||
$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)) != SUCCESS) {
|
||||||
return $r;
|
return $r;
|
||||||
}
|
}
|
||||||
|
|
||||||
# be portable.
|
# be portable.
|
||||||
my @dirs = splitdir($path);
|
my @dirs = splitdir($path);
|
||||||
foreach my $f (@{$self->{entryList}}) {
|
foreach my $f (@{$self->{entryList}}) {
|
||||||
# be portable.
|
# be portable.
|
||||||
my $path = catfile(@dirs, $f);
|
my $path = catfile(@dirs, $f);
|
||||||
|
|
||||||
my $r = $self->walk($path);
|
my $r = $self->walk($path);
|
||||||
|
|
||||||
if ($r == PRUNE) {
|
if ($r == PRUNE) {
|
||||||
next;
|
next;
|
||||||
} elsif ($r != SUCCESS) {
|
} elsif ($r != SUCCESS) {
|
||||||
return $r;
|
return $r;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
closedir $dirh;
|
closedir $dirh;
|
||||||
|
|
||||||
$self->{currentDir} = $currentDir;
|
$self->{currentDir} = $currentDir;
|
||||||
$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)) != SUCCESS) {
|
||||||
return $r;
|
return $r;
|
||||||
}
|
}
|
||||||
--$self->{currentDepth};
|
--$self->{currentDepth};
|
||||||
} else {
|
} else {
|
||||||
if ((my $r = $self->{onFile}->($path)) != SUCCESS) {
|
if ((my $r = $self->{onFile}->($path)) != SUCCESS) {
|
||||||
return $r;
|
return $r;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return SUCCESS;
|
return SUCCESS;
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
@@ -354,15 +354,15 @@ is finished or if one of the callbacks doesn't return SUCCESS. If the callback f
|
|||||||
returns PRUNE, C<walk> will skip to the next element within the current directory
|
returns PRUNE, C<walk> will skip to the next element within the current directory
|
||||||
hierarchy. You can use PRUNE to exclude files or folders:
|
hierarchy. You can use PRUNE to exclude files or folders:
|
||||||
|
|
||||||
$dw->onBeginWalk(sub {
|
$dw->onBeginWalk(sub {
|
||||||
my ($path) = @_;
|
my ($path) = @_;
|
||||||
|
|
||||||
if ($path =~ /ignore/) {
|
if ($path =~ /ignore/) {
|
||||||
return PRUNE;
|
return PRUNE;
|
||||||
}
|
}
|
||||||
|
|
||||||
return SUCCESS;
|
return SUCCESS;
|
||||||
});
|
});
|
||||||
|
|
||||||
=back
|
=back
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user