File Coverage

blib/lib/Directory/Scanner/StreamBuilder/Matching.pm
Criterion Covered Total %
statement 45 47 95.7
branch 7 10 70.0
condition 2 5 40.0
subroutine 15 16 93.7
pod 1 7 14.2
total 70 85 82.3


line stmt bran cond sub pod time code
1             package Directory::Scanner::StreamBuilder::Matching;
2             # ABSTRACT: Filtered streaming directory iterator
3              
4 8     8   50 use strict;
  8         17  
  8         247  
5 8     8   40 use warnings;
  8         17  
  8         185  
6              
7 8     8   36 use Carp ();
  8         15  
  8         98  
8 8     8   30 use Scalar::Util ();
  8         16  
  8         121  
9              
10 8     8   35 use UNIVERSAL::Object;
  8         14  
  8         141  
11 8     8   35 use Directory::Scanner::API::Stream;
  8         19  
  8         363  
12              
13             our $VERSION = '0.01';
14             our $AUTHORITY = 'cpan:STEVAN';
15              
16 8   50 8   41 use constant DEBUG => $ENV{DIR_SCANNER_STREAM_MATCHING_DEBUG} // 0;
  8         12  
  8         612  
17              
18             ## ...
19              
20 8     8   552 our @ISA; BEGIN { @ISA = ('UNIVERSAL::Object', 'Directory::Scanner::API::Stream') }
21             our %HAS; BEGIN {
22             %HAS = (
23             stream => sub {},
24             predicate => sub {},
25             )
26 8     8   2289 }
27              
28             ## ...
29              
30             sub BUILD {
31 6     6 1 374 my $self = $_[0];
32 6         28 my $stream = $self->{stream};
33 6         10 my $predicate = $self->{predicate};
34              
35 6 50 33     59 (Scalar::Util::blessed($stream) && $stream->DOES('Directory::Scanner::API::Stream'))
36             || Carp::confess 'You must supply a directory stream';
37              
38 6 50       23 (defined $predicate)
39             || Carp::confess 'You must supply a predicate';
40              
41 6 50       22 (ref $predicate eq 'CODE')
42             || Carp::confess 'The predicate supplied must be a CODE reference';
43             }
44              
45             sub clone {
46 0     0 0 0 my ($self, $dir) = @_;
47             return $self->new(
48             stream => $self->{stream}->clone( $dir ),
49             predicate => $self->{predicate}
50 0         0 );
51             }
52              
53             ## delegate
54              
55 17     17 0 947 sub head { $_[0]->{stream}->head }
56 24     24 0 3516 sub is_done { $_[0]->{stream}->is_done }
57 18     18 0 796 sub is_closed { $_[0]->{stream}->is_closed }
58 6     6 0 152 sub close { $_[0]->{stream}->close }
59              
60             sub next {
61 34     34 0 2276 my $self = $_[0];
62              
63 34         55 my $next;
64 34         57 while (1) {
65 60         399 undef $next; # clear any previous values, just cause ...
66 60         86 $self->_log('Entering loop ... ') if DEBUG;
67              
68 60         171 $next = $self->{stream}->next;
69              
70             # this means the stream is likely
71             # exhausted, so jump out of the loop
72 60 100       144 last unless defined $next;
73              
74             # now try to predicate the value
75             # and redo the loop if it does
76             # not pass
77 54         96 local $_ = $next;
78 54 100       139 next unless $self->{predicate}->( $next );
79              
80 28         339 $self->_log('Exiting loop ... ') if DEBUG;
81              
82             # if we have gotten to this
83             # point, we have a value and
84             # want to return it
85 28         52 last;
86             }
87              
88 34         88 return $next;
89             }
90              
91             1;
92              
93             __END__