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