Filename | /usr/lib/perl/5.18/Time/Piece.pm |
Statements | Executed 83 statements in 6.81ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.26ms | 3.78ms | BEGIN@7 | Time::Piece::
1 | 1 | 1 | 211µs | 215µs | BEGIN@422 | Time::Piece::
1 | 1 | 1 | 55µs | 150µs | BEGIN@121 | Time::Piece::
1 | 1 | 1 | 46µs | 196µs | BEGIN@8 | Time::Piece::
1 | 1 | 1 | 36µs | 86µs | BEGIN@9 | Time::Piece::
1 | 1 | 1 | 35µs | 95µs | BEGIN@3 | Time::Piece::
1 | 1 | 1 | 29µs | 29µs | bootstrap (xsub) | Time::Piece::
1 | 1 | 1 | 26µs | 75µs | BEGIN@122 | Time::Piece::
1 | 1 | 1 | 25µs | 33µs | export | Time::Piece::
1 | 1 | 1 | 23µs | 162µs | BEGIN@34 | Time::Piece::
1 | 1 | 1 | 22µs | 48µs | BEGIN@42 | Time::Piece::
1 | 1 | 1 | 16µs | 45µs | BEGIN@37 | Time::Piece::
1 | 1 | 1 | 15µs | 48µs | import | Time::Piece::
1 | 1 | 1 | 15µs | 60µs | BEGIN@510 | Time::Piece::
1 | 1 | 1 | 12µs | 46µs | BEGIN@35 | Time::Piece::
1 | 1 | 1 | 12µs | 41µs | BEGIN@36 | Time::Piece::
1 | 1 | 1 | 10µs | 31µs | BEGIN@533 | Time::Piece::
1 | 1 | 1 | 10µs | 38µs | BEGIN@38 | Time::Piece::
1 | 1 | 1 | 10µs | 28µs | BEGIN@575 | Time::Piece::
1 | 1 | 1 | 9µs | 41µs | BEGIN@44 | Time::Piece::
1 | 1 | 1 | 9µs | 35µs | BEGIN@41 | Time::Piece::
1 | 1 | 1 | 8µs | 36µs | BEGIN@39 | Time::Piece::
1 | 1 | 1 | 8µs | 34µs | BEGIN@40 | Time::Piece::
1 | 1 | 1 | 8µs | 34µs | BEGIN@43 | Time::Piece::
1 | 1 | 1 | 4µs | 4µs | __ANON__[:114] | Time::Piece::
1 | 1 | 1 | 4µs | 4µs | __ANON__[:113] | Time::Piece::
0 | 0 | 0 | 0s | 0s | __ANON__[:293] | Time::Piece::
0 | 0 | 0 | 0s | 0s | _is_leap_year | Time::Piece::
0 | 0 | 0 | 0s | 0s | _jd | Time::Piece::
0 | 0 | 0 | 0s | 0s | _mktime | Time::Piece::
0 | 0 | 0 | 0s | 0s | _mon | Time::Piece::
0 | 0 | 0 | 0s | 0s | _wday | Time::Piece::
0 | 0 | 0 | 0s | 0s | _year | Time::Piece::
0 | 0 | 0 | 0s | 0s | add | Time::Piece::
0 | 0 | 0 | 0s | 0s | add_months | Time::Piece::
0 | 0 | 0 | 0s | 0s | add_years | Time::Piece::
0 | 0 | 0 | 0s | 0s | cdate | Time::Piece::
0 | 0 | 0 | 0s | 0s | compare | Time::Piece::
0 | 0 | 0 | 0s | 0s | date_separator | Time::Piece::
0 | 0 | 0 | 0s | 0s | datetime | Time::Piece::
0 | 0 | 0 | 0s | 0s | day_list | Time::Piece::
0 | 0 | 0 | 0s | 0s | dmy | Time::Piece::
0 | 0 | 0 | 0s | 0s | epoch | Time::Piece::
0 | 0 | 0 | 0s | 0s | fullday | Time::Piece::
0 | 0 | 0 | 0s | 0s | fullmonth | Time::Piece::
0 | 0 | 0 | 0s | 0s | get_epochs | Time::Piece::
0 | 0 | 0 | 0s | 0s | gmtime | Time::Piece::
0 | 0 | 0 | 0s | 0s | hms | Time::Piece::
0 | 0 | 0 | 0s | 0s | hour | Time::Piece::
0 | 0 | 0 | 0s | 0s | is_leap_year | Time::Piece::
0 | 0 | 0 | 0s | 0s | isdst | Time::Piece::
0 | 0 | 0 | 0s | 0s | julian_day | Time::Piece::
0 | 0 | 0 | 0s | 0s | localtime | Time::Piece::
0 | 0 | 0 | 0s | 0s | mday | Time::Piece::
0 | 0 | 0 | 0s | 0s | mdy | Time::Piece::
0 | 0 | 0 | 0s | 0s | min | Time::Piece::
0 | 0 | 0 | 0s | 0s | mjd | Time::Piece::
0 | 0 | 0 | 0s | 0s | mon | Time::Piece::
0 | 0 | 0 | 0s | 0s | mon_list | Time::Piece::
0 | 0 | 0 | 0s | 0s | month | Time::Piece::
0 | 0 | 0 | 0s | 0s | month_last_day | Time::Piece::
0 | 0 | 0 | 0s | 0s | new | Time::Piece::
0 | 0 | 0 | 0s | 0s | parse | Time::Piece::
0 | 0 | 0 | 0s | 0s | sec | Time::Piece::
0 | 0 | 0 | 0s | 0s | str_compare | Time::Piece::
0 | 0 | 0 | 0s | 0s | strftime | Time::Piece::
0 | 0 | 0 | 0s | 0s | strptime | Time::Piece::
0 | 0 | 0 | 0s | 0s | subtract | Time::Piece::
0 | 0 | 0 | 0s | 0s | time_separator | Time::Piece::
0 | 0 | 0 | 0s | 0s | tzoffset | Time::Piece::
0 | 0 | 0 | 0s | 0s | wday | Time::Piece::
0 | 0 | 0 | 0s | 0s | wdayname | Time::Piece::
0 | 0 | 0 | 0s | 0s | week | Time::Piece::
0 | 0 | 0 | 0s | 0s | yday | Time::Piece::
0 | 0 | 0 | 0s | 0s | year | Time::Piece::
0 | 0 | 0 | 0s | 0s | ymd | Time::Piece::
0 | 0 | 0 | 0s | 0s | yy | Time::Piece::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Time::Piece; | ||||
2 | |||||
3 | 2 | 89µs | 2 | 155µs | # spent 95µs (35+60) within Time::Piece::BEGIN@3 which was called:
# once (35µs+60µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 3 # spent 95µs making 1 call to Time::Piece::BEGIN@3
# spent 60µs making 1 call to strict::import |
4 | |||||
5 | 1 | 1µs | require Exporter; | ||
6 | 1 | 500ns | require DynaLoader; | ||
7 | 2 | 725µs | 2 | 4.00ms | # spent 3.78ms (2.26+1.51) within Time::Piece::BEGIN@7 which was called:
# once (2.26ms+1.51ms) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 7 # spent 3.78ms making 1 call to Time::Piece::BEGIN@7
# spent 222µs making 1 call to Exporter::import |
8 | 2 | 76µs | 2 | 345µs | # spent 196µs (46+149) within Time::Piece::BEGIN@8 which was called:
# once (46µs+149µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 8 # spent 196µs making 1 call to Time::Piece::BEGIN@8
# spent 149µs making 1 call to Exporter::import |
9 | 2 | 346µs | 2 | 135µs | # spent 86µs (36+50) within Time::Piece::BEGIN@9 which was called:
# once (36µs+50µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 9 # spent 86µs making 1 call to Time::Piece::BEGIN@9
# spent 50µs making 1 call to Exporter::import |
10 | |||||
11 | 1 | 12µs | our @ISA = qw(Exporter DynaLoader); | ||
12 | |||||
13 | 1 | 1µs | our @EXPORT = qw( | ||
14 | localtime | ||||
15 | gmtime | ||||
16 | ); | ||||
17 | |||||
18 | 1 | 2µs | our %EXPORT_TAGS = ( | ||
19 | ':override' => 'internal', | ||||
20 | ); | ||||
21 | |||||
22 | 1 | 300ns | our $VERSION = '1.20_01'; | ||
23 | |||||
24 | 1 | 9µs | 1 | 260µs | bootstrap Time::Piece $VERSION; # spent 260µs making 1 call to DynaLoader::bootstrap |
25 | |||||
26 | 1 | 500ns | my $DATE_SEP = '-'; | ||
27 | 1 | 800ns | my $TIME_SEP = ':'; | ||
28 | 1 | 2µs | my @MON_LIST = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); | ||
29 | 1 | 2µs | my @FULLMON_LIST = qw(January February March April May June July | ||
30 | August September October November December); | ||||
31 | 1 | 1µs | my @DAY_LIST = qw(Sun Mon Tue Wed Thu Fri Sat); | ||
32 | 1 | 2µs | my @FULLDAY_LIST = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); | ||
33 | |||||
34 | 2 | 54µs | 2 | 301µs | # spent 162µs (23+139) within Time::Piece::BEGIN@34 which was called:
# once (23µs+139µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 34 # spent 162µs making 1 call to Time::Piece::BEGIN@34
# spent 139µs making 1 call to constant::import |
35 | 2 | 37µs | 2 | 80µs | # spent 46µs (12+34) within Time::Piece::BEGIN@35 which was called:
# once (12µs+34µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 35 # spent 46µs making 1 call to Time::Piece::BEGIN@35
# spent 34µs making 1 call to constant::import |
36 | 2 | 30µs | 2 | 70µs | # spent 41µs (12+29) within Time::Piece::BEGIN@36 which was called:
# once (12µs+29µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 36 # spent 41µs making 1 call to Time::Piece::BEGIN@36
# spent 29µs making 1 call to constant::import |
37 | 2 | 34µs | 2 | 75µs | # spent 45µs (16+30) within Time::Piece::BEGIN@37 which was called:
# once (16µs+30µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 37 # spent 45µs making 1 call to Time::Piece::BEGIN@37
# spent 30µs making 1 call to constant::import |
38 | 2 | 28µs | 2 | 66µs | # spent 38µs (10+28) within Time::Piece::BEGIN@38 which was called:
# once (10µs+28µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 38 # spent 38µs making 1 call to Time::Piece::BEGIN@38
# spent 28µs making 1 call to constant::import |
39 | 2 | 29µs | 2 | 64µs | # spent 36µs (8+28) within Time::Piece::BEGIN@39 which was called:
# once (8µs+28µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 39 # spent 36µs making 1 call to Time::Piece::BEGIN@39
# spent 28µs making 1 call to constant::import |
40 | 2 | 33µs | 2 | 60µs | # spent 34µs (8+26) within Time::Piece::BEGIN@40 which was called:
# once (8µs+26µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 40 # spent 34µs making 1 call to Time::Piece::BEGIN@40
# spent 26µs making 1 call to constant::import |
41 | 2 | 33µs | 2 | 62µs | # spent 35µs (9+26) within Time::Piece::BEGIN@41 which was called:
# once (9µs+26µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 41 # spent 35µs making 1 call to Time::Piece::BEGIN@41
# spent 26µs making 1 call to constant::import |
42 | 2 | 26µs | 2 | 75µs | # spent 48µs (22+27) within Time::Piece::BEGIN@42 which was called:
# once (22µs+27µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 42 # spent 48µs making 1 call to Time::Piece::BEGIN@42
# spent 27µs making 1 call to constant::import |
43 | 2 | 35µs | 2 | 61µs | # spent 34µs (8+27) within Time::Piece::BEGIN@43 which was called:
# once (8µs+27µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 43 # spent 34µs making 1 call to Time::Piece::BEGIN@43
# spent 27µs making 1 call to constant::import |
44 | 2 | 1.05ms | 2 | 73µs | # spent 41µs (9+32) within Time::Piece::BEGIN@44 which was called:
# once (9µs+32µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 44 # spent 41µs making 1 call to Time::Piece::BEGIN@44
# spent 32µs making 1 call to constant::import |
45 | |||||
46 | sub localtime { | ||||
47 | unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') }; | ||||
48 | my $class = shift; | ||||
49 | my $time = shift; | ||||
50 | $time = time if (!defined $time); | ||||
51 | $class->_mktime($time, 1); | ||||
52 | } | ||||
53 | |||||
54 | sub gmtime { | ||||
55 | unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') }; | ||||
56 | my $class = shift; | ||||
57 | my $time = shift; | ||||
58 | $time = time if (!defined $time); | ||||
59 | $class->_mktime($time, 0); | ||||
60 | } | ||||
61 | |||||
62 | sub new { | ||||
63 | my $class = shift; | ||||
64 | my ($time) = @_; | ||||
65 | |||||
66 | my $self; | ||||
67 | |||||
68 | if (defined($time)) { | ||||
69 | $self = $class->localtime($time); | ||||
70 | } | ||||
71 | elsif (ref($class) && $class->isa(__PACKAGE__)) { | ||||
72 | $self = $class->_mktime($class->epoch, $class->[c_islocal]); | ||||
73 | } | ||||
74 | else { | ||||
75 | $self = $class->localtime(); | ||||
76 | } | ||||
77 | |||||
78 | return bless $self, ref($class) || $class; | ||||
79 | } | ||||
80 | |||||
81 | sub parse { | ||||
82 | my $proto = shift; | ||||
83 | my $class = ref($proto) || $proto; | ||||
84 | my @components; | ||||
85 | if (@_ > 1) { | ||||
86 | @components = @_; | ||||
87 | } | ||||
88 | else { | ||||
89 | @components = shift =~ /(\d+)$DATE_SEP(\d+)$DATE_SEP(\d+)(?:(?:T|\s+)(\d+)$TIME_SEP(\d+)(?:$TIME_SEP(\d+)))/; | ||||
90 | @components = reverse(@components[0..5]); | ||||
91 | } | ||||
92 | return $class->new(_strftime("%s", @components)); | ||||
93 | } | ||||
94 | |||||
95 | sub _mktime { | ||||
96 | my ($class, $time, $islocal) = @_; | ||||
97 | $class = eval { (ref $class) && (ref $class)->isa('Time::Piece') } | ||||
98 | ? ref $class | ||||
99 | : $class; | ||||
100 | if (ref($time)) { | ||||
101 | $time->[c_epoch] = undef; | ||||
102 | return wantarray ? @$time : bless [@$time[0..9], $islocal], $class; | ||||
103 | } | ||||
104 | _tzset(); | ||||
105 | my @time = $islocal ? | ||||
106 | CORE::localtime($time) | ||||
107 | : | ||||
108 | CORE::gmtime($time); | ||||
109 | wantarray ? @time : bless [@time, $time, $islocal], $class; | ||||
110 | } | ||||
111 | |||||
112 | my %_special_exports = ( | ||||
113 | 2 | 6µs | # spent 4µs within Time::Piece::__ANON__[/usr/lib/perl/5.18/Time/Piece.pm:113] which was called:
# once (4µs+0s) by Time::Piece::export at line 123 | ||
114 | 2 | 7µs | # spent 4µs within Time::Piece::__ANON__[/usr/lib/perl/5.18/Time/Piece.pm:114] which was called:
# once (4µs+0s) by Time::Piece::export at line 123 | ||
115 | 1 | 8µs | ); | ||
116 | |||||
117 | # spent 33µs (25+8) within Time::Piece::export which was called:
# once (25µs+8µs) by Time::Piece::import at line 139 | ||||
118 | 1 | 1µs | my ($class, $to, @methods) = @_; | ||
119 | 1 | 5µs | for my $method (@methods) { | ||
120 | 2 | 2µs | if (exists $_special_exports{$method}) { | ||
121 | 2 | 130µs | 2 | 244µs | # spent 150µs (55+95) within Time::Piece::BEGIN@121 which was called:
# once (55µs+95µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 121 # spent 150µs making 1 call to Time::Piece::BEGIN@121
# spent 95µs making 1 call to strict::unimport |
122 | 2 | 2.37ms | 2 | 124µs | # spent 75µs (26+49) within Time::Piece::BEGIN@122 which was called:
# once (26µs+49µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 122 # spent 75µs making 1 call to Time::Piece::BEGIN@122
# spent 49µs making 1 call to warnings::unimport |
123 | 2 | 13µs | 2 | 8µs | *{$to . "::$method"} = $_special_exports{$method}->($class); # spent 4µs making 1 call to Time::Piece::__ANON__[Time/Piece.pm:114]
# spent 4µs making 1 call to Time::Piece::__ANON__[Time/Piece.pm:113] |
124 | } else { | ||||
125 | $class->SUPER::export($to, $method); | ||||
126 | } | ||||
127 | } | ||||
128 | } | ||||
129 | |||||
130 | # spent 48µs (15+33) within Time::Piece::import which was called:
# once (15µs+33µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 13 of HTTP/Headers/ActionPack/Util.pm | ||||
131 | # replace CORE::GLOBAL localtime and gmtime if required | ||||
132 | 1 | 500ns | my $class = shift; | ||
133 | 1 | 300ns | my %params; | ||
134 | 1 | 4µs | map($params{$_}++,@_,@EXPORT); | ||
135 | 1 | 6µs | if (delete $params{':override'}) { | ||
136 | $class->export('CORE::GLOBAL', keys %params); | ||||
137 | } | ||||
138 | else { | ||||
139 | 1 | 4µs | 1 | 33µs | $class->export((caller)[0], keys %params); # spent 33µs making 1 call to Time::Piece::export |
140 | } | ||||
141 | } | ||||
142 | |||||
143 | ## Methods ## | ||||
144 | |||||
145 | sub sec { | ||||
146 | my $time = shift; | ||||
147 | $time->[c_sec]; | ||||
148 | } | ||||
149 | |||||
150 | 1 | 1µs | *second = \&sec; | ||
151 | |||||
152 | sub min { | ||||
153 | my $time = shift; | ||||
154 | $time->[c_min]; | ||||
155 | } | ||||
156 | |||||
157 | 1 | 600ns | *minute = \&min; | ||
158 | |||||
159 | sub hour { | ||||
160 | my $time = shift; | ||||
161 | $time->[c_hour]; | ||||
162 | } | ||||
163 | |||||
164 | sub mday { | ||||
165 | my $time = shift; | ||||
166 | $time->[c_mday]; | ||||
167 | } | ||||
168 | |||||
169 | 1 | 500ns | *day_of_month = \&mday; | ||
170 | |||||
171 | sub mon { | ||||
172 | my $time = shift; | ||||
173 | $time->[c_mon] + 1; | ||||
174 | } | ||||
175 | |||||
176 | sub _mon { | ||||
177 | my $time = shift; | ||||
178 | $time->[c_mon]; | ||||
179 | } | ||||
180 | |||||
181 | sub month { | ||||
182 | my $time = shift; | ||||
183 | if (@_) { | ||||
184 | return $_[$time->[c_mon]]; | ||||
185 | } | ||||
186 | elsif (@MON_LIST) { | ||||
187 | return $MON_LIST[$time->[c_mon]]; | ||||
188 | } | ||||
189 | else { | ||||
190 | return $time->strftime('%b'); | ||||
191 | } | ||||
192 | } | ||||
193 | |||||
194 | 1 | 700ns | *monname = \&month; | ||
195 | |||||
196 | sub fullmonth { | ||||
197 | my $time = shift; | ||||
198 | if (@_) { | ||||
199 | return $_[$time->[c_mon]]; | ||||
200 | } | ||||
201 | elsif (@FULLMON_LIST) { | ||||
202 | return $FULLMON_LIST[$time->[c_mon]]; | ||||
203 | } | ||||
204 | else { | ||||
205 | return $time->strftime('%B'); | ||||
206 | } | ||||
207 | } | ||||
208 | |||||
209 | sub year { | ||||
210 | my $time = shift; | ||||
211 | $time->[c_year] + 1900; | ||||
212 | } | ||||
213 | |||||
214 | sub _year { | ||||
215 | my $time = shift; | ||||
216 | $time->[c_year]; | ||||
217 | } | ||||
218 | |||||
219 | sub yy { | ||||
220 | my $time = shift; | ||||
221 | my $res = $time->[c_year] % 100; | ||||
222 | return $res > 9 ? $res : "0$res"; | ||||
223 | } | ||||
224 | |||||
225 | sub wday { | ||||
226 | my $time = shift; | ||||
227 | $time->[c_wday] + 1; | ||||
228 | } | ||||
229 | |||||
230 | sub _wday { | ||||
231 | my $time = shift; | ||||
232 | $time->[c_wday]; | ||||
233 | } | ||||
234 | |||||
235 | 1 | 400ns | *day_of_week = \&_wday; | ||
236 | |||||
237 | sub wdayname { | ||||
238 | my $time = shift; | ||||
239 | if (@_) { | ||||
240 | return $_[$time->[c_wday]]; | ||||
241 | } | ||||
242 | elsif (@DAY_LIST) { | ||||
243 | return $DAY_LIST[$time->[c_wday]]; | ||||
244 | } | ||||
245 | else { | ||||
246 | return $time->strftime('%a'); | ||||
247 | } | ||||
248 | } | ||||
249 | |||||
250 | 1 | 400ns | *day = \&wdayname; | ||
251 | |||||
252 | sub fullday { | ||||
253 | my $time = shift; | ||||
254 | if (@_) { | ||||
255 | return $_[$time->[c_wday]]; | ||||
256 | } | ||||
257 | elsif (@FULLDAY_LIST) { | ||||
258 | return $FULLDAY_LIST[$time->[c_wday]]; | ||||
259 | } | ||||
260 | else { | ||||
261 | return $time->strftime('%A'); | ||||
262 | } | ||||
263 | } | ||||
264 | |||||
265 | sub yday { | ||||
266 | my $time = shift; | ||||
267 | $time->[c_yday]; | ||||
268 | } | ||||
269 | |||||
270 | 1 | 300ns | *day_of_year = \&yday; | ||
271 | |||||
272 | sub isdst { | ||||
273 | my $time = shift; | ||||
274 | $time->[c_isdst]; | ||||
275 | } | ||||
276 | |||||
277 | 1 | 400ns | *daylight_savings = \&isdst; | ||
278 | |||||
279 | # Thanks to Tony Olekshy <olekshy@cs.ualberta.ca> for this algorithm | ||||
280 | sub tzoffset { | ||||
281 | my $time = shift; | ||||
282 | |||||
283 | return Time::Seconds->new(0) unless $time->[c_islocal]; | ||||
284 | |||||
285 | my $epoch = $time->epoch; | ||||
286 | |||||
287 | my $j = sub { | ||||
288 | |||||
289 | my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900; | ||||
290 | |||||
291 | $time->_jd($y, $m, $d, $h, $n, $s); | ||||
292 | |||||
293 | }; | ||||
294 | |||||
295 | # Compute floating offset in hours. | ||||
296 | # | ||||
297 | # Note use of crt methods so the tz is properly set... | ||||
298 | # See: http://perlmonks.org/?node_id=820347 | ||||
299 | my $delta = 24 * ($j->(_crt_localtime($epoch)) - $j->(_crt_gmtime($epoch))); | ||||
300 | |||||
301 | # Return value in seconds rounded to nearest minute. | ||||
302 | return Time::Seconds->new( int($delta * 60 + ($delta >= 0 ? 0.5 : -0.5)) * 60 ); | ||||
303 | } | ||||
304 | |||||
305 | sub epoch { | ||||
306 | my $time = shift; | ||||
307 | if (defined($time->[c_epoch])) { | ||||
308 | return $time->[c_epoch]; | ||||
309 | } | ||||
310 | else { | ||||
311 | my $epoch = $time->[c_islocal] ? | ||||
312 | timelocal(@{$time}[c_sec .. c_mon], $time->[c_year]+1900) | ||||
313 | : | ||||
314 | timegm(@{$time}[c_sec .. c_mon], $time->[c_year]+1900); | ||||
315 | $time->[c_epoch] = $epoch; | ||||
316 | return $epoch; | ||||
317 | } | ||||
318 | } | ||||
319 | |||||
320 | sub hms { | ||||
321 | my $time = shift; | ||||
322 | my $sep = @_ ? shift(@_) : $TIME_SEP; | ||||
323 | sprintf("%02d$sep%02d$sep%02d", $time->[c_hour], $time->[c_min], $time->[c_sec]); | ||||
324 | } | ||||
325 | |||||
326 | 1 | 400ns | *time = \&hms; | ||
327 | |||||
328 | sub ymd { | ||||
329 | my $time = shift; | ||||
330 | my $sep = @_ ? shift(@_) : $DATE_SEP; | ||||
331 | sprintf("%d$sep%02d$sep%02d", $time->year, $time->mon, $time->[c_mday]); | ||||
332 | } | ||||
333 | |||||
334 | 1 | 300ns | *date = \&ymd; | ||
335 | |||||
336 | sub mdy { | ||||
337 | my $time = shift; | ||||
338 | my $sep = @_ ? shift(@_) : $DATE_SEP; | ||||
339 | sprintf("%02d$sep%02d$sep%d", $time->mon, $time->[c_mday], $time->year); | ||||
340 | } | ||||
341 | |||||
342 | sub dmy { | ||||
343 | my $time = shift; | ||||
344 | my $sep = @_ ? shift(@_) : $DATE_SEP; | ||||
345 | sprintf("%02d$sep%02d$sep%d", $time->[c_mday], $time->mon, $time->year); | ||||
346 | } | ||||
347 | |||||
348 | sub datetime { | ||||
349 | my $time = shift; | ||||
350 | my %seps = (date => $DATE_SEP, T => 'T', time => $TIME_SEP, @_); | ||||
351 | return join($seps{T}, $time->date($seps{date}), $time->time($seps{time})); | ||||
352 | } | ||||
353 | |||||
- - | |||||
356 | # Julian Day is always calculated for UT regardless | ||||
357 | # of local time | ||||
358 | sub julian_day { | ||||
359 | my $time = shift; | ||||
360 | # Correct for localtime | ||||
361 | $time = $time->gmtime( $time->epoch ) if $time->[c_islocal]; | ||||
362 | |||||
363 | # Calculate the Julian day itself | ||||
364 | my $jd = $time->_jd( $time->year, $time->mon, $time->mday, | ||||
365 | $time->hour, $time->min, $time->sec); | ||||
366 | |||||
367 | return $jd; | ||||
368 | } | ||||
369 | |||||
370 | # MJD is defined as JD - 2400000.5 days | ||||
371 | sub mjd { | ||||
372 | return shift->julian_day - 2_400_000.5; | ||||
373 | } | ||||
374 | |||||
375 | # Internal calculation of Julian date. Needed here so that | ||||
376 | # both tzoffset and mjd/jd methods can share the code | ||||
377 | # Algorithm from Hatcher 1984 (QJRAS 25, 53-55), and | ||||
378 | # Hughes et al, 1989, MNRAS, 238, 15 | ||||
379 | # See: http://adsabs.harvard.edu/cgi-bin/nph-bib_query?bibcode=1989MNRAS.238.1529H&db_key=AST | ||||
380 | # for more details | ||||
381 | |||||
382 | sub _jd { | ||||
383 | my $self = shift; | ||||
384 | my ($y, $m, $d, $h, $n, $s) = @_; | ||||
385 | |||||
386 | # Adjust input parameters according to the month | ||||
387 | $y = ( $m > 2 ? $y : $y - 1); | ||||
388 | $m = ( $m > 2 ? $m - 3 : $m + 9); | ||||
389 | |||||
390 | # Calculate the Julian Date (assuming Julian calendar) | ||||
391 | my $J = int( 365.25 *( $y + 4712) ) | ||||
392 | + int( (30.6 * $m) + 0.5) | ||||
393 | + 59 | ||||
394 | + $d | ||||
395 | - 0.5; | ||||
396 | |||||
397 | # Calculate the Gregorian Correction (since we have Gregorian dates) | ||||
398 | my $G = 38 - int( 0.75 * int(49+($y/100))); | ||||
399 | |||||
400 | # Calculate the actual Julian Date | ||||
401 | my $JD = $J + $G; | ||||
402 | |||||
403 | # Modify to include hours/mins/secs in floating portion. | ||||
404 | return $JD + ($h + ($n + $s / 60) / 60) / 24; | ||||
405 | } | ||||
406 | |||||
407 | sub week { | ||||
408 | my $self = shift; | ||||
409 | |||||
410 | my $J = $self->julian_day; | ||||
411 | # Julian day is independent of time zone so add on tzoffset | ||||
412 | # if we are using local time here since we want the week day | ||||
413 | # to reflect the local time rather than UTC | ||||
414 | $J += ($self->tzoffset/(24*3600)) if $self->[c_islocal]; | ||||
415 | |||||
416 | # Now that we have the Julian day including fractions | ||||
417 | # convert it to an integer Julian Day Number using nearest | ||||
418 | # int (since the day changes at midday we oconvert all Julian | ||||
419 | # dates to following midnight). | ||||
420 | $J = int($J+0.5); | ||||
421 | |||||
422 | 2 | 838µs | 2 | 218µs | # spent 215µs (211+4) within Time::Piece::BEGIN@422 which was called:
# once (211µs+4µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 422 # spent 215µs making 1 call to Time::Piece::BEGIN@422
# spent 4µs making 1 call to integer::import |
423 | my $d4 = ((($J + 31741 - ($J % 7)) % 146097) % 36524) % 1461; | ||||
424 | my $L = $d4 / 1460; | ||||
425 | my $d1 = (($d4 - $L) % 365) + $L; | ||||
426 | return $d1 / 7 + 1; | ||||
427 | } | ||||
428 | |||||
429 | sub _is_leap_year { | ||||
430 | my $year = shift; | ||||
431 | return (($year %4 == 0) && !($year % 100 == 0)) || ($year % 400 == 0) | ||||
432 | ? 1 : 0; | ||||
433 | } | ||||
434 | |||||
435 | sub is_leap_year { | ||||
436 | my $time = shift; | ||||
437 | my $year = $time->year; | ||||
438 | return _is_leap_year($year); | ||||
439 | } | ||||
440 | |||||
441 | 1 | 2µs | my @MON_LAST = qw(31 28 31 30 31 30 31 31 30 31 30 31); | ||
442 | |||||
443 | sub month_last_day { | ||||
444 | my $time = shift; | ||||
445 | my $year = $time->year; | ||||
446 | my $_mon = $time->_mon; | ||||
447 | return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0); | ||||
448 | } | ||||
449 | |||||
450 | sub strftime { | ||||
451 | my $time = shift; | ||||
452 | my $tzname = $time->[c_islocal] ? '%Z' : 'UTC'; | ||||
453 | my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S $tzname"; | ||||
454 | if (!defined $time->[c_wday]) { | ||||
455 | if ($time->[c_islocal]) { | ||||
456 | return _strftime($format, CORE::localtime($time->epoch)); | ||||
457 | } | ||||
458 | else { | ||||
459 | return _strftime($format, CORE::gmtime($time->epoch)); | ||||
460 | } | ||||
461 | } | ||||
462 | return _strftime($format, (@$time)[c_sec..c_isdst]); | ||||
463 | } | ||||
464 | |||||
465 | sub strptime { | ||||
466 | my $time = shift; | ||||
467 | my $string = shift; | ||||
468 | my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z"; | ||||
469 | my @vals = _strptime($string, $format); | ||||
470 | # warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals))); | ||||
471 | return scalar $time->_mktime(\@vals, (ref($time) ? $time->[c_islocal] : 0)); | ||||
472 | } | ||||
473 | |||||
474 | sub day_list { | ||||
475 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method | ||||
476 | my @old = @DAY_LIST; | ||||
477 | if (@_) { | ||||
478 | @DAY_LIST = @_; | ||||
479 | } | ||||
480 | return @old; | ||||
481 | } | ||||
482 | |||||
483 | sub mon_list { | ||||
484 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method | ||||
485 | my @old = @MON_LIST; | ||||
486 | if (@_) { | ||||
487 | @MON_LIST = @_; | ||||
488 | } | ||||
489 | return @old; | ||||
490 | } | ||||
491 | |||||
492 | sub time_separator { | ||||
493 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); | ||||
494 | my $old = $TIME_SEP; | ||||
495 | if (@_) { | ||||
496 | $TIME_SEP = $_[0]; | ||||
497 | } | ||||
498 | return $old; | ||||
499 | } | ||||
500 | |||||
501 | sub date_separator { | ||||
502 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); | ||||
503 | my $old = $DATE_SEP; | ||||
504 | if (@_) { | ||||
505 | $DATE_SEP = $_[0]; | ||||
506 | } | ||||
507 | return $old; | ||||
508 | } | ||||
509 | |||||
510 | 1 | 9µs | 1 | 45µs | # spent 60µs (15+45) within Time::Piece::BEGIN@510 which was called:
# once (15µs+45µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 512 # spent 45µs making 1 call to overload::import |
511 | 'cmp' => \&str_compare, | ||||
512 | 1 | 150µs | 1 | 60µs | 'fallback' => undef; # spent 60µs making 1 call to Time::Piece::BEGIN@510 |
513 | |||||
514 | sub cdate { | ||||
515 | my $time = shift; | ||||
516 | if ($time->[c_islocal]) { | ||||
517 | return scalar(CORE::localtime($time->epoch)); | ||||
518 | } | ||||
519 | else { | ||||
520 | return scalar(CORE::gmtime($time->epoch)); | ||||
521 | } | ||||
522 | } | ||||
523 | |||||
524 | sub str_compare { | ||||
525 | my ($lhs, $rhs, $reverse) = @_; | ||||
526 | if (UNIVERSAL::isa($rhs, 'Time::Piece')) { | ||||
527 | $rhs = "$rhs"; | ||||
528 | } | ||||
529 | return $reverse ? $rhs cmp $lhs->cdate : $lhs->cdate cmp $rhs; | ||||
530 | } | ||||
531 | |||||
532 | use overload | ||||
533 | 1 | 6µs | 1 | 21µs | # spent 31µs (10+21) within Time::Piece::BEGIN@533 which was called:
# once (10µs+21µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 534 # spent 21µs making 1 call to overload::import |
534 | 1 | 216µs | 1 | 31µs | '+' => \&add; # spent 31µs making 1 call to Time::Piece::BEGIN@533 |
535 | |||||
536 | sub subtract { | ||||
537 | my $time = shift; | ||||
538 | my $rhs = shift; | ||||
539 | if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { | ||||
540 | $rhs = $rhs->seconds; | ||||
541 | } | ||||
542 | |||||
543 | if (shift) | ||||
544 | { | ||||
545 | # SWAPED is set (so someone tried an expression like NOTDATE - DATE). | ||||
546 | # Imitate Perl's standard behavior and return the result as if the | ||||
547 | # string $time resolves to was subtracted from NOTDATE. This way, | ||||
548 | # classes which override this one and which have a stringify function | ||||
549 | # that resolves to something that looks more like a number don't need | ||||
550 | # to override this function. | ||||
551 | return $rhs - "$time"; | ||||
552 | } | ||||
553 | |||||
554 | if (UNIVERSAL::isa($rhs, 'Time::Piece')) { | ||||
555 | return Time::Seconds->new($time->epoch - $rhs->epoch); | ||||
556 | } | ||||
557 | else { | ||||
558 | # rhs is seconds. | ||||
559 | return $time->_mktime(($time->epoch - $rhs), $time->[c_islocal]); | ||||
560 | } | ||||
561 | } | ||||
562 | |||||
563 | sub add { | ||||
564 | my $time = shift; | ||||
565 | my $rhs = shift; | ||||
566 | if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { | ||||
567 | $rhs = $rhs->seconds; | ||||
568 | } | ||||
569 | croak "Invalid rhs of addition: $rhs" if ref($rhs); | ||||
570 | |||||
571 | return $time->_mktime(($time->epoch + $rhs), $time->[c_islocal]); | ||||
572 | } | ||||
573 | |||||
574 | use overload | ||||
575 | 2 | 348µs | 2 | 46µs | # spent 28µs (10+18) within Time::Piece::BEGIN@575 which was called:
# once (10µs+18µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 575 # spent 28µs making 1 call to Time::Piece::BEGIN@575
# spent 18µs making 1 call to overload::import |
576 | |||||
577 | sub get_epochs { | ||||
578 | my ($lhs, $rhs, $reverse) = @_; | ||||
579 | if (!UNIVERSAL::isa($rhs, 'Time::Piece')) { | ||||
580 | $rhs = $lhs->new($rhs); | ||||
581 | } | ||||
582 | if ($reverse) { | ||||
583 | return $rhs->epoch, $lhs->epoch; | ||||
584 | } | ||||
585 | return $lhs->epoch, $rhs->epoch; | ||||
586 | } | ||||
587 | |||||
588 | sub compare { | ||||
589 | my ($lhs, $rhs) = get_epochs(@_); | ||||
590 | return $lhs <=> $rhs; | ||||
591 | } | ||||
592 | |||||
593 | sub add_months { | ||||
594 | my ($time, $num_months) = @_; | ||||
595 | |||||
596 | croak("add_months requires a number of months") unless defined($num_months); | ||||
597 | |||||
598 | my $final_month = $time->_mon + $num_months; | ||||
599 | my $num_years = 0; | ||||
600 | if ($final_month > 11 || $final_month < 0) { | ||||
601 | # these two ops required because we have no POSIX::floor and don't | ||||
602 | # want to load POSIX.pm | ||||
603 | if ($final_month < 0 && $final_month % 12 == 0) { | ||||
604 | $num_years = int($final_month / 12) + 1; | ||||
605 | } | ||||
606 | else { | ||||
607 | $num_years = int($final_month / 12); | ||||
608 | } | ||||
609 | $num_years-- if ($final_month < 0); | ||||
610 | |||||
611 | $final_month = $final_month % 12; | ||||
612 | } | ||||
613 | |||||
614 | my @vals = _mini_mktime($time->sec, $time->min, $time->hour, | ||||
615 | $time->mday, $final_month, $time->year - 1900 + $num_years); | ||||
616 | # warn(sprintf("got %d vals: %d-%d-%d %d:%d:%d [%d]\n", scalar(@vals), reverse(@vals), $time->[c_islocal])); | ||||
617 | return scalar $time->_mktime(\@vals, $time->[c_islocal]); | ||||
618 | } | ||||
619 | |||||
620 | sub add_years { | ||||
621 | my ($time, $years) = @_; | ||||
622 | $time->add_months($years * 12); | ||||
623 | } | ||||
624 | |||||
625 | 1 | 18µs | 1; | ||
626 | __END__ | ||||
# spent 29µs within Time::Piece::bootstrap which was called:
# once (29µs+0s) by DynaLoader::bootstrap at line 207 of DynaLoader.pm |