File Coverage

blib/lib/DateTime/Format/Epoch.pm
Criterion Covered Total %
statement 93 101 92.0
branch 38 50 76.0
condition 9 15 60.0
subroutine 13 13 100.0
pod 3 3 100.0
total 156 182 85.7


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__