File Coverage

blib/lib/Badger/Duration.pm
Criterion Covered Total %
statement 57 61 93.4
branch 11 18 61.1
condition 10 20 50.0
subroutine 7 8 87.5
pod 7 7 100.0
total 92 114 80.7


line stmt bran cond sub pod time code
1             package Badger::Duration;
2              
3             use Badger::Class
4 1         7 version => 0.01,
5             debug => 0,
6             base => 'Badger::Comparable',
7             import => 'CLASS',
8             utils => 'numlike is_object params inflect',
9             as_text => 'text',
10             is_true => 1,
11             accessors => 'duration seconds',
12             constants => 'HASH DELIMITER',
13             constant => {
14             DURATION => 'Badger::Duration',
15             },
16             exports => {
17             any => 'DURATION Duration',
18 1     1   6 };
  1         2  
19              
20             our $SECONDS = {
21             second => 1,
22             minute => 60,
23             hour => 60*60,
24             day => 60*60*24,
25             week => 60*60*24*7,
26             month => 60*60*24*30,
27             year => 60*60*24*365,
28             };
29              
30             our $ALIAS_LIST = {
31             second => 's sec secs second seconds',
32             minute => 'm min mins minute minutes',
33             hour => 'h hr hrs hour hours',
34             day => 'd day days',
35             week => 'w wk week weeks',
36             month => 'M mon mons month months',
37             year => 'y yr yrs year years',
38             };
39              
40             our $ALIASES = {
41             map {
42             my $key = $_;
43             my $aliases = $ALIAS_LIST->{ $key };
44             map { $_ => $key }
45             split(/\s+/, $aliases);
46             }
47             keys %$ALIAS_LIST
48             };
49              
50             our @ORDER = qw( year month day hour minute second );
51              
52              
53             sub Duration {
54 7 50   7 1 19 return DURATION unless @_;
55 7 100       12 if (@_ == 1) {
56 6 50       16 if (is_object(DURATION, $_[0])) {
57 0         0 return $_[0];
58             }
59             else {
60 6         23 return DURATION->new( duration => $_[0] );
61             }
62             }
63             else {
64 1         4 return DURATION->new( duration => params(@_) );
65             }
66             }
67              
68             sub init {
69 7     7 1 11 my ($self, $config) = @_;
70 7   33     16 my $duration = $config->{ duration } || $config;
71              
72 7         7 $self->debug(
73             "init() : ", $self->dump_data($duration)
74             ) if DEBUG;
75              
76 7 100       11 if (ref $duration eq HASH) {
77 2         15 $duration = $self->parse_hash($duration);
78             }
79             else {
80 5         10 $duration = $self->parse_text($duration);
81             }
82              
83 7         15 $self->{ seconds } = $self->count_seconds($duration);
84 7         13 $self->{ duration } = $duration;
85              
86 7         13 return $self;
87             }
88              
89             sub parse_text {
90 5     5 1 6 my ($self, $duration) = @_;
91 5         7 my $bits = { };
92              
93             # $duration can be a number, assumed to be seconds
94 5 50       15 return { seconds => $duration }
95             if numlike($duration);
96              
97 5         42 while ($duration =~ /\G\s*(-?[\d\.]+)\s*(\w+)\s*(,|and)?\s*/gc) {
98 9         9 $self->debug("PARSE [$1] [$2]") if DEBUG;
99 9   50     26 my $name = $ALIASES->{ $2 } || $ALIASES->{ lc $2 }
100             || return $self->error_msg( invalid => duration => "$1 $2" );
101 9   50     21 my $old = $bits->{ $name } || 0;
102 9         15 my $new = $1;
103 9 50       19 return $self->error_msg( invalid => duration => "$1 $2" )
104             unless numlike($new);
105 9         14 $bits->{ $name } += $new;
106 9         27 $self->debug("+ $new $name") if DEBUG;
107             }
108              
109 5 50 33     23 if ($duration =~ /\G\s*(.*)/gc && length $1) {
110 0         0 return $self->error_msg( invalid => duration => $1 );
111             }
112              
113 5         10 return $bits;
114             }
115              
116             sub parse_hash {
117 2     2 1 5 my ($self, $duration) = @_;
118 2         3 my $bits = { };
119              
120 2         8 while (my ($key, $value) = each %$duration) {
121 12   50     22 my $name = $ALIASES->{ $key } || $ALIASES->{ lc $key }
122             || return $self->error_msg( invalid => duration => $key );
123 12   50     23 my $old = $bits->{ $name } || 0;
124 12 50       24 return $self->error_msg( invalid => duration => "$key => $value" )
125             unless numlike($value);
126 12         16 $bits->{ $name } += $value;
127 12         24 $self->debug("+ $value $name") if DEBUG;
128             }
129 2         3 return $bits;
130             }
131              
132             sub count_seconds {
133 7     7 1 11 my ($self, $bits) = @_;
134 7         9 my $seconds = 0;
135              
136 7         20 while (my ($key, $value) = each %$bits) {
137 21   50     35 my $name = $ALIASES->{ $key } || $ALIASES->{ lc $key }
138             || return $self->error_msg( invalid => duration => $key );
139 21         21 $self->debug("COUNT [$key => $name] [$value]") if DEBUG;
140 21   50     32 my $secs = $SECONDS->{ $name }
141             || return $self->error_msg( invalid => duration => "$key -> $name" );
142 21 50       32 return $self->error_msg( invalid => duration => "$value $key" )
143             unless numlike($value);
144 21         48 $seconds += $secs * $value;
145             }
146              
147 7         61 return $seconds;
148             }
149              
150             sub compare {
151 0     0 1 0 my ($this, $that) = @_;
152 0         0 return $this->{ seconds } <=> $that->{ seconds };
153             }
154              
155             sub text {
156 6     6 1 21 my $self = shift;
157 6         11 my $duration = $self->{ duration };
158 6         6 my @bits;
159              
160 6         6 $self->debug("DURATION: ", $self->dump_data($duration)) if DEBUG;
161              
162 6         13 foreach my $item (@ORDER) {
163 36   100     72 my $value = $duration->{ $item } || next;
164 19         34 push(@bits, inflect($value, $item));
165 19         31 $self->debug("DURATION + $value $item") if DEBUG;
166             }
167 6         30 return join(' ', @bits);
168             }
169              
170              
171              
172             1;
173             __END__