File Coverage

blib/lib/TAP/Parser/IteratorFactory.pm
Criterion Covered Total %
statement 86 93 92.4
branch 25 32 78.1
condition 8 14 57.1
subroutine 17 17 100.0
pod 5 5 100.0
total 141 161 87.5


line stmt bran cond sub pod time code
1             package TAP::Parser::IteratorFactory;
2              
3 38     38   811 use strict;
  38         39  
  38         881  
4 38     38   118 use warnings;
  38         36  
  38         856  
5              
6 38     38   130 use Carp qw( confess );
  38         38  
  38         1730  
7 38     38   138 use File::Basename qw( fileparse );
  38         46  
  38         1276  
8              
9 38     38   128 use base 'TAP::Object';
  38         50  
  38         2150  
10              
11 38     38   140 use constant handlers => [];
  38         45  
  38         28453  
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.38
20              
21             =cut
22              
23             our $VERSION = '3.38';
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 and runs it through all the
34             registered Ls to see which one should handle the source.
35              
36             If you're a plugin author, you'll be interested in how to Ls,
37             how L works.
38              
39             =head1 METHODS
40              
41             =head2 Class Methods
42              
43             =head3 C
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 and calls L.
50              
51             =cut
52              
53             sub _initialize {
54 304     304   514 my ( $self, $config ) = @_;
55 304   100     1992 $self->config( $config || {} )->load_handlers;
56 304         752 return $self;
57             }
58              
59             =head3 C
60              
61             Registers a new L with this factory.
62              
63             __PACKAGE__->register_handler( $handler_class );
64              
65             =head3 C
66              
67             List of handlers that have been registered.
68              
69             =cut
70              
71             sub register_handler {
72 179     179 1 1382 my ( $class, $dclass ) = @_;
73              
74 179 50 33     1750 confess("$dclass must implement can_handle & make_iterator methods!")
75             unless UNIVERSAL::can( $dclass, 'can_handle' )
76             && UNIVERSAL::can( $dclass, 'make_iterator' );
77              
78 179         621 my $handlers = $class->handlers;
79 179         301 push @{$handlers}, $dclass
80 179 50       175 unless grep { $_ eq $dclass } @{$handlers};
  356         670  
  179         400  
81              
82 179         383 return $class;
83             }
84              
85             ##############################################################################
86              
87             =head2 Instance Methods
88              
89             =head3 C
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 914     914 1 3193 my $self = shift;
107 914 100       2908 return $self->{config} unless @_;
108 306 100       1079 unless ( 'HASH' eq ref $_[0] ) {
109 1         9 $self->_croak('Argument to &config must be a hash reference');
110             }
111 305         652 $self->{config} = shift;
112 305         1069 return $self;
113             }
114              
115             sub _last_handler {
116 313     313   3390 my $self = shift;
117 313 100       709 return $self->{last_handler} unless @_;
118 302         557 $self->{last_handler} = shift;
119 302         355 return $self;
120             }
121              
122             sub _testing {
123 313     313   366 my $self = shift;
124 313 100       1172 return $self->{testing} unless @_;
125 11         9 $self->{testing} = shift;
126 11         14 return $self;
127             }
128              
129             ##############################################################################
130              
131             =head3 C
132              
133             $sf->load_handlers;
134              
135             Loads the handler classes defined in L. For example, given a config:
136              
137             $sf->config({
138             MySourceHandler => { some => 'config' },
139             });
140              
141             C will attempt to load the C class by looking in
142             C<@INC> for it in this order:
143              
144             TAP::Parser::SourceHandler::MySourceHandler
145             MySourceHandler
146              
147             Cs on error.
148              
149             =cut
150              
151             sub load_handlers {
152 304     304 1 388 my ($self) = @_;
153 304         461 for my $handler ( keys %{ $self->config } ) {
  304         552  
154 5         15 my $sclass = $self->_load_handler($handler);
155              
156             # TODO: store which class we loaded anywhere?
157             }
158 304         391 return $self;
159             }
160              
161             sub _load_handler {
162 5     5   6 my ( $self, $handler ) = @_;
163              
164 5         5 my @errors;
165 5         15 for my $dclass ( "TAP::Parser::SourceHandler::$handler", $handler ) {
166 8 100 66     86 return $dclass
167             if UNIVERSAL::can( $dclass, 'can_handle' )
168             && UNIVERSAL::can( $dclass, 'make_iterator' );
169              
170 5     3   296 eval "use $dclass";
  3     2   774  
  0         0  
  0         0  
  2         632  
  2         56  
  2         28  
171 5 100       20 if ( my $e = $@ ) {
172 3         6 push @errors, $e;
173 3         5 next;
174             }
175              
176 2 50 33     23 return $dclass
177             if UNIVERSAL::can( $dclass, 'can_handle' )
178             && UNIVERSAL::can( $dclass, 'make_iterator' );
179 0         0 push @errors,
180             "handler '$dclass' does not implement can_handle & make_iterator";
181             }
182              
183             $self->_croak(
184 0         0 "Cannot load handler '$handler': " . join( "\n", @errors ) );
185             }
186              
187             ##############################################################################
188              
189             =head3 C
190              
191             my $iterator = $src_factory->make_iterator( $source );
192              
193             Given a L, finds the most suitable L
194             to use to create a L (see L). Dies on error.
195              
196             =cut
197              
198             sub make_iterator {
199 304     304 1 460 my ( $self, $source ) = @_;
200              
201 304 50       756 $self->_croak('no raw source defined!') unless defined $source->raw;
202              
203 304         659 $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 304 50 66     853 && UNIVERSAL::isa( $source->raw, 'TAP::Parser::SourceHandler' ) );
209              
210             # figure out what kind of source it is
211 304         994 my $sd_class = $self->detect_source($source);
212 302         729 $self->_last_handler($sd_class);
213              
214 302 100       658 return if $self->_testing;
215              
216             # create it
217 291         1134 my $iterator = $sd_class->make_iterator($source);
218              
219 291         3015 return $iterator;
220             }
221              
222             =head3 C
223              
224             Given a L, detects what kind of source it is and
225             returns I L (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 304     304 1 502 my ( $self, $source ) = @_;
242              
243 304 50       740 confess('no raw source ref defined!') unless defined $source->raw;
244              
245             # find a list of handlers that can handle this source:
246 304         360 my %handlers;
247 304         372 for my $dclass ( @{ $self->handlers } ) {
  304         1341  
248 1529         17231 my $confidence = $dclass->can_handle($source);
249              
250             # warn "handler: $dclass: $confidence\n";
251 1529 100       3808 $handlers{$dclass} = $confidence if $confidence;
252             }
253              
254 304 100       1561 if ( !%handlers ) {
255              
256             # use Data::Dump qw( pp );
257             # warn pp( $meta );
258              
259             # error: can't detect source
260 2         3 my $raw_source_short = substr( ${ $source->raw }, 0, 50 );
  2         4  
261 2         253 confess("Cannot detect source of '$raw_source_short'!");
262 0         0 return;
263             }
264              
265             # if multiple handlers can handle it, choose the most confident one
266             my @handlers = (
267 313         1225 map {$_}
268 302         1033 sort { $handlers{$a} cmp $handlers{$b} }
  11         128  
269             keys %handlers
270             );
271              
272             # this is really useful for debugging handlers:
273 302 50       1014 if ( $ENV{TAP_HARNESS_SOURCE_FACTORY_VOTES} ) {
274             warn(
275             "votes: ",
276 0         0 join( ', ', map {"$_: $handlers{$_}"} @handlers ),
  0         0  
277             "\n"
278             );
279             }
280              
281             # return 1st
282 302         813 return pop @handlers;
283             }
284              
285             1;
286              
287             __END__