#!/usr/local/bin/perl
# -*-Perl-*- 
#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################
# 


package TestTools;

use Carp;
use strict;
use FileHandle;

$|=1;

sub new {
    my $type = shift;
    my %params = @_;
    my $self = {};
    $self->{verbose} = $params{verbose};
    $self->{CAF} = {
        DNA => {}, 
        DNALen => {},
        BaseQuality => {},
        BaseQualityLen => {}
    };
    $self->{test} = $params{tests_to_run};
    if($self->{test}) {
        $self->{pass} = 0;
        $self->{fail} = 0;
        $self->{ontest} = 0;
        $self->{test_src_dir} = '../../src';
        ($self->{program}) = (caller())[1] =~ /test_(\S+)/; 
    }
    my $ref = bless $self, $type;

    if($self->{test}) {
        $ref->enter_test_dir();
        select $ref->open_test_log();
    }
    
    return $ref;
}

sub enter_test_dir {
    my ($self) = @_;
    
    my $dir = $self->{program} . "-test";
    unless(chdir("$dir")) {
        ++$self->{fail};
        &print_test_results();
        print "ERROR: Unable to enter directory $dir.$!\n";  
        die;
    }
}

sub readCafFile {
    my ($self, $file) = @_;
    my $fileRef = (ref($file)) ? $file : (FileHandle->new("< $file"));
    my $size = -s $fileRef;
    $size = 1 unless ($size);
    my ($name, $class,$failed_dup);
    my @x;
    while (<$fileRef>) {
        s/\/\/.*// ;			# ace file comments
        if ( /^DNA\s+(:\s+)?(\S+)/ ) {
            $name = $2;
	    @x = ();
	    while (<$fileRef>) {
		last if /^\s*$/ ;
		s/\s+//g ;		# remove whitespace
		push(@x,$_);
	    }
	    $self->{CAF}->{DNA}->{$name} = join("",@x)
		unless ($self->{CAF}->{DNA}->{$name} && $self->_reportDuplicate($name, 'DNA',\$failed_dup));
            $self->{CAF}->{DNALen}->{$name} = scalar(@x);
	} elsif ( /BaseQuality\s+(:\s+)?(\S+)/ ) {
            $name = $2;
	    @x = ();
	    while (<$fileRef>) {
		last if /^\s*$/;
		chomp;
		push(@x, $_);
	    }
	    $self->{CAF}->{BaseQuality}->{$name} = join(" ", @x)
		unless ($self->{CAF}->{BaseQuality}->{$name} && $self->_reportDuplicate($name, 'base quality',\$failed_dup));
            $self->{CAF}->{BaseQualityLen}->{$name} = scalar(@x);
	} elsif ( /^(\S+)\s+(:\s+)?(\S+)/ ) {
	    $class = $1;
	    $name = $3;
	    $self->{CAF}->{$class} = {} unless $self->{CAF}->{$class};
	    @x = ();
	    while (<$fileRef>) {
		last if /^\s*$/ ;
		s/\\\n$// ;		# continuation lines
		push(@x,$_);
	    }
            @x = sort @x;
	    if (defined($self->{CAF}->{$class}->{$name})) {
	        $self->{CAF}->{$class}->{$name} .= join("",@x) unless $self->_reportDuplicate($name, $class,\$failed_dup);
	    } else {                
	        $self->{CAF}->{$class}->{$name} = join("",@x);
                # combine sequence string into one nospace line for equality.
                $self->{CAF}->{$class}->{$name} =~ s/[\n|\s+]//g;
	    }
	}
	last if eof($fileRef);
    }
    return $failed_dup;
}

sub _reportDuplicate {
    my ($self, $name, $class,$fc) = @_;
    print "Found duplicate $class entry $name in CAF file.\n";
    ++$$fc;
}

sub contigsList {
    my ($self) = @_;
    confess "Wrong type" unless ref($self);
    return grep($self->{CAF}->{Sequence}->{$_} =~ /Is_contig\n/, keys(%{$self->{CAF}->{Sequence}}));
}

sub readsList {
    my ($self) = @_;
    confess "Wrong type" unless ref($self);
    return grep($self->{CAF}->{Sequence}->{$_} =~ /Is_read\n/, keys(%{$self->{CAF}->{Sequence}}));
}

sub _warnError {
    my ($msg, $retval) = @_;
    print $msg;
    return $retval;
}

