diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm | 327 |
1 files changed, 249 insertions, 78 deletions
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm index 064d7beb167..a45f08550cb 100644 --- a/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm +++ b/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm @@ -3,40 +3,40 @@ package TAP::Parser::IteratorFactory; use strict; use vars qw($VERSION @ISA); -use TAP::Object (); -use TAP::Parser::Iterator::Array (); -use TAP::Parser::Iterator::Stream (); -use TAP::Parser::Iterator::Process (); +use TAP::Object (); + +use Carp qw( confess ); +use File::Basename qw( fileparse ); @ISA = qw(TAP::Object); +use constant handlers => []; + =head1 NAME -TAP::Parser::IteratorFactory - Internal TAP::Parser Iterator +TAP::Parser::IteratorFactory - Figures out which SourceHandler objects to use for a given Source =head1 VERSION -Version 3.17 +Version 3.23 =cut -$VERSION = '3.17'; +$VERSION = '3.23'; =head1 SYNOPSIS use TAP::Parser::IteratorFactory; - my $factory = TAP::Parser::IteratorFactory->new; - my $iter = $factory->make_iterator(\*TEST); - my $iter = $factory->make_iterator(\@array); - my $iter = $factory->make_iterator(\%hash); - - my $line = $iter->next; + my $factory = TAP::Parser::IteratorFactory->new({ %config }); + my $iterator = $factory->make_iterator( $filename ); =head1 DESCRIPTION -This is a factory class for simple iterator wrappers for arrays, filehandles, -and hashes. Unless you're subclassing, you probably won't need to use this -module directly. +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 @@ -44,128 +44,299 @@ module directly. =head3 C<new> -Creates a new factory class. -I<Note:> You currently don't need to instantiate a factory in order to use it. +Creates a new factory class: -=head3 C<make_iterator> + my $sf = TAP::Parser::IteratorFactory->new( $config ); -Create an iterator. The type of iterator created depends on the arguments to -the constructor: +C<$config> is optional. If given, sets L</config> and calls L</load_handlers>. - my $iter = TAP::Parser::Iterator->make_iterator( $filehandle ); +=cut + +sub _initialize { + my ( $self, $config ) = @_; + $self->config( $config || {} )->load_handlers; + return $self; +} -Creates a I<stream> iterator (see L</make_stream_iterator>). +=head3 C<register_handler> - my $iter = TAP::Parser::Iterator->make_iterator( $array_reference ); +Registers a new L<TAP::Parser::SourceHandler> with this factory. -Creates an I<array> iterator (see L</make_array_iterator>). + __PACKAGE__->register_handler( $handler_class ); - my $iter = TAP::Parser::Iterator->make_iterator( $hash_reference ); +=head3 C<handlers> -Creates a I<process> iterator (see L</make_process_iterator>). +List of handlers that have been registered. =cut -sub make_iterator { - my ( $proto, $thing ) = @_; +sub register_handler { + my ( $class, $dclass ) = @_; - my $ref = ref $thing; - if ( $ref eq 'GLOB' || $ref eq 'IO::Handle' ) { - return $proto->make_stream_iterator($thing); - } - elsif ( $ref eq 'ARRAY' ) { - return $proto->make_array_iterator($thing); - } - elsif ( $ref eq 'HASH' ) { - return $proto->make_process_iterator($thing); - } - else { - die "Can't iterate with a $ref"; + 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<make_stream_iterator> +############################################################################## + +=head3 C<load_handlers> + + $sf->load_handlers; -Make a new stream iterator and return it. Passes through any arguments given. -Defaults to a L<TAP::Parser::Iterator::Stream>. +Loads the handler classes defined in L</config>. For example, given a config: -=head3 C<make_array_iterator> + $sf->config({ + MySourceHandler => { some => 'config' }, + }); -Make a new array iterator and return it. Passes through any arguments given. -Defaults to a L<TAP::Parser::Iterator::Array>. +C<load_handlers> will attempt to load the C<MySourceHandler> class by looking in +C<@INC> for it in this order: -=head3 C<make_process_iterator> + TAP::Parser::SourceHandler::MySourceHandler + MySourceHandler -Make a new process iterator and return it. Passes through any arguments given. -Defaults to a L<TAP::Parser::Iterator::Process>. +C<croak>s on error. =cut -sub make_stream_iterator { - my $proto = shift; - TAP::Parser::Iterator::Stream->new(@_); +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 make_array_iterator { - my $proto = shift; - TAP::Parser::Iterator::Array->new(@_); +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 ) ); } -sub make_process_iterator { - my $proto = shift; - TAP::Parser::Iterator::Process->new(@_); +############################################################################## + +=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; } -1; +=head3 C<detect_source> -=head1 SUBCLASSING +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. -Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview. +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 ) = @_; -There are a few things to bear in mind when creating your own -C<ResultFactory>: + confess('no raw source ref defined!') unless defined $source->raw; -=over 4 + # find a list of handlers that can handle this source: + my %handlers; + for my $dclass ( @{ $self->handlers } ) { + my $confidence = $dclass->can_handle($source); -=item 1 + # 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; + } -The factory itself is never instantiated (this I<may> change in the future). -This means that C<_initialize> is never called. + # 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; -=back +__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 MyStreamIterator; use TAP::Parser::IteratorFactory; @ISA = qw( TAP::Parser::IteratorFactory ); - # override stream iterator - sub make_stream_iterator { - my $proto = shift; - MyStreamIterator->new(@_); + # 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::Iterator>, -L<TAP::Parser::Iterator::Array>, -L<TAP::Parser::Iterator::Stream>, -L<TAP::Parser::Iterator::Process>, +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 |