view release on metacpan or  search on metacpan

lib/Bio/Perl.pm  view on Meta::CPAN

    my $factory = Bio::Tools::Run::RemoteBlast->new(@params);

    my $r = $factory->submit_blast($seq);
    if( $verbose ) {
        print STDERR "Submitted Blast for [".$seq->id."] ";
    }
    sleep 5;

    my $result;

    LOOP :
    while( my @rids = $factory->each_rid) {
        foreach my $rid ( @rids ) {
            my $rc = $factory->retrieve_blast($rid);
            if( !ref($rc) ) {
                if( $rc < 0 ) {
                    $factory->remove_rid($rid);
                }
                if( $verbose ) {
                    print STDERR ".";
                }
                sleep 10;
            } else {
                $result = $rc->next_result();
                $factory->remove_rid($rid);
                last LOOP;
            }
        }
    }

    if( $verbose ) {
        print STDERR "\n";
    }
    return $result;
}


sub write_blast {
    my ($filename,$blast) = @_;

    if( $filename !~ /^\>/ && $filename !~ /^|/ ) {
        $filename = ">".$filename;
    }

    my $output = Bio::SearchIO->new( -output_format => 'blast', -file => $filename);

    $output->write_result($blast);

}


my $genbank_db = undef;
my $genpept_db = undef;
my $embl_db = undef;
my $swiss_db = undef;
my $refseq_db = undef;

sub get_sequence{
    my ($db_type,$identifier) = @_;
    if( ! $DBOKAY ) {
        confess ("Your system does not have one of LWP, HTTP::Request::Common, IO::String\n".
                 "installed so the DB retrieval method is not available.\n".
                 "Full error message is:\n $!\n");
        return;
    }
    $db_type = lc($db_type);

    my $db;

    if( $db_type =~ /genbank/ ) {
        if( !defined $genbank_db ) {
            $genbank_db = Bio::DB::GenBank->new();
        }
        $db = $genbank_db;
    }
    if( $db_type =~ /genpept/ ) {
        if( !defined $genpept_db ) {
            $genpept_db = Bio::DB::GenPept->new();
        }
        $db = $genpept_db;
    }

    if( $db_type =~ /swiss/ ) {
        if( !defined $swiss_db ) {
            $swiss_db = Bio::DB::SwissProt->new();
        }
        $db = $swiss_db;
    }

    if( $db_type =~ /embl/ ) {
        if( !defined $embl_db ) {
            $embl_db = Bio::DB::EMBL->new();
        }
        $db = $embl_db;
    }

    if( $db_type =~ /refseq/ or ($db_type !~ /swiss/ and
                                 $identifier =~ /^\s*N\S+_/)) {
        if( !defined $refseq_db ) {
            $refseq_db = Bio::DB::RefSeq->new();
        }
        $db = $refseq_db;
    }

    my $seq;

    if( $identifier =~ /^\w+\d+$/ ) {
        $seq = $db->get_Seq_by_acc($identifier);
    } else {
        $seq = $db->get_Seq_by_id($identifier);
    }

    return $seq;
}



sub translate {
    my ($scalar) = shift;

    my $obj;