1package DateTime::LeapSecond; 2 3use strict; 4use warnings; 5 6our $VERSION = '0.53'; 7 8use vars qw( $VERSION ); 9use vars qw( @RD @LEAP_SECONDS %RD_LENGTH ); 10 11$VERSION = '0.05'; # last standalone distro was 0.03 12 13use DateTime; 14 15# Generates a Perl binary decision tree 16sub _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 34sub _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 70sub extra_seconds { 71 exists $RD_LENGTH{ $_[0] } ? $RD_LENGTH{ $_[0] } : 0 72} 73 74sub day_length { 75 exists $RD_LENGTH{ $_[0] } ? 86400 + $RD_LENGTH{ $_[0] } : 86400 76} 77 78sub _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( 881972 Jul. 1 +1 891973 Jan. 1 +1 901974 Jan. 1 +1 911975 Jan. 1 +1 921976 Jan. 1 +1 931977 Jan. 1 +1 941978 Jan. 1 +1 951979 Jan. 1 +1 961980 Jan. 1 +1 971981 Jul. 1 +1 981982 Jul. 1 +1 991983 Jul. 1 +1 1001985 Jul. 1 +1 1011988 Jan. 1 +1 1021990 Jan. 1 +1 1031991 Jan. 1 +1 1041992 Jul. 1 +1 1051993 Jul. 1 +1 1061994 Jul. 1 +1 1071996 Jan. 1 +1 1081997 Jul. 1 +1 1091999 Jan. 1 +1 1102006 Jan. 1 +1 1112009 Jan. 1 +1 112 ) ); 113} 114 115__PACKAGE__->_initialize(); 116 1171; 118__END__ 119 120=head1 NAME 121 122DateTime::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 135This module is used to calculate leap seconds for a given Rata Die 136day. It is used when DateTime.pm cannot compile the XS version of 137this code. 138 139This library is known to be accurate for dates until December 2009. 140 141There are no leap seconds before 1972, because that's the year this 142system was implemented. 143 144=over 4 145 146=item * leap_seconds( $rd ) 147 148Returns the number of accumulated leap seconds for a given day, 149in the range 0 .. 22. 150 151=item * extra_seconds( $rd ) 152 153Returns the number of leap seconds for a given day, 154in the range -2 .. 2. 155 156=item * day_length( $rd ) 157 158Returns the number of seconds for a given day, 159in the range 86398 .. 86402. 160 161=back 162 163=head1 AUTHOR 164 165Fl�vio Soibelmann Glock, E<lt>fglock@pucrs.brE<gt> 166 167=head1 COPYRIGHT 168 169Copyright (c) 2003 Fl�vio Soibelmann Glock. Copyright (c) 2004-2009 170David Rolsky. All rights reserved. This program is free software; 171you can redistribute it and/or modify it under the same terms as Perl 172itself. 173 174The full text of the license can be found in the LICENSE file included 175with this module. 176 177=head1 SEE ALSO 178 179E<lt>http://hpiers.obspm.fr/eop-pc/earthor/utc/leapsecond.htmlE<gt> 180 181http://datetime.perl.org 182 183=cut 184