File Coverage

blib/lib/Number/Misc.pm
Criterion Covered Total %
statement 79 88 89.7
branch 32 38 84.2
condition 4 8 50.0
subroutine 12 14 85.7
pod 7 11 63.6
total 134 159 84.2


line stmt bran cond sub pod time code
1             package Number::Misc;
2 1     1   482 use strict;
  1         2  
  1         28  
3 1     1   4 use Carp;
  1         1  
  1         220  
4              
5             # version
6             our $VERSION = '1.2';
7              
8              
9             #------------------------------------------------------------------------------
10             # opening POD
11             #
12              
13             =head1 NAME
14              
15             Number::Misc - handy utilities for numbers
16              
17             =head1 SYNOPSIS
18              
19             use Number::Misc ':all';
20              
21             is_numeric('x'); # false
22             to_number('3,000'); # 3000
23             commafie('3000'); # 3,000
24             zero_pad(2, 10); # 0000000002
25             rand_in_range(3, 10); # a random number from 3 to 10, inclusive
26             is_even(3) # true
27             is_odd(4); # true
28              
29             =head1 DESCRIPTION
30              
31             Number::Misc provides some miscellaneous handy utilities for handling numbers.
32             These utilities handle processing numbers as strings, determining basic properties
33             of numbers, or selecting a random number from a range.
34              
35             =head1 INSTALLATION
36              
37             Number::Misc can be installed with the usual routine:
38              
39             perl Makefile.PL
40             make
41             make test
42             make install
43              
44             =head1 FUNCTIONS
45              
46              
47             =cut
48              
49             #
50             # opening POD
51             #------------------------------------------------------------------------------
52              
53              
54             #------------------------------------------------------------------------------
55             # export
56             #
57 1     1   4 use vars qw[@EXPORT_OK %EXPORT_TAGS @ISA];
  1         9  
  1         927  
