Perl code snippets

Blobs of code

sub max { my $r=$_[0]; for (@_) { if ($_>$r) { $r=$_ } }; return $r; }
sub min { my $r=$_[0]; for (@_) { if ($_<$r) { $r=$_ } }; return $r; }
sub sum { my $r=0; for (@_) { $r += $_ }; return $r; }
sub avg { return sum(@_)/@_; }
sub stdev {
	my $s=0;
	my $avg = avg(@_);
	foreach (@_){
		$s += ($_ - $avg)**2;
	}
	return sqrt($s/(@_-1));
}
sub limits {
	my $lo = my $hi = $_[0];
	for (@_) { 
		if ($_<$lo) { $lo=$_ } 
		if ($_>$hi) { $hi=$_ } 
	}
	return ($lo,$hi); 
}
# returns maximum in scalar context; returns (maximum,max_index) in list context.
sub max {
	my $I=0;
	my $r=$_[0]; 
	for (my $i=1; $i<@_; $i++) {
		if ($_[$i] > $r) { 
			$r=$_[$i]; 
			$I=$i 
		}
	}
	return wantarray ? ($r,$I) : $r; 
}
# returns minimum in scalar context; returns (minimum,min_index) in list context.
sub min {
	my $I=0;
	my $r=$_[0]; 
	for (my $i=1; $i<@_; $i++) {
		if ($_[$i] < $r) { 
			$r=$_[$i]; 
			$I=$i 
		}
	}
	return wantarray ? ($r,$I) : $r; 
}
 
sub timestamp {
	my ($fmt,$time) = @_;
	$fmt ||= 'SHORT';
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = defined($time) ? localtime($time) : localtime();
	$mon++; $year += 1900;
	return 
		($fmt eq 'SHORTEST') ? sprintf("%04d%02d%02d-%02d%02d%02d",$year,$mon,$mday,$hour,$min,$sec) :
		($fmt eq 'SHORT') ? sprintf("%04d-%02d-%02d %02d:%02d:%02d",$year,$mon,$mday,$hour,$min,$sec) :
		'<undefined timestamp format>';
}
 
sub size_units {
	my ($n) = @_;
	if ($n>1024*1024*1024*1024) { return sprintf("%.1f T",$n/(1024*1024*1024*1024)); }
	if ($n>     1024*1024*1024) { return sprintf("%.1f G",$n/(     1024*1024*1024)); }
	if ($n>          1024*1024) { return sprintf("%.1f M",$n/(          1024*1024)); }
	if ($n>               1024) { return sprintf("%.1f k",$n/(               1024)); }
	return $n;
}
 
sub parse_size_units {
	my ($s) = @_;
	if ($s=~/^([.\d]+)([kmgt]?)$/i) {
		if    ($2 eq 't' || $2 eq 'T') { return $1*1024*1024*1024*1024; }
		elsif ($2 eq 'g' || $2 eq 'G') { return $1*1024*1024*1024; }
		elsif ($2 eq 'm' || $2 eq 'M') { return $1*1024*1024; }
		elsif ($2 eq 'k' || $2 eq 'K') { return $1*1024; }
		else                           { return $1; }
	} else {
		return undef;
	}
}
 
 
 
use Getopt::Std;
my %opt;
getopts( 'o:vh', \%opt ) or usage();
usage() if ($opt{h} or !@ARGV);
 
 
sub file_put_contents {
	my ($file) = @_;
	open my $fp, "> $file" or die "$file: $!\n";
	print $fp $_ for (@_);
	close $fp;
}
sub file_get_contents {
	my ($file) = @_;
	local $/ = undef;
	open my $fp, "< $file" or die "$file: $!\n";
	my $r = <$fp>;
	close $fp;
	return $r;
}
 
# this forces a full stack trace on every exception
use Carp qw( confess );
$SIG{__DIE__} =  \&confess;
$SIG{__WARN__} = \&confess;
 
 
sub commify {
	# commify a number. Perl Cookbook, 2.17, p. 64
	my $text = reverse $_[0];
	$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
	return scalar reverse $text;
}
 
##
# copy data from source to destination until EOF.  Either argument can be
# a file handle or a file name.  If the latter, the file will be opened for
# the appropriate mode, and closed when done.
#
# Params: 
#  $src - Source file name or handle
#  $dest - Destination file name or handle
#
sub copy {
	my ($src,$dest) = @_;
	my ($fpSrc,$fpDest);
 
	# if the src is a glob (aka file handle), use it, else open it
	if (ref($src) eq 'GLOB') { $fpSrc = $src; }
	elsif (ref($src) eq '') { open $fpSrc,$src or die "$src: $!\n"; }
	else { die "Invalid src type: $src\n"; }
 
	# ditto for dest
	if (ref($dest) eq 'GLOB') { $fpDest = $dest; }
	elsif (ref($dest) eq '') { open $fpDest,$dest or die "$dest: $!\n"; }
	else { die "Invalid dest type: $dest\n"; }
 
	# do copy
	my $buf;
	while (read($fpSrc,$buf,1024)) {
		print $fpDest $buf;
	}
 
	# if we opened the file, we close it
	if (ref($src) eq '') { close $fpSrc; }
	if (ref($dest) eq '') { close $fpDest; }
 
}
 
 
#stupid slow timeout
sub ip2host {
	my $name = gethostbyaddr(inet_aton($_[0]), AF_INET);
	return $name;
}
 
# faster, needs nslookup installed
sub ip2host {
	my ($ip) = @_;
	open PIPE,"nslookup $ip |" or die "pipe: $!\n";
	while (<PIPE>) {
		if (/name = (.*)\./) { # if this line contains the name...
		return $1;
		}
	}
	return;
}
 
 
sub round_to_nearest_multiple {
	my ($n,$m) = @_;
	my $r = $n % $m;
	return $r ? $n+$m-$r : $n;
}