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