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__ |