cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm

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