Initial commit.

DirWalk.pm

@@ -0,0 +1,349 @@
+# Copyright (c) 2005-2006 Jens Luedicke <jensl@cpan.org>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package File::DirWalk;
+use base qw(Exporter);
+
+our $VERSION = '0.4';
+our @EXPORT = qw(FAILED SUCCESS ABORTED PRUNE);
+
+use warnings;
+use strict;
+
+use File::Basename;
+use File::Spec;
+
+use constant SUCCESS 	=> 1;
+use constant FAILED 	=> 0;
+use constant ABORTED 	=> -1;
+use constant PRUNE 	=> -10;
+
+sub new {
+	my ($class) = @_;
+	my $self = bless {}, $class;
+
+	$self->{onBeginWalk} = sub { SUCCESS };
+	$self->{onLink}      = sub { SUCCESS };
+	$self->{onFile}      = sub { SUCCESS };
+	$self->{onDirEnter}  = sub { SUCCESS };
+	$self->{onDirLeave}  = sub { SUCCESS };
+
+	$self->{depth}       = 0;
+	$self->{depth_count} = 0;
+
+	$self->{filesInDir}  = 0;
+
+# 	$self->{customResponse} = {};
+
+	return $self;
+}
+
+sub onBeginWalk {
+	my ($self,$func) = @_;
+	$self->{onBeginWalk} = $func;
+}
+
+sub onLink {
+	my ($self,$func) = @_;
+	$self->{onLink} = $func;
+}
+
+sub onFile {
+	my ($self,$func) = @_;
+	$self->{onFile} = $func;
+}
+
+sub onDirEnter {
+	my ($self,$func) = @_;
+	$self->{onDirEnter} = $func;
+}
+
+sub onDirLeave {
+	my ($self,$func) = @_;
+	$self->{onDirLeave} = $func;
+}
+
+sub setDepth {
+	my ($self,$v) = @_;
+	$self->{depth} = $v;
+}
+
+sub getDepth {
+	my ($self) = @_;
+	return $self->{depth_count};
+}
+
+sub currentDir {
+	my ($self) = @_;
+	return $self->{currentDir};
+}
+
+sub currentPath {
+	my ($self) = @_;
+	return $self->{currentPath};
+}
+
+sub currentBasename {
+	my ($self) = @_;
+	return $self->{currentBasename};
+}
+
+sub filesInDir {
+	my ($self) = @_;
+	return $self->{filesInDir};
+}
+
+sub walk {
+	my ($self,$path) = @_;
+
+	$self->{currentDir}      = dirname($path);
+	$self->{currentBasename} = basename($path);
+	$self->{currentPath}     = $path;
+
+	if ((my $r = $self->{onBeginWalk}->($path)) != SUCCESS) {
+		return $r;
+	}
+
+	if (-l $path) {
+
+		if ((my $r = $self->{onLink}->($path)) != SUCCESS) {
+			return $r;
+		}
+
+	} elsif (-d $path) {
+
+		if ($self->{depth} != 0) {
+			if ($self->{depth_count} == $self->{depth}) {
+				return SUCCESS;
+			}
+		}
+
+		opendir my $dirh, $path || return FAILED;
+		my @dir_contents = readdir $dirh;
+		@dir_contents    = File::Spec->no_upwards(@dir_contents);
+
+		$self->{filesInDir} = scalar @dir_contents;
+
+		if ((my $r = $self->{onDirEnter}->($path)) != SUCCESS) {
+			return $r;
+		}
+		++$self->{depth_count};
+
+		# be portable.
+		my @dirs = File::Spec->splitdir($path);
+
+		foreach my $f (@dir_contents) {
+			# be portable.
+			my $path = File::Spec->catfile(@dirs, $f);
+
+			my $r = $self->walk($path);
+
+			if ($r == PRUNE) {
+				next;
+			} elsif ($r != SUCCESS) {
+				return $r;
+			}
+		}
+
+		closedir $dirh;
+
+		if ((my $r = $self->{onDirLeave}->($path)) != SUCCESS) {
+			return $r;
+		}
+		--$self->{depth_count};
+	} else {
+		if ((my $r = $self->{onFile}->($path)) != SUCCESS) {
+			return $r;
+		}
+	}
+
+	return SUCCESS;
+}
+
+1;
+
+=head1 NAME
+
+File::DirWalk - walk through a directory tree and run callbacks
+on files, symlinks and directories.
+
+=head1 SYNOPSIS
+
+    use File::DirWalk;
+
+    my $dw = File::DirWalk->new;
+
+Walk through your homedir and print out all filenames:
+
+    $dw->onFile(sub {
+        my ($file) = @_;
+        print "$file\n";
+
+        return SUCCESS;
+    });
+
+    $dw->walk($ENV{'HOME'});
+
+Walk through your homedir and print out all directories:
+
+    $dw->onDirEnter(sub {
+        my ($path) = @_;
+        print "$path\n";
+
+        return SUCCESS;
+    });
+
+    $dw->walk($ENV{'HOME'});
+
+Walk through your homedir and print out all directories
+with depth 3:
+
+    $dw->onDirEnter(sub {
+        my ($path) = @_;
+        print "$path\n";
+
+        return SUCCESS;
+    });
+
+    $dw->setDepth(3);
+    $dw->walk($ENV{'HOME'});
+
+=head1 DESCRIPTION
+
+This module can be used to walk through a directory tree and run own functions
+on files, directories and symlinks.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Create a new File::DirWalk object.
+The constructor takes no arguments.
+
+=item onBeginWalk(\&func)
+
+Specify a function to be be run on beginning of a walk.
+
+=item onLink(\&func)
+
+Specify a function to be run on symlinks.
+
+=item onFile(\&func)
+
+Specify a function to be run on regular files.
+
+=item onDirEnter(\&func)
+
+Specify a function to be run before entering a directory.
+
+=item onDirLeave(\&func)
+
+Specify a function to be run when leaving a directory.
+
+=item setDepth($int)
+
+Set the directory traversal depth.
+Default: 0
+
+=item getDepth
+
+Get the directory traversal depth;
+
+=item currentDir
+
+The directory we are in:
+
+    $dw->onBeginWalk(sub {
+        my ($path) = @_;
+
+        print "directory: " . $dir,            "\n";
+        print "directory: " . $dw->currentDir, "\n"; # same!
+
+        return SUCCESS;
+    });
+
+=item currentPath
+
+The current path:
+
+    $dw->onBeginWalk(sub {
+        my ($path) = @_;
+
+        print "directory: " . $path,            "\n";
+        print "directory: " . $dw->currentPath, "\n"; # same!
+
+        return SUCCESS;
+    });
+
+=item currentBasename
+
+=item filesInDir
+
+Returns the number of files in directory.
+Excludes . and ..
+
+=item walk($path)
+
+Begin the walk through the given directory tree. This method returns if the walk
+is finished or if one of the callbacks doesn't return SUCCESS.
+
+=back
+
+=head1 CALLBACKS
+
+All callback-methods expect a function reference as their argument. 
+The current path is passed to the callback function.
+
+The callback function must return SUCCESS, otherwise the recursive walk is aborted and
+C<walk> returns. You don't need to define a callback if you don't need to.
+
+=head1 CONSTANTS
+
+File::DirWalk exports the following predefined constants
+as return values:
+
+=over 4
+
+=item SUCCESS (1)
+
+=item FAILED  (0)
+
+=item ABORTED (-1)
+
+=item PRUNE   (-10)
+
+=back
+
+=head1 BUGS
+
+Please mail the author if you encounter any bugs.
+
+=head1 AUTHOR
+
+Jens Luedicke E<lt>jensl@cpan.orgE<gt> web: L<http://perldude.de/>
+
+=head1 CHANGES
+
+Version 0.4: add more methods, better testing, more documentation.
+
+Version 0.3: add PRUNE constant. add option to specify the directory depth.
+
+Version 0.2: platform portability fixes and more documentation
+
+Version 0.1: first CPAN release
+
+=head1 HISTORY
+
+I wrote DirWalk.pm module for use within my 'Filer' file manager as a directory
+traversing backend and I thought it might be useful for others. It is my first
+CPAN module.
+
+=head1 COPYRIGHT AND LICENCE
+
+Copyright (c) 2005-2006 Jens Luedicke. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms as Perl
+itself.
+

