| 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; |