1 package TAP::Parser::Result;
4 use vars qw($VERSION @ISA);
13 my @attrs = qw( plan pragma test comment bailout version unknown yaml );
15 for my $token (@attrs) {
16 my $method = "is_$token";
17 *$method = sub { return $token eq shift->type };
21 ##############################################################################
25 TAP::Parser::Result - Base class for TAP::Parser output objects
37 # abstract class - not meany to be used directly
38 # see TAP::Parser::ResultFactory for preferred usage
41 use TAP::Parser::Result;
43 my $result = TAP::Parser::Result->new( $token );
47 This is a simple base class used by L<TAP::Parser> to store objects that
48 represent the current bit of test output data from TAP (usually a single
49 line). Unless you're subclassing, you probably won't need to use this module
56 # see TAP::Parser::ResultFactory for preferred usage
59 my $result = TAP::Parser::Result->new($token);
61 Returns an instance the appropriate class for the test token passed in.
65 # new() implementation provided by TAP::Object
68 my ( $self, $token ) = @_;
71 # assign to a hash slice to make a shallow copy of the token.
72 # I guess we could assign to the hash as (by default) there are not
73 # contents, but that seems less helpful if someone wants to subclass us
74 @{$self}{ keys %$token } = values %$token;
79 ##############################################################################
81 =head2 Boolean methods
83 The following methods all return a boolean value and are to be overridden in
84 the appropriate subclass.
90 Indicates whether or not this is the test plan line.
96 Indicates whether or not this is a pragma line.
102 Indicates whether or not this is a test line.
106 =item * C<is_comment>
108 Indicates whether or not this is a comment.
112 =item * C<is_bailout>
114 Indicates whether or not this is bailout line.
116 Bail out! We're out of dilithium crystals.
118 =item * C<is_version>
120 Indicates whether or not this is a TAP version line.
124 =item * C<is_unknown>
126 Indicates whether or not the current line could be parsed.
128 ... this line is junk ...
132 Indicates whether or not this is a YAML chunk.
138 ##############################################################################
144 Returns the original line of text which was parsed.
148 sub raw { shift->{raw} }
150 ##############################################################################
154 my $type = $result->type;
156 Returns the "type" of a token, such as C<comment> or C<test>.
160 sub type { shift->{type} }
162 ##############################################################################
166 print $result->as_string;
168 Prints a string representation of the token. This might not be the exact
169 output, however. Tests will have test numbers added if not present, TODO and
170 SKIP directives will be capitalized and, in general, things will be cleaned
171 up. If you need the original text for the token, see the C<raw> method.
175 sub as_string { shift->{raw} }
177 ##############################################################################
181 if ( $result->is_ok ) { ... }
183 Reports whether or not a given result has passed. Anything which is B<not> a
184 test result returns true. This is merely provided as a convenient shortcut.
190 ##############################################################################
194 Deprecated. Please use C<is_ok> instead.
199 warn 'passed() is deprecated. Please use "is_ok()"';
203 ##############################################################################
205 =head3 C<has_directive>
207 if ( $result->has_directive ) {
211 Indicates whether or not the given result has a TODO or SKIP directive.
217 return ( $self->has_todo || $self->has_skip );
220 ##############################################################################
224 if ( $result->has_todo ) {
228 Indicates whether or not the given result has a TODO directive.
232 sub has_todo { 'TODO' eq ( shift->{directive} || '' ) }
234 ##############################################################################
238 if ( $result->has_skip ) {
242 Indicates whether or not the given result has a SKIP directive.
246 sub has_skip { 'SKIP' eq ( shift->{directive} || '' ) }
248 =head3 C<set_directive>
250 Set the directive associated with this token. Used internally to fake
256 my ( $self, $dir ) = @_;
257 $self->{directive} = $dir;
264 Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
266 Remember: if you want your subclass to be automatically used by the parser,
267 you'll have to register it with L<TAP::Parser::ResultFactory/register_type>.
269 If you're creating a completely new result I<type>, you'll probably need to
270 subclass L<TAP::Parser::Grammar> too, or else it'll never get used.
279 @ISA = 'TAP::Parser::Result';
281 # register with the factory:
282 TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ );
284 sub as_string { 'My results all look the same' }
290 L<TAP::Parser::ResultFactory>,
291 L<TAP::Parser::Result::Bailout>,
292 L<TAP::Parser::Result::Comment>,
293 L<TAP::Parser::Result::Plan>,
294 L<TAP::Parser::Result::Pragma>,
295 L<TAP::Parser::Result::Test>,
296 L<TAP::Parser::Result::Unknown>,
297 L<TAP::Parser::Result::Version>,
298 L<TAP::Parser::Result::YAML>,