File Coverage

blib/lib/Time/Zone.pm
Criterion Covered Total %
statement 41 67 61.1
branch 12 48 25.0
condition 3 12 25.0
subroutine 8 10 80.0
pod 0 5 0.0
total 64 142 45.0


line stmt bran cond sub pod time code
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 parses the TZ environment variable and returns a timezone
23             string suitable for inclusion in L-like output. It opionally takes
24             a timezone string, a time, and a is-dst flag.
25              
26             C determins the offset from GMT time in seconds. It
27             only does the calculation once.
28              
29             C determines the offset from GMT in seconds of a specified
30             timezone.
31              
32             C determines the name of the timezone based on its offset
33              
34             =head1 AUTHORS
35              
36             Graham Barr
37             David Muir Sharnoff
38             Paul Foley
39              
40             =cut
41              
42             require 5.002;
43              
44             require Exporter;
45 5     5   34 use Carp;
  5         8  
  5         311  
46 5     5   27 use strict;
  5         10  
  5         125  
47 5     5   21 use vars qw(@ISA @EXPORT $VERSION @tz_local);
  5         11  
  5         629  
48              
49             @ISA = qw(Exporter);
50             @EXPORT = qw(tz2zone tz_local_offset tz_offset tz_name);
51             $VERSION = "2.24";
52              
53             # Parts stolen from code by Paul Foley
54              
55             sub tz2zone (;$$$)
56             {
57 0     0 0 0 my($TZ, $time, $isdst) = @_;
58              
59 5     5   35 use vars qw(%tzn_cache);
  5         9  
  5         2670  
60              
61 0 0       0 $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : ''
    0          
    0          
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 0 0       0 if (! defined $isdst) {
69 0         0 my $j;
70 0 0       0 $time = time() unless $time;
71 0         0 ($j, $j, $j, $j, $j, $j, $j, $j, $isdst) = localtime($time);
72             }
73              
74 0 0       0 if (defined $tzn_cache{$TZ}->[$isdst]) {
75 0         0 return $tzn_cache{$TZ}->[$isdst];
76             }
77            
78 0 0       0 if ($TZ =~ /^
79             ( [^:\d+\-,] {3,} )
80             ( [+-] ?
81             \d {1,2}
82             ( : \d {1,2} ) {0,2}
83             )
84             ( [^\d+\-,] {3,} )?
85             /x
86             ) {
87 0 0       0 my $dsttz = defined($4) ? $4 : $1;
88 0 0       0 $TZ = $isdst ? $dsttz : $1;
89 0         0 $tzn_cache{$TZ} = [ $1, $dsttz ];
90             } else {
91 0         0 $tzn_cache{$TZ} = [ $TZ, $TZ ];
92             }
93 0         0 return $TZ;
94             }
95              
96             sub tz_local_offset (;$)
97             {
98 157     157 0 8859 my ($time) = @_;
99              
100 157 50       317 $time = time() unless $time;
101 157         2169 my (@l) = localtime($time);
102 157         378 my $isdst = $l[8];
103              
104 157 100       424 if (defined($tz_local[$isdst])) {
105 154         488 return $tz_local[$isdst];
106             }
107              
108 3         9 $tz_local[$isdst] = &calc_off($time);
109              
110 3         12 return $tz_local[$isdst];
111             }
112              
113             sub calc_off
114             {
115 3     3 0 9 my ($time) = @_;
116              
117 3         50 my (@l) = localtime($time);
118 3         23 my (@g) = gmtime($time);
119              
120 3         5 my $off;
121              
122 3         11 $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 3 50       39 if ($l[7] == $g[7]) {
    0          
    0          
    0          
129             # done
130             } elsif ($l[7] == $g[7] + 1) {
131 0         0 $off += 86400;
132             } elsif ($l[7] == $g[7] - 1) {
133 0         0 $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 0         0 $off += 86400;
139             } else {
140 0         0 $off -= 86400;
141             }
142              
143 3         26 return $off;
144             }
145              
146             # constants
147              
148             CONFIG: {
149 5     5   40 use vars qw(%dstZone %zoneOff %dstZoneOff %Zone);
  5         9  
  5         3634  
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             "akdt" => -8*3600, # Alaska Daylight
160             "ydt" => -8*3600, # Yukon Daylight
161             "hdt" => -9*3600, # Hawaii Daylight
162             "bst" => +1*3600, # British Summer
163             "mest" => +2*3600, # Middle European Summer
164             "metdst" => +2*3600, # Middle European DST
165             "sst" => +2*3600, # Swedish Summer
166             "fst" => +2*3600, # French Summer
167             "cest" => +2*3600, # Central European Daylight
168             "eest" => +3*3600, # Eastern European Summer
169             "msd" => +4*3600, # Moscow Daylight
170             "wadt" => +8*3600, # West Australian Daylight
171             "kdt" => +10*3600, # Korean Daylight
172             # "cadt" => +10*3600+1800, # Central Australian Daylight
173             "aedt" => +11*3600, # Eastern Australian Daylight
174             "eadt" => +11*3600, # Eastern Australian Daylight
175             "nzd" => +13*3600, # New Zealand Daylight
176             "nzdt" => +13*3600, # New Zealand Daylight
177             );
178              
179             my @Zone = (
180             "gmt" => 0, # Greenwich Mean
181             "ut" => 0, # Universal (Coordinated)
182             "utc" => 0,
183             "wet" => 0, # Western European
184             "wat" => -1*3600, # West Africa
185             "at" => -2*3600, # Azores
186             "fnt" => -2*3600, # Brazil Time (Extreme East - Fernando Noronha)
187             "brt" => -3*3600, # Brazil Time (East Standard - Brasilia)
188             # For completeness. BST is also British Summer, and GST is also Guam Standard.
189             # "bst" => -3*3600, # Brazil Standard
190             # "gst" => -3*3600, # Greenland Standard
191             # "nft" => -3*3600-1800,# Newfoundland
192             # "nst" => -3*3600-1800,# Newfoundland Standard
193             "mnt" => -4*3600, # Brazil Time (West Standard - Manaus)
194             "ewt" => -4*3600, # U.S. Eastern War Time
195             "ast" => -4*3600, # Atlantic Standard
196             "est" => -5*3600, # Eastern Standard
197             "act" => -5*3600, # Brazil Time (Extreme West - Acre)
198             "cst" => -6*3600, # Central Standard
199             "mst" => -7*3600, # Mountain Standard
200             "pst" => -8*3600, # Pacific Standard
201             "akst" => -9*3600, # Alaska Standard
202             "yst" => -9*3600, # Yukon Standard
203             "hst" => -10*3600, # Hawaii Standard
204             "cat" => -10*3600, # Central Alaska
205             "ahst" => -10*3600, # Alaska-Hawaii Standard
206             "nt" => -11*3600, # Nome
207             "idlw" => -12*3600, # International Date Line West
208             "cet" => +1*3600, # Central European
209             "mez" => +1*3600, # Central European (German)
210             "ect" => +1*3600, # Central European (French)
211             "met" => +1*3600, # Middle European
212             "mewt" => +1*3600, # Middle European Winter
213             "swt" => +1*3600, # Swedish Winter
214             "set" => +1*3600, # Seychelles
215             "fwt" => +1*3600, # French Winter
216             "eet" => +2*3600, # Eastern Europe, USSR Zone 1
217             "ukr" => +2*3600, # Ukraine
218             "bt" => +3*3600, # Baghdad, USSR Zone 2
219             "msk" => +3*3600, # Moscow
220             # "it" => +3*3600+1800,# Iran
221             "zp4" => +4*3600, # USSR Zone 3
222             "zp5" => +5*3600, # USSR Zone 4
223             # "ist" => +5*3600+1800,# Indian Standard
224             "zp6" => +6*3600, # USSR Zone 5
225             # For completeness. NST is also Newfoundland Stanard, and SST is also Swedish Summer.
226             # "nst" => +6*3600+1800,# North Sumatra
227             # "sst" => +7*3600, # South Sumatra, USSR Zone 6
228             # "jt" => +7*3600+1800,# Java (3pm in Cronusland!)
229             "wst" => +8*3600, # West Australian Standard
230             "hkt" => +8*3600, # Hong Kong
231             "cct" => +8*3600, # China Coast, USSR Zone 7
232             "jst" => +9*3600, # Japan Standard, USSR Zone 8
233             "kst" => +9*3600, # Korean Standard
234             # "cast" => +9*3600+1800,# Central Australian Standard
235             "aest" => +10*3600, # Eastern Australian Standard
236             "east" => +10*3600, # Eastern Australian Standard
237             "gst" => +10*3600, # Guam Standard, USSR Zone 9
238             "nzt" => +12*3600, # New Zealand
239             "nzst" => +12*3600, # New Zealand Standard
240             "idle" => +12*3600, # International Date Line East
241             );
242              
243             %Zone = @Zone;
244             %dstZone = @dstZone;
245             %zoneOff = reverse(@Zone);
246             %dstZoneOff = reverse(@dstZone);
247              
248             }
249              
250             sub tz_offset (;$$)
251             {
252 639     639 0 1266 my ($zone, $time) = @_;
253              
254 639 50       1147 return &tz_local_offset($time) unless($zone);
255              
256 639 100       1239 $time = time() unless $time;
257 639         12997 my(@l) = localtime($time);
258 639         1710 my $dst = $l[8];
259              
260 639         1188 $zone = lc $zone;
261              
262 639 100 33     2782 if($zone =~ /^(([\-\+])\d\d?)(\d\d)$/) {
    100 66        
    50          
263 4         13 my $v = $2 . $3;
264 4         24 return $1 * 3600 + $v * 60;
265             } elsif (exists $dstZone{$zone} && ($dst || !exists $Zone{$zone})) {
266 3         72 return $dstZone{$zone};
267             } elsif(exists $Zone{$zone}) {
268 632         8153 return $Zone{$zone};
269             }
270 0           undef;
271             }
272              
273             sub tz_name (;$$)
274             {
275 0     0 0   my ($off, $dst) = @_;
276              
277 0 0         $off = tz_offset()
278             unless(defined $off);
279              
280 0 0         $dst = (localtime(time))[8]
281             unless(defined $dst);
282              
283 0 0 0       if (exists $dstZoneOff{$off} && ($dst || !exists $zoneOff{$off})) {
    0 0        
284 0           return $dstZoneOff{$off};
285             } elsif (exists $zoneOff{$off}) {
286 0           return $zoneOff{$off};
287             }
288 0           sprintf("%+05d", int($off / 60) * 100 + $off % 60);
289             }
290              
291             1;