lib/TAP/Parser/Multiplexer.pm

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