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