line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DateTime::Format::Epoch; |
2
|
|
|
|
|
|
|
|
3
|
19
|
|
|
19
|
|
751203
|
use 5.00503; #qr |
|
19
|
|
|
|
|
43
|
|
|
19
|
|
|
|
|
521
|
|
4
|
19
|
|
|
19
|
|
62
|
use strict; |
|
19
|
|
|
|
|
22
|
|
|
19
|
|
|
|
|
780
|
|
5
|
|
|
|
|
|
|
|
6
|
19
|
|
|
19
|
|
60
|
use vars qw($VERSION); |
|
19
|
|
|
|
|
26
|
|
|
19
|
|
|
|
|
762
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
$VERSION = '0.14'; |
9
|
|
|
|
|
|
|
|
10
|
19
|
|
|
19
|
|
1456
|
use DateTime 0.22; |
|
19
|
|
|
|
|
84500
|
|
|
19
|
|
|
|
|
351
|
|
11
|
19
|
|
|
19
|
|
7233
|
use DateTime::LeapSecond; |
|
19
|
|
|
|
|
19318
|
|
|
19
|
|
|
|
|
557
|
|
12
|
|
|
|
|
|
|
|
13
|
19
|
50
|
|
19
|
|
15294
|
use Math::BigInt ('lib' => $^O eq 'MSWin32' ? 'Pari,FastCalc' : 'GMP,Pari,FastCalc'); |
|
19
|
|
|
|
|
258744
|
|
|
19
|
|
|
|
|
349
|
|
14
|
19
|
|
|
19
|
|
200747
|
use Params::Validate qw/validate BOOLEAN OBJECT/; |
|
19
|
|
|
|
|
33
|
|
|
19
|
|
|
|
|
13319
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub _floor { |
17
|
4
|
|
|
4
|
|
112
|
my $x = shift; |
18
|
4
|
|
|
|
|
7
|
my $ix = int $x; |
19
|
4
|
50
|
|
|
|
17
|
if ($ix <= $x) { |
20
|
4
|
|
|
|
|
26
|
return $ix; |
21
|
|
|
|
|
|
|
} else { |
22
|
0
|
|
|
|
|
0
|
return $ix - 1; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
my %units_per_second = ( |
27
|
|
|
|
|
|
|
seconds => 1, |
28
|
|
|
|
|
|
|
milliseconds => 1000, |
29
|
|
|
|
|
|
|
microseconds => 1e6, |
30
|
|
|
|
|
|
|
nanoseconds => 1e9, |
31
|
|
|
|
|
|
|
); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub new { |
34
|
36
|
|
|
36
|
1
|
1929
|
my $class = shift; |
35
|
|
|
|
|
|
|
my %p = validate( @_, |
36
|
|
|
|
|
|
|
{ epoch => {type => OBJECT, |
37
|
|
|
|
|
|
|
can => 'utc_rd_values'}, |
38
|
|
|
|
|
|
|
unit => {callbacks => |
39
|
|
|
|
|
|
|
{'valid unit' => |
40
|
27
|
100
|
|
27
|
|
734
|
sub { exists $units_per_second{$_[0]} |
41
|
|
|
|
|
|
|
or $_[0] > 0 }}, |
42
|
36
|
|
|
|
|
954
|
default => 'seconds'}, |
43
|
|
|
|
|
|
|
type => {regex => qr/^(?:int|float|bigint)$/, |
44
|
|
|
|
|
|
|
default => 0}, |
45
|
|
|
|
|
|
|
local_epoch => {type => BOOLEAN, |
46
|
|
|
|
|
|
|
default => 0}, |
47
|
|
|
|
|
|
|
dhms => {type => BOOLEAN, |
48
|
|
|
|
|
|
|
default => 0}, |
49
|
|
|
|
|
|
|
skip_leap_seconds => {type => BOOLEAN, |
50
|
|
|
|
|
|
|
default => 1}, |
51
|
|
|
|
|
|
|
start_at => {default => 0}, |
52
|
|
|
|
|
|
|
} ); |
53
|
|
|
|
|
|
|
|
54
|
36
|
50
|
|
|
|
1651
|
$p{epoch} = $p{epoch}->clone if $p{epoch}->can('clone'); |
55
|
|
|
|
|
|
|
|
56
|
36
|
|
66
|
|
|
430
|
$p{unit} = $units_per_second{$p{unit}} || $p{unit}; |
57
|
36
|
100
|
|
|
|
84
|
$p{unit} = 1 if $p{dhms}; |
58
|
|
|
|
|
|
|
|
59
|
36
|
100
|
|
|
|
86
|
if (!$p{type}) { |
60
|
11
|
100
|
|
|
|
39
|
$p{type} = ($p{unit} > 1e6 ? 'bigint' : 'int'); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
36
|
|
|
|
|
86
|
($p{epoch_rd_days}, $p{epoch_rd_secs}) = $p{epoch}->utc_rd_values; |
64
|
36
|
|
|
|
|
233
|
$p{epoch_class} = ref $p{epoch}; |
65
|
|
|
|
|
|
|
|
66
|
36
|
100
|
|
|
|
70
|
if (!$p{skip_leap_seconds}) { |
67
|
5
|
|
|
|
|
137
|
$p{leap_secs} = |
68
|
|
|
|
|
|
|
DateTime::LeapSecond::leap_seconds( $p{epoch_rd_days} ); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
36
|
|
|
|
|
125
|
my $self = bless \%p, $class; |
72
|
36
|
|
|
|
|
86
|
return $self; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub format_datetime { |
76
|
82
|
|
|
82
|
1
|
73183
|
my ($self, $dt) = @_; |
77
|
|
|
|
|
|
|
|
78
|
82
|
100
|
|
|
|
197
|
unless (ref $self) { |
79
|
18
|
|
|
|
|
42
|
$self = $self->new; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
82
|
100
|
66
|
|
|
347
|
$dt = $dt->clone->set_time_zone('floating') |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
83
|
|
|
|
|
|
|
if $self->{local_epoch} && |
84
|
|
|
|
|
|
|
$self->{epoch}->can('time_zone') && |
85
|
|
|
|
|
|
|
$self->{epoch}->time_zone->is_floating && |
86
|
|
|
|
|
|
|
$dt->can('time_zone') && |
87
|
|
|
|
|
|
|
!$dt->time_zone->is_floating; |
88
|
|
|
|
|
|
|
|
89
|
82
|
|
|
|
|
963
|
my ($rd_days, $rd_secs) = $dt->utc_rd_values; |
90
|
82
|
|
|
|
|
382
|
my $delta_days = $rd_days - $self->{epoch_rd_days}; |
91
|
82
|
|
|
|
|
92
|
my $delta_secs = $rd_secs - $self->{epoch_rd_secs}; |
92
|
|
|
|
|
|
|
|
93
|
82
|
|
|
|
|
105
|
my $secs = $delta_days * 86_400 + $delta_secs; |
94
|
|
|
|
|
|
|
|
95
|
82
|
100
|
|
|
|
132
|
if (!$self->{skip_leap_seconds}) { |
96
|
16
|
|
|
|
|
340
|
$secs += DateTime::LeapSecond::leap_seconds( $rd_days ) |
97
|
|
|
|
|
|
|
- $self->{leap_secs}; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
82
|
100
|
|
|
|
243
|
if ($self->{type} eq 'bigint') { |
101
|
21
|
|
|
|
|
67
|
$secs = Math::BigInt->new($secs); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
82
|
|
|
|
|
954
|
$secs *= $self->{unit}; |
105
|
|
|
|
|
|
|
|
106
|
82
|
50
|
|
|
|
1947
|
if ($dt->can('nanosecond')) { |
107
|
82
|
|
|
|
|
153
|
my $fraction = $dt->nanosecond / 1e9 * $self->{unit}; |
108
|
82
|
100
|
|
|
|
377
|
if ($self->{type} eq 'float') { |
109
|
1
|
|
|
|
|
2
|
$secs += $fraction; |
110
|
|
|
|
|
|
|
} else { |
111
|
81
|
|
|
|
|
120
|
$secs += int $fraction; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
82
|
|
|
|
|
2047
|
$secs += $self->{start_at}; |
116
|
|
|
|
|
|
|
|
117
|
82
|
100
|
|
|
|
1807
|
if ($self->{dhms}) { |
118
|
5
|
|
|
|
|
6
|
my $mins = int($secs / 60); |
119
|
5
|
|
|
|
|
4
|
$secs -= $mins * 60; |
120
|
5
|
|
|
|
|
4
|
my $hours = int($mins / 60); |
121
|
5
|
|
|
|
|
4
|
$mins -= $hours * 60; |
122
|
5
|
|
|
|
|
18
|
my $days = int($hours / 24); |
123
|
5
|
|
|
|
|
2
|
$hours -= $days * 24; |
124
|
|
|
|
|
|
|
|
125
|
5
|
|
|
|
|
28
|
return $days, $hours, $mins, $secs; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
77
|
|
|
|
|
327
|
return $secs; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub parse_datetime { |
132
|
4
|
|
|
4
|
1
|
12421
|
my ($self, $str) = @_; |
133
|
|
|
|
|
|
|
|
134
|
4
|
50
|
|
|
|
11
|
unless (ref $self) { |
135
|
0
|
|
|
|
|
0
|
$self = $self->new; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
4
|
50
|
|
|
|
14
|
if ($self->{dhms}) { |
139
|
0
|
|
|
|
|
0
|
my (undef, $d, $h, $m, $s) = @_; |
140
|
0
|
|
|
|
|
0
|
$str = (($d * 24 + $h) * 60 + $m) + $s; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
4
|
|
|
|
|
7
|
$str -= $self->{start_at}; |
144
|
|
|
|
|
|
|
|
145
|
4
|
|
|
|
|
120
|
my $delta_days = _floor( $str / (86_400 * $self->{unit}) ); |
146
|
4
|
|
|
|
|
7
|
$str -= $delta_days * 86_400 * $self->{unit}; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# $str cannot be negative now, so int() instead of _floor() |
149
|
4
|
|
|
|
|
193
|
my $delta_secs = int( $str / $self->{unit} ); |
150
|
4
|
|
|
|
|
79
|
$str -= $delta_secs * $self->{unit}; |
151
|
|
|
|
|
|
|
|
152
|
4
|
|
|
|
|
101
|
my $delta_nano = $str / $self->{unit} * 1e9; |
153
|
|
|
|
|
|
|
|
154
|
4
|
|
|
|
|
140
|
my $rd_days = $self->{epoch_rd_days} + $delta_days; |
155
|
4
|
|
|
|
|
80
|
my $rd_secs = $self->{epoch_rd_secs} + $delta_secs; |
156
|
|
|
|
|
|
|
|
157
|
4
|
100
|
|
|
|
69
|
if (!$self->{skip_leap_seconds}) { |
158
|
1
|
|
|
|
|
21
|
$rd_secs -= DateTime::LeapSecond::leap_seconds( $rd_days ) |
159
|
|
|
|
|
|
|
- $self->{leap_secs}; |
160
|
1
|
50
|
|
|
|
356
|
if ($rd_secs >= DateTime::LeapSecond::day_length( $rd_days )) { |
|
|
0
|
|
|
|
|
|
161
|
1
|
|
|
|
|
62
|
$rd_secs -= DateTime::LeapSecond::day_length( $rd_days ); |
162
|
1
|
|
|
|
|
94
|
$rd_days++; |
163
|
|
|
|
|
|
|
} elsif ($rd_secs < 0) { |
164
|
0
|
|
|
|
|
0
|
$rd_days--; |
165
|
0
|
|
|
|
|
0
|
$rd_secs += DateTime::LeapSecond::day_length( $rd_days ); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} else { |
168
|
3
|
50
|
|
|
|
6
|
if ($rd_secs >= 86400) { |
169
|
0
|
|
|
|
|
0
|
$rd_secs -= 86400; |
170
|
0
|
|
|
|
|
0
|
$rd_days++; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
4
|
100
|
|
|
|
38
|
$rd_days = $rd_days->numify if UNIVERSAL::isa($rd_days, 'Math::BigInt'); |
175
|
4
|
100
|
|
|
|
28
|
$rd_secs = $rd_secs->numify if UNIVERSAL::isa($rd_secs, 'Math::BigInt'); |
176
|
|
|
|
|
|
|
|
177
|
4
|
|
|
|
|
25
|
my $temp_dt = bless { rd_days => $rd_days, rd_secs => $rd_secs}, |
178
|
|
|
|
|
|
|
'DateTime::Format::Epoch::_DateTime'; |
179
|
|
|
|
|
|
|
|
180
|
4
|
|
|
|
|
17
|
my $dt = $self->{epoch_class}->from_object( object => $temp_dt ); |
181
|
|
|
|
|
|
|
|
182
|
4
|
50
|
|
|
|
1266
|
if (!$self->{local_epoch}) { |
183
|
4
|
50
|
|
|
|
17
|
$dt->set_time_zone( 'UTC' ) if $dt->can('set_time_zone'); |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
4
|
|
|
|
|
361
|
return $dt; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub DateTime::Format::Epoch::_DateTime::utc_rd_values { |
190
|
4
|
|
|
4
|
|
94
|
my $self = shift; |
191
|
|
|
|
|
|
|
|
192
|
4
|
|
|
|
|
21
|
return $self->{rd_days}, $self->{rd_secs}; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
1; |
196
|
|
|
|
|
|
|
__END__ |