Filename | /usr/share/perl5/HTTP/Date.pm |
Statements | Executed 18 statements in 1.48ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 20µs | 27µs | BEGIN@11 | HTTP::Date::
1 | 1 | 1 | 15µs | 88µs | BEGIN@14 | HTTP::Date::
0 | 0 | 0 | 0s | 0s | parse_date | HTTP::Date::
0 | 0 | 0 | 0s | 0s | str2time | HTTP::Date::
0 | 0 | 0 | 0s | 0s | time2iso | HTTP::Date::
0 | 0 | 0 | 0s | 0s | time2isoz | HTTP::Date::
0 | 0 | 0 | 0s | 0s | time2str | HTTP::Date::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package HTTP::Date; | ||||
2 | |||||
3 | 1 | 1µs | $VERSION = "5.831"; | ||
4 | |||||
5 | 1 | 56µs | require 5.004; | ||
6 | 1 | 1µs | require Exporter; | ||
7 | 1 | 11µs | @ISA = qw(Exporter); | ||
8 | 1 | 900ns | @EXPORT = qw(time2str str2time); | ||
9 | 1 | 1µs | @EXPORT_OK = qw(parse_date time2iso time2isoz); | ||
10 | |||||
11 | 3 | 41µs | 2 | 33µs | # spent 27µs (20+6) within HTTP::Date::BEGIN@11 which was called:
# once (20µs+6µs) by LWP::UserAgent::BEGIN@12 at line 11 # spent 27µs making 1 call to HTTP::Date::BEGIN@11
# spent 6µs making 1 call to strict::import |
12 | 1 | 128µs | require Time::Local; | ||
13 | |||||
14 | 3 | 1.20ms | 2 | 160µs | # spent 88µs (15+72) within HTTP::Date::BEGIN@14 which was called:
# once (15µs+72µs) by LWP::UserAgent::BEGIN@12 at line 14 # spent 88µs making 1 call to HTTP::Date::BEGIN@14
# spent 72µs making 1 call to vars::import |
15 | 1 | 4µs | @DoW = qw(Sun Mon Tue Wed Thu Fri Sat); | ||
16 | 1 | 4µs | @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); | ||
17 | 1 | 8µs | @MoY{@MoY} = (1..12); | ||
18 | |||||
19 | 1 | 3µs | my %GMT_ZONE = (GMT => 1, UTC => 1, UT => 1, Z => 1); | ||
20 | |||||
21 | |||||
22 | sub time2str (;$) | ||||
23 | { | ||||
24 | my $time = shift; | ||||
25 | $time = time unless defined $time; | ||||
26 | my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time); | ||||
27 | sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", | ||||
28 | $DoW[$wday], | ||||
29 | $mday, $MoY[$mon], $year+1900, | ||||
30 | $hour, $min, $sec); | ||||
31 | } | ||||
32 | |||||
33 | |||||
34 | sub str2time ($;$) | ||||
35 | { | ||||
36 | my $str = shift; | ||||
37 | return undef unless defined $str; | ||||
38 | |||||
39 | # fast exit for strictly conforming string | ||||
40 | if ($str =~ /^[SMTWF][a-z][a-z], (\d\d) ([JFMAJSOND][a-z][a-z]) (\d\d\d\d) (\d\d):(\d\d):(\d\d) GMT$/) { | ||||
41 | return eval { | ||||
42 | my $t = Time::Local::timegm($6, $5, $4, $1, $MoY{$2}-1, $3); | ||||
43 | $t < 0 ? undef : $t; | ||||
44 | }; | ||||
45 | } | ||||
46 | |||||
47 | my @d = parse_date($str); | ||||
48 | return undef unless @d; | ||||
49 | $d[1]--; # month | ||||
50 | |||||
51 | my $tz = pop(@d); | ||||
52 | unless (defined $tz) { | ||||
53 | unless (defined($tz = shift)) { | ||||
54 | return eval { my $frac = $d[-1]; $frac -= ($d[-1] = int($frac)); | ||||
55 | my $t = Time::Local::timelocal(reverse @d) + $frac; | ||||
56 | $t < 0 ? undef : $t; | ||||
57 | }; | ||||
58 | } | ||||
59 | } | ||||
60 | |||||
61 | my $offset = 0; | ||||
62 | if ($GMT_ZONE{uc $tz}) { | ||||
63 | # offset already zero | ||||
64 | } | ||||
65 | elsif ($tz =~ /^([-+])?(\d\d?):?(\d\d)?$/) { | ||||
66 | $offset = 3600 * $2; | ||||
67 | $offset += 60 * $3 if $3; | ||||
68 | $offset *= -1 if $1 && $1 eq '-'; | ||||
69 | } | ||||
70 | else { | ||||
71 | eval { require Time::Zone } || return undef; | ||||
72 | $offset = Time::Zone::tz_offset($tz); | ||||
73 | return undef unless defined $offset; | ||||
74 | } | ||||
75 | |||||
76 | return eval { my $frac = $d[-1]; $frac -= ($d[-1] = int($frac)); | ||||
77 | my $t = Time::Local::timegm(reverse @d) + $frac; | ||||
78 | $t < 0 ? undef : $t - $offset; | ||||
79 | }; | ||||
80 | } | ||||
81 | |||||
82 | |||||
83 | sub parse_date ($) | ||||
84 | { | ||||
85 | local($_) = shift; | ||||
86 | return unless defined; | ||||
87 | |||||
88 | # More lax parsing below | ||||
89 | s/^\s+//; # kill leading space | ||||
90 | s/^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[a-z]*,?\s*//i; # Useless weekday | ||||
91 | |||||
92 | my($day, $mon, $yr, $hr, $min, $sec, $tz, $ampm); | ||||
93 | |||||
94 | # Then we are able to check for most of the formats with this regexp | ||||
95 | (($day,$mon,$yr,$hr,$min,$sec,$tz) = | ||||
96 | /^ | ||||
97 | (\d\d?) # day | ||||
98 | (?:\s+|[-\/]) | ||||
99 | (\w+) # month | ||||
100 | (?:\s+|[-\/]) | ||||
101 | (\d+) # year | ||||
102 | (?: | ||||
103 | (?:\s+|:) # separator before clock | ||||
104 | (\d\d?):(\d\d) # hour:min | ||||
105 | (?::(\d\d))? # optional seconds | ||||
106 | )? # optional clock | ||||
107 | \s* | ||||
108 | ([-+]?\d{2,4}|(?![APap][Mm]\b)[A-Za-z]+)? # timezone | ||||
109 | \s* | ||||
110 | (?:\(\w+\))? # ASCII representation of timezone in parens. | ||||
111 | \s*$ | ||||
112 | /x) | ||||
113 | |||||
114 | || | ||||
115 | |||||
116 | # Try the ctime and asctime format | ||||
117 | (($mon, $day, $hr, $min, $sec, $tz, $yr) = | ||||
118 | /^ | ||||
119 | (\w{1,3}) # month | ||||
120 | \s+ | ||||
121 | (\d\d?) # day | ||||
122 | \s+ | ||||
123 | (\d\d?):(\d\d) # hour:min | ||||
124 | (?::(\d\d))? # optional seconds | ||||
125 | \s+ | ||||
126 | (?:([A-Za-z]+)\s+)? # optional timezone | ||||
127 | (\d+) # year | ||||
128 | \s*$ # allow trailing whitespace | ||||
129 | /x) | ||||
130 | |||||
131 | || | ||||
132 | |||||
133 | # Then the Unix 'ls -l' date format | ||||
134 | (($mon, $day, $yr, $hr, $min, $sec) = | ||||
135 | /^ | ||||
136 | (\w{3}) # month | ||||
137 | \s+ | ||||
138 | (\d\d?) # day | ||||
139 | \s+ | ||||
140 | (?: | ||||
141 | (\d\d\d\d) | # year | ||||
142 | (\d{1,2}):(\d{2}) # hour:min | ||||
143 | (?::(\d\d))? # optional seconds | ||||
144 | ) | ||||
145 | \s*$ | ||||
146 | /x) | ||||
147 | |||||
148 | || | ||||
149 | |||||
150 | # ISO 8601 format '1996-02-29 12:00:00 -0100' and variants | ||||
151 | (($yr, $mon, $day, $hr, $min, $sec, $tz) = | ||||
152 | /^ | ||||
153 | (\d{4}) # year | ||||
154 | [-\/]? | ||||
155 | (\d\d?) # numerical month | ||||
156 | [-\/]? | ||||
157 | (\d\d?) # day | ||||
158 | (?: | ||||
159 | (?:\s+|[-:Tt]) # separator before clock | ||||
160 | (\d\d?):?(\d\d) # hour:min | ||||
161 | (?::?(\d\d(?:\.\d*)?))? # optional seconds (and fractional) | ||||
162 | )? # optional clock | ||||
163 | \s* | ||||
164 | ([-+]?\d\d?:?(:?\d\d)? | ||||
165 | |Z|z)? # timezone (Z is "zero meridian", i.e. GMT) | ||||
166 | \s*$ | ||||
167 | /x) | ||||
168 | |||||
169 | || | ||||
170 | |||||
171 | # Windows 'dir' 11-12-96 03:52PM | ||||
172 | (($mon, $day, $yr, $hr, $min, $ampm) = | ||||
173 | /^ | ||||
174 | (\d{2}) # numerical month | ||||
175 | - | ||||
176 | (\d{2}) # day | ||||
177 | - | ||||
178 | (\d{2}) # year | ||||
179 | \s+ | ||||
180 | (\d\d?):(\d\d)([APap][Mm]) # hour:min AM or PM | ||||
181 | \s*$ | ||||
182 | /x) | ||||
183 | |||||
184 | || | ||||
185 | return; # unrecognized format | ||||
186 | |||||
187 | # Translate month name to number | ||||
188 | $mon = $MoY{$mon} || | ||||
189 | $MoY{"\u\L$mon"} || | ||||
190 | ($mon =~ /^\d\d?$/ && $mon >= 1 && $mon <= 12 && int($mon)) || | ||||
191 | return; | ||||
192 | |||||
193 | # If the year is missing, we assume first date before the current, | ||||
194 | # because of the formats we support such dates are mostly present | ||||
195 | # on "ls -l" listings. | ||||
196 | unless (defined $yr) { | ||||
197 | my $cur_mon; | ||||
198 | ($cur_mon, $yr) = (localtime)[4, 5]; | ||||
199 | $yr += 1900; | ||||
200 | $cur_mon++; | ||||
201 | $yr-- if $mon > $cur_mon; | ||||
202 | } | ||||
203 | elsif (length($yr) < 3) { | ||||
204 | # Find "obvious" year | ||||
205 | my $cur_yr = (localtime)[5] + 1900; | ||||
206 | my $m = $cur_yr % 100; | ||||
207 | my $tmp = $yr; | ||||
208 | $yr += $cur_yr - $m; | ||||
209 | $m -= $tmp; | ||||
210 | $yr += ($m > 0) ? 100 : -100 | ||||
211 | if abs($m) > 50; | ||||
212 | } | ||||
213 | |||||
214 | # Make sure clock elements are defined | ||||
215 | $hr = 0 unless defined($hr); | ||||
216 | $min = 0 unless defined($min); | ||||
217 | $sec = 0 unless defined($sec); | ||||
218 | |||||
219 | # Compensate for AM/PM | ||||
220 | if ($ampm) { | ||||
221 | $ampm = uc $ampm; | ||||
222 | $hr = 0 if $hr == 12 && $ampm eq 'AM'; | ||||
223 | $hr += 12 if $ampm eq 'PM' && $hr != 12; | ||||
224 | } | ||||
225 | |||||
226 | return($yr, $mon, $day, $hr, $min, $sec, $tz) | ||||
227 | if wantarray; | ||||
228 | |||||
229 | if (defined $tz) { | ||||
230 | $tz = "Z" if $tz =~ /^(GMT|UTC?|[-+]?0+)$/; | ||||
231 | } | ||||
232 | else { | ||||
233 | $tz = ""; | ||||
234 | } | ||||
235 | return sprintf("%04d-%02d-%02d %02d:%02d:%02d%s", | ||||
236 | $yr, $mon, $day, $hr, $min, $sec, $tz); | ||||
237 | } | ||||
238 | |||||
239 | |||||
240 | sub time2iso (;$) | ||||
241 | { | ||||
242 | my $time = shift; | ||||
243 | $time = time unless defined $time; | ||||
244 | my($sec,$min,$hour,$mday,$mon,$year) = localtime($time); | ||||
245 | sprintf("%04d-%02d-%02d %02d:%02d:%02d", | ||||
246 | $year+1900, $mon+1, $mday, $hour, $min, $sec); | ||||
247 | } | ||||
248 | |||||
249 | |||||
250 | sub time2isoz (;$) | ||||
251 | { | ||||
252 | my $time = shift; | ||||
253 | $time = time unless defined $time; | ||||
254 | my($sec,$min,$hour,$mday,$mon,$year) = gmtime($time); | ||||
255 | sprintf("%04d-%02d-%02d %02d:%02d:%02dZ", | ||||
256 | $year+1900, $mon+1, $mday, $hour, $min, $sec); | ||||
257 | } | ||||
258 | |||||
259 | 1 | 21µs | 1; | ||
260 | |||||
261 | |||||
262 | __END__ |