view release on metacpan or  search on metacpan

lib/Bio/Grep/Backend/Vmatch.pm  view on Meta::CPAN

    ( $fields->[$COL_LENGTH] ) = $fields->[$COL_LENGTH] =~ m{ (\d+) }xms;
    ( $fields->[$COL_POS] )    = $fields->[$COL_POS]    =~ m{ (\d+) }xms;
    ( $fields->[$COL_STRAND] ) = $fields->[$COL_STRAND] =~ m{ ([DP]) }xms;

    if ( $self->settings->showdesc_isset ) {

        # not numerical with showdesc on
        # don't worry about this unclean untainting, we don't use that
        # description in dangerous ways
        ( $fields->[$COL_ID] )    = $fields->[$COL_ID]    =~ m{ (.+) }xms;
        ( $fields->[$COL_QUERY] ) = $fields->[$COL_QUERY] =~ m{ (.+) }xms;
    }
    else {
        ( $fields->[$COL_ID] )    = $fields->[$COL_ID]    =~ m{ (\d+) }xms;
        ( $fields->[$COL_QUERY] ) = $fields->[$COL_QUERY] =~ m{ (\d+) }xms;
    }
    return;
}

sub _get_subsequence {
    my ( $self, $length, $id, $start ) = @_;
    my $command
        = $self->_cat_path_filename( $self->settings->execpath,
        'vsubseqselect' )
        . " -seq $length $id $start "
        . $self->_cat_path_filename( $self->settings->datapath,
        $self->settings->database );
    my $output = $self->_execute_command_and_return_output($command);

    if ( $ENV{BIOGREPDEBUG} ) {
        warn $command . "\n";
    }
    if ( $output =~ m{(\d+).*must\sbe\ssmaller\sthan\s (\d+)}xms ) {
        return $self->_get_subsequence( $length - ( $1 - $2 + 1 ), $id,
            $start );
    }
    my $stringio = IO::String->new($output);
    my $in       = Bio::SeqIO->new(
        '-fh'     => $stringio,
        '-format' => 'fasta'
    );
    return $in->next_seq();
}

sub get_sequences {
    my ( $self, $seqid ) = @_;
    my $s = $self->settings;
    $self->is_arrayref_of_size( $seqid, 1 );
    $self->_check_search_settings();
    my ( $tmp_fh, $tmpfile );

    my $seq_query = q{};

    if ( @{$seqid}[0] =~ m{\A \d+ \z}xms ) {
        ( $tmp_fh, $tmpfile )
            = tempfile( 'vseqselect_XXXXXXXXXXXXX', DIR => $s->tmppath );

        for my $sid ( @{$seqid} ) {
            print ${tmp_fh} $sid . " \n "
                or $self->_cannot_print($tmpfile);
        }
        close $tmp_fh;
        $seq_query = ' -seqnum ' . $tmpfile;
    }
    else {
        my $seq_desc = $self->is_sentence( @{$seqid}[0] );
        $seq_query = ' -matchdesc "' . $seq_desc . q{"};
    }

    my $command
        = $self->_cat_path_filename( $s->execpath, 'vseqselect' )
        . $seq_query . q{ }
        . $self->_cat_path_filename( $s->datapath, $s->database );

    if ( $ENV{BIOGREPDEBUG} ) {
        warn $command . "\n";
    }

    my $output = $self->_execute_command_and_return_output($command);
    if ( $CHILD_ERROR && $output !~ m{\A \> }xms ) {
        $self->throw(
            -class => 'Bio::Root::SystemException',
            -text  => 'vseqselect call failed. Cannot fetch sequences. '
                . "Command was:\n\t$command\n$output",
        );
    }
    my $stringio = IO::String->new($output);
    my $out      = Bio::SeqIO->new(
        '-fh'     => $stringio,
        '-format' => 'fasta'
    );
    return $out;
}

sub available_sort_modes {
    my ($self) = @_;
    return (
        $self->SUPER::available_sort_modes(),
        la  => 'ascending order of length',
        ld  => 'descending order of length',
        ia  => 'ascending order of first position',
        id  => 'descending order of first position',
        ja  => 'ascending order of second position',
        jd  => 'descending order of second position',
        ea  => 'ascending order of Evalue',
        ed  => 'descending order of Evalue',
        sa  => 'ascending order of score',
        sd  => 'descending order of score',
        ida => 'ascending order of identity',
        idd => 'descending order of identity'
    );
}
1;    # Magic true value required at end of module
__END__

=head1 NAME

Bio::Grep::Backend::Vmatch - Vmatch back-end  

=head1 SYNOPSIS