git.maemo.org Git - pkg-perl/blob - deb-src/libtest-harness-perl/libtest-harness-perl-3.12/lib/TAP/Parser/Source.pm

   1 package TAP::Parser::Source;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA);
   5
   6 use TAP::Object                  ();
   7 use TAP::Parser::IteratorFactory ();
   8
   9 @ISA = qw(TAP::Object);
  10
  11 # Causes problem on MacOS and shouldn't be necessary anyway
  12 #$SIG{CHLD} = sub { wait };
  13
  14 =head1 NAME
  15
  16 TAP::Parser::Source - Stream output from some source
  17
  18 =head1 VERSION
  19
  20 Version 3.12
  21
  22 =cut
  23
  24 $VERSION = '3.12';
  25
  26 =head1 SYNOPSIS
  27
  28   use TAP::Parser::Source;
  29   my $source = TAP::Parser::Source->new({ parser => $parser });
  30   my $stream = $source->source(['/usr/bin/ruby', 'mytest.rb'])->get_stream;
  31
  32 =head1 DESCRIPTION
  33
  34 Takes a command and hopefully returns a stream from it.
  35
  36 =head1 METHODS
  37
  38 =head2 Class Methods
  39
  40 =head3 C<new>
  41
  42  my $source = TAP::Parser::Source->new({ parser => $parser });
  43
  44 Returns a new C<TAP::Parser::Source> object.
  45
  46 =cut
  47
  48 # new() implementation supplied by TAP::Object
  49
  50 sub _initialize {
  51     my ( $self, $args ) = @_;
  52     $self->{switches} = [];
  53     $self->{parser}   = $args->{parser};    # TODO: accessor
  54     _autoflush( \*STDOUT );
  55     _autoflush( \*STDERR );
  56     return $self;
  57 }
  58
  59 ##############################################################################
  60
  61 =head2 Instance Methods
  62
  63 =head3 C<source>
  64
  65  my $source = $source->source;
  66  $source->source(['./some_prog some_test_file']);
  67
  68  # or
  69  $source->source(['/usr/bin/ruby', 't/ruby_test.rb']);
  70
  71 Getter/setter for the source.  The source should generally consist of an array
  72 reference of strings which, when executed via L<&IPC::Open3::open3|IPC::Open3>,
  73 should return a filehandle which returns successive rows of TAP.  C<croaks> if
  74 it doesn't get an arrayref.
  75
  76 =cut
  77
  78 sub source {
  79     my $self = shift;
  80     return $self->{source} unless @_;
  81     unless ( 'ARRAY' eq ref $_[0] ) {
  82         $self->_croak('Argument to &source must be an array reference');
  83     }
  84     $self->{source} = shift;
  85     return $self;
  86 }
  87
  88 ##############################################################################
  89
  90 =head3 C<get_stream>
  91
  92  my $stream = $source->get_stream;
  93
  94 Returns a L<TAP::Parser::Iterator> stream of the output generated by executing
  95 C<source>.  C<croak>s if there was no command found.
  96
  97 =cut
  98
  99 sub get_stream {
 100     my ($self) = @_;
 101     my @command = $self->_get_command
 102       or $self->_croak('No command found!');
 103
 104     return $self->{parser}->make_iterator(
 105         {   command => \@command,
 106             merge   => $self->merge
 107         }
 108     );
 109 }
 110
 111 sub _get_command { return @{ shift->source || [] } }
 112
 113 ##############################################################################
 114
 115 =head3 C<merge>
 116
 117   my $merge = $source->merge;
 118
 119 Sets or returns the flag that dictates whether STDOUT and STDERR are merged.
 120
 121 =cut
 122
 123 sub merge {
 124     my $self = shift;
 125     return $self->{merge} unless @_;
 126     $self->{merge} = shift;
 127     return $self;
 128 }
 129
 130 # Turns on autoflush for the handle passed
 131 sub _autoflush {
 132     my $flushed = shift;
 133     my $old_fh  = select $flushed;
 134     $| = 1;
 135     select $old_fh;
 136 }
 137
 138 1;
 139
 140 =head1 SUBCLASSING
 141
 142 Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
 143
 144 =head2 Example
 145
 146   package MyRubySource;
 147
 148   use strict;
 149   use vars '@ISA';
 150
 151   use Carp qw( croak );
 152   use TAP::Parser::Source;
 153
 154   @ISA = qw( TAP::Parser::Source );
 155
 156   # expect $source->(['mytest.rb', 'cmdline', 'args']);
 157   sub source {
 158     my ($self, $args) = @_;
 159     my ($rb_file) = @$args;
 160     croak("error: Ruby file '$rb_file' not found!") unless (-f $rb_file);
 161     return $self->SUPER::source(['/usr/bin/ruby', @$args]);
 162   }
 163
 164 =head1 SEE ALSO
 165
 166 L<TAP::Object>,
 167 L<TAP::Parser>,
 168 L<TAP::Parser::Source::Perl>,
 169
 170 =cut
 171