← 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:45 2010

File /project/perl/lib/HTTP/Date.pm
Statements Executed 1862
Statement Execution Time 27.7ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
4611123.8ms23.8msHTTP::Date::::time2strHTTP::Date::time2str
11221µs21µsHTTP::Date::::CORE:matchHTTP::Date::CORE:match (opcode)
0000s0sHTTP::Date::::BEGINHTTP::Date::BEGIN
0000s0sHTTP::Date::::parse_dateHTTP::Date::parse_date
0000s0sHTTP::Date::::str2timeHTTP::Date::str2time
0000s0sHTTP::Date::::time2isoHTTP::Date::time2iso
0000s0sHTTP::Date::::time2isozHTTP::Date::time2isoz
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package HTTP::Date; # $Date: 2005/12/06 11:09:25 $
2
3162µs121µs$VERSION = sprintf("%d.%02d", q$Revision: 1.47 $ =~ /(\d+)\.(\d+)/);
# spent 21µs making 1 call to HTTP::Date::CORE:match
4
515µsrequire 5.004;
615µsrequire Exporter;
7111µs@ISA = qw(Exporter);
816µs@EXPORT = qw(time2str str2time);
917µs@EXPORT_OK = qw(parse_date time2iso time2isoz);
10
113109µs127µsuse strict;
# spent 27µs making 1 call to strict::import
1215µsrequire Time::Local;
13
1432.34ms1314µsuse vars qw(@DoW @MoY %MoY);
# spent 314µs making 1 call to vars::import
1518µs@DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
1618µs@MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
17118µs@MoY{@MoY} = (1..12);
18
19110µsmy %GMT_ZONE = (GMT => 1, UTC => 1, UT => 1, Z => 1);
20
21
22sub time2str (;$)
23
# spent 23.8ms within HTTP::Date::time2str which was called 461 times, avg 52µs/call: # 461 times (23.8ms+0s) by LWP::UserAgent::send_request at line 233 of LWP/UserAgent.pm, avg 52µs/call
{
24184425.1ms 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
34sub 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
83sub 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
240sub 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
250sub 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
259135µs1;
260
261
262__END__
263
264=head1 NAME
265
266HTTP::Date - date conversion routines
267
268=head1 SYNOPSIS
269
270 use HTTP::Date;
271
272 $string = time2str($time); # Format as GMT ASCII time
273 $time = str2time($string); # convert ASCII date to machine time
274
275=head1 DESCRIPTION
276
277This module provides functions that deal the date formats used by the
278HTTP protocol (and then some more). Only the first two functions,
279time2str() and str2time(), are exported by default.
280
281=over 4
282
283=item time2str( [$time] )
284
285The time2str() function converts a machine time (seconds since epoch)
286to a string. If the function is called without an argument, it will
287use the current time.
288
289The string returned is in the format preferred for the HTTP protocol.
290This is a fixed length subset of the format defined by RFC 1123,
291represented in Universal Time (GMT). An example of a time stamp
292in this format is:
293
294 Sun, 06 Nov 1994 08:49:37 GMT
295
296=item str2time( $str [, $zone] )
297
298The str2time() function converts a string to machine time. It returns
299C<undef> if the format of $str is unrecognized, otherwise whatever the
300C<Time::Local> functions can make out of the parsed time. Dates
301before the system's epoch may not work on all operating systems. The
302time formats recognized are the same as for parse_date().
303
304The function also takes an optional second argument that specifies the
305default time zone to use when converting the date. This parameter is
306ignored if the zone is found in the date string itself. If this
307parameter is missing, and the date string format does not contain any
308zone specification, then the local time zone is assumed.
309
310If the zone is not "C<GMT>" or numerical (like "C<-0800>" or
311"C<+0100>"), then the C<Time::Zone> module must be installed in order
312to get the date recognized.
313
314=item parse_date( $str )
315
316This function will try to parse a date string, and then return it as a
317list of numerical values followed by a (possible undefined) time zone
318specifier; ($year, $month, $day, $hour, $min, $sec, $tz). The $year
319returned will B<not> have the number 1900 subtracted from it and the
320$month numbers start with 1.
321
322In scalar context the numbers are interpolated in a string of the
323"YYYY-MM-DD hh:mm:ss TZ"-format and returned.
324
325If the date is unrecognized, then the empty list is returned.
326
327The function is able to parse the following formats:
328
329 "Wed, 09 Feb 1994 22:23:32 GMT" -- HTTP format
330 "Thu Feb 3 17:03:55 GMT 1994" -- ctime(3) format
331 "Thu Feb 3 00:00:00 1994", -- ANSI C asctime() format
332 "Tuesday, 08-Feb-94 14:15:29 GMT" -- old rfc850 HTTP format
333 "Tuesday, 08-Feb-1994 14:15:29 GMT" -- broken rfc850 HTTP format
334
335 "03/Feb/1994:17:03:55 -0700" -- common logfile format
336 "09 Feb 1994 22:23:32 GMT" -- HTTP format (no weekday)
337 "08-Feb-94 14:15:29 GMT" -- rfc850 format (no weekday)
338 "08-Feb-1994 14:15:29 GMT" -- broken rfc850 format (no weekday)
339
340 "1994-02-03 14:15:29 -0100" -- ISO 8601 format
341 "1994-02-03 14:15:29" -- zone is optional
342 "1994-02-03" -- only date
343 "1994-02-03T14:15:29" -- Use T as separator
344 "19940203T141529Z" -- ISO 8601 compact format
345 "19940203" -- only date
346
347 "08-Feb-94" -- old rfc850 HTTP format (no weekday, no time)
348 "08-Feb-1994" -- broken rfc850 HTTP format (no weekday, no time)
349 "09 Feb 1994" -- proposed new HTTP format (no weekday, no time)
350 "03/Feb/1994" -- common logfile format (no time, no offset)
351
352 "Feb 3 1994" -- Unix 'ls -l' format
353 "Feb 3 17:03" -- Unix 'ls -l' format
354
355 "11-15-96 03:52PM" -- Windows 'dir' format
356
357The parser ignores leading and trailing whitespace. It also allow the
358seconds to be missing and the month to be numerical in most formats.
359
360If the year is missing, then we assume that the date is the first
361matching date I<before> current month. If the year is given with only
3622 digits, then parse_date() will select the century that makes the
363year closest to the current date.
364
365=item time2iso( [$time] )
366
367Same as time2str(), but returns a "YYYY-MM-DD hh:mm:ss"-formatted
368string representing time in the local time zone.
369
370=item time2isoz( [$time] )
371
372Same as time2str(), but returns a "YYYY-MM-DD hh:mm:ssZ"-formatted
373string representing Universal Time.
374
375
376=back
377
378=head1 SEE ALSO
379
380L<perlfunc/time>, L<Time::Zone>
381
382=head1 COPYRIGHT
383
384Copyright 1995-1999, Gisle Aas
385
386This library is free software; you can redistribute it and/or
387modify it under the same terms as Perl itself.
388
389=cut
# spent 21µs within HTTP::Date::CORE:match which was called # once (21µs+0s) by LWP::UserAgent::BEGIN at line 3 of HTTP/Date.pm
sub HTTP::Date::CORE:match; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.