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