sub checkForMissingInfo {
    my ($self) = @_;
    my $mustHaveBaseQuality = 1;
    my $errorCount = 0;
    my $key = 0;
    $self->test_header("Checking CAF data for missing entries");
    foreach $key (keys %{$self->{CAF}->{DNA}}) {
	unless ($mustHaveBaseQuality && $self->{CAF}->{BaseQuality}->{$key}) {            
	    $errorCount += &_warnError("DNA entry $key has no corresponding base quality entry\n", 1);
	}
	unless ($self->{CAF}->{Sequence}->{$key}) {
	    $errorCount += &_warnError("DNA entry $key has no corresponding sequence entry\n", 1);
	}
    }
    foreach $key (keys %{$self->{CAF}->{BaseQuality}}) {
	unless ($self->{CAF}->{DNA}->{$key}) {
	    $errorCount += &_warnError("BaseQuality entry $key has no corresponding DNA entry\n", 1);
	}
	unless ($self->{CAF}->{Sequence}->{$key}) {
	    $errorCount += &_warnError("BaseQuality entry $key has no corresponding sequence entry\n", 1);
	}
    }
    foreach $key (keys %{$self->{CAF}->{Sequence}}) {
	unless ($self->{CAF}->{DNA}->{$key}) {
	    $errorCount += &_warnError("Sequence entry $key has no corresponding DNA entry\n", 1);
	}
	unless ($mustHaveBaseQuality && $self->{CAF}->{BaseQuality}->{$key}) {
	    $errorCount += &_warnError("Sequence entry $key has no corresponding base quality entry\n", 1);
	}
    }
    
   (!$errorCount) ? $self->test_result(1) : $self->test_result(0);
}

sub checkRawSequences {
    # Checks Sequence entries for raw reads
    my ($self) = @_;
    $self->test_header("Checking raw sequence entries for missing information");
    my $key;
    my $errorCount;
    foreach $key ($self->readsList()) {
	if ($self->checkRawSequence($key)) { $errorCount++; }
    }
    (!$errorCount) ? $self->test_result(1) : $self->test_result(0);
}

sub checkRawSequence {
    my ($self, $name) = @_;
    my $entry = $self->{CAF}->{Sequence}->{$name};
    my $retVal = 0;
    unless ($entry =~ /Is_read/) { $retVal += &_warnError("$name is not a read\n", 1); }
    unless ($entry =~ /Template/) { $retVal += &_warnError("$name does not have a template entry\n", 1); }
    unless ($entry =~ /Insert_size/) { $retVal += &_warnError("$name does not have an insert size entry\n", 1); }
    unless ($entry =~ /Primer/) { $retVal += &_warnError("$name does not have a primer entry\n", 1); }
    unless ($entry =~ /Strand/) { $retVal += &_warnError("$name does not have a strand entry\n", 1); }
    unless ($entry =~ /Dye/) { $retVal += &_warnError("$name does not have a dye entry\n",  1); }
    return $retVal;
}

#
# Check for nulls within structures.
#
sub check_null {
    my($self) = @_;
    $self->test_header("Checking caf file for NULL's");
    foreach my $type (keys %{$self->{CAF}}) {
	foreach my $key (keys %{$self->{CAF}->{$type}}) {
	    my $entry = $self->{CAF}->{$type}->{$key};	
	    if($entry =~ /\000/g) {
		print "Null(s) located within data for $key ($type).\n";
                $self->test_result(0);
                return;
	    }
	}
    }
    $self->test_result(1); 
}


#
# Ensure sequence length matches basequality length.
#
sub check_seq_quality_length {
    my ($self) = @_;    
    $self->test_header("Checking seq length matches basequality length");
    foreach my $rd ($self->readsList()) {
	my $dna = length($self->{CAF}->{DNA}->{$rd});
	my $qual = (split/ /,$self->{CAF}->{BaseQuality}->{$rd});
	if($dna != $qual) {
	    print "Sequence length and basequality differ for entry $rd (seq: $dna | qual: $qual).\n";
            $self->test_result(0);
            return;
	}
    }
    $self->test_result(1);   
}


sub print_test_results {
    my ($self) = @_;

    if($self->{pass} != $self->{test}) {
        printf STDERR ("%s\n-*- %s: -*-\n%s out of %s tests passed\n%s\n\n\n",
               '#'x35,$self->{program},$self->{pass},$self->{test},'#'x35);
    }else{
        printf STDERR ("%s\n-*- %s: -*-\nAll tests passed\n%s\n\n\n",'#'x35,$self->{program},'#'x35);
    }
}


sub run_installed {
    my($self,$args) = @_;  

    $self->test_header("Installed program output");

    if(system("$self->{installed_dir}/$self->{program} $args")) {
        print "Error: Failure in system call. ($self->{installed_dir}/$self->{program} $args).$!\n";
        $self->test_result(0);
        die;
    }
    $self->test_result(1);

}

