File Coverage

blib/lib/Apache/ASP/Date.pm
Criterion Covered Total %
statement 45 69 65.2
branch 17 56 30.3
condition 1 15 6.6
subroutine 7 9 77.7
pod 0 4 0.0
total 70 153 45.7


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 46     46   343 use strict;
  46         83  
  46         2158  
9 46     46   235 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  46         85  
  46         5911  
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 46     46   573185 use Time::Local ();
  46         140163  
  46         1707  
18              
19 46     46   599 use strict;
  46         98  
  46         2325  
20 46     46   1192 use vars qw(@DoW @MoY %MoY);
  46         93  
  46         73321  
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 4     4 0 135 my $time = shift;
37 4 100       22 $time = time unless defined $time;
38 4         23 my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
39 4         108 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 11 local($_) = shift;
50 3 50       10 return undef unless defined;
51 3         7 my($default_zone) = @_;
52              
53             # Remove useless weekday, if it exists
54 3         22 s/^\s*(?:sun|mon|tue|wed|thu|fri|sat)\w*,?\s*//i;
55              
56 3         8 my($day, $mon, $yr, $hr, $min, $sec, $tz, $aorp);
57 3         6 my $offset = 0; # used when compensating for timezone
58              
59 3 50       56 PARSEDATE: {
60             # Then we are able to check for most of the formats with this regexp
61 3         7 ($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       21 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         7 $mon = lc $mon;
156 3 50       15 return undef unless exists $MoY{$mon};
157 3         14 $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       11 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     27 return undef if $yr > 99 && $yr < 1900; # We ignore these years
169 3 50       11 $yr += 100 if $yr < 50; # a stupid thing to do???
170 3 50       13 $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       11 return undef if $yr > 138;
178 3 50       10 return undef if $yr < 70; # 1970 is Unix epoch
179              
180             # Compensate for AM/PM
181 3 50       10 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       10 for ($sec, $min, $hr) { $_ = 0 unless defined }
  9         27  
189              
190             # Should we compensate for the timezone?
191 3 50       10 $tz = $default_zone unless defined $tz;
192 3 50       14 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       13 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         7 eval{Time::Local::timegm($sec, $min, $hr, $day, $mon, $yr) + $offset};
  3         19  
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;