File Coverage

blib/lib/Apache/ASP/Date.pm
Criterion Covered Total %
statement 45 69 65.2
branch 16 56 28.6
condition 1 15 6.7
subroutine 7 9 77.8
pod 0 4 0.0
total 69 153 45.1


line stmt bran cond sub pod time code
1             package Apache::ASP::Date;
2              
3             # This package code was taken from HTTP::Date, written by Gisle Aas
4             # Copyright 1995-1997, Gisle Aas
5             # This library is free software; you can redistribute it and/or
6             # modify it under the same terms as Perl itself.
7              
8 14     14   202 use strict;
  14         1988  
  14         232  
9 14     14   212 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  14         133  
  14         204  
10              
11             require 5.002;
12             require Exporter;
13             @ISA = qw(Exporter);
14             @EXPORT = qw(time2str str2time);
15             @EXPORT_OK = qw(time2iso time2isoz);
16              
17 14     14   932 use Time::Local ();
  14         144  
  14         142  
18              
19 14     14   245 use strict;
  14         128  
  14         258  
20 14     14   340 use vars qw(@DoW @MoY %MoY);
  14         136  
  14         247  
21              
22             #@DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
23             @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
24             @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
25             # Build %MoY hash
26             my $i = 0;
27             foreach(@MoY) {
28                $MoY{lc $_} = $i++;
29             }
30              
31             my($current_month, $current_year) = (localtime)[4, 5];
32              
33              
34             sub time2str (;$)
35             {
36 3     3 0 29    my $time = shift;
37 3 50       33    $time = time unless defined $time;
38 3         44    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
39 3         109    sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
40             $DoW[$wday],
41             $mday, $MoY[$mon], $year+1900,
42             $hour, $min, $sec);
43             }
44              
45              
46              
47             sub str2time ($;$)
48             {
49 3     3 0 78    local($_) = shift;
50 3 50       58    return undef unless defined;
51 3         30    my($default_zone) = @_;
52              
53             # Remove useless weekday, if it exists
54 3         127    s/^\s*(?:sun|mon|tue|wed|thu|fri|sat)\w*,?\s*//i;
55              
56 3         30    my($day, $mon, $yr, $hr, $min, $sec, $tz, $aorp);
57 3         28    my $offset = 0; # used when compensating for timezone
58              
59 3 50       95  PARSEDATE: {
60             # Then we are able to check for most of the formats with this regexp
61 3         61       ($day,$mon,$yr,$hr,$min,$sec,$tz) =
62             /^\s*
63             (\d\d?) # day
64             (?:\s+|[-\/])
65             (\w+) # month
66             (?:\s+|[-\/])
67             (\d+) # year
68             (?:
69             (?:\s+|:) # separator before clock
70             (\d\d?):(\d\d) # hour:min
71             (?::(\d\d))? # optional seconds
72             )? # optional clock
73             \s*
74             ([-+]?\d{2,4}|GMT|gmt)? # timezone
75             \s*$
76             /x
77             and last PARSEDATE;
78              
79             # Try the ctime and asctime format
80 0 0       0       ($mon, $day, $hr, $min, $sec, $tz, $yr) =
81             /^\s* # allow intial whitespace
82             (\w{1,3}) # month
83             \s+
84             (\d\d?) # day
85             \s+
86             (\d\d?):(\d\d) # hour:min
87             (?::(\d\d))? # optional seconds
88             \s+
89             (?:(GMT|gmt)\s+)? # optional GMT timezone
90             (\d+) # year
91             \s*$ # allow trailing whitespace
92             /x
93             and last PARSEDATE;
94              
95             # Then the Unix 'ls -l' date format
96 0 0       0       ($mon, $day, $yr, $hr, $min, $sec) =
97             /^\s*
98             (\w{3}) # month
99             \s+
100             (\d\d?) # day
101             \s+
102             (?:
103             (\d\d\d\d) | # year
104             (\d{1,2}):(\d{2}) # hour:min
105             (?::(\d\d))? # optional seconds
106             )
107             \s*$
108             /x
109             and last PARSEDATE;
110              
111             # ISO 8601 format '1996-02-29 12:00:00 -0100' and variants
112 0 0       0       ($yr, $mon, $day, $hr, $min, $sec, $tz) =
113             /^\s*
114             (\d{4}) # year
115             [-\/]?
116             (\d\d?) # numerical month
117             [-\/]?
118             (\d\d?) # day
119             (?:
120             (?:\s+|:|T|-) # separator before clock
121             (\d\d?):?(\d\d) # hour:min
122             (?::?(\d\d))? # optional seconds
123             )? # optional clock
124             \s*
125             ([-+]?\d\d?:?(:?\d\d)?
126             |Z|z)? # timezone (Z is "zero meridian", i.e. GMT)
127             \s*$
128             /x
129             and last PARSEDATE;
130              
131             # Windows 'dir' 11-12-96 03:52PM
132 0 0       0       ($mon, $day, $yr, $hr, $min, $aorp) =
133                     /^\s*
134             (\d{2}) # numerical month
135             -
136             (\d{2}) # day
137             -
138             (\d{2}) # year
139             \s+
140             (\d\d?):(\d\d)([apAP][mM]) # hour:min AM or PM
141             \s*$
142             /x
143                       and last PARSEDATE;
144              
145             # If it is not recognized by now we give up
146 0         0       return undef;
147                }
148              
149             # Translate month name to number
150 3 50       42    if ($mon =~ /^\d+$/) {
151             # numeric month
152 0 0 0     0      return undef if $mon < 1 || $mon > 12;
153 0         0      $mon--;
154                } else {
155 3         30      $mon = lc $mon;
156 3 50       53      return undef unless exists $MoY{$mon};
157 3         77      $mon = $MoY{$mon};
158                }
159              
160             # If the year is missing, we assume some date before the current,
161             # because these date are mostly present on "ls -l" listings.
162 3 50       32    unless (defined $yr) {
163 0         0 $yr = $current_year;
164 0 0       0 $yr-- if $mon > $current_month;
165                 }
166              
167             # Then we check if the year is acceptable
168 3 50 33     52    return undef if $yr > 99 && $yr < 1900; # We ignore these years
169 3 50       83    $yr += 100 if $yr < 50; # a stupid thing to do???
170 3 50       56    $yr -= 1900 if $yr >= 1900;
171             # The $yr is now relative to 1900 (as expected by timelocal())
172              
173             # timelocal() seems to go into an infinite loop if it is given out
174             # of range parameters. Let's check the year at least.
175              
176             # Epoch counter maxes out in year 2038, assuming "time_t" is 32 bit
177 3 50       68    return undef if $yr > 138;
178 3 50       33    return undef if $yr < 70; # 1970 is Unix epoch
179              
180             # Compensate for AM/PM
181 3 50       33    if ($aorp) {
182 0         0        $aorp = uc $aorp;
183 0 0 0     0        $hr = 0 if $hr == 12 && $aorp eq 'AM';
184 0 0 0     0        $hr += 12 if $aorp eq 'PM' && $hr != 12;
185                }
186              
187             # Make sure things are defined
188 3 50       31    for ($sec, $min, $hr) { $_ = 0 unless defined }
  9         93  
189              
190             # Should we compensate for the timezone?
191 3 50       73    $tz = $default_zone unless defined $tz;
192 3 50       30    return eval {Time::Local::timelocal($sec, $min, $hr, $day, $mon, $yr)}
  0         0  
193                  unless defined $tz;
194              
195             # We can calculate offset for numerical time zones
196 3 50       56    if ($tz =~ /^([-+])?(\d\d?):?(\d\d)?$/) {
197 0         0        $offset = 3600 * $2;
198 0 0       0        $offset += 60 * $3 if $3;
199 0 0 0     0        $offset *= -1 if $1 && $1 ne '-';
200                }
201 3         27    eval{Time::Local::timegm($sec, $min, $hr, $day, $mon, $yr) + $offset};
  3         45  
202             }
203              
204              
205              
206             # And then some bloat because I happen to like the ISO 8601 time
207             # format.
208              
209             sub time2iso (;$)
210             {
211 0     0 0      my $time = shift;
212 0 0            $time = time unless defined $time;
213 0              my($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
214 0              sprintf("%04d-%02d-%02d %02d:%02d:%02d",
215             $year+1900, $mon+1, $mday, $hour, $min, $sec);
216             }
217              
218              
219             sub time2isoz (;$)
220             {
221 0     0 0       my $time = shift;
222 0 0             $time = time unless defined $time;
223 0               my($sec,$min,$hour,$mday,$mon,$year) = gmtime($time);
224 0               sprintf("%04d-%02d-%02d %02d:%02d:%02dZ",
225                         $year+1900, $mon+1, $mday, $hour, $min, $sec);
226             }
227              
228             1;
229