package Dancer2::Core::Time; # ABSTRACT: class to handle common helpers for time manipulations $Dancer2::Core::Time::VERSION = '1.1.1'; 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 1.1.1 =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) 2024 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