forked from plainblack/webgui
-
Notifications
You must be signed in to change notification settings - Fork 1
/
Utility.pm
409 lines (267 loc) · 8.45 KB
/
Utility.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
package WebGUI::Utility;
=head1 LEGAL
-------------------------------------------------------------------
WebGUI is Copyright 2001-2007 Plain Black Corporation.
-------------------------------------------------------------------
Please read the legal notices (docs/legal.txt) and the license
(docs/license.txt) that came with this distribution before using
this software.
-------------------------------------------------------------------
http://www.plainblack.com info@plainblack.com
-------------------------------------------------------------------
=cut
use Exporter;
use strict;
use Tie::IxHash;
use Net::Subnets;
our @ISA = qw(Exporter);
our @EXPORT = qw(&isBetween &makeTabSafe &makeArrayTabSafe &randomizeHash &commify &randomizeArray &isInSubnet
&formatBytes &sortHashDescending &sortHash &isIn &makeCommaSafe &makeArrayCommaSafe &randint &round
);
=head1 NAME
Package WebGUI::Utility
=head1 DESCRIPTION
This package provides miscellaneous but useful utilities to the WebGUI programmer.
=head1 SYNOPSIS
use WebGUI::Utility;
$string = commify($integer);
$size = formatBytes($integer);
$boolean = isIn($value, @array);
$boolean = isInSubnet($ip, \@subnets);
makeArrayCommaSafe(\@array);
makeArrayTabSafe(\@array);
$string = makeCommaSafe($string);
$string = makeTabSafe($string);
$integer = randint($low,$high);
$hashRef = randomizeHash(\%hash);
%hash = sortHash(%hash);
%hash = sortHashDescending(%hash);
=head1 METHODS
These subroutines are available from this package:
=cut
#-------------------------------------------------------------------
=head2 commify ( integer )
Returns a number with commas applied at each third character.
=head3 integer
Any old number will do.
=cut
sub commify {
my $text = reverse $_[0];
$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
return scalar reverse $text;
}
#-------------------------------------------------------------------
=head2 formatBytes ( integer )
Returns a formatted file size like "3MB" or "44kB".
=head3 integer
An integer representing the number of bytes to format.
=cut
sub formatBytes {
my $size = shift;
if ($size > 1048576) {
return round($size/1048576).' MB';
} elsif ($size > 1024) {
return round($size/1024).' kB';
} else {
return $size.' B';
}
}
#-------------------------------------------------------------------
=head2 isBetween ( value, first, second )
Returns true if value is between two other values (inclusive). Otherwise returns false.
=head3 value
An integer to compare against first and second.
=head3 first
An integer to compare value against.
=head3 second
Another integer to compare value against.
=cut
sub isBetween {
my $value = shift;
my $first = shift;
my $second = shift;
if ($first > $second) {
($first,$second) = ($second,$first);
}
if ($value >= $first && $value <= $second) {
return 1;
}
return 0;
}
#-------------------------------------------------------------------
=head2 isIn ( value, list )
Returns a boolean value as to whether the value is in the array.
=head3 value
The value to check for.
=head3 list
An array to look for the value in.
=cut
sub isIn {
my $key = shift;
$_ eq $key and return 1 for @_;
return 0;
}
#-------------------------------------------------------------------
=head2 isInSubnet ( ipAddress, subnets )
Verifies whether an IP address is in a given subnet. Returns a 1 if it is, undef if there's a formatting error, or 0 if the IP is not in the list of subnets.
=head3 ipAddress
A scalar containing an IP address.
=head3 subnets
An array reference containing subnets in CIDR format. Example: 127.0.0.1/32
=cut
sub isInSubnet {
my $ip = shift;
my $subnets = shift;
# some validation
for my $cidr ( @{ $subnets } ) {
my @parts = $cidr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\/(\d+)$/;
unless ( 5 == @parts ) { # cidr has 5 parts
return undef;
}
unless ( 4 == grep { $_ <= 255 } @parts[0..3] ) { # each octet needs to be between 0 and 255
return undef;
}
unless ( $parts[4] <= 32 ) { # the subnet needs to be less than or equal to 32, as 32 represents only 1 ip address
return undef;
}
}
my $net = Net::Subnets->new;
$net->subnets($subnets);
if ($net->check(\$ip)) {
return 1;
} else {
return 0;
}
}
#-------------------------------------------------------------------
=head2 makeArrayCommaSafe ( array )
Searches through an array looking for commas and replaces them with semi-colons. Also replaces carriage returns with spaces. This is useful for exporting comma separated data.
=head3 array
A reference to the array to look through.
=cut
sub makeArrayCommaSafe {
my $array = $_[0];
$_ = makeCommaSafe($_) for @$array;
}
#-------------------------------------------------------------------
=head2 makeArrayTabSafe ( array )
Searches through an array looking for tabs and replaces them with four spaces. Also replaces carriage returns with a space. This is useful for exporting tab separated data.
=head3 array
A reference to the array to look through.
=cut
sub makeArrayTabSafe {
my $array = $_[0];
$_ = makeTabSafe($_) for @$array;
}
#-------------------------------------------------------------------
=head2 makeCommaSafe ( text )
Replaces commas with semi-colons and carriage returns with spaces.
=head3 text
The text to search through.
=cut
sub makeCommaSafe {
my $text = $_[0];
$text =~ tr/,\r\n/; /;
return $text;
}
#-------------------------------------------------------------------
=head2 makeTabSafe ( text )
Replaces tabs with four spaces and carriage returns with a space each.
=head3 text
The text to search through.
=cut
sub makeTabSafe {
my $text = $_[0];
$text =~ tr/\r\n/ /;
$text =~ s/\t/ /g;
return $text;
}
#-------------------------------------------------------------------
=head2 randint ( low, high )
Returns an integer between the low and high number.
=head3 low
The lowest possible value. Defaults to 0.
=head3 high
The highest possible value. Defaults to 1.
=cut
sub randint {
my ($low, $high) = @_;
$low = 0 unless defined $low;
$high = 1 unless defined $high;
($low, $high) = ($high,$low) if $low > $high;
return $low + int( rand( $high - $low + 1 ) );
}
#-------------------------------------------------------------------
=head2 randomizeArray ( )
Don't use this function, it is depricated and will be removed at some point in the future. Instead use List::Util::shuffle()
=cut
sub randomizeArray {
my $array = shift;
if ($#$array > 0) {
for (my $i = @$array; --$i; ) {
my $j = int rand ($i+1);
next if $i == $j;
@$array[$i,$j] = @$array[$j,$i];
}
}
}
#-------------------------------------------------------------------
=head2 randomizeHash ( hashRef )
Resorts a hash tied to IxHash in random order. Returns a hash reference.
=head3 hashRef
A reference hash to randomize.
=cut
sub randomizeHash {
my $hash = $_[0];
my @keys = keys %$hash;
randomizeArray(\@keys);
tie my %temp, 'Tie::IxHash';
foreach my $key (@keys) {
$temp{$key} = $hash->{$key};
}
return \%temp;
}
#-------------------------------------------------------------------
=head2 round ( float [, significantDigits ] )
Returns an integer after rounding a floating point number.
=head3 float
Any floating point number.
=head3 significantDigits
The number of digits to leave after the decimal point. Defaults to 0.
B<NOTE:> If you set this higher than 0 then you'll get back another floating point number rather than an integer.
=cut
sub round {
my $significantDigits = $_[1] || 0;
return sprintf(('%.'.$significantDigits.'f'), $_[0]);
}
#-------------------------------------------------------------------
=head2 sortHash ( hash )
Sorts a hash by its values. Returns a Tie::IxHash. You must assign this to
a similarly tied hash to preserve the order.
=head3 hash
A hash to be sorted.
=cut
sub sortHash {
my %hash = @_;
tie my %newHash, 'Tie::IxHash';
for my $key ( sort { $hash{$a} cmp $hash{$b} } keys %hash ) {
$newHash{ $key } = $hash{ $key };
}
return %newHash;
}
#-------------------------------------------------------------------
=head2 sortHashDecending ( hash )
Sorts a hash in decending order by its values. Returns a Tie::IxHash.
You must assign this to a similarly tied hash to preserve the order.
=head3 hash
A hash to be sorted.
=cut
sub sortHashDescending {
my %hash = @_;
tie my %newHash, 'Tie::IxHash';
for my $key ( sort { $hash{$b} cmp $hash{$a} } keys %hash ) {
$newHash{ $key } = $hash{ $key };
}
return %newHash;
}
1;