File Coverage

blib/lib/Dancer2/Core/Time.pm
Criterion Covered Total %
statement 37 37 100.0
branch 15 16 93.7
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 58 60 96.6


line stmt bran cond sub pod time code
1             package Dancer2::Core::Time;
2             # ABSTRACT: class to handle common helpers for time manipulations
3             $Dancer2::Core::Time::VERSION = '1.0.0';
4 151     151   3583 use Moo;
  151         7870  
  151         2017  
5              
6             has seconds => (
7             is => 'ro',
8             lazy => 1,
9             builder => '_build_seconds',
10             );
11              
12             sub _build_seconds {
13 32     32   558 my ($self) = @_;
14 32         96 my $seconds = $self->expression;
15              
16 32 50       107 return $seconds
17             if $seconds =~ /^\d+$/;
18              
19 32         86 return $self->_parse_duration($seconds)
20             }
21              
22             has epoch => (
23             is => 'ro',
24             lazy => 1,
25             builder => '_build_epoch',
26             );
27              
28             sub _build_epoch {
29 31     31   295 my ($self) = @_;
30 31 100       466 return $self->seconds if $self->seconds !~ /^[\-\+]?\d+$/;
31 25         493 $self->seconds + time;
32             }
33              
34             has gmt_string => (
35             is => 'ro',
36             builder => '_build_gmt_string',
37             lazy => 1,
38             );
39              
40             sub _build_gmt_string {
41 60     60   9256 my ($self) = @_;
42 60         961 my $epoch = $self->epoch;
43 60 100       776 return $epoch if $epoch !~ /^\d+$/;
44              
45 54         338 my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = gmtime($epoch);
46 54         340 my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
47 54         403 my @days = qw(Sun Mon Tue Wed Thu Fri Sat);
48              
49 54         1297 return sprintf "%s, %02d-%s-%d %02d:%02d:%02d GMT",
50             $days[$wday],
51             $mday,
52             $months[$mon],
53             ( $year + 1900 ),
54             $hour, $min, $sec;
55             }
56              
57             has expression => (
58             is => 'ro',
59             required => 1,
60             );
61              
62             sub BUILDARGS {
63 79     79 0 38304 my ($class, %args) = @_;
64              
65             $args{epoch} = $args{expression}
66 79 100       445 if $args{expression} =~ /^\d+$/;
67              
68 79         1284 return \%args;
69             }
70              
71             # private
72              
73             # This map is taken from Cache and Cache::Cache
74             # map of expiration formats to their respective time in seconds
75             #<<< no perl tidy
76             my %Units = ( map(($_, 1), qw(s second seconds sec secs)),
77             map(($_, 60), qw(m minute minutes min mins)),
78             map(($_, 60*60), qw(h hr hour hours)),
79             map(($_, 60*60*24), qw(d day days)),
80             map(($_, 60*60*24*7), qw(w week weeks)),
81             map(($_, 60*60*24*30), qw(M month months)),
82             map(($_, 60*60*24*365), qw(y year years)) );
83             #>>>
84              
85             # This code is taken from Time::Duration::Parse, except if it isn't
86             # understood it just passes it through and it adds the current time.
87             sub _parse_duration {
88 32     32   72 my ( $self, $timespec ) = @_;
89 32         53 my $orig_timespec = $timespec;
90              
91             # Treat a plain number as a number of seconds (and parse it later)
92 32 100       134 if ( $timespec =~ /^\s*([-+]?\d+(?:[.,]\d+)?)\s*$/ ) {
93 2         6 $timespec = "$1s";
94             }
95              
96             # Convert hh:mm(:ss)? to something we understand
97 32         56 $timespec =~ s/\b(\d+):(\d\d):(\d\d)\b/$1h $2m $3s/g;
98 32         45 $timespec =~ s/\b(\d+):(\d\d)\b/$1h $2m/g;
99              
100 32         51 my $duration = 0;
101 32         180 while ( $timespec
102             =~ s/^\s*([-+]?\d+(?:[.,]\d+)?)\s*([a-zA-Z]+)(?:\s*(?:,|and)\s*)*//i )
103             {
104 37         117 my ( $amount, $unit ) = ( $1, $2 );
105 37 100       112 $unit = lc($unit) unless length($unit) == 1;
106              
107 37 100       94 if ( my $value = $Units{$unit} ) {
108 34         63 $amount =~ s/,/./;
109 34         125 $duration += $amount * $value;
110             }
111             else {
112 3         53 return $orig_timespec;
113             }
114             }
115              
116 29 100       66 if ( $timespec =~ /\S/ ) {
117 3         50 return $orig_timespec;
118             }
119              
120 26         208 return sprintf "%.0f", $duration;
121             }
122              
123             1;
124              
125             __END__
126              
127             =pod
128              
129             =encoding UTF-8
130              
131             =head1 NAME
132              
133             Dancer2::Core::Time - class to handle common helpers for time manipulations
134              
135             =head1 VERSION
136              
137             version 1.0.0
138              
139             =head1 SYNOPSIS
140              
141             my $time = Dancer2::Core::Time->new( expression => "1h" );
142             $time->seconds; # return 3600
143              
144             =head1 DESCRIPTION
145              
146             For consistency, whenever something needs to work with time, it
147             needs to be expressed in seconds, with a timestamp. Although it's very
148             convenient for the machine and calculations, it's not very handy for a
149             human-being, for instance in a configuration file.
150              
151             This class provides everything needed to translate any human-understandable
152             expression into a number of seconds.
153              
154             =head1 ATTRIBUTES
155              
156             =head2 seconds
157              
158             Number of seconds represented by the object. Defaults to 0.
159              
160             =head2 epoch
161              
162             The current epoch to handle. Defaults to seconds + time.
163              
164             =head2 gmt_string
165              
166             Convert the current value in epoch as a GMT string.
167              
168             =head2 expression
169              
170             Required. A human readable expression representing the number of seconds to provide.
171              
172             The format supported is a number followed by an expression. It currently
173             understands:
174              
175             s second seconds sec secs
176             m minute minutes min mins
177             h hr hour hours
178             d day days
179             w week weeks
180             M month months
181             y year years
182              
183             Months and years are currently fixed at 30 and 365 days. This may change.
184             Anything else is used verbatim as the expression of a number of seconds.
185              
186             Example:
187              
188             2 hours, 3 days, 3d, 1 week, 3600, etc...
189              
190             =head1 AUTHOR
191              
192             Dancer Core Developers
193              
194             =head1 COPYRIGHT AND LICENSE
195              
196             This software is copyright (c) 2023 by Alexis Sukrieh.
197              
198             This is free software; you can redistribute it and/or modify it under
199             the same terms as the Perl 5 programming language system itself.
200              
201             =cut