File Coverage

blib/lib/Time/Left.pm

Criterion	Covered	Total	%
statement	62	63	98.4
branch	33	36	91.6
condition	14	21	66.6
subroutine	22	22	100.0
pod	8	8	100.0
total	139	150	92.6

use 5.010;
use strict;
use warnings;

package Time::Left;
our $VERSION = '1.000';

use Exporter qw(import);
use Scalar::Util qw(looks_like_number);
use Time::HiRes qw(clock_gettime);

use constant CLOCK =>
    eval { Time::HiRes::CLOCK_MONOTONIC_RAW() } //
    eval { Time::HiRes::CLOCK_MONOTONIC() } //
    Time::HiRes::CLOCK_REALTIME();

use overload
    bool     => 'active',
    '!'      => 'expired',
    '0+'     => '_numify',
    '<=>'    => '_compare',
    '""'     => '_stringify',
    cmp      => '_strcmp',
    nomethod => '_nomethod',
    ;

our @EXPORT_OK = qw(to_seconds time_left);

sub _die { exists(&Carp::croak) ? goto &Carp::croak : die "@_\n" }

### Functions

sub to_seconds {
    my ($t) = @_;
    unless (looks_like_number($t)) {
        return undef
            unless $t =~ /^(.+)([smhd])$/
            and looks_like_number($1);
        $t = $1;
        if    ($2 eq 'm') { $t *= 60    }
        elsif ($2 eq 'h') { $t *= 3600  }
        elsif ($2 eq 'd') { $t *= 86400 }
    }
    return $t;
}

sub time_left {
    my ($t) = @_;
    return defined($t) ?
        Time::Left->new(to_seconds($t) // _die("time_left: invalid duration '$_[0]'")) :
        Time::Left->new($t);
}

### Methods

sub new {
    my ($class, $time) = @_;
    _die("${class}->new: invalid time '$time'")
        unless looks_like_number($time // 0);
    $time += clock_gettime(CLOCK)
        if defined $time;
    return bless(\$time, ref($class)||$class);
}

sub remaining  { defined(${$_[0]}) ? ${$_[0]} -  clock_gettime(CLOCK) : undef }
sub active     { defined(${$_[0]}) ? ${$_[0]} >  clock_gettime(CLOCK) : 1     }
sub expired    { defined(${$_[0]}) ? ${$_[0]} <= clock_gettime(CLOCK) : !1    }
sub is_limited { defined(${$_[0]}) }
sub abort      { ${$_[0]} = clock_gettime(CLOCK) }

sub _numify    { _die("Can't numify Time::Left") }
sub _nomethod  { _die("Time::Left does not overload '$_[3]'") }
sub _stringify { defined(${$_[0]}) ? sprintf("%.3f", $_[0]->remaining) : 'Inf' }
sub _strcmp    { ($_[0]->_stringify cmp (ref($_[1]) ? $_[1]->_stringify : $_[1])) * ($_[2] ? -1 : 1) }
sub _compare {
    my ($a, $b, $swap) = @_;
    $a = $$a // 'Inf';
    $b = ref($b) ? $$b // 'Inf' : defined($b) ? $b + clock_gettime(CLOCK) : 'Inf';
    return $swap ? $b <=> $a : $a <=> $b;
}

1;
__END__