| 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 | DateTime::Format::Builder::Parser::BEGIN@626 |
| 7 | 1 | 1 | 260µs | 1.31ms | DateTime::Format::Builder::Parser::create_single_parser |
| 4 | 4 | 4 | 74µs | 74µs | DateTime::Format::Builder::Parser::valid_params |
| 1 | 1 | 1 | 51µs | 1.36ms | DateTime::Format::Builder::Parser::sort_parsers |
| 7 | 1 | 1 | 38µs | 38µs | DateTime::Format::Builder::Parser::params |
| 7 | 1 | 1 | 33µs | 33µs | DateTime::Format::Builder::Parser::params_all |
| 1 | 1 | 1 | 31µs | 1.41ms | DateTime::Format::Builder::Parser::create_multiple_parsers |
| 1 | 1 | 1 | 27µs | 65µs | DateTime::Format::Builder::Parser::BEGIN@5 |
| 1 | 1 | 1 | 14µs | 16µs | DateTime::Format::Builder::Parser::BEGIN@2 |
| 1 | 1 | 1 | 13µs | 13µs | DateTime::Format::Builder::Parser::new |
| 1 | 1 | 1 | 13µs | 1.43ms | DateTime::Format::Builder::Parser::create_parser |
| 7 | 1 | 1 | 12µs | 12µs | DateTime::Format::Builder::Parser::whose_params |
| 1 | 1 | 1 | 11µs | 30µs | DateTime::Format::Builder::Parser::BEGIN@8 |
| 2 | 1 | 1 | 9µs | 9µs | DateTime::Format::Builder::Parser::merge_callbacks |
| 1 | 1 | 1 | 7µs | 23µs | DateTime::Format::Builder::Parser::BEGIN@3 |
| 1 | 1 | 1 | 7µs | 30µs | DateTime::Format::Builder::Parser::BEGIN@4 |
| 1 | 1 | 1 | 4µs | 4µs | DateTime::Format::Builder::Parser::set_maker |
| 1 | 1 | 1 | 3µs | 3µs | DateTime::Format::Builder::Parser::set_parser |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::__ANON__[:170] |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::__ANON__[:171] |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::__ANON__[:374] |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::__ANON__[:455] |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::__ANON__[:542] |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::chain_parsers |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::create_single_object |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::fail |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::maker |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::no_parser |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::on_fail |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::parse |
| 0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::Parser::set_fail |
| 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 | 1 | 15µ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 | 1 | 200ns | 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 | 1 | 2µs | 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 | 36 | 88µ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 | $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 | 133 | 337µ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 | 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 | 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 | 12 | 12µs | my $self = shift; | ||
| 347 | |||||
| 348 | return unless @_; # No arguments | ||||
| 349 | return unless $_[0]; # Irrelevant argument | ||||
| 350 | my @callbacks = @_; | ||||
| 351 | 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 | 11 | 25µ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 | $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 | 27 | 47µ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 | if (ref $spec eq 'CODE') | ||||
| 493 | { | ||||
| 494 | push @others, $spec; | ||||
| 495 | } | ||||
| 496 | # Specifications... | ||||
| 497 | elsif (ref $spec eq 'HASH') | ||||
| 498 | { | ||||
| 499 | 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 | 7 | 13µ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 | 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 | 5 | 162µ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 | 5 | 4µs | die $@ if $@; | ||
| 632 | } | ||||
| 633 | } | ||||
| 634 | |||||
| 635 | 1 | 16µs | 1; | ||
| 636 | |||||
| 637 | __END__ |