File Coverage

blib/lib/Time/Duration/Concise.pm
Criterion Covered Total %
statement 137 137 100.0
branch 40 42 95.2
condition 7 10 70.0
subroutine 25 25 100.0
pod 16 16 100.0
total 225 230 97.8


line stmt bran cond sub pod time code
1             package Time::Duration::Concise;
2              
3 7     7   60590 use 5.006;
  7         15  
4 7     7   22 use strict;
  7         7  
  7         144  
5 7     7   22 use warnings FATAL => 'all';
  7         7  
  7         219  
6              
7 7     7   2840 use Time::Seconds;
  7         20274  
  7         420  
8 7     7   3274 use POSIX qw(ceil);
  7         32714  
  7         26  
9 7     7   5656 use Carp;
  7         7  
  7         303  
10 7     7   2708 use Tie::Hash::LRU;
  7         2236  
  7         9262  
11              
12             our $VERSION = '2.61'; ## VERSION
13              
14             our %popular;
15             our $lru = tie %popular, 'Tie::Hash::LRU', 100;
16              
17             =head1 NAME
18              
19             Time::Duration::Concise
20              
21             =head1 DESCRIPTION
22              
23             Time::Duration::Concise is an improved approach to convert concise time duration to string representation.
24              
25             =cut
26              
27             our %LENGTH_TO_PERIOD = (
28             86400 => 'day',
29             3600 => 'hour',
30             60 => 'minute',
31             1 => 'second',
32             );
33              
34             our %PERIOD_SIZES = (
35             'd' => 86400,
36             'h' => 3600,
37             'm' => 60,
38             's' => 1,
39             );
40              
41             our @KNOWN_UNITS = qw[d h m s];
42              
43             our $KNOWN_UNITS_ = 'dhms';
44              
45             =head1 SYNOPSIS
46              
47             use Time::Duration::Concise;
48              
49             my $duration = Time::Duration::Concise->new(
50             interval => '1h20m'
51             );
52              
53             # Intervals can have decimal values
54             # 1.5h etc
55              
56             $duration = Time::Duration::Concise->new(
57             interval => '1.5h'
58             );
59              
60             =head1 FIELDS
61              
62             =head2 interval (REQUIRED)
63              
64             Concise Format
65              
66             The format is an integer followed immediatley by its duration
67             identifier. White-space will be ignored.
68              
69             The following table explains the format.
70              
71             identifier duration
72             ---------- --------
73             d day
74             h hour
75             m minute
76             s second
77              
78             # Intervals can have decimal values
79             Example : 1.5h
80              
81             =cut
82              
83             =head1 METHODS
84              
85             =head2 interval
86              
87             Returns the given time interval.
88              
89             =cut
90              
91             sub interval {
92 1     1 1 5 my ($self) = @_;
93 1         6 return $self->{'_interval'};
94             }
95              
96             =head2 seconds
97              
98             The number of seconds represented by this time interval.
99              
100             =cut
101              
102             sub seconds {
103 133     133 1 388 my ($self) = @_;
104              
105 133 100       448 return $self->{'_seconds'} if $self->{'_seconds'};
106              
107 35         38 my $interval = $self->{'_interval'};
108 35         35 my $known_units = $KNOWN_UNITS_;
109              
110 35         30 my $seconds = 0;
111              
112             # These should be integers, but we might need to have 0.5m
113 35         450 while ($interval =~ s/([+-]?\d*\.?\d+)([$known_units])//) {
114 61         97 my $amount = $1;
115 61         59 my $units = $2;
116 61         284 $seconds += $amount * $PERIOD_SIZES{$units};
117             }
118              
119 35 100       80 if ($interval ne '') {
120              
121             # We had something which didn't match the above, which renders this unparseable
122 1         13 Carp::croak("Bad format supplied [" . $interval . "]: unknown key.");
123             }
124 34         54 $self->{'_seconds'} = int $seconds;
125 34         139 return $self->{'_seconds'};
126             }
127              
128             =head2 minutes
129              
130             The number of minutes represented by this time interval.
131              
132             =cut
133              
134             sub minutes {
135 22     22 1 23 my ($self) = @_;
136 22         39 return $self->duration->{'minutes'};
137             }
138              
139             =head2 hours
140              
141             The number of hours represented by this time interval.
142              
143             =cut
144              
145             sub hours {
146 20     20 1 27 my ($self) = @_;
147 20         34 return $self->duration->{'hours'};
148             }
149              
150             =head2 days
151              
152             The number of days represented by this time interval.
153              
154             =cut
155              
156             sub days {
157 20     20 1 26 my ($self) = @_;
158 20         37 return $self->duration->{'days'};
159             }
160              
161             =head2 weeks
162              
163             The number of week represented by this time interval.
164              
165             =cut
166              
167             sub weeks {
168 1     1 1 2 my ($self) = @_;
169 1         3 return $self->duration->{'weeks'};
170             }
171              
172             =head2 months
173              
174             The number of months represented by this time interval.
175              
176             =cut
177              
178             sub months {
179 2     2 1 3 my ($self) = @_;
180 2         4 return $self->duration->{'months'};
181             }
182              
183             =head2 as_string
184              
185             Concise time druation to string representation.
186              
187             =cut
188              
189             sub as_string {
190 5     5 1 7 my ($self, $precision) = @_;
191 5         6 my $time_frames = $self->_duration_array($precision);
192 5         20 return join(' ', @$time_frames);
193             }
194              
195             =head2 as_concise_string
196              
197             Concise time druation to conscise string representation.
198              
199             =cut
200              
201             sub as_concise_string {
202 27     27 1 2249 my ($self, $precision) = @_;
203 27   100     102 $precision ||= 10;
204 27         44 my $time_frames = $self->_duration_array($precision);
205             my @concise_time_frames = map {
206 27         53 s/\s+//rg =~ /([-|\+]?\d+[A-Za-z]{1})/ig;
  47         169  
207 47         118 $1;
208             } @$time_frames;
209 27         45 $self->{"_duration_array_$precision"} = undef;
210 27         133 return join('', @concise_time_frames);
211             }
212              
213             =head2 normalized_code
214              
215             The largest division of Duration
216              
217             =cut
218              
219             sub normalized_code {
220 19     19 1 4115 my ($self) = @_;
221 19         94 my @keys = sort @KNOWN_UNITS;
222              
223 19         20 my $entry_code = '0s';
224 19   66     93 while ($entry_code eq '0s' and my $period = shift @keys) {
225 53         53 my $period_length = $PERIOD_SIZES{$period};
226 53 100       79 if (not $self->seconds % $period_length) {
227 19         25 my $period_size = $self->seconds / $period_length;
228 19         133 $entry_code = $period_size . $period;
229             }
230             }
231 19         61 return $entry_code;
232             }
233              
234             =head2 duration_array
235              
236             Concise time druation to array
237              
238             [ { value => 1, unit => 'day' }, { value => 2, unit => 'hours' } ]
239              
240             =cut
241              
242             sub duration_array {
243 29     29 1 30 my ($self, $precision) = @_;
244 29         44 my $durations = $self->_duration_array($precision);
245 29         25 my @duration_distribution;
246 29         33 foreach my $d (@$durations) {
247 62         85 my @d_value_unit = split(' ', $d);
248 62         140 push(
249             @duration_distribution,
250             {
251             'value' => $d_value_unit[0],
252             'unit' => $d_value_unit[1]});
253             }
254 29         87 return \@duration_distribution;
255             }
256              
257             sub _duration_array {
258 61     61   68 my ($self, $precision) = @_;
259              
260 61   100     116 $precision ||= 10;
261              
262             return $self->{"_duration_array_$precision"}
263 61 100       163 if $self->{"_duration_array_$precision"};
264              
265 51         83 my $pretty_format = $self->duration->{'time'}->pretty;
266 51         3055 $pretty_format =~ s/minus /-/ig;
267              
268 51         46 my @time_frame;
269 51         48 my $precision_counter = 1;
270 51         139 foreach my $frame (split(',', $pretty_format)) {
271 175 100       236 next if $precision_counter > $precision;
272 144         119 chomp $frame;
273 144         409 $frame =~ s/^\s+|\s+$//g;
274 144         261 $frame =~ s/s$//ig;
275 144         251 $frame =~ /^([-|\+]?\d+\s)/ig;
276              
277             # Make sure we gets the number
278             # to avoid Use of uninitialized warning
279 144         170 my $value = $1;
280 144 50 33     436 if (defined $value && $value) {
281              
282 144         228 $value =~ s/\s+//ig;
283              
284 144 100       242 $frame = '' if $value == 0;
285 144 100       209 $frame .= 's' if $value > 1;
286              
287 144 100       194 if ($frame) {
288 94         101 push(@time_frame, $frame);
289 94         119 $precision_counter++;
290             }
291             }
292             }
293 51 100       107 if (!scalar @time_frame) {
294 1         2 push(@time_frame, '0 second');
295             }
296 51         108 $self->{"_duration_array_$precision"} = \@time_frame;
297 51         81 return \@time_frame;
298             }
299              
300             =head2 multiple_units_of
301              
302             Shorthand to call time methods
303              
304             =cut
305              
306             sub multiple_units_of {
307 7     7 1 1044 my ($self, $unit) = @_;
308             # two is multiple!
309 7 100       14 return ($self->_minimum_number_of($unit) >= 2) ? 1 : 0;
310             }
311              
312             =head2 minimum_number_of
313              
314             Returns the minimum number of the given period.
315              
316             =cut
317              
318             sub minimum_number_of {
319 7     7 1 515 my ($self, $unit) = @_;
320 7         14 return ceil($self->_minimum_number_of($unit));
321             }
322              
323             sub _minimum_number_of {
324 14     14   16 my ($self, $unit) = @_;
325 14         16 my $orig_unit = $unit;
326 14 100       42 $unit =~ s/s$// if (length($unit) > 1); # Chop plurals, but not 's' itself
327 14         24 $unit = substr($unit, 0, 1);
328 14 100       35 $unit = 'mo' if $orig_unit =~ /^months|^mo/ig;
329              
330 14         46 my %unit_maps = (
331             'mo' => 'months',
332             'w' => 'weeks',
333             'd' => 'days',
334             'h' => 'hours',
335             'm' => 'minutes',
336             's' => 'seconds',
337             );
338 14         17 my $method = $unit_maps{$unit};
339 14 100       33 confess "Cannot determine period for $orig_unit" unless ($method);
340              
341 13         31 return $self->$method;
342             }
343              
344             =head2 duration
345              
346             Returns HASH of duration with the following keys
347              
348             'time' # Time::Seconds object
349             'years'
350             'months'
351             'weeks'
352             'days'
353             'hours'
354             'minutes'
355             'seconds'
356              
357             =cut
358              
359             sub duration {
360 120     120 1 118 my ($self) = @_;
361 120 100       802 return $self->{'_duration'} if $self->{'_duration'};
362 34         79 my $time_ = Time::Seconds->new($self->seconds);
363 34         219 my $duration = {
364             'time' => $time_,
365             'years' => $time_->years,
366             'months' => $time_->months,
367             'weeks' => $time_->weeks,
368             'days' => $time_->days,
369             'hours' => $time_->hours,
370             'minutes' => $time_->minutes,
371             'seconds' => $time_->seconds
372             };
373 34         1104 $self->{'_duration'} = $duration;
374 34         111 return $duration;
375             }
376              
377             =head2 get_time_layout
378              
379             Return the duration hash with regards to precision
380              
381             =cut
382              
383             sub get_time_layout {
384 1     1 1 312 my ($self, $precision) = @_;
385 1         2 my $duration = $self->duration;
386             my $time_layout = {
387             duration => $self->seconds,
388             day => $duration->{'day'},
389             hour => $duration->{'hour'},
390 1         2 second => $duration->{'seconds'},
391             display_string => $self->as_string($precision)};
392 1         4 return $time_layout;
393             }
394              
395             =head2 new
396              
397             Object constructor
398              
399             =cut
400              
401             sub new { ## no critic (RequireArgUnpacking)
402 43     43 1 97219 my $class = shift;
403 43 100       133 my %params_ref = ref($_[0]) ? %{$_[0]} : @_;
  2         6  
404              
405 43         50 my $interval = $params_ref{'interval'};
406              
407 43 100       95 confess "Missing required arguments"
408             unless defined $interval;
409              
410 42 100       248 if ($popular{$interval}) {
411             ## Helps in multiple calling, it would really save the time
412 4         15 return $popular{$interval};
413             }
414              
415 38 50       89 if (defined $interval) {
416 38 100       75 Carp::croak("Invalid time interval") if $interval eq '';
417             }
418              
419             # Try our best to make it parseable.
420 37         69 $interval =~ s/\s//g;
421 37         58 $interval = lc $interval;
422              
423             # All numbers implies a number of seconds.
424 37 100       104 if ($interval !~ /[A-Za-z]/) {
425 2         4 $interval .= 's';
426             }
427              
428 37         72 my $self = {
429             _interval => $interval,
430             };
431 37         52 my $obj = bless $self, $class;
432 37         160 $popular{$interval} = $obj;
433 37         108 return $obj;
434             }
435              
436             =head1 AUTHOR
437              
438             Binary.com, C<< >>
439              
440             =head1 BUGS
441              
442             Please report any bugs or feature requests to C, or through
443             the web interface at L. I will be notified, and then you'll
444             automatically be notified of progress on your bug as I make changes.
445              
446             =head1 SUPPORT
447              
448             You can find documentation for this module with the perldoc command.
449              
450             perldoc Time::Duration::Concise
451              
452              
453             You can also look for information at:
454              
455             =over 4
456              
457             =item * RT: CPAN's request tracker (report bugs here)
458              
459             L
460              
461             =item * AnnoCPAN: Annotated CPAN documentation
462              
463             L
464              
465             =item * CPAN Ratings
466              
467             L
468              
469             =item * Search CPAN
470              
471             L
472              
473             =back
474              
475             =cut
476              
477             1; # End of Time::Duration::Concise