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__ |