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   8291 use strict;
  5         6  
  5         126  
4 5     5   16 use warnings;
  5         10  
  5         120  
5              
6 5     5   1912 use IO::Select;
  5         5270  
  5         243  
7              
8 5     5   21 use base 'TAP::Object';
  5         7  
  5         487  
9              
10 5     5   23 use constant IS_WIN32 => $^O =~ /^(MS)?Win32$/;
  5         9  
  5         305  
11 5     5   48 use constant IS_VMS => $^O eq 'VMS';
  5         7  
  5         299  
12 5     5   25 use constant SELECT_OK => !( IS_VMS || IS_WIN32 );
  5         7  
  5         2236  
13              
14             =head1 NAME
15              
16             TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers
17              
18             =head1 VERSION
19              
20             Version 3.38
21              
22             =cut
23              
24             our $VERSION = '3.38';
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   15 my $self = shift;
61 11         42 $self->{select} = IO::Select->new;
62 11         106 $self->{avid} = []; # Parsers that can't select
63 11         23 $self->{count} = 0;
64 11         19 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 86 my ( $self, $parser, $stash ) = @_;
83              
84 25 100       70 if ( SELECT_OK && ( my @handles = $parser->get_select_handles ) ) {
85 15         21 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         22 my @filenos = map { fileno $_ } @handles;
  23         43  
91 15         26 for my $h (@handles) {
92 23         195 $sel->add( [ $h, $parser, $stash, @filenos ] );
93             }
94              
95 15         339 $self->{count}++;
96             }
97             else {
98 10         11 push @{ $self->{avid} }, [ $parser, $stash ];
  10         30  
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 121 my $self = shift;
113 26         25 return $self->{count} + scalar @{ $self->{avid} };
  26         133  
114             }
115              
116             sub _iter {
117 11     11   13 my $self = shift;
118              
119 11         15 my $sel = $self->{select};
120 11         17 my $avid = $self->{avid};
121 11         18 my @ready = ();
122              
123             return sub {
124              
125             # Drain all the non-selectable parsers first
126 147 100   147   243 if (@$avid) {
127 34         25 my ( $parser, $stash ) = @{ $avid->[0] };
  34         49  
128 34         79 my $result = $parser->next;
129 34 100       53 shift @$avid unless defined $result;
130 34         92 return ( $parser, $stash, $result );
131             }
132              
133 113 100       205 unless (@ready) {
134 54 100       135 return unless $sel->count;
135 44         194 @ready = $sel->can_read;
136             }
137              
138 103         1002289 my ( $h, $parser, $stash, @handles ) = @{ shift @ready };
  103         192  
139 103         225 my $result = $parser->next;
140              
141 103 100       162 unless ( defined $result ) {
142 14         33 $sel->remove(@handles);
143 14         406 $self->{count}--;
144              
145             # Force another can_read - we may now have removed a handle
146             # thought to have been ready.
147 14         37 @ready = ();
148             }
149              
150 103         282 return ( $parser, $stash, $result );
151 11         101 };
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 47353 my $self = shift;
183 147   66     447 return ( $self->{_iter} ||= $self->_iter )->();
184             }
185              
186             =head1 See Also
187              
188             L
189              
190             L
191              
192             =cut
193              
194             1;