MANIFEST

@@ -0,0 +1,7 @@
+DirWalk.pm
+MANIFEST
+META.yml
+Makefile.PL
+README
+configure
+t/1.t

Makefile.PL

@@ -0,0 +1,14 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+	'NAME'		=> 'File::DirWalk',
+	'VERSION_FROM'	=> 'DirWalk.pm',
+	'PREREQ_PM'	=> {
+		'File::Basename' => 0,
+		'File::Spec' => 0,
+	}, 
+	($] >= 5.005
+		? (AUTHOR     => 'Jens Luedicke <jensl@cpan.org>') 
+		: ()
+	),
+);

README

@@ -0,0 +1,31 @@
+File-DirWalk version 0.2
+=========================
+
+File::DirWalk is a Perl module to walk through a directory tree
+and run own functions on directories, files and symlinks. 
+
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+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 :
+
+  File::Basename
+  File::Spec
+
+COPYRIGHT AND LICENCE
+
+Copyright (c) 2005 Jens Luedicke <jensl@cpan.org>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+

configure

@@ -0,0 +1,2 @@
+#!/bin/sh
+exec perl ./Makefile.PL "$@"

t/1.t

@@ -0,0 +1,87 @@
+use Test::Simple tests => 6;
+
+use File::Basename;
+use File::DirWalk;
+
+my $perl_path        = dirname($^X);
+my $perl_interpreter = basename($^X);
+
+ok( ref(File::DirWalk->new) eq 'File::DirWalk' ); # 1
+
+$dw = new File::DirWalk;
+
+$dw->onDirEnter(sub {
+	my ($path) = @_;
+
+	if ($path eq $perl_path) {
+		return FAILED;
+	}
+		
+	return SUCCESS;
+});
+
+ok( $dw->walk($perl_path) == FAILED ); # 2
+
+$dw->onBeginWalk(sub {
+	my ($path) = @_;
+	if (dirname($path) eq $dw->currentDir) {
+		return ABORTED;
+	}
+
+	return SUCCESS;
+});
+
+ok( $dw->walk($perl_path) == ABORTED ); # 3
+
+$dw->onBeginWalk(sub {
+	my ($path) = @_;
+	if ($path eq $dw->currentPath) {
+		return ABORTED;
+	}
+
+	return SUCCESS;
+});
+
+ok( $dw->walk($perl_path) == ABORTED ); # 4
+
+$dw->onFile(sub {
+	my ($path) = @_;
+
+	if (basename($path) eq $perl_interpreter) {
+		return ABORTED;
+	}
+
+	return SUCCESS;
+});
+
+ok( $dw->walk($perl_path) == ABORTED ); # 5
+
+$dw->onFile(sub {
+	my ($path) = @_;
+	
+	if (basename($path) eq "1.t") {
+		return ABORTED;
+	}
+
+	return SUCCESS;
+});
+
+ok( $dw->walk($0) == ABORTED ); # 6
+
+# $dw->setCustomResponse('FOOBAR', -20);
+# ok( $dw->getCustomResponse('FOOBAR') == -20); # 7
+# 
+# $dw->onBeginWalk(sub {
+# 	my ($path) = @_;
+# 
+# 	if ($path eq $ENV{'HOME'}) {
+# 		return $dw->getCustomResponse('FOOBAR');
+# 	}
+# 
+# 	return FAILED;	
+# });
+# 
+# ok( $dw->walk($ENV{'HOME'}) == $dw->getCustomResponse('FOOBAR') ); # 8
+# 
+# $dw->setCustomResponse('WOMBAT', -42);
+# ok( $dw->getCustomResponse('FOOBAR') != $dw->getCustomResponse('WOMBAT') ); # 9