Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DateTime/Format/Builder/Parser.pm |
Statements | Executed 322 statements in 2.84ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 413µs | 523µs | BEGIN@626 | DateTime::Format::Builder::Parser::
7 | 1 | 1 | 260µs | 1.31ms | create_single_parser | DateTime::Format::Builder::Parser::
4 | 4 | 4 | 74µs | 74µs | valid_params | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 51µs | 1.36ms | sort_parsers | DateTime::Format::Builder::Parser::
7 | 1 | 1 | 38µs | 38µs | params | DateTime::Format::Builder::Parser::
7 | 1 | 1 | 33µs | 33µs | params_all | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 31µs | 1.41ms | create_multiple_parsers | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 27µs | 65µs | BEGIN@5 | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 14µs | 16µs | BEGIN@2 | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 13µs | 13µs | new | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 13µs | 1.43ms | create_parser | DateTime::Format::Builder::Parser::
7 | 1 | 1 | 12µs | 12µs | whose_params | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 11µs | 30µs | BEGIN@8 | DateTime::Format::Builder::Parser::
2 | 1 | 1 | 9µs | 9µs | merge_callbacks | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 7µs | 23µs | BEGIN@3 | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 7µs | 30µs | BEGIN@4 | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 4µs | 4µs | set_maker | DateTime::Format::Builder::Parser::
1 | 1 | 1 | 3µs | 3µs | set_parser | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | __ANON__[:170] | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | __ANON__[:171] | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | __ANON__[:374] | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | __ANON__[:455] | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | __ANON__[:542] | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | chain_parsers | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | create_single_object | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | fail | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | maker | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | no_parser | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | on_fail | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | parse | DateTime::Format::Builder::Parser::
0 | 0 | 0 | 0s | 0s | set_fail | DateTime::Format::Builder::Parser::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package DateTime::Format::Builder::Parser; | ||||
2 | 3 | 22µs | 2 | 19µs | # spent 16µs (14+2) within DateTime::Format::Builder::Parser::BEGIN@2 which was called:
# once (14µs+2µs) by DateTime::Format::SQLite::BEGIN@16 at line 2 # spent 16µs making 1 call to DateTime::Format::Builder::Parser::BEGIN@2
# spent 2µs making 1 call to strict::import |
3 | 3 | 24µs | 2 | 40µs | # spent 23µs (7+17) within DateTime::Format::Builder::Parser::BEGIN@3 which was called:
# once (7µs+17µs) by DateTime::Format::SQLite::BEGIN@16 at line 3 # spent 23µs making 1 call to DateTime::Format::Builder::Parser::BEGIN@3
# spent 17µs making 1 call to vars::import |
4 | 3 | 24µs | 2 | 54µs | # spent 30µs (7+24) within DateTime::Format::Builder::Parser::BEGIN@4 which was called:
# once (7µs+24µs) by DateTime::Format::SQLite::BEGIN@16 at line 4 # spent 30µs making 1 call to DateTime::Format::Builder::Parser::BEGIN@4
# spent 24µs making 1 call to Exporter::import |
5 | 1 | 38µs | # spent 65µs (27+38) within DateTime::Format::Builder::Parser::BEGIN@5 which was called:
# once (27µs+38µs) by DateTime::Format::SQLite::BEGIN@16 at line 7 # spent 38µs making 1 call to Exporter::import | ||
6 | validate SCALAR CODEREF UNDEF ARRAYREF | ||||
7 | 3 | 21µs | 1 | 65µs | ); # spent 65µs making 1 call to DateTime::Format::Builder::Parser::BEGIN@5 |
8 | 3 | 1.39ms | 2 | 49µs | # spent 30µs (11+19) within DateTime::Format::Builder::Parser::BEGIN@8 which was called:
# once (11µs+19µs) by DateTime::Format::SQLite::BEGIN@16 at line 8 # spent 30µs making 1 call to DateTime::Format::Builder::Parser::BEGIN@8
# spent 19µs making 1 call to Exporter::import |
9 | |||||
10 | =head1 NAME | ||||
11 | |||||
12 | DateTime::Format::Builder::Parser - Parser creation | ||||
13 | |||||
14 | =head1 SYNOPSIS | ||||
15 | |||||
16 | my $class = 'DateTime::Format::Builder::Parser'; | ||||
17 | my $parser = $class->create_single_parser( %specs ); | ||||
18 | |||||
19 | =head1 DESCRIPTION | ||||
20 | |||||
21 | This is a utility class for L<DateTime::Format::Builder> that | ||||
22 | handles creation of parsers. It is to here that C<Builder> delegates | ||||
23 | most of its responsibilities. | ||||
24 | |||||
25 | =cut | ||||
26 | |||||
27 | 1 | 800ns | $VERSION = '0.77'; | ||
28 | |||||
29 | =head1 CONSTRUCTORS | ||||
30 | |||||
31 | =cut | ||||
32 | |||||
33 | sub on_fail | ||||
34 | { | ||||
35 | my ($self, $input, $parent) = @_; | ||||
36 | my $maker = $self->maker; | ||||
37 | if ( $maker and $maker->can( 'on_fail' ) ) { | ||||
38 | $maker->on_fail( $input ); | ||||
39 | } else { | ||||
40 | croak __PACKAGE__.": Invalid date format: $input"; | ||||
41 | } | ||||
42 | } | ||||
43 | |||||
44 | sub no_parser | ||||
45 | { | ||||
46 | croak "No parser set for this parser object."; | ||||
47 | } | ||||
48 | |||||
49 | sub new | ||||
50 | # spent 13µs within DateTime::Format::Builder::Parser::new which was called:
# once (13µs+0s) by DateTime::Format::Builder::Parser::create_multiple_parsers at line 394 | ||||
51 | 5 | 16µs | my $class = shift; | ||
52 | $class = ref($class)||$class; | ||||
53 | my $i = 0; | ||||
54 | my $self = bless { | ||||
55 | on_fail => \&on_fail, | ||||
56 | parser => \&no_parser, | ||||
57 | }, $class; | ||||
58 | |||||
59 | return $self; | ||||
60 | } | ||||
61 | |||||
62 | sub maker { $_[0]->{maker} } | ||||
63 | |||||
64 | sub set_maker | ||||
65 | # spent 4µs within DateTime::Format::Builder::Parser::set_maker which was called:
# once (4µs+0s) by DateTime::Format::Builder::Parser::create_multiple_parsers at line 408 | ||||
66 | 5 | 6µs | my $self = shift; | ||
67 | my $maker = shift; | ||||
68 | |||||
69 | $self->{maker} = $maker; | ||||
70 | weaken $self->{maker} | ||||
71 | if ref $self->{maker}; | ||||
72 | |||||
73 | return $self; | ||||
74 | } | ||||
75 | |||||
76 | sub fail | ||||
77 | { | ||||
78 | my ($self, $parent, $input) = @_; | ||||
79 | $self->{on_fail}->( $self, $input, $parent ); | ||||
80 | } | ||||
81 | |||||
82 | sub parse | ||||
83 | { | ||||
84 | my ( $self, $parent, $input, @args ) = @_; | ||||
85 | my $r = $self->{parser}->( $parent, $input, @args ); | ||||
86 | $self->fail( $parent, $input ) unless defined $r; | ||||
87 | $r; | ||||
88 | } | ||||
89 | |||||
90 | sub set_parser | ||||
91 | # spent 3µs within DateTime::Format::Builder::Parser::set_parser which was called:
# once (3µs+0s) by DateTime::Format::Builder::Parser::create_multiple_parsers at line 456 | ||||
92 | 3 | 5µs | my ($self, $parser) = @_; | ||
93 | $self->{parser} = $parser; | ||||
94 | $self; | ||||
95 | } | ||||
96 | |||||
97 | sub set_fail | ||||
98 | { | ||||
99 | my ($self, $fail) = @_; | ||||
100 | $self->{on_fail} = $fail; | ||||
101 | $self; | ||||
102 | } | ||||
103 | |||||
104 | =head1 METHODS | ||||
105 | |||||
106 | There are two sorts of methods in this class. Those used by | ||||
107 | parser implementations and those used by C<Builder>. It is | ||||
108 | generally unlikely the user will want to use any of them. | ||||
109 | |||||
110 | They are presented, grouped according to use. | ||||
111 | |||||
112 | =head2 Parameter Handling (implementations) | ||||
113 | |||||
114 | These methods allow implementations to have validation of | ||||
115 | their arguments in a standard manner and due to C<Parser>'s | ||||
116 | impelementation, these methods also allow C<Parser> to | ||||
117 | determine which implementation to use. | ||||
118 | |||||
119 | =cut | ||||
120 | |||||
121 | 1 | 1µs | my @callbacks = qw( on_match on_fail postprocess preprocess ); | ||
122 | |||||
123 | { | ||||
124 | |||||
125 | 1 | 400ns | =head3 Common parameters | ||
126 | |||||
127 | These parameters appear for all parser implementations. | ||||
128 | These are primarily documented in | ||||
129 | L<the main docs|DateTime::Format::Builder/"SINGLE SPECIFICATIONS">. | ||||
130 | |||||
131 | =over 4 | ||||
132 | |||||
133 | =item * | ||||
134 | |||||
135 | B<on_match> | ||||
136 | |||||
137 | =item * | ||||
138 | |||||
139 | B<on_fail> | ||||
140 | |||||
141 | =item * | ||||
142 | |||||
143 | B<postprocess> | ||||
144 | |||||
145 | =item * | ||||
146 | |||||
147 | B<preprocess> | ||||
148 | |||||
149 | =item * | ||||
150 | |||||
151 | B<label> | ||||
152 | |||||
153 | =item * | ||||
154 | |||||
155 | B<length> may be a number or an arrayref of numbers | ||||
156 | indicating the length of the input. This lets us optimise in | ||||
157 | the case of static length input. If supplying an arrayref of | ||||
158 | numbers, please keep the number of numbers to a minimum. | ||||
159 | |||||
160 | =back | ||||
161 | |||||
162 | =cut | ||||
163 | |||||
164 | my %params = ( | ||||
165 | common => { | ||||
166 | length => { | ||||
167 | type => SCALAR|ARRAYREF, | ||||
168 | optional => 1, | ||||
169 | callbacks => { | ||||
170 | 'is an int' => sub { ref $_[0] ? 1 : $_[0] !~ /\D/ }, | ||||
171 | 'not empty' => sub { ref $_[0] ? @{$_[0]} >= 1 : 1 }, | ||||
172 | } | ||||
173 | }, | ||||
174 | |||||
175 | # Stuff used by callbacks | ||||
176 | label => { type => SCALAR, optional => 1 }, | ||||
177 | 3 | 18µs | ( map { $_ => { type => CODEREF|ARRAYREF, optional => 1 } } @callbacks ), | ||
178 | }, | ||||
179 | ); | ||||
180 | |||||
181 | =head3 params | ||||
182 | |||||
183 | my $params = $self->params(); | ||||
184 | validate( @_, $params ); | ||||
185 | |||||
186 | Returns declared parameters and C<common> parameters in a hashref | ||||
187 | suitable for handing to L<Params::Validate>'s C<validate> function. | ||||
188 | |||||
189 | =cut | ||||
190 | |||||
191 | sub params | ||||
192 | # spent 38µs within DateTime::Format::Builder::Parser::params which was called 7 times, avg 5µs/call:
# 7 times (38µs+0s) by DateTime::Format::Builder::Parser::create_single_parser at line 333, avg 5µs/call | ||||
193 | 21 | 46µs | my $self = shift; | ||
194 | my $caller = ref $self || $self; | ||||
195 | return { map { %$_ } @params{ $caller, 'common' } } | ||||
196 | } | ||||
197 | |||||
198 | =head3 params_all | ||||
199 | |||||
200 | my $all_params = $self->params_all(); | ||||
201 | |||||
202 | Returns a hash of all the valid options. Not recommended | ||||
203 | for general use. | ||||
204 | |||||
205 | =cut | ||||
206 | |||||
207 | my $all_params; | ||||
208 | sub params_all | ||||
209 | # spent 33µs within DateTime::Format::Builder::Parser::params_all which was called 7 times, avg 5µs/call:
# 7 times (33µs+0s) by DateTime::Format::Builder::Parser::create_single_parser at line 311, avg 5µs/call | ||||
210 | 11 | 41µs | return $all_params if defined $all_params; | ||
211 | my %all_params = map { %$_ } values %params; | ||||
212 | $_->{optional} = 1 for values %all_params; | ||||
213 | $all_params = \%all_params; | ||||
214 | } | ||||
215 | |||||
216 | =head3 valid_params | ||||
217 | |||||
218 | __PACKAGE__->valid_params( %params ); | ||||
219 | |||||
220 | Arguments are as per L<Params::Validate>'s C<validate> function. | ||||
221 | This method is used to declare what your valid arguments are in | ||||
222 | a parser specification. | ||||
223 | |||||
224 | =cut | ||||
225 | |||||
226 | my %inverse; | ||||
227 | sub valid_params | ||||
228 | # spent 74µs within DateTime::Format::Builder::Parser::valid_params which was called 4 times, avg 18µs/call:
# once (37µs+0s) by DateTime::Format::Builder::Parser::BEGIN@1.41 at line 35 of DateTime/Format/Builder/Parser/Strptime.pm
# once (13µs+0s) by DateTime::Format::Builder::Parser::BEGIN@1.39 at line 71 of DateTime/Format/Builder/Parser/Quick.pm
# once (13µs+0s) by DateTime::Format::Builder::Parser::BEGIN@1.40 at line 101 of DateTime/Format/Builder/Parser/Regex.pm
# once (10µs+0s) by DateTime::Format::Builder::Parser::BEGIN@1 at line 84 of DateTime/Format/Builder/Parser/Dispatch.pm | ||||
229 | 28 | 76µs | my $self = shift; | ||
230 | my $from = (caller)[0]; | ||||
231 | my %args = @_; | ||||
232 | $params{ $from } = \%args; | ||||
233 | for (keys %args) | ||||
234 | { | ||||
235 | # %inverse contains keys matching all the | ||||
236 | # possible params; values are the class if and | ||||
237 | # only if that class is the only one that uses | ||||
238 | # the given param. | ||||
239 | 8 | 12µs | $inverse{$_} = exists $inverse{$_} ? undef : $from; | ||
240 | } | ||||
241 | undef $all_params; | ||||
242 | 1; | ||||
243 | } | ||||
244 | |||||
245 | =head3 whose_params | ||||
246 | |||||
247 | my $class = whose_params( $key ); | ||||
248 | |||||
249 | Internal function which merely returns to which class a | ||||
250 | parameter is unique. If not unique, returns C<undef>. | ||||
251 | |||||
252 | =cut | ||||
253 | |||||
254 | sub whose_params | ||||
255 | # spent 12µs within DateTime::Format::Builder::Parser::whose_params which was called 7 times, avg 2µs/call:
# 7 times (12µs+0s) by DateTime::Format::Builder::Parser::create_single_parser at line 323, avg 2µs/call | ||||
256 | 14 | 21µs | my $param = shift; | ||
257 | return $inverse{$param}; | ||||
258 | } | ||||
259 | } | ||||
260 | |||||
261 | =head2 Organising and Creating Parsers | ||||
262 | |||||
263 | =head3 create_single_parser | ||||
264 | |||||
265 | This takes a single specification and returns a coderef that | ||||
266 | is a parser that suits that specification. This is the end | ||||
267 | of the line for all the parser creation methods. It | ||||
268 | delegates no further. | ||||
269 | |||||
270 | If a coderef is specified, then that coderef is immediately | ||||
271 | returned (it is assumed to be appropriate). | ||||
272 | |||||
273 | The single specification (if not a coderef) can be either a | ||||
274 | hashref or a hash. The keys and values must be as per the | ||||
275 | L<specification|/"SINGLE SPECIFICATIONS">. | ||||
276 | |||||
277 | It is here that any arrays of callbacks are unified. It is | ||||
278 | also here that any parser implementations are used. With | ||||
279 | the spec that's given, the keys are looked at and whichever | ||||
280 | module is the first to have a unique key in the spec is the | ||||
281 | one to whom the spec is given. | ||||
282 | |||||
283 | B<Note>: please declare a C<valid_params> argument with an | ||||
284 | uppercase letter. For example, if you're writing | ||||
285 | C<DateTime::Format::Builder::Parser::Fnord>, declare a | ||||
286 | parameter called C<Fnord>. Similarly, C<DTFBP::Strptime> | ||||
287 | should have C<Strptime> and C<DTFBP::Regex> should have | ||||
288 | C<Regex>. These latter two don't for backwards compatibility | ||||
289 | reasons. | ||||
290 | |||||
291 | The returned parser will return either a C<DateTime> object | ||||
292 | or C<undef>. | ||||
293 | |||||
294 | =cut | ||||
295 | |||||
296 | sub create_single_object | ||||
297 | { | ||||
298 | my ( $self ) = shift; | ||||
299 | my $obj = $self->new; | ||||
300 | my $parser = $self->create_single_parser( @_ ); | ||||
301 | |||||
302 | $obj->set_parser( $parser ); | ||||
303 | } | ||||
304 | |||||
305 | sub create_single_parser | ||||
306 | # spent 1.31ms (260µs+1.05) within DateTime::Format::Builder::Parser::create_single_parser which was called 7 times, avg 187µs/call:
# 7 times (260µs+1.05ms) by DateTime::Format::Builder::Parser::sort_parsers at line 512, avg 187µs/call | ||||
307 | 84 | 303µs | my $class = shift; | ||
308 | return $_[0] if ref $_[0] eq 'CODE'; # already code | ||||
309 | @_ = %{ $_[0] } if ref $_[0] eq 'HASH'; # turn hashref into hash | ||||
310 | # ordinary boring sort | ||||
311 | 1 | 193µs | 23 | 338µs | my %args = validate( @_, params_all() ); # spent 288µs making 7 calls to Params::Validate::XS::validate, avg 41µs/call
# spent 33µs making 7 calls to DateTime::Format::Builder::Parser::params_all, avg 5µs/call
# spent 12µs making 7 calls to DateTime::Format::Builder::Parser::Regex::__ANON__[DateTime/Format/Builder/Parser/Regex.pm:84], avg 2µs/call
# spent 4µs making 2 calls to DateTime::Format::Builder::Parser::Regex::__ANON__[DateTime/Format/Builder/Parser/Regex.pm:98], avg 2µs/call # spent 14µs executing statements in 7 string evals (merged) |
312 | |||||
313 | # Determine variables for ease of reference. | ||||
314 | for (@callbacks) | ||||
315 | { | ||||
316 | 28 | 19µs | 2 | 9µs | $args{$_} = $class->merge_callbacks( $args{$_} ) if $args{$_}; # spent 9µs making 2 calls to DateTime::Format::Builder::Parser::merge_callbacks, avg 5µs/call |
317 | } | ||||
318 | |||||
319 | # Determine parser class | ||||
320 | my $from; | ||||
321 | for ( keys %args ) | ||||
322 | { | ||||
323 | 21 | 15µs | 7 | 12µs | $from = whose_params( $_ ); # spent 12µs making 7 calls to DateTime::Format::Builder::Parser::whose_params, avg 2µs/call |
324 | next if (not defined $from) or ($from eq 'common'); | ||||
325 | last; | ||||
326 | } | ||||
327 | croak "Could not identify a parsing module to use." unless $from; | ||||
328 | |||||
329 | # Find and call parser creation method | ||||
330 | 7 | 15µs | my $method = $from->can( "create_parser" ) # spent 15µs making 7 calls to UNIVERSAL::can, avg 2µs/call | ||
331 | or croak "Can't create a $_ parser (no appropriate create_parser method)"; | ||||
332 | my @args = %args; | ||||
333 | 1 | 173µs | 23 | 303µs | %args = validate( @args, $from->params() ); # spent 252µs making 7 calls to Params::Validate::XS::validate, avg 36µs/call
# spent 38µs making 7 calls to DateTime::Format::Builder::Parser::params, avg 5µs/call
# spent 11µs making 7 calls to DateTime::Format::Builder::Parser::Regex::__ANON__[DateTime/Format/Builder/Parser/Regex.pm:84], avg 2µs/call
# spent 3µs making 2 calls to DateTime::Format::Builder::Parser::Regex::__ANON__[DateTime/Format/Builder/Parser/Regex.pm:98], avg 1µs/call # spent 13µs executing statements in 7 string evals (merged) |
334 | 7 | 404µs | $from->$method( %args ); # spent 404µs making 7 calls to DateTime::Format::Builder::Parser::Regex::create_parser, avg 58µs/call | ||
335 | } | ||||
336 | |||||
337 | =head3 merge_callbacks | ||||
338 | |||||
339 | Produce either undef or a single coderef from either undef, | ||||
340 | an empty array, a single coderef or an array of coderefs | ||||
341 | |||||
342 | =cut | ||||
343 | |||||
344 | sub merge_callbacks | ||||
345 | # spent 9µs within DateTime::Format::Builder::Parser::merge_callbacks which was called 2 times, avg 5µs/call:
# 2 times (9µs+0s) by DateTime::Format::Builder::Parser::create_single_parser at line 316, avg 5µs/call | ||||
346 | 10 | 5µs | my $self = shift; | ||
347 | |||||
348 | return unless @_; # No arguments | ||||
349 | return unless $_[0]; # Irrelevant argument | ||||
350 | my @callbacks = @_; | ||||
351 | 2 | 7µs | if (@_ == 1) | ||
352 | { | ||||
353 | return $_[0] if ref $_[0] eq 'CODE'; | ||||
354 | @callbacks = @{ $_[0] } if ref $_[0] eq 'ARRAY'; | ||||
355 | } | ||||
356 | return unless @callbacks; | ||||
357 | |||||
358 | for (@callbacks) | ||||
359 | { | ||||
360 | croak "All callbacks must be coderefs!" unless ref $_ eq 'CODE'; | ||||
361 | } | ||||
362 | |||||
363 | return sub { | ||||
364 | my $rv; | ||||
365 | my %args = @_; | ||||
366 | for my $cb (@callbacks) | ||||
367 | { | ||||
368 | $rv = $cb->( %args ); | ||||
369 | return $rv unless $rv; | ||||
370 | # Ugh. Symbiotic. All but postprocessor return the date. | ||||
371 | $args{input} = $rv unless $args{parsed}; | ||||
372 | } | ||||
373 | $rv; | ||||
374 | }; | ||||
375 | } | ||||
376 | |||||
377 | =head2 create_multiple_parsers | ||||
378 | |||||
379 | Given the options block (as made from C<create_parser()>) | ||||
380 | and a list of single parser specifications, this returns a | ||||
381 | coderef that returns either the resultant C<DateTime> object | ||||
382 | or C<undef>. | ||||
383 | |||||
384 | It first sorts the specifications using C<sort_parsers()> | ||||
385 | and then creates the function based on what that returned. | ||||
386 | |||||
387 | =cut | ||||
388 | |||||
389 | sub create_multiple_parsers | ||||
390 | # spent 1.41ms (31µs+1.38) within DateTime::Format::Builder::Parser::create_multiple_parsers which was called:
# once (31µs+1.38ms) by DateTime::Format::Builder::Parser::create_parser at line 600 | ||||
391 | 10 | 24µs | my $class = shift; | ||
392 | my ($options, @specs) = @_; | ||||
393 | |||||
394 | 1 | 13µs | my $obj = $class->new; # spent 13µs making 1 call to DateTime::Format::Builder::Parser::new | ||
395 | |||||
396 | # Organise the specs, and transform them into parsers. | ||||
397 | 1 | 1.36ms | my ($lengths, $others) = $class->sort_parsers( $options, \@specs ); # spent 1.36ms making 1 call to DateTime::Format::Builder::Parser::sort_parsers | ||
398 | |||||
399 | # Merge callbacks if any. | ||||
400 | for ( 'preprocess' ) { | ||||
401 | 1 | 1µs | $options->{$_} = $class->merge_callbacks( | ||
402 | $options->{$_} | ||||
403 | ) if $options->{$_}; | ||||
404 | } | ||||
405 | # Custom fail method? | ||||
406 | $obj->set_fail( $options->{on_fail} ) if exists $options->{on_fail}; | ||||
407 | # Who's our maker? | ||||
408 | 1 | 4µs | $obj->set_maker( $options->{maker} ) if exists $options->{maker}; # spent 4µs making 1 call to DateTime::Format::Builder::Parser::set_maker | ||
409 | |||||
410 | # We don't want to save the whole options hash as a closure, since | ||||
411 | # that can cause a circular reference when $options->{maker} is | ||||
412 | # set. | ||||
413 | my $preprocess = $options->{preprocess}; | ||||
414 | |||||
415 | # These are the innards of a multi-parser. | ||||
416 | my $parser = sub { | ||||
417 | my ($self, $date, @args) = @_; | ||||
418 | return unless defined $date; | ||||
419 | |||||
420 | # Parameters common to the callbacks. Pre-prepared. | ||||
421 | my %param = ( | ||||
422 | self => $self, | ||||
423 | ( @args ? (args => \@args) : () ), | ||||
424 | ); | ||||
425 | |||||
426 | my %p; | ||||
427 | # Preprocess and potentially fill %p | ||||
428 | if ($preprocess) | ||||
429 | { | ||||
430 | $date = $preprocess->( | ||||
431 | input => $date, parsed => \%p, %param | ||||
432 | ); | ||||
433 | } | ||||
434 | |||||
435 | # Find length parser | ||||
436 | if (%$lengths) | ||||
437 | { | ||||
438 | my $length = length $date; | ||||
439 | my $parser = $lengths->{$length}; | ||||
440 | if ($parser) | ||||
441 | { | ||||
442 | # Found one, call it with _copy_ of %p | ||||
443 | my $dt = $parser->( $self, $date, { %p }, @args ); | ||||
444 | return $dt if defined $dt; | ||||
445 | } | ||||
446 | } | ||||
447 | # Or calls all others, with _copy_ of %p | ||||
448 | for my $parser (@$others) | ||||
449 | { | ||||
450 | my $dt = $parser->( $self, $date, { %p }, @args ); | ||||
451 | return $dt if defined $dt; | ||||
452 | } | ||||
453 | # Failed, return undef. | ||||
454 | return; | ||||
455 | }; | ||||
456 | 1 | 3µs | $obj->set_parser( $parser ); # spent 3µs making 1 call to DateTime::Format::Builder::Parser::set_parser | ||
457 | } | ||||
458 | |||||
459 | =head2 sort_parsers | ||||
460 | |||||
461 | This takes the list of specifications and sorts them while | ||||
462 | turning the specifications into parsers. It returns two | ||||
463 | values: the first is a hashref containing all the length | ||||
464 | based parsers. The second is an array containing all the | ||||
465 | other parsers. | ||||
466 | |||||
467 | If any of the specs are not code or hash references, then it | ||||
468 | will call C<croak()>. | ||||
469 | |||||
470 | Code references are put directly into the 'other' array. Any | ||||
471 | hash references without I<length> keys are run through | ||||
472 | C<create_single_parser()> and the resultant parser is placed | ||||
473 | in the 'other' array. | ||||
474 | |||||
475 | Hash references B<with> I<length> keys are run through | ||||
476 | C<create_single_parser()>, but the resultant parser is used | ||||
477 | as the value in the length hashref with the length being the | ||||
478 | key. If two or more parsers have the same I<length> | ||||
479 | specified then an error is thrown. | ||||
480 | |||||
481 | =cut | ||||
482 | |||||
483 | sub sort_parsers | ||||
484 | # spent 1.36ms (51µs+1.31) within DateTime::Format::Builder::Parser::sort_parsers which was called:
# once (51µs+1.31ms) by DateTime::Format::Builder::Parser::create_multiple_parsers at line 397 | ||||
485 | 6 | 9µs | my $class = shift; | ||
486 | my ($options, $specs) = @_; | ||||
487 | my (%lengths, @others); | ||||
488 | |||||
489 | for my $spec (@$specs) | ||||
490 | { | ||||
491 | # Put coderefs straight into the 'other' heap. | ||||
492 | 14 | 18µs | if (ref $spec eq 'CODE') | ||
493 | { | ||||
494 | push @others, $spec; | ||||
495 | } | ||||
496 | # Specifications... | ||||
497 | elsif (ref $spec eq 'HASH') | ||||
498 | { | ||||
499 | 7 | 20µs | if (exists $spec->{length}) | ||
500 | { | ||||
501 | my $code = $class->create_single_parser( %$spec ); | ||||
502 | my @lengths = ref $spec->{length} | ||||
503 | ? @{ $spec->{length} } | ||||
504 | : ( $spec->{length} ); | ||||
505 | for my $length ( @lengths ) | ||||
506 | { | ||||
507 | push @{ $lengths{$length} }, $code; | ||||
508 | } | ||||
509 | } | ||||
510 | else | ||||
511 | { | ||||
512 | 7 | 1.31ms | push @others, $class->create_single_parser( %$spec ); # spent 1.31ms making 7 calls to DateTime::Format::Builder::Parser::create_single_parser, avg 187µs/call | ||
513 | } | ||||
514 | } | ||||
515 | # Something else | ||||
516 | else | ||||
517 | { | ||||
518 | croak "Invalid specification in list."; | ||||
519 | } | ||||
520 | } | ||||
521 | |||||
522 | while (my ($length, $parsers) = each %lengths) | ||||
523 | { | ||||
524 | $lengths{$length} = $class->chain_parsers( $parsers ); | ||||
525 | } | ||||
526 | |||||
527 | return ( \%lengths, \@others ); | ||||
528 | } | ||||
529 | |||||
530 | sub chain_parsers | ||||
531 | { | ||||
532 | my ($self, $parsers) = @_; | ||||
533 | return $parsers->[0] if @$parsers == 1; | ||||
534 | return sub { | ||||
535 | my $self = shift; | ||||
536 | for my $parser (@$parsers) | ||||
537 | { | ||||
538 | my $rv = $self->$parser( @_ ); | ||||
539 | return $rv if defined $rv; | ||||
540 | } | ||||
541 | return undef; | ||||
542 | }; | ||||
543 | } | ||||
544 | |||||
545 | =head2 create_parser | ||||
546 | |||||
547 | C<create_class()> is mostly a wrapper around | ||||
548 | C<create_parser()> that does loops and stuff and calls | ||||
549 | C<create_parser()> to create the actual parsers. | ||||
550 | |||||
551 | C<create_parser()> takes the parser specifications (be they | ||||
552 | single specifications or multiple specifications) and | ||||
553 | returns an anonymous coderef that is suitable for use as a | ||||
554 | method. The coderef will call C<croak()> in the event of | ||||
555 | being unable to parse the single string it expects as input. | ||||
556 | |||||
557 | The simplest input is that of a single specification, | ||||
558 | presented just as a plain hash, not a hashref. This is | ||||
559 | passed directly to C<create_single_parser()> with the return | ||||
560 | value from that being wrapped in a function that lets it | ||||
561 | C<croak()> on failure, with that wrapper being returned. | ||||
562 | |||||
563 | If the first argument to C<create_parser()> is an arrayref, | ||||
564 | then that is taken to be an options block (as per the | ||||
565 | multiple parser specification documented earlier). | ||||
566 | |||||
567 | Any further arguments should be either hashrefs or coderefs. | ||||
568 | If the first argument after the optional arrayref is not a | ||||
569 | hashref or coderef then that argument and all remaining | ||||
570 | arguments are passed off to C<create_single_parser()> | ||||
571 | directly. If the first argument is a hashref or coderef, | ||||
572 | then it and the remaining arguments are passed to | ||||
573 | C<create_multiple_parsers()>. | ||||
574 | |||||
575 | The resultant coderef from calling either of the creation | ||||
576 | methods is then wrapped in a function that calls C<croak()> | ||||
577 | in event of failure or the C<DateTime> object in event of | ||||
578 | success. | ||||
579 | |||||
580 | =cut | ||||
581 | |||||
582 | sub create_parser | ||||
583 | # spent 1.43ms (13µs+1.41) within DateTime::Format::Builder::Parser::create_parser which was called:
# once (13µs+1.41ms) by DateTime::Format::Builder::create_parser at line 156 of DateTime/Format/Builder.pm | ||||
584 | 5 | 10µs | my $class = shift; | ||
585 | if (not ref $_[0]) | ||||
586 | { | ||||
587 | # Simple case of single specification as a hash | ||||
588 | return $class->create_single_object( @_ ) | ||||
589 | } | ||||
590 | |||||
591 | # Let's see if we were given an options block | ||||
592 | my %options; | ||||
593 | while ( ref $_[0] eq 'ARRAY' ) | ||||
594 | { | ||||
595 | 2 | 3µs | my $options = shift; | ||
596 | %options = ( %options, @$options ); | ||||
597 | } | ||||
598 | |||||
599 | # Now, can we create a multi-parser out of the remaining arguments? | ||||
600 | 1 | 1.41ms | if (ref $_[0] eq 'HASH' or ref $_[0] eq 'CODE') # spent 1.41ms making 1 call to DateTime::Format::Builder::Parser::create_multiple_parsers | ||
601 | { | ||||
602 | return $class->create_multiple_parsers( \%options, @_ ); | ||||
603 | } | ||||
604 | else | ||||
605 | { | ||||
606 | # If it wasn't a HASH or CODE, then it was (ideally) | ||||
607 | # a list of pairs describing a single specification. | ||||
608 | return $class->create_multiple_parsers( \%options, { @_ } ); | ||||
609 | } | ||||
610 | } | ||||
611 | |||||
612 | =head1 FINDING IMPLEMENTATIONS | ||||
613 | |||||
614 | C<Parser> automatically loads any parser classes in C<@INC>. | ||||
615 | |||||
616 | To be loaded automatically, you must be a | ||||
617 | C<DateTime::Format::Builder::Parser::XXX> module. | ||||
618 | |||||
619 | To be invisible, and not loaded, start your class with a lower class | ||||
620 | letter. These are ignored. | ||||
621 | |||||
622 | =cut | ||||
623 | |||||
624 | # Find all our workers | ||||
625 | { | ||||
626 | 4 | 128µs | 2 | 531µs | # spent 523µs (413+110) within DateTime::Format::Builder::Parser::BEGIN@626 which was called:
# once (413µs+110µs) by DateTime::Format::SQLite::BEGIN@16 at line 626 # spent 523µs making 1 call to DateTime::Format::Builder::Parser::BEGIN@626
# spent 8µs making 1 call to Class::Factory::Util::import |
627 | |||||
628 | 1 | 5µs | 1 | 184µs | foreach my $worker ( __PACKAGE__->subclasses ) # spent 184µs making 1 call to Class::Factory::Util::_subclasses |
629 | { | ||||
630 | 10 | 166µs | eval "use DateTime::Format::Builder::Parser::$worker;"; # spent 90µs executing statements in string eval # includes 1.88ms spent executing 1 call to 1 sub defined therein. # spent 88µs executing statements in string eval # includes 452µs spent executing 1 call to 1 sub defined therein. # spent 77µs executing statements in string eval # includes 342µs spent executing 1 call to 1 sub defined therein. # spent 66µs executing statements in string eval # includes 302µs spent executing 1 call to 1 sub defined therein. # spent 10µs executing statements in string eval # includes 12µs spent executing 1 call to 1 sub defined therein. | ||
631 | die $@ if $@; | ||||
632 | } | ||||
633 | } | ||||
634 | |||||
635 | 1 | 16µs | 1; | ||
636 | |||||
637 | __END__ |