← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:55 2010

File /project/perl/lib/Class/Date.pm
Statements Executed 233
Statement Execution Time 38.8ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
641419µs545µsClass::Date::::_set_tz Class::Date::_set_tz
111247µs1.93msClass::Date::::new_from_array Class::Date::new_from_array
111205µs1.68msClass::Date::::_recalc_from_struct Class::Date::_recalc_from_struct
221187µs1.30msClass::Date::::_set_temp_tz Class::Date::_set_temp_tz
722173µs173µsClass::Date::::tzset_xs Class::Date::tzset_xs (xsub)
221137µs137µsClass::Date::::_check_sum Class::Date::_check_sum
11199µs2.07msClass::Date::::new_from_scalar_internal Class::Date::new_from_scalar_internal
11195µs2.25msClass::Date::::new Class::Date::new
11154µs2.13msClass::Date::::new_from_scalar Class::Date::new_from_scalar
22152µs68µsClass::Date::::local_timezone Class::Date::local_timezone
31243µs43µsClass::Date::::CORE:match Class::Date::CORE:match (opcode)
11140µs2.29msClass::Date::::date Class::Date::date
11138µs303µsClass::Date::::_recalc_from_epoch Class::Date::_recalc_from_epoch
11132µs711µsClass::Date::::__ANON__[:290] Class::Date::__ANON__[:290]
11125µs25µsClass::Date::::__ANON__[:308] Class::Date::__ANON__[:308]
11221µs21µsClass::Date::::bootstrap Class::Date::bootstrap (xsub)
21216µs16µsClass::Date::::tzname_xs Class::Date::tzname_xs (xsub)
0000s0sClass::Date::::BEGIN Class::Date::BEGIN
0000s0sClass::Date::Invalid::::AUTOLOADClass::Date::Invalid::AUTOLOAD
0000s0sClass::Date::Invalid::::BEGINClass::Date::Invalid::BEGIN
0000s0sClass::Date::Invalid::::compareClass::Date::Invalid::compare
0000s0sClass::Date::Invalid::::emptyClass::Date::Invalid::empty
0000s0sClass::Date::Invalid::::errmsgClass::Date::Invalid::errmsg
0000s0sClass::Date::Invalid::::errorClass::Date::Invalid::error
0000s0sClass::Date::Invalid::::trueClass::Date::Invalid::true
0000s0sClass::Date::Invalid::::zeroClass::Date::Invalid::zero
0000s0sClass::Date::Rel::::BEGIN Class::Date::Rel::BEGIN
0000s0sClass::Date::Rel::::add Class::Date::Rel::add
0000s0sClass::Date::Rel::::compare Class::Date::Rel::compare
0000s0sClass::Date::Rel::::day Class::Date::Rel::day
0000s0sClass::Date::Rel::::hour Class::Date::Rel::hour
0000s0sClass::Date::Rel::::min Class::Date::Rel::min
0000s0sClass::Date::Rel::::mon Class::Date::Rel::mon
0000s0sClass::Date::Rel::::mon_part Class::Date::Rel::mon_part
0000s0sClass::Date::Rel::::neg Class::Date::Rel::neg
0000s0sClass::Date::Rel::::new Class::Date::Rel::new
0000s0sClass::Date::Rel::::new_copy Class::Date::Rel::new_copy
0000s0sClass::Date::Rel::::new_from_array Class::Date::Rel::new_from_array
0000s0sClass::Date::Rel::::new_from_hash Class::Date::Rel::new_from_hash
0000s0sClass::Date::Rel::::new_from_scalar Class::Date::Rel::new_from_scalar
0000s0sClass::Date::Rel::::new_from_scalar_internal Class::Date::Rel::new_from_scalar_internal
0000s0sClass::Date::Rel::::sec Class::Date::Rel::sec
0000s0sClass::Date::Rel::::sec_part Class::Date::Rel::sec_part
0000s0sClass::Date::Rel::::year Class::Date::Rel::year
0000s0sClass::Date::::__ANON__[:255] Class::Date::__ANON__[:255]
0000s0sClass::Date::::__ANON__[:264] Class::Date::__ANON__[:264]
0000s0sClass::Date::::__ANON__[:282] Class::Date::__ANON__[:282]
0000s0sClass::Date::::__ANON__[:313] Class::Date::__ANON__[:313]
0000s0sClass::Date::::__ANON__[:314] Class::Date::__ANON__[:314]
0000s0sClass::Date::::__ANON__[:315] Class::Date::__ANON__[:315]
0000s0sClass::Date::::__ANON__[:316] Class::Date::__ANON__[:316]
0000s0sClass::Date::::__ANON__[:317] Class::Date::__ANON__[:317]
0000s0sClass::Date::::__ANON__[:318] Class::Date::__ANON__[:318]
0000s0sClass::Date::::__ANON__[:319] Class::Date::__ANON__[:319]
0000s0sClass::Date::::__ANON__[:320] Class::Date::__ANON__[:320]
0000s0sClass::Date::::__ANON__[:321] Class::Date::__ANON__[:321]
0000s0sClass::Date::::__ANON__[:461] Class::Date::__ANON__[:461]
0000s0sClass::Date::::__ANON__[:466] Class::Date::__ANON__[:466]
0000s0sClass::Date::::__ANON__[:496] Class::Date::__ANON__[:496]
0000s0sClass::Date::::_array_from_hash Class::Date::_array_from_hash
0000s0sClass::Date::::_mon Class::Date::_mon
0000s0sClass::Date::::_set_invalid Class::Date::_set_invalid
0000s0sClass::Date::::_wday Class::Date::_wday
0000s0sClass::Date::::_year Class::Date::_year
0000s0sClass::Date::::add Class::Date::add
0000s0sClass::Date::::ampm Class::Date::ampm
0000s0sClass::Date::::aref Class::Date::aref
0000s0sClass::Date::::array Class::Date::array
0000s0sClass::Date::::clone Class::Date::clone
0000s0sClass::Date::::compare Class::Date::compare
0000s0sClass::Date::::day Class::Date::day
0000s0sClass::Date::::days_in_month Class::Date::days_in_month
0000s0sClass::Date::::dmy Class::Date::dmy
0000s0sClass::Date::::epoch Class::Date::epoch
0000s0sClass::Date::::errmsg Class::Date::errmsg
0000s0sClass::Date::::error Class::Date::error
0000s0sClass::Date::::get_epochs Class::Date::get_epochs
0000s0sClass::Date::::gmdate Class::Date::gmdate
0000s0sClass::Date::::hash Class::Date::hash
0000s0sClass::Date::::hms Class::Date::hms
0000s0sClass::Date::::hour Class::Date::hour
0000s0sClass::Date::::href Class::Date::href
0000s0sClass::Date::::import Class::Date::import
0000s0sClass::Date::::is_leap_year Class::Date::is_leap_year
0000s0sClass::Date::::isdst Class::Date::isdst
0000s0sClass::Date::::localdate Class::Date::localdate
0000s0sClass::Date::::mdy Class::Date::mdy
0000s0sClass::Date::::meridiam Class::Date::meridiam
0000s0sClass::Date::::min Class::Date::min
0000s0sClass::Date::::mon Class::Date::mon
0000s0sClass::Date::::monname Class::Date::monname
0000s0sClass::Date::::month_begin Class::Date::month_begin
0000s0sClass::Date::::month_end Class::Date::month_end
0000s0sClass::Date::::new_copy Class::Date::new_copy
0000s0sClass::Date::::new_from_hash Class::Date::new_from_hash
0000s0sClass::Date::::new_from_scalar_date_parse Class::Date::new_from_scalar_date_parse
0000s0sClass::Date::::new_invalid Class::Date::new_invalid
0000s0sClass::Date::::now Class::Date::now
0000s0sClass::Date::::sec Class::Date::sec
0000s0sClass::Date::::sref Class::Date::sref
0000s0sClass::Date::::strftime Class::Date::strftime
0000s0sClass::Date::::string Class::Date::string
0000s0sClass::Date::::struct Class::Date::struct
0000s0sClass::Date::::subtract Class::Date::subtract
0000s0sClass::Date::::to_tz Class::Date::to_tz
0000s0sClass::Date::::trunc Class::Date::trunc
0000s0sClass::Date::::tz Class::Date::tz
0000s0sClass::Date::::tzdst Class::Date::tzdst
0000s0sClass::Date::::tzoffset Class::Date::tzoffset
0000s0sClass::Date::::wday Class::Date::wday
0000s0sClass::Date::::wdayname Class::Date::wdayname
0000s0sClass::Date::::yday Class::Date::yday
0000s0sClass::Date::::year Class::Date::year
0000s0sClass::Date::::ymd Class::Date::ymd
0000s0sClass::Date::::yr Class::Date::yr
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Class::Date;
2# $Id: Date.pm 126 2005-11-21 21:16:16Z dlux $
3
415µsrequire 5.005_03;
5
63124µs128µsuse strict;
# spent 28µs making 1 call to strict::import
7use vars qw(
# spent 1.27ms making 1 call to vars::import
8 $VERSION @EXPORT_OK %EXPORT_TAGS @ISA
9 $DATE_FORMAT $DST_ADJUST $MONTH_BORDER_ADJUST $RANGE_CHECK
10 @NEW_FROM_SCALAR @ERROR_MESSAGES $WARNINGS
11 $DEFAULT_TIMEZONE $LOCAL_TIMEZONE $GMT_TIMEZONE
12 $NOTZ_TIMEZONE $RESTORE_TZ
13396µs);
14398µs1228µsuse Carp;
# spent 228µs making 1 call to Exporter::import
15389µs1266µsuse UNIVERSAL qw(isa);
# spent 266µs making 1 call to Exporter::import
16
17385µs1128µsuse Exporter;
# spent 128µs making 1 call to Exporter::import
18389µs1125µsuse DynaLoader;
# spent 125µs making 1 call to Exporter::import
19322.3ms1237µsuse Time::Local;
# spent 237µs making 1 call to Exporter::import
203882µs11.36msuse Class::Date::Const;
# spent 1.36ms making 1 call to Exporter::import
21
22BEGIN {
23873µs $WARNINGS = 1 if !defined $WARNINGS;
24213µs if ($] > 5.006) {
25 *timelocal = *Time::Local::timelocal_nocheck;
26 *timegm = *Time::Local::timegm_nocheck;
27 } else {
28 *timelocal = *Time::Local::timelocal;
29 *timegm = *Time::Local::timegm;
30 }
31
32 @ISA=qw(DynaLoader Exporter);
33 %EXPORT_TAGS = ( errors => $Class::Date::Const::EXPORT_TAGS{errors});
34 @EXPORT_OK = (qw( date localdate gmdate now @ERROR_MESSAGES),
35 @{$EXPORT_TAGS{errors}});
36
37 $VERSION = '1.1.9';
38131µs127.7ms eval { Class::Date->bootstrap($VERSION); };
# spent 27.7ms making 1 call to DynaLoader::bootstrap
39 if ($@) {
40 warn "Cannot find the XS part of Class::Date, \n".
41 " using strftime, tzset and tzname from POSIX module.\n"
42 if $WARNINGS;
43 require POSIX;
44 *strftime_xs = *POSIX::strftime;
45 *tzset_xs = *POSIX::tzset;
46 *tzname_xs = *POSIX::tzname;
47 }
481618µs}
49
5016µs$GMT_TIMEZONE = 'GMT';
5114µs$DST_ADJUST = 1;
5214µs$MONTH_BORDER_ADJUST = 0;
53126µs$RANGE_CHECK = 0;
5414µs$RESTORE_TZ = 1;
5515µs$DATE_FORMAT="%Y-%m-%d %H:%M:%S";
56
5730466µs
# spent 545µs (419+126) within Class::Date::_set_tz which was called 6 times, avg 91µs/call: # 2 times (161µs+55µs) by Class::Date::_set_temp_tz at line 73, avg 108µs/call # 2 times (126µs+39µs) by Class::Date::_set_temp_tz at line 75, avg 82µs/call # once (72µs+16µs) by Class::DBI::_require_class at line 83 # once (60µs+16µs) by Class::DBI::_require_class at line 85
sub _set_tz { my ($tz) = @_;
58 my $lasttz = $ENV{TZ};
5912103µs if (!defined $tz || $tz eq $NOTZ_TIMEZONE) {
60 # warn "_set_tz: deleting TZ\n";
61 delete $ENV{TZ};
62 Env::C::unsetenv('TZ') if exists $INC{"Env/C.pm"};
63 } else {
64 # warn "_set_tz: setting TZ to $tz\n";
65 $ENV{TZ} = $tz;
66 Env::C::setenv('TZ', $tz) if exists $INC{"Env/C.pm"};
67 }
68 tzset_xs();
# spent 126µs making 6 calls to Class::Date::tzset_xs, avg 21µs/call
69 return $lasttz;
70}
71
7212134µs
# spent 1.30ms (187µs+1.12) within Class::Date::_set_temp_tz which was called 2 times, avg 652µs/call: # once (103µs+936µs) by Class::Date::_recalc_from_struct at line 291 # once (84µs+181µs) by Class::Date::_recalc_from_epoch at line 310
sub _set_temp_tz { my ($tz, $sub) = @_;
73 my $lasttz = _set_tz($tz);
# spent 216µs making 2 calls to Class::Date::_set_tz, avg 108µs/call
74234µs2736µs my $retval = eval { $sub->(); };
# spent 711µs making 1 call to Class::Date::__ANON__[Class/Date.pm:290] # spent 25µs making 1 call to Class::Date::__ANON__[Class/Date.pm:308]
75 _set_tz($lasttz) if $RESTORE_TZ;
# spent 165µs making 2 calls to Class::Date::_set_tz, avg 82µs/call
76 die $@ if $@;
77 return $retval;
78}
79
80184µs147µstzset_xs();
# spent 47µs making 1 call to Class::Date::tzset_xs
81123µs142µs$LOCAL_TIMEZONE = $DEFAULT_TIMEZONE = local_timezone();
# spent 42µs making 1 call to Class::Date::local_timezone
82{
83457µs188µs my $last_tz = _set_tz(undef);
# spent 88µs making 1 call to Class::Date::_set_tz
84 $NOTZ_TIMEZONE = local_timezone();
# spent 26µs making 1 call to Class::Date::local_timezone
85 _set_tz($last_tz);
# spent 76µs making 1 call to Class::Date::_set_tz
86}
87# warn "LOCAL: $LOCAL_TIMEZONE, NOTZ: $NOTZ_TIMEZONE\n";
88
89# this method is used to determine what is the package name of the relative
90# time class. It is used at the operators. You only need to redefine it if
91# you want to derive both Class::Date and Class::Date::Rel.
92# Look at the Class::Date::Rel::ClassDate also.
933364µs1205µsuse constant ClassDateRel => "Class::Date::Rel";
# spent 205µs making 1 call to constant::import
943113µs1173µsuse constant ClassDateInvalid => "Class::Date::Invalid";
# spent 173µs making 1 call to constant::import
95
96use overload
97 '""' => "string",
# spent 476µs making 1 call to overload::import
98 '-' => "subtract",
99 '+' => "add",
100 '<=>' => "compare",
101 'cmp' => "compare",
10237.94ms fallback => 1;
103
1042176µs
# spent 2.29ms (40µs+2.25) within Class::Date::date which was called # once (40µs+2.25ms) by K2::DB2::__ANON__[/project/perllib/K2/DB2.pm:49] at line 48 of K2/DB2.pm
sub date ($;$) { my ($date,$tz)=@_;
105 return __PACKAGE__ -> new($date,$tz);
# spent 2.25ms making 1 call to Class::Date::new
106}
107
108sub now () { date(time); }
109
110sub localdate ($) { date($_[0] || time, $LOCAL_TIMEZONE) }
111
112sub gmdate ($) { date($_[0] || time, $GMT_TIMEZONE) }
113
114sub import {
115 my $package=shift;
116 my @exported;
117 foreach my $symbol (@_) {
118 if ($symbol eq '-DateParse') {
119 if (!$Class::Date::DateParse++) {
120 if ( eval { require Date::Parse } ) {
121 push @NEW_FROM_SCALAR,\&new_from_scalar_date_parse;
122 } else {
123 warn "Date::Parse is not available, although it is requested by Class::Date\n"
124 if $WARNINGS;
125 }
126 }
127 } elsif ($symbol eq '-EnvC') {
128 if (!$Class::Date::EnvC++) {
129 if ( !eval { require Env::C } ) {
130 warn "Env::C is not available, although it is requested by Class::Date\n"
131 if $WARNINGS;
132 }
133 }
134 } else {
135 push @exported,$symbol;
136 }
137 };
138 $package->export_to_level(1,$package,@exported);
139}
140
141686µs
# spent 2.25ms (95µs+2.15) within Class::Date::new which was called # once (95µs+2.15ms) by Class::Date::date at line 105
sub new { my ($proto,$time,$tz)=@_;
142 my $class = ref($proto) || $proto;
143
144 # if the prototype is an object, not a class, then the timezone will be
145 # the same
146 $tz = $proto->[c_tz]
# spent 6µs making 1 call to UNIVERSAL::isa
147 if defined($time) && !defined $tz && isa(ref($proto), __PACKAGE__ );
148
149 # Default timezone is used if the timezone cannot be determined otherwise
150 $tz = $DEFAULT_TIMEZONE if !defined $tz;
151
152 return $proto->new_invalid(E_UNDEFINED,"") if !defined $time;
153129µs217µs if (isa($time, __PACKAGE__ )) {
# spent 17µs making 2 calls to UNIVERSAL::isa, avg 8µs/call
154 return $class->new_copy($time,$tz);
155 } elsif (isa($time,'Class::Date::Rel')) {
156 return $class->new_from_scalar($time,$tz);
157 } elsif (ref($time) eq 'ARRAY') {
158 return $class->new_from_array($time,$tz);
159 } elsif (ref($time) eq 'SCALAR') {
160 return $class->new_from_scalar($$time,$tz);
161 } elsif (ref($time) eq 'HASH') {
162 return $class->new_from_hash($time,$tz);
163 } else {
164 return $class->new_from_scalar($time,$tz);
# spent 2.13ms making 1 call to Class::Date::new_from_scalar
165 }
166}
167
168sub new_copy { my ($s,$input,$tz)=@_;
169 my $new_object=[ @$input ];
170 # we don't mind $isgmt!
171 return bless($new_object, ref($s) || $s);
172}
173
1747245µs
# spent 1.93ms (247µs+1.68) within Class::Date::new_from_array which was called # once (247µs+1.68ms) by Class::Date::new_from_scalar_internal at line 234
sub new_from_array { my ($s,$time,$tz) = @_;
175 my ($y,$m,$d,$hh,$mm,$ss,$dst) = @$time;
176 my $obj= [
177 ($y||2000)-1900, ($m||1)-1, $d||1,
178 $hh||0 , $mm||0 , $ss||0
179 ];
180 $obj->[c_tz]=$tz;
181 bless $obj, ref($s) || $s;
182 $obj->_recalc_from_struct;
# spent 1.68ms making 1 call to Class::Date::_recalc_from_struct
183 return $obj;
184}
185
186sub new_from_hash { my ($s,$time,$tz) = @_;
187 $s->new_from_array(_array_from_hash($time),$tz);
188}
189
190sub _array_from_hash { my ($val)=@_;
191 [
192 $val->{year} || ($val->{_year} ? $val->{_year} + 1900 : 0 ),
193 $val->{mon} || $val->{month} || ( $val->{_mon} ? $val->{_mon} + 1 : 0 ),
194 $val->{day} || $val->{mday} || $val->{day_of_month},
195 $val->{hour},
196 exists $val->{min} ? $val->{min} : $val->{minute},
197 exists $val->{sec} ? $val->{sec} : $val->{second},
198 ];
199}
200
201318µs
# spent 2.13ms (54µs+2.07) within Class::Date::new_from_scalar which was called # once (54µs+2.07ms) by Class::Date::new at line 164
sub new_from_scalar { my ($s,$time,$tz)=@_;
202239µs for (my $i=0;$i<@NEW_FROM_SCALAR;$i++) {
203 my $ret=$NEW_FROM_SCALAR[$i]->($s,$time,$tz);
# spent 2.07ms making 1 call to Class::Date::new_from_scalar_internal
204 return $ret if defined $ret;
205 }
206 return $s->new_invalid(E_UNPARSABLE,$time);
207}
208
209390µs
# spent 2.07ms (99µs+1.97) within Class::Date::new_from_scalar_internal which was called # once (99µs+1.97ms) by Class::Date::new_from_scalar at line 203
sub new_from_scalar_internal { my ($s,$time,$tz) = @_;
210 return undef if !$time;
211
212253µs343µs if ($time eq 'now') {
# spent 43µs making 3 calls to Class::Date::CORE:match, avg 14µs/call
213 # now string
214 my $obj=bless [], ref($s) || $s;
215 $obj->[c_epoch]=time;
216 $obj->[c_tz]=$tz;
217 $obj->_recalc_from_epoch;
218 return $obj;
219 } elsif ($time =~ /^\s*(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)\d*\s*$/) {
220 # mysql timestamp
221 my ($y,$m,$d,$hh,$mm,$ss)=($1,$2,$3,$4,$5,$6);
222 return $s->new_from_array([$y,$m,$d,$hh,$mm,$ss],$tz);
223 } elsif ($time =~ /^\s*( \-? \d+ (\.\d+ )? )\s*$/x) {
224 # epoch secs
225 my $obj=bless [], ref($s) || $s;
226 $obj->[c_epoch]=$1;
227 $obj->[c_tz]=$tz;
228 $obj->_recalc_from_epoch;
229 return $obj;
230 } elsif ($time =~ m{ ^\s* ( \d{0,4} ) - ( \d\d? ) - ( \d\d? )
231 ( \s+ ( \d\d? ) : ( \d\d? ) ( : ( \d\d? ) (\.\d+)?)? )? }x) {
232 my ($y,$m,$d,$hh,$mm,$ss)=($1,$2,$3,$5,$6,$8);
233 # ISO(-like) date
234 return $s->new_from_array([$y,$m,$d,$hh,$mm,$ss],$tz);
# spent 1.93ms making 1 call to Class::Date::new_from_array
235 } else {
236 return undef;
237 }
238}
239
24018µspush @NEW_FROM_SCALAR,\&new_from_scalar_internal;
241
242sub new_from_scalar_date_parse { my ($s,$date,$tz)=@_;
243 my $lt;
244 my ($ss, $mm, $hh, $day, $month, $year, $zone) =
245 Date::Parse::strptime($date);
246 $zone = $tz if !defined $zone;
247 if ($zone eq $GMT_TIMEZONE) {
248 _set_temp_tz($zone, sub {
249 $ss = ($lt ||= [ gmtime ])->[0] if !defined $ss;
250 $mm = ($lt ||= [ gmtime ])->[1] if !defined $mm;
251 $hh = ($lt ||= [ gmtime ])->[2] if !defined $hh;
252 $day = ($lt ||= [ gmtime ])->[3] if !defined $day;
253 $month = ($lt ||= [ gmtime ])->[4] if !defined $month;
254 $year = ($lt ||= [ gmtime ])->[5] if !defined $year;
255 });
256 } else {
257 _set_temp_tz($zone, sub {
258 $ss = ($lt ||= [ localtime ])->[0] if !defined $ss;
259 $mm = ($lt ||= [ localtime ])->[1] if !defined $mm;
260 $hh = ($lt ||= [ localtime ])->[2] if !defined $hh;
261 $day = ($lt ||= [ localtime ])->[3] if !defined $day;
262 $month = ($lt ||= [ localtime ])->[4] if !defined $month;
263 $year = ($lt ||= [ localtime ])->[5] if !defined $year;
264 });
265 }
266 return $s->new_from_array( [$year+1900, $month+1, $day,
267 $hh, $mm, $ss], $zone);
268}
269
2701089µs
# spent 137µs within Class::Date::_check_sum which was called 2 times, avg 68µs/call: # once (69µs+0s) by Class::Date::_recalc_from_struct at line 294 # once (68µs+0s) by Class::Date::_recalc_from_struct at line 296
sub _check_sum { my ($s) = @_;
271 my $sum=0; $sum += $_ || 0 foreach @{$s}[c_year .. c_sec];
272155µs return $sum;
273}
274
275
# spent 1.68ms (205µs+1.48) within Class::Date::_recalc_from_struct which was called # once (205µs+1.48ms) by Class::Date::new_from_array at line 182
sub _recalc_from_struct {
27612129µs my $s = shift;
277 $s->[c_isdst] = -1;
278 $s->[c_wday] = 0;
279 $s->[c_yday] = 0;
280 $s->[c_epoch] = 0; # these are required to suppress warinngs;
281367µs eval {
282 local $SIG{__WARN__} = sub { };
283 my $timecalc = $s->[c_tz] eq $GMT_TIMEZONE ?
284 \&timegm : \&timelocal;
285 _set_temp_tz($s->[c_tz],
286
# spent 711µs (32+679) within Class::Date::__ANON__[/project/perl/lib/Class/Date.pm:290] which was called # once (32µs+679µs) by Class::Date::_set_temp_tz at line 74
sub {
287 $s->[c_epoch] = $timecalc->(
288132µs1679µs @{$s}[c_sec,c_min,c_hour,c_day,c_mon],
# spent 679µs making 1 call to Time::Local::timelocal_nocheck
289 $s->[c_year] + 1900);
290 }
291 );
# spent 1.04ms making 1 call to Class::Date::_set_temp_tz
292 };
293 return $s->_set_invalid(E_INVALID,$@) if $@;
294 my $sum = $s->_check_sum;
# spent 69µs making 1 call to Class::Date::_check_sum
295 $s->_recalc_from_epoch;
# spent 303µs making 1 call to Class::Date::_recalc_from_epoch
296 @$s[c_error,c_errmsg] = (($s->_check_sum != $sum ? E_RANGE : 0), "");
# spent 68µs making 1 call to Class::Date::_check_sum
297 return $s->_set_invalid(E_RANGE,"") if $RANGE_CHECK && $s->[c_error];
298 return 1;
299}
300
301239µs
# spent 303µs (38+265) within Class::Date::_recalc_from_epoch which was called # once (38µs+265µs) by Class::Date::_recalc_from_struct at line 295
sub _recalc_from_epoch { my ($s) = @_;
302 _set_temp_tz($s->[c_tz],
303
# spent 25µs within Class::Date::__ANON__[/project/perl/lib/Class/Date.pm:308] which was called # once (25µs+0s) by Class::Date::_set_temp_tz at line 74
sub {
304131µs @{$s}[c_year..c_isdst] =
305 ($s->[c_tz] eq $GMT_TIMEZONE ?
306 gmtime($s->[c_epoch]) : localtime($s->[c_epoch]))
307 [5,4,3,2,1,0,6,7,8];
308 }
309 )
310}
# spent 265µs making 1 call to Class::Date::_set_temp_tz
311
312my $SETHASH = {
313 year => sub { shift->[c_year] = shift() - 1900 },
314 _year => sub { shift->[c_year] = shift },
315 month => sub { shift->[c_mon] = shift() - 1 },
316 _month => sub { shift->[c_mon] = shift },
317 day => sub { shift->[c_day] = shift },
318 hour => sub { shift->[c_hour] = shift },
319 min => sub { shift->[c_min] = shift },
320 sec => sub { shift->[c_sec] = shift },
321 tz => sub { shift->[c_tz] = shift },
322119µs};
32318µs$SETHASH->{mon} = $SETHASH->{month};
32415µs$SETHASH->{_mon} = $SETHASH->{_month};
32516µs$SETHASH->{mday} = $SETHASH->{day_of_month} = $SETHASH->{day};
32615µs$SETHASH->{minute} = $SETHASH->{min};
32714µs$SETHASH->{second} = $SETHASH->{sec};
328
329sub clone {
330 my $s = shift;
331 my $new_date = $s->new_copy($s);
332 while (@_) {
333 my $key = shift;
334 my $value = shift;
335 $SETHASH->{$key}->($value,$new_date);
336 };
337 $new_date->_recalc_from_struct;
338 return $new_date;
339}
340
34118µs*set = *clone; # compatibility
342
343sub year { shift->[c_year] +1900 }
344sub _year { shift->[c_year] }
345sub yr { shift->[c_year] % 100 }
346sub mon { shift->[c_mon] +1 }
34714µs*month = *mon;
348sub _mon { shift->[c_mon] }
34914µs*_month = *_mon;
350sub day { shift->[c_day] }
35117µs*day_of_month= *mday = *day;
352sub hour { shift->[c_hour] }
353sub min { shift->[c_min] }
35415µs*minute = *min;
355sub sec { shift->[c_sec] }
35615µs*second = *sec;
357sub wday { shift->[c_wday] + 1 }
358sub _wday { shift->[c_wday] }
35915µs*day_of_week = *_wday;
360sub yday { shift->[c_yday] }
36115µs*day_of_year = *yday;
362sub isdst { shift->[c_isdst] }
36316µs*daylight_savings = \&isdst;
364sub epoch { shift->[c_epoch] }
36514µs*as_sec = *epoch; # for compatibility
366sub tz { shift->[c_tz] }
367sub tzdst { shift->strftime("%Z") }
368
369sub monname { shift->strftime('%B') }
37015µs*monthname = *monname;
371sub wdayname { shift->strftime('%A') }
37215µs*day_of_weekname= *wdayname;
373
374sub error { shift->[c_error] }
375sub errmsg { my ($s) = @_;
376 sprintf $ERROR_MESSAGES[ $s->[c_error] ]."\n", $s->[c_errmsg]
377}
37816µs*errstr = *errmsg;
379
380sub new_invalid { my ($proto,$error,$errmsg) = @_;
381 bless([],ref($proto) || $proto)->_set_invalid($error,$errmsg);
382}
383
384sub _set_invalid { my ($s,$error,$errmsg) = @_;
385 bless($s,$s->ClassDateInvalid);
386 @$s = ();
387 @$s[ci_error, ci_errmsg] = ($error,$errmsg);
388 return $s;
389}
390
391sub ampm { my ($s) = @_;
392 return $s->[c_hour] < 12 ? "AM" : "PM";
393}
394
395sub meridiam { my ($s) = @_;
396 my $hour = $s->[c_hour] % 12;
397 if( $hour == 0 ) { $hour = 12; }
398 sprintf('%02d:%02d %s', $hour, $s->[c_min], $s->ampm);
399}
400
401sub hms { sprintf('%02d:%02d:%02d', @{ shift() }[c_hour,c_min,c_sec]) }
402
403sub ymd { my ($s)=@_;
404 sprintf('%04d/%02d/%02d', $s->year, $s->mon, $s->[c_day])
405}
406
407sub mdy { my ($s)=@_;
408 sprintf('%02d/%02d/%04d', $s->mon, $s->[c_day], $s->year)
409}
410
411sub dmy { my ($s)=@_;
412 sprintf('%02d/%02d/%04d', $s->[c_day], $s->mon, $s->year)
413}
414
415sub array { my ($s)=@_;
416 my @return=@{$s}[c_year .. c_sec];
417 $return[c_year]+=1900;
418 $return[c_mon]+=1;
419 @return;
420}
421
422sub aref { return [ shift()->array ] }
42315µs*as_array = *aref;
424
425sub struct {
426 return ( @{ shift() }
427 [c_sec,c_min,c_hour,c_day,c_mon,c_year,c_wday,c_yday,c_isdst] )
428}
429
430sub sref { return [ shift()->struct ] }
431
432sub href { my ($s)=@_;
433 my @struct=$s->struct;
434 my $h={};
435 foreach my $key (qw(sec min hour day _month _year wday yday isdst)) {
436 $h->{$key}=shift @struct;
437 }
438 $h->{epoch} = $s->[c_epoch];
439 $h->{year} = 1900 + $h->{_year};
440 $h->{month} = $h->{_month} + 1;
441 $h->{minute} = $h->{min};
442 return $h;
443}
444
44515µs*as_hash=*href;
446
447sub hash { return %{ shift->href } }
448
449# Thanks to Tony Olekshy <olekshy@cs.ualberta.ca> for this algorithm
450# ripped from Time::Object by Matt Sergeant
451sub tzoffset { my ($s)=@_;
452 my $epoch = $s->[c_epoch];
453 my $j = sub { # Tweaked Julian day number algorithm.
454 my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900;
455 # Standard Julian day number algorithm without constant.
456 my $y1 = $m > 2 ? $y : $y - 1;
457 my $m1 = $m > 2 ? $m + 1 : $m + 13;
458 my $day = int(365.25 * $y1) + int(30.6001 * $m1) + $d;
459 # Modify to include hours/mins/secs in floating portion.
460 return $day + ($h + ($n + $s / 60) / 60) / 24;
461 };
462 # Compute floating offset in hours.
463 my $delta = _set_temp_tz($s->[c_tz],
464 sub {
465 24 * (&$j(localtime $epoch) - &$j(gmtime $epoch));
466 }
467 );
468 # Return value in seconds rounded to nearest minute.
469 return int($delta * 60 + ($delta >= 0 ? 0.5 : -0.5)) * 60;
470}
471
472sub month_begin { my ($s) = @_;
473 my $aref = $s->aref;
474 $aref->[2] = 1;
475 return $s->new($aref);
476}
477
478sub month_end { my ($s)=@_;
479 return $s->clone(day => 1)+'1M'-'1D';
480}
481
482sub days_in_month {
483 shift->month_end->mday;
484}
485
486sub is_leap_year { my ($s) = @_;
487 my $new_date;
488 eval {
489 $new_date = $s->new([$s->year, 2, 29],$s->tz);
490 } or return 0;
491 return $new_date->day == 29;
492}
493
494sub strftime { my ($s,$format)=@_;
495 $format ||= "%a, %d %b %Y %H:%M:%S %Z";
496 my $fmt = _set_temp_tz($s->[c_tz], sub { strftime_xs($format,$s->struct) } );
497 return $fmt;
498}
499
500sub string { my ($s) = @_;
501 $s->strftime($DATE_FORMAT);
502}
503
504sub subtract { my ($s,$rhs)=@_;
505 if (isa(ref($rhs), __PACKAGE__ )) {
506 my $dst_adjust = 0;
507 $dst_adjust = 60*60*( $s->[c_isdst]-$rhs->[c_isdst] ) if $DST_ADJUST;
508 return $s->ClassDateRel->new($s->[c_epoch]-$rhs->[c_epoch]+$dst_adjust);
509 } elsif (isa(ref($rhs), "Class::Date::Rel")) {
510 return $s->add(-$rhs);
511 } elsif ($rhs) {
512 return $s->add($s->ClassDateRel->new($rhs)->neg);
513 } else {
514 return $s;
515 }
516}
517
518sub add { my ($s,$rhs)=@_;
519 local $RANGE_CHECK;
520 $rhs=$s->ClassDateRel->new($rhs) if !isa($rhs,'Class::Date::Rel');
521
522 return $s if !isa($rhs,'Class::Date::Rel');
523
524 # adding seconds
525 my $retval= $rhs->[cs_sec] ?
526 $s->new_from_scalar($s->[c_epoch]+$rhs->[cs_sec],$s->[c_tz]) :
527 $s->new_copy($s);
528
529 # adjust DST if necessary
530 if ( $DST_ADJUST && (my $dstdiff=$retval->[c_isdst]-$s->[c_isdst])) {
531 $retval->[c_epoch] -= $dstdiff*60*60;
532 $retval->_recalc_from_epoch;
533 }
534
535 # adding months
536 if ($rhs->[cs_mon]) {
537 $retval->[c_mon]+=$rhs->[cs_mon];
538 my $year_diff= $retval->[c_mon]>0 ? # instead of POSIX::floor
539 int ($retval->[c_mon]/12) :
540 int (($retval->[c_mon]-11)/12);
541 $retval->[c_mon] -= 12*$year_diff;
542 my $expected_month = $retval->[c_mon];
543 $retval->[c_year] += $year_diff;
544 $retval->_recalc_from_struct;
545
546 # adjust month border if necessary
547 if ($MONTH_BORDER_ADJUST && $retval && $expected_month != $retval->[c_mon]) {
548 $retval->[c_epoch] -= $retval->[c_day]*60*60*24;
549 $retval->_recalc_from_epoch;
550 }
551 }
552
553 # sigh! We have finished!
554 return $retval;
555}
556
557sub trunc { my ($s)=@_;
558 return $s->new_from_array([$s->year,$s->month,$s->day,0,0,0],$s->[c_tz]);
559}
560
56115µs*truncate = *trunc;
562
563sub get_epochs {
564 my ($lhs,$rhs,$reverse)=@_;
565 if (!isa(ref($rhs), __PACKAGE__ )) {
566 $rhs = $lhs->new($rhs);
567 }
568 my $repoch= $rhs ? $rhs->epoch : 0;
569 return $repoch, $lhs->epoch if $reverse;
570 return $lhs->epoch, $repoch;
571}
572
573sub compare {
574 my ($lhs, $rhs) = get_epochs(@_);
575 return $lhs <=> $rhs;
576}
577
578
# spent 68µs (52+16) within Class::Date::local_timezone which was called 2 times, avg 34µs/call: # once (32µs+10µs) by Class::DBI::_require_class at line 81 # once (20µs+6µs) by Class::DBI::_require_class at line 84
sub local_timezone {
579276µs216µs return (tzname_xs())[0];
# spent 16µs making 2 calls to Class::Date::tzname_xs, avg 8µs/call
580}
581
582sub to_tz { my ($s, $tz) = @_;
583 return $s->new($s->epoch, $tz);
584}
585
586package Class::Date::Rel;
587393µs127µsuse strict;
# spent 27µs making 1 call to strict::import
5883103µs1140µsuse vars qw(@NEW_FROM_SCALAR);
# spent 140µs making 1 call to vars::import
589381µs1181µsuse UNIVERSAL qw(isa);
# spent 181µs making 1 call to Exporter::import
5903105µs11.39msuse Class::Date::Const;
# spent 1.39ms making 1 call to Exporter::import
591
592395µs1181µsuse constant SEC_PER_MONTH => 2_629_744;
# spent 181µs making 1 call to constant::import
593
594# see the ClassDateRel const in package Class::Date
5953119µs1187µsuse constant ClassDate => "Class::Date";
# spent 187µs making 1 call to constant::import
596
597use overload
598 '0+' => "sec",
# spent 571µs making 1 call to overload::import
599 '""' => "sec",
600 '<=>' => "compare",
601 'cmp' => "compare",
602 '+' => "add",
603 'neg' => "neg",
60432.04ms fallback => 1;
605
606sub new { my ($proto,$val)=@_;
607 my $class = ref($proto) || $proto;
608 return undef if !defined $val;
609 if (isa(ref($val), __PACKAGE__ )) {
610 return $class->new_copy($val);
611 } elsif (ref($val) eq 'ARRAY') {
612 return $class->new_from_array($val);
613 } elsif (ref($val) eq 'HASH') {
614 return $class->new_from_hash($val);
615 } elsif (ref($val) eq 'SCALAR') {
616 return $class->new_from_scalar($$val);
617 } else {
618 return $class->new_from_scalar($val);
619 };
620}
621
622sub new_copy { my ($s,$val)=@_;
623 return bless([@$val], ref($s)||$s);
624}
625
626sub new_from_array { my ($s,$val) = @_;
627 my ($y,$m,$d,$hh,$mm,$ss) = @$val;
628 return bless([ ($y || 0) * 12 + $m , ($ss || 0) +
629 60*(($mm || 0) + 60*(($hh || 0) + 24* ($d || 0))) ], ref($s)||$s);
630}
631
632sub new_from_hash { my ($s,$val) = @_;
633 $s->new_from_array(Class::Date::_array_from_hash($val));
634}
635
636sub new_from_scalar { my ($s,$val)=@_;
637 for (my $i=0;$i<@NEW_FROM_SCALAR;$i++) {
638 my $ret=$NEW_FROM_SCALAR[$i]->($s,$val);
639 return $ret if defined $ret;
640 }
641 return undef;
642}
643
644sub new_from_scalar_internal { my ($s,$val)=@_;
645 return undef if !defined $val;
646 return bless([0,$1],ref($s) || $s)
647 if $val =~ / ^ \s* ( \-? \d+ ( \. \d* )? ) \s* $/x;
648
649 if ($val =~ m{ ^\s* ( \d{1,4} ) - ( \d\d? ) - ( \d\d? )
650 ( \s+ ( \d\d? ) : ( \d\d? ) ( : ( \d\d? )? (\.\d+)? )? )? }x ) {
651 # ISO date
652 my ($y,$m,$d,$hh,$mm,$ss)=($1,$2,$3,$5,$6,$8);
653 return $s->new_from_array([$y,$m,$d,$hh,$mm,$ss]);
654 }
655
656 my ($y,$m,$d,$hh,$mm,$ss)=(0,0,0,0,0,0);
657 $val =~ s{ \G \s* ( \-? \d+) \s* (Y|M|D|h|m|s) }{
658 my ($num,$cmd)=($1,$2);
659 if ($cmd eq 'Y') {
660 $y=$num;
661 } elsif ($cmd eq 'M') {
662 $m=$num;
663 } elsif ($cmd eq 'D') {
664 $d=$num;
665 } elsif ($cmd eq 'h') {
666 $hh=$num;
667 } elsif ($cmd eq 'm') {
668 $mm=$num;
669 } elsif ($cmd eq 's') {
670 $ss=$num;
671 }
672 "";
673 }gexi;
674 return $s->new_from_array([$y,$m,$d,$hh,$mm,$ss]);
675}
676
67716µspush @NEW_FROM_SCALAR,\&new_from_scalar_internal;
678
679sub compare { my ($s,$val2,$reverse) = @_;
680 my $rev_multiply=$reverse ? -1 : 1;
681 if (isa($val2, __PACKAGE__ )) {
682 return ($s->sec <=> $val2->sec) * $rev_multiply;
683 } else {
684 my $date_obj=$s->new($val2);
685 return ($s->sec <=> 0) * $rev_multiply if !defined $date_obj;
686 return ($s->sec <=> $date_obj->sec) * $rev_multiply;
687 }
688}
689
690sub add { my ($s,$val2)=@_;
691 if (my $reldate=$s->new($val2)) {
692 my $months=$s->[cs_mon] + $reldate->[cs_mon];
693 my $secs =$s->[cs_sec] + $reldate->[cs_sec];
694 return $s->new_from_hash({ month => $months, sec => $secs }) if $months;
695 return $secs;
696 } else {
697 return $s;
698 }
699}
700
701sub neg { my ($s)=@_;
702 return $s->new_from_hash({
703 month => -$s->[cs_mon],
704 sec => -$s->[cs_sec]
705 });
706}
707
708sub year { shift->sec / (SEC_PER_MONTH*12) }
709sub mon { shift->sec / SEC_PER_MONTH }
71015µs*month = *mon;
711sub day { shift->sec / (60*60*24) }
712sub hour { shift->sec / (60*60) }
713sub min { shift->sec / 60 }
71415µs*minute = *min;
715sub sec { my ($s)=@_; $s->[cs_sec] + SEC_PER_MONTH * $s->[cs_mon]; }
71615µs*second = *sec;
717
718sub sec_part { shift->[cs_sec] }
71915µs*second_part = *sec_part;
720sub mon_part { shift->[cs_mon] }
72115µs*month_part = *mon_part;
722
723package Class::Date::Invalid;
724384µs125µsuse strict;
# spent 25µs making 1 call to strict::import
7253147µs11.40msuse Class::Date::Const;
# spent 1.40ms making 1 call to Exporter::import
726
727use overload
728 '0+' => "zero",
# spent 551µs making 1 call to overload::import
729 '""' => "empty",
730 '<=>' => "compare",
731 'cmp' => "compare",
732 '+' => "zero",
733 '!' => "true",
7343573µs fallback => 1;
735
736sub empty { "" }
737sub zero { 0 }
738sub true { 1 }
739
740sub compare { return ($_[1] ? 1 : 0) * ($_[2] ? -1 : 1) }
741
742sub error { shift->[ci_error]; }
743
744sub errmsg { my ($s) = @_;
745 sprintf $ERROR_MESSAGES[ $s->[ci_error] ]."\n", $s->[ci_errmsg]
746}
74715µs*errstr = *errmsg;
748
749sub AUTOLOAD { undef }
750
751164µs1;
# spent 43µs within Class::Date::CORE:match which was called 3 times, avg 14µs/call: # 3 times (43µs+0s) by Class::Date::new_from_scalar_internal at line 212 of Class/Date.pm, avg 14µs/call
sub Class::Date::CORE:match; # xsub
# spent 21µs within Class::Date::bootstrap which was called # once (21µs+0s) by DynaLoader::bootstrap at line 253 of DynaLoader.pm
sub Class::Date::bootstrap; # xsub
# spent 16µs within Class::Date::tzname_xs which was called 2 times, avg 8µs/call: # 2 times (16µs+0s) by Class::Date::local_timezone at line 579 of Class/Date.pm, avg 8µs/call
sub Class::Date::tzname_xs; # xsub
# spent 173µs within Class::Date::tzset_xs which was called 7 times, avg 25µs/call: # 6 times (126µs+0s) by Class::Date::_set_tz at line 68 of Class/Date.pm, avg 21µs/call # once (47µs+0s) by Class::DBI::_require_class at line 80 of Class/Date.pm
sub Class::Date::tzset_xs; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.