#!/usr/bin/perl
# USGS computer program source code: qwmixtrace.pl
# 
# Use of this program is described in USGS Scientific Investigations Report:
# Software for Analysis of Chemical Mixture Occurrence, Distribution, and
# Potential Toxicity by Jonathon Scott, Kenneth Skach, and Patricia Toccalino
# 
# The program is written in the Perl programming language (version 5.10.1)
# and was developed and tested on a Sun V440 with 8-GB of memory running
# SunOS 5.10.  The program has also been successfully using a Lenovo with
# 64-bit Intel G630 processors and 6-GB of memory running Microsoft Windows 7.
#
# Use of trade names is for identification purposes and does not imply
# endorsement by the U.S. Geological Survey.  Perl and applicable Perl
# packages are free software, made available under an Artistic License.
# http://perldoc.perl.org/perlartistic.html
#
# Although this program has been used by the USGS, no warranty, expressed or
# implied, is made by the USGS or the United States Government as to the
# accuracy and functioning of the program and related program material nor
# shall the fact of distribution constitute any such warranty, and no
# responsibility is assumed by the USGS in connection therewith.
#
# Program to trace mixtures back to analytical results.
#
# Jon Scott, Oct 2008 : Initial coding
#            Sep 2012 : Improved internal documentation 
#            Oct 2012 : Version 1.0
#
=head1 Usage

qwmixtrace -f output_file -d input_directory -m mixture_1 ... -m mixture_n 


=head1 Required arguments:

 -d directoryname  the directory name for reading stored input
 -f output_file    name of output file to create

=head1 Optional arguments:

 -m "mixture"      mixture in "quotes" and repeat -m as necessary
 -n occurrences    minimum number of occurrences for a mixture to be traced
 either -m or -n must be specified, although both may be used.

=cut
# ==================================================================
# -- Scan mixture to see if in the target list of mixtures
# ==================================================================
sub bruteforce {
    local ($mixture,@Mixtures) = @_;
    my $found = 0;
    my ($mix);
    scanmix: foreach $mix (@Mixtures) {
	if ($mixture eq $mix) {
	    $found ++;
	    last scanmix;
	}
    }
    return $found;
}
# ==================================================================
# -- Display any error and warning messages, stopping for error.
# ==================================================================
sub ErrorExit {
    print "Errors:\n  ", join(".\n  ",@error),".\n" if $#error >= 0;
    print "Alerts:\n  ", join(".\n  ",@alert),".\n" if $#alert >= 0;
    exit if $#error >= 0;
}

# ==================================================================
# -- Perl packages used, see:  http://cpan.org
# ==================================================================
use IO::Zlib;
use File::Basename;
use File::Spec::Functions;

$DEBUG = 0;
$Clock = 1;
$expect = 99999 * 10 ** 99;
$starttime = times;
# ==================================================================
# -- Parse command-line arguments
# ==================================================================
while ( ($_ = $ARGV[0]) =~ /^-\S/ ) {
    print "Processing command argument: $_\n" if $DEBUG;
    $_ = shift;
    if ( /^-d.*/ ) { $Directory = shift; }
    if ( /^-f.*/ ) { $FileName  = shift; }
    if ( /^-m.*/ ) { $mixture = shift;
		     $mixture = join("+",sort(split(/[+]/,$mixture)));
		     push (@Mixtures,$mixture);}
    if ( /^-n.*/ ) { $MinOcc  = shift;}
}
if ($#ARGV >= 0) {
    push (@error,"Unexpected arguments: " . join(" ",@ARGV));
}
# ==================================================================
# -- Check the directory-name argument, open input file
# ==================================================================
if ($Directory eq "") {push (@error,"Missing required argument: -d directory")}
else {
    if (! -e $Directory) {
	push (@error,"No such directory: $Directory");
    }
    else {
	if (! -d "$Directory") {
	    push(@error,"Not a directory: $Directory");
	}
	if (! -w "$Directory") {
	    push(@error,"Directory is not writeable: $Directory");
	}
	$RawPath  = catfile(curdir(), $Directory, "raw.rdb");
	$RawPathZ = join(".", $RawPath, "gz");
	if (-f $RawPathZ) {
	    tie *RAW, 'IO::Zlib', $RawPathZ , "rb" ||
		push (@error,"Unable to open input file: $RawPathZ");
	}
	elsif (-f $RawPath) {
	    $unzipped ++;
	    open (RAW,"<",$RawPath)  ||
		push (@error,"Unable to open input file: $RawPath");
	}
	else {
	    push (@error,"Unable to find input file: $RawPath");
	}
# ==================================================================
# -- Determine the mixtures to find from minimum-occurrence count 	
# ==================================================================
	
	if ( $MinOcc ne "" ) {
	    $MixPath = catfile(curdir(), $Directory, "mixtures.rdb.gz");
	    tie *MIX, 'IO::Zlib', $MixPath , "rb" ||
		push (@error,"Unable to open input file: $MixPath");
	    $row    = 0;
	    $expect = 0;
	    readmix: while (<MIX>) {
		next readmix if (/^#/); #;
		$row ++;
		next readmix if ($row < 3); # Ignore RDB header rows
		$_ =~ s/[\r\n]+$//;         # aka "chop"
		($mixture,$count,$extra) = split ("\t",$_,3);
		if ($count >= $MinOcc) {
		    push (@Mixtures,$mixture);
		    $expect += $count;
		}
		else {
		    last readmix; # mixture file is sorted by desc occurrence
		}
	    }
	    untie *MIX;
	}
    }
}
# ==================================================================
# -- Check the mixtures argument(s)
# ==================================================================
if ($#Mixtures < 0) {
    if ($MinOcc eq "") {
	push (@error,"Missing required argument: -m mixture")}
    else {
	push (@error,"No mixtures occurring >= $MinOcc found in $MixPath\n");
    }
}
# ==================================================================
# -- Check the output-file name argument
# ==================================================================
if ($FileName eq "") {push (@error,"Missing required argument: -f filename")}
else {
    ($name,$path,$suffix) = fileparse($FileName,qr{\.gz});
    if ($suffix ne ".gz") {
	push (@alert,"Added \".gz\" suffix to file name $FileName");
	$FileName .= ".gz";
    }
    $FilePath = catfile(curdir(), $Directory, $FileName);
    if (-e $FilePath) { push (@alert,"Overwriting existing file: $FileName");}

    tie *OUT, 'IO::Zlib', $FilePath, "wb" ||
	push (@error,"Unable to open $FileName for writing\n");
}

&ErrorExit if ($#error >= 0 || $#alert >= 0) ;
# ==================================================================
# -- Search for mixtures
# ==================================================================
$nf  = 0;
$row = 0;
$starttime = times;
readraw: while (<RAW>) {
  next readraw if (/^#/); #;
  $row ++;
  if ($row < 3 ) {print OUT $_;}
  else {
      ($mixture,$other) = split ("\t",$_,2);
      if (&bruteforce ($mixture,@Mixtures)) {
	  print OUT $_ ;
	  $nf ++;
	  last readraw if $nf == $expect;
      }
      # Perhaps some elegant search method will be added?
  }
}  
# ==================================================================
# -- Print final milestone, close files
# ==================================================================
$endtime = times;
$elapsed = $endtime - $starttime;
print "Found $nf mixtures in $elapsed seconds\n";   
if ($unzipped) {close RAW;} else {untie *RAW;}
untie *OUT;
