← 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:24:09 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DateTime/Format/Builder.pm
StatementsExecuted 65 statements in 1.26ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11154µs54µsDateTime::Format::Builder::::BEGIN@11DateTime::Format::Builder::BEGIN@11
11153µs1.57msDateTime::Format::Builder::::create_classDateTime::Format::Builder::create_class
11116µs16µsDateTime::Format::Builder::::create_constructorDateTime::Format::Builder::create_constructor
11113µs1.44msDateTime::Format::Builder::::create_parserDateTime::Format::Builder::create_parser
11113µs15µsDateTime::Format::Builder::::BEGIN@10DateTime::Format::Builder::BEGIN@10
11112µs23µsDateTime::Format::Builder::::BEGIN@13DateTime::Format::Builder::BEGIN@13
11111µs63µsDateTime::Format::Builder::::BEGIN@12DateTime::Format::Builder::BEGIN@12
11110µs25µsDateTime::Format::Builder::::BEGIN@76DateTime::Format::Builder::BEGIN@76
11110µs76µsDateTime::Format::Builder::::BEGIN@14DateTime::Format::Builder::BEGIN@14
11110µs1.45msDateTime::Format::Builder::::create_end_parserDateTime::Format::Builder::create_end_parser
1119µs1.57msDateTime::Format::Builder::::importDateTime::Format::Builder::import
1118µs15µsDateTime::Format::Builder::::BEGIN@122DateTime::Format::Builder::BEGIN@122
1116µs33µsDateTime::Format::Builder::::BEGIN@17DateTime::Format::Builder::BEGIN@17
1114µs4µsDateTime::Format::Builder::::create_methodDateTime::Format::Builder::create_method
0000s0sDateTime::Format::Builder::::__ANON__[:134]DateTime::Format::Builder::__ANON__[:134]
0000s0sDateTime::Format::Builder::::__ANON__[:190]DateTime::Format::Builder::__ANON__[:190]
0000s0sDateTime::Format::Builder::::__ANON__[:230]DateTime::Format::Builder::__ANON__[:230]
0000s0sDateTime::Format::Builder::::cloneDateTime::Format::Builder::clone
0000s0sDateTime::Format::Builder::::format_datetimeDateTime::Format::Builder::format_datetime
0000s0sDateTime::Format::Builder::::get_parserDateTime::Format::Builder::get_parser
0000s0sDateTime::Format::Builder::::newDateTime::Format::Builder::new
0000s0sDateTime::Format::Builder::::on_failDateTime::Format::Builder::on_fail
0000s0sDateTime::Format::Builder::::parse_datetimeDateTime::Format::Builder::parse_datetime
0000s0sDateTime::Format::Builder::::parserDateTime::Format::Builder::parser
0000s0sDateTime::Format::Builder::::set_parserDateTime::Format::Builder::set_parser
0000s0sDateTime::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
1package DateTime::Format::Builder;
2# $Id: Builder.pm 4400 2010-03-14 15:49:10Z autarch $
3
4=begin comments
5
6Note: there is no API documentation in this file. You want F<Builder.pod> instead.
7
8=cut
9
10319µs218µ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
11367µs154µ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
12323µs2114µ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
13345µs234µ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
1417µs166µ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
16216µs176µs);
# spent 76µs making 1 call to DateTime::Format::Builder::BEGIN@14
173157µs261µ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
191600nsmy $parser = 'DateTime::Format::Builder::Parser';
201700ns$VERSION = '0.80';
21
22# Developer oriented methods
23
24=pod
25
26C<verbose()> sets the logging.
27
28=cut
29
30sub verbose
31{
32 warn "Use of verbose() deprecated for the interim.";
33 1;
34}
35
36=pod
37
38C<import()> merely exists to save typing. class is specified after C<@_>
39in order to override it. We really don't want to know about
40any class they specify. We'd leave it empty, but C<create_class()>
41uses C<caller()> to determine where the code came from.
42
43=cut
44
45sub 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
{
4711µs my $class = shift;
4817µs11.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
53Populates C<$class::VERSION>, C<$class::new> and writes any
54of the methods.
55
56=cut
57
58sub 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
{
601800ns my $class = shift;
61161µs143µ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
701600ns verbose( $args{verbose} ) if exists $args{verbose};
71
721700ns my $target = $args{class}; # where we're writing our methods and such.
73
74 # Create own lovely new package
75 {
764197µs239µ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
791900ns ${"${target}::VERSION"} = $args{version} if exists $args{version};
80
8115µs116µ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 {
8621µs my $specs = $args{groups};
871200ns my %groups;
88
8912µs for my $label ( keys %$specs )
90 {
91 my $parsers = $specs->{$label};
92 my $code = $class->create_parser( $parsers );
93 $groups{$label} = $code;
94 }
95
9612µs $dispatch_data{$target} = \%groups;
97 }
98
99 # Write all our parser methods, creating parsers as we go.
10015µs while (my ($method, $parsers) = each %{ $args{parsers} })
101 {
10211µs my $globname = $target."::$method";
10311µs croak "Will not override a preexisting method $method()" if defined &{$globname};
10416µs11.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
110sub 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
{
1121600ns my $class = shift;
11312µs my ( $target, $intended, $value ) = @_;
114
1151900ns my $new = $target."::new";
1161800ns $value = 1 unless $intended;
117
1181300ns return unless $value;
11912µs return if not $intended and defined &$new;
1201900ns croak "Will not override a preexisting constructor new()" if defined &$new;
121
1223519µs223µ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
12411µs 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;
134110µs };
135}
136
137=pod
138
139This creates the parser coderefs. Coderefs return undef on
140bad parses, return C<DateTime> objects on good parse. Used
141by C<parser()> and C<create_class()>.
142
143=cut
144
145sub 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
{
1471600ns my $class = shift;
14811µs my @common = ( maker => $class );
14915µs if (@_ == 1)
150 {
1511400ns my $parsers = shift;
15213µs my @parsers = (
153 (ref $parsers eq 'HASH' ) ? %$parsers :
154 ( ( ref $parsers eq 'ARRAY' ) ? @$parsers : $parsers)
155 );
15614µs11.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
166This creates the end methods. Coderefs die on bad parses,
167return C<DateTime> objects on good parse.
168
169=cut
170
171sub 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
{
1731800ns my ($class, $parsers) = @_;
17417µs21.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
179C<create_method()> simply takes a parser and returns a coderef suitable
180to act as a method.
181
182=cut
183
184sub 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
{
1861900ns my ($class, $parser) = @_;
187 return sub {
188 my $self = shift;
189 $parser->parse( $self, @_);
190 }
19115µs}
192
193=pod
194
195This is the method used when a parse fails. Subclass and override
196this if you like.
197
198=cut
199
200sub 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
220These methods don't need explaining. They're pretty much
221boiler plate stuff.
222
223=cut
224
225sub 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
241sub 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
256sub clone
257{
258 my $self = shift;
259 croak "Calling object method as class method!" unless ref $self;
260 return $self->new();
261}
262
263sub 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
272sub get_parser
273{
274 my ($self) = @_;
275 return $self->{parser};
276}
277
278sub 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
287sub format_datetime
288{
289 croak __PACKAGE__."::format_datetime not implemented.";
290}
291
292164µsrequire DateTime::Format::Builder::Parser;
293
294
295=pod
296
297Create the single parser. Delegation stops here!
298
299=cut
300
30115µs1;