Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Data::Stream::Bulk::Path::Class

  • Loading branch information...
commit 541aec90fdb2e5022d9c761def63de95ddc89ff5 1 parent 7267bd7
@nothingmuch nothingmuch authored
Showing with 255 additions and 0 deletions.
  1. +181 −0 lib/Data/Stream/Bulk/Path/Class.pm
  2. +74 −0 t/path_class.t
View
181 lib/Data/Stream/Bulk/Path/Class.pm
@@ -0,0 +1,181 @@
+#!/usr/bin/perl
+
+package Data::Stream::Bulk::Path::Class;
+use Moose;
+
+use Path::Class;
+
+use namespace::clean -except => 'meta';
+
+with qw(Data::Stream::Bulk);
+
+has dir => (
+ isa => "Path::Class::Dir",
+ is => "ro",
+ required => 1,
+);
+
+has depth_first => (
+ isa => "Bool",
+ is => "rw",
+ default => 1,
+);
+
+has only_files => (
+ isa => "Bool",
+ is => "ro",
+);
+
+has chunk_size => (
+ isa => "Int",
+ is => "rw",
+ default => 250,
+);
+
+has _stack => (
+ isa => "ArrayRef",
+ is => "ro",
+ default => sub { [] },
+);
+
+has _queue => (
+ isa => "ArrayRef",
+ is => "ro",
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ return [ $self->dir ],
+ },
+);
+
+sub is_done {
+ my $self = shift;
+ return (
+ @{ $self->_dh_queue } == 0
+ and
+ @{ $self->_queue } == 0
+ );
+}
+
+sub next {
+ my $self = shift;
+
+ my $queue = $self->_queue;
+ my $stack = $self->_stack;
+
+ my $depth_first = $self->depth_first;
+ my $only_files = $self->only_files;
+ my $chunk_size = $self->chunk_size;
+
+ my @ret;
+
+ {
+ outer: while ( @$stack ) {
+ my $frame = $stack->[-1];
+
+ my ( $dh, $parent ) = @$frame;
+
+ while ( defined(my $entry = $dh->read) ) {
+ next if $entry eq '.' || $entry eq '..';
+
+ my $path = $parent->file($entry);
+
+ if ( -d $path ) {
+ my $dir = $parent->subdir($entry);
+
+ if ( $depth_first ) {
+ unshift @$queue, $dir;
+ } else {
+ push @$queue, $dir;
+ }
+
+ last outer;
+ } else {
+ push @ret, $path;
+ return \@ret if @ret >= $chunk_size;
+ }
+ }
+
+ # we're done reading this dir
+ pop @$stack;
+ }
+
+ if ( @$queue ) {
+ my $dir = shift @$queue;
+ my $dh = $dir->open || croak("Can't open directory $dir: $!");
+
+ if ( $depth_first ) {
+ push @$stack, [ $dh, $dir ];
+ } else {
+ unshift @$stack, [ $dh, $dir ];
+ }
+
+ unless ( $only_files ) {
+ push @ret, $dir;
+ return \@ret if @ret >= $chunk_size;
+ }
+
+ redo;
+ }
+ }
+
+ return unless @ret;
+ return \@ret;
+}
+
+
+__PACKAGE__->meta->make_immutable;
+
+__PACKAGE__
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Data::Stream::Bulk::Path::Class - L<Path::Class::Dir> traversal
+
+=head1 SYNOPSIS
+
+ use Data::Stream::Bulk::Path::Class;
+
+ my $dir = Data::Stream::Bulk::Path::Class->new(
+ dir => Path::Class::Dir->new( ... ),
+ );
+
+=head1 DESCRIPTION
+
+This stream produces depth or breadth first traversal order recursion through
+L<Path::Class::Dir> objects.
+
+Items are read iteratively, and a stack of open directory handles is used to
+keep track of state.
+
+=head1 ATTRIBUTES
+
+=item chunk_size
+
+Defaults to 250.
+
+=item depth_first
+
+Chooses between depth first and breadth first traversal order.
+
+=head1 METHODS
+
+=over 4
+
+=item is_done
+
+Returns true when no more files are left to iterate.
+
+=item next
+
+Returns the next chunk of L<Path::Class> objects
+
+=back
+
+=cut
+
+
View
74 t/path_class.t
@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use ok 'Data::Stream::Bulk::Path::Class';
+
+use Path::Class;
+
+my $dist = file(__FILE__)->parent->parent;
+
+foreach my $dir ( $dist->subdir("t"), $dist->subdir("lib"), $dist ) {
+
+ {
+ my $paths = Data::Stream::Bulk::Path::Class->new(
+ dir => $dir,
+ chunk_size => 2,
+ max_queue => 3,
+ depth_first => 0,
+ );
+
+ my $strings = $paths->filter(sub {[ map { "$_" } @$_ ]});
+
+ my @rec;
+ $dir->recurse( callback => sub { push @rec, "$_[0]" }, depthfirst => 0, preorder => 1 );
+
+ my @all = $strings->all;
+
+ is_deeply(
+ [ sort @all ],
+ [ sort @rec ],
+ "breadth first traversal path set",
+ );
+
+ is_deeply(
+ \@all,
+ \@rec,
+ "breadth first traversal order",
+ ) || do {
+ warn join("\n", @all, "", "");
+ warn join("\n", @rec, "", "");
+ };
+ }
+
+ {
+ my $paths = Data::Stream::Bulk::Path::Class->new(
+ dir => $dir,
+ chunk_size => 2,
+ max_queue => 3,
+ depth_first => 1,
+ );
+
+ my $strings = $paths->filter(sub {[ map { "$_" } @$_ ]});
+
+ my @rec;
+ $dir->recurse( callback => sub { push @rec, "$_[0]" }, depthfirst => 1, preorder => 1 );
+
+ my @all = $strings->all;
+
+ is_deeply(
+ [ sort @all ],
+ [ sort @rec ],
+ "depth first traversal path set",
+ );
+
+ is_deeply(
+ \@all,
+ \@rec,
+ "depth first traversal order",
+ );
+ }
+}
Please sign in to comment.
Something went wrong with that request. Please try again.