# -*-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.                      #
#######################################################################

# 
# $Id: Fasta.pm,v 1.11 1997/04/28 08:42:31 dn1 Exp $
#
# $Log: Fasta.pm,v $
# Revision 1.11  1997/04/28  08:42:31  dn1
# moved copyright
#
# Revision 1.10  1997/04/24  10:09:46  dn1
# Added copyright
#
# Revision 1.9  1996/09/05  17:16:01  sd
# Tolerate blank lines in fasta files.
#
# Revision 1.8  1996/07/08  15:51:28  rmott
# *** empty log message ***
#
# Revision 1.7  1996/07/08  15:42:35  rmott
# *** empty log message ***
#
# Revision 1.6  1996/07/08  15:40:19  rmott
# *** empty log message ***
#
# Revision 1.5  1996/07/08  15:39:11  rmott
# *** empty log message ***
#
# Revision 1.4  1996/07/08  15:35:48  rmott
# allow zero size files
# .
#
# Revision 1.3  1996/07/08  15:04:16  dmh
# I don't think I changed anything.....!
#
# Revision 1.2  1996/05/22  15:30:09  dmh
# Added getSubSeq method
#
# Revision 1.1  1996/05/22  13:34:07  dmh
# Initial revision
#
#
#
#

package Fasta;
use Carp;
use strict qw(vars);

##########################################
#
# Construct...
#
##########################################
sub new { 

    my $type=shift;

    my $self={};

    my %args = @_;
    my $realopt;
    my $fsize;
    foreach (keys%args) {
        ($realopt=$_)=~s/^\-//;
        $self->{$realopt} = $args{$_};
    }

    # Read file.
    unless (defined($self->{'filename'})  && ($fsize = (-e $self->{'filename'}) ) ) {
	warn "Fasta.pm: < $self->{filename} > < exists $fsize > filename must be supplied via \'-filename\'";
	return;
    }

    my $err = $type->readFastaFile($self);

    if ($err) {
	warn "Fasta.pm: Couldn't read file \"$self->{'filename'}\"\n";
	return;
    }

    bless $self, $type;

}


sub readFastaFile {  

    my ($type, $param_ref)=@_;

    unless(open(FASTA, $param_ref->{'filename'})) {
	warn $!;
	return 1;
    }

    my $seqname;  # Name of the current sequence.
    while (<FASTA>) {
	
	chomp;

	if(/^>(\S+)/) {
	    $seqname=$1;
	    $param_ref->{'seqs'}->{$seqname}=''; 
	} elsif (/^\S+$/) {
	    $param_ref->{'seqs'}->{$seqname} .= $_;
	} elsif (! /^\s*$/) {
	    warn "Fasta.pm: Unrecognised line in fasta file \"$param_ref->{'filename'}\": $_\n";
	}

    }
    close(FASTA);

    0;

}


##########################################
#
# Methods
#
##########################################

sub listSeqNames {

    my $this = shift;
    return (keys(%{$this->{'seqs'}}));
}


#
# returns 0 = OK, 1 = Error
#
sub changeName {

    my ($this, $oldname, $newname)=@_;

    if (defined($this->{'seqs'}->{$newname})) {
	return 1;
    }

    $this->{'seqs'}->{$newname} = $this->{'seqs'}->{$oldname};
    delete $this->{'seqs'}->{$oldname};

    0;

}

sub getSeq {

    my ($this, $seqname)=@_;
    return $this->{'seqs'}->{$seqname};

}


sub getFormattedSeq {

    my ($this, $seqname)=@_;

    my $seqlen = $this->getSeqLength($seqname);

    local $[=1;
    my $seq;
    my $i;

    for($i=1; $i<=$seqlen; $i++) {
	$seq .= substr($this->{'seqs'}->{$seqname}, $i, 1);
	if ($i % 60 == 0) {$seq .= "\n";}
    }

    return $seq;

}



sub getSubSeq {

    my ($this, $seqname, $index, $offset)=@_;
    return substr($this->{'seqs'}->{$seqname}, $index, $offset);


}

sub getSeqLength {

    my ($this, $seqname)=@_;
    return length($this->{'seqs'}->{$seqname});
    
}

sub getTotalSeqLength {

    my $this = shift;

    my $length=0;
    foreach ($this->listSeqNames) {
	$length += $this->getSeqLength($_);
    }

    return $length;

}

1;