sub run_tested {
    my($self,$args) = @_; 

    $self->test_header("Test program output");
    
    if(system("$self->{test_src_dir}/$self->{program} $args")) {        
        print "Error: Failure in system call. ($self->{test_src_dir}/$self->{program} $args).$!\n";
        $self->test_result(0);
        die;
    }

    $self->test_result(1);
}

sub test_header {
    my($self,$string) = @_;
    my $len = length($string) - 3;    
    printf(STDERR "Test %d: %s %s ",++$self->{ontest},$string,"."x(50-$len));
}


sub test_result {
    my($self,$result) = @_;
    if($result==1) {
        ++$self->{pass};
        print STDERR "Pass\n";
    }else{            
        ++$self->{fail};
        print STDERR "Fail\n";
    }
}


sub open_test_log {
    my ($self) = @_;

    unless(open(LOG,">error_log")) {
        warn "Unable to open error log.$!\n";
        return \*STDERR;
    }
    select((select(LOG), $|=1)[0]);
    return \*LOG;
}

sub compare_output {
    my($self,$insthash,$testhash,$str) = @_;

    $self->test_header($str);
    my $rows = 0;
    my $found = 0;
    foreach my $key (keys %$insthash) {
        ++$rows;
        if(exists $$testhash{$key}) {
            ++$found;
        }
    }
    if($rows != $found) {
        print "Row mismatch! Installed contains $rows rows, test version contains $found rows.\n";
        $self->test_result(0);
        return;
    }    
    $self->test_result(1);
}


sub read_template_output {
    my($self,$hashref,$file,$str) = @_;

    $self->test_header($str);
    
    unless(open(F,"$file")) {        
        print "Unable to open file $file for reading.$!\n";
        $self->test_result(0);   
    }
    while(defined(my $line = <F>)) {
        chomp($line);        
        # new version has an extra column, we'll ignore that .
        ($line) = $line =~ /^(.*\d+\s+\d+\s+\d+\s+\d+\s+\S+\s+\S+)/;                
        $$hashref{$line}++;    
    }
    close(F);
    $self->test_result(1);
}


sub read_standard_output {
    my($self) = @_;

    $self->test_header('Reading standard output file');       
    my $selfref = (ref($self))->new();    
    my $fc = $selfref->readCafFile("../test_data/$self->{program}.caf");
    (!$fc) ? $self->test_result(1) : $self->test_result(0);
    return $selfref;

}

sub compare_against_caf {
    my($self,$stdcaf) = @_;
    
    $self->test_header('Comparing test output');        
    my $fc;
    foreach my $class ('DNALen','BaseQualityLen','Sequence') {
        foreach my $item ($self->readsList(), $self->contigsList()) {
            if($class eq 'DNALen' || $class eq 'BaseQualityLen') {
                if($self->{CAF}->{$class}->{$item} != $stdcaf->{CAF}->{$class}->{$item}) {
                    print "test $class -> $item = $self->{CAF}->{$class}->{$item} : standard $class -> $item = $stdcaf->{CAF}->{$class}->{$item}\n";
                    ++$fc;
                }
            }else{
                if($self->{CAF}->{$class}->{$item} ne $stdcaf->{CAF}->{$class}->{$item}) {
                    print "sequence class difference for $item. \n$self->{CAF}->{$class}->{$item} ne $stdcaf->{CAF}->{$class}->{$item}";
                    ++$fc;
                }   
            }
        }   
    }
    
    (!$fc) ? $self->test_result(1) : $self->test_result(0);
}

sub compare_fasta {
    my($self) = @_;
    $self->test_header('Comparing fasta output');       

    if($self->read_and_return_string("../test_data/$self->{program}.fasta")
       ne $self->read_and_return_string("./c2ptest")){
        print "Output from test_data/$self->{program} does not match output in file c2ptest\n";
        $self->test_result(0);
        return;
    }

    $self->test_result(1);
}

sub compare_qual {
    my($self) = @_;
    $self->test_header('Comparing quality output'); 
    if($self->read_and_return_string("../test_data/$self->{program}.qual")
       ne $self->read_and_return_string("./c2ptest.qual")){
        print "Output from test_data/$self->{program} does not match output in file c2ptest\n";
        $self->test_result(0);
        return;
    }

    $self->test_result(1);
}

sub read_and_return_string {
    my($self,$file) = @_;

    local $/ = undef;

    open(FILE,"$file") or return $file;
    my $retstr = <FILE>;
    $retstr =~ s/[\n|\s+]//g;
    close(FILE);
    return $retstr;       
}


1;