#!/usr/bin/perl 
1;

### data access

sub Array { local (*array) = @_;
	defined(@array)? @array : ();
}
sub Assoc { local (*array) = @_;
	defined(%array)? %array : ();
}
sub ArraySize { local (*array) = @_;
	defined(@array)? $#array+1 : 0;
}
sub AssocSize { local (*array) = @_;
	defined(%array)? &ArraySize(keys %array) : 0;
}
sub ArrayVal { local (*array,$key) = @_;
	defined(@array)? $array[$key] : undef;
}
sub AssocVal { local (*array,$key) = @_;
	defined(%array)? $array{$key} : undef;
} 
sub AssocKeys { local (*array) = @_;
	defined(%array)? (keys %array) : undef;
} 

sub FindArrayKey { local (*array,$val) = @_;
	local $found;
	foreach $key (0..$#array) {
		$found = $key if ($array[$key] eq $val);
		last if defined($found);
	} $found;
}
sub FindAssocKey { local (*array,$val) = @_;
	local $found;
	foreach $key (keys %array) {
		$found = $key if ($array{$key} eq $val);
		last if $found;
	} $found;
}
sub FindArrayKeys { local (*array,$val) = @_;
	local @found;
	foreach $key (0..$#array) {
		$found[$#found+1] = $key if ($array[$key] eq $val);
	} @found;
}
sub FindAssocKeys { local (*array,$val) = @_;
	local @found;
	foreach $key (keys %array) {
		$found[$#found+1] = $key if ($array{$key} eq $val);
	} @found;
}

sub AppendArray { local(*array,@new) = @_;
	foreach $val (@new) {
		$array[$#array+1] = $val;
	} 1;
}
sub AppendAssoc { local(*array,%new) = @_;
	foreach $key (keys %new) {
		$array{$key} = $new{$key};
	} 1;
}

sub CreateArray { local(@new) = @_;
	local $array = &AutoName;
	&AppendArray($array,@new);
	$array;
}
sub CreateAssoc { local(%new) = @_;
	local $array = &AutoName;
	&AppendAssoc($array,%new);
	$array;
}

sub Ascending  { $a <=> $b; }
sub Descending { $b <=> $a; }

sub ByAscendingArrayVal  { $array[$a] <=> $array[$b]; }
sub ByDescendingArrayVal { $array[$b] <=> $array[$a]; }

sub ByAscendingAssocVal  { $array{$a} <=> $array{$b}; }
sub ByDescendingAssocVal { $array{$b} <=> $array{$a}; }

sub GetSubArray { local (*array,$left,$right) = @_;
	local @subarray = ();
	for $i ($left..$right) {
		$subarray[$#subarray+1] = $array[$i];
	}
	@subarray;
}
sub CreateSubArray { local($array,$left,$right) = @_;
	&CreateArray(&GetSubArray($array,$left,$right));
}

sub PrependArray { local(*array,@new) = @_;
	@array = (@new,@array);
}
sub InsertArray { local($insert,*array,@new) = @_;
	@array = (&GetSubArray($array,0,$insert-1),@new,&GetSubArray($array,$insert,$#array));
}

### Array data processing

sub ArrayEq { local(*array1,*array2,$compare) = @_;
	local $eq = ($#array1 == $#array2);
	foreach $i (0..$#array1) {
		last unless $eq;
		$eq = $compare? &Eval($compare,$array1[$i],$array2[$i]) : ($array1[$i] == $array2[$i]);
	} 
	$eq;
}

sub PrintArray { local(*array,*info,@arg) = @_;
	for $key (0..$#array) {
		local $val = $array[$key];
		$val = &info($val,@arg) if defined(&info);
		print("$key\t$val\n");
	}
}

sub PrintAssoc { local(*array,*info,@arg) = @_;
	foreach $key (keys %array) {
		local $val = $array{$key};
		$val = &info($val,@arg) if defined(&info);
		print("$key\t$val\n");
	}
}

### file IO

sub FileIn {	local($file,$process,@args) = @_;
	open (FILEIN,$file) or die ("Cannot read file \42$file\42\n");
	print("# System Message:\tstarted reading file \42$file\42 ",&DateTime,"\n");
	local $line;
	while (<FILEIN>) {
		$line ++;
		print("# System Message:\t$line lines read\n") unless $line%10000;
		local @data = split;
		&Eval($process,@args,@data) if $process;
	}
	print("# System Message:\tfinished reading file \42$file\42 ",&DateTime,"\n");
	close(FILEIN);
}

sub FileOut {	local($file,$process,@args) = @_;
	open (FILEOUT,">$file") or die ("Cannot write file \42$file\42\n");
	print("# System Message:\tstarted writing file \42$file\42 ",&DateTime,"\n");
	print(FILEOUT $AutoFirstLine,&AutoFirstLine($file),"\n") if $AutoFirstLine;
	&Eval($process,@args) if $process;
	print("# System Message:\tfinished writing file \42$file\42 ",&DateTime,"\n");
	close(FILEOUT);
}

sub AutoFirstLine {	local($file) = @_;
	"File \42$file\42 written ",&DateTime," by $ProgramName version $ProgramVersion";
}

### string processing

sub LowerCase {	local($word) = @_;
	$word =~ tr/A-Z/a-z/; $word;
}

sub UpperCase {	local($word) = @_;
	$word =~ tr/a-z/A-Z/; $word;
}

sub StringMatch {	local($word,@matches) = @_;
	local $found;
	foreach $match (@matches) {
		$found = (&UpperCase($word) eq &UpperCase($match));
		last if $found;
	} $found;
}

sub Beginning {	local($word,$n) = @_;
	substr($word,0,$n);
}

sub Ending {	local($word,$n) = @_;
	substr($word,length($word)-$n,$n);
}

sub Unbrace {	local($word) = @_;
	($word =~ /^\((.*)\)$/)? $1 :
	($word =~ /^\{(.*)\}$/)? $1 :
	($word =~ /^\[(.*)\]$/)? $1 :
	($word =~ /^\<(.*)\>$/)? $1 :
	$word;
}

sub Unquote {	local($word) = @_;
	($word =~ /^\42(.*)\42$/)? $1 :
	($word =~ /^\47(.*)\47$/)? $1 :
	$word;
}

sub Doublequote {	local($word) = @_;
	"\42".&Unquote($word)."\42";
}

sub Singlequote {	local($word) = @_;
	"\47".&Unquote($word)."\47";
}

sub Plural {	local($word) = @_;
	($word =~ /(\S*)(AY|EY|OY|UY)$/)? "$1$2S" :
	($word =~ /(\S*)(ay|ey|oy|uy)$/)? "$1$2s" :
	($word =~ /(\S+)Y$/)?  	"$1IES" :
	($word =~ /(\S+)y$/)?  	"$1ies" :
	($word =~ /(\S+)X$/)?  	"$1CES" :
	($word =~ /(\S+)x$/)?  	"$1ces" :
	($word =~ /(\S+)S$/)?  	"$1SES" :
	($word =~ /(\S+)s$/)?  	"$1ses" :
	($word =~ /(\S*)([A-Z])$/)?	"$1$2S" :
	($word =~ /(\S*)([a-z])$/)?	"$1$2s" :
	$word;
}

sub Singular {	local($word) = @_;
	($word =~ /(\S*)(AY|EY|OY|UY)S$/)? "$1$2" :
	($word =~ /(\S*)(ay|ey|oy|uy)s$/)? "$1$2" :
	($word =~ /(\S+)IES$/)?  	"$1Y" :
	($word =~ /(\S+)ies$/)?  	"$1y" :
	($word =~ /(\S+)CES$/)?  	"$1X" :
	($word =~ /(\S+)ces$/)?  	"$1x" :
	($word =~ /(\S+)SES$/)?  	"$1S" :
	($word =~ /(\S+)ses$/)?  	"$1s" :
	($word =~ /(\S*)([A-Z])S$/)?	"$1$2" :
	($word =~ /(\S*)([a-z])s$/)?	"$1$2" :
	$word;
}

### misc

sub AutoName {
	$AutoNameCount = $AutoNameCount + 1;
	$AutoNameID.'_'.$AutoNameCount;
}

sub AutoNameStart {	local($id,$n) = @_;
	$AutoNameID = $id;
	$AutoNameCount = $n;
}

sub AutoTab { 	local($n) = @_;
	local $tab = '';
	while ($n) {
		$n = $n-1;
		$tab = "$tab  ";
	} $tab;
}

sub DateTime {
	local ($sec,$min,$hour,$month_day,$month,$year,$week_day,$year_day,$isdst) = localtime(time);
	local (@week_day)  = (Sun,Mon,Tue,Wed,Thu,Fri,Sat);
	local (@month) = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
	$year  = $year + 1900;
	$week_day[$week_day]." ".$month[$month]." $month_day $year $hour:$min:$sec";
}

sub Eval { local(*sub,@arg) = @_;
	&sub(@arg);
}