TAP::Parser::ResultFactory - Factory for creating TAP::Parser output objects


Test-Harness documentation Contained in the Test-Harness distribution.

Index


Code Index:

NAME

Top

TAP::Parser::ResultFactory - Factory for creating TAP::Parser output objects

SYNOPSIS

Top

  use TAP::Parser::ResultFactory;
  my $token   = {...};
  my $factory = TAP::Parser::ResultFactory->new;
  my $result  = $factory->make_result( $token );

VERSION

Top

Version 3.23

DESCRIPTION

This is a simple factory class which returns a TAP::Parser::Result subclass representing the current bit of test data from TAP (usually a single line). It is used primarily by TAP::Parser::Grammar. Unless you're subclassing, you probably won't need to use this module directly.

METHODS

Class Methods

new

Creates a new factory class. Note: You currently don't need to instantiate a factory in order to use it.

make_result

Returns an instance the appropriate class for the test token passed in.

  my $result = TAP::Parser::ResultFactory->make_result($token);

Can also be called as an instance method.

class_for

Takes one argument: $type. Returns the class for this $type, or croaks with an error.

register_type

Takes two arguments: $type, $class

This lets you override an existing type with your own custom type, or register a completely new type, eg:

  # create a custom result type:
  package MyResult;
  use strict;
  use vars qw(@ISA);
  @ISA = 'TAP::Parser::Result';

  # register with the factory:
  TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ );

  # use it:
  my $r = TAP::Parser::ResultFactory->( { type => 'my_type' } );

Your custom type should then be picked up automatically by the TAP::Parser.

SUBCLASSING

Top

Please see SUBCLASSING in TAP::Parser for a subclassing overview.

There are a few things to bear in mind when creating your own ResultFactory:

1

The factory itself is never instantiated (this may change in the future). This means that _initialize is never called.

2

TAP::Parser::Result->new is never called, $tokens are reblessed. This will change in a future version!

3

TAP::Parser::Result subclasses will register themselves with TAP::Parser::ResultFactory directly:

  package MyFooResult;
  TAP::Parser::ResultFactory->register_type( foo => __PACKAGE__ );

Of course, it's up to you to decide whether or not to ignore them.

Example

  package MyResultFactory;

  use strict;
  use vars '@ISA';

  use MyResult;
  use TAP::Parser::ResultFactory;

  @ISA = qw( TAP::Parser::ResultFactory );

  # force all results to be 'MyResult'
  sub class_for {
    return 'MyResult';
  }

  1;

SEE ALSO

Top

TAP::Parser, TAP::Parser::Result, TAP::Parser::Grammar


Test-Harness documentation Contained in the Test-Harness distribution.
package TAP::Parser::ResultFactory;

use strict;
use vars qw($VERSION @ISA %CLASS_FOR);

use TAP::Object                  ();
use TAP::Parser::Result::Bailout ();
use TAP::Parser::Result::Comment ();
use TAP::Parser::Result::Plan    ();
use TAP::Parser::Result::Pragma  ();
use TAP::Parser::Result::Test    ();
use TAP::Parser::Result::Unknown ();
use TAP::Parser::Result::Version ();
use TAP::Parser::Result::YAML    ();

@ISA = 'TAP::Object';

##############################################################################

$VERSION = '3.23';

sub make_result {
    my ( $proto, $token ) = @_;
    my $type = $token->{type};
    return $proto->class_for($type)->new($token);
}

BEGIN {
    %CLASS_FOR = (
        plan    => 'TAP::Parser::Result::Plan',
        pragma  => 'TAP::Parser::Result::Pragma',
        test    => 'TAP::Parser::Result::Test',
        comment => 'TAP::Parser::Result::Comment',
        bailout => 'TAP::Parser::Result::Bailout',
        version => 'TAP::Parser::Result::Version',
        unknown => 'TAP::Parser::Result::Unknown',
        yaml    => 'TAP::Parser::Result::YAML',
    );
}

sub class_for {
    my ( $class, $type ) = @_;

    # return target class:
    return $CLASS_FOR{$type} if exists $CLASS_FOR{$type};

    # or complain:
    require Carp;
    Carp::croak("Could not determine class for result type '$type'");
}

sub register_type {
    my ( $class, $type, $rclass ) = @_;

    # register it blindly, assume they know what they're doing
    $CLASS_FOR{$type} = $rclass;
    return $class;
}

1;