File Coverage

blib/lib/Time/D.pm

Criterion	Covered	Total	%
statement	205	235	87.2
branch	92	150	61.3
condition	48	60	80.0
subroutine	26	28	92.8
pod	13	13	100.0
total	384	486	79.0

use strict;
use warnings;
package Time::D;
$Time::D::VERSION = '0.024';
# ABSTRACT: Differentiate between two times.

use overload (
    '""' => sub { shift->to_string(2); },
    bool => sub { 1 },
    fallback => 1,
);

use Carp qw/ croak /;
use Function::Parameters qw/ :strict /;
use Time::C;
use Time::C::Sentinel;



method new ($c: $base, $comp = $base) {
    bless { base => $base, comp => $comp }, $c;
}

method _setter ($d: $key, $new) {
    return sub {
        $d->{$key} = $_[0];
        return $d if defined $new;
        return $_[0];
    };
}

method _computed_setter ($d: $key, $new) {
    my %diff;
    @diff{qw/ sign year month week day hour minute second /} = $d->to_array();

    my $val = $diff{$key};

    my $ct = Time::C->gmtime($d->comp);
    return $val, sub {
        if ($diff{sign} eq '-') {
            $ct->$key -= $_[0] - $val;
        } else {
            $ct->$key -= $val - $_[0];
        }
        $d->comp = $ct->epoch;

        return $d if defined $new;
        return $_[0];
    };
}



method base ($d: $new_base = undef) :lvalue {
    my $setter = $d->_setter('base', $new_base);

    return $setter->($new_base) if defined $new_base;

    sentinel value => $d->{base}, set => $setter;
}


method comp ($d: $new_comp = undef) :lvalue {
    my $setter = $d->_setter('comp', $new_comp);

    return $setter->($new_comp) if defined $new_comp;

    sentinel value => $d->{comp}, set => $setter;
}


method sign ($d: $new_sign = undef) :lvalue {
    my %diff;
    @diff{qw/ sign year month week day hour minute second /} = $d->to_array();

    my $sign = $diff{sign};

    my $ct = Time::C->gmtime($d->comp);

    my $setter = sub {
        if ($_[0] ne '+' and $_[0] ne '-') { croak "Can't set a sign other than '+' or '-'."; }

        if ($_[0] ne $sign) { $d->comp += 2*($d->base-$d->comp); }

        return $d if defined $new_sign;
        return $_[0];
    };

    return $setter->($new_sign) if defined $new_sign;

    sentinel value => $sign, set => $setter;
}


method years ($d: $new_years = undef) :lvalue {
    my ($years, $setter) = $d->_computed_setter('year', $new_years);

    return $setter->($new_years) if defined $new_years;

    sentinel value => $years, set => $setter;
}


method months ($d: $new_months = undef) :lvalue {
    my ($months, $setter) = $d->_computed_setter('month', $new_months);

    return $setter->($new_months) if defined $new_months;

    sentinel value => $months, set => $setter;
}


method weeks ($d: $new_weeks = undef) :lvalue {
    my ($weeks, $setter) = $d->_computed_setter('week', $new_weeks);

    return $setter->($new_weeks) if defined $new_weeks;

    sentinel value => $weeks, set => $setter;
}


method days ($d: $new_days = undef) :lvalue {
    my ($days, $setter) = $d->_computed_setter('day', $new_days);

    return $setter->($new_days) if defined $new_days;

    sentinel value => $days, set => $setter;
}


method hours ($d: $new_hours = undef) :lvalue {
    my ($hours, $setter) = $d->_computed_setter('hour', $new_hours);

    return $setter->($new_hours) if defined $new_hours;

    sentinel value => $hours, set => $setter;
}


method minutes ($d: $new_minutes = undef) :lvalue {
    my ($minutes, $setter) = $d->_computed_setter('minute', $new_minutes);

    return $setter->($new_minutes) if defined $new_minutes;

    sentinel value => $minutes, set => $setter;
}


