File Coverage

blib/lib/Toolbox/Simple.pm

Criterion	Covered	Total	%
statement	125	243	51.4
branch	19	68	27.9
condition	5	16	31.2
subroutine	28	43	65.1
pod	25	26	96.1
total	202	396	51.0

#
# Toolbox::Simple   - Some tools (mostly math-related) to make life easier.
#                       Wrote it for myself, anyone else is welcome to it.
#
# (c) 2002 Jason Leane
#
# See "README" for help.
#

BEGIN {
	srand;
}

package Toolbox::Simple;

$VERSION = "0.52";

use Exporter;
use Socket;
use Sys::Hostname;
use MIME::Base64;
use Digest::MD5;
use IO::File;

@ISA 		= qw(Exporter);

@EXPORT 	= qw();

@EXPORT_OK 	= qw(c32 _nl send_mail md5_file b64_encode b64_decode my_hostname my_ip round_money commify_number hex2ascii ip2name name2ip fibo gcd gcf lcm is_prime dec2hex hex2dec dec2bin bin2dec dec2oct oct2dec time_now time_english);


sub average {
	my $nums = scalar(@_);
	my $n = 0;
	my $total = 0;

	foreach $n (@_) {
		$total = $total + $n;
	}

	my $avg = $total / $nums;
	return($avg);
}

sub fibo {
	my ($n, $s) = (shift, sqrt(5));
	return int((((0.5 + 0.5*$s) ** $n) - ((0.5 - 0.5*$s) ** $n)) / $s);
}

sub gcd {
	use integer;
	my $gcd = shift || 1;
	while (@_) {
		my $next = shift;
		while($next) {
			my $r = $gcd % $next;
			$r += $next if $r < 0;
			$gcd = $next;
			$next = $r;
		}
	}
	no integer;
	return $gcd;
}

sub gcf {
	use integer;
	my $gcf = shift || 1;
	while (@_) {
		my $next = shift;
		while($next) {
			my $r = $gcf % $next;
			$r += $next if $r < 0;
			$gcf = $next;
			$next = $r;
		}
	}
	no integer;
	return $gcf;
}

sub lcm {
	use integer;
	my $lcm = shift;
	foreach (@_) { $lcm *= $_ / gcd($_, $lcm) }
	no integer;
	return $lcm;
}

sub is_prime {
	# Hella props to Miller & Rabin
	use integer;
	my $n = shift;
	my $n1 = $n - 1;
	my $one = $n - $n1;
	my $wit = $one * 100;
	my $wit_count;

	my $p2 = $one;
	my $p2i = -1;
	++$p2i, $p2 *= 2 while $p2 <= $n1;
	$p2 /= 2;

	my $last_wit = 5;
	$last_wit += (260 - $p2i)/13 if $p2i < 260;

	for $wit_count ( 1..$last_wit ) {
		$wit *= 1024;
		$wit += rand(1024);
		$wit = $wit % $n if $wit > $n;
		$wit = $one * 100, redo if $wit == 0;

		my $prod = $one;
		my $n1bits = $n1;
		my $p2next = $p2;

		while(1) {
			my $rootone = $prod == 1 || $prod == $n1;
			$prod = ($prod * $prod) % $n;
			return 0 if $prod == 1 && !$rootone;

			if($n1bits >= $p2next) {
				$prod = ($prod * $wit) % $n;
				$n1bits -= $p2next;
			}

			last if $p2next == 1;
			$p2next /= 2;
		}
		return 0 unless $prod == 1;
	}
	no integer;
	return 1;
}

sub dec2hex {
	my $dec = int(shift);
	my $pref;
	if(shift) { $pref = '0x' } else { $pref = '' }
	my $hex = $pref . sprintf("%x", $dec);
	return($hex);
}

sub hex2dec {
	my $h = shift;
	$h =~ s/^0x//g;
	return(hex($h));
}

sub dec2oct {
	my $dec = int(shift);
	my $oct = sprintf("%o", $dec);
	return($oct);
}

sub oct2dec {
	my $o = shift;
	return(oct($o));
}

sub dec2bin {
	my $dec = int(shift);
	my $bits = shift;
	my $bin = unpack("B32", pack("N", $dec));
	substr($bin, 0, (32 - $bits)) = '';
	return($bin);
}

sub bin2dec {
	my $bin = shift;
	my $bits = length($bin);
	$bin = (32 - $bits) x '0' . $bin;
	my $dec = unpack("N", pack("B32", substr("0" x 32 . $bin, -32)));
	return($dec);
}

sub round_money {
	my $f = shift;
	if($f == int($f)) { return($f); }
	my $r = sprintf("%.2f", $f);
	return($r);
}

