| 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.28 |
| 22 | |
| 23 | =cut |
| 24 | |
| 25 | $VERSION = '3.28'; |
| 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 | |