method seconds ($d: $new_seconds = undef) :lvalue {
    my ($seconds, $setter) = $d->_computed_setter('second', $new_seconds);

    return $setter->($new_seconds) if defined $new_seconds;

    sentinel value => $seconds, set => $setter;
}



method to_array ($d:) {
    my $bt = Time::C->gmtime($d->base);
    my $ct = Time::C->gmtime($d->comp);

    my $sign = $d->base > $d->comp ? '-' : '+';

    my $years = $bt->tm->delta_years($ct->tm);
    $ct->year -= $years;
    if    ($sign eq '+' and $bt->epoch > $ct->epoch) { $years--; $ct->year++; }
    elsif ($sign eq '-' and $bt->epoch < $ct->epoch) { $years++; $ct->year--; }

    my $months = $bt->tm->delta_months($ct->tm);
    $ct->month -= $months;
    if    ($sign eq '+' and $bt->epoch > $ct->epoch) { $months--; $ct->month++; }
    elsif ($sign eq '-' and $bt->epoch < $ct->epoch) { $months++; $ct->month--; }

    my $weeks = $bt->tm->delta_weeks($ct->tm);
    $ct->week -= $weeks;
    if    ($sign eq '+' and $bt->epoch > $ct->epoch) { $weeks--; $ct->week++; }
    elsif ($sign eq '-' and $bt->epoch < $ct->epoch) { $weeks++; $ct->week--; }

    my $days = $bt->tm->delta_days($ct->tm);
    $ct->day -= $days;
    if    ($sign eq '+' and $bt->epoch > $ct->epoch) { $days--; $ct->day++; }
    elsif ($sign eq '-' and $bt->epoch < $ct->epoch) { $days++; $ct->day--; }

    my $hours = $bt->tm->delta_hours($ct->tm);
    $ct->hour -= $hours;
    if    ($sign eq '+' and $bt->epoch > $ct->epoch) { $hours--; $ct->hour++; }
    elsif ($sign eq '-' and $bt->epoch < $ct->epoch) { $hours++; $ct->hour--; }

    my $minutes = $bt->tm->delta_minutes($ct->tm);
    $ct->minute -= $minutes;
    if    ($sign eq '+' and $bt->epoch > $ct->epoch) { $minutes--; $ct->minute++; }
    elsif ($sign eq '-' and $bt->epoch < $ct->epoch) { $minutes++; $ct->minute--; }

    my $seconds = $bt->tm->delta_seconds($ct->tm);

    if ($sign eq '-') {
        ($years, $months, $weeks, $days, $hours, $minutes, $seconds) =
          (-$years, -$months, -$weeks, -$days, -$hours, -$minutes, -$seconds);
    }

    return $sign, $years, $months, $weeks, $days, $hours, $minutes, $seconds;
}

fun _plural ($num, $sing, $plur) { sprintf "%s %s", $num, $num == 1 ? $sing : $plur; }


method to_string ($d: $precision = 7) {
    my ($sign, $years, $months, $weeks, $days, $hours, $minutes, $seconds) =
      $d->to_array();

    my @out;

    if ($precision > 0 and $years)   { $precision--; push @out, _plural($years, 'year', 'years'); }
    if ($precision > 0 and $months)  { $precision--; push @out, _plural($months, 'month', 'months'); }
    if ($precision > 0 and $weeks)   { $precision--; push @out, _plural($weeks, 'week', 'weeks'); }
    if ($precision > 0 and $days)    { $precision--; push @out, _plural($days, 'day', 'days'); }
    if ($precision > 0 and $hours)   { $precision--; push @out, _plural($hours, 'hour', 'hours'); }
    if ($precision > 0 and $minutes) { $precision--; push @out, _plural($minutes, 'minute', 'minutes'); }
    if ($precision > 0 and $seconds) { $precision--; push @out, _plural($seconds, 'second', 'seconds'); }

    return "now" unless @out;

    if (@out > 1) { $out[-1] = "and $out[-1]"; }

    my $pretty = join ", ", @out;

    return sprintf $sign eq '+' ? "in %s" : "%s ago", $pretty;
}

1;

__END__