sub time_english {
	# Format = time | date_short | date_long | weekday | month | year | date_lf
	my $fmt = shift;
	my @days = qw(Sunday Monday Tuesday Wednesday Thursday Friday);
	my @months = qw(January February March April May June July August September October November December);
	my @t = localtime(time);
	if(length($t[0]) == 1) { $t[0] = '0' . $t[0] }
	if(length($t[1]) == 1) { $t[1] = '0' . $t[1] }
	if(length($t[2]) == 1) { $t[2] = '0' . $t[2] }
	my $tm = $t[2] . ':' . $t[1] . ':' . $t[0];
	my $d_long = $days[$t[6]] . ", " . $months[$t[4]] . " $t[3], " . ($t[5] + 1900);
	return $tm if $fmt eq 'time';
	$t[3]++; if(length($t[3]) == 1) { $t[3] = '0' . $t[3] }
	$t[4]++; if(length($t[4]) == 1) { $t[4] = '0' . $t[4] }
	my $d_short = $t[4] . '/' . $t[3] . '/' . ($t[5] + 1900);
	my $d_lf = $t[3] . '/' . $t[4] . '/' . ($t[5] + 1900);
	return $d_long if $fmt eq 'date_long';
	return $d_short if $fmt eq 'date_short';
	return $d_lf if $fmt eq 'date_lf';
	return $days[(localtime(time))[6]] if $fmt eq 'weekday';
	return $months[(localtime(time))[4]] if $fmt eq 'month';
	return $t[5] + 1900 if $fmt eq 'year';
	return 0;
}

sub time_now {
	my @t = localtime(time);
	if(length($t[0]) == 1) { $t[0] = '0' . $t[0] }
	if(length($t[1]) == 1) { $t[1] = '0' . $t[1] }
	if(length($t[2]) == 1) { $t[2] = '0' . $t[2] }
	my $tm = $t[2] . ':' . $t[1] . ':' . $t[0];
	return($tm);
}

sub name2ip {
	my $host = shift;
	my ($addr) = (gethostbyname($host))[4];
	my $ip = join(".", unpack("C4", $addr));
	return($ip);
}

sub ip2name {
	my $ip = shift;
	my $ia = inet_aton($ip);
	my $name = scalar(gethostbyaddr($ia, AF_INET));
	if($name) { return($name) } else { return(0) }
}

sub hex2ascii {
	my $hex = shift;
	return(chr(hex($hex)));
}

sub commify_number {
	# Props to Larry, as always
	my $num = shift;
	1 while $num =~ s/(\d)(\d\d\d)(?!\d)/$1,$2/;
	return($num);
}

sub send_mail {
	my $srv = shift;
	my $to = shift;
	my $from = shift;
	my $subject = shift;
	my $msg = shift;
	my @msglines = split(/\n/, $msg);
	unless($msg =~ /\n/) { $msglines[0] = $msg; }

	use Net::SMTP;

	my $smtp = Net::SMTP->new($srv) or return(0);
	$smtp->mail($from);
	$smtp->to($to);
	$smtp->data();
	$smtp->datasend("To: $to\n");
	$smtp->datasend("From: $from\n");
	$smtp->datasend("Subject: $subject\n");
	$smtp->datasend("X-Mailer: Toolbox-Simple v0.5 (Perl)\n\n");
	foreach $e (@msglines) {
		$smtp->datasend("$e\n");
	}
	$smtp->dataend();
	$smtp->quit;
	return(1);
}

sub my_hostname {
	return(hostname);
}

sub my_ip {
	return(&name2ip(hostname));
}

sub b64_encode {
	my $file = shift;
	my $out = shift || "$file.b64";
	open(BINP, $file) or return(0);
	open(BOUTP, ">$out") or return(0);
	while(read(BINP, $buf, 60*57)) {
		print(BOUTP encode_base64($buf));
	}
	close(BINP);
	close(BOUTP);
	return(1);
}

sub b64_decode {
	my $file = shift;
	my $out = shift || "$file.out";
	open(BINP, $file) or return(0);
	open(BOUTP, ">$out") or return(0);
	while() {
		print(BOUTP decode_base64($_));
	}
	close(BINP);
	close(BOUTP);
	return(1);
}

sub md5_file {
	my $file = shift;
	my $md5 = Digest::MD5->new;
	open(MDFILE, "<$file") or return(0);
	binmode(MDFILE);
	$md5->addfile(*MDFILE);
	my $dig = $md5->hexdigest;
	close(MDFILE);
	undef $md5;
	return($dig);
}

sub _nl {
	return("\n");
}

sub c32 {
	my $data = shift;
	my $c = unpack("%32C*", $data) % 32767;
	return(sprintf("%x", $c));
}

return 1;

__END__