package MISC;
use strict;
use File::Copy;
use Cwd qw(cwd abs_path);
use FindBin qw($RealDir);
use lib $RealDir;
use FORKER;

our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);

use Exporter;
$VERSION = 2008.166;
@ISA = qw(Exporter);

@EXPORT = qw(); # symbols to autoexport (:DEFAULT tag)
@EXPORT_OK = qw(open_table read_event read_time read_time2 read_geom 
		read_chan mash smash get_dir_files get_dir_dirs 
		copy_list2dir mcopy_list2dir labs 
		abs_path_list unlink_list); # symbols to export on request
%EXPORT_TAGS = (
	pre_css => [qw(open_table read_event read_time read_time2 read_geom read_chan)], # old flat file routines for pps-1.0
	other => [qw(mash smash get_dir_files get_dir_dirs copy_list2dir mcopy_list2dir labs abs_path_list unlink_list)],
);

# BEGIN CODE
###################################################################

# (TABLE FILE, #_OF_HEADER_LINES_TO_REMOVE)
sub open_table {
	open(TABLE,$_[0]) or print "COULD NOT OPEN TABLE FILE: $_[0]!\n" and mexit(1000);
	my @table=<TABLE>; close(TABLE); splice(@table,0,$_[1]); chomp(@table); return sort(@table);
}

sub read_event {
	# OPEN EVENT FILE
	open(EFILE,$_[0]) or print "COULD NOT OPEN EVENT INFO FILE: $_[0]!\n" and mexit(1001);
	
	# PARSING INFO
	my ($kevnm)=split('<=',<EFILE>);
	my ($evla)=split('<=',<EFILE>);
	my ($evlo)=split('<=',<EFILE>);
	my ($evdp)=split('<=',<EFILE>);
	my ($evyear)=split('<=',<EFILE>);
	my ($evjday)=split('<=',<EFILE>);
	my ($evhour)=split('<=',<EFILE>);
	my ($evmin)=split('<=',<EFILE>);
	my ($evsec)=split('<=',<EFILE>);
	my ($mb)=split('<=',<EFILE>);
	my ($mo)=split('<=',<EFILE>);
	my ($ms)=split('<=',<EFILE>);
	close(EFILE);
	
	# RETURNING INFO
	return mash($kevnm,$evla,$evlo,$evdp,$evyear,$evjday,$evhour,$evmin,$evsec,$mb,$mo,$ms);
}

sub read_time {
	# PARSING INFO
	my (%npts,%delta,%b,%e);
	foreach (open_table($_[0],1)) {
		my ($file,@temp)=split(' ',$_);
		$npts{$file}=$temp[0];
		$delta{$file}=$temp[1];
		$b{$file}=$temp[2];
		$e{$file}=$temp[3];
	}
	
	# RETURNING INFO
	return \(%npts,%delta,%b,%e);
}

sub read_time2 {
	# OPEN TIMING FILE
	open(TFILE,$_[0]) or print "COULD NOT OPEN TIMING INFO FILE: $_[0]!\n" and mexit(1020);
	
	# PARSING INFO
	my %records;
	my $header=<TFILE>; # DUMP HEADER
	foreach (<TFILE>) {$records{(split(" ",$_))[0]}=$_;}
	close(TFILE);
	
	# RETURNING INFO
	return %records;
}

sub read_geom {
	# PARSING INFO
	my (%stla,%stlo,%stel,%stdp,%gcarc,%dist,%az,%baz);
	foreach (open_table($_[0],1)) {
		my ($file,@temp)=split(' ',$_);
		$stla{$file}=$temp[0];
		$stlo{$file}=$temp[1];
		$stel{$file}=$temp[2];
		$stdp{$file}=$temp[3];
		$gcarc{$file}=$temp[4];
		$dist{$file}=$temp[5];
		$az{$file}=$temp[6];
		$baz{$file}=$temp[7];
	}
	
	# RETURNING INFO
	return \(%stla,%stlo,%stel,%stdp,%gcarc,%dist,%az,%baz);
}

