Blame internal/gen_dm5abbrevs

Packit Service 653591
#!/usr/bin/perl -w
Packit Service 653591
# Copyright (c) 2010-2017 Sullivan Beck.  All rights reserved.
Packit Service 653591
# This program is free software; you can redistribute it and/or modify it
Packit Service 653591
# under the same terms as Perl itself.
Packit Service 653591
Packit Service 653591
###############################################################################
Packit Service 653591
###############################################################################
Packit Service 653591
# This script is used to automatically generate the Date::Manip::DM5abbrevs
Packit Service 653591
# modeul used in Date::Manip 5.xx .
Packit Service 653591
Packit Service 653591
use lib "./lib";
Packit Service 653591
Packit Service 653591
require 5.010000;
Packit Service 653591
use strict;
Packit Service 653591
use warnings;
Packit Service 653591
Packit Service 653591
use Date::Manip::Zones;
Packit Service 653591
use Date::Manip::TZ;
Packit Service 653591
Packit Service 653591
our($VERSION);
Packit Service 653591
$VERSION='6.60';
Packit Service 653591
Packit Service 653591
our($DEBUG);
Packit Service 653591
$DEBUG = 0;
Packit Service 653591
Packit Service 653591
our(@keep);
Packit Service 653591
@keep = qw(
Packit Service 653591
      idlw   -1200
Packit Service 653591
      nt     -1100
Packit Service 653591
      sat    -0400
Packit Service 653591
      cldt   -0300
Packit Service 653591
      at     -0200
Packit Service 653591
      utc    +0000
Packit Service 653591
      mewt   +0100
Packit Service 653591
      mez    +0100
Packit Service 653591
      fwt    +0100
Packit Service 653591
      gb     +0100
Packit Service 653591
      swt    +0100
Packit Service 653591
      mesz   +0200
Packit Service 653591
      fst    +0200
Packit Service 653591
      metdst +0200
Packit Service 653591
      eetdst +0300
Packit Service 653591
      eetedt +0300
Packit Service 653591
      bt     +0300
Packit Service 653591
      it     +0330
Packit Service 653591
      zp4    +0400
Packit Service 653591
      zp5    +0500
Packit Service 653591
      ist    +0530
Packit Service 653591
      zp6    +0600
Packit Service 653591
      awst   +0800
Packit Service 653591
      rok    +0900
Packit Service 653591
      aest   +1000
Packit Service 653591
      acdt   +1030
Packit Service 653591
      cadt   +1030
Packit Service 653591
      aedt   +1100
Packit Service 653591
      eadt   +1100
Packit Service 653591
      nzt    +1200
Packit Service 653591
      idle   +1200
Packit Service 653591
         );
