local-lib5/lib/perl5/i486-linux-gnu-thread-multi/DateTime/LeapSecond.pm

   1 package DateTime::LeapSecond;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.53';
   7
   8 use vars qw( $VERSION );
   9 use vars qw( @RD @LEAP_SECONDS %RD_LENGTH );
  10
  11 $VERSION = '0.05';  # last standalone distro was 0.03
  12
  13 use DateTime;
  14
  15 # Generates a Perl binary decision tree
  16 sub _make_utx {
  17     my ($beg, $end, $tab, $op) = @_;
  18     my $step = int(($end - $beg) / 2);
  19     my $tmp;
  20     if ($step <= 0) {
  21         $tmp = "${tab}return $LEAP_SECONDS[$beg + 1];\n";
  22         return $tmp;
  23     }
  24     $tmp  = "${tab}if (\$val < " . $RD[$beg + $step] . ") {\n";
  25     $tmp .= _make_utx ($beg, $beg + $step, $tab . "    ", $op);
  26     $tmp .= "${tab}}\n";
  27     $tmp .= "${tab}else {\n";
  28     $tmp .= _make_utx ($beg + $step, $end, $tab . "    ", $op);
  29     $tmp .= "${tab}}\n";
  30     return $tmp;
  31 }
  32
  33 # Process BEGIN data and write binary tree decision table
  34 sub _init {
  35     my $value = -1;
  36     while (@_) {
  37         my ( $year, $mon, $mday, $leap_seconds ) =
  38            ( shift, shift, shift, shift );
  39         # print "$year,$mon,$mday\n";
  40
  41         my $utc_epoch = DateTime->_ymd2rd( $year, ( $mon =~ /Jan/i ? 1 : 7 ), $mday );
  42
  43         $value++;
  44         push @LEAP_SECONDS, $value;
  45         push @RD, $utc_epoch;
  46
  47         $RD_LENGTH{ $utc_epoch - 1 } = $leap_seconds;
  48
  49         # warn "$year,$mon,$mday = $utc_epoch +$value";
  50     }
  51
  52     push @LEAP_SECONDS, ++$value;
  53
  54     my $tmp;
  55
  56     # write binary tree decision table
  57
  58     $tmp  = "sub leap_seconds {\n";
  59     $tmp .= "    my \$val = shift;\n";
  60     $tmp .= _make_utx (-1, 1 + $#RD, "    ", "+");
  61     $tmp .= "}\n";
  62
  63     # NOTE: uncomment the line below to see the code:
  64     #warn $tmp;
  65
  66     eval $tmp;
  67
  68 }
  69
  70 sub extra_seconds {
  71     exists $RD_LENGTH{ $_[0] } ? $RD_LENGTH{ $_[0] } : 0
  72 }
  73
  74 sub day_length {
  75     exists $RD_LENGTH{ $_[0] } ? 86400 + $RD_LENGTH{ $_[0] } : 86400
  76 }
  77
  78 sub _initialize {
  79     # this table: ftp://62.161.69.5/pub/tai/publication/leaptab.txt
  80     # known accurate until (at least): 2005-12-31
  81     #
  82     # There are no leap seconds before 1972, because that's the
  83     # year this system was implemented.
  84     #
  85     # year month day number-of-leapseconds
  86     #
  87     _init ( qw(
  88 1972  Jul. 1  +1
  89 1973  Jan. 1  +1
  90 1974  Jan. 1  +1
  91 1975  Jan. 1  +1
  92 1976  Jan. 1  +1
  93 1977  Jan. 1  +1
  94 1978  Jan. 1  +1
  95 1979  Jan. 1  +1
  96 1980  Jan. 1  +1
  97 1981  Jul. 1  +1
  98 1982  Jul. 1  +1
  99 1983  Jul. 1  +1
 100 1985  Jul. 1  +1
 101 1988  Jan. 1  +1
 102 1990  Jan. 1  +1
 103 1991  Jan. 1  +1
 104 1992  Jul. 1  +1
 105 1993  Jul. 1  +1
 106 1994  Jul. 1  +1
 107 1996  Jan. 1  +1
 108 1997  Jul. 1  +1
 109 1999  Jan. 1  +1
 110 2006  Jan. 1  +1
 111 2009  Jan. 1  +1
 112     ) );
 113 }
 114
 115 __PACKAGE__->_initialize();
 116
 117 1;
 118 __END__
 119
 120 =head1 NAME
 121
 122 DateTime::LeapSecond - leap seconds table and utilities
 123
 124 =head1 SYNOPSIS
 125
 126   use DateTime;
 127   use DateTime::LeapSecond;
 128
 129   print "Leap seconds between years 1990 and 2000 are ";
 130   print Date::Leapsecond::leap_seconds( $utc_rd_2000 ) -
 131         Date::Leapsecond::leap_seconds( $utc_rd_1990 );
 132
 133 =head1 DESCRIPTION
 134
 135 This module is used to calculate leap seconds for a given Rata Die
 136 day.  It is used when DateTime.pm cannot compile the XS version of
 137 this code.
 138
 139 This library is known to be accurate for dates until December 2009.
 140
 141 There are no leap seconds before 1972, because that's the year this
 142 system was implemented.
 143
 144 =over 4
 145
 146 =item * leap_seconds( $rd )
 147
 148 Returns the number of accumulated leap seconds for a given day,
 149 in the range 0 .. 22.
 150
 151 =item * extra_seconds( $rd )
 152
 153 Returns the number of leap seconds for a given day,
 154 in the range -2 .. 2.
 155
 156 =item * day_length( $rd )
 157
 158 Returns the number of seconds for a given day,
 159 in the range 86398 .. 86402.
 160
 161 =back
 162
 163 =head1 AUTHOR
 164
 165 Flávio Soibelmann Glock, E<lt>fglock@pucrs.brE<gt>
 166
 167 =head1 COPYRIGHT
 168
 169 Copyright (c) 2003 Flávio Soibelmann Glock.  Copyright (c) 2004-2009
 170 David Rolsky.  All rights reserved.  This program is free software;
 171 you can redistribute it and/or modify it under the same terms as Perl
 172 itself.
 173
 174 The full text of the license can be found in the LICENSE file included
 175 with this module.
 176
 177 =head1 SEE ALSO
 178
 179 E<lt>http://hpiers.obspm.fr/eop-pc/earthor/utc/leapsecond.htmlE<gt>
 180
 181 http://datetime.perl.org
 182
 183 =cut