Profile of DateTime/Format/Builder.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:38 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DateTime/Format/Builder.pm
Statements | Executed 65 statements in 1.26ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 54µs | 54µs | DateTime::Format::Builder::::BEGIN@11DateTime::Format::Builder::BEGIN@11
1 | 1 | 1 | 53µs | 1.57ms | DateTime::Format::Builder::::create_classDateTime::Format::Builder::create_class
1 | 1 | 1 | 16µs | 16µs | DateTime::Format::Builder::::create_constructorDateTime::Format::Builder::create_constructor
1 | 1 | 1 | 13µs | 1.44ms | DateTime::Format::Builder::::create_parserDateTime::Format::Builder::create_parser
1 | 1 | 1 | 13µs | 15µs | DateTime::Format::Builder::::BEGIN@10DateTime::Format::Builder::BEGIN@10
1 | 1 | 1 | 12µs | 23µs | DateTime::Format::Builder::::BEGIN@13DateTime::Format::Builder::BEGIN@13
1 | 1 | 1 | 11µs | 63µs | DateTime::Format::Builder::::BEGIN@12DateTime::Format::Builder::BEGIN@12
1 | 1 | 1 | 10µs | 25µs | DateTime::Format::Builder::::BEGIN@76DateTime::Format::Builder::BEGIN@76
1 | 1 | 1 | 10µs | 76µs | DateTime::Format::Builder::::BEGIN@14DateTime::Format::Builder::BEGIN@14
1 | 1 | 1 | 10µs | 1.45ms | DateTime::Format::Builder::::create_end_parserDateTime::Format::Builder::create_end_parser
1 | 1 | 1 | 9µs | 1.57ms | DateTime::Format::Builder::::importDateTime::Format::Builder::import
1 | 1 | 1 | 8µs | 15µs | DateTime::Format::Builder::::BEGIN@122DateTime::Format::Builder::BEGIN@122
1 | 1 | 1 | 6µs | 33µs | DateTime::Format::Builder::::BEGIN@17DateTime::Format::Builder::BEGIN@17
1 | 1 | 1 | 4µs | 4µs | DateTime::Format::Builder::::create_methodDateTime::Format::Builder::create_method
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::__ANON__[:134]DateTime::Format::Builder::__ANON__[:134]
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::__ANON__[:190]DateTime::Format::Builder::__ANON__[:190]
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::__ANON__[:230]DateTime::Format::Builder::__ANON__[:230]
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::cloneDateTime::Format::Builder::clone
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::format_datetimeDateTime::Format::Builder::format_datetime
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::get_parserDateTime::Format::Builder::get_parser
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::newDateTime::Format::Builder::new
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::on_failDateTime::Format::Builder::on_fail
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::parse_datetimeDateTime::Format::Builder::parse_datetime
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::parserDateTime::Format::Builder::parser
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::set_parserDateTime::Format::Builder::set_parser
0 | 0 | 0 | 0s | 0s | DateTime::Format::Builder::::verboseDateTime::Format::Builder::verbose

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package DateTime::Format::Builder;
2 |  |  |  |  | # $Id: Builder.pm 4400 2010-03-14 15:49:10Z autarch $
3 |  |  |  |  |
4 |  |  |  |  | =begin comments
5 |  |  |  |  |
6 |  |  |  |  | Note: there is no API documentation in this file. You want F<Builder.pod> instead.
7 |  |  |  |  |
8 |  |  |  |  | =cut
9 |  |  |  |  |
10 | 3 | 19µs | 2 | 18µs | # spent 15µs (13+3) within DateTime::Format::Builder::BEGIN@10 which was called: # once (13µs+3µs) by DateTime::Format::SQLite::BEGIN@16 at line 10 use strict; # spent 15µs making 1 call to DateTime::Format::Builder::BEGIN@10 # spent 2µs making 1 call to strict::import
11 | 3 | 67µs | 1 | 54µs | # spent 54µs within DateTime::Format::Builder::BEGIN@11 which was called: # once (54µs+0s) by DateTime::Format::SQLite::BEGIN@16 at line 11 use 5.005; # spent 54µs making 1 call to DateTime::Format::Builder::BEGIN@11
12 | 3 | 23µs | 2 | 114µs | # spent 63µs (11+52) within DateTime::Format::Builder::BEGIN@12 which was called: # once (11µs+52µs) by DateTime::Format::SQLite::BEGIN@16 at line 12 use Carp; # spent 63µs making 1 call to DateTime::Format::Builder::BEGIN@12 # spent 52µs making 1 call to Exporter::import
13 | 3 | 45µs | 2 | 34µs | # spent 23µs (12+11) within DateTime::Format::Builder::BEGIN@13 which was called: # once (12µs+11µs) by DateTime::Format::SQLite::BEGIN@16 at line 13 use DateTime 0.12; # spent 23µs making 1 call to DateTime::Format::Builder::BEGIN@13 # spent 11µs making 1 call to UNIVERSAL::VERSION
14 |  |  | 1 | 66µs | # spent 76µs (10+66) within DateTime::Format::Builder::BEGIN@14 which was called: # once (10µs+66µs) by DateTime::Format::SQLite::BEGIN@16 at line 16 use Params::Validate qw( # spent 66µs making 1 call to Exporter::import
15 |  |  |  |  | validate SCALAR ARRAYREF HASHREF SCALARREF CODEREF GLOB GLOBREF UNDEF
16 | 3 | 23µs | 1 | 76µs | ); # spent 76µs making 1 call to DateTime::Format::Builder::BEGIN@14
17 | 3 | 157µs | 2 | 61µs | # spent 33µs (6+27) within DateTime::Format::Builder::BEGIN@17 which was called: # once (6µs+27µs) by DateTime::Format::SQLite::BEGIN@16 at line 17 use vars qw( $VERSION %dispatch_data ); # spent 33µs making 1 call to DateTime::Format::Builder::BEGIN@17 # spent 27µs making 1 call to vars::import
18 |  |  |  |  |
19 | 1 | 600ns |  |  | my $parser = 'DateTime::Format::Builder::Parser';
20 | 1 | 700ns |  |  | $VERSION = '0.80';
21 |  |  |  |  |
22 |  |  |  |  | # Developer oriented methods
23 |  |  |  |  |
24 |  |  |  |  | =pod
25 |  |  |  |  |
26 |  |  |  |  | C<verbose()> sets the logging.
27 |  |  |  |  |
28 |  |  |  |  | =cut
29 |  |  |  |  |
30 |  |  |  |  | sub verbose
31 |  |  |  |  | {
32 |  |  |  |  | warn "Use of verbose() deprecated for the interim.";
33 |  |  |  |  | 1;
34 |  |  |  |  | }
35 |  |  |  |  |
36 |  |  |  |  | =pod
37 |  |  |  |  |
38 |  |  |  |  | C<import()> merely exists to save typing. class is specified after C<@_>
39 |  |  |  |  | in order to override it. We really don't want to know about
40 |  |  |  |  | any class they specify. We'd leave it empty, but C<create_class()>
41 |  |  |  |  | uses C<caller()> to determine where the code came from.
42 |  |  |  |  |
43 |  |  |  |  | =cut
44 |  |  |  |  |
45 |  |  |  |  | sub import
46 |  |  |  |  | # spent 1.57ms (9µs+1.57) within DateTime::Format::Builder::import which was called: # once (9µs+1.57ms) by DateTime::Format::SQLite::BEGIN@16 at line 70 of DateTime/Format/SQLite.pm {
47 | 2 | 8µs |  |  | my $class = shift;
48 |  |  | 1 | 1.57ms | $class->create_class( @_, class => (caller)[0] ) if @_; # spent 1.57ms making 1 call to DateTime::Format::Builder::create_class
49 |  |  |  |  | }
50 |  |  |  |  |
51 |  |  |  |  | =pod
52 |  |  |  |  |
53 |  |  |  |  | Populates C<$class::VERSION>, C<$class::new> and writes any
54 |  |  |  |  | of the methods.
55 |  |  |  |  |
56 |  |  |  |  | =cut
57 |  |  |  |  |
58 |  |  |  |  | sub create_class
59 |  |  |  |  | # spent 1.57ms (53µs+1.51) within DateTime::Format::Builder::create_class which was called: # once (53µs+1.51ms) by DateTime::Format::Builder::import at line 48 {
60 | 16 | 63µs |  |  | my $class = shift;
61 | 1 | 29µs | 1 | 43µs | my %args = validate( @_, { # spent 43µs making 1 call to Params::Validate::XS::validate # spent 2µs executing statements in string eval
62 |  |  |  |  | class => { type => SCALAR, default => (caller)[0] },
63 |  |  |  |  | version => { type => SCALAR, optional => 1 },
64 |  |  |  |  | verbose => { type => SCALAR|GLOBREF|GLOB, optional => 1 },
65 |  |  |  |  | parsers => { type => HASHREF },
66 |  |  |  |  | groups => { type => HASHREF, optional => 1 },
67 |  |  |  |  | constructor => { type => UNDEF|SCALAR|CODEREF, optional => 1 },
68 |  |  |  |  | });
69 |  |  |  |  |
70 |  |  |  |  | verbose( $args{verbose} ) if exists $args{verbose};
71 |  |  |  |  |
72 |  |  |  |  | my $target = $args{class}; # where we're writing our methods and such.
73 |  |  |  |  |
74 |  |  |  |  | # Create own lovely new package
75 |  |  |  |  | {
76 | 3 | 192µs | 2 | 39µs | # spent 25µs (10+14) within DateTime::Format::Builder::BEGIN@76 which was called: # once (10µs+14µs) by DateTime::Format::SQLite::BEGIN@16 at line 76 no strict 'refs'; # spent 25µs making 1 call to DateTime::Format::Builder::BEGIN@76 # spent 14µs making 1 call to strict::unimport
77 |  |  |  |  |
78 |  |  |  |  |
79 |  |  |  |  | ${"${target}::VERSION"} = $args{version} if exists $args{version};
80 |  |  |  |  |
81 |  |  | 1 | 16µs | $class->create_constructor( # spent 16µs making 1 call to DateTime::Format::Builder::create_constructor
82 |  |  |  |  | $target, exists $args{constructor}, $args{constructor} );
83 |  |  |  |  |
84 |  |  |  |  | # Turn groups of parser specs in to groups of parsers
85 |  |  |  |  | {
86 |  |  |  |  | my $specs = $args{groups};
87 |  |  |  |  | my %groups;
88 |  |  |  |  |
89 |  |  |  |  | for my $label ( keys %$specs )
90 |  |  |  |  | {
91 |  |  |  |  | my $parsers = $specs->{$label};
92 |  |  |  |  | my $code = $class->create_parser( $parsers );
93 |  |  |  |  | $groups{$label} = $code;
94 |  |  |  |  | }
95 |  |  |  |  |
96 |  |  |  |  | $dispatch_data{$target} = \%groups;
97 |  |  |  |  | }
98 |  |  |  |  |
99 |  |  |  |  | # Write all our parser methods, creating parsers as we go.
100 |  |  |  |  | while (my ($method, $parsers) = each %{ $args{parsers} })
101 |  |  |  |  | {
102 |  |  |  |  | my $globname = $target."::$method";
103 |  |  |  |  | croak "Will not override a preexisting method $method()" if defined &{$globname};
104 |  |  | 1 | 1.45ms | *$globname = $class->create_end_parser( $parsers ); # spent 1.45ms making 1 call to DateTime::Format::Builder::create_end_parser
105 |  |  |  |  | }
106 |  |  |  |  | }
107 |  |  |  |  |
108 |  |  |  |  | }
109 |  |  |  |  |
110 |  |  |  |  | sub create_constructor
111 |  |  |  |  | # spent 16µs within DateTime::Format::Builder::create_constructor which was called: # once (16µs+0s) by DateTime::Format::Builder::create_class at line 81 {
112 | 9 | 18µs |  |  | my $class = shift;
113 |  |  |  |  | my ( $target, $intended, $value ) = @_;
114 |  |  |  |  |
115 |  |  |  |  | my $new = $target."::new";
116 |  |  |  |  | $value = 1 unless $intended;
117 |  |  |  |  |
118 |  |  |  |  | return unless $value;
119 |  |  |  |  | return if not $intended and defined &$new;
120 |  |  |  |  | croak "Will not override a preexisting constructor new()" if defined &$new;
121 |  |  |  |  |
122 | 3 | 519µs | 2 | 23µs | # spent 15µs (8+8) within DateTime::Format::Builder::BEGIN@122 which was called: # once (8µs+8µs) by DateTime::Format::SQLite::BEGIN@16 at line 122 no strict 'refs'; # spent 15µs making 1 call to DateTime::Format::Builder::BEGIN@122 # spent 8µs making 1 call to strict::unimport
123 |  |  |  |  |
124 |  |  |  |  | return *$new = $value if ref $value eq 'CODE';
125 |  |  |  |  | return *$new = sub {
126 |  |  |  |  | my $class = shift;
127 |  |  |  |  | croak "${class}->new takes no parameters." if @_;
128 |  |  |  |  |
129 |  |  |  |  | my $self = bless {}, ref($class)||$class;
130 |  |  |  |  | # If called on an object, clone, but we've nothing to
131 |  |  |  |  | # clone
132 |  |  |  |  |
133 |  |  |  |  | $self;
134 |  |  |  |  | };
135 |  |  |  |  | }
136 |  |  |  |  |
137 |  |  |  |  | =pod
138 |  |  |  |  |
139 |  |  |  |  | This creates the parser coderefs. Coderefs return undef on
140 |  |  |  |  | bad parses, return C<DateTime> objects on good parse. Used
141 |  |  |  |  | by C<parser()> and C<create_class()>.
142 |  |  |  |  |
143 |  |  |  |  | =cut
144 |  |  |  |  |
145 |  |  |  |  | sub create_parser
146 |  |  |  |  | # spent 1.44ms (13µs+1.43) within DateTime::Format::Builder::create_parser which was called: # once (13µs+1.43ms) by DateTime::Format::Builder::create_end_parser at line 174 {
147 | 6 | 14µs |  |  | my $class = shift;
148 |  |  |  |  | my @common = ( maker => $class );
149 |  |  |  |  | if (@_ == 1)
150 |  |  |  |  | {
151 |  |  |  |  | my $parsers = shift;
152 |  |  |  |  | my @parsers = (
153 |  |  |  |  | (ref $parsers eq 'HASH' ) ? %$parsers :
154 |  |  |  |  | ( ( ref $parsers eq 'ARRAY' ) ? @$parsers : $parsers)
155 |  |  |  |  | );
156 |  |  | 1 | 1.43ms | $parser->create_parser( \@common, @parsers ); # spent 1.43ms making 1 call to DateTime::Format::Builder::Parser::create_parser
157 |  |  |  |  | }
158 |  |  |  |  | else
159 |  |  |  |  | {
160 |  |  |  |  | $parser->create_parser( \@common, @_ );
161 |  |  |  |  | }
162 |  |  |  |  | }
163 |  |  |  |  |
164 |  |  |  |  | =pod
165 |  |  |  |  |
166 |  |  |  |  | This creates the end methods. Coderefs die on bad parses,
167 |  |  |  |  | return C<DateTime> objects on good parse.
168 |  |  |  |  |
169 |  |  |  |  | =cut
170 |  |  |  |  |
171 |  |  |  |  | sub create_end_parser
172 |  |  |  |  | # spent 1.45ms (10µs+1.44) within DateTime::Format::Builder::create_end_parser which was called: # once (10µs+1.44ms) by DateTime::Format::Builder::create_class at line 104 {
173 | 2 | 8µs |  |  | my ($class, $parsers) = @_;
174 |  |  | 2 | 1.44ms | $class->create_method( $class->create_parser( $parsers ) ); # spent 1.44ms making 1 call to DateTime::Format::Builder::create_parser # spent 4µs making 1 call to DateTime::Format::Builder::create_method
175 |  |  |  |  | }
176 |  |  |  |  |
177 |  |  |  |  | =pod
178 |  |  |  |  |
179 |  |  |  |  | C<create_method()> simply takes a parser and returns a coderef suitable
180 |  |  |  |  | to act as a method.
181 |  |  |  |  |
182 |  |  |  |  | =cut
183 |  |  |  |  |
184 |  |  |  |  | sub create_method
185 |  |  |  |  | # spent 4µs within DateTime::Format::Builder::create_method which was called: # once (4µs+0s) by DateTime::Format::Builder::create_end_parser at line 174 {
186 | 2 | 6µs |  |  | my ($class, $parser) = @_;
187 |  |  |  |  | return sub {
188 |  |  |  |  | my $self = shift;
189 |  |  |  |  | $parser->parse( $self, @_);
190 |  |  |  |  | }
191 |  |  |  |  | }
192 |  |  |  |  |
193 |  |  |  |  | =pod
194 |  |  |  |  |
195 |  |  |  |  | This is the method used when a parse fails. Subclass and override
196 |  |  |  |  | this if you like.
197 |  |  |  |  |
198 |  |  |  |  | =cut
199 |  |  |  |  |
200 |  |  |  |  | sub on_fail
201 |  |  |  |  | {
202 |  |  |  |  | my ($class, $input) = @_;
203 |  |  |  |  |
204 |  |  |  |  | my $pkg;
205 |  |  |  |  | my $i = 0;
206 |  |  |  |  | while (($pkg) = caller($i++)) {
207 |  |  |  |  | last if (!UNIVERSAL::isa($pkg, 'DateTime::Format::Builder') &&
208 |  |  |  |  | !UNIVERSAL::isa($pkg, 'DateTime::Format::Builder::Parser'));
209 |  |  |  |  | }
210 |  |  |  |  | local $Carp::CarpLevel = $i;
211 |  |  |  |  | croak "Invalid date format: $input";
212 |  |  |  |  | }
213 |  |  |  |  |
214 |  |  |  |  | #
215 |  |  |  |  | # User oriented methods
216 |  |  |  |  | #
217 |  |  |  |  |
218 |  |  |  |  | =pod
219 |  |  |  |  |
220 |  |  |  |  | These methods don't need explaining. They're pretty much
221 |  |  |  |  | boiler plate stuff.
222 |  |  |  |  |
223 |  |  |  |  | =cut
224 |  |  |  |  |
225 |  |  |  |  | sub new
226 |  |  |  |  | {
227 |  |  |  |  | my $class = shift;
228 |  |  |  |  | croak "Constructor 'new' takes no parameters" if @_;
229 |  |  |  |  | my $self = bless {
230 |  |  |  |  | parser => sub { croak "No parser set." }
231 |  |  |  |  | }, ref($class)||$class;
232 |  |  |  |  | if (ref $class)
233 |  |  |  |  | {
234 |  |  |  |  | # If called on an object, clone
235 |  |  |  |  | $self->set_parser( $class->get_parser );
236 |  |  |  |  | # and that's it. we don't store that much info per object
237 |  |  |  |  | }
238 |  |  |  |  | return $self;
239 |  |  |  |  | }
240 |  |  |  |  |
241 |  |  |  |  | sub parser
242 |  |  |  |  | {
243 |  |  |  |  | my $class = shift;
244 |  |  |  |  | my $parser = $class->create_end_parser( \@_ );
245 |  |  |  |  |
246 |  |  |  |  | # Do we need to instantiate a new object for return,
247 |  |  |  |  | # or are we modifying an existing object?
248 |  |  |  |  | my $self;
249 |  |  |  |  | $self = ref $class ? $class : $class->new();
250 |  |  |  |  |
251 |  |  |  |  | $self->set_parser( $parser );
252 |  |  |  |  |
253 |  |  |  |  | $self;
254 |  |  |  |  | }
255 |  |  |  |  |
256 |  |  |  |  | sub clone
257 |  |  |  |  | {
258 |  |  |  |  | my $self = shift;
259 |  |  |  |  | croak "Calling object method as class method!" unless ref $self;
260 |  |  |  |  | return $self->new();
261 |  |  |  |  | }
262 |  |  |  |  |
263 |  |  |  |  | sub set_parser
264 |  |  |  |  | {
265 |  |  |  |  | my ($self, $parser) = @_;
266 |  |  |  |  | croak "set_parser given something other than a coderef" unless $parser
267 |  |  |  |  | and ref $parser eq 'CODE';
268 |  |  |  |  | $self->{parser} = $parser;
269 |  |  |  |  | $self;
270 |  |  |  |  | }
271 |  |  |  |  |
272 |  |  |  |  | sub get_parser
273 |  |  |  |  | {
274 |  |  |  |  | my ($self) = @_;
275 |  |  |  |  | return $self->{parser};
276 |  |  |  |  | }
277 |  |  |  |  |
278 |  |  |  |  | sub parse_datetime
279 |  |  |  |  | {
280 |  |  |  |  | my $self = shift;
281 |  |  |  |  | croak "parse_datetime is an object method, not a class method."
282 |  |  |  |  | unless ref $self and $self->isa( __PACKAGE__ );
283 |  |  |  |  | croak "No date specified." unless @_;
284 |  |  |  |  | return $self->{parser}->( $self, @_ );
285 |  |  |  |  | }
286 |  |  |  |  |
287 |  |  |  |  | sub format_datetime
288 |  |  |  |  | {
289 |  |  |  |  | croak __PACKAGE__."::format_datetime not implemented.";
290 |  |  |  |  | }
291 |  |  |  |  |
292 | 1 | 64µs |  |  | require DateTime::Format::Builder::Parser;
293 |  |  |  |  |
294 |  |  |  |  |
295 |  |  |  |  | =pod
296 |  |  |  |  |
297 |  |  |  |  | Create the single parser. Delegation stops here!
298 |  |  |  |  |
299 |  |  |  |  | =cut
300 |  |  |  |  |
301 | 1 | 5µs |  |  | 1;