File Coverage

blib/lib/BLASTaid.pm

Criterion	Covered	Total	%
statement	81	135	60.0
branch	25	58	43.1
condition	2	9	22.2
subroutine	12	14	85.7
pod	5	5	100.0
total	125	221	56.5

package BLASTaid;

# | PACKAGE | BLASTaid
# | AUTHOR  | Todd Wylie
# | EMAIL   | [e-mail]
# | ID      | $Id: BLASTaid.pm 20 2006-03-15 21:28:53Z Todd Wylie $

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


# --------------------------------------------------------------------------
# N E W  (class CONSTRUCTOR)
# ==========================================================================
# USAGE      : BLASTaid->new();
# PURPOSE    : Constructor for class.
# RETURNS    : Object handle.
# PARAMETERS : report       => ''
#            : index        => ''
# THROWS     : croaks if arguments are missing or report file is suspect
# COMMENTS   : Feed the interface a WU-BLAST report path and also the
#            : path/name where you want the index file saved. If the index
#            : file specified already exists, use it.
# --------------------------------------------------------------------------
sub new {
    my ($class, %arg) = @_;

    # Do some simple file validation checks.
    if (!$arg{report}   ) { croak "new requires a REPORT value"                }
    if (!-f $arg{report}) { croak "report [$arg{report}] does not exist"       }
    if (!-T $arg{report}) { croak "report [$arg{report}] is not a text report" }

    # Deal with the index file initialization.
    if (!$arg{index}) { croak "new requires a INDEX value" }

    # Class setup.
    my $self  = {
        _report  => $arg{report},
        _index   => $arg{index},
        _ignored => [],
    };
    bless($self, $class);

    # If the supplied index already exists then use it. Else, build
    # the index file. Populate the object with the index regardless.
    if (-f $self->{_index}) {
        $self->_load_index_file();
    }
    else {
        $self->_build_index();
    }

    return($self);
}


# --------------------------------------------------------------------------
# E A C H  R E P O R T  (accessor method)
# ==========================================================================
# USAGE      : BLASTaid->each_report( ignore => 'yes' );
# PURPOSE    : Accessor method, iterator for object.
# RETURNS    : Query names.
# PARAMETERS : ignore => ''
# THROWS     : croaks if no query names are in object
# COMMENTS   : If ignore = yes, reports with no alignments are skipped.
# --------------------------------------------------------------------------
sub each_report {
    my ($class, %arg)  = @_;

    # Must have a valid ignore clause:
    if (!defined $arg{ignore}) { croak "each_report requires a IGNORE value" }

    # Iterate through the record index returning associated query
    # name:
    my @queries;
    foreach my $id ( sort {$a <=> $b} keys %{$class->{_id}} ) {
        unless ( $class->{_id}->{$id}->{_name} eq "END-OF-FILE" ) {
            unless ( $arg{ignore} eq "yes" ) {
                push( @queries, $class->{_id}->{$id}->{_name} );
            }
            else {
                if ($class->{_id}->{$id}->{_alignments} eq "TRUE") {
                    push( @queries, $class->{_id}->{$id}->{_name} );
                }
                else {
                    push( @{$class->{_ignored}}, $class->{_id}->{$id}->{_name} );
                }
            }
        }
    }
    if (@queries < 1) { croak "no queries found in object" }

    return(@queries);
}


# --------------------------------------------------------------------------
# R E T U R N  R E P O R T  (accessor method)
# ==========================================================================
# USAGE      : BLASTaid->return_report( query => 'contig1.0' );
# PURPOSE    : Accessor method for returning a report,
# RETURNS    : String of BLAST report content.
# PARAMETERS : query => ''
# THROWS     : croaks if no query argument is indicated
#            : croaks if report string is null
#            : croaks if a record is partial (no EXIT CODE)
# --------------------------------------------------------------------------
sub return_report {
    my ($class, %arg) = @_;

    # Must have a query name to continue.
    if (!defined $arg{query} || $arg{query} eq ""          ) { croak "return_report must have a QUERY argument"           }
    if (!defined $class->{_queries}->{_name}->{$arg{query}}) { croak "return_report cannot locate $arg{query} in object"  }

    # Seek ahead to the entry and grab the report's text.
    my $pass = "false";
    my $REPORT = new IO::File;
    $REPORT->open( "$class->{_report}" ) or croak "could not open file $class->{_report}";
    $REPORT->seek( $class->{_queries}->{_name}->{$arg{query}}->{_start}, 0 );
    my $string;
    my $seeking = <$REPORT>;
    $string     = $seeking;
  SEEKENTRY:
    while (<$REPORT>) {
        if ($_ =~ /EXIT CODE (\d+)/) { $pass = "true" };
        last SEEKENTRY if ($_ =~ /^BLAST/);
        $string .= $_;
    }
    $REPORT->close;

    # Error checking.
    if ($string eq ""  ) { croak "return_report has null return for $arg{query}" };
    if ($pass ne "true") { croak "$arg{query} is a partial report"               };

    return($string);
}


