<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package TAP::Parser::IteratorFactory;

use strict;
use warnings;

use Carp qw( confess );
use File::Basename qw( fileparse );

use base 'TAP::Object';

use constant handlers =&gt; [];

=head1 NAME

TAP::Parser::IteratorFactory - Figures out which SourceHandler objects to use for a given Source

=head1 VERSION

Version 3.44

=cut

our $VERSION = '3.44';

=head1 SYNOPSIS

  use TAP::Parser::IteratorFactory;
  my $factory = TAP::Parser::IteratorFactory-&gt;new({ %config });
  my $iterator  = $factory-&gt;make_iterator( $filename );

=head1 DESCRIPTION

This is a factory class that takes a L&lt;TAP::Parser::Source&gt; and runs it through all the
registered L&lt;TAP::Parser::SourceHandler&gt;s to see which one should handle the source.

If you're a plugin author, you'll be interested in how to L&lt;/register_handler&gt;s,
how L&lt;/detect_source&gt; works.

=head1 METHODS

=head2 Class Methods

=head3 C&lt;new&gt;

Creates a new factory class:

  my $sf = TAP::Parser::IteratorFactory-&gt;new( $config );

C&lt;$config&gt; is optional.  If given, sets L&lt;/config&gt; and calls L&lt;/load_handlers&gt;.

=cut

sub _initialize {
    my ( $self, $config ) = @_;
    $self-&gt;config( $config || {} )-&gt;load_handlers;
    return $self;
}

=head3 C&lt;register_handler&gt;

Registers a new L&lt;TAP::Parser::SourceHandler&gt; with this factory.

  __PACKAGE__-&gt;register_handler( $handler_class );

=head3 C&lt;handlers&gt;

List of handlers that have been registered.

=cut

sub register_handler {
    my ( $class, $dclass ) = @_;

    confess("$dclass must implement can_handle &amp; make_iterator methods!")
      unless UNIVERSAL::can( $dclass, 'can_handle' )
          &amp;&amp; UNIVERSAL::can( $dclass, 'make_iterator' );

    my $handlers = $class-&gt;handlers;
    push @{$handlers}, $dclass
      unless grep { $_ eq $dclass } @{$handlers};

    return $class;
}

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

=head2 Instance Methods

=head3 C&lt;config&gt;

 my $cfg = $sf-&gt;config;
 $sf-&gt;config({ Perl =&gt; { %config } });

Chaining getter/setter for the configuration of the available source handlers.
This is a hashref keyed on handler class whose values contain config to be passed
onto the handlers during detection &amp; creation.  Class names may be fully qualified
or abbreviated, eg:

  # these are equivalent
  $sf-&gt;config({ 'TAP::Parser::SourceHandler::Perl' =&gt; { %config } });
  $sf-&gt;config({ 'Perl' =&gt; { %config } });

=cut

sub config {
    my $self = shift;
    return $self-&gt;{config} unless @_;
    unless ( 'HASH' eq ref $_[0] ) {
        $self-&gt;_croak('Argument to &amp;config must be a hash reference');
    }
    $self-&gt;{config} = shift;
    return $self;
}

sub _last_handler {
    my $self = shift;
    return $self-&gt;{last_handler} unless @_;
    $self-&gt;{last_handler} = shift;
    return $self;
}

sub _testing {
    my $self = shift;
    return $self-&gt;{testing} unless @_;
    $self-&gt;{testing} = shift;
    return $self;
}

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

=head3 C&lt;load_handlers&gt;

 $sf-&gt;load_handlers;

Loads the handler classes defined in L&lt;/config&gt;.  For example, given a config:

  $sf-&gt;config({
    MySourceHandler =&gt; { some =&gt; 'config' },
  });

C&lt;load_handlers&gt; will attempt to load the C&lt;MySourceHandler&gt; class by looking in
C&lt;@INC&gt; for it in this order:

  TAP::Parser::SourceHandler::MySourceHandler
  MySourceHandler

C&lt;croak&gt;s on error.

=cut

sub load_handlers {
    my ($self) = @_;
    for my $handler ( keys %{ $self-&gt;config } ) {
        my $sclass = $self-&gt;_load_handler($handler);

        # TODO: store which class we loaded anywhere?
    }
    return $self;
}

sub _load_handler {
    my ( $self, $handler ) = @_;

    my @errors;
    for my $dclass ( "TAP::Parser::SourceHandler::$handler", $handler ) {
        return $dclass
          if UNIVERSAL::can( $dclass, 'can_handle' )
              &amp;&amp; UNIVERSAL::can( $dclass, 'make_iterator' );

        eval "use $dclass";
        if ( my $e = $@ ) {
            push @errors, $e;
            next;
        }

        return $dclass
          if UNIVERSAL::can( $dclass, 'can_handle' )
              &amp;&amp; UNIVERSAL::can( $dclass, 'make_iterator' );
        push @errors,
          "handler '$dclass' does not implement can_handle &amp; make_iterator";
    }

    $self-&gt;_croak(
        "Cannot load handler '$handler': " . join( "\n", @errors ) );
}

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

