oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Ready for 7.10.29 development.

Browse source
This commit is contained in:
Colin Kuskie 2013-03-20 21:38:23 -07:00
commit c806f99b7b
4236 changed files with 1217679 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

449
lib/WebGUI/Utility.pm Normal file
View file

@ -0,0 +1,449 @@
package WebGUI::Utility;
=head1 LEGAL
-------------------------------------------------------------------
WebGUI is Copyright 2001-2009 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::CIDR::Lite;
our @ISA = qw(Exporter);
our @EXPORT = qw(&isBetween &makeTabSafe &makeArrayTabSafe &randomizeHash &commify &randomizeArray &isInSubnet
&formatBytes &sortHashDescending &sortHash &isIn &makeCommaSafe &makeArrayCommaSafe &randint &round &scalarEquals
);
=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 = isBetween($value, $first, $second);
$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);
$rounded = round($number, $digits);
%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 emailRegex ( )
Returns a regex object that can be used to validate email addresses.
=cut
sub emailRegex {
return qr/^([0-9a-zA-Z]+[-._+&])*\w+@([-0-9a-zA-Z]+[.])+[a-zA-Z]{2,7}$/;
}
#-------------------------------------------------------------------
=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;
return 0 unless @{ $subnets };
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::CIDR::Lite->new(@{ $subnets });
if ($net->find($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. The array itself is modified, rather than
returning useful data.
=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 scalarEquals ( $a, $b, .. )
Checks an arbitrary number of scalars for strict equality.
Lets perl do all the work for us, via clever use of hash keys.
Credit goes to davido on perlmonks: http://www.perlmonks.org/?node_id=525349
Be aware that this may actually be more strict than you want. See Utility.t
for the full list of scalars that are considered equal and not equal.
=cut
sub scalarEquals {
# False when < 2 defined args
return 0 if ( grep { defined($_) } @_ ) < 2;
# Use args as hash keys, all equal if we end up with only 1 key
no warnings qw/uninitialized/;
my %gadget;
@gadget{@_} = ();
return scalar keys %gadget == 1 ? 1 : 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 sortHashDescending ( 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;