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