=head3 C&lt;make_iterator&gt;

  my $iterator = $src_factory-&gt;make_iterator( $source );

Given a L&lt;TAP::Parser::Source&gt;, finds the most suitable L&lt;TAP::Parser::SourceHandler&gt;
to use to create a L&lt;TAP::Parser::Iterator&gt; (see L&lt;/detect_source&gt;).  Dies on error.

=cut

sub make_iterator {
    my ( $self, $source ) = @_;

    $self-&gt;_croak('no raw source defined!') unless defined $source-&gt;raw;

    $source-&gt;config( $self-&gt;config )-&gt;assemble_meta;

    # is the raw source already an object?
    return $source-&gt;raw
      if ( $source-&gt;meta-&gt;{is_object}
        &amp;&amp; UNIVERSAL::isa( $source-&gt;raw, 'TAP::Parser::SourceHandler' ) );

    # figure out what kind of source it is
    my $sd_class = $self-&gt;detect_source($source);
    $self-&gt;_last_handler($sd_class);

    return if $self-&gt;_testing;

    # create it
    my $iterator = $sd_class-&gt;make_iterator($source);

    return $iterator;
}

=head3 C&lt;detect_source&gt;

Given a L&lt;TAP::Parser::Source&gt;, detects what kind of source it is and
returns I&lt;one&gt; L&lt;TAP::Parser::SourceHandler&gt; (the most confident one).  Dies
on error.

The detection algorithm works something like this:

  for (@registered_handlers) {
    # ask them how confident they are about handling this source
    $confidence{$handler} = $handler-&gt;can_handle( $source )
  }
  # choose the most confident handler

Ties are handled by choosing the first handler.

=cut

sub detect_source {
    my ( $self, $source ) = @_;

    confess('no raw source ref defined!') unless defined $source-&gt;raw;

    # find a list of handlers that can handle this source:
    my %confidence_for;
    for my $handler ( @{ $self-&gt;handlers } ) {
        my $confidence = $handler-&gt;can_handle($source);
        # warn "handler: $handler: $confidence\n";
        $confidence_for{$handler} = $confidence if $confidence;
    }

    if ( !%confidence_for ) {
        # error: can't detect source
        my $raw_source_short = substr( ${ $source-&gt;raw }, 0, 50 );
        confess("Cannot detect source of '$raw_source_short'!");
        return;
    }

    # if multiple handlers can handle it, choose the most confident one
    my @handlers =
          sort { $confidence_for{$b} &lt;=&gt; $confidence_for{$a} }
          keys %confidence_for;

    # Check for a tie.
    if( @handlers &gt; 1 &amp;&amp;
        $confidence_for{$handlers[0]} == $confidence_for{$handlers[1]}
    ) {
        my $filename = $source-&gt;meta-&gt;{file}{basename};
        die("There is a tie between $handlers[0] and $handlers[1].\n".
            "Both voted $confidence_for{$handlers[0]} on $filename.\n");
    }

    # this is really useful for debugging handlers:
    if ( $ENV{TAP_HARNESS_SOURCE_FACTORY_VOTES} ) {
        warn(
            "votes: ",
            join( ', ', map {"$_: $confidence_for{$_}"} @handlers ),
            "\n"
        );
    }

    # return 1st
    return $handlers[0];
}

1;

__END__

=head1 SUBCLASSING

Please see L&lt;TAP::Parser/SUBCLASSING&gt; for a subclassing overview.

=head2 Example

If we've done things right, you'll probably want to write a new source,
rather than sub-classing this (see L&lt;TAP::Parser::SourceHandler&gt; for that).

But in case you find the need to...

  package MyIteratorFactory;

  use strict;

  use base 'TAP::Parser::IteratorFactory';

  # override source detection algorithm
  sub detect_source {
    my ($self, $raw_source_ref, $meta) = @_;
    # do detective work, using $meta and whatever else...
  }

  1;

=head1 AUTHORS

Steve Purkis

=head1 ATTRIBUTION

Originally ripped off from L&lt;Test::Harness&gt;.

Moved out of L&lt;TAP::Parser&gt; &amp; converted to a factory class to support
extensible TAP source detective work by Steve Purkis.

=head1 SEE ALSO

L&lt;TAP::Object&gt;,
L&lt;TAP::Parser&gt;,
L&lt;TAP::Parser::SourceHandler&gt;,
L&lt;TAP::Parser::SourceHandler::File&gt;,
L&lt;TAP::Parser::SourceHandler::Perl&gt;,
L&lt;TAP::Parser::SourceHandler::RawTAP&gt;,
L&lt;TAP::Parser::SourceHandler::Handle&gt;,
L&lt;TAP::Parser::SourceHandler::Executable&gt;

=cut

</pre></body></html>