File Coverage

blib/lib/DateTime/LeapSecond.pm
Criterion Covered Total %
statement 57 99 57.5
branch 20 64 31.2
condition n/a
subroutine 10 10 100.0
pod 3 3 100.0
total 90 176 51.1


line stmt bran cond sub pod time code
1             package DateTime::LeapSecond;
2              
3 3     3   108237 use strict;
  3         22  
  3         107  
4 3     3   15 use warnings;
  3         13  
  3         80  
5 3     3   545 use namespace::autoclean;
  3         18301  
  3         18  
6              
7             our $VERSION = '1.62';
8              
9             our ( @RD, @LEAP_SECONDS, %RD_LENGTH );
10              
11 3     3   1255 use DateTime;
  3         12  
  3         1972  
12              
13             # Generates a Perl binary decision tree
14             sub _make_utx {
15 165     165   349 my ( $beg, $end, $tab, $op ) = @_;
16 165         264 my $step = int( ( $end - $beg ) / 2 );
17 165         189 my $tmp;
18 165 100       295 if ( $step <= 0 ) {
19 84         183 $tmp = "${tab}return $LEAP_SECONDS[$beg + 1];\n";
20 84         230 return $tmp;
21             }
22 81         180 $tmp = "${tab}if (\$val < " . $RD[ $beg + $step ] . ") {\n";
23 81         296 $tmp .= _make_utx( $beg, $beg + $step, $tab . q{ }, $op );
24 81         174 $tmp .= "${tab}}\n";
25 81         124 $tmp .= "${tab}else {\n";
26 81         176 $tmp .= _make_utx( $beg + $step, $end, $tab . q{ }, $op );
27 81         169 $tmp .= "${tab}}\n";
28 81         291 return $tmp;
29             }
30              
31             # Process BEGIN data and write binary tree decision table
32             sub _init {
33 3     3   7 my $value = -1;
34 3         15 while (@_) {
35 81         154 my ( $year, $mon, $mday, $leap_seconds )
36             = ( shift, shift, shift, shift );
37              
38             # print "$year,$mon,$mday\n";
39              
40             ## no critic (Subroutines::ProtectPrivateSubs)
41 81 100       279 my $utc_epoch
42             = DateTime->_ymd2rd( $year, ( $mon =~ /Jan/i ? 1 : 7 ), $mday );
43              
44 81         112 $value++;
45 81         118 push @LEAP_SECONDS, $value;
46 81         111 push @RD, $utc_epoch;
47              
48 81         247 $RD_LENGTH{ $utc_epoch - 1 } = $leap_seconds;
49              
50             # warn "$year,$mon,$mday = $utc_epoch +$value";
51             }
52              
53 3         9 push @LEAP_SECONDS, ++$value;
54              
55 3         5 my $tmp;
56              
57             # write binary tree decision table
58              
59 3         8 $tmp = "sub leap_seconds {\n";
60 3         10 $tmp .= " my \$val = shift;\n";
61 3         10 $tmp .= _make_utx( -1, 1 + $#RD, q{ }, '+' );
62 3         42 $tmp .= "}; 1\n";
63              
64             # NOTE: uncomment the line below to see the code:
65             #warn $tmp;
66              
67             ## no critic (BuiltinFunctions::ProhibitStringyEval)
68 3 50   7 1 1128 eval $tmp or die $@;
  7 50       175  
  7 100       27  
  4 0       11  
  4 0       10  
  4 0       10  
  2 50       12  
  2 0       5  
  2 0       14  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 100       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  0 50       0  
  0 100       0  
  0         0  
  0         0  
  3         17  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  3         17  
  3         5  
  1         6  
  2         8  
  2         16  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
69             }
70              
71             sub extra_seconds {
72 2 100   2 1 21 exists $RD_LENGTH{ $_[0] } ? $RD_LENGTH{ $_[0] } : 0;
73             }
74              
75             sub day_length {
76 27 50   27 1 199 exists $RD_LENGTH{ $_[0] } ? 86400 + $RD_LENGTH{ $_[0] } : 86400;
77             }
78              
79             sub _initialize {
80              
81             # There are no leap seconds before 1972, because that's the
82             # year this system was implemented.
83             #
84             # year month day number-of-leapseconds
85             #
86 3     3   15 _init(
87             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             2012 Jul. 1 +1
113             2015 Jul. 1 +1
114             2017 Jan. 1 +1
115             )
116             );
117             }
118              
119             __PACKAGE__->_initialize();
120              
121             1;
122              
123             # ABSTRACT: leap seconds table and utilities
124              
125             __END__
126              
127             =pod
128              
129             =encoding UTF-8
130              
131             =head1 NAME
132              
133             DateTime::LeapSecond - leap seconds table and utilities
134              
135             =head1 VERSION
136              
137             version 1.62
138              
139             =head1 SYNOPSIS
140              
141             use DateTime;
142             use DateTime::LeapSecond;
143              
144             print "Leap seconds between years 1990 and 2000 are ";
145             print DateTime::Leapsecond::leap_seconds($utc_rd_2000)
146             - DateTime::Leapsecond::leap_seconds($utc_rd_1990);
147              
148             =head1 DESCRIPTION
149              
150             This module is used to calculate leap seconds for a given Rata Die day. It is
151             used when L<DateTime> cannot compile the XS version of this code.
152              
153             This library is known to be accurate for dates until Jun 2020.
154              
155             There are no leap seconds before 1972, because that's the year this system was
156             implemented.
157              
158             =over 4
159              
160             =item * leap_seconds($rd)
161              
162             Returns the number of accumulated leap seconds for a given day.
163              
164             =item * extra_seconds($rd)
165              
166             Returns the number of leap seconds for a given day, in the range -2 .. 2.
167              
168             =item * day_length($rd)
169              
170             Returns the number of seconds for a given day, in the range 86398 .. 86402.
171              
172             =back
173              
174             =head1 SEE ALSO
175              
176             L<http://hpiers.obspm.fr/eop-pc/earthor/utc/leapsecond.html>
177              
178             =head1 SUPPORT
179              
180             Bugs may be submitted at L<https://github.com/houseabsolute/DateTime.pm/issues>.
181              
182             There is a mailing list available for users of this distribution,
183             L<mailto:datetime@perl.org>.
184              
185             =head1 SOURCE
186              
187             The source code repository for DateTime can be found at L<https://github.com/houseabsolute/DateTime.pm>.
188              
189             =head1 AUTHOR
190              
191             Dave Rolsky <autarch@urth.org>
192              
193             =head1 COPYRIGHT AND LICENSE
194              
195             This software is Copyright (c) 2003 - 2023 by Dave Rolsky.
196              
197             This is free software, licensed under:
198              
199             The Artistic License 2.0 (GPL Compatible)
200              
201             The full text of the license can be found in the
202             F<LICENSE> file included with this distribution.
203              
204             =cut