package TAP::Parser::IteratorFactory;

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

use TAP::Object ();

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

@ISA = qw(TAP::Object);

use constant handlers => [];

=head1 NAME

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

=head1 VERSION

Version 3.26

=cut

$VERSION = '3.26';

=head1 SYNOPSIS

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

=head1 DESCRIPTION

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

If you're a plugin author, you'll be interested in how to L</register_handler>s,
how L</detect_source> works.

=head1 METHODS

=head2 Class Methods

=head3 C<new>

Creates a new factory class:

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

C<$config> is optional. If given, sets L</config> and calls L</load_handlers>.

=cut

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

=head3 C<register_handler>

Registers a new L<TAP::Parser::SourceHandler> with this factory.

__PACKAGE__->register_handler( $handler_class );

=head3 C<handlers>

List of handlers that have been registered.

=cut

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

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

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

return $class;
}

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

=head2 Instance Methods

=head3 C<config>

my $cfg = $sf->config;
$sf->config({ Perl => { %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 & creation. Class names may be fully qualified
or abbreviated, eg:

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

=cut

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

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

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

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

=head3 C<load_handlers>

$sf->load_handlers;

Loads the handler classes defined in L</config>. For example, given a config:

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

C<load_handlers> will attempt to load the C<MySourceHandler> class by looking in
C<@INC> for it in this order:

TAP::Parser::SourceHandler::MySourceHandler
MySourceHandler

C<croak>s on error.

=cut

sub load_handlers {
my ($self) = @_;
for my $handler ( keys %{ $self->config } ) {
my $sclass = $self->_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' )
&& UNIVERSAL::can( $dclass, 'make_iterator' );

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

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

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

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

=head3 C<make_iterator>

my $iterator = $src_factory->make_iterator( $source );

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

=cut

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

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

$source->config( $self->config )->assemble_meta;

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

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

return if $self->_testing;

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

return $iterator;
}

=head3 C<detect_source>

Given a L<TAP::Parser::Source>, detects what kind of source it is and
returns I<one> L<TAP::Parser::SourceHandler> (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->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->raw;

# find a list of handlers that can handle this source:
my %handlers;
for my $dclass ( @{ $self->handlers } ) {
my $confidence = $dclass->can_handle($source);

# warn "handler: $dclass: $confidence\n";
$handlers{$dclass} = $confidence if $confidence;
}

if ( !%handlers ) {

# use Data::Dump qw( pp );
# warn pp( $meta );

# error: can't detect source
my $raw_source_short = substr( ${ $source->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 = (
map {$_}
sort { $handlers{$a} cmp $handlers{$b} }
keys %handlers
);

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

# return 1st
return pop @handlers;
}

1;

__END__

=head1 SUBCLASSING

Please see L<TAP::Parser/SUBCLASSING> 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<TAP::Parser::SourceHandler> for that).

But in case you find the need to...

package MyIteratorFactory;

use strict;
use vars '@ISA';

use TAP::Parser::IteratorFactory;

@ISA = qw( 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<Test::Harness>.

Moved out of L<TAP::Parser> & converted to a factory class to support
extensible TAP source detective work by Steve Purkis.

=head1 SEE ALSO

L<TAP::Object>,
L<TAP::Parser>,
L<TAP::Parser::SourceHandler>,
L<TAP::Parser::SourceHandler::File>,
L<TAP::Parser::SourceHandler::Perl>,
L<TAP::Parser::SourceHandler::RawTAP>,
L<TAP::Parser::SourceHandler::Handle>,
L<TAP::Parser::SourceHandler::Executable>

=cut