ok
Direktori : /proc/self/root/usr/share/perl5/vendor_perl/TAP/Parser/ |
Current File : //proc/self/root/usr/share/perl5/vendor_perl/TAP/Parser/IteratorFactory.pm |
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.28 =cut $VERSION = '3.28'; =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