local-lib5/lib/perl5/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.17
  34
  35 =cut
  36
  37 $VERSION = '3.17';
  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 =head3 C<class_for>
  72
  73 Takes one argument: C<$type>.  Returns the class for this $type, or C<croak>s
  74 with an error.
  75
  76 =head3 C<register_type>
  77
  78 Takes two arguments: C<$type>, C<$class>
  79
  80 This lets you override an existing type with your own custom type, or register
  81 a completely new type, eg:
  82
  83   # create a custom result type:
  84   package MyResult;
  85   use strict;
  86   use vars qw(@ISA);
  87   @ISA = 'TAP::Parser::Result';
  88
  89   # register with the factory:
  90   TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ );
  91
  92   # use it:
  93   my $r = TAP::Parser::ResultFactory->( { type => 'my_type' } );
  94
  95 Your custom type should then be picked up automatically by the L<TAP::Parser>.
  96
  97 =cut
  98
  99 BEGIN {
 100     %CLASS_FOR = (
 101         plan    => 'TAP::Parser::Result::Plan',
 102         pragma  => 'TAP::Parser::Result::Pragma',
 103         test    => 'TAP::Parser::Result::Test',
 104         comment => 'TAP::Parser::Result::Comment',
 105         bailout => 'TAP::Parser::Result::Bailout',
 106         version => 'TAP::Parser::Result::Version',
 107         unknown => 'TAP::Parser::Result::Unknown',
 108         yaml    => 'TAP::Parser::Result::YAML',
 109     );
 110 }
 111
 112 sub class_for {
 113     my ( $class, $type ) = @_;
 114
 115     # return target class:
 116     return $CLASS_FOR{$type} if exists $CLASS_FOR{$type};
 117
 118     # or complain:
 119     require Carp;
 120     Carp::croak("Could not determine class for result type '$type'");
 121 }
 122
 123 sub register_type {
 124     my ( $class, $type, $rclass ) = @_;
 125
 126     # register it blindly, assume they know what they're doing
 127     $CLASS_FOR{$type} = $rclass;
 128     return $class;
 129 }
 130
 131 1;
 132
 133 =head1 SUBCLASSING
 134
 135 Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
 136
 137 There are a few things to bear in mind when creating your own
 138 C<ResultFactory>:
 139
 140 =over 4
 141
 142 =item 1
 143
 144 The factory itself is never instantiated (this I<may> change in the future).
 145 This means that C<_initialize> is never called.
 146
 147 =item 2
 148
 149 C<TAP::Parser::Result-E<gt>new> is never called, $tokens are reblessed.
 150 This I<will> change in a future version!
 151
 152 =item 3
 153
 154 L<TAP::Parser::Result> subclasses will register themselves with
 155 L<TAP::Parser::ResultFactory> directly:
 156
 157   package MyFooResult;
 158   TAP::Parser::ResultFactory->register_type( foo => __PACKAGE__ );
 159
 160 Of course, it's up to you to decide whether or not to ignore them.
 161
 162 =back
 163
 164 =head2 Example
 165
 166   package MyResultFactory;
 167
 168   use strict;
 169   use vars '@ISA';
 170
 171   use MyResult;
 172   use TAP::Parser::ResultFactory;
 173
 174   @ISA = qw( TAP::Parser::ResultFactory );
 175
 176   # force all results to be 'MyResult'
 177   sub class_for {
 178     return 'MyResult';
 179   }
 180
 181   1;
 182
 183 =head1 SEE ALSO
 184
 185 L<TAP::Parser>,
 186 L<TAP::Parser::Result>,
 187 L<TAP::Parser::Grammar>
 188
 189 =cut