view release on metacpan or  search on metacpan

Bio/SearchIO/psl.pm  view on Meta::CPAN

sub _initialize {
    my ( $self, @args ) = @_;
    $self->SUPER::_initialize(@args);
    my ($pname) = $self->_rearrange( [qw(PROGRAM_NAME)], @args );
    $self->program_name( $pname || $DefaultProgramName );
    $self->_eventHandler->register_factory(
        'result',
        Bio::Search::Result::ResultFactory->new(
            -type => 'Bio::Search::Result::GenericResult'
        )
    );

    $self->_eventHandler->register_factory(
        'hit',
        Bio::Search::Hit::HitFactory->new(
            -type => 'Bio::Search::Hit::GenericHit'
        )
    );
    $self->_eventHandler->register_factory(
        'hsp',
        Bio::Search::HSP::HSPFactory->new(
            -type => 'Bio::Search::HSP::PSLHSP'
        )
    );
}

=head2 next_result

 Title   : next_result
 Usage   : my $result = $parser->next_result
 Function: Parse the next result from the data stream
 Returns : L<Bio::Search::Result::ResultI> or undef if no more results
 Args    : none

=cut

sub next_result {
    my ($self) = @_;
    my ( $lastquery, $lasthit );
    local $/ = "\n";
    local $_;

    # skip over any header lines
    while( defined($_ = $self->_readline) and ! /^\d+\s+\d+\s+/ ) {}
    $self->_pushback($_);

    # now start the main parsing loop
    while ( defined( $_ = $self->_readline ) ) {
        my (
            $matches,      $mismatches,    $rep_matches,  $n_count,
            $q_num_insert, $q_base_insert, $t_num_insert, $t_base_insert,
            $strand,       $q_name,        $q_length,     $q_start,
            $q_end,        $t_name,        $t_length,     $t_start,
            $t_end,        $block_count,   $block_sizes,  $q_starts,
            $t_starts
        ) = split;

        $q_length > 0 or $self->throw("parse error, invalid query length '$q_length'");
        my $score = sprintf( "%.2f",  100 * ( $matches + $mismatches + $rep_matches ) / $q_length );

        # this is overall percent identity...
        my $match_total  = $matches + $mismatches + $rep_matches;
        $match_total > 0
            or $self->throw("parse error, matches + mismatches + rep_matches must be > 0!");
        my $percent_id = sprintf("%.2f", 100 * ( $matches + $rep_matches ) / $match_total );

        # Remember Jim's code is 0 based
        if ( defined $lastquery
            && $lastquery ne $q_name )
        {
            $self->end_element( { 'Name' => 'Hit' } );
            $self->end_element( { 'Name' => 'PSLOutput' } );
            $self->_pushback($_);
            return $self->end_document;
        }
        elsif ( !defined $lastquery ) {
            $self->{'_result_count'}++;
            $self->start_element( { 'Name' => 'PSLOutput' } );
            $self->element(
                {
                    'Name' => 'PSLOutput_program',
                    'Data' => $self->program_name
                }
            );
            $self->element(
                {
                    'Name' => 'PSLOutput_query-def',
                    'Data' => $q_name
                }
            );
            $self->element(
                {
                    'Name' => 'PSLOutput_query-len',
                    'Data' => $q_length
                }
            );
            $self->start_element( { 'Name' => 'Hit' } );
            $self->element(
                {
                    'Name' => 'Hit_id',
                    'Data' => $t_name
                }
            );
            $self->element(
                {
                    'Name' => 'Hit_len',
                    'Data' => $t_length
                }
            );
            $self->element(
                {
                    'Name' => 'Hit_score',
                    'Data' => $score
                }
            );
        }
        elsif ( $lasthit ne $t_name ) {
            $self->end_element( { 'Name' => 'Hit' } );
            $self->start_element( { 'Name' => 'Hit' } );
            $self->element(
                {
                    'Name' => 'Hit_id',
                    'Data' => $t_name
                }
            );