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