| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Number::Misc; | 
| 2 | 1 |  |  | 1 |  | 557 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 28 |  | 
| 3 | 1 |  |  | 1 |  | 5 | use Carp; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 113 |  | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | # version | 
| 6 |  |  |  |  |  |  | our $VERSION = '1.1'; | 
| 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 |  |  |  |  | 6 |  | 
|  | 1 |  |  |  |  | 1114 |  | 
| 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 | 29 | sub isnumeric { return is_numeric(@_) } | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | sub is_numeric { | 
| 116 | 25 |  |  | 25 | 1 | 56 | my ($val, %opts) = @_; | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | # if not defined, return false | 
| 119 | 25 | 100 |  |  |  | 64 | defined($val) or return 0; | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | # if convertible | 
| 122 | 22 | 100 | 66 |  |  | 101 | if ($opts{'convertible'} || $opts{'convertable'}) | 
|  | 3 |  |  |  |  | 8 |  | 
| 123 |  |  |  |  |  |  | {$val = to_number($val)} | 
| 124 |  |  |  |  |  |  |  | 
| 125 | 22 | 100 |  |  |  | 40 | if (! defined $val) | 
|  | 1 |  |  |  |  | 4 |  | 
| 126 |  |  |  |  |  |  | {return 0} | 
| 127 |  |  |  |  |  |  |  | 
| 128 | 21 |  |  |  |  | 30 | $val =~ s/,//g; | 
| 129 | 21 |  |  |  |  | 27 | $val =~ s/^\-//; | 
| 130 | 21 |  |  |  |  | 26 | $val =~ s/^\+//; | 
| 131 | 21 |  |  |  |  | 28 | $val =~ s/\.//; | 
| 132 |  |  |  |  |  |  |  | 
| 133 | 21 | 100 |  |  |  | 69 | if ($val =~ m/^\d+$/) | 
|  | 14 |  |  |  |  | 54 |  | 
| 134 |  |  |  |  |  |  | {return 1} | 
| 135 |  |  |  |  |  |  |  | 
| 136 | 7 |  |  |  |  | 23 | 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 | 15 | my ($rv, %opts) = @_; | 
| 177 |  |  |  |  |  |  |  | 
| 178 |  |  |  |  |  |  | # if not defined, or just spaces, return 0 | 
| 179 | 7 | 50 | 33 |  |  | 43 | 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 |  |  |  |  | 18 | $rv =~ s|^\s+||s; | 
| 188 | 7 |  |  |  |  | 13 | $rv =~ s|\s+$||s; | 
| 189 | 7 |  |  |  |  | 11 | $rv =~ s/,//g; | 
| 190 | 7 |  |  |  |  | 9 | $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 |  |  |  | 12 | if (! isnumeric($rv)) { | 
| 195 | 3 | 100 |  |  |  | 9 | if ($opts{'always_number'}) | 
| 196 | 1 |  |  |  |  | 4 | { return 0 } | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | # else return undef | 
| 199 | 2 |  |  |  |  | 5 | return undef; | 
| 200 |  |  |  |  |  |  | } | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | # return | 
| 203 | 4 |  |  |  |  | 15 | 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 |  |  |  |  |  |  | =cut | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | sub commafie { | 
| 226 | 4 |  |  | 4 | 1 | 6 | my $val = shift; | 
| 227 | 4 |  |  |  |  | 5 | my ($int, $dec, $neg); | 
| 228 |  |  |  |  |  |  |  | 
| 229 | 4 |  |  |  |  | 20 | $neg = ($val =~ s/^\-//); | 
| 230 |  |  |  |  |  |  |  | 
| 231 | 4 |  |  |  |  | 9 | ($int, $dec) = split('\.', $val); | 
| 232 |  |  |  |  |  |  |  | 
| 233 | 4 |  |  |  |  | 8 | $int = reverse($int); | 
| 234 | 4 |  |  |  |  | 20 | $int =~ s/(\d\d\d)/$1,/g; | 
| 235 | 4 |  |  |  |  | 8 | $int =~ s/,$//; | 
| 236 | 4 |  |  |  |  | 6 | $int = reverse($int); | 
| 237 |  |  |  |  |  |  |  | 
| 238 | 4 | 100 |  |  |  | 10 | if ($neg) | 
|  | 1 |  |  |  |  | 2 |  | 
| 239 |  |  |  |  |  |  | {$int = "-$int"} | 
| 240 | 4 | 100 |  |  |  | 8 | if (defined $dec) | 
|  | 1 |  |  |  |  | 3 |  | 
| 241 |  |  |  |  |  |  | {$int .= ".$dec"} | 
| 242 | 4 |  |  |  |  | 16 | return $int; | 
| 243 |  |  |  |  |  |  | } | 
| 244 |  |  |  |  |  |  | # | 
| 245 |  |  |  |  |  |  | # commafie | 
| 246 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 247 |  |  |  |  |  |  |  | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 250 |  |  |  |  |  |  | # zero_pad | 
| 251 |  |  |  |  |  |  | # | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | =head2 zero_pad | 
| 254 |  |  |  |  |  |  |  | 
| 255 |  |  |  |  |  |  | Prepends zeroes to the number to make it a specified length.  The first param is | 
| 256 |  |  |  |  |  |  | the  number, the second is the target length.  If the length of the number is | 
| 257 |  |  |  |  |  |  | equal to or longer than the given length then nothing is changed. | 
| 258 |  |  |  |  |  |  |  | 
| 259 |  |  |  |  |  |  | zero_pad(2, 3);   # 002 | 
| 260 |  |  |  |  |  |  | zero_pad(2, 10);  # 0000000002 | 
| 261 |  |  |  |  |  |  | zero_pad(444, 2); # 444 | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | =cut | 
| 264 |  |  |  |  |  |  |  | 
| 265 |  |  |  |  |  |  | # support legacy code that uses zeropad (i.e zero_pad without the underscore) | 
| 266 | 0 |  |  | 0 | 0 | 0 | sub zeropad { return zero_pad(@_) } | 
| 267 |  |  |  |  |  |  |  | 
| 268 |  |  |  |  |  |  | sub zero_pad { | 
| 269 | 3 |  |  | 3 | 1 | 10 | my ($int, $length) = @_; | 
| 270 |  |  |  |  |  |  |  | 
| 271 |  |  |  |  |  |  | # add zeroes | 
| 272 | 3 |  |  |  |  | 20 | while (length($int) < $length) { | 
| 273 | 11 |  |  |  |  | 29 | $int = "0$int"; | 
| 274 |  |  |  |  |  |  | } | 
| 275 |  |  |  |  |  |  |  | 
| 276 |  |  |  |  |  |  | # return | 
| 277 | 3 |  |  |  |  | 11 | return $int; | 
| 278 |  |  |  |  |  |  | } | 
| 279 |  |  |  |  |  |  | # | 
| 280 |  |  |  |  |  |  | # zero_pad | 
| 281 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  |  | 
| 284 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 285 |  |  |  |  |  |  | # rand_in_range | 
| 286 |  |  |  |  |  |  | # | 
| 287 |  |  |  |  |  |  |  | 
| 288 |  |  |  |  |  |  | =head2 rand_in_range | 
| 289 |  |  |  |  |  |  |  | 
| 290 |  |  |  |  |  |  | Given lower and upper bounds, returns a random number greater than | 
| 291 |  |  |  |  |  |  | or equal to the lower bound and less than or equal to the upper. | 
| 292 |  |  |  |  |  |  | Works only on integers. | 
| 293 |  |  |  |  |  |  |  | 
| 294 |  |  |  |  |  |  | rand_in_range(3, 10);   # a random number from 3 to 10, inclusive | 
| 295 |  |  |  |  |  |  | rand_in_range(-1, 10);  # a random number from -1 to 10, inclusive | 
| 296 |  |  |  |  |  |  |  | 
| 297 |  |  |  |  |  |  | =cut | 
| 298 |  |  |  |  |  |  |  | 
| 299 |  |  |  |  |  |  | sub rand_in_range { | 
| 300 | 100 |  |  | 100 | 1 | 474 | my ($min, $max, $iter) = @_; | 
| 301 | 100 |  |  |  |  | 93 | my (@rv); | 
| 302 | 100 |  | 50 |  |  | 296 | $iter ||= 1; | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  | # switch if necessary | 
| 305 | 100 | 50 |  |  |  | 158 | if ($min > $max) | 
| 306 | 0 |  |  |  |  | 0 | { ($max, $min) = ($min, $max) } | 
| 307 |  |  |  |  |  |  |  | 
| 308 |  |  |  |  |  |  | # loop through as many iterations as needed | 
| 309 | 100 |  |  |  |  | 134 | for (1..$iter) { | 
| 310 | 100 |  |  |  |  | 207 | push @rv, int(rand($max - $min + 1)) + $min; | 
| 311 |  |  |  |  |  |  |  | 
| 312 | 100 | 50 |  |  |  | 169 | if (! wantarray) | 
| 313 | 100 |  |  |  |  | 234 | { return $rv[0] } | 
| 314 |  |  |  |  |  |  | } | 
| 315 |  |  |  |  |  |  |  | 
| 316 | 0 |  |  |  |  | 0 | return @rv; | 
| 317 |  |  |  |  |  |  | } | 
| 318 |  |  |  |  |  |  | # | 
| 319 |  |  |  |  |  |  | # rand_in_range | 
| 320 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 321 |  |  |  |  |  |  |  | 
| 322 |  |  |  |  |  |  |  | 
| 323 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 324 |  |  |  |  |  |  | # is_even / is_odd | 
| 325 |  |  |  |  |  |  | # | 
| 326 |  |  |  |  |  |  |  | 
| 327 |  |  |  |  |  |  | =head2 is_even / is_odd | 
| 328 |  |  |  |  |  |  |  | 
| 329 |  |  |  |  |  |  | C returns true if the number is even. | 
| 330 |  |  |  |  |  |  | C returns true if the number is odd. | 
| 331 |  |  |  |  |  |  | Nonnumbers and decimals return undef. | 
| 332 |  |  |  |  |  |  |  | 
| 333 |  |  |  |  |  |  | =cut | 
| 334 |  |  |  |  |  |  |  | 
| 335 |  |  |  |  |  |  | sub is_even { | 
| 336 | 4 |  |  | 4 | 1 | 50 | my ($number) = @_; | 
| 337 |  |  |  |  |  |  |  | 
| 338 |  |  |  |  |  |  | # check if we can determine even/odd | 
| 339 | 4 | 100 |  |  |  | 9 | even_odd_check($number) or return undef; | 
| 340 |  |  |  |  |  |  |  | 
| 341 |  |  |  |  |  |  | # if the number isn't even, return 0 | 
| 342 | 2 | 100 |  |  |  | 6 | if ($number%2 == 1) | 
| 343 | 1 |  |  |  |  | 4 | { return 0 } | 
| 344 |  |  |  |  |  |  |  | 
| 345 |  |  |  |  |  |  | # it's even, return true | 
| 346 | 1 |  |  |  |  | 7 | return 1; | 
| 347 |  |  |  |  |  |  | } | 
| 348 |  |  |  |  |  |  |  | 
| 349 |  |  |  |  |  |  | sub is_odd { | 
| 350 | 4 |  |  | 4 | 1 | 8 | my ($number) = @_; | 
| 351 |  |  |  |  |  |  |  | 
| 352 |  |  |  |  |  |  | # check if we can determine even/odd | 
| 353 | 4 | 100 |  |  |  | 10 | even_odd_check($number) or return undef; | 
| 354 |  |  |  |  |  |  |  | 
| 355 |  |  |  |  |  |  | # if it's odd, return true | 
| 356 | 2 | 100 |  |  |  | 6 | if ($number%2 == 1) | 
| 357 | 1 |  |  |  |  | 5 | { return 1 } | 
| 358 |  |  |  |  |  |  |  | 
| 359 |  |  |  |  |  |  | # it's not odd, so return false | 
| 360 | 1 |  |  |  |  | 3 | return 0; | 
| 361 |  |  |  |  |  |  | } | 
| 362 |  |  |  |  |  |  |  | 
| 363 |  |  |  |  |  |  | # private method: even_odd_check | 
| 364 |  |  |  |  |  |  | sub even_odd_check { | 
| 365 | 8 |  |  | 8 | 0 | 9 | my ($number) = @_; | 
| 366 |  |  |  |  |  |  |  | 
| 367 |  |  |  |  |  |  | # if not number, returns undef | 
| 368 | 8 | 100 |  |  |  | 13 | if (! isnumeric($number)) { | 
| 369 | 4 | 100 |  |  |  | 11 | if (defined $number) | 
| 370 | 2 |  |  |  |  | 16 | { warn qq|cannot determine odd/even for non-number: $number| } | 
| 371 |  |  |  |  |  |  | else | 
| 372 | 2 |  |  |  |  | 18 | { warn qq|cannot determine odd/even for undef| } | 
| 373 |  |  |  |  |  |  |  | 
| 374 |  |  |  |  |  |  | # return undef | 
| 375 | 4 |  |  |  |  | 28 | return undef; | 
| 376 |  |  |  |  |  |  | } | 
| 377 |  |  |  |  |  |  |  | 
| 378 |  |  |  |  |  |  | # decimals return undef | 
| 379 | 4 | 50 |  |  |  | 11 | if ($number =~ m|\,|) { | 
| 380 | 0 |  |  |  |  | 0 | warn qq|cannot determine odd/even for decimal|; | 
| 381 | 0 |  |  |  |  | 0 | return undef; | 
| 382 |  |  |  |  |  |  | } | 
| 383 |  |  |  |  |  |  |  | 
| 384 |  |  |  |  |  |  | # else it's ok | 
| 385 | 4 |  |  |  |  | 10 | return 1; | 
| 386 |  |  |  |  |  |  | } | 
| 387 |  |  |  |  |  |  |  | 
| 388 |  |  |  |  |  |  | # | 
| 389 |  |  |  |  |  |  | # is_even / is_odd | 
| 390 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 391 |  |  |  |  |  |  |  | 
| 392 |  |  |  |  |  |  |  | 
| 393 |  |  |  |  |  |  |  | 
| 394 |  |  |  |  |  |  | # return true | 
| 395 |  |  |  |  |  |  | 1; | 
| 396 |  |  |  |  |  |  |  | 
| 397 |  |  |  |  |  |  |  | 
| 398 |  |  |  |  |  |  | __END__ |