File Coverage

blib/lib/DateTime/Format/Epoch.pm

Criterion	Covered	Total	%
statement	98	103	95.1
branch	41	50	82.0
condition	9	15	60.0
subroutine	13	13	100.0
pod	3	3	100.0
total	164	184	89.1

package DateTime::Format::Epoch;

use 5.00503; #qr
use strict;

use vars qw($VERSION);

$VERSION = '0.16';

use DateTime 0.22;
use DateTime::LeapSecond;

use Math::BigInt 'lib' => 'GMP,Pari,FastCalc';
use Params::Validate qw/validate BOOLEAN OBJECT/;

sub _floor {
    my $x  = shift;
    my $ix = int $x;
    if ($ix <= $x) {
        return $ix;
    } else {
        return $ix - 1;
    }
}

my %units_per_second = (
        seconds     => 1,
        milliseconds => 1000,
        microseconds => 1e6,
        nanoseconds => 1e9,
   );

sub new {
	my $class = shift;
    my %p = validate( @_,
                      { epoch => {type  => OBJECT,
                                  can   => 'utc_rd_values'},
                        unit  => {callbacks =>
                                     {'valid unit' =>
                                      sub { exists $units_per_second{$_[0]}
                                            or $_[0] > 0 }},
                                  default => 'seconds'},
                        type  => {regex => qr/^(?:int|float|bigint)$/,
                                  default => 0},
                        local_epoch => {type => BOOLEAN,
                                        default => 0},
                        dhms  => {type => BOOLEAN,
                                  default => 0},
                        skip_leap_seconds => {type => BOOLEAN,
                                              default => 1},
                        start_at => {default => 0},
                      } );

    $p{epoch} = $p{epoch}->clone if $p{epoch}->can('clone');

    $p{unit} = $units_per_second{$p{unit}} || $p{unit};
    $p{unit} = 1 if $p{dhms};

    if (!$p{type}) {
        $p{type} = ($p{unit} > 1e6 ? 'bigint' : 'int');
    }

    ($p{epoch_rd_days}, $p{epoch_rd_secs}) = $p{epoch}->utc_rd_values;
    $p{epoch_class} = ref $p{epoch};

    if (!$p{skip_leap_seconds}) {
        $p{leap_secs} =
            DateTime::LeapSecond::leap_seconds( $p{epoch_rd_days} );
    }

    my $self = bless \%p, $class;
	return $self;
}

sub format_datetime {
    my ($self, $dt) = @_;

    unless (ref $self) {
        $self = $self->new;
    }

    $dt = $dt->clone->set_time_zone('floating')
        if  $self->{local_epoch} &&
            $self->{epoch}->can('time_zone') &&
            $self->{epoch}->time_zone->is_floating &&
            $dt->can('time_zone') &&
            !$dt->time_zone->is_floating;

    my ($rd_days, $rd_secs) = $dt->utc_rd_values;
    my $delta_days = $rd_days - $self->{epoch_rd_days};
    my $delta_secs = $rd_secs - $self->{epoch_rd_secs};

    my $secs = $delta_days * 86_400 + $delta_secs;

    if (!$self->{skip_leap_seconds}) {
        $secs += DateTime::LeapSecond::leap_seconds( $rd_days )
                 - $self->{leap_secs};
    }

    if ($self->{type} eq 'bigint') {
        if ($secs > 2_147_483_647) {
          $secs = "$secs"; #https://rt.cpan.org/Ticket/Display.html?id=103517
        }
        $secs = Math::BigInt->new($secs);
    }

    $secs *= $self->{unit};

    if ($dt->can('nanosecond')) {
        my $fraction = $dt->nanosecond / 1e9 * $self->{unit};
        if ($self->{type} eq 'float') {
            $secs += $fraction;
        } else {
            $secs += int $fraction;
        }
    }

    $secs += $self->{start_at};

    if ($self->{dhms}) {
        my $mins = int($secs / 60);
        $secs -= $mins * 60;
        my $hours = int($mins / 60);
        $mins -= $hours * 60;
        my $days = int($hours / 24);
        $hours -= $days * 24;

        return $days, $hours, $mins, $secs;
    }

    return $secs;
}

sub parse_datetime {
    my ($self, $str) = @_;

    unless (ref $self) {
        $self = $self->new;
    }

    if ($self->{dhms}) {
        my (undef, $d, $h, $m, $s) = @_;
        $str = (($d * 24 + $h) * 60 + $m) + $s;
    }

    $str -= $self->{start_at};

    my $delta_days = _floor( $str / (86_400 * $self->{unit}) );
    $str -= $delta_days * 86_400 * $self->{unit};

    # $str cannot be negative now, so int() instead of _floor()
    my $delta_secs = int( $str / $self->{unit} );
    $str -= $delta_secs * $self->{unit};

    my $delta_nano = $str / $self->{unit} * 1e9;

    my $rd_days = $self->{epoch_rd_days} + $delta_days;
    my $rd_secs = $self->{epoch_rd_secs} + $delta_secs;

    if (!$self->{skip_leap_seconds}) {
        $rd_secs -= DateTime::LeapSecond::leap_seconds( $rd_days )
                 - $self->{leap_secs};
        if ($rd_secs >= DateTime::LeapSecond::day_length( $rd_days )) {
            $rd_secs -= DateTime::LeapSecond::day_length( $rd_days );
            $rd_days++;
        } elsif ($rd_secs < 0) {
            $rd_days--;
            $rd_secs += DateTime::LeapSecond::day_length( $rd_days );
        }
    } else {
        if ($rd_secs >= 86400) {
            $rd_secs -= 86400;
            $rd_days++;
        }
    }

    $rd_days = $rd_days->numify if UNIVERSAL::isa($rd_days, 'Math::BigInt');
    $rd_secs = $rd_secs->numify if UNIVERSAL::isa($rd_secs, 'Math::BigInt');

    my $temp_dt = bless { rd_days => $rd_days, rd_secs => $rd_secs},
                        'DateTime::Format::Epoch::_DateTime';

    my $dt = $self->{epoch_class}->from_object( object => $temp_dt );

    if (!$self->{local_epoch}) {
        $dt->set_time_zone( 'UTC' ) if $dt->can('set_time_zone');
    }

    return $dt;
}

sub DateTime::Format::Epoch::_DateTime::utc_rd_values {
    my $self = shift;

    return $self->{rd_days}, $self->{rd_secs};
}

1;
__END__