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