File Coverage

blib/lib/Convert/Age.pm
Criterion Covered Total %
statement 29 29 100.0
branch 4 6 66.6
condition n/a
subroutine 7 7 100.0
pod 4 4 100.0
total 44 46 95.6


line stmt bran cond sub pod time code
1             package Convert::Age;
2              
3 2     2   62544 use warnings;
  2         7  
  2         78  
4 2     2   12 use strict;
  2         5  
  2         117  
5              
6             =head1 NAME
7              
8             Convert::Age - convert integer seconds into a "compact" form and back.
9              
10             =head1 VERSION
11              
12             Version 0.04
13              
14             =cut
15              
16             our $VERSION = '0.04';
17              
18             =head1 SYNOPSIS
19              
20             use Convert::Age;
21              
22             my $c = Convert::Age::encode(189988007); # 6y7d10h26m47s
23             my $d = Convert::Age::decode('5h37m5s'); # 20225
24              
25             # or export functions
26              
27             use Convert::Age qw(encode_age decode_age);
28              
29             my $c = encode_age(20225); # 5h37m5s
30             my $d = decode_age('5h37m5s'); # 5h37m5s
31              
32             =cut
33              
34              
35 2     2   12 use Exporter 'import';
  2         9  
  2         935  
36             our @EXPORT_OK = qw(encode_age decode_age);
37              
38             =head1 EXPORT
39              
40             =over 4
41              
42             =item encode_age
43              
44             synonym for Convert::Age::encode()
45              
46             =item decode_age
47              
48             synonym for Convert::Age::decode()
49              
50             =back
51              
52             =head1 NOTE
53              
54             The methods in this module are suitable for some kinds of logging and
55             input/output conversions. It achieves the conversion through simple
56             remainder arithmetic and the length of a year as 365.2425 days.
57              
58             =head1 FUNCTIONS
59              
60             =head2 encode
61              
62             convert seconds into a "readable" format 344 => 5m44s
63              
64             =cut
65              
66             my %convert = (
67             y => 365.2425 * 3600 * 24,
68             d => 3600 * 24,
69             h => 3600,
70             m => 60,
71             s => 1,
72             );
73              
74             sub encode {
75 33     33 1 49 my $age = shift;
76              
77 33         49 my $out = "";
78              
79 33         181 my %tag = reverse %convert;
80              
81             # largest first
82 33         119 for my $k (reverse sort {$a <=> $b} keys %tag) {
  241         396  
83 165 100       468 next unless ($age >= $k);
84 95 50       239 next if (int ($age / $k) == 0);
85              
86 95         193 $out .= int ($age / $k). $tag{$k};
87 95         204 $age = $age % $k;
88             }
89              
90 33         182 return $out;
91             }
92              
93             =head2 encode_age
94              
95             synonym for encode that can be exported
96              
97             =cut
98              
99             sub encode_age {
100 33     33 1 3092 goto &encode;
101             }
102              
103             =head2 decode
104              
105             convert the "readable" format into seconds
106              
107             =cut
108              
109             sub decode {
110 33     33 1 45 my $age = shift;
111              
112 33 50       142 return $age if ($age =~ /^\d+$/);
113              
114 33         46 my $seconds = 0;
115 33         101 my $p = join "", keys %convert;
116 33         252 my @l = split /([$p])/, $age;
117              
118 33         126 while (my ($c, $s) = splice(@l, 0, 2)) {
119 95         349 $seconds += $c * $convert{$s};
120             }
121              
122 33         144 return $seconds;
123             }
124              
125             =head2 decode_age
126              
127             synonym for encode that can be exported
128              
129             =cut
130              
131             sub decode_age {
132 33     33 1 3443 goto &decode;
133             }
134              
135             =head1 AUTHOR
136              
137             Chris Fedde, C<< >>
138              
139             =head1 BUGS
140              
141             Please report any bugs or feature requests to
142             C, or through the web interface at
143             L.
144             I will be notified, and then you'll automatically be notified of progress on
145             your bug as I make changes.
146              
147             =head1 SUPPORT
148              
149             You can find documentation for this module with the perldoc command.
150              
151             perldoc Convert::Age
152              
153             You can also look for information at:
154              
155             =over 4
156              
157             =item * AnnoCPAN: Annotated CPAN documentation
158              
159             L
160              
161             =item * CPAN Ratings
162              
163             L
164              
165             =item * RT: CPAN's request tracker
166              
167             L
168              
169             =item * Search CPAN
170              
171             L
172              
173             =back
174              
175             =head1 ACKNOWLEDGEMENTS
176              
177             =head1 COPYRIGHT & LICENSE
178              
179             Copyright 2007 Chris Fedde, all rights reserved.
180              
181             This program is free software; you can redistribute it and/or modify it
182             under the same terms as Perl itself.
183              
184             =cut
185              
186             1; # End of Convert::Age