File Coverage

blib/lib/TAP/Parser/Multiplexer.pm
Criterion Covered Total %
statement 63 63 100.0
branch 12 12 100.0
condition 2 3 66.6
subroutine 13 13 100.0
pod 3 3 100.0
total 93 94 98.9


line stmt bran cond sub pod time code
1             package TAP::Parser::Multiplexer;
2              
3 5     5   5737 use strict;
  5         6  
  5         127  
4 5     5   15 use warnings;
  5         6  
  5         117  
5              
6 5     5   1565 use IO::Select;
  5         4657  
  5         226  
7              
8 5     5   23 use base 'TAP::Object';
  5         6  
  5         472  
9              
10 5     5   24 use constant IS_WIN32 => $^O =~ /^(MS)?Win32$/;
  5         5  
  5         303  
11 5     5   18 use constant IS_VMS => $^O eq 'VMS';
  5         6  
  5         241  
12 5     5   17 use constant SELECT_OK => !( IS_VMS || IS_WIN32 );
  5         5  
  5         1974  
13              
14             =head1 NAME
15              
16             TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers
17              
18             =head1 VERSION
19              
20             Version 3.39
21              
22             =cut
23              
24             our $VERSION = '3.39';
25              
26             =head1 SYNOPSIS
27              
28             use TAP::Parser::Multiplexer;
29              
30             my $mux = TAP::Parser::Multiplexer->new;
31             $mux->add( $parser1, $stash1 );
32             $mux->add( $parser2, $stash2 );
33             while ( my ( $parser, $stash, $result ) = $mux->next ) {
34             # do stuff
35             }
36              
37             =head1 DESCRIPTION
38              
39             C gathers input from multiple TAP::Parsers.
40             Internally it calls select on the input file handles for those parsers
41             to wait for one or more of them to have input available.
42              
43             See L for an example of its use.
44              
45             =head1 METHODS
46              
47             =head2 Class Methods
48              
49             =head3 C
50              
51             my $mux = TAP::Parser::Multiplexer->new;
52              
53             Returns a new C object.
54              
55             =cut
56              
57             # new() implementation supplied by TAP::Object
58              
59             sub _initialize {
60 11     11   19 my $self = shift;
61 11         57 $self->{select} = IO::Select->new;
62 11         142 $self->{avid} = []; # Parsers that can't select
63 11         26 $self->{count} = 0;
64 11         24 return $self;
65             }
66              
67             ##############################################################################
68              
69             =head2 Instance Methods
70              
71             =head3 C
72              
73             $mux->add( $parser, $stash );
74              
75             Add a TAP::Parser to the multiplexer. C<$stash> is an optional opaque
76             reference that will be returned from C along with the parser and
77             the next result.
78              
79             =cut
80              
81             sub add {
82 25     25 1 113 my ( $self, $parser, $stash ) = @_;
83              
84 25 100       81 if ( SELECT_OK && ( my @handles = $parser->get_select_handles ) ) {
85 15         27 my $sel = $self->{select};
86              
87             # We have to turn handles into file numbers here because by
88             # the time we want to remove them from our IO::Select they
89             # will already have been closed by the iterator.
90 15         28 my @filenos = map { fileno $_ } @handles;
  23         59  
91 15         37 for my $h (@handles) {
92 23         245 $sel->add( [ $h, $parser, $stash, @filenos ] );
93             }
94              
95 15         474 $self->{count}++;
96             }
97             else {
98 10         11 push @{ $self->{avid} }, [ $parser, $stash ];
  10         31  
99             }
100             }
101              
102             =head3 C
103              
104             my $count = $mux->parsers;
105              
106             Returns the number of parsers. Parsers are removed from the multiplexer
107             when their input is exhausted.
108              
109             =cut
110              
111             sub parsers {
112 26     26 1 130 my $self = shift;
113 26         36 return $self->{count} + scalar @{ $self->{avid} };
  26         160  
114             }
115              
116             sub _iter {
117 11     11   13 my $self = shift;
118              
119 11         17 my $sel = $self->{select};
120 11         16 my $avid = $self->{avid};
121 11         20 my @ready = ();
122              
123             return sub {
124              
125             # Drain all the non-selectable parsers first
126 147 100   147   259 if (@$avid) {
127 34         23 my ( $parser, $stash ) = @{ $avid->[0] };
  34         58  
128 34         82 my $result = $parser->next;
129 34 100       54 shift @$avid unless defined $result;
130 34         93 return ( $parser, $stash, $result );
131             }
132              
133 113 100       256 unless (@ready) {
134 57 100       163 return unless $sel->count;
135 47         251 @ready = $sel->can_read;
136             }
137              
138 103         1004476 my ( $h, $parser, $stash, @handles ) = @{ shift @ready };
  103         222  
139 103         301 my $result = $parser->next;
140              
141 103 100       198 unless ( defined $result ) {
142 14         51 $sel->remove(@handles);
143 14         494 $self->{count}--;
144              
145             # Force another can_read - we may now have removed a handle
146             # thought to have been ready.
147 14         41 @ready = ();
148             }
149              
150 103         355 return ( $parser, $stash, $result );
151 11         120 };
152             }
153              
154             =head3 C
155              
156             Return a result from the next available parser. Returns a list
157             containing the parser from which the result came, the stash that
158             corresponds with that parser and the result.
159              
160             my ( $parser, $stash, $result ) = $mux->next;
161              
162             If C<$result> is undefined the corresponding parser has reached the end
163             of its input (and will automatically be removed from the multiplexer).
164              
165             When all parsers are exhausted an empty list will be returned.
166              
167             if ( my ( $parser, $stash, $result ) = $mux->next ) {
168             if ( ! defined $result ) {
169             # End of this parser
170             }
171             else {
172             # Process result
173             }
174             }
175             else {
176             # All parsers finished
177             }
178              
179             =cut
180              
181             sub next {
182 147     147 1 48314 my $self = shift;
183 147   66     492 return ( $self->{_iter} ||= $self->_iter )->();
184             }
185              
186             =head1 See Also
187              
188             L
189              
190             L
191              
192             =cut
193              
194             1;