sub read_chan {
	# PARSING INFO
	my (%knetwk,%kstnm,%khole,%kcmpnm,%cmpinc,%cmpaz);
	foreach (open_table($_[0],1)) {
		my ($file,@temp)=split(' ',$_);
		$knetwk{$file}=$temp[0];
		$kstnm{$file}=$temp[1];
		$khole{$file}=$temp[2];
		$kcmpnm{$file}=$temp[3];
		$cmpinc{$file}=$temp[4];
		$cmpaz{$file}=$temp[5];
	}
	
	# RETURNING INFO
	return \(%knetwk,%kstnm,%khole,%kcmpnm,%cmpinc,%cmpaz);
}

# REMOVES WHITESPACE AT START/END OF LINE
sub mash {return map {s/^\s+//; s/\s+$//; $_;} @_;}
sub smash {my $out=$_[0]; $out=~s/^\s+//; $out=~s/\s+$//; return $out;}

sub get_dir_files {
	# NEW LIST BASED ON DATA FILES
	opendir(DIR,$_[0]) or print "COULD NOT OPEN DIRECTORY: $_[0]!\n" and mexit(1050);
	my ($adir)=abs_path_list($_[0]);
	my @list=readdir(DIR); closedir(DIR); chomp(@list);
	@list=sort @list; @list=grep {! -d $adir.$_} @list;
	return @list;
}

sub get_dir_dirs {
	# NEW LIST BASED ON DATA FILES
	opendir(DIR,$_[0]) or print "COULD NOT OPEN DIRECTORY: $_[0]!\n" and mexit(1060);
	my ($adir)=abs_path_list($_[0]);
	my @list=readdir(DIR); closedir(DIR); chomp(@list);
	@list=sort @list; @list=grep {-d $adir.$_} @list;
	@list=grep {$_ ne '.' and $_ ne '..'} @list;
	return @list;
}

# FIRST ARGUMENT IS THE DIRECTORY TO COPY TO - THE REST IS LIST OF FILES TO COPY
sub copy_list2dir {
	for (my $i=1; $i<=$#_; $i++) {
		copy($_[$i],$_[0]) or print "COULD NOT COPY $_[$i] TO $_[0]!\n$!\n" and mexit(1070);
	}
}

# FIRST ARGUMENT IS THE PROCESSOR SCALING, SECOND IS THE DIRECTORY TO COPY TO - THE REST IS LIST OF FILES TO COPY
sub mcopy_list2dir {
	my ($nproc,$outdir,@files)=@_;
	my $id=forker($nproc);
	@files=parsel($id,$nproc,@files);
	foreach (@files) {
		copy($_,$outdir) or print "COULD NOT COPY $_ TO $outdir!\n$!\n" and mexit(1080);
	}
	dethread(0,$id);
}


# ABSOLUTE VALUE OF EACH ELEMENT OF A LIST
sub labs {return map {abs} @_;}

# GET ABSOLUTE PATHS FOR A LIST
sub abs_path_list {
	my @obj=@_; my $cwd=cwd;
	foreach (my $i=0; $i<=$#obj; $i++) {
		if (-d $obj[$i]) {
			chdir($obj[$i]) or print "COULD NOT MOVE INTO DIRECTORY $obj[$i]!\n" and mexit(1090);
			$obj[$i]=abs_path('x'); 
			chop($obj[$i]);
			chdir($cwd) or print "COULD NOT MOVE INTO DIRECTORY $cwd!\n" and mexit(1091);
		} else {$obj[$i]=abs_path($obj[$i]);}
	}
	return @obj;
}

# DELETE LIST OF FILES
sub unlink_list {
	foreach (@_) {
		unlink($_) or print "COULD NOT DELETE FILE $_!\n" and mexit(1100);
	}
}

###################################################################

1;
