#! /usr/local/bin/perl
#
# Miscellaneous tools
#
# 21-Mar-1995 Created -- SD
# 28-Mar-1995 Fixed bug regarding tag line parsing -- SD
# 11-May-1995 Add on information about source clone -- SD
# 06-Oct-1995 Extract template, strands, and primer info -- SD
# 09-Oct-1995 Detecting tag strand seems paradoxical of type "b" -- SD
# 09-Oct-1995 Parsing of TC lines was a crock (repeat of 28-Mar-1995)-- SD
# 11-Oct-1995 Reverse Universal Primer is PR 2 not PR 1 -- SD
# 10-Jan-1996 Added CHemistry field interpretation -- SD
# 07-Mar-1996 AV (BaseQuality support) -- SD
# 03-Apr-1996 Renamed cafmisctools to avoid clashes - rmott
#
# $Log: cafmisctools.pl,v $
# Revision 1.16  2007/02/07  14:49:26  rmd
# Fixed 'Argument "" isn't numeric' warnings caused when reading experiment
# files that incorrectly have extra spaces at the start of AV lines.
#
# Revision 1.15  2006/08/29  09:10:50  jkb
# Updates to support Internal Trace Server. This involved switching from
# exptools.pl to Exptools.pm
#
# Revision 1.14  2002/02/14 09:59:47  mng
# Fixed TG parsing to check to see if clonename is defined. If it is
# then add that as the comment, if not use the comment in the exp file.
#
# Revision 1.13  1998/02/03  17:04:26  sd
# Use ReadTypes, not pattern, to determine terminator.
#
# Revision 1.12  1997/09/11  10:28:48  sd
# Added Sequencing_vector
#
# Revision 1.11  1997/04/24  15:00:19  dn1
# Added copyright
#
# Revision 1.10  1997/02/24  18:41:08  rmott
# fixed ligation tag from LI to LG
#
# Revision 1.9  1997/02/24  10:14:58  rmott
# bug
#
# Revision 1.8  1997/02/24  10:09:31  rmott
# added support for parsing insert_size and Ligation_no in readExp2Ace()
#
# Revision 1.7  1996/10/07  09:11:25  rmott
# ditto
#
# Revision 1.6  1996/10/07  08:59:06  rmott
# added ProcessStatus tagging
#
# Revision 1.5  1996/06/25  15:20:01  rmott
# *** empty log message ***
#
# Revision 1.4  1996/06/25  15:03:39  rmott
# pad-state set in readExp2Ace by looking for original numbering
#
# Revision 1.3  1996/06/25  13:32:49  sd
# Added Base_caller to caf, from BC entry in experiment file.
#
# Revision 1.2  1996/06/05  17:22:59  sd
# CAF std for BaseQuality values is 98 edited low, and 99 is edited high.
# Need to coerce gap's 100 for high.
#
#
#######################################################################
# 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.                      #
#######################################################################

#push(@INC,"$ENV{BADGER}/bin");
#unshift(@INC,split(/:/,"$ENV{'INC_PATH'}")) if exists($ENV{'INC_PATH'});

require "caftools.pl";
require ReadTypes;

use Exptools;


############################################################
# &cafAddTag($read,$type,$start,$end,$comment);
# Fold in gap tag information. Some tags have special meaning
# in CAF so handle these here.
#
############################################################



sub cafAddTag {
    local($read,$tagType,$tagStart,$tagEnd,$tagComment) = @_;

    if ($tagType eq "SVEC") {
	$Sequence{$read} .= "Seq_vec $tagType $tagStart $tagEnd \"$tagComment\"\n";
    } elsif ($tagType eq "CVEC") {
	$Sequence{$read} .= "Clone_vec $tagType $tagStart $tagEnd \"$tagComment\"\n";
    } elsif ($tagType eq "STOL") {
	if (defined $tagComment) {
	    $Sequence{$read} .= "Stolen \"$tagComment\"\n";
	} else {
	    $Sequence{$read} .= "Stolen\n";
	}
    } else {
	$Sequence{$read} .= "Tag $tagType $tagStart $tagEnd \"$tagComment\"\n";
    }

}


############################################################
# &readExp2Ace($read);
# Modifies ace structures with information from experiment file.
# Assumes you have read in experiment file using &readExpFile().
#
############################################################

sub readExp2Ace {			# 

    local($read, $exp) = @_;

    local($ln,$cs,$sl,$sr,$on,$sq,$tn,$pr,$dr,$ch,$cn,$av,$ps,$ql,$qr,$bc);
    local($tagNo,$tag,$tagType,$tagDir,$tagStart,$tagEnd,$tagComment);
    local($vector);
    local($pos,$len,$from,$to);
    local($sqlen);

    if (defined($sq = $exp->getEntry("SQ"))) {
	$sqlen = length($sq);
    } else {
	warn "No original sequence data for '$read'\n";
	return;
    }
    

    ############################################################
    # Trace
    ############################################################
    if (defined($ln = $exp->getEntry("LN"))) {
	chomp($ln);
	$Sequence{$read} .= "SCF_File $ln\n";
    }


    ############################################################
    # Template
    ############################################################
    if (defined($tn = $exp->getEntry("TN"))) {
	chomp($tn);
	$Sequence{$read} .= "Template $tn\n";
    }

    ############################################################
    # Insert Size
    ############################################################

    if ( defined($range = $exp->getEntry("SI") ) ) {
	if ( ($from,$to) = ( $range =~ /(\d+)\D+(\d+)/ ) ) {
	    $Sequence{$read} .= "Insert_size $from $to\n";
	}
    }

    ############################################################
    # Library
    ############################################################

    if ( defined($ligation = $exp->getEntry("LG") ) ) {
	chomp($ligation);
	$Sequence{$read} .= "Ligation_no $ligation\n";
    }
    
    ############################################################
    # Primer
    ############################################################
    if (defined($pr = $exp->getEntry("PR"))) {
	chomp($pr);
	if ($pr == 1 || $pr == 2) {
	    $Sequence{$read} .= "Primer Universal_primer\n";
	} else {
	    $Sequence{$read} .= "Primer Custom\n";
	}
    }

    ############################################################
    # Strand
    ############################################################
    if (defined($dr = $exp->getEntry("DR"))) {
	chomp($dr);
	if ($dr eq "+") {
	    $Sequence{$read} .= "Strand Forward\n";
	} else {
	    $Sequence{$read} .= "Strand Reverse\n";
	}
    }

    ############################################################
    # Dye
    ############################################################
    if (defined($ch = $exp->getEntry("CH"))) {
	chomp($ch);
    } else {
	my $rt = ReadTypes->new($read);
	$ch = ($rt->getItemInfo("dye") eq "terminator");
    }
    if ($ch == 1) {
	$Sequence{$read} .= "Dye Dye_terminator\n";
    } else {
	$Sequence{$read} .= "Dye Dye_primer\n";
    }



    ############################################################
    # Clone Name
    ############################################################
    if (defined($cn = $exp->getEntry("CN"))) {
	chomp($cn);
	# Add on information about source clone -- SD
	$Sequence{$read} .= "Clone $cn\n";
    }
    
    ############################################################
    # Tags
    ############################################################
    for (my $tag = $exp->getFirstEntry("TG");
	 defined($tag);
	 $tag = $exp->getNextEntry("TG")) {
	$tag =~ s/[\n\"]//g;

	# Eg of TG line:
	# TG ALUS + 123..456
	# TG      Alu found by hmmfs

	( $tagType, $tagDir, $tagStart, $tagEnd, $tagComment ) = $tag =~ /^(\S\S\S\S)\s+(\S)\s+(\d+)..(\d+)\s*(.*)$/;

	if ( $tagDir eq "-" ) { ($tagStart, $tagEnd) = ($tagEnd, $tagStart); }

	if (($tagType eq "STOL") && defined $cn) {
	    &cafAddTag($read,$tagType,$tagStart,$tagEnd,$cn);
	} else {
	    &cafAddTag($read,$tagType,$tagStart,$tagEnd,$tagComment);
	}
    }

    ############################################################
    # Cosmid Vector
    ############################################################
    if (defined($cs = $exp->getEntry("CS"))) {
	( $tagStart , $tagEnd ) = $cs =~ /(\d+)..(\d+)/;
	$vector = $exp->getEntry("CV"); chomp($vector);
	$Sequence{$read} .= "Clone_vec CVEC $tagStart $tagEnd $vector\n";
	# $Sequence{$read} .= "Vector $tagStart $tagEnd $vector\n";
    }


    ############################################################
    # Sequencing Vector -- LEFT END
    ############################################################
    if (defined($sl = $exp->getEntry("SL"))) {
	chomp($sl);
	if ($sl > 0) {
	    $vector = $exp->getEntry("SV"); chomp($vector);
	    $Sequence{$read} .= "Seq_vec SVEC 1 $sl $vector\n";
	    $Sequence{$read} .= "Sequencing_vector \"$vector\"\n";
	    # $Sequence{$read} .= "Vector 1 $sl $vector\n";
	}
    }

    ############################################################
    # Sequencing Vector -- RIGHT END
    ############################################################
    if (defined($sr = $exp->getEntry("SR"))) {
	chomp($sr);
	if ($sr <= $sqlen) {
	    $vector = $exp->getEntry("SV"); chomp($vector);
	    $Sequence{$read} .= "Seq_vec SVEC $sr $sqlen $vector\n";
	    # $Sequence{$read} .= "Vector $sr $sqlen $vector\n";
	}
    }

    ############################################################
    # Quality Clipping (PHRED)
    ############################################################

    if (defined($ql=$exp->getEntry("QL")) && defined($qr=$exp->getEntry("QR")))
    {
	chomp($qr);
	chomp($ql);
	$ql = 1 if ( $ql < 1 );
	$Sequence{$read} .= "Clipping QUAL $ql $qr\n";
    }

    ############################################################
    # Failures (Process Status)
    ############################################################

    if ( defined($ps=$exp->getEntry("PS")) ) 
    {
	chomp($ps);
	if ( ($ps =~ /Trace quality/i) ) {
	    $Sequence{$read}.= "ProcessStatus QUAL  \"$ps\"\n"; }
	elsif ( ($ps =~ /Matches/i) ) {
	    $Sequence{$read}.= "ProcessStatus CONT  \"$ps\"\n"; }
	elsif ( ($ps =~ /Completely cloning vector/i) ) {
	    $Sequence{$read}.= "ProcessStatus CVEC  \"$ps\"\n"; }
	elsif ( ($ps =~ /Completely sequencing vector/i) ) {
	    $Sequence{$read}.= "ProcessStatus SVEC  \"$ps\"\n"; }
	else {
	    $Sequence{$read}.= "ProcessStatus FAIL  \"$ps\"\n"; }
    }
    else
    {
	$Sequence{$read}.= "ProcessStatus PASS\n";
    }

    ############################################################
    # Date
    ############################################################


    if ( defined($dt=$exp->getEntry("DT")) )
    {
	chomp($dt);
	$Sequence{$read} .= "Asped $dt\n";
    }

    ############################################################
    # Original numbering and pad state
    ############################################################
    if (defined($on = $exp->getEntry("ON"))) {
	$pos = 1;
	$Sequence{$read} .= "Padded\n";
	foreach ( split(/\s+/,$on) ) {
	    if ($_ == 0) {
		$pos++;
	    } elsif( ($from,$to) = /^(\d+)\.\.(\d+)/) {
		$len = $to - $from + 1;
		$end = $pos + $len - 1;
		$Sequence{$read} .= "Align_to_SCF $pos $end $from $to\n";
		$pos += $len;
	    } else {
		$Sequence{$read} .= "Align_to_SCF $pos $pos $_ $_\n";
		$pos++;
	    }
	}
    } else {
	$Sequence{$read} .= "Unpadded\n";
	$Sequence{$read} .= "Align_to_SCF 1 $sqlen 1 $sqlen\n";
    }

    ############################################################
    # Base Quality
    ############################################################
    if (defined($av = $exp->getEntry("AV"))) {
	@tmp = split(" ",$av);
	grep( $_==100 ? $_=99 : 1 , @tmp);
	$BaseQuality{$read} = join " ", @tmp;
	undef(@tmp);
    }


    ############################################################
    # Base Caller
    ############################################################
    if (defined($bc = $exp->getEntry("BC"))) {
	chomp($bc);
	$Sequence{$read} .= "Base_caller $bc\n";
    }

}






############################################################
# &contigExp2Ace($read);
# Modifies ace structures with information from experiment file.
# Assumes you have read in experiment file using &readExpFile().
#
# Contig version (Save consensus tags option in Gap)
#
############################################################

sub contigExp2Ace {			# 

    local($read, $exp) = @_;

    local($tagNo,$tag,$tagType,$tagDir,$tagStart,$tagEnd,$tagComment);

    if (defined($sq = $exp->getEntry("SQ"))) {
	$sqlen = length($sq);
    } else {
	warn "No original sequence data for $read\n";
	return;
    }
    

    ############################################################
    # Tags
    ############################################################
    for (my $tag = $exp->getFirstEntry("TC");
	 defined($tag);
	 $tag = $exp->getNextEntry("TC")) {
	$tag =~ s/[\n\"]//g;
	( $tagType, $tagDir, $tagStart, $tagEnd, $tagComment ) = $tag =~ /(\S\S\S\S)\s+(\S)\s+(\d+)..(\d+)\s*(.*)$/;
	if ( $tagDir eq "-" ) { ($tagStart, $tagEnd) = ($tagEnd, $tagStart); }
	&cafAddTag($read,$tagType,$tagStart,$tagEnd,$tagComment);
    }

}



############# end of file ###############
# Local Variables:
# mode:perl
# End:
############# end of file ###############
