File Coverage

blib/lib/DateTimeX/Lite/LeapSecond.pm
Criterion Covered Total %
statement 90 90 100.0
branch 56 56 100.0
condition n/a
subroutine 9 9 100.0
pod 3 3 100.0
total 158 158 100.0


line stmt bran cond sub pod time code
1             # $Id: LeapSecond.pm 27589 2008-12-29 23:51:35Z daisuke $
2              
3             package DateTimeX::Lite::LeapSecond;
4 57     57   27116 use strict;
  57         119  
  57         2575  
5 57     57   365 use vars qw( @RD @LEAP_SECONDS %RD_LENGTH );
  57         105  
  57         4252  
6              
7 57     57   9223 use DateTimeX::Lite::Util;
  57         134  
  57         38824  
8              
9             # Generates a Perl binary decision tree
10             sub _make_utx {
11 2793     2793   4345 my ($beg, $end, $tab, $op) = @_;
12 2793         5718 my $step = int(($end - $beg) / 2);
13 2793         9604 my $tmp;
14 2793 100       5838 if ($step <= 0) {
15 1425         3461 $tmp = "${tab}return $LEAP_SECONDS[$beg + 1];\n";
16 1425         3902 return $tmp;
17             }
18 1368         3518 $tmp = "${tab}if (\$val < " . $RD[$beg + $step] . ") {\n";
19 1368         6408 $tmp .= _make_utx ($beg, $beg + $step, $tab . " ", $op);
20 1368         2913 $tmp .= "${tab}}\n";
21 1368         2692 $tmp .= "${tab}else {\n";
22 1368         3560 $tmp .= _make_utx ($beg + $step, $end, $tab . " ", $op);
23 1368         2925 $tmp .= "${tab}}\n";
24 1368         5064 return $tmp;
25             }
26              
27             # Process BEGIN data and write binary tree decision table
28             sub _init {
29 57     57   135 my $value = -1;
30 57         346 while (@_) {
31 1368         2810 my ( $year, $mon, $mday, $leap_seconds ) =
32             ( shift, shift, shift, shift );
33             # print "$year,$mon,$mday\n";
34              
35 1368 100       7202 my $utc_epoch = DateTimeX::Lite::Util::ymd2rd( $year, ( $mon =~ /Jan/i ? 1 : 7 ), $mday );
36              
37 1368         4452 $value++;
38 1368         2196 push @LEAP_SECONDS, $value;
39 1368         1928 push @RD, $utc_epoch;
40              
41 1368         6916 $RD_LENGTH{ $utc_epoch - 1 } = $leap_seconds;
42              
43             # warn "$year,$mon,$mday = $utc_epoch +$value";
44             }
45              
46 57         138 push @LEAP_SECONDS, ++$value;
47              
48 57         145 my $tmp;
49              
50             # write binary tree decision table
51              
52 57         136 $tmp = "sub leap_seconds {\n";
53 57         180 $tmp .= " my \$val = shift;\n";
54 57         315 $tmp .= _make_utx (-1, 1 + $#RD, " ", "+");
55 57         248 $tmp .= "}\n";
56              
57             # NOTE: uncomment the line below to see the code:
58             #warn $tmp;
59              
60 57 100   161 1 22397 eval $tmp;
  161 100       315  
  161 100       337  
  78 100       129  
  66 100       109  
  60 100       112  
  26 100       83  
  34 100       67  
  30 100       100  
  4 100       13  
  6 100       13  
  2 100       5  
  4 100       8  
  2 100       5  
  2 100       5  
  12 100       22  
  6 100       10  
  2 100       5  
  4 100       17  
  2 100       6  
  2 100       7  
  6 100       13  
  2 100       7  
  4 100       11  
  2         6  
  2         9  
  83         167  
  12         27  
  6         13  
  2         7  
  4         9  
  2         7  
  2         7  
  6         12  
  2         6  
  4         9  
  2         6  
  2         7  
  71         172  
  11         32  
  2         8  
  9         25  
  2         8  
  7         27  
  60         119  
  46         132  
  9         33  
  37         114  
  14         28  
  9         26  
  5         17  
61              
62             }
63              
64             sub extra_seconds {
65 2 100   2 1 21 exists $RD_LENGTH{ $_[0] } ? $RD_LENGTH{ $_[0] } : 0
66             }
67              
68             sub day_length {
69 235 100   235 1 1224 exists $RD_LENGTH{ $_[0] } ? 86400 + $RD_LENGTH{ $_[0] } : 86400
70             }
71              
72             sub _initialize {
73             # this table: ftp://62.161.69.5/pub/tai/publication/leaptab.txt
74             # known accurate until (at least): 2005-12-31
75             #
76             # There are no leap seconds before 1972, because that's the
77             # year this system was implemented.
78             #
79             # year month day number-of-leapseconds
80             #
81 57     57   343 _init ( qw(
82             1972 Jul. 1 +1
83             1973 Jan. 1 +1
84             1974 Jan. 1 +1
85             1975 Jan. 1 +1
86             1976 Jan. 1 +1
87             1977 Jan. 1 +1
88             1978 Jan. 1 +1
89             1979 Jan. 1 +1
90             1980 Jan. 1 +1
91             1981 Jul. 1 +1
92             1982 Jul. 1 +1
93             1983 Jul. 1 +1
94             1985 Jul. 1 +1
95             1988 Jan. 1 +1
96             1990 Jan. 1 +1
97             1991 Jan. 1 +1
98             1992 Jul. 1 +1
99             1993 Jul. 1 +1
100             1994 Jul. 1 +1
101             1996 Jan. 1 +1
102             1997 Jul. 1 +1
103             1999 Jan. 1 +1
104             2006 Jan. 1 +1
105             2009 Jan. 1 +1
106             ) );
107             }
108              
109             __PACKAGE__->_initialize();
110              
111             1;
112             __END__