Packit Service 653591
Packit Service 653591
############################################################################
Packit Service 653591
# MAIN PROGRAM
Packit Service 653591
############################################################################
Packit Service 653591
Packit Service 653591
my $year = ( localtime(time) )[5] + 1900;
Packit Service 653591
my $tz   = new Date::Manip::TZ;
Packit Service 653591
Packit Service 653591
my $podstr = '=pod';    # so the CPAN indexer won't treat this as a POD file
Packit Service 653591
Packit Service 653591
print "package Date::Manip::DM5abbrevs;
Packit Service 653591
# Copyright (c) 2003-$year Sullivan Beck. All rights reserved.
Packit Service 653591
# This program is free software; you can redistribute it and/or modify it
Packit Service 653591
# under the same terms as Perl itself.
Packit Service 653591
Packit Service 653591
########################################################################
Packit Service 653591
########################################################################
Packit Service 653591
Packit Service 653591
$podstr
Packit Service 653591
Packit Service 653591
=head1 NAME
Packit Service 653591
Packit Service 653591
Date::Manip::DM5abbrevs - A list of all timezone abbreviations
Packit Service 653591
Packit Service 653591
=head1 SYNPOSIS
Packit Service 653591
Packit Service 653591
This module is not intended to be used directly. Date::Manip 5.xx
Packit Service 653591
will load it as needed.
Packit Service 653591
Packit Service 653591
This module contains all of the time zone abbreviations from
Packit Service 653591
Date::Manip 6.xx copied backwards to 5.xx to provide slightly
Packit Service 653591
better support for time zones.
Packit Service 653591
Packit Service 653591
Note that this is only a bandaid fix, and does not add proper
Packit Service 653591
time zone handling to version 5.xx .
Packit Service 653591
Packit Service 653591
=cut
Packit Service 653591
Packit Service 653591
require 5.000;
Packit Service 653591
Packit Service 653591
use strict;
Packit Service 653591
use warnings;
Packit Service 653591
Packit Service 653591
our(\$VERSION);
Packit Service 653591
\$VERSION='6.60';
Packit Service 653591
Packit Service 653591
END {
Packit Service 653591
   my \$tmp;
Packit Service 653591
   \$tmp = \\\$Date::Manip::DM5::Abbrevs;
Packit Service 653591
}
Packit Service 653591
Packit Service 653591
\$Date::Manip::DM5::Abbrevs = join(' ',qw(
Packit Service 653591
";
Packit Service 653591
Packit Service 653591
my @tmp = @keep;
Packit Service 653591
my %off;
Packit Service 653591
while (@tmp) {
Packit Service 653591
   my($abb) = shift(@tmp);
Packit Service 653591
   my($off) = shift(@tmp);
Packit Service 653591
   $off{$abb} = $off;
Packit Service 653591
   print "      $abb" . " "x(6-length($abb)) . " $off\n";
Packit Service 653591
}
Packit Service 653591
print "\n";
Packit Service 653591
Packit Service 653591
# We have to come up with the best offset for each abbreviation.
Packit Service 653591
#
Packit Service 653591
# We'll look first at values in the current year.
Packit Service 653591
# Then we'll look back in time.
Packit Service 653591
Packit Service 653591
ABBREV: foreach my $abbrev (sort keys %Date::Manip::Zones::Abbrev) {
Packit Service 653591
   my @zone = @{ $Date::Manip::Zones::Abbrev{$abbrev} };
Packit Service 653591
Packit Service 653591
   foreach my $zone (@zone) {
Packit Service 653591
      my @period = $tz->all_periods($zone,$year);
Packit Service 653591
      foreach my $period (@period) {
Packit Service 653591
         my @per = @$period;
Packit Service 653591
         my $abb = lc($per[4]);
Packit Service 653591
         next  if ($abb ne $abbrev);
Packit Service 653591
         my $off = $per[3];
Packit Service 653591
         my ($h,$m,$s) = @$off;
Packit Service 653591
         $h += 0;
Packit Service 653591
         next  if ($s != 0);
Packit Service 653591
Packit Service 653591
         my $sign;
Packit Service 653591
         if ($h < 0) {
Packit Service 653591
            $h *= -1;
Packit Service 653591
            $m *= -1;
Packit Service 653591
            $sign = "-";
Packit Service 653591
         } else {
Packit Service 653591
            $sign = "+";
Packit Service 653591
         }
Packit Service 653591
         $h = "0$h"  if (length($h) == 1);
Packit Service 653591
         $m = "0$m"  if (length($m) == 1);
Packit Service 653591
         $off = "$sign$h$m";
Packit Service 653591
Packit Service 653591
         print "      $abb" . " "x(6-length($abb)) . " $off\n";
Packit Service 653591
         $off{$abb} = $off;
Packit Service 653591
         next ABBREV;
Packit Service 653591
      }
Packit Service 653591
   }
Packit Service 653591
Packit Service 653591
   # If we've arrived here, we didn't find the abbreviation in
Packit Service 653591
   # the current year, so we need to go back in time.
Packit Service 653591
Packit Service 653591
   my $best_off  = "";
Packit Service 653591
   my $best_date = "0001010100:00:00";
Packit Service 653591
Packit Service 653591
   print ":: Abbrev = $abbrev...\n"  if ($DEBUG);
Packit Service 653591
Packit Service 653591
 ZONE:foreach my $zone (@zone) {
Packit Service 653591
      my @period = $tz->periods($zone,undef,$year);
Packit Service 653591
      while (@period) {
Packit Service 653591
         my $period = pop(@period);
Packit Service 653591
Packit Service 653591
         my @per  = @$period;
Packit Service 653591
         my $date = $per[10];
Packit Service 653591
         my $abb  = lc($per[4]);
Packit Service 653591
         next  if ($abb ne $abbrev);
Packit Service 653591
         my $off = $per[3];
Packit Service 653591
         my ($h,$m,$s) = @$off;
Packit Service 653591
         $h += 0;
Packit Service 653591
         next  if ($s != 0);
Packit Service 653591
Packit Service 653591
         my $sign;
Packit Service 653591
         if ($h < 0  ||
Packit Service 653591
             ($h == 0  &&  $m < 0)) {
Packit Service 653591
            $h *= -1;
Packit Service 653591
            $m *= -1;
Packit Service 653591
            $sign = "-";
Packit Service 653591
         } else {
Packit Service 653591
            $sign = "+";
Packit Service 653591
         }
Packit Service 653591
         $h = "0$h"  if (length($h) == 1);
Packit Service 653591
         $m = "0$m"  if (length($m) == 1);
Packit Service 653591
Packit Service 653591
         if ($date lt $best_date) {
Packit Service 653591
            print "::     $zone => $best_off [ $best_date ]\n"  if ($DEBUG);
Packit Service 653591
            next ZONE;
Packit Service 653591
         }
Packit Service 653591
Packit Service 653591
         $best_off = "$sign$h$m";
Packit Service 653591
         $best_date = $date;
Packit Service 653591
Packit Service 653591
         print "::     $zone => $best_off [ $best_date ] ***\n"  if ($DEBUG);
Packit Service 653591
         next ZONE;
Packit Service 653591
      }
Packit Service 653591
   }
Packit Service 653591
Packit Service 653591
   if ($best_off) {
Packit Service 653591
      $off{$abbrev} = $best_off;
Packit Service 653591
      print "      $abbrev" . " "x(6-length($abbrev)) . " $best_off\n";
Packit Service 653591
   }
Packit Service 653591
   next ABBREV;
Packit Service 653591
}
Packit Service 653591
Packit Service 653591
print "));
Packit Service 653591
Packit Service 653591
$podstr
Packit Service 653591
Packit Service 653591
=head1 TIMEZONES
Packit Service 653591
Packit Service 653591
The following timezones are defined:
Packit Service 653591
Packit Service 653591
";
Packit Service 653591
Packit Service 653591
foreach my $abb (sort keys %off) {
Packit Service 653591
   my $off = $off{$abb};
Packit Service 653591
   print "      " . uc($abb) . " "x(6-length($abb)) . " $off\n";
Packit Service 653591
}
Packit Service 653591
Packit Service 653591
print "
Packit Service 653591
Packit Service 653591
=head1 LICENSE
Packit Service 653591
Packit Service 653591
This script is free software; you can redistribute it and/or modify it
Packit Service 653591
under the same terms as Perl itself.
Packit Service 653591
Packit Service 653591
=head1 AUTHOR
Packit Service 653591
Packit Service 653591
Sullivan Beck (sbeck\@cpan.org)
Packit Service 653591
Packit Service 653591
=cut
Packit Service 653591
Packit Service 653591
1;
Packit Service 653591
";
Packit Service 653591
Packit Service 653591
# Local Variables:
Packit Service 653591
# mode: cperl
Packit Service 653591
# indent-tabs-mode: nil
Packit Service 653591
# cperl-indent-level: 3
Packit Service 653591
# cperl-continued-statement-offset: 2
Packit Service 653591
# cperl-continued-brace-offset: 0
Packit Service 653591
# cperl-brace-offset: 0
Packit Service 653591
# cperl-brace-imaginary-offset: 0
Packit Service 653591
# cperl-label-offset: 0
Packit Service 653591
# End: