File Coverage

blib/lib/DateTime/Duration/Fuzzy.pm

Criterion	Covered	Total	%
statement	31	34	91.1
branch	7	10	70.0
condition	1	3	33.3
subroutine	7	7	100.0
pod	1	1	100.0
total	47	55	85.4

package DateTime::Duration::Fuzzy;

use strict;
use utf8;
use DateTime;
use Carp;
use Exporter qw(import);

use if $ENV{ARCH_64BIT}, 'integer';

our @EXPORT_OK = qw(time_ago);

our $VERSION = '0.06';

my @ranges = (
    [ -1, 'in the future' ],
    [ 60, 'just now' ],
    [ 900, 'a few minutes ago'], # 15*60
    [ 3000, 'less than an hour ago'], # 50*60
    [ 4500, 'about an hour ago'], # 75*60
    [ 7200, 'more than an hour ago'], # 2*60*60
    [ 21600, 'several hours ago'], # 6*60*60
    [ 86400, 'today', sub {        # 24*60*60
        my $time = shift;
        my $now = shift;
        if (   $time->day   < $now->day
            or $time->month < $now->month
            or $time->year  < $now->year
        ) {
            return 'yesterday'
        }
        if ($time->hour < 5) {
            return 'tonight'
        }
        if ($time->hour < 10) {
            return 'this morning'
        }
        if ($time->hour < 15) {
            return 'today'
        }
        if ($time->hour < 19) {
            return 'this afternoon'
        }
        return 'this evening'
    }],
    [ 172800, 'yesterday'], # 2*24*60*60
    [ 604800, 'this week'], # 7*24*60*60
    [ 1209600, 'last week'], # 2*7*24*60*60
    [ 2678400, 'this month', sub { # 31*24*60*60
        my $time = shift;
        my $now = shift;
        if ($time->year == $now->year and $time->month == $now->month) {
            return 'this month'
        }
        return 'last month'
    }],
    [ 5356800, 'last month'], # 2*31*24*60*60
    [ 24105600, 'several months ago'], # 9*31*24*60*60
    [ 31536000, 'about a year ago'], # 365*24*60*60
    [ 34214400, 'last year'], # (365+31)*24*60*60
    [ 63072000, 'more than a year ago'], # 2*365*24*60*60
    [ 283824000, 'several years ago'], # 9*365*24*60*60
    [ 315360000, 'about a decade ago'], # 10*365*24*60*60
    [ 630720000, 'last decade'], # 20*365*24*60*60
    [ 2838240000, 'several decades ago'], # 90*365*24*60*60
    [ 3153600000, 'about a century ago'], # 100*365*24*60*60
    [ 6307200000, 'last century'], # 200*365*24*60*60
    [ 6622560000, 'more than a century ago'], # 210*365*24*60*60
    [ 28382400000, 'several centuries ago'], # 900*365*24*60*60
    [ 31536000000, 'about a millenium ago'], # 1000*365*24*60*60
    [ 63072000000, 'more than a millenium ago'], # 2000*365*24*60*60
);

sub time_ago {
    my ($time, $now) = @_;

    if (not defined $time or not $time->isa('DateTime')) {
        croak('DateTime::Duration::Fuzzy::time_ago needs a DateTime object as first parameter')
    }
    if (not defined $now) {
        $now = DateTime->now();
    }
    if (not $now->isa('DateTime')) {
        croak('Invalid second parameter provided to DateTime::Duration::Fuzzy::time_ago; it must be a DateTime object if provided')
    }

    # Use clones in UTC for safe date calculation
    my $now_clone = $now->clone->set_time_zone('UTC');
    my $time_clone = $time->clone->set_time_zone('UTC');
    my $dur = $now_clone->subtract_datetime_absolute( $time_clone )->in_units('seconds');

    foreach my $range ( @ranges ) {
        if ( $dur <= $range->[0] ) {
            if ( $range->[2] ) {
                return $range->[2]->( $time_clone, $now_clone )
            }
            return $range->[1]
        }
    }

    return 'millenia ago'
}

1

__END__