| 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.22"; |
|---|
| 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 |
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 |
|
|---|
| 96 |
sub 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 |
|
|---|
| 113 |
sub 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 |
|
|---|
| 148 |
CONFIG: { |
|---|
| 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 |
|
|---|
| 243 |
sub 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 |
|
|---|
| 266 |
sub 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 |
|
|---|
| 284 |
1; |
|---|
