← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:48 2015

Filename/usr/share/perl5/Date/Manip/Obj.pm
StatementsExecuted 252 statements in 3.52ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1118.86ms9.11msDate::Manip::Obj::::new_recurDate::Manip::Obj::new_recur
1114.93ms5.20msDate::Manip::Obj::::new_deltaDate::Manip::Obj::new_delta
1113.11ms4.49msDate::Manip::Obj::::BEGIN@13Date::Manip::Obj::BEGIN@13
972179µs11.2msDate::Manip::Obj::::newDate::Manip::Obj::new (recurses: max depth 2, inclusive time 21.3ms)
11112µs17µsDate::Manip::Obj::::BEGIN@10Date::Manip::Obj::BEGIN@10
11111µs113µsDate::Manip::Obj::::BEGIN@12Date::Manip::Obj::BEGIN@12
11111µs1.49msDate::Manip::Obj::::configDate::Manip::Obj::config
7119µs9µsDate::Manip::Obj::::_init_finalDate::Manip::Obj::_init_final
1116µs23µsDate::Manip::Obj::::new_dateDate::Manip::Obj::new_date
1116µs14µsDate::Manip::Obj::::BEGIN@11Date::Manip::Obj::BEGIN@11
1114µs4µsDate::Manip::Obj::::baseDate::Manip::Obj::base
1113µs3µsDate::Manip::Obj::::ENDDate::Manip::Obj::END
1112µs2µsDate::Manip::Obj::::tzDate::Manip::Obj::tz
0000s0sDate::Manip::Obj::::_init_argsDate::Manip::Obj::_init_args
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::::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-2014 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
919µsrequire 5.010000;
10221µs223µs
# spent 17µs (12+6) within Date::Manip::Obj::BEGIN@10 which was called: # once (12µs+6µs) by Date::Manip::Date::BEGIN@14 at line 10
use warnings;
# spent 17µs making 1 call to Date::Manip::Obj::BEGIN@10 # spent 6µs making 1 call to warnings::import
11288µs222µs
# spent 14µs (6+8) within Date::Manip::Obj::BEGIN@11 which was called: # once (6µs+8µs) by Date::Manip::Date::BEGIN@14 at line 11
use strict;
# spent 14µs making 1 call to Date::Manip::Obj::BEGIN@11 # spent 8µs making 1 call to strict::import
12227µs2215µs
# spent 113µs (11+102) within Date::Manip::Obj::BEGIN@12 which was called: # once (11µs+102µs) by Date::Manip::Date::BEGIN@14 at line 12
use IO::File;
# spent 113µs making 1 call to Date::Manip::Obj::BEGIN@12 # spent 102µs making 1 call to Exporter::import
1321.67ms24.53ms
# spent 4.49ms (3.11+1.38) within Date::Manip::Obj::BEGIN@13 which was called: # once (3.11ms+1.38ms) by Date::Manip::Date::BEGIN@14 at line 13
use Storable qw(dclone);
# spent 4.49ms making 1 call to Date::Manip::Obj::BEGIN@13 # spent 42µs making 1 call to Exporter::import
14
151100nsour ($VERSION);
161300ns$VERSION='6.47';
1713µs
# spent 3µs within Date::Manip::Obj::END which was called: # once (3µs+0s) by main::RUNTIME at line 131 of C4/Service.pm
END { undef $VERSION; }
18
19########################################################################
20# METHODS
21########################################################################
22
2312µ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 11.2ms (179µs+11.0) within Date::Manip::Obj::new which was called 9 times, avg 1.25ms/call: # 2 times (39µs+-39µs) by Date::Manip::Obj::new at line 153, avg 0s/call # 2 times (29µs+-29µs) by Date::Manip::Obj::new at line 135, avg 0s/call # once (32µs+6.47ms) by C4::Overdues::BEGIN@25 at line 64 of Date/Manip/DM6.pm # once (16µs+4.59ms) by C4::Overdues::BEGIN@25 at line 67 of Date/Manip/DM6.pm # once (24µs+29µs) by Date::Manip::Obj::new_recur at line 209 # once (24µs+9µs) by Date::Manip::Obj::new_delta at line 204 # once (13µs+5µs) by Date::Manip::Obj::new_date at line 199
sub new {
3195µ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
4697µ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) {
8835µ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 {
9832µs $tz = $$old{'tz'};
9932µs $base = $$tz{'base'};
100 }
101 }
102
103 # Create a new empty object.
104
105 $new = {
106910µ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;
11895µs if ($class eq 'Date::Manip::Base') {
1192600ns 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') {
13529µs20s if ($tz) {
# spent 10.3ms making 2 calls to Date::Manip::Obj::new, avg 5.15ms/call, recursion: max depth 2, sum of overlapping time 10.3ms
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 }
14621µs $$new{'base'} = $base;
147
148 } else {
14952µs if (! $tz) {
150 if ($base) {
151 $tz = new Date::Manip::TZ $base;
152 } else {
153210µs20s $tz = new Date::Manip::TZ;
# spent 11.0ms making 2 calls to Date::Manip::Obj::new, avg 5.52ms/call, recursion: max depth 1, sum of overlapping time 11.0ms
154 }
155 }
15652µs $$new{'tz'} = $tz;
157 }
158
15998µs $$new{'args'} = [ @args ];
160910µs bless $new,$class;
161
162917µs910.6ms $new->_init() if ($init);
# spent 10.3ms making 2 calls to Date::Manip::Base::_init, avg 5.13ms/call # spent 286µs making 2 calls to Date::Manip::TZ::_init, avg 143µs/call # spent 28µs making 1 call to Date::Manip::Recur::_init # spent 22µs making 3 calls to Date::Manip::Date::_init, avg 7µs/call # spent 7µs making 1 call to Date::Manip::Delta::_init
16392µs $new->config(@opts) if (@opts);
16491µs $new->_init_args() if (@args);
165920µs9427µs $new->_init_final();
# spent 418µs making 2 calls to Date::Manip::TZ::_init_final, avg 209µs/call # spent 9µs making 7 calls to Date::Manip::Obj::_init_final, avg 1µs/call
166925µ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 9µs within Date::Manip::Obj::_init_final which was called 7 times, avg 1µs/call: # 7 times (9µs+0s) by Date::Manip::Obj::new at line 165, avg 1µs/call
sub _init_final {
17972µs my($self) = @_;
180712µ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
196
# spent 23µs (6+18) within Date::Manip::Obj::new_date which was called: # once (6µs+18µs) by C4::Overdues::BEGIN@25 at line 68 of Date/Manip/DM6.pm
sub new_date {
1971800ns my(@args) = @_;
1981800ns require Date::Manip::Date;
19914µs118µs return new Date::Manip::Date @args;
# spent 18µs making 1 call to Date::Manip::Obj::new
200}
201
# spent 5.20ms (4.93+270µs) within Date::Manip::Obj::new_delta which was called: # once (4.93ms+270µs) by C4::Overdues::BEGIN@25 at line 69 of Date/Manip/DM6.pm
sub new_delta {
2021500ns my(@args) = @_;
2031756µs require Date::Manip::Delta;
20418µs133µs return new Date::Manip::Delta @args;
# spent 33µs making 1 call to Date::Manip::Obj::new
205}
206
# spent 9.11ms (8.86+243µs) within Date::Manip::Obj::new_recur which was called: # once (8.86ms+243µs) by C4::Overdues::BEGIN@25 at line 70 of Date/Manip/DM6.pm
sub new_recur {
2071800ns my(@args) = @_;
2081726µs require Date::Manip::Recur;
209111µs153µs return new Date::Manip::Recur @args;
# spent 53µs making 1 call to Date::Manip::Obj::new
210}
211
212
# spent 4µs within Date::Manip::Obj::base which was called: # once (4µs+0s) by C4::Overdues::BEGIN@25 at line 71 of Date/Manip/DM6.pm
sub base {
2131400ns my($self) = @_;
2141600ns my $t = ref($self);
2151800ns if ($t eq 'Date::Manip::Base') {
216 return undef;
217 } elsif ($t eq 'Date::Manip::TZ') {
218 return $$self{'base'};
219 } else {
2201500ns my $dmt = $$self{'tz'};
22114µs return $$dmt{'base'};
222 }
223}
224
225
# spent 2µs within Date::Manip::Obj::tz which was called: # once (2µs+0s) by C4::Overdues::BEGIN@25 at line 72 of Date/Manip/DM6.pm
sub tz {
2261300ns my($self) = @_;
2271500ns my $t = ref($self);
228
2291500ns if ($t eq 'Date::Manip::Base' ||
230 $t eq 'Date::Manip::TZ') {
231 return undef;
232 }
233
23413µs return $$self{'tz'};
235}
236
237
# spent 1.49ms (11µs+1.48) within Date::Manip::Obj::config which was called: # once (11µs+1.48ms) by C4::Overdues::BEGIN@25 at line 65 of Date/Manip/DM6.pm
sub config {
23811µs my($self,@opts) = @_;
2391300ns my $obj;
24011µs if (ref($self) eq 'Date::Manip::Base' ||
241 ref($self) eq 'Date::Manip::TZ') {
242 $obj = $self;
243 } else {
2441600ns $obj = $$self{'tz'};
245 }
246
24714µs while (@opts) {
2481500ns my $var = shift(@opts);
2491300ns my $val = shift(@opts);
25014µs11.48ms $obj->_config_var($var,$val);
# spent 1.48ms making 1 call to Date::Manip::TZ_Base::_config_var
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:
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.