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