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

   1 package TAP::Parser::ResultFactory;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA %CLASS_FOR);
   5
   6 use TAP::Object                  ();
   7 use TAP::Parser::Result::Bailout ();
   8 use TAP::Parser::Result::Comment ();
   9 use TAP::Parser::Result::Plan    ();
  10 use TAP::Parser::Result::Pragma  ();
  11 use TAP::Parser::Result::Test    ();
  12 use TAP::Parser::Result::Unknown ();
  13 use TAP::Parser::Result::Version ();
  14 use TAP::Parser::Result::YAML    ();
  15
  16 @ISA = 'TAP::Object';
  17
  18 ##############################################################################
  19
  20 =head1 NAME
  21
  22 TAP::Parser::ResultFactory - Factory for creating TAP::Parser output objects
  23
  24 =head1 SYNOPSIS
  25
  26   use TAP::Parser::ResultFactory;
  27   my $token   = {...};
  28   my $factory = TAP::Parser::ResultFactory->new;
  29   my $result  = $factory->make_result( $token );
  30
  31 =head1 VERSION
  32
  33 Version 3.12
  34
  35 =cut
  36
  37 $VERSION = '3.12';
  38
  39 =head2 DESCRIPTION
  40
  41 This is a simple factory class which returns a L<TAP::Parser::Result> subclass
  42 representing the current bit of test data from TAP (usually a single line).
  43 It is used primarily by L<TAP::Parser::Grammar>.  Unless you're subclassing,
  44 you probably won't need to use this module directly.
  45
  46 =head2 METHODS
  47
  48 =head2 Class Methods
  49
  50 =head3 C<new>
  51
  52 Creates a new factory class.
  53 I<Note:> You currently don't need to instantiate a factory in order to use it.
  54
  55 =head3 C<make_result>
  56
  57 Returns an instance the appropriate class for the test token passed in.
  58
  59   my $result = TAP::Parser::ResultFactory->make_result($token);
  60
  61 Can also be called as an instance method.
  62
  63 =cut
  64
  65 sub make_result {
  66     my ( $proto, $token ) = @_;
  67     my $type   = $token->{type};
  68     return $proto->class_for( $type )->new( $token );
  69 }
  70
  71
  72 =head3 C<class_for>
  73
  74 Takes one argument: C<$type>.  Returns the class for this $type, or C<croak>s
  75 with an error.
  76
  77 =head3 C<register_type>
  78
  79 Takes two arguments: C<$type>, C<$class>
  80
  81 This lets you override an existing type with your own custom type, or register
  82 a completely new type, eg:
  83
  84   # create a custom result type:
  85   package MyResult;
  86   use strict;
  87   use vars qw(@ISA);
  88   @ISA = 'TAP::Parser::Result';
  89
  90   # register with the factory:
  91   TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ );
  92
  93   # use it:
  94   my $r = TAP::Parser::ResultFactory->( { type => 'my_type' } );
  95
  96 Your custom type should then be picked up automatically by the L<TAP::Parser>.
  97
  98 =cut
  99
 100 BEGIN {
 101     %CLASS_FOR = (
 102         plan    => 'TAP::Parser::Result::Plan',
 103         pragma  => 'TAP::Parser::Result::Pragma',
 104         test    => 'TAP::Parser::Result::Test',
 105         comment => 'TAP::Parser::Result::Comment',
 106         bailout => 'TAP::Parser::Result::Bailout',
 107         version => 'TAP::Parser::Result::Version',
 108         unknown => 'TAP::Parser::Result::Unknown',
 109         yaml    => 'TAP::Parser::Result::YAML',
 110     );
 111 }
 112
 113 sub class_for {
 114     my ( $class, $type ) = @_;
 115     # return target class:
 116     return $CLASS_FOR{$type} if exists $CLASS_FOR{$type};
 117     # or complain:
 118     require Carp;
 119     Carp::croak("Could not determine class for result type '$type'");
 120 }
 121
 122 sub register_type {
 123     my ( $class, $type, $rclass ) = @_;
 124     # register it blindly, assume they know what they're doing
 125     $CLASS_FOR{$type} = $rclass;
 126     return $class;
 127 }
 128
 129 1;
 130
 131 =head1 SUBCLASSING
 132
 133 Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
 134
 135 There are a few things to bear in mind when creating your own
 136 C<ResultFactory>:
 137
 138 =over 4
 139
 140 =item 1
 141
 142 The factory itself is never instantiated (this I<may> change in the future).
 143 This means that C<_initialize> is never called.
 144
 145 =item 2
 146
 147 C<TAP::Parser::Result-E<gt>new> is never called, $tokens are reblessed.
 148 This I<will> change in a future version!
 149
 150 =item 3
 151
 152 L<TAP::Parser::Result> subclasses will register themselves with
 153 L<TAP::Parser::ResultFactory> directly:
 154
 155   package MyFooResult;
 156   TAP::Parser::ResultFactory->register_type( foo => __PACKAGE__ );
 157
 158 Of course, it's up to you to decide whether or not to ignore them.
 159
 160 =back
 161
 162 =head2 Example
 163
 164   package MyResultFactory;
 165
 166   use strict;
 167   use vars '@ISA';
 168
 169   use MyResult;
 170   use TAP::Parser::ResultFactory;
 171
 172   @ISA = qw( TAP::Parser::ResultFactory );
 173
 174   # force all results to be 'MyResult'
 175   sub class_for {
 176     return 'MyResult';
 177   }
 178
 179   1;
 180
 181 =head1 SEE ALSO
 182
 183 L<TAP::Parser>,
 184 L<TAP::Parser::Result>,
 185 L<TAP::Parser::Grammar>
 186
 187 =cut