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 7 7 100.0
total 76 85 89.4


line stmt bran cond sub pod time code
1             package Directory::Scanner::StreamBuilder::Matching;
2             # ABSTRACT: Filtered streaming directory iterator
3              
4 8     8   44 use strict;
  8         17  
  8         194  
5 8     8   39 use warnings;
  8         17  
  8         160  
6              
7 8     8   34 use Carp ();
  8         14  
  8         83  
8 8     8   30 use Scalar::Util ();
  8         14  
  8         122  
9              
10 8     8   32 use UNIVERSAL::Object;
  8         15  
  8         117  
11 8     8   34 use Directory::Scanner::API::Stream;
  8         16  
  8         365  
12              
13             our $VERSION = '0.02';
14             our $AUTHORITY = 'cpan:STEVAN';
15              
16 8   50 8   45 use constant DEBUG => $ENV{DIR_SCANNER_STREAM_MATCHING_DEBUG} // 0;
  8         21  
  8         638  
17              
18             ## ...
19              
20 8     8   495 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   2382 }
27              
28             ## ...
29              
30             sub BUILD {
31 6     6 1 364 my $self = $_[0];
32 6         25 my $stream = $self->{stream};
33 6         15 my $predicate = $self->{predicate};
34              
35 6 50 33     69 (Scalar::Util::blessed($stream) && $stream->DOES('Directory::Scanner::API::Stream'))
36             || Carp::confess 'You must supply a directory stream';
37              
38 6 50       26 (defined $predicate)
39             || Carp::confess 'You must supply a predicate';
40              
41 6 50       27 (ref $predicate eq 'CODE')
42             || Carp::confess 'The predicate supplied must be a CODE reference';
43             }
44              
45             sub clone {
46 0     0 1 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 1 947 sub head { $_[0]->{stream}->head }
56 24     24 1 4637 sub is_done { $_[0]->{stream}->is_done }
57 18     18 1 828 sub is_closed { $_[0]->{stream}->is_closed }
58 6     6 1 208 sub close { $_[0]->{stream}->close }
59              
60             sub next {
61 34     34 1 2301 my $self = $_[0];
62              
63 34         51 my $next;
64 34         48 while (1) {
65 60         341 undef $next; # clear any previous values, just cause ...
66 60         73 $self->_log('Entering loop ... ') if DEBUG;
67              
68 60         143 $next = $self->{stream}->next;
69              
70             # this means the stream is likely
71             # exhausted, so jump out of the loop
72 60 100       129 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         91 local $_ = $next;
78 54 100       130 next unless $self->{predicate}->( $next );
79              
80 28         336 $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         49 last;
86             }
87              
88 34         88 return $next;
89             }
90              
91             1;
92              
93             __END__