58             @ISA = 'Exporter';
59              
60             @EXPORT_OK = qw[
61             is_numeric isnumeric
62             to_number tonumber
63             commafie
64             zero_pad zeropad
65             rand_in_range
66             is_even is_odd
67             ];
68              
69             %EXPORT_TAGS = ('all' => [@EXPORT_OK]);
70             #
71             # export
72             #------------------------------------------------------------------------------
73              
74              
75              
76             #------------------------------------------------------------------------------
77             # is_numeric
78             #
79              
80             =head2 is_numeric
81              
82             Returns true if the given scalar is a number. An undefined value returns false.
83             A "number" is defined as consisting solely of numerals (i.e. the characters 0-9),
84             with at most one decimal, and at most a single leading minus or plus sign.
85              
86             is_numeric('3'); # true
87             is_numeric('-3'); # true
88             is_numeric('+3'); # true
89             is_numeric('0003'); # true
90             is_numeric('0.003'); # true
91             is_numeric('0.00.3'); # false
92             is_numeric('3,003'); # false
93             is_numeric(' 3'); # false
94             is_numeric(undef); # false
95              
96             =over
97              
98             =item option: convertible
99              
100             If you want to test if the string B be a number if it were run through
101             to_number() then use the convertible option.
102              
103             is_numeric('3,003', convertible=>1); # true
104             is_numeric(' 3', convertible=>1); # true
105             is_numeric('0.00.3', convertible=>1); # false
106              
107             =back
108              
109             =cut
110              
111             # I changed the name of the the function from isnumeric to is_numeric,
112             # but still need to support some legacy code.
113 15     15 0 22 sub isnumeric { return is_numeric(@_) }
114              
115             sub is_numeric {
116 25     25 1 206 my ($val, %opts) = @_;
117            
118             # if not defined, return false
119 25 100       55 defined($val) or return 0;
120            
121             # if convertible
122 22 100 66     80 if ($opts{'convertible'} || $opts{'convertable'})
  3         6  
123             {$val = to_number($val)}
124            
125 22 100       36 if (! defined $val)
  1         4  
126             {return 0}
127            
128 21         24 $val =~ s/,//g;
129 21         19 $val =~ s/^\-//;
130 21         22 $val =~ s/^\+//;
131 21         23 $val =~ s/\.//;
132            
133 21 100       67 if ($val =~ m/^\d+$/)
  14         64  
134             {return 1}
135            
136 7         22 return 0;
137             }
138             #
139             # isnumeric
140             #------------------------------------------------------------------------------
141              
142              
143             #------------------------------------------------------------------------------
144             # to_number
145             #
146              
147             =head2 to_number
148              
149             Converts a string to a number by removing commas and spaces. If the string
150             can't be converted, returns undef. Some examples:
151              
152             to_number(' 3 '); # returns 3
153             to_number(' 3,000 '); # returns 3000
154             to_number('whatever'); # returns undef
155              
156             =over
157              
158             =item option: always_number
159              
160             If the string cannot be converted to a number, return 0 instead of undef.
161             For example, this call:
162              
163             to_number('whatever', always_number=>1)
164              
165             returns 0.
166              
167             =back
168              
169             =cut
170              
171             # I changed the name of the the function from to_number to to_number
172             # but still need to support some legacy code.
173 0     0 0 0 sub tonumber { return to_number(@_) }
174              
175             sub to_number {
176 7     7 1 11 my ($rv, %opts) = @_;
177            
178             # if not defined, or just spaces, return 0
179 7 50 33     35 unless ( defined($rv) && ($rv =~ m|\S|) ){
180 0 0       0 if ($opts{'always_number'})
181 0         0 { return 0 }
182            
183 0         0 return undef;
184             }
185            
186             # do some basic cleanup
187 7         14 $rv =~ s|^\s+||s;
188 7         13 $rv =~ s|\s+$||s;
189 7         8 $rv =~ s/,//g;
190 7         7 $rv =~ s/\-\s+/-/;
191            
192             # If it's not numeric, but it is requested to always return a number,
193             # then return zero.
194 7 100       9 if (! isnumeric($rv)) {
195 3 100       4 if ($opts{'always_number'})
196 1         6 { return 0 }
197            
198             # else return undef
199 2         6 return undef;
200             }
201            
202             # return
203 4         12 return $rv;
204             }
205             #
206             # to_number
207             #------------------------------------------------------------------------------
208              
209              
210             #------------------------------------------------------------------------------
211             # commafie
212             #
213              
214             =head2 commafie
215              
216             Converts a number to a string representing the same number but with commas
217              
218             commafie(2000); # 2,000
219             commafie(-2000); # -1,000
220             commafie(2000.33); # 2,000.33
221             commafie(100); # 100
222              
223             B
224              
225             The C option lets you set what to use as a separator instead of a comma.
226             For example, if you want to C<:> instead of C<,> you would do that like this:
227              
228             commafie('2000', sep=>':');
229              
230             which would give you this:
231              
232             2:000
233              
234             =cut
235              
236             sub commafie {
237 5     5 1 11 my ($val, %opts) = @_;
238 5         4 my ($int, $dec, $neg, $comma);
239            
240             # default options
241 5         18 %opts = (sep=>',', %opts);
242            
243             # set what to use for comma
244 5         7 $comma = $opts{'sep'};
245            
246             # remove and note negation
247 5         21 $neg = ($val =~ s/^\-//);
248            
249             # get integer and decimal values
250 5         14 ($int, $dec) = split('\.', $val);
251            
252             # add commas
253 5         6 $int = reverse($int);
254 5         27 $int =~ s/(\d\d\d)/$1$comma/g;
255 5         11 $int =~ s/,$//;
256 5         6 $int = reverse($int);
257            
258             # add back negation if necessary
259 5 100       10 if ($neg)
  1         2  
260             {$int = "-$int"}
261            
262             # add back decimal value if it was present
263 5 100       10 if (defined $dec)
  1         9  
264             {$int .= ".$dec"}
265            
266             # return
267 5         24 return $int;
268             }
269             #
270             # commafie
271             #------------------------------------------------------------------------------
272              
273              
274             #------------------------------------------------------------------------------
275             # zero_pad
276             #
277              
278             =head2 zero_pad
279              
280             Prepends zeroes to the number to make it a specified length. The first param is
281             the number, the second is the target length. If the length of the number is
282             equal to or longer than the given length then nothing is changed.
283              
284             zero_pad(2, 3); # 002
285             zero_pad(2, 10); # 0000000002
286             zero_pad(444, 2); # 444
287              
288             =cut
289              
290             # support legacy code that uses zeropad (i.e zero_pad without the underscore)
291 0     0 0 0 sub zeropad { return zero_pad(@_) }
292              
293             sub zero_pad {
294 3     3 1 7 my ($int, $length) = @_;
295            
296             # add zeroes
297 3         10 while (length($int) < $length) {
298 11         20 $int = "0$int";
299             }
300            
301             # return
302 3         13 return $int;
303             }
304             #
305             # zero_pad
306             #------------------------------------------------------------------------------
307              
308              
309             #------------------------------------------------------------------------------
310             # rand_in_range
311             #
312              
313             =head2 rand_in_range
314              
315             Given lower and upper bounds, returns a random number greater than
316             or equal to the lower bound and less than or equal to the upper.
317             Works only on integers.
318              
319             rand_in_range(3, 10); # a random number from 3 to 10, inclusive
320             rand_in_range(-1, 10); # a random number from -1 to 10, inclusive
321              
322             =cut
323              
324             sub rand_in_range {
325 100     100 1 299 my ($min, $max, $iter) = @_;
326 100         78 my (@rv);
327 100   50     214 $iter ||= 1;
328            
329             # switch if necessary
330 100 50       112 if ($min > $max)
331 0         0 { ($max, $min) = ($min, $max) }
332            
333             # loop through as many iterations as needed
334 100         96 for (1..$iter) {
335 100         125 push @rv, int(rand($max - $min + 1)) + $min;
336            
337 100 50       112 if (! wantarray)
338 100         108 { return $rv[0] }
339             }
340            
341 0         0 return @rv;
342             }
343             #
344             # rand_in_range
345             #------------------------------------------------------------------------------
346              
347              
348             #------------------------------------------------------------------------------
349             # is_even / is_odd
350             #
351              
352             =head2 is_even / is_odd
353              
354             C returns true if the number is even.
355             C returns true if the number is odd.
356             Nonnumbers and decimals return undef.
357              
358             =cut
359              
360             sub is_even {
361 4     4 1 646 my ($number) = @_;
362            
363             # check if we can determine even/odd
364 4 100       8 even_odd_check($number) or return undef;
365            
366             # if the number isn't even, return 0
367 2 100       6 if ($number%2 == 1)
368 1         8 { return 0 }
369            
370             # it's even, return true
371 1         4 return 1;
372             }
373              
374             sub is_odd {
375 4     4 1 213 my ($number) = @_;
376            
377             # check if we can determine even/odd
378 4 100       8 even_odd_check($number) or return undef;
379            
380             # if it's odd, return true
381 2 100       5 if ($number%2 == 1)
382 1         4 { return 1 }
383            
384             # it's not odd, so return false
385 1         4 return 0;
386             }
387              
388             # private method: even_odd_check
389             sub even_odd_check {
390 8     8 0 7 my ($number) = @_;
391            
392             # if not number, returns undef
393 8 100       11 if (! isnumeric($number)) {
394 4 100       6 if (defined $number)
395 2         13 { warn qq|cannot determine odd/even for non-number: $number| }
396             else
397 2         16 { warn qq|cannot determine odd/even for undef| }
398            
399             # return undef
400 4         25 return undef;
401             }
402            
403             # decimals return undef
404 4 50       11 if ($number =~ m|\,|) {
405 0         0 warn qq|cannot determine odd/even for decimal|;
406 0         0 return undef;
407             }
408            
409             # else it's ok
410 4         6 return 1;
411             }
412              
413             #
414             # is_even / is_odd
415             #------------------------------------------------------------------------------
416              
417              
418              
419             # return true
420             1;
421              
422              
423             __END__