local-lib5/lib/perl5/Data/Stream/Bulk/Path/Class.pm

   1 #!/usr/bin/perl
   2
   3 package Data::Stream::Bulk::Path::Class;
   4 use Moose;
   5
   6 use Path::Class;
   7 use Carp qw(croak);
   8
   9 use namespace::clean -except => 'meta';
  10
  11 with qw(Data::Stream::Bulk);
  12
  13 has dir => (
  14         isa => "Path::Class::Dir",
  15         is  => "ro",
  16         required => 1,
  17 );
  18
  19 has depth_first => (
  20         isa => "Bool",
  21         is  => "rw",
  22         default => 1,
  23 );
  24
  25 has only_files => (
  26         isa => "Bool",
  27         is  => "ro",
  28 );
  29
  30 has chunk_size => (
  31         isa => "Int",
  32         is  => "rw",
  33         default => 250,
  34 );
  35
  36 has _stack => (
  37         isa => "ArrayRef",
  38         is  => "ro",
  39         default => sub { [] },
  40 );
  41
  42 has _queue => (
  43         isa => "ArrayRef",
  44         is  => "ro",
  45         lazy => 1,
  46         default => sub {
  47                 my $self = shift;
  48                 return [ $self->dir ],
  49         },
  50 );
  51
  52 sub is_done {
  53         my $self = shift;
  54         return (
  55                 @{ $self->_stack } == 0
  56                         and
  57                 @{ $self->_queue } == 0
  58         );
  59 }
  60
  61 sub next {
  62         my $self = shift;
  63
  64         my $queue = $self->_queue;
  65         my $stack = $self->_stack;
  66
  67         my $depth_first = $self->depth_first;
  68         my $only_files  = $self->only_files;
  69         my $chunk_size  = $self->chunk_size;
  70
  71         my @ret;
  72
  73         {
  74                 outer: while ( @$stack ) {
  75                         my $frame = $stack->[-1];
  76
  77                         my ( $dh, $parent ) = @$frame;
  78
  79                         while ( defined(my $entry = $dh->read) ) {
  80                                 next if $entry eq '.' || $entry eq '..';
  81
  82                                 my $path = $parent->file($entry);
  83
  84                                 if ( -d $path ) {
  85                                         my $dir = $parent->subdir($entry);
  86
  87                                         if ( $depth_first ) {
  88                                                 unshift @$queue, $dir;
  89                                         } else {
  90                                                 push @$queue, $dir;
  91                                         }
  92
  93                                         last outer;
  94                                 } else {
  95                                         push @ret, $path;
  96                                         return \@ret if @ret >= $chunk_size;
  97                                 }
  98                         }
  99
 100                         # we're done reading this dir
 101                         pop @$stack;
 102                 }
 103
 104                 if ( @$queue ) {
 105                         my $dir = shift @$queue;
 106                         my $dh = $dir->open || croak("Can't open directory $dir: $!");
 107
 108                         if ( $depth_first ) {
 109                                 push @$stack, [ $dh, $dir ];
 110                         } else {
 111                                 unshift @$stack, [ $dh, $dir ];
 112                         }
 113
 114                         unless ( $only_files ) {
 115                                 push @ret, $dir;
 116                                 return \@ret if @ret >= $chunk_size;
 117                         }
 118
 119                         redo;
 120                 }
 121         }
 122
 123         return unless @ret;
 124         return \@ret;
 125 }
 126
 127
 128 __PACKAGE__->meta->make_immutable;
 129
 130 __PACKAGE__
 131
 132 __END__
 133
 134 =pod
 135
 136 =head1 NAME
 137
 138 Data::Stream::Bulk::Path::Class - L<Path::Class::Dir> traversal
 139
 140 =head1 SYNOPSIS
 141
 142         use Data::Stream::Bulk::Path::Class;
 143
 144         my $dir = Data::Stream::Bulk::Path::Class->new(
 145                 dir => Path::Class::Dir->new( ... ),
 146         );
 147
 148 =head1 DESCRIPTION
 149
 150 This stream produces depth or breadth first traversal order recursion through
 151 L<Path::Class::Dir> objects.
 152
 153 Items are read iteratively, and a stack of open directory handles is used to
 154 keep track of state.
 155
 156 =head1 ATTRIBUTES
 157
 158 =over 4
 159
 160 =item chunk_size
 161
 162 Defaults to 250.
 163
 164 =item depth_first
 165
 166 Chooses between depth first and breadth first traversal order.
 167
 168 =item only_files
 169
 170 If true only L<Path::Class::File> items will be returned in the output streams
 171 (no directories).
 172
 173 =back
 174
 175 =head1 METHODS
 176
 177 =over 4
 178
 179 =item is_done
 180
 181 Returns true when no more files are left to iterate.
 182
 183 =item next
 184
 185 Returns the next chunk of L<Path::Class> objects
 186
 187 =back
 188
 189 =cut
 190
 191