File Coverage

blib/lib/Data/Stream/Bulk/Path/Class.pm
Criterion Covered Total %
statement 2 4 50.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 4 6 66.6


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