1package TAP::Parser::Multiplexer;
2
3use strict;
4use vars qw($VERSION @ISA);
5
6use IO::Select;
7use TAP::Object ();
8
9use constant IS_WIN32 => $^O =~ /^(MS)?Win32$/;
10use constant IS_VMS => $^O eq 'VMS';
11use constant SELECT_OK => !( IS_VMS || IS_WIN32 );
12
13@ISA = 'TAP::Object';
14
15=head1 NAME
16
17TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers
18
19=head1 VERSION
20
21Version 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
40C<TAP::Parser::Multiplexer> gathers input from multiple TAP::Parsers.
41Internally it calls select on the input file handles for those parsers
42to wait for one or more of them to have input available.
43
44See 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
54Returns a new C<TAP::Parser::Multiplexer> object.
55
56=cut
57
58# new() implementation supplied by TAP::Object
59
60sub _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
76Add a TAP::Parser to the multiplexer. C<$stash> is an optional opaque
77reference that will be returned from C<next> along with the parser and
78the next result.
79
80=cut
81
82sub 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
107Returns the number of parsers. Parsers are removed from the multiplexer
108when their input is exhausted.
109
110=cut
111
112sub parsers {
113    my $self = shift;
114    return $self->{count} + scalar @{ $self->{avid} };
115}
116
117sub _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
157Return a result from the next available parser. Returns a list
158containing the parser from which the result came, the stash that
159corresponds with that parser and the result.
160
161    my ( $parser, $stash, $result ) = $mux->next;
162
163If C<$result> is undefined the corresponding parser has reached the end
164of its input (and will automatically be removed from the multiplexer).
165
166When 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
182sub next {
183    my $self = shift;
184    return ( $self->{_iter} ||= $self->_iter )->();
185}
186
187=head1 See Also
188
189L<TAP::Parser>
190
191L<TAP::Harness>
192
193=cut
194
1951;
196