home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / Time / Zone.pm
Encoding:
Perl POD Document  |  2009-12-12  |  8.2 KB  |  292 lines
  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(1)>-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.24";
  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.         "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.     my ($zone, $time) = @_;
  253.  
  254.     return &tz_local_offset($time) unless($zone);
  255.  
  256.     $time = time() unless $time;
  257.     my(@l) = localtime($time);
  258.     my $dst = $l[8];
  259.  
  260.     $zone = lc $zone;
  261.  
  262.     if($zone =~ /^(([\-\+])\d\d?)(\d\d)$/) {
  263.         my $v = $2 . $3;
  264.         return $1 * 3600 + $v * 60;
  265.     } elsif (exists $dstZone{$zone} && ($dst || !exists $Zone{$zone})) {
  266.         return $dstZone{$zone};
  267.     } elsif(exists $Zone{$zone}) {
  268.         return $Zone{$zone};
  269.     }
  270.     undef;
  271. }
  272.  
  273. sub tz_name (;$$)
  274. {
  275.     my ($off, $dst) = @_;
  276.  
  277.     $off = tz_offset()
  278.         unless(defined $off);
  279.  
  280.     $dst = (localtime(time))[8]
  281.         unless(defined $dst);
  282.  
  283.     if (exists $dstZoneOff{$off} && ($dst || !exists $zoneOff{$off})) {
  284.         return $dstZoneOff{$off};
  285.     } elsif (exists $zoneOff{$off}) {
  286.         return $zoneOff{$off};
  287.     }
  288.     sprintf("%+05d", int($off / 60) * 100 + $off % 60);
  289. }
  290.  
  291. 1;
  292.