"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm" (10 Mar 2019, 8307 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package TAP::Parser::IteratorFactory;
    2 
    3 use strict;
    4 use warnings;
    5 
    6 use Carp qw( confess );
    7 use File::Basename qw( fileparse );
    8 
    9 use base 'TAP::Object';
   10 
   11 use constant handlers => [];
   12 
   13 =head1 NAME
   14 
   15 TAP::Parser::IteratorFactory - Figures out which SourceHandler objects to use for a given Source
   16 
   17 =head1 VERSION
   18 
   19 Version 3.42
   20 
   21 =cut
   22 
   23 our $VERSION = '3.42';
   24 
   25 =head1 SYNOPSIS
   26 
   27   use TAP::Parser::IteratorFactory;
   28   my $factory = TAP::Parser::IteratorFactory->new({ %config });
   29   my $iterator  = $factory->make_iterator( $filename );
   30 
   31 =head1 DESCRIPTION
   32 
   33 This is a factory class that takes a L<TAP::Parser::Source> and runs it through all the
   34 registered L<TAP::Parser::SourceHandler>s to see which one should handle the source.
   35 
   36 If you're a plugin author, you'll be interested in how to L</register_handler>s,
   37 how L</detect_source> works.
   38 
   39 =head1 METHODS
   40 
   41 =head2 Class Methods
   42 
   43 =head3 C<new>
   44 
   45 Creates a new factory class:
   46 
   47   my $sf = TAP::Parser::IteratorFactory->new( $config );
   48 
   49 C<$config> is optional.  If given, sets L</config> and calls L</load_handlers>.
   50 
   51 =cut
   52 
   53 sub _initialize {
   54     my ( $self, $config ) = @_;
   55     $self->config( $config || {} )->load_handlers;
   56     return $self;
   57 }
   58 
   59 =head3 C<register_handler>
   60 
   61 Registers a new L<TAP::Parser::SourceHandler> with this factory.
   62 
   63   __PACKAGE__->register_handler( $handler_class );
   64 
   65 =head3 C<handlers>
   66 
   67 List of handlers that have been registered.
   68 
   69 =cut
   70 
   71 sub register_handler {
   72     my ( $class, $dclass ) = @_;
   73 
   74     confess("$dclass must implement can_handle & make_iterator methods!")
   75       unless UNIVERSAL::can( $dclass, 'can_handle' )
   76           && UNIVERSAL::can( $dclass, 'make_iterator' );
   77 
   78     my $handlers = $class->handlers;
   79     push @{$handlers}, $dclass
   80       unless grep { $_ eq $dclass } @{$handlers};
   81 
   82     return $class;
   83 }
   84 
   85 ##############################################################################
   86 
   87 =head2 Instance Methods
   88 
   89 =head3 C<config>
   90 
   91  my $cfg = $sf->config;
   92  $sf->config({ Perl => { %config } });
   93 
   94 Chaining getter/setter for the configuration of the available source handlers.
   95 This is a hashref keyed on handler class whose values contain config to be passed
   96 onto the handlers during detection & creation.  Class names may be fully qualified
   97 or abbreviated, eg:
   98 
   99   # these are equivalent
  100   $sf->config({ 'TAP::Parser::SourceHandler::Perl' => { %config } });
  101   $sf->config({ 'Perl' => { %config } });
  102 
  103 =cut
  104 
  105 sub config {
  106     my $self = shift;
  107     return $self->{config} unless @_;
  108     unless ( 'HASH' eq ref $_[0] ) {
  109         $self->_croak('Argument to &config must be a hash reference');
  110     }
  111     $self->{config} = shift;
  112     return $self;
  113 }
  114 
  115 sub _last_handler {
  116     my $self = shift;
  117     return $self->{last_handler} unless @_;
  118     $self->{last_handler} = shift;
  119     return $self;
  120 }
  121 
  122 sub _testing {
  123     my $self = shift;
  124     return $self->{testing} unless @_;
  125     $self->{testing} = shift;
  126     return $self;
  127 }
  128 
  129 ##############################################################################
  130 
  131 =head3 C<load_handlers>
  132 
  133  $sf->load_handlers;
  134 
  135 Loads the handler classes defined in L</config>.  For example, given a config:
  136 
  137   $sf->config({
  138     MySourceHandler => { some => 'config' },
  139   });
  140 
  141 C<load_handlers> will attempt to load the C<MySourceHandler> class by looking in
  142 C<@INC> for it in this order:
  143 
  144   TAP::Parser::SourceHandler::MySourceHandler
  145   MySourceHandler
  146 
  147 C<croak>s on error.
  148 
  149 =cut
  150 
  151 sub load_handlers {
  152     my ($self) = @_;
  153     for my $handler ( keys %{ $self->config } ) {
  154         my $sclass = $self->_load_handler($handler);
  155 
  156         # TODO: store which class we loaded anywhere?
  157     }
  158     return $self;
  159 }
  160 
  161 sub _load_handler {
  162     my ( $self, $handler ) = @_;
  163 
  164     my @errors;
  165     for my $dclass ( "TAP::Parser::SourceHandler::$handler", $handler ) {
  166         return $dclass
  167           if UNIVERSAL::can( $dclass, 'can_handle' )
  168               && UNIVERSAL::can( $dclass, 'make_iterator' );
  169 
  170         eval "use $dclass";
  171         if ( my $e = $@ ) {
  172             push @errors, $e;
  173             next;
  174         }
  175 
  176         return $dclass
  177           if UNIVERSAL::can( $dclass, 'can_handle' )
  178               && UNIVERSAL::can( $dclass, 'make_iterator' );
  179         push @errors,
  180           "handler '$dclass' does not implement can_handle & make_iterator";
  181     }
  182 
  183     $self->_croak(
  184         "Cannot load handler '$handler': " . join( "\n", @errors ) );
  185 }
  186 
  187 ##############################################################################
  188 
  189 =head3 C<make_iterator>
  190 
  191   my $iterator = $src_factory->make_iterator( $source );
  192 
  193 Given a L<TAP::Parser::Source>, finds the most suitable L<TAP::Parser::SourceHandler>
  194 to use to create a L<TAP::Parser::Iterator> (see L</detect_source>).  Dies on error.
  195 
  196 =cut
  197 
  198 sub make_iterator {
  199     my ( $self, $source ) = @_;
  200 
  201     $self->_croak('no raw source defined!') unless defined $source->raw;
  202 
  203     $source->config( $self->config )->assemble_meta;
  204 
  205     # is the raw source already an object?
  206     return $source->raw
  207       if ( $source->meta->{is_object}
  208         && UNIVERSAL::isa( $source->raw, 'TAP::Parser::SourceHandler' ) );
  209 
  210     # figure out what kind of source it is
  211     my $sd_class = $self->detect_source($source);
  212     $self->_last_handler($sd_class);
  213 
  214     return if $self->_testing;
  215 
  216     # create it
  217     my $iterator = $sd_class->make_iterator($source);
  218 
  219     return $iterator;
  220 }
  221 
  222 =head3 C<detect_source>
  223 
  224 Given a L<TAP::Parser::Source>, detects what kind of source it is and
  225 returns I<one> L<TAP::Parser::SourceHandler> (the most confident one).  Dies
  226 on error.
  227 
  228 The detection algorithm works something like this:
  229 
  230   for (@registered_handlers) {
  231     # ask them how confident they are about handling this source
  232     $confidence{$handler} = $handler->can_handle( $source )
  233   }
  234   # choose the most confident handler
  235 
  236 Ties are handled by choosing the first handler.
  237 
  238 =cut
  239 
  240 sub detect_source {
  241     my ( $self, $source ) = @_;
  242 
  243     confess('no raw source ref defined!') unless defined $source->raw;
  244 
  245     # find a list of handlers that can handle this source:
  246     my %confidence_for;
  247     for my $handler ( @{ $self->handlers } ) {
  248         my $confidence = $handler->can_handle($source);
  249         # warn "handler: $handler: $confidence\n";
  250         $confidence_for{$handler} = $confidence if $confidence;
  251     }
  252 
  253     if ( !%confidence_for ) {
  254         # error: can't detect source
  255         my $raw_source_short = substr( ${ $source->raw }, 0, 50 );
  256         confess("Cannot detect source of '$raw_source_short'!");
  257         return;
  258     }
  259 
  260     # if multiple handlers can handle it, choose the most confident one
  261     my @handlers =
  262           sort { $confidence_for{$b} <=> $confidence_for{$a} }
  263           keys %confidence_for;
  264 
  265     # Check for a tie.
  266     if( @handlers > 1 &&
  267         $confidence_for{$handlers[0]} == $confidence_for{$handlers[1]}
  268     ) {
  269         my $filename = $source->meta->{file}{basename};
  270         die("There is a tie between $handlers[0] and $handlers[1].\n".
  271             "Both voted $confidence_for{$handlers[0]} on $filename.\n");
  272     }
  273 
  274     # this is really useful for debugging handlers:
  275     if ( $ENV{TAP_HARNESS_SOURCE_FACTORY_VOTES} ) {
  276         warn(
  277             "votes: ",
  278             join( ', ', map {"$_: $confidence_for{$_}"} @handlers ),
  279             "\n"
  280         );
  281     }
  282 
  283     # return 1st
  284     return $handlers[0];
  285 }
  286 
  287 1;
  288 
  289 __END__
  290 
  291 =head1 SUBCLASSING
  292 
  293 Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
  294 
  295 =head2 Example
  296 
  297 If we've done things right, you'll probably want to write a new source,
  298 rather than sub-classing this (see L<TAP::Parser::SourceHandler> for that).
  299 
  300 But in case you find the need to...
  301 
  302   package MyIteratorFactory;
  303 
  304   use strict;
  305 
  306   use base 'TAP::Parser::IteratorFactory';
  307 
  308   # override source detection algorithm
  309   sub detect_source {
  310     my ($self, $raw_source_ref, $meta) = @_;
  311     # do detective work, using $meta and whatever else...
  312   }
  313 
  314   1;
  315 
  316 =head1 AUTHORS
  317 
  318 Steve Purkis
  319 
  320 =head1 ATTRIBUTION
  321 
  322 Originally ripped off from L<Test::Harness>.
  323 
  324 Moved out of L<TAP::Parser> & converted to a factory class to support
  325 extensible TAP source detective work by Steve Purkis.
  326 
  327 =head1 SEE ALSO
  328 
  329 L<TAP::Object>,
  330 L<TAP::Parser>,
  331 L<TAP::Parser::SourceHandler>,
  332 L<TAP::Parser::SourceHandler::File>,
  333 L<TAP::Parser::SourceHandler::Perl>,
  334 L<TAP::Parser::SourceHandler::RawTAP>,
  335 L<TAP::Parser::SourceHandler::Handle>,
  336 L<TAP::Parser::SourceHandler::Executable>
  337 
  338 =cut
  339