Permalink
Browse files

implement optional recursive iterator

Defaults to not following symlinks.  When links are followed, there
is no loop protection.

Removed benchmarking section since it could be confusing now that
Path::Tiny has its own tiny, recursive iterator.
  • Loading branch information...
1 parent ea17a3a commit 5c2c2c31c0e42f57c676910eec2313115c079a68 @xdg xdg committed Mar 24, 2013
Showing with 160 additions and 26 deletions.
  1. +4 −0 Changes
  2. +40 −26 lib/Path/Tiny.pm
  3. +116 −0 t/recurse.t
View
@@ -2,6 +2,10 @@ Revision history for Path-Tiny
{{$NEXT}}
+ [ADDED]
+
+ - The iterator now has an optional recursive mode
+
0.015 2013-03-13 13:20:38 America/New_York
[CHANGED]
View
@@ -436,29 +436,50 @@ sub is_relative { substr( $_[0]->dirname, 0, 1 ) ne '/' }
=method iterator
+ $iter = path("/tmp")->iterator( \%options );
+
+Returns a code reference that walks a directory lazily. Each invocation
+returns a C<Path::Tiny> object or undef when the iterator is exhausted.
+
$iter = path("/tmp")->iterator;
while ( $path = $iter->() ) {
...
}
-Returns a code reference that walks a directory lazily. Each invocation
-returns a C<Path::Tiny> object or undef when the iterator is exhausted.
+The current and parent directory entries ("." and "..") will not
+be included.
-This iterator is B<not> recursive. For recursive iteration, use
-L<Path::Iterator::Rule> instead.
+If the C<recurse> option is true, the iterator will walk the directory
+recursively, breadth-first. If the C<follow_symlinks> option is also true,
+directory links will be recursed. There is no protection against loops when
+following links.
+
+For a more powerful, recursive iterator with built-in loop avoidance, see
+L<Path::Iterator::Rule>.
=cut
sub iterator {
- my ($self) = @_;
- opendir( my $dh, $self->[PATH] );
+ my ( $self, $args ) = @_;
+ my @dirs = $self;
+ my $current;
return sub {
- return unless $dh;
my $next;
- while ( defined( $next = readdir $dh ) ) {
- return $self->child($next) if $next ne '.' && $next ne '..';
+ while (@dirs) {
+ if ( ref $dirs[0] eq 'Path::Tiny' ) {
+ $current = $dirs[0];
+ opendir( my $dh, $current->[PATH] );
+ $dirs[0] = $dh;
+ }
+ while ( defined( $next = readdir $dirs[0] ) ) {
+ next if $next eq '.' || $next eq '..';
+ my $path = $current->child($next);
+ push @dirs, $path
+ if $args->{recurse} && -d $path && !( !$args->{follow_symlinks} && -l $path );
+ return $path;
+ }
+ shift @dirs;
}
- undef $dh;
return;
};
}
@@ -1082,28 +1103,21 @@ L<MooseX::Types::Path::Tiny>.
=head1 SEE ALSO
-=for :list
+These are other file/path utilities, which may offer a different feature
+set than C<Path::Tiny>.
+
* L<File::Fu>
* L<IO::All>
* L<Path::Class>
-Probably others. Let me know if you want me to add a module to the list.
-
-=head1 BENCHMARKING
-
-I benchmarked a naive file-finding task: finding all C<*.pm> files in C<@INC>.
-I tested L<Path::Iterator::Rule> and different subclasses of it that do file
-manipulations using file path helpers L<Path::Class>, L<IO::All>, L<File::Fu>
-and C<Path::Tiny>.
+These iterators may be slightly faster than the recursive iterator in
+C<Path::Tiny>:
- Path::Iterator::Rule 0.474s (no objects)
- Path::Tiny::Rule 0.938s (not on CPAN)
- IO::All::Rule 1.355s
- File::Fu::Rule 1.437s (not on CPAN)
- Path::Class::Rule 4.673s
+* L<Path::Iterator::Rule>
+* L<File::Next>
-This benchmark heavily stressed object creation and determination of
-a file's basename.
+There are probably comparable, non-Tiny tools. Let me know if you want me to
+add a module to the list.
=cut
View
@@ -0,0 +1,116 @@
+use 5.006;
+use strict;
+use warnings;
+use Test::More 0.92;
+use File::Temp;
+use Test::Deep qw/cmp_deeply/;
+use File::pushd qw/tempd/;
+use Config;
+
+use Path::Tiny;
+
+#--------------------------------------------------------------------------#
+
+subtest 'no symlinks' => sub {
+ my $wd = tempd;
+
+ my @tree = qw(
+ aaaa.txt
+ bbbb.txt
+ cccc/dddd.txt
+ cccc/eeee/ffff.txt
+ gggg.txt
+ );
+
+ my @breadth = qw(
+ aaaa.txt
+ bbbb.txt
+ cccc
+ gggg.txt
+ cccc/dddd.txt
+ cccc/eeee
+ cccc/eeee/ffff.txt
+ );
+
+ path($_)->touchpath for @tree;
+
+ my $iter = path(".")->iterator( { recurse => 1 } );
+
+ my @files;
+ while ( my $f = $iter->() ) {
+ push @files, "$f";
+ }
+
+ cmp_deeply( [sort @files], [sort @breadth], "Breadth first iteration" )
+ or diag explain \@files;
+
+};
+
+subtest 'with symlinks' => sub {
+ plan skip_all => "No symlink support"
+ unless $Config{d_symlink};
+
+ my $wd = tempd;
+
+ my @tree = qw(
+ aaaa.txt
+ bbbb.txt
+ cccc/dddd.txt
+ cccc/eeee/ffff.txt
+ gggg.txt
+ );
+
+ my @follow = qw(
+ aaaa.txt
+ bbbb.txt
+ cccc
+ gggg.txt
+ pppp
+ qqqq.txt
+ cccc/dddd.txt
+ cccc/eeee
+ cccc/eeee/ffff.txt
+ pppp/ffff.txt
+ );
+
+ my @nofollow = qw(
+ aaaa.txt
+ bbbb.txt
+ cccc
+ gggg.txt
+ pppp
+ qqqq.txt
+ cccc/dddd.txt
+ cccc/eeee
+ cccc/eeee/ffff.txt
+ );
+
+ path($_)->touchpath for @tree;
+
+ symlink path( 'cccc', 'eeee' ), path('pppp');
+ symlink path('aaaa.txt'), path('qqqq.txt');
+
+ subtest 'no follow' => sub {
+ # no-follow
+ my $iter = path(".")->iterator( { recurse => 1 } );
+ my @files;
+ while ( my $f = $iter->() ) {
+ push @files, "$f";
+ }
+ cmp_deeply( [sort @files], [sort @nofollow], "Don't follow symlinks" )
+ or diag explain \@files;
+ };
+
+ subtest 'follow' => sub {
+ my $iter = path(".")->iterator( { recurse => 1, follow_symlinks => 1 } );
+ my @files;
+ while ( my $f = $iter->() ) {
+ push @files, "$f";
+ }
+ cmp_deeply( [sort @files], [sort @follow], "Follow symlinks" )
+ or diag explain \@files;
+ };
+};
+
+done_testing;
+# COPYRIGHT

0 comments on commit 5c2c2c3

Please sign in to comment.