Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | |
2 | package Time::Zone; | |
3 | ||
4 | =head1 NAME | |
5 | ||
6 | Time::Zone -- miscellaneous timezone manipulations routines | |
7 | ||
8 | =head1 SYNOPSIS | |
9 | ||
10 | use Time::Zone; | |
11 | print tz2zone(); | |
12 | print tz2zone($ENV{'TZ'}); | |
13 | print tz2zone($ENV{'TZ'}, time()); | |
14 | print tz2zone($ENV{'TZ'}, undef, $isdst); | |
15 | $offset = tz_local_offset(); | |
16 | $offset = tz_offset($TZ); | |
17 | ||
18 | =head1 DESCRIPTION | |
19 | ||
20 | This is a collection of miscellaneous timezone manipulation routines. | |
21 | ||
22 | C<tz2zone()> parses the TZ environment variable and returns a timezone | |
23 | string suitable for inclusion in L<date>-like output. It opionally takes | |
24 | a timezone string, a time, and a is-dst flag. | |
25 | ||
26 | C<tz_local_offset()> determins the offset from GMT time in seconds. It | |
27 | only does the calculation once. | |
28 | ||
29 | C<tz_offset()> determines the offset from GMT in seconds of a specified | |
30 | timezone. | |
31 | ||
32 | C<tz_name()> determines the name of the timezone based on its offset | |
33 | ||
34 | =head1 AUTHORS | |
35 | ||
36 | Graham Barr <gbarr@pobox.com> | |
37 | David Muir Sharnoff <muir@idiom.com> | |
38 | Paul Foley <paul@ascent.com> | |
39 | ||
40 | =cut | |
41 | ||
42 | require 5.002; | |
43 | ||
44 | require Exporter; | |
45 | use Carp; | |
46 | use strict; | |
47 | use vars qw(@ISA @EXPORT $VERSION @tz_local); | |
48 | ||
49 | @ISA = qw(Exporter); | |
50 | @EXPORT = qw(tz2zone tz_local_offset tz_offset tz_name); | |
51 | $VERSION = "2.21"; | |
52 | ||
53 | # Parts stolen from code by Paul Foley <paul@ascent.com> | |
54 | ||
55 | sub tz2zone (;$$$) | |
56 | { | |
57 | my($TZ, $time, $isdst) = @_; | |
58 | ||
59 | use vars qw(%tzn_cache); | |
60 | ||
61 | $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '' | |
62 | unless $TZ; | |
63 | ||
64 | # Hack to deal with 'PST8PDT' format of TZ | |
65 | # Note that this can't deal with all the esoteric forms, but it | |
66 | # does recognize the most common: [:]STDoff[DST[off][,rule]] | |
67 | ||
68 | if (! defined $isdst) { | |
69 | my $j; | |
70 | $time = time() unless $time; | |
71 | ($j, $j, $j, $j, $j, $j, $j, $j, $isdst) = localtime($time); | |
72 | } | |
73 | ||
74 | if (defined $tzn_cache{$TZ}->[$isdst]) { | |
75 | return $tzn_cache{$TZ}->[$isdst]; | |
76 | } | |
77 | ||
78 | if ($TZ =~ /^ | |
79 | ( [^:\d+\-,] {3,} ) | |
80 | ( [+-] ? | |
81 | \d {1,2} | |
82 | ( : \d {1,2} ) {0,2} | |
83 | ) | |
84 | ( [^\d+\-,] {3,} )? | |
85 | /x | |
86 | ) { | |
87 | $TZ = $isdst ? $4 : $1; | |
88 | $tzn_cache{$TZ} = [ $1, $4 ]; | |
89 | } else { | |
90 | $tzn_cache{$TZ} = [ $TZ, $TZ ]; | |
91 | } | |
92 | return $TZ; | |
93 | } | |
94 | ||
95 | sub tz_local_offset (;$) | |
96 | { | |
97 | my ($time) = @_; | |
98 | ||
99 | $time = time() unless $time; | |
100 | my (@l) = localtime($time); | |
101 | my $isdst = $l[8]; | |
102 | ||
103 | if (defined($tz_local[$isdst])) { | |
104 | return $tz_local[$isdst]; | |
105 | } | |
106 | ||
107 | $tz_local[$isdst] = &calc_off($time); | |
108 | ||
109 | return $tz_local[$isdst]; | |
110 | } | |
111 | ||
112 | sub calc_off | |
113 | { | |
114 | my ($time) = @_; | |
115 | ||
116 | my (@l) = localtime($time); | |
117 | my (@g) = gmtime($time); | |
118 | ||
119 | my $off; | |
120 | ||
121 | $off = $l[0] - $g[0] | |
122 | + ($l[1] - $g[1]) * 60 | |
123 | + ($l[2] - $g[2]) * 3600; | |
124 | ||
125 | # subscript 7 is yday. | |
126 | ||
127 | if ($l[7] == $g[7]) { | |
128 | # done | |
129 | } elsif ($l[7] == $g[7] + 1) { | |
130 | $off += 86400; | |
131 | } elsif ($l[7] == $g[7] - 1) { | |
132 | $off -= 86400; | |
133 | } elsif ($l[7] < $g[7]) { | |
134 | # crossed over a year boundry! | |
135 | # localtime is beginning of year, gmt is end | |
136 | # therefore local is ahead | |
137 | $off += 86400; | |
138 | } else { | |
139 | $off -= 86400; | |
140 | } | |
141 | ||
142 | return $off; | |
143 | } | |
144 | ||
145 | # constants | |
146 | ||
147 | CONFIG: { | |
148 | use vars qw(%dstZone %zoneOff %dstZoneOff %Zone); | |
149 | ||
150 | my @dstZone = ( | |
151 | # "ndt" => -2*3600-1800, # Newfoundland Daylight | |
152 | "adt" => -3*3600, # Atlantic Daylight | |
153 | "edt" => -4*3600, # Eastern Daylight | |
154 | "cdt" => -5*3600, # Central Daylight | |
155 | "mdt" => -6*3600, # Mountain Daylight | |
156 | "pdt" => -7*3600, # Pacific Daylight | |
157 | "ydt" => -8*3600, # Yukon Daylight | |
158 | "hdt" => -9*3600, # Hawaii Daylight | |
159 | "bst" => +1*3600, # British Summer | |
160 | "mest" => +2*3600, # Middle European Summer | |
161 | "sst" => +2*3600, # Swedish Summer | |
162 | "fst" => +2*3600, # French Summer | |
163 | "cest" => +2*3600, # Central European Daylight | |
164 | "eest" => +3*3600, # Eastern European Summer | |
165 | "wadt" => +8*3600, # West Australian Daylight | |
166 | "kdt" => +10*3600, # Korean Daylight | |
167 | # "cadt" => +10*3600+1800, # Central Australian Daylight | |
168 | "eadt" => +11*3600, # Eastern Australian Daylight | |
169 | "nzd" => +13*3600, # New Zealand Daylight | |
170 | "nzdt" => +13*3600, # New Zealand Daylight | |
171 | ); | |
172 | ||
173 | my @Zone = ( | |
174 | "gmt" => 0, # Greenwich Mean | |
175 | "ut" => 0, # Universal (Coordinated) | |
176 | "utc" => 0, | |
177 | "wet" => 0, # Western European | |
178 | "wat" => -1*3600, # West Africa | |
179 | "at" => -2*3600, # Azores | |
180 | # For completeness. BST is also British Summer, and GST is also Guam Standard. | |
181 | # "bst" => -3*3600, # Brazil Standard | |
182 | # "gst" => -3*3600, # Greenland Standard | |
183 | # "nft" => -3*3600-1800,# Newfoundland | |
184 | # "nst" => -3*3600-1800,# Newfoundland Standard | |
185 | "ewt" => -4*3600, # U.S. Eastern War Time | |
186 | "ast" => -4*3600, # Atlantic Standard | |
187 | "est" => -5*3600, # Eastern Standard | |
188 | "cst" => -6*3600, # Central Standard | |
189 | "mst" => -7*3600, # Mountain Standard | |
190 | "pst" => -8*3600, # Pacific Standard | |
191 | "yst" => -9*3600, # Yukon Standard | |
192 | "hst" => -10*3600, # Hawaii Standard | |
193 | "cat" => -10*3600, # Central Alaska | |
194 | "ahst" => -10*3600, # Alaska-Hawaii Standard | |
195 | "nt" => -11*3600, # Nome | |
196 | "idlw" => -12*3600, # International Date Line West | |
197 | "cet" => +1*3600, # Central European | |
198 | "mez" => +1*3600, # Central European (German) | |
199 | "ect" => +1*3600, # Central European (French) | |
200 | "met" => +1*3600, # Middle European | |
201 | "mewt" => +1*3600, # Middle European Winter | |
202 | "swt" => +1*3600, # Swedish Winter | |
203 | "set" => +1*3600, # Seychelles | |
204 | "fwt" => +1*3600, # French Winter | |
205 | "eet" => +2*3600, # Eastern Europe, USSR Zone 1 | |
206 | "ukr" => +2*3600, # Ukraine | |
207 | "bt" => +3*3600, # Baghdad, USSR Zone 2 | |
208 | # "it" => +3*3600+1800,# Iran | |
209 | "zp4" => +4*3600, # USSR Zone 3 | |
210 | "zp5" => +5*3600, # USSR Zone 4 | |
211 | # "ist" => +5*3600+1800,# Indian Standard | |
212 | "zp6" => +6*3600, # USSR Zone 5 | |
213 | # For completeness. NST is also Newfoundland Stanard, and SST is also Swedish Summer. | |
214 | # "nst" => +6*3600+1800,# North Sumatra | |
215 | # "sst" => +7*3600, # South Sumatra, USSR Zone 6 | |
216 | # "jt" => +7*3600+1800,# Java (3pm in Cronusland!) | |
217 | "wst" => +8*3600, # West Australian Standard | |
218 | "hkt" => +8*3600, # Hong Kong | |
219 | "cct" => +8*3600, # China Coast, USSR Zone 7 | |
220 | "jst" => +9*3600, # Japan Standard, USSR Zone 8 | |
221 | "kst" => +9*3600, # Korean Standard | |
222 | # "cast" => +9*3600+1800,# Central Australian Standard | |
223 | "east" => +10*3600, # Eastern Australian Standard | |
224 | "gst" => +10*3600, # Guam Standard, USSR Zone 9 | |
225 | "nzt" => +12*3600, # New Zealand | |
226 | "nzst" => +12*3600, # New Zealand Standard | |
227 | "idle" => +12*3600, # International Date Line East | |
228 | ); | |
229 | ||
230 | %Zone = @Zone; | |
231 | %dstZone = @dstZone; | |
232 | %zoneOff = reverse(@Zone); | |
233 | %dstZoneOff = reverse(@dstZone); | |
234 | ||
235 | } | |
236 | ||
237 | sub tz_offset (;$$) | |
238 | { | |
239 | my ($zone, $time) = @_; | |
240 | ||
241 | return &tz_local_offset($time) unless($zone); | |
242 | ||
243 | $time = time() unless $time; | |
244 | my(@l) = localtime($time); | |
245 | my $dst = $l[8]; | |
246 | ||
247 | $zone = lc $zone; | |
248 | ||
249 | if($zone =~ /^(([\-\+])\d\d?)(\d\d)$/) { | |
250 | my $v = $2 . $3; | |
251 | return $1 * 3600 + $v * 60; | |
252 | } elsif (exists $dstZone{$zone} && ($dst || !exists $Zone{$zone})) { | |
253 | return $dstZone{$zone}; | |
254 | } elsif(exists $Zone{$zone}) { | |
255 | return $Zone{$zone}; | |
256 | } | |
257 | undef; | |
258 | } | |
259 | ||
260 | sub tz_name (;$$) | |
261 | { | |
262 | my ($off, $dst) = @_; | |
263 | ||
264 | $off = tz_offset() | |
265 | unless(defined $off); | |
266 | ||
267 | $dst = (localtime(time))[8] | |
268 | unless(defined $dst); | |
269 | ||
270 | if (exists $dstZoneOff{$off} && ($dst || !exists $zoneOff{$off})) { | |
271 | return $dstZoneOff{$off}; | |
272 | } elsif (exists $zoneOff{$off}) { | |
273 | return $zoneOff{$off}; | |
274 | } | |
275 | sprintf("%+05d", int($off / 60) * 100 + $off % 60); | |
276 | } | |
277 | ||
278 | 1; |