| File | /usr/local/lib/perl5/site_perl/5.10.1/HTTP/Date.pm |
| Statements Executed | 30 |
| Statement Execution Time | 1.12ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 3 | 1 | 1 | 63µs | 63µs | HTTP::Date::time2str |
| 1 | 1 | 1 | 15µs | 18µs | HTTP::Date::BEGIN@11 |
| 1 | 1 | 1 | 7µs | 43µs | HTTP::Date::BEGIN@14 |
| 0 | 0 | 0 | 0s | 0s | HTTP::Date::parse_date |
| 0 | 0 | 0 | 0s | 0s | HTTP::Date::str2time |
| 0 | 0 | 0 | 0s | 0s | HTTP::Date::time2iso |
| 0 | 0 | 0 | 0s | 0s | HTTP::Date::time2isoz |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package HTTP::Date; | ||||
| 2 | |||||
| 3 | 1 | 600ns | $VERSION = "5.831"; | ||
| 4 | |||||
| 5 | 1 | 14µs | require 5.004; | ||
| 6 | 1 | 300ns | require Exporter; | ||
| 7 | 1 | 6µs | @ISA = qw(Exporter); | ||
| 8 | 1 | 700ns | @EXPORT = qw(time2str str2time); | ||
| 9 | 1 | 600ns | @EXPORT_OK = qw(parse_date time2iso time2isoz); | ||
| 10 | |||||
| 11 | 3 | 42µs | 2 | 21µs | # spent 18µs (15+3) within HTTP::Date::BEGIN@11 which was called
# once (15µs+3µs) by LWP::UserAgent::BEGIN@12 at line 11 # spent 18µs making 1 call to HTTP::Date::BEGIN@11
# spent 3µs making 1 call to strict::import |
| 12 | 1 | 85µs | require Time::Local; | ||
| 13 | |||||
| 14 | 3 | 852µs | 2 | 80µs | # spent 43µs (7+37) within HTTP::Date::BEGIN@14 which was called
# once (7µs+37µs) by LWP::UserAgent::BEGIN@12 at line 14 # spent 43µs making 1 call to HTTP::Date::BEGIN@14
# spent 37µs making 1 call to vars::import |
| 15 | 1 | 5µ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 | 4µs | my %GMT_ZONE = (GMT => 1, UTC => 1, UT => 1, Z => 1); | ||
| 20 | |||||
| 21 | |||||
| 22 | sub time2str (;$) | ||||
| 23 | # spent 63µs within HTTP::Date::time2str which was called 3 times, avg 21µs/call:
# 3 times (63µs+0s) by LWP::UserAgent::send_request at line 196 of LWP/UserAgent.pm, avg 21µs/call | ||||
| 24 | 12 | 68µs | 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 | 30µs | 1; | ||
| 260 | |||||
| 261 | |||||
| 262 | __END__ | ||||
| 263 | |||||
| 264 | =head1 NAME | ||||
| 265 | |||||
| 266 | HTTP::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 | |||||
| 277 | This module provides functions that deal the date formats used by the | ||||
| 278 | HTTP protocol (and then some more). Only the first two functions, | ||||
| 279 | time2str() and str2time(), are exported by default. | ||||
| 280 | |||||
| 281 | =over 4 | ||||
| 282 | |||||
| 283 | =item time2str( [$time] ) | ||||
| 284 | |||||
| 285 | The time2str() function converts a machine time (seconds since epoch) | ||||
| 286 | to a string. If the function is called without an argument or with an | ||||
| 287 | undefined argument, it will use the current time. | ||||
| 288 | |||||
| 289 | The string returned is in the format preferred for the HTTP protocol. | ||||
| 290 | This is a fixed length subset of the format defined by RFC 1123, | ||||
| 291 | represented in Universal Time (GMT). An example of a time stamp | ||||
| 292 | in this format is: | ||||
| 293 | |||||
| 294 | Sun, 06 Nov 1994 08:49:37 GMT | ||||
| 295 | |||||
| 296 | =item str2time( $str [, $zone] ) | ||||
| 297 | |||||
| 298 | The str2time() function converts a string to machine time. It returns | ||||
| 299 | C<undef> if the format of $str is unrecognized, otherwise whatever the | ||||
| 300 | C<Time::Local> functions can make out of the parsed time. Dates | ||||
| 301 | before the system's epoch may not work on all operating systems. The | ||||
| 302 | time formats recognized are the same as for parse_date(). | ||||
| 303 | |||||
| 304 | The function also takes an optional second argument that specifies the | ||||
| 305 | default time zone to use when converting the date. This parameter is | ||||
| 306 | ignored if the zone is found in the date string itself. If this | ||||
| 307 | parameter is missing, and the date string format does not contain any | ||||
| 308 | zone specification, then the local time zone is assumed. | ||||
| 309 | |||||
| 310 | If 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 | ||||
| 312 | to get the date recognized. | ||||
| 313 | |||||
| 314 | =item parse_date( $str ) | ||||
| 315 | |||||
| 316 | This function will try to parse a date string, and then return it as a | ||||
| 317 | list of numerical values followed by a (possible undefined) time zone | ||||
| 318 | specifier; ($year, $month, $day, $hour, $min, $sec, $tz). The $year | ||||
| 319 | returned will B<not> have the number 1900 subtracted from it and the | ||||
| 320 | $month numbers start with 1. | ||||
| 321 | |||||
| 322 | In scalar context the numbers are interpolated in a string of the | ||||
| 323 | "YYYY-MM-DD hh:mm:ss TZ"-format and returned. | ||||
| 324 | |||||
| 325 | If the date is unrecognized, then the empty list is returned. | ||||
| 326 | |||||
| 327 | The 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 | |||||
| 357 | The parser ignores leading and trailing whitespace. It also allow the | ||||
| 358 | seconds to be missing and the month to be numerical in most formats. | ||||
| 359 | |||||
| 360 | If the year is missing, then we assume that the date is the first | ||||
| 361 | matching date I<before> current month. If the year is given with only | ||||
| 362 | 2 digits, then parse_date() will select the century that makes the | ||||
| 363 | year closest to the current date. | ||||
| 364 | |||||
| 365 | =item time2iso( [$time] ) | ||||
| 366 | |||||
| 367 | Same as time2str(), but returns a "YYYY-MM-DD hh:mm:ss"-formatted | ||||
| 368 | string representing time in the local time zone. | ||||
| 369 | |||||
| 370 | =item time2isoz( [$time] ) | ||||
| 371 | |||||
| 372 | Same as time2str(), but returns a "YYYY-MM-DD hh:mm:ssZ"-formatted | ||||
| 373 | string representing Universal Time. | ||||
| 374 | |||||
| 375 | |||||
| 376 | =back | ||||
| 377 | |||||
| 378 | =head1 SEE ALSO | ||||
| 379 | |||||
| 380 | L<perlfunc/time>, L<Time::Zone> | ||||
| 381 | |||||
| 382 | =head1 COPYRIGHT | ||||
| 383 | |||||
| 384 | Copyright 1995-1999, Gisle Aas | ||||
| 385 | |||||
| 386 | This library is free software; you can redistribute it and/or | ||||
| 387 | modify it under the same terms as Perl itself. | ||||
| 388 | |||||
| 389 | =cut |