1package TAP::Parser::Result; 2 3use strict; 4use warnings; 5 6use base 'TAP::Object'; 7 8BEGIN { 9 10 # make is_* methods 11 my @attrs = qw( plan pragma test comment bailout version unknown yaml ); 12 no strict 'refs'; 13 for my $token (@attrs) { 14 my $method = "is_$token"; 15 *$method = sub { return $token eq shift->type }; 16 } 17} 18 19############################################################################## 20 21=head1 NAME 22 23TAP::Parser::Result - Base class for TAP::Parser output objects 24 25=head1 VERSION 26 27Version 3.44 28 29=cut 30 31our $VERSION = '3.44'; 32 33=head1 SYNOPSIS 34 35 # abstract class - not meant to be used directly 36 # see TAP::Parser::ResultFactory for preferred usage 37 38 # directly: 39 use TAP::Parser::Result; 40 my $token = {...}; 41 my $result = TAP::Parser::Result->new( $token ); 42 43=head2 DESCRIPTION 44 45This is a simple base class used by L<TAP::Parser> to store objects that 46represent the current bit of test output data from TAP (usually a single 47line). Unless you're subclassing, you probably won't need to use this module 48directly. 49 50=head2 METHODS 51 52=head3 C<new> 53 54 # see TAP::Parser::ResultFactory for preferred usage 55 56 # to use directly: 57 my $result = TAP::Parser::Result->new($token); 58 59Returns an instance the appropriate class for the test token passed in. 60 61=cut 62 63# new() implementation provided by TAP::Object 64 65sub _initialize { 66 my ( $self, $token ) = @_; 67 if ($token) { 68 69 # assign to a hash slice to make a shallow copy of the token. 70 # I guess we could assign to the hash as (by default) there are not 71 # contents, but that seems less helpful if someone wants to subclass us 72 @{$self}{ keys %$token } = values %$token; 73 } 74 return $self; 75} 76 77############################################################################## 78 79=head2 Boolean methods 80 81The following methods all return a boolean value and are to be overridden in 82the appropriate subclass. 83 84=over 4 85 86=item * C<is_plan> 87 88Indicates whether or not this is the test plan line. 89 90 1..3 91 92=item * C<is_pragma> 93 94Indicates whether or not this is a pragma line. 95 96 pragma +strict 97 98=item * C<is_test> 99 100Indicates whether or not this is a test line. 101 102 ok 1 Is OK! 103 104=item * C<is_comment> 105 106Indicates whether or not this is a comment. 107 108 # this is a comment 109 110=item * C<is_bailout> 111 112Indicates whether or not this is bailout line. 113 114 Bail out! We're out of dilithium crystals. 115 116=item * C<is_version> 117 118Indicates whether or not this is a TAP version line. 119 120 TAP version 4 121 122=item * C<is_unknown> 123 124Indicates whether or not the current line could be parsed. 125 126 ... this line is junk ... 127 128=item * C<is_yaml> 129 130Indicates whether or not this is a YAML chunk. 131 132=back 133 134=cut 135 136############################################################################## 137 138=head3 C<raw> 139 140 print $result->raw; 141 142Returns the original line of text which was parsed. 143 144=cut 145 146sub raw { shift->{raw} } 147 148############################################################################## 149 150=head3 C<type> 151 152 my $type = $result->type; 153 154Returns the "type" of a token, such as C<comment> or C<test>. 155 156=cut 157 158sub type { shift->{type} } 159 160############################################################################## 161 162=head3 C<as_string> 163 164 print $result->as_string; 165 166Prints a string representation of the token. This might not be the exact 167output, however. Tests will have test numbers added if not present, TODO and 168SKIP directives will be capitalized and, in general, things will be cleaned 169up. If you need the original text for the token, see the C<raw> method. 170 171=cut 172 173sub as_string { shift->{raw} } 174 175############################################################################## 176 177=head3 C<is_ok> 178 179 if ( $result->is_ok ) { ... } 180 181Reports whether or not a given result has passed. Anything which is B<not> a 182test result returns true. This is merely provided as a convenient shortcut. 183 184=cut 185 186sub is_ok {1} 187 188############################################################################## 189 190=head3 C<passed> 191 192Deprecated. Please use C<is_ok> instead. 193 194=cut 195 196sub passed { 197 warn 'passed() is deprecated. Please use "is_ok()"'; 198 shift->is_ok; 199} 200 201############################################################################## 202 203=head3 C<has_directive> 204 205 if ( $result->has_directive ) { 206 ... 207 } 208 209Indicates whether or not the given result has a TODO or SKIP directive. 210 211=cut 212 213sub has_directive { 214 my $self = shift; 215 return ( $self->has_todo || $self->has_skip ); 216} 217 218############################################################################## 219 220=head3 C<has_todo> 221 222 if ( $result->has_todo ) { 223 ... 224 } 225 226Indicates whether or not the given result has a TODO directive. 227 228=cut 229 230sub has_todo { 'TODO' eq ( shift->{directive} || '' ) } 231 232############################################################################## 233 234=head3 C<has_skip> 235 236 if ( $result->has_skip ) { 237 ... 238 } 239 240Indicates whether or not the given result has a SKIP directive. 241 242=cut 243 244sub has_skip { 'SKIP' eq ( shift->{directive} || '' ) } 245 246=head3 C<set_directive> 247 248Set the directive associated with this token. Used internally to fake 249TODO tests. 250 251=cut 252 253sub set_directive { 254 my ( $self, $dir ) = @_; 255 $self->{directive} = $dir; 256} 257 2581; 259 260=head1 SUBCLASSING 261 262Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview. 263 264Remember: if you want your subclass to be automatically used by the parser, 265you'll have to register it with L<TAP::Parser::ResultFactory/register_type>. 266 267If you're creating a completely new result I<type>, you'll probably need to 268subclass L<TAP::Parser::Grammar> too, or else it'll never get used. 269 270=head2 Example 271 272 package MyResult; 273 274 use strict; 275 276 use base 'TAP::Parser::Result'; 277 278 # register with the factory: 279 TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ ); 280 281 sub as_string { 'My results all look the same' } 282 283=head1 SEE ALSO 284 285L<TAP::Object>, 286L<TAP::Parser>, 287L<TAP::Parser::ResultFactory>, 288L<TAP::Parser::Result::Bailout>, 289L<TAP::Parser::Result::Comment>, 290L<TAP::Parser::Result::Plan>, 291L<TAP::Parser::Result::Pragma>, 292L<TAP::Parser::Result::Test>, 293L<TAP::Parser::Result::Unknown>, 294L<TAP::Parser::Result::Version>, 295L<TAP::Parser::Result::YAML>, 296 297=cut 298