File Coverage

blib/lib/Number/Textify.pm
Criterion Covered Total %
statement 58 58 100.0
branch 43 44 97.7
condition 19 21 90.4
subroutine 8 8 100.0
pod 2 2 100.0
total 130 133 97.7


line stmt bran cond sub pod time code
1             package Number::Textify;
2             $Number::Textify::VERSION = '20200512';
3              
4 3     3   573675 use strict;
  3         16  
  3         88  
5 3     3   637 use utf8;
  3         18  
  3         14  
6 3     3   76 use warnings;
  3         14  
  3         2431  
7              
8             =encoding utf8
9              
10             =head1 NAME
11              
12             Number::Textify - turn number into some string.
13              
14             =head1 VERSION
15              
16             version 20200512
17              
18             =head1 SYNOPSIS
19              
20             use Number::Textify ();
21              
22             my $time_converter = Number::Textify
23             -> new( [ [ 60 * 60, 'hour' ],
24             [ 60, 'minute' ],
25             [ 0, 'second' ],
26             ],
27              
28             skip_zeroes => 1,
29             );
30              
31             print $time_converter -> textify( 7274 ); # 2 hours 1 minute 14 seconds
32              
33              
34             my $time_converter_digital_neat = Number::Textify
35             -> new( [ [ 24 * 60 * 60, '%dd ' ],
36             [ 60 * 60, '%02d:' ],
37             [ 60, '%02d:' ],
38             [ 0, '%02d' ],
39             ],
40              
41             joiner => '',
42             formatter => sub { my $format = $_[ 1 ] // '%02d';
43             sprintf $format,
44             $_[ 0 ];
45             },
46             post_process => sub {
47             $_[ 0 ] =~ s/^0+//;
48             $_[ 0 ];
49             },
50             );
51              
52             print $time_converter_digital_neat -> textify( 10_000_000 ); # 115d 17:46:40
53              
54              
55             my $size_converter = Number::Textify
56             -> new( [ [ 1_024 * 1_024 * 1_024, '%.2f GiB' ],
57             [ 1_024 * 1_024, '%.2f MiB' ],
58             [ 1_024, '%.2f KiB' ],
59             [ 0, '%d B' ],
60             ],
61              
62             rounding => 1,
63             formatter => sub { sprintf $_[ 1 ],
64             $_[ 0 ];
65             },
66             );
67              
68             print $size_converter -> textify( 10_000_000 ); # 9.54 MiB
69              
70             =head1 DESCRIPTION
71              
72             Number::Textify helps you to build and use converter of number to some text representation of it.
73              
74             For example 10_000_000 can be represented as '115 days 17 hours 46 minutes 40 seconds', '115.7 days', '115d 17:46:40', '9.54 MiB' or '10.00 MB'. You can see some examples in t/02-examples.t
75              
76             This module uses object oriented approach and doesn't export anything.
77              
78             =head1 OBJECT CREATION
79              
80             =head2 new
81              
82             Expects one required parameter and a hash of optional ones. If some incorrectness detected, it dies.
83              
84             First (and only required) parameter is an arrayref to arrayrefs. First element in the nested arrayref is a positive number, which is a threshold for the range. The rest of elements are passed to the formatter. Arrayrefs should be sorted by the first element in descending order.
85              
86             Range representation figured using the threshold is passed to the formatter along with the rest of elements in the nested arrayref.
87              
88             Default formatter joins the range representation with the first of the rest of elements in the arrayref. Unless range representation equals 1, adds 's' to the result.
89              
90             If you need something else instead of that, you can pass a pair:
91              
92             formatter => sub { my ( $range_representation, @tail_of_nested_arrayref ) = @_; .. },
93              
94             Then those formatted range representations are joined with the default joiner, which is ' ' (a space). If you want to use another joiner, you can provide it as:
95              
96             joiner => ':',
97              
98             Then the joined result is passed through the post_process sub, which by default doesn't change anything. If you want to do some processing though, you can replace it:
99              
100             post_process => sub { my $result = shift; .. },
101              
102             If you prefer to avoid zero values in the middle of result ( like '2 hours 0 minutes 14 seconds' ), you can use the option:
103              
104             skip_zeroes => 1,
105              
106             If you don't want the exact representation, but only some rounding, there's an option for that:
107              
108             rounding => 1,
109              
110             though in this case it usually has sense to provide a custom formatter too.
111              
112             =cut
113              
114             sub new {
115 21 100   21 1 12056 ref( my $class = shift )
116             and die "I'm only a class method!";
117              
118 20 100       62 die 'Constructor expects at least one argument'
119             unless @_ > 0;
120              
121 19         26 my $ranges = shift;
122              
123 19 100       56 die 'Incorrect number of additional parameters (hash expected)'
124             if @_ % 2;
125              
126 18         47 my %arg = @_;
127              
128             # let's check that ranges are in the way we expect (as structure)
129 18 100 100     324 die 'Ranges should be defined as array of arrays'
      100        
      100        
      100        
130             unless $ranges
131             && 'ARRAY' eq ref $ranges
132             && @$ranges
133             && ! grep( ! ( $_
134             && 'ARRAY' eq ref $_
135             && @$_ >= 1 # range cutoff, additional parameters (e. g. description string) for formatter
136             && $_ -> [ 0 ] >= 0 # range cutoff should be positive
137             ),
138             @$ranges
139             )
140             ;
141              
142             # now let's check that ranges are in descending order
143 10         24 my $prev_range = $ranges -> [ 0 ][ 0 ];
144 10         29 for my $range
145             ( @$ranges[ 1 .. $#$ranges ]
146             ) {
147 24 100       60 die 'Ranges should be defined in descending order'
148             unless $prev_range > $range -> [ 0 ];
149              
150 22         33 $prev_range = $range -> [ 0 ];
151             }
152              
153             my %self =
154             ( ranges => $ranges,
155             joiner => exists $arg{joiner} ? $arg{joiner} : ' ',
156             skip_zeroes => exists $arg{skip_zeroes} ? !! $arg{skip_zeroes} : '',
157             rounding => exists $arg{rounding} ? !! $arg{rounding} : '',
158              
159             map {
160 8 100       45 exists $arg{ $_ }
    100          
    100          
161             && $arg{ $_ }
162             && 'CODE' eq ref $arg{ $_ } ?
163 16 100 33     82 ( $_ => $arg{ $_ } )
164             : ();
165             }
166             qw/ formatter
167             post_process
168             /,
169             );
170              
171 8         28 bless \ %self, $class;
172             }
173              
174             =head1 OBJECT METHODS
175              
176             =head2 textify
177              
178             Returns text presentation of the only one passed numeric parameter.
179              
180             =cut
181              
182             sub textify {
183 59 100   59 1 5307 ref( my $self = shift )
184             or die "I'm only an object method!";
185              
186 58         87 my $value = shift;
187 58         93 my $sign = '';
188 58 100       135 if ( $value < 0
189             ) {
190 5         8 $sign = '-';
191 5         9 $value *= -1;
192             }
193              
194 58         82 my @result;
195              
196 58         80 for my $range
197 58         122 ( @{ $self -> {ranges} }
198             ) {
199 187         246 my $t;
200 187         336 ( $t, $value ) = $self -> _range_value( $value, $range -> [ 0 ] );
201 187 100 100     488 if ( $t
      100        
202             || ( @result
203             && ! $self -> {skip_zeroes}
204             )
205             ) {
206 145         337 push @result,
207             $self -> _formatter( $t, @$range[ 1 .. $#$range ] );
208             }
209              
210             last
211 187 100       862 unless defined $value;
212             }
213              
214             $self
215             -> _post_process( ( $sign ? $sign : '' )
216             . join $self -> {joiner},
217             @result
218 58 100       226 );
219             }
220              
221             sub _range_value { # returns numeric value for current range, value for the next range (undef if not needed to process further)
222 187     187   256 my $self = shift;
223 187         232 my $value = shift;
224 187         248 my $range = shift;
225              
226 187 100       318 if ( $value >= $range
227             ) { # there's something in this range
228 130 100       292 my $value_for_range = $range ?
229             $value / $range
230             : $value;
231              
232 130 100       232 if ( $self -> {rounding}
233             ) { # range value is rounded. no need to continue
234 18         46 ( $value_for_range, undef );
235             } else { # range value is whole
236 112         167 $value_for_range = int( $value_for_range );
237              
238 112 100       191 my $for_next_range = $range ?
239             $value % $range
240             : undef;
241              
242 112         227 ( $value_for_range, $for_next_range );
243             }
244             } else { # pass to the next range
245 57         146 ( 0, $value );
246             }
247             }
248              
249             sub _formatter {
250 145     145   245 my $self = shift;
251              
252 145 100       239 if ( $self -> {formatter}
253             ) {
254 84         169 $self -> {formatter} -> ( @_ );
255             } else {
256 61         83 my $value = shift;
257 61         80 my $string = shift;
258              
259 61 100       252 sprintf '%s %s%s',
    50          
260             $value,
261             defined $string ?
262             ( $string,
263             $value == 1 ? '' : 's',
264             )
265             : ( '', '' ),
266             ;
267             }
268             }
269              
270             sub _post_process {
271 58     58   97 my $self = shift;
272              
273 58 100       106 if ( $self -> {post_process}
274             ) {
275 10         21 $self -> {post_process} -> ( @_ );
276             } else {
277 48         291 $_[ 0 ];
278             }
279             }
280              
281             =head1 AUTHOR
282              
283             Valery Kalesnik, C<< >>
284              
285             =head1 COPYRIGHT AND LICENSE
286              
287             This software is copyright (c) 2020 by Valery Kalesnik.
288              
289             This is free software; you can redistribute it and/or modify it under
290             the same terms as the Perl 5 programming language system itself.
291              
292             =cut
293              
294             1;