File Coverage

blib/lib/FASTAParse.pm

Criterion	Covered	Total	%
statement	120	130	92.3
branch	20	36	55.5
condition			n/a
subroutine	15	15	100.0
pod	10	10	100.0
total	165	191	86.3

package FASTAParse;

# | PACKAGE | FASTAParse
# | AUTHOR  | Todd Wylie
# | EMAIL   | [e-mail]

use version; $VERSION = qv('0.0.3');
use warnings;
use strict;
use Carp;
use IO::File;

# --------------------------------------------------------------------------
# N E W  (class CONSTRUCTOR)
# ==========================================================================
# USAGE      : FASTAParse->new();
# PURPOSE    : constructor for class
# RETURNS    : object handle
# PARAMETERS : none
# COMMENTS   : FASTA object.
# --------------------------------------------------------------------------
sub new {
    my $class = shift;

    my $self  = {
        _id          => '',
        _descriptors => [],
        _comments    => [],
        _sequence    => [],
    };

    bless($self, $class);
    return($self);
}


# --------------------------------------------------------------------------
# L O A D  F A S T A  (method)
# ==========================================================================
# USAGE      : FASTAParse->load_FASTA();
# PURPOSE    : loads a chunk of FASTA into the class
# RETURNS    : none
# PARAMETERS : fasta => ''
# THROWS     : croaks if no FASTA attribute or bad FASTA header
# COMMENTS   : The user sould be passing a chunk of text (scalar) to
#            : this method which represents 1 FASTA entry... from the
#            : > symbol to the end of the sequence; includes line
#            : returns.
# EXAMPLE    : Example format:
#            : >gi|55416189|gb|AAV50056.1| NADH dehydrogenase subunit 1 [Dasyurus hallucatus]
#            : ;Taken from nr GenBank
#            : MFTINLLIYIIPILLAVAFLTLIERKMLGYMQFRKGPNIVGPYGLLQPFADAVKLFTKEPLRPLTSSISIFIIAPILALT
#            : IALTIWTPLPMPNTLLDLNLGLIFILSLSGLSVYSILWSGWASNSKYALIGALRAVAQTISYEVSLAIILLSIMLINGSF
#            : TLKTLSITQENLWLIITTWPLAMMWYISTLAETNRAPFDLTEGESELVSGFNVEYAAGPFAMFFLAEYANIIAMNAITTI
#            : LFLGPSLTPNLSHLNTLSFMLKTLLLTMVFLWVRASYPRFRYDQLMHLLWKNFLPMTLAM
# --------------------------------------------------------------------------
sub load_FASTA {
    my ($class, %arg) = @_;

    # Check incoming FASTA format:
    if (!$arg{fasta})       { croak "load_FASTA needs FASTA attribute" }
    if ($arg{fasta} !~ />/) { croak "no FASTA header found for input"  }

    # Parse sequence and load the FASTA object:
    my @lines = split( /\n/, $arg{fasta} );
    foreach my $line (@lines) {
        if ($line =~ /^>\S+/) {
            # Header line:
            my ($id, $descriptions)   = $line =~ /^>(\S+)\s*(.*)/;
            $class->{_id}             = $id;
            if (defined$descriptions) {
                @{$class->{_descriptors}} = split( /\cA/, $descriptions );
            }
        }
        elsif ($line =~ /^;\s*(.+)/) {
            # Comment lines:
            push( @{$class->{_comments}}, $1 );
        }
        else {
            # Sequence lines:
            $line =~ s/\s+//g;
            unless( $line eq "" ) { push( @{$class->{_sequence}}, $line ) }
        }
    }
    return($class);
}


# --------------------------------------------------------------------------
# F O R M A T  F A S T A  (method)
# ==========================================================================
# USAGE      : $fasta->format_FASTA();
# PURPOSE    : Manually populate the FASTA class.
# RETURNS    : none
# PARAMETERS : id          => '' # REQUIRED
#            : sequnce     => '' # REQUIRED
#            : comments    => []
#            : descriptors => []
#            : cols        => ''
# COMMENTS   : A user may manually load a FASTA object. Only ID and SEQUENCE
#            : are required, all others are optional. The SEQUENCE attribute
#            : should be a flat, single line scalar value (i.e., a single
#            : string of sequence).
# --------------------------------------------------------------------------
sub format_FASTA {
    my ($class, %arg) = @_;

    # Format the incoming sequence. Sequence must be single line,
    # flatten sequence string. Check incoming FASTA format first:
    if (!$arg{sequence}) { croak "format_FASTA needs SEQUENCE attribute" }
    if (!$arg{id}      ) { croak "format_FASTA needs ID attribute"       }
    my $columns = defined $arg{cols} ? $arg{cols} : 60;  # Default is 60 cols.

    # If incoming sequence is multi-part, join them before breaking
    # into FASTA lines:
    delete( $class->{_sequence} );
    my $fasta  = join( "", $arg{sequence} );
    my $length = length( $fasta );
    my $pos    = 0;
    my $lines  = int( $length / $columns) + 1;
    for (my $i = 1; $i <= $lines; $i++) {
        my $line = substr( $fasta, $pos, $columns );
        push( @{$class->{_sequence}}, $line );
        $pos = $pos + $columns;
    }

    # Descriptions, comments, etc.
    $class->{_id} = $arg{id};
    if (defined @{$arg{comments}}) {
        @{$class->{_comments}} = @{$arg{comments}};
    }
    if (defined @{$arg{descriptors}}) {
        @{$class->{_descriptors}} = @{$arg{descriptors}};
    }

    return( $class );
}


