git.maemo.org Git - dh-make-perl/blob - dev/i386/libtest-harness-perl/libtest-harness-perl-3.12/lib/TAP/Parser/Multiplexer.pm

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