home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / Time / Timezone.pm < prev    next >
Text File  |  1997-01-17  |  7KB  |  273 lines
  1.  
  2. package Time::Timezone;
  3.  
  4. require 5.002;
  5.  
  6. require Exporter;
  7. @ISA = qw(Exporter);
  8. @EXPORT = qw(tz2zone tz_local_offset tz_offset tz_name);
  9. @EXPORT_OK = qw();
  10.  
  11. use Carp;
  12. use strict;
  13.  
  14. # Parts stolen from code by Paul Foley <paul@ascent.com>
  15.  
  16. use vars qw($VERSION);
  17.  
  18. $VERSION = 97.011701;
  19.  
  20. sub tz2zone
  21. {
  22.     my($TZ, $time, $isdst) = @_;
  23.  
  24.     use vars qw(%tzn_cache);
  25.  
  26.     $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : ''
  27.         unless $TZ;
  28.  
  29.     # Hack to deal with 'PST8PDT' format of TZ
  30.     # Note that this can't deal with all the esoteric forms, but it
  31.     # does recognize the most common: [:]STDoff[DST[off][,rule]]
  32.  
  33.     if (! defined $isdst) {
  34.         my $j;
  35.         $time = time() unless $time;
  36.         ($j, $j, $j, $j, $j, $j, $j, $j, $isdst) = localtime($time);
  37.     }
  38.  
  39.     if (defined $tzn_cache{$TZ}->[$isdst]) {
  40.         return $tzn_cache{$TZ}->[$isdst];
  41.     }
  42.       
  43.     if ($TZ =~ /^
  44.             ( [^:\d+\-,] {3,} )
  45.             ( [+-] ?
  46.               \d {1,2}
  47.               ( : \d {1,2} ) {0,2} 
  48.             )
  49.             ( [^\d+\-,] {3,} )?
  50.             /x
  51.         ) {
  52.         $TZ = $isdst ? $4 : $1;
  53.         $tzn_cache{$TZ} = [ $1, $4 ];
  54.     } else {
  55.         $tzn_cache{$TZ} = [ $TZ, $TZ ];
  56.     }
  57.     return $TZ;
  58. }
  59.  
  60. sub tz_local_offset
  61. {
  62.     my ($time) = @_;
  63.  
  64.     $time = time() unless $time;
  65.     my (@l) = localtime($time);
  66.     my $isdst = $l[8];
  67.  
  68.     if (defined($Timezone::tz_local[$isdst])) {
  69.         return $Timezone::tz_local[$isdst];
  70.     }
  71.  
  72.     $Timezone::tz_local[$isdst] = &calc_off($time);
  73.  
  74.     return $Timezone::tz_local[$isdst];
  75. }
  76.  
  77. sub calc_off
  78. {
  79.     my ($time) = @_;
  80.  
  81.     my (@l) = localtime($time);
  82.     my (@g) = gmtime($time);
  83.  
  84.     my $off;
  85.  
  86.     $off =     $l[0] - $g[0]
  87.         + ($l[1] - $g[1]) * 60
  88.         + ($l[2] - $g[2]) * 3600;
  89.  
  90.     # subscript 7 is yday.
  91.  
  92.     if ($l[7] == $g[7]) {
  93.         # done
  94.     } elsif ($l[7] == $g[7] + 1) {
  95.         $off += 86400;
  96.     } elsif ($l[7] == $g[7] - 1) {
  97.         $off -= 86400;
  98.     } elsif ($l[7] < $g[7]) {
  99.         # crossed over a year boundry!
  100.         # localtime is beginning of year, gmt is end
  101.         # therefore local is ahead
  102.         $off += 86400;
  103.     } else {
  104.         $off -= 86400;
  105.     }
  106.  
  107.     return $off;
  108. }
  109.  
  110. # constants
  111. # The rest of the file comes from Graham Barr <bodg@tiuk.ti.com>
  112.  
  113. CONFIG: {
  114.     use vars qw(%dstZone %zoneOff %dstZoneOff %Zone);
  115.  
  116.     %dstZone = (
  117.     #   "ndt"  =>   -2*3600-1800,     # Newfoundland Daylight   
  118.         "adt"  =>   -3*3600,       # Atlantic Daylight   
  119.         "edt"  =>   -4*3600,       # Eastern Daylight
  120.         "cdt"  =>   -5*3600,       # Central Daylight
  121.         "mdt"  =>   -6*3600,       # Mountain Daylight
  122.         "pdt"  =>   -7*3600,       # Pacific Daylight
  123.         "ydt"  =>   -8*3600,       # Yukon Daylight
  124.         "hdt"  =>   -9*3600,       # Hawaii Daylight
  125.         "bst"  =>   +1*3600,       # British Summer   
  126.         "mest" =>   +2*3600,       # Middle European Summer   
  127.         "sst"  =>   +2*3600,       # Swedish Summer
  128.         "fst"  =>   +2*3600,       # French Summer
  129.         "wadt" =>   +8*3600,       # West Australian Daylight
  130.     #   "cadt" =>  +10*3600+1800,     # Central Australian Daylight
  131.         "eadt" =>  +11*3600,       # Eastern Australian Daylight
  132.         "nzdt" =>  +13*3600,       # New Zealand Daylight   
  133.     );
  134.  
  135.     %Zone = (
  136.         "gmt"    =>   0,       # Greenwich Mean
  137.         "ut"        =>   0,       # Universal (Coordinated)
  138.         "utc"       =>   0,
  139.         "wet"       =>   0,       # Western European
  140.         "wat"       =>  -1*3600,     # West Africa
  141.         "at"        =>  -2*3600,     # Azores
  142.     # For completeness.  BST is also British Summer, and GST is also Guam Standard.
  143.     #   "bst"       =>  -3*3600,     # Brazil Standard
  144.     #   "gst"       =>  -3*3600,     # Greenland Standard
  145.     #   "nft"       =>  -3*3600-1800,# Newfoundland
  146.     #   "nst"       =>  -3*3600-1800,# Newfoundland Standard
  147.         "ast"       =>  -4*3600,     # Atlantic Standard
  148.         "est"       =>  -5*3600,     # Eastern Standard
  149.         "cst"       =>  -6*3600,     # Central Standard
  150.         "mst"       =>  -7*3600,     # Mountain Standard
  151.         "pst"       =>  -8*3600,     # Pacific Standard
  152.         "yst"    =>  -9*3600,     # Yukon Standard
  153.         "hst"    => -10*3600,     # Hawaii Standard
  154.         "cat"    => -10*3600,     # Central Alaska
  155.         "ahst"    => -10*3600,     # Alaska-Hawaii Standard
  156.         "nt"    => -11*3600,     # Nome
  157.         "idlw"    => -12*3600,     # International Date Line West
  158.         "cet"    =>  +1*3600,      # Central European
  159.         "met"    =>  +1*3600,      # Middle European
  160.         "mewt"    =>  +1*3600,      # Middle European Winter
  161.         "swt"    =>  +1*3600,      # Swedish Winter
  162.         "fwt"    =>  +1*3600,      # French Winter
  163.         "eet"    =>  +2*3600,      # Eastern Europe, USSR Zone 1
  164.         "bt"    =>  +3*3600,      # Baghdad, USSR Zone 2
  165.     #   "it"    =>  +3*3600+1800,# Iran
  166.         "zp4"    =>  +4*3600,      # USSR Zone 3
  167.         "zp5"    =>  +5*3600,      # USSR Zone 4
  168.     #   "ist"    =>  +5*3600+1800,# Indian Standard
  169.         "zp6"    =>  +6*3600,      # USSR Zone 5
  170.     # For completeness.  NST is also Newfoundland Stanard, and SST is also Swedish Summer.
  171.     #   "nst"    =>  +6*3600+1800,# North Sumatra
  172.     #   "sst"    =>  +7*3600,      # South Sumatra, USSR Zone 6
  173.         "wast"    =>  +7*3600,      # West Australian Standard
  174.     #   "jt"    =>  +7*3600+1800,# Java (3pm in Cronusland!)
  175.         "cct"    =>  +8*3600,      # China Coast, USSR Zone 7
  176.         "jst"    =>  +9*3600,     # Japan Standard, USSR Zone 8
  177.     #   "cast"    =>  +9*3600+1800,# Central Australian Standard
  178.         "east"    => +10*3600,     # Eastern Australian Standard
  179.         "gst"    => +10*3600,     # Guam Standard, USSR Zone 9
  180.         "nzt"    => +12*3600,     # New Zealand
  181.         "nzst"    => +12*3600,     # New Zealand Standard
  182.         "idle"    => +12*3600,     # International Date Line East
  183.     );
  184.  
  185.     %zoneOff = reverse(%Zone);
  186.     %dstZoneOff = reverse(%dstZone);
  187.  
  188.     # Preferences
  189.  
  190.     $zoneOff{0}       = 'gmt';
  191.     $dstZoneOff{3600} = 'bst';
  192.  
  193. }
  194.  
  195. sub tz_offset
  196. {
  197.     my ($zone, $time) = @_;
  198.  
  199.     return &tz_local_offset() unless($zone);
  200.  
  201.     $time = time() unless $time;
  202.     my(@l) = localtime($time);
  203.     my $dst = $l[8];
  204.  
  205.     $zone = lc $zone;
  206.  
  207.     if ($zone =~ /^([\-\+]\d{3,4})$/) {
  208.         my $v = 0 + $1;
  209.         return int($v / 100) * 60 + ($v % 100);
  210.     } elsif (exists $dstZone{$zone} && ($dst || !exists $Zone{$zone})) {
  211.         return $dstZone{$zone};
  212.     } elsif(exists $Zone{$zone}) {
  213.         return $Zone{$zone};
  214.     }
  215.     undef;
  216. }
  217.  
  218. sub tz_name
  219. {
  220.     my ($off, $time) = @_;
  221.  
  222.     $time = time() unless $time;
  223.     my(@l) = localtime($time);
  224.     my $dst = $l[8];
  225.  
  226.     if (exists $dstZoneOff{$off} && ($dst || !exists $zoneOff{$off})) {
  227.         return $dstZoneOff{$off};
  228.     } elsif (exists $zoneOff{$off}) {
  229.         return $zoneOff{$off};
  230.     }
  231.     sprintf("%+05d", int($off / 60) * 100 + $off % 60);
  232. }
  233.  
  234. 1;
  235.  
  236. __DATA__
  237.  
  238. =head1 NAME
  239.  
  240. Time::Timezone -- miscellaneous timezone manipulations routines
  241.  
  242. =head1 SYNOPSIS
  243.  
  244.     use Time::Timezone;
  245.     print tz2zone();
  246.     print tz2zone($ENV{'TZ'});
  247.     print tz2zone($ENV{'TZ'}, time());
  248.     print tz2zone($ENV{'TZ'}, undef, $isdst);
  249.     $offset = tz_local_offset();
  250.     $offset = tz_offset($TZ);
  251.  
  252. =head1 DESCRIPTION
  253.  
  254. This is a collection of miscellaneous timezone manipulation routines.
  255.  
  256. C<tz2zone()> parses the TZ environment variable and returns a timezone
  257. string suitable for inclusion in L<date>-like output.  It opionally takes
  258. a timezone string, a time, and a is-dst flag.
  259.  
  260. C<tz_local_offset()> determins the offset from GMT time in seconds.  It
  261. only does the calculation once.
  262.  
  263. C<tz_offset()> determines the offset from GMT in seconds of a specified
  264. timezone.  
  265.  
  266. C<tz_name()> determines the name of the timezone based on its offset
  267.  
  268. =head1 AUTHORS
  269.  
  270. Graham Barr <bodg@tiuk.ti.com>
  271. David Muir Sharnoff <muir@idiom.com>
  272. Paul Foley <paul@ascent.com>
  273.