lib/perl5/5.8.8/TAP/Parser/IteratorFactory.pm

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