The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Dancer2::Core::Time;
# ABSTRACT: class to handle common helpers for time manipulations
$Dancer2::Core::Time::VERSION = '0.200002';
use Moo;

has seconds => (
    is      => 'ro',
    lazy    => 1,
    builder => '_build_seconds',
);

sub _build_seconds {
    my ($self) = @_;
    my $seconds = $self->expression;

    return $seconds
        if $seconds =~ /^\d+$/;

    return $self->_parse_duration($seconds)
}

has epoch => (
    is      => 'ro',
    lazy    => 1,
    builder => '_build_epoch',
);

sub _build_epoch {
    my ($self) = @_;
    return $self->seconds if $self->seconds !~ /^[\-\+]?\d+$/;
    $self->seconds + time;
}

has gmt_string => (
    is      => 'ro',
    builder => '_build_gmt_string',
    lazy    => 1,
);

sub _build_gmt_string {
    my ($self) = @_;
    my $epoch = $self->epoch;
    return $epoch if $epoch !~ /^\d+$/;

    my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = gmtime($epoch);
    my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my @days   = qw(Sun Mon Tue Wed Thu Fri Sat);

    return sprintf "%s, %02d-%s-%d %02d:%02d:%02d GMT",
      $days[$wday],
      $mday,
      $months[$mon],
      ( $year + 1900 ),
      $hour, $min, $sec;
}

has expression => (
    is       => 'ro',
    required => 1,
);

sub BUILDARGS {
    my ($class, %args) = @_;

    $args{epoch} = $args{expression}
        if $args{expression} =~ /^\d+$/;

    return \%args;
}

# private

# This map is taken from Cache and Cache::Cache
# map of expiration formats to their respective time in seconds
#<<< no perl tidy
my %Units = ( map(($_,             1), qw(s second seconds sec secs)),
              map(($_,            60), qw(m minute minutes min mins)),
              map(($_,         60*60), qw(h hr hour hours)),
              map(($_,      60*60*24), qw(d day days)),
              map(($_,    60*60*24*7), qw(w week weeks)),
              map(($_,   60*60*24*30), qw(M month months)),
              map(($_,  60*60*24*365), qw(y year years)) );
#>>>

# This code is taken from Time::Duration::Parse, except if it isn't
# understood it just passes it through and it adds the current time.
sub _parse_duration {
    my ( $self, $timespec ) = @_;
    my $orig_timespec = $timespec;

    # Treat a plain number as a number of seconds (and parse it later)
    if ( $timespec =~ /^\s*([-+]?\d+(?:[.,]\d+)?)\s*$/ ) {
        $timespec = "$1s";
    }

    # Convert hh:mm(:ss)? to something we understand
    $timespec =~ s/\b(\d+):(\d\d):(\d\d)\b/$1h $2m $3s/g;
    $timespec =~ s/\b(\d+):(\d\d)\b/$1h $2m/g;

    my $duration = 0;
    while ( $timespec
        =~ s/^\s*([-+]?\d+(?:[.,]\d+)?)\s*([a-zA-Z]+)(?:\s*(?:,|and)\s*)*//i )
    {
        my ( $amount, $unit ) = ( $1, $2 );
        $unit = lc($unit) unless length($unit) == 1;

        if ( my $value = $Units{$unit} ) {
            $amount =~ s/,/./;
            $duration += $amount * $value;
        }
        else {
            return $orig_timespec;
        }
    }

    if ( $timespec =~ /\S/ ) {
        return $orig_timespec;
    }

    return sprintf "%.0f", $duration;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Dancer2::Core::Time - class to handle common helpers for time manipulations

=head1 VERSION

version 0.200002

=head1 SYNOPSIS

    my $time = Dancer2::Core::Time->new( expression => "1h" );
    $time->seconds; # return 3600

=head1 DESCRIPTION

For consistency, whenever something needs to work with time, it
needs to be expressed in seconds, with a timestamp. Although it's very
convenient for the machine and calculations, it's not very handy for a
human-being, for instance in a configuration file.

This class provides everything needed to translate any human-understandable
expression into a number of seconds.

=head1 ATTRIBUTES

=head2 seconds

Number of seconds represented by the object. Defaults to 0.

=head2 epoch

The current epoch to handle. Defaults to seconds + time.

=head2 gmt_string

Convert the current value in epoch as a GMT string.

=head2 expression

Required. A human readable expression representing the number of seconds to provide.

The format supported is a number followed by an expression. It currently
understands:

    s second seconds sec secs
    m minute minutes min mins
    h hr hour hours
    d day days
    w week weeks
    M month months
    y year years

Months and years are currently fixed at 30 and 365 days.  This may change.
Anything else is used verbatim as the expression of a number of seconds.

Example:

    2 hours, 3 days, 3d, 1 week, 3600, etc...

=head1 AUTHOR

Dancer Core Developers

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2016 by Alexis Sukrieh.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut