# -*- perl -*-
# Copyright (C) 1996-2013 Nigel P. Brown
# $Id: tfasta.pm,v 1.12 2013/09/09 21:31:05 npb Exp $

###########################################################################
package NPB::Parse::Format::FASTA2::tfasta;

use NPB::Parse::Format::FASTA2;
use strict;

use vars qw(@ISA);

@ISA = qw(NPB::Parse::Format::FASTA2);

sub new { my $self=shift; $self->SUPER::new(@_) }


###########################################################################
package NPB::Parse::Format::FASTA2::tfasta::HEADER;

use vars qw(@ISA);

@ISA = qw(NPB::Parse::Format::FASTA2::HEADER);


###########################################################################
package NPB::Parse::Format::FASTA2::tfasta::RANK;

use vars qw(@ISA);

@ISA = qw(NPB::Parse::Format::FASTA::RANK);

sub new {
    my $type = shift;
    if (@_ < 2) {
	#at least two args, ($offset, $bytes are optional).
	NPB::Message::die($type, "new() invalid arguments (@_)");
    }
    my ($parent, $text, $offset, $bytes) = (@_, -1, -1);
    my ($self, $line, $record);
    
    $self = new NPB::Parse::Record($type, $parent, $text, $offset, $bytes);
    $text = new NPB::Parse::Record_Stream($self);

    #ranked search hits
    while (defined ($line = $text->next_line)) {
	
	next    if $line =~ /$NPB::Parse::Format::FASTA2::RANK_START/o;

	if($line =~ /^
	   \s*
	   ([^\s]+)                #id
	   \s+
	   (.*)                    #description
	   \s+
	   \((\S)\)                #frame
	   \s+
	   (\d+)                   #initn 
	   \s+
	   (\d+)                   #init1
	   \s+
	   (\d+)                   #opt
	   \s+
	   (\S+)                   #z-score
	   \s+
	   (\S+)                   #E(58765)
	   \s*
	   $/xo) {
	    
	    $self->test_args($line, $1,$2,$3,$4,$5,$6,$7,$8);
	    
	    push(@{$self->{'hit'}},
		 { 
		  'id'     => NPB::Parse::Record::clean_identifier($1),
		  'desc'   => $2,
		  'frame'  => NPB::Parse::Format::FASTA::parse_frame($3),
		  'orient' => NPB::Parse::Format::FASTA::parse_orient($3),
		  'initn'  => $4,
		  'init1'  => $5,
		  'opt'    => $6,
		  'zscore' => $7,
		  'expect' => $8,
		 });
	    next;
	}
    
	#blank line or empty record: ignore
	next    if $line =~ /$NPB::Parse::Format::FASTA2::NULL/o;
	
	#default
	$self->warn("unknown field: $line");
    }
    $self;
}


###########################################################################
package NPB::Parse::Format::FASTA2::tfasta::TRAILER;

use vars qw(@ISA);

@ISA = qw(NPB::Parse::Format::FASTA::TRAILER);


###########################################################################
package NPB::Parse::Format::FASTA2::tfasta::MATCH;

use vars qw(@ISA);

@ISA = qw(NPB::Parse::Format::FASTA::MATCH);


###########################################################################
package NPB::Parse::Format::FASTA2::tfasta::MATCH::SUM;

use vars qw(@ISA);
use NPB::Parse::Regexps;

@ISA = qw(NPB::Parse::Format::FASTA::MATCH::SUM);

sub new {
    my $type = shift;
    if (@_ < 2) {
	#at least two args, ($offset, $bytes are optional).
	NPB::Message::die($type, "new() invalid arguments (@_)");
    }
    my ($parent, $text, $offset, $bytes) = (@_, -1, -1);
    my ($self, $line, $record);
    
    $self = new NPB::Parse::Record($type, $parent, $text, $offset, $bytes);
    $text = new NPB::Parse::Record_Stream($self);

    $line = $text->next_line;
	
    if ($line =~ /^
	>*
	(\S+)                      #id
	\s+
	(.*)                       #description
	\s+
	\(\s*(\d+)\s*(?:aa|nt)\)   #length
	\s*
	$/xo) {

	$self->test_args($line, $1, $2, $3);

	(
	 $self->{'id'},
	 $self->{'desc'},
	 $self->{'length'},
	) = (NPB::Parse::Record::clean_identifier($1),
	     NPB::Parse::Record::strip_english_newlines($2), $3);
    } else {
	$self->warn("unknown field: $line");
    }

    $line = $text->next_line;
    
    if ($line =~ /^
	(?:Frame\:\s*(\S+))?   #frame
	\s*
	init1\:\s*(\S+)        #init1  REVERSE of fasta ordering WRONG!
	\s*
	initn\:\s*(\S+)        #initn  REVERSE of fasta ordering WRONG!
	\s*
	opt\:\s*(\S+)          #opt
	\s*
	z-score\:\s*(\S+)      #z
	\s*
	E\(\)\:\s*(\S+)        #E
	\s*
	$/xo) {

	$self->test_args($line,$2,$3,$4,$5,$6);

	(
	 $self->{'frame'},
	 $self->{'orient'},
	 $self->{'initn'},     #correct REVERSAL
	 $self->{'init1'},     #correct REVERSAL
	 $self->{'opt'},
	 $self->{'zscore'},
	 $self->{'expect'},
	) = (
	    NPB::Parse::Format::FASTA::parse_frame($1),
	    NPB::Parse::Format::FASTA::parse_orient($1),
	    $2, $3, $4, $5, $6,
	);
    } else {
	$self->warn("unknown field: $line");
    }
    
    $line = $text->next_line;

    if ($line =~ /^
	(?:Smith-Waterman\s+score:\s*(\d+);)?    #sw score
	\s*($RX_Ureal)%                          #percent identity
	\s*identity\s+in\s+(\d+)                 #overlap length
	\s+(?:aa|nt)\s+overlap
	\s*
	$/xo) {

	$self->test_args($line,$2,$3);
	
	(
	 $self->{'score'},
	 $self->{'id_percent'},
	 $self->{'overlap'},
	) = (defined $1?$1:0,$2,$3);
    } else {
	$self->warn("unknown field: $line");
    }
    
    $self;
}


###########################################################################
package NPB::Parse::Format::FASTA2::tfasta::MATCH::ALN;

use vars qw(@ISA);

@ISA = qw(NPB::Parse::Format::FASTA2::MATCH::ALN);


###########################################################################
1;