# --------------------------------------------------------------------------
# B U I L D  I N D E X  (internal method)
# ==========================================================================
# USAGE      : BLASTaid->_build_index();
# PURPOSE    : Builds & saves the index file for byte positions.
# RETURNS    : none
# PARAMETERS : none
# THROWS     : croaks if BLAST report cannot be opened
#            : croaks if object entries are not complete
# --------------------------------------------------------------------------
sub _build_index {
    my $class = shift;

    # Open the specified BLAST report and index it.
    my $id;
    my $REPORT = new IO::File;
    $REPORT->open( "$class->{_report}" ) or croak "could not open file $class->{_report}";
    while (<$REPORT>) {
        if (/^(BLAST\S+)\s+/) {
            $id++;
            $class->{_id}->{$id}->{_start}      = $REPORT->tell - length($_);
            $class->{_id}->{$id}->{_alignments} = "TRUE";
            $class->{_id}->{$id}->{_type}       = $1;
        }
        elsif (/^Query\=\s+(\S+)/) {
            $class->{_id}->{$id}->{_name} = $1;
        }
        elsif (/\s*.+NONE.+\s*/) {
            # No alignments:
            $class->{_id}->{$id}->{_alignments} = "FALSE";
        }
        elsif ($REPORT->eof) {
            $id++;
            $class->{_id}->{$id}->{_start}      = $REPORT->tell - length($_);
            $class->{_id}->{$id}->{_name}       = "END-OF-FILE";
            $class->{_id}->{$id}->{_alignments} = "FALSE";
            $class->{_id}->{$id}->{_type}       = "N/A";
        }
    }
    $REPORT->close;

    # Make sure that all entries have needed values. Revise the object
    # to support the query names as unique keys.
    foreach my $report (sort {$a <=> $b} keys %{$class->{_id}}) {
        if (
            !defined $class->{_id}->{$report}->{_name} ||
            !defined $class->{_id}->{$report}->{_start}
            ) {
            croak "missing QUERY NAME or START for entry $report";
        }
        else {
            $class->{_queries}->{_name}->{ $class->{_id}->{$report}->{_name} } = {
                _start      => $class->{_id}->{$report}->{_start},
                _alignments => $class->{_id}->{$report}->{_alignments},
                _type       => $class->{_id}->{$report}->{_type},
            };
        }
    }

    # Save the object to an index file.
    $class->_save_index_file();

    return($class);
}


# --------------------------------------------------------------------------
# S A V E  I N D E X  F I L E  (internal method)
# ==========================================================================
# USAGE      : BLASTaid->_save_index_file();
# PURPOSE    : Saves the object to an index byte file.
# RETURNS    : none
# PARAMETERS : none
# THROWS     : croaks if index file cannot be saved
# --------------------------------------------------------------------------
sub _save_index_file {
    my $class = shift;

    # Save the object to a file.
    my $OUT = new IO::File;
    $OUT->open( ">$class->{_index}" ) or croak "could not write file $class->{_index}";
    foreach my $report (sort {$a <=> $b} keys %{$class->{_id}}) {
        my $line = sprintf "%-15s %-15s %-15s %-15s $class->{_id}->{$report}->{_name}", $report, $class->{_id}->{$report}->{_start}, $class->{_id}->{$report}->{_alignments}, $class->{_id}->{$report}->{_type};
        $OUT->print("$line\n");
    }
    $OUT->close;

    return($class);
}


# --------------------------------------------------------------------------
# L O A D  I N D E X  F I L E  (internal method)
# ==========================================================================
# USAGE      : BLASTaid->_load_index_file();
# PURPOSE    : Populates an object from a saved index file.
# RETURNS    : none
# PARAMETERS : none
# THROWS     : croaks if index file cannot be opened
#            : croaks if object entries are not complete
#            : croaks if the first entry is not byte position 0
# --------------------------------------------------------------------------
sub _load_index_file {
    my $class = shift;

    # Load object from a file.
    my $IN = new IO::File;
    $IN->open( "$class->{_index}" ) or croak "could not open file $class->{_index}";
    while(<$IN>) {
        chomp;
        my ($report, $start, $alignments, $type, $name) = split(/\s+/, $_);
        $class->{_id}->{$report} = {
            _start      => $start,
            _name       => $name,
            _type       => $type,
            _alignments => $alignments,
        };
    }

    # Make sure that all entries have needed values. Revise the object
    # to support the query names as unique keys.
    if ($class->{_id}->{1}->{_start} != 0) { croak "check incoming INDEX format" }
    foreach my $report (sort {$a <=> $b} keys %{$class->{_id}}) {
        if (
            !defined $class->{_id}->{$report}->{_name}  ||
            !defined $class->{_id}->{$report}->{_start} ||
            !defined $class->{_id}->{$report}->{_type}
            ) {
            croak "missing QUERY NAME or START or TYPE for entry $report";
        }
        else {
            $class->{_queries}->{_name}->{ $class->{_id}->{$report}->{_name} } = {
                _start      => $class->{_id}->{$report}->{_start},
                _alignments => $class->{_id}->{$report}->{_alignments},
                _type       => $class->{_id}->{$report}->{_type},
            };
        }
    }

    return($class);
}


# --------------------------------------------------------------------------
# T Y P E  (accessor method)
# ==========================================================================
# USAGE      : BLASTaid->type( report => '' )
# PURPOSE    : Returns the BLAST report type.
# RETURNS    : Scalar: BLAST type name.
# PARAMETERS : report => ''
# THROWS     : croaks if report attribute is missing
#            : croaks if type is null in the index onject
# --------------------------------------------------------------------------
sub type {
    my ( $class, %arg ) = @_;

    # Do some simple file validation checks.
    if ( !$arg{report} ) { croak "new requires a REPORT value" }

    # Validation & return:
    if (defined $class->{_queries}->{_name}->{$arg{report}}->{_type}) {
        return( $class->{_queries}->{_name}->{$arg{report}}->{_type} );
    }
    else {
        croak "type is null for report $arg{report}";
    }

}


# --------------------------------------------------------------------------
# U N D E F  (accessor method)
# ==========================================================================
# USAGE      : BLASTaid->undef();
# PURPOSE    : Deletes the object.
# RETURNS    : Scalar: BLAST type name.
# PARAMETERS : none
# THROWS     : none
# --------------------------------------------------------------------------
sub undef {
    my $class = shift;

    # Delete content from the object.
    undef(%{$class});

    return($class);
}

1;  # End of module.

__END__