# --------------------------------------------------------------------------
# D U M P  F A S T A  (method)
# ==========================================================================
# USAGE      : $fasta->dump_FASTA();
# PURPOSE    : Accessor to dump the FASTA class into text.
# RETURNS    : scalar (chunk of FASTA text)
# PARAMETERS : none
# --------------------------------------------------------------------------
sub dump_FASTA {
    my $class = shift;

    # Dump the class in scalar context:
    my $returnable;
    if (defined $class->{_id}) {
        my $descriptors = join( "\cA", @{$class->{_descriptors}} );  # ^A delimiter
        $returnable = ">$class->{_id} $descriptors\n";
        foreach my $comment ( @{$class->{_comments}} ) {
            $returnable .= ";$comment\n";
        }
        foreach my $sequence ( @{$class->{_sequence}} ) {
            $returnable .= "$sequence\n";
        }
    }
    else {
        croak "ID is missing from the object";
    }

    return( $returnable );
}


# --------------------------------------------------------------------------
# S A V E   F A S T A  (method)
# ==========================================================================
# USAGE      : $fasta->save_FASTA( save => '' );
# PURPOSE    : Accessor to save the FASTA entry to a file.
# RETURNS    : none
# PARAMETERS : save => ''
# --------------------------------------------------------------------------
sub save_FASTA {
    my ($class, %arg)  = @_;

    if (!$arg{save}) { croak "save_FASTA needs SAVE attribute" }

    # Save the class information to a file:
    my $save = new IO::File ">>$arg{save}" or croak "could not save to file $arg{save}";
    my $returnable;
    if (defined $class->{_id}) {
        my $descriptors = join( "\cA", @{$class->{_descriptors}} );  # ^A delimiter
        $returnable = ">$class->{_id} $descriptors\n";
        foreach my $comment ( @{$class->{_comments}} ) {
            $returnable .= ";$comment\n";
        }
        foreach my $sequence ( @{$class->{_sequence}} ) {
            $returnable .= "$sequence\n";
        }
    }
    else {
        croak "ID is missing from the object";
    }
    print $save "$returnable";

    return($class);
}


# --------------------------------------------------------------------------
# P R I N T  (method)
# ==========================================================================
# USAGE      : $fasta->print();
# PURPOSE    : Accessor to print the FASTA class to STDOUT.
# RETURNS    : none
# PARAMETERS : none
# --------------------------------------------------------------------------
sub print {
    my $class = shift;

    # Print the class to STDOUT:
    my $printable;
    if (defined $class->{_id}) {
        my $descriptors = join( "\cA", @{$class->{_descriptors}} );  # ^A delimiter
        $printable = ">$class->{_id} $descriptors\n";
        foreach my $comment ( @{$class->{_comments}} ) {
            $printable .= ";$comment\n";
        }
        foreach my $sequence ( @{$class->{_sequence}} ) {
            $printable .= "$sequence\n";
        }
        print $printable;
    }
    else {
        croak "ID is missing from the object";
    }

    return( $class );
}


# --------------------------------------------------------------------------
# I D  (method)
# ==========================================================================
# USAGE      : $fasta->id();
# PURPOSE    : Accessor to retrieve the FASTA ID.
# RETURNS    : scalar
# PARAMETERS : none
# --------------------------------------------------------------------------
sub id {
    my $class = shift;
    if (defined $class->{_id}) {
        return( $class->{_id} );
    }
    else {
        croak "ID does not exist in object";
    }
}


# --------------------------------------------------------------------------
# S E Q U E N C E  (method)
# ==========================================================================
# USAGE      : $fasta->sequence();
# PURPOSE    : Accessor to retrieve the FASTA sequence.
# RETURNS    : scalar
# PARAMETERS : none
# --------------------------------------------------------------------------
sub sequence {
    my $class = shift;
    if (defined $class->{_sequence} ) {
        my $sequence = join(  "", @{$class->{_sequence}} );
        return( $sequence );
    }
    else {
        croak "SEQUENCE does not exist in object";
    }
}


# --------------------------------------------------------------------------
# D E S C R I P T O R S  (method)
# ==========================================================================
# USAGE      : $fasta->descriptors();
# PURPOSE    : Accessor to retrieve the FASTA descriptors.
# RETURNS    : array reference
# PARAMETERS : none
# --------------------------------------------------------------------------
sub descriptors {
    my $class = shift;
    return( \@{$class->{_descriptors}} );
}


# --------------------------------------------------------------------------
# C O M M E N T S  (method)
# ==========================================================================
# USAGE      : $fasta->comments();
# PURPOSE    : Accessor to retrieve the FASTA comments.
# RETURNS    : array reference
# PARAMETERS : none
# --------------------------------------------------------------------------
sub comments {
    my $class = shift;
    return( \@{$class->{_comments}} );
}


1; # End of module.

__END__