Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
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
xdg committed Mar 26, 2013
1 parent ea17a3a commit 5c2c2c3
Show file tree
Hide file tree
Showing 3 changed files with 160 additions and 26 deletions.
4 changes: 4 additions & 0 deletions Changes
Expand Up @@ -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]
Expand Down
66 changes: 40 additions & 26 deletions lib/Path/Tiny.pm
Expand Up @@ -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;
};
}
Expand Down Expand Up @@ -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

Expand Down
116 changes: 116 additions & 0 deletions t/recurse.t
@@ -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.