| Subject: | Add new function to find dirs instead of files |
Hello,
the new fuction dirs use a similar interface for dirs. I found it very hard to work on dirs with the
files function. And even harder, if the directory is empty. I also add a test for the new function.
please consider to apply the function.
--
Boris
| Subject: | fn_add_dirs.patch |
diff -Nur b/Next.pm c/Next.pm
--- b/Next.pm 2006-10-12 16:24:35.000000000 +0200
+++ c/Next.pm 2006-11-05 22:57:54.000000000 +0100
@@ -66,6 +66,17 @@
The file_filter function takes no arguments but rather does its work through
a collection of variables.
+=head2 dir_filter -> \&dir_filter
+
+The dir_filter lets you check to see if it's really a dir you
+want to get back. If the dir_filter returns a true value, the
+dir will be returned; if false, it will be skipped.
+
+The dir_filter function takes no arguments but rather does its work through
+a collection of variables.
+
+dir_filter is only valid for the dirs functions
+
=over 4
=item * C<$_> is the current filename within that directory
@@ -241,6 +252,119 @@
return @newfiles;
}
+
+=for private _candidate_dirs( $parms, $dir )
+
+Pulls out the dirs that might be worth looking into in I<$dir>.
+If I<$dir> is the empty string, then search the current directory.
+This is different than explicitly passing in a ".", because that
+will get prepended to the path names.
+
+I<$parms> is the hashref of parms passed into File::Next constructor.
+
+=cut
+
+sub _candidate_dirs {
+ my $parms = shift;
+ my $dir = shift;
+
+ my $dh;
+ if ( !opendir $dh, $dir ) {
+ $parms->{error_handler}->("$dir: $!");
+ return;
+ }
+
+ my @newdirs;
+ my $up = File::Spec->updir;
+ my $cur = File::Spec->curdir;
+ while ( my $file = readdir $dh ) {
+ next if ( $file eq $up ) || ( $file eq $cur );
+
+ local $File::Next::dir = File::Spec->catdir( $dir, $file );
+ if ( -d $File::Next::dir ) {
+ local $_ = $file;
+ next unless $parms->{descend_filter}->();
+ push( @newdirs, [ $dir, $file ] );
+ }
+ }
+
+ return @newdirs;
+}
+my %dirs_defaults = (
+ dir_filter => sub { 1 },
+ descend_filter => sub { 1 },
+ error_handler => sub { CORE::die @_ },
+ );
+
+=head2 dirs( { \%parameters }, @starting points )
+
+Returns an iterator that walks directories starting with the items
+in I<@starting_points>.
+
+All file-finding in this module is adapted from Mark Jason Dominus'
+marvelous I<Higher Order Perl>, page 126.
+
+=cut
+
+sub dirs {
+ my $passed_parms =
+ ref $_[0] eq 'HASH' ? { %{ +shift } } : {}; # copy parm hash
+ my %passed_parms = %{$passed_parms};
+
+ my $parms = {};
+ for my $key ( keys %dirs_defaults ) {
+ $parms->{$key} = delete( $passed_parms{$key} ) || $dirs_defaults{$key};
+ }
+
+ # Any leftover keys are bogus
+ for my $badkey ( keys %passed_parms ) {
+ $parms->{error_handler}->("Invalid parameter passed to files(): $badkey");
+ }
+
+ my @queue;
+ for (@_) {
+ my $start = _reslash($_);
+ if ( -d $start ) {
+ push @queue, [ $start, undef ];
+ }
+ else {
+ push @queue, [ undef, $start ];
+ }
+ }
+ return sub {
+ while (@queue) {
+ my ( $dir, $file ) = @{ shift @queue };
+
+ my $fullpath =
+ defined $dir
+ ? defined $file
+ ? File::Spec->catfile( $dir, $file )
+ : $dir
+ : $file;
+
+ if ( -d $fullpath ) {
+ push( @queue, _candidate_dirs( $parms, $fullpath ) );
+
+ local $_ = $file
+ || do { ( File::Spec->splitpath($fullpath) )[2] || '' };
+ local $File::Next::dir = $fullpath;
+ local $File::Next::name = $fullpath;
+ if ( $parms->{dir_filter}->() ) {
+ if (wantarray) {
+ return ( $fullpath, $file );
+ }
+ else {
+ return $fullpath;
+ }
+ }
+ }
+ } # while
+
+ return;
+ }; # iterator
+}
+
+
=head1 AUTHOR
Andy Lester, C<< <andy at petdance.com> >>
diff -Nur b/t/basic.t c/t/basic.t
--- b/t/basic.t 2006-09-06 06:47:57.000000000 +0200
+++ c/t/basic.t 2006-11-05 22:43:05.000000000 +0100
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 11;
+use Test::More tests => 15;
BEGIN {
use_ok( 'File::Next' );
@@ -21,6 +21,16 @@
);
_sets_match( \@expected, \@actual, 'JUST_A_FILE' );
}
+JUST_A_DIR: {
+ my $iter = File::Next::dirs( 't/swamp/a' );
+ isa_ok( $iter, 'CODE' );
+
+ my @actual = slurp( $iter );
+ my @expected = qw(
+ t/swamp/a
+ );
+ _sets_match( \@expected, \@actual, 'JUST_A_DIR' );
+}
NO_PARMS: {
my $iter = File::Next::files( 't/swamp' );
@@ -52,6 +62,23 @@
_sets_match( \@expected, \@actual, 'NO_PARMS' );
}
+NO_PARMS_DIRS: {
+ my $iter = File::Next::dirs( 't/swamp' );
+ isa_ok( $iter, 'CODE' );
+
+ my @actual = slurp( $iter );
+
+ my @expected = qw(
+ t/swamp
+ t/swamp/a
+ t/swamp/b
+ t/swamp/c
+ );
+
+ @actual = grep { !/\.svn/ } @actual; # If I'm building this in my Subversion dir
+ _sets_match( \@expected, \@actual, 'NO_PARMS_DIRS' );
+}
+
MULTIPLE_STARTS: {
my $iter = File::Next::files( 't/swamp/a', 't/swamp/b', 't/swamp/c' );
isa_ok( $iter, 'CODE' );