← Index
NYTProf Performance Profile   « line view »
For ../dm5dm6_ex3
  Run on Mon Feb 23 08:36:56 2015
Reported on Mon Feb 23 08:37:02 2015

Filename/home/sulbeck/local/lib/perl5/5.20.1/Date/Manip/Obj.pm
StatementsExecuted 14877 statements in 8.93ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
4874314.91ms4.91msDate::Manip::Obj::::baseDate::Manip::Obj::base
6112.54ms2.85msDate::Manip::Obj::::new_deltaDate::Manip::Obj::new_delta
1111.17ms1.49msDate::Manip::Obj::::BEGIN@13Date::Manip::Obj::BEGIN@13
111440µs5.77msDate::Manip::Obj::::BEGIN@12Date::Manip::Obj::BEGIN@12
942136µs4.10msDate::Manip::Obj::::newDate::Manip::Obj::new (recurses: max depth 2, inclusive time 7.40ms)
11111µs18µsDate::Manip::Obj::::BEGIN@10Date::Manip::Obj::BEGIN@10
8116µs6µsDate::Manip::Obj::::_init_finalDate::Manip::Obj::_init_final
1114µs16µsDate::Manip::Obj::::BEGIN@11Date::Manip::Obj::BEGIN@11
1112µs2µsDate::Manip::Obj::::ENDDate::Manip::Obj::END
0000s0sDate::Manip::Obj::::_init_argsDate::Manip::Obj::_init_args
0000s0sDate::Manip::Obj::::configDate::Manip::Obj::config
0000s0sDate::Manip::Obj::::errDate::Manip::Obj::err
0000s0sDate::Manip::Obj::::get_configDate::Manip::Obj::get_config
0000s0sDate::Manip::Obj::::is_dateDate::Manip::Obj::is_date
0000s0sDate::Manip::Obj::::is_deltaDate::Manip::Obj::is_delta
0000s0sDate::Manip::Obj::::is_recurDate::Manip::Obj::is_recur
0000s0sDate::Manip::Obj::::new_configDate::Manip::Obj::new_config
0000s0sDate::Manip::Obj::::new_dateDate::Manip::Obj::new_date
0000s0sDate::Manip::Obj::::new_recurDate::Manip::Obj::new_recur
0000s0sDate::Manip::Obj::::tzDate::Manip::Obj::tz
0000s0sDate::Manip::Obj::::versionDate::Manip::Obj::version
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Date::Manip::Obj;
2# Copyright (c) 2008-2015 Sullivan Beck. All rights reserved.
3# This program is free software; you can redistribute it and/or modify it
4# under the same terms as Perl itself.
5
6########################################################################
7########################################################################
8
915µsrequire 5.010000;
10220µs224µs
# spent 18µs (11+6) within Date::Manip::Obj::BEGIN@10 which was called: # once (11µs+6µs) by Date::Manip::Date::BEGIN@14 at line 10
use warnings;
# spent 18µs making 1 call to Date::Manip::Obj::BEGIN@10 # spent 6µs making 1 call to warnings::import
11214µs228µs
# spent 16µs (4+12) within Date::Manip::Obj::BEGIN@11 which was called: # once (4µs+12µs) by Date::Manip::Date::BEGIN@14 at line 11
use strict;
# spent 16µs making 1 call to Date::Manip::Obj::BEGIN@11 # spent 12µs making 1 call to strict::import
122113µs25.83ms
# spent 5.77ms (440µs+5.33) within Date::Manip::Obj::BEGIN@12 which was called: # once (440µs+5.33ms) by Date::Manip::Date::BEGIN@14 at line 12
use IO::File;
# spent 5.77ms making 1 call to Date::Manip::Obj::BEGIN@12 # spent 58µs making 1 call to Exporter::import
132877µs21.54ms
# spent 1.49ms (1.17+318µs) within Date::Manip::Obj::BEGIN@13 which was called: # once (1.17ms+318µs) by Date::Manip::Date::BEGIN@14 at line 13
use Storable qw(dclone);
# spent 1.49ms making 1 call to Date::Manip::Obj::BEGIN@13 # spent 51µs making 1 call to Exporter::import
14
151100nsour ($VERSION);
161200ns$VERSION='6.49';
1712µs
# spent 2µs within Date::Manip::Obj::END which was called: # once (2µs+0s) by main::RUNTIME at line 0 of ../dm5dm6_ex3
END { undef $VERSION; }
18
19########################################################################
20# METHODS
21########################################################################
22
2311µsmy %classes = ( 'Date::Manip::Base' => 1,
24 'Date::Manip::TZ' => 1,
25 'Date::Manip::Date' => 1,
26 'Date::Manip::Delta' => 1,
27 'Date::Manip::Recur' => 1,
28 );
29
30
# spent 4.10ms (136µs+3.96) within Date::Manip::Obj::new which was called 9 times, avg 455µs/call: # 6 times (83µs+31µs) by Date::Manip::Obj::new_delta at line 204, avg 19µs/call # once (20µs+3.96ms) by main::RUNTIME at line 26 of ../dm5dm6_ex3 # once (15µs+-15µs) by Date::Manip::Obj::new at line 135 # once (19µs+-19µs) by Date::Manip::Obj::new at line 153
sub new {
3193µs my(@args) = @_;
3294µs my(@allargs) = @args;
33
34 # $old is the object (if any) being used to create a new object
35 # $new is the new object
36 # $class is the class of the new object
37 # $tz is a Date::Manip::TZ object to base the new object on
38 # (only for Date, Delta, Recur objects)
39 # $base is the Date::Manip::Base object to base the new object on
40 # @opts options to pass to config method
41
4292µs my($old,$new,$class,$tz,$base,@opts);
43
44 # Get the class of the new object
45
4696µs if (exists $classes{ $args[0] }) {
47 # $obj = new CLASS
48 $class = shift(@args);
49
50 } elsif (ref($args[0])) {
51 # $obj->new
52 $class = ref($args[0]);
53
54 } else {
55 warn "ERROR: [new] first argument must be a Date::Manip class/object\n";
56 return undef;
57 }
58
59 # Get an old object
60
6194µs if (ref($args[0])) {
62 # $old->new
63 # new CLASS $old
64 $old = shift(@args);
65 }
66
67 # Find out if there are any config options (which will be the
68 # final argument).
69
7092µs if (@args && ref($args[$#args]) eq 'ARRAY') {
71 @opts = @{ pop(@args) };
72 }
73
74 # There must be at most 1 additional argument
75
7691µs if (@args) {
77 if (@args > 1) {
78 warn "ERROR: [new] unknown arguments\n";
79 return undef;
80 }
81 }
82
83 ########################
84
85 # Get Base/TZ objects from an existing object
86
8792µs if ($old) {
8865µs if (ref($old) eq 'Date::Manip::Base') {
89 $base = $old;
90 } elsif (ref($old) eq 'Date::Manip::TZ') {
91 $tz = $old;
92 $base = $$tz{'base'};
93 } elsif (ref($old) eq 'ARRAY') {
94 my %old = @$old;
95 $tz = $old{'tz'};
96 $base = $$tz{'base'};
97 } else {
9861µs $tz = $$old{'tz'};
9961µs $base = $$tz{'base'};
100 }
101 }
102
103 # Create a new empty object.
104
105 $new = {
10699µs 'data' => {},
107 'err' => '',
108 };
109
110 # Create Base/TZ objects if necessary
111
11292µs if ($base && @opts) {
113 $base = dclone($base);
114 $tz = new Date::Manip::TZ $base if ($tz);
115 }
116
11792µs my $init = 1;
11894µs if ($class eq 'Date::Manip::Base') {
1191300ns if ($base) {
120 # new Date::Manip::Base $base
121 if (@opts) {
122 $new = $base;
123 } else {
124 # dclone doesn't handle regexps
125 my $tmp = $$base{'data'}{'rx'};
126 delete $$base{'data'}{'rx'};
127 $new = dclone($base);
128 $$base{'data'}{'rx'} = $tmp;
129 $$new{'data'}{'rx'} = $tmp;
130 }
131 $init = 0;
132 }
133
134 } elsif ($class eq 'Date::Manip::TZ') {
13515µs10s if ($tz) {
# spent 3.44ms making 1 call to Date::Manip::Obj::new, recursion: max depth 2, sum of overlapping time 3.44ms
136 # new Date::Manip::TZ $tz
137 if (@opts) {
138 $new = $tz;
139 } else {
140 $new = dclone($tz);
141 }
142 $init = 0;
143 } elsif (! $base) {
144 $base = new Date::Manip::Base;
145 }
1461300ns $$new{'base'} = $base;
147
148 } else {
14971µs if (! $tz) {
150 if ($base) {
151 $tz = new Date::Manip::TZ $base;
152 } else {
15317µs10s $tz = new Date::Manip::TZ;
# spent 3.96ms making 1 call to Date::Manip::Obj::new, recursion: max depth 1, sum of overlapping time 3.96ms
154 }
155 }
15674µs $$new{'tz'} = $tz;
157 }
158
15997µs $$new{'args'} = [ @args ];
16098µs bless $new,$class;
161
162911µs93.49ms $new->_init() if ($init);
# spent 3.43ms making 1 call to Date::Manip::Base::_init # spent 31µs making 1 call to Date::Manip::TZ::_init # spent 26µs making 6 calls to Date::Manip::Delta::_init, avg 4µs/call # spent 8µs making 1 call to Date::Manip::Date::_init
16392µs $new->config(@opts) if (@opts);
16492µs $new->_init_args() if (@args);
165911µs9470µs $new->_init_final();
# spent 464µs making 1 call to Date::Manip::TZ::_init_final # spent 6µs making 8 calls to Date::Manip::Obj::_init_final, avg 750ns/call
166916µs return $new;
167}
168
169sub _init_args {
170 my($self) = @_;
171
172 my @args = @{ $$self{'args'} };
173 if (@args) {
174 warn "WARNING: [new] invalid arguments: @args\n";
175 }
176}
177
178
# spent 6µs within Date::Manip::Obj::_init_final which was called 8 times, avg 750ns/call: # 8 times (6µs+0s) by Date::Manip::Obj::new at line 165, avg 750ns/call
sub _init_final {
17981µs my($self) = @_;
18089µs return;
181}
182
183sub new_config {
184 my(@args) = @_;
185
186 # Make sure that @opts is passed in as the final argument.
187
188 if (! @args ||
189 ! (ref($args[$#args]) eq 'ARRAY')) {
190 push(@args,['ignore','ignore']);
191 }
192
193 return new(@args);
194}
195
196sub new_date {
197 my(@args) = @_;
198 require Date::Manip::Date;
199 return new Date::Manip::Date @args;
200}
201
# spent 2.85ms (2.54+312µs) within Date::Manip::Obj::new_delta which was called 6 times, avg 475µs/call: # 6 times (2.54ms+312µs) by Date::Manip::Date::_parse_delta at line 1811 of Date/Manip/Date.pm, avg 475µs/call
sub new_delta {
20262µs my(@args) = @_;
2036132µs require Date::Manip::Delta;
204628µs6114µs return new Date::Manip::Delta @args;
# spent 114µs making 6 calls to Date::Manip::Obj::new, avg 19µs/call
205}
206sub new_recur {
207 my(@args) = @_;
208 require Date::Manip::Recur;
209 return new Date::Manip::Recur @args;
210}
211
212
# spent 4.91ms within Date::Manip::Obj::base which was called 4874 times, avg 1µs/call: # 2443 times (2.06ms+0s) by Date::Manip::TZ_Base::_now at line 269 of Date/Manip/TZ_Base.pm, avg 842ns/call # 2430 times (2.85ms+0s) by Date::Manip::TZ_Base::_fix_year at line 188 of Date/Manip/TZ_Base.pm, avg 1µs/call # once (500ns+0s) by Date::Manip::TZ_Base::_update_now at line 341 of Date/Manip/TZ_Base.pm
sub base {
2134874537µs my($self) = @_;
2144874928µs my $t = ref($self);
21548746.13ms if ($t eq 'Date::Manip::Base') {
216 return undef;
217 } elsif ($t eq 'Date::Manip::TZ') {
218 return $$self{'base'};
219 } else {
220 my $dmt = $$self{'tz'};
221 return $$dmt{'base'};
222 }
223}
224
225sub tz {
226 my($self) = @_;
227 my $t = ref($self);
228
229 if ($t eq 'Date::Manip::Base' ||
230 $t eq 'Date::Manip::TZ') {
231 return undef;
232 }
233
234 return $$self{'tz'};
235}
236
237sub config {
238 my($self,@opts) = @_;
239 my $obj;
240 if (ref($self) eq 'Date::Manip::Base' ||
241 ref($self) eq 'Date::Manip::TZ') {
242 $obj = $self;
243 } else {
244 $obj = $$self{'tz'};
245 }
246
247 while (@opts) {
248 my $var = shift(@opts);
249 my $val = shift(@opts);
250 $obj->_config_var($var,$val);
251 }
252}
253
254sub get_config {
255 my($self,@args) = @_;
256
257 my $base;
258 my $t = ref($self);
259 if ($t eq 'Date::Manip::Base') {
260 $base = $self;
261 } elsif ($t eq 'Date::Manip::TZ') {
262 $base = $$self{'base'};
263 } else {
264 my $dmt = $$self{'tz'};
265 $base = $$dmt{'base'};
266 }
267
268 if (@args) {
269 my @ret;
270 foreach my $var (@args) {
271 if (exists $$base{'data'}{'sections'}{'conf'}{lc($var)}) {
272 push @ret,$$base{'data'}{'sections'}{'conf'}{lc($var)};
273 } else {
274 warn "ERROR: [config] invalid config variable: $var\n";
275 return '';
276 }
277 }
278
279 if (@ret == 1) {
280 return $ret[0];
281 } else {
282 return @ret;
283 }
284 }
285
286 my @ret = sort keys %{ $$base{'data'}{'sections'}{'conf'} };
287 return @ret;
288}
289
290sub err {
291 my($self,$arg) = @_;
292 if ($arg) {
293 $$self{'err'} = '';
294 return;
295 } else {
296 return $$self{'err'};
297 }
298}
299
300sub is_date {
301 return 0;
302}
303sub is_delta {
304 return 0;
305}
306sub is_recur {
307 return 0;
308}
309
310sub version {
311 my($self,$flag) = @_;
312 if ($flag && ref($self) ne 'Date::Manip::Base') {
313 my $dmt;
314 if (ref($self) eq 'Date::Manip::TZ') {
315 $dmt = $self;
316 } else {
317 $dmt = $$self{'tz'};
318 }
319 my $tz = $dmt->_now('systz');
320 return "$VERSION [$tz]";
321 } else {
322 return $VERSION;
323 }
324}
325
32613µs1;
327# Local Variables:
328# mode: cperl
329# indent-tabs-mode: nil
330# cperl-indent-level: 3
331# cperl-continued-statement-offset: 2
332# cperl-continued-brace-offset: 0
333# cperl-brace-offset: 0
334# cperl-brace-imaginary-offset: 0
335# cperl-label-offset: 0
336# End: