Bio/Tools/Run/RemoteBlast.pm

   1 #
   2 # BioPerl module for Bio::Tools::Run::RemoteBlast
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # FORMERLY Cared for by Jason Stajich, Mat Wiepert
   7 #
   8 # Somewhat cared for by Roger Hall, Chris Fields (when they have time)
   9 #
  10 # Copyright Jason Stajich, Bioperl
  11 #
  12 # You may distribute this module under the same terms as perl itself
  13
  14 # POD documentation - main docs before the code
  15
  16 =head1 NAME
  17
  18 Bio::Tools::Run::RemoteBlast - Object for remote execution of the NCBI Blast
  19 via HTTP
  20
  21 =head1 SYNOPSIS
  22
  23   #Remote-blast "factory object" creation and blast-parameter initialization
  24
  25   use Bio::Tools::Run::RemoteBlast;
  26   use strict;
  27   my $prog = 'blastp';
  28   my $db   = 'swissprot';
  29   my $e_val= '1e-10';
  30
  31   my @params = ( '-prog' => $prog,
  32          '-data' => $db,
  33          '-expect' => $e_val,
  34          '-readmethod' => 'SearchIO' );
  35
  36   my $factory = Bio::Tools::Run::RemoteBlast->new(@params);
  37
  38   #change a query parameter
  39   $Bio::Tools::Run::RemoteBlast::HEADER{'ENTREZ_QUERY'} = 'Homo sapiens [ORGN]';
  40
  41   #change a retrieval parameter
  42   $Bio::Tools::Run::RemoteBlast::RETRIEVALHEADER{'DESCRIPTIONS'} = 1000;
  43
  44   #remove a parameter
  45   delete $Bio::Tools::Run::RemoteBlast::HEADER{'FILTER'};
  46
  47   #$v is just to turn on and off the messages
  48   my $v = 1;
  49
  50   my $str = Bio::SeqIO->new(-file=>'amino.fa' , -format => 'fasta' );
  51
  52   while (my $input = $str->next_seq()){
  53     #Blast a sequence against a database:
  54
  55     #Alternatively, you could  pass in a file with many
  56     #sequences rather than loop through sequence one at a time
  57     #Remove the loop starting 'while (my $input = $str->next_seq())'
  58     #and swap the two lines below for an example of that.
  59     my $r = $factory->submit_blast($input);
  60     #my $r = $factory->submit_blast('amino.fa');
  61
  62     print STDERR "waiting..." if( $v > 0 );
  63     while ( my @rids = $factory->each_rid ) {
  64       foreach my $rid ( @rids ) {
  65         my $rc = $factory->retrieve_blast($rid);
  66         if( !ref($rc) ) {
  67           if( $rc < 0 ) {
  68             $factory->remove_rid($rid);
  69           }
  70           print STDERR "." if ( $v > 0 );
  71           sleep 5;
  72         } else {
  73           my $result = $rc->next_result();
  74           #save the output
  75           my $filename = $result->query_name()."\.out";
  76           $factory->save_output($filename);
  77           $factory->remove_rid($rid);
  78           print "\nQuery Name: ", $result->query_name(), "\n";
  79           while ( my $hit = $result->next_hit ) {
  80             next unless ( $v > 0);
  81             print "\thit name is ", $hit->name, "\n";
  82             while( my $hsp = $hit->next_hsp ) {
  83               print "\t\tscore is ", $hsp->score, "\n";
  84             }
  85           }
  86         }
  87       }
  88     }
  89   }
  90
  91   # This example shows how to change a CGI parameter:
  92   $Bio::Tools::Run::RemoteBlast::HEADER{'MATRIX_NAME'} = 'BLOSUM45';
  93   $Bio::Tools::Run::RemoteBlast::HEADER{'GAPCOSTS'} = '15 2';
  94
  95   # And this is how to delete a CGI parameter:
  96   delete $Bio::Tools::Run::RemoteBlast::HEADER{'FILTER'};
  97
  98
  99 =head1 DESCRIPTION
 100
 101 Class for remote execution of the NCBI Blast via HTTP.
 102
 103 For a description of the many CGI parameters see:
 104 http://www.ncbi.nlm.nih.gov/BLAST/Doc/urlapi.html
 105
 106 Various additional options and input formats are available.
 107
 108 =head1 FEEDBACK
 109
 110 =head2 Mailing Lists
 111
 112 User feedback is an integral part of the evolution of this and other
 113 Bioperl modules. Send your comments and suggestions preferably to one
 114 of the Bioperl mailing lists.  Your participation is much appreciated.
 115
 116   bioperl-l@bioperl.org                  - General discussion
 117   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 118
 119 =head2 Support
 120
 121 Please direct usage questions or support issues to the mailing list:
 122
 123 I<bioperl-l@bioperl.org>
 124
 125 rather than to the module maintainer directly. Many experienced and
 126 reponsive experts will be able look at the problem and quickly
 127 address it. Please include a thorough description of the problem
 128 with code and data examples if at all possible.
 129
 130 =head2 Reporting Bugs
 131
 132 Report bugs to the Bioperl bug tracking system to help us keep track
 133 the bugs and their resolution.  Bug reports can be submitted via the
 134 web:
 135
 136   https://redmine.open-bio.org/projects/bioperl/
 137
 138 =head1 AUTHOR
 139
 140 Please do NOT contact Jason directly about this module.  Please post to
 141 the bioperl mailing list (L<FEEDBACK>). If you would like to be the
 142 official maintainer of this module, please volunteer on the list and
 143 we will make it official in this POD.
 144
 145 First written by Jason Stajich, many others have helped keep it running.
 146
 147 =head1 APPENDIX
 148
 149 The rest of the documentation details each of the object
 150 methods. Internal methods are usually preceded with a _
 151
 152 =cut
 153
 154 package Bio::Tools::Run::RemoteBlast;
 155
 156 use strict;
 157 use warnings;
 158
 159 use Bio::SeqIO;
 160 use IO::String;
 161 use Bio::SearchIO;
 162 use LWP;
 163 use HTTP::Request::Common;
 164
 165 use constant {
 166     NOT_FINISHED => 0,
 167     ERR_QBSTATUS => 1,
 168     ERR_NOCONTENT => 2,
 169     ERR_HTTPFAIL => 4,
 170     ERR_QBNONSPEC => 8
 171 };
 172
 173 # Bio::Root::IO is-a Bio::Root::Roo
 174 use base qw(Bio::Root::IO Exporter);
 175
 176 our @EXPORT = qw( NOT_FINISHED ERR_QBSTATUS ERR_NOCONTENT ERR_HTTPFAIL ERR_QBNONSPEC );
 177 our $MODVERSION = $Bio::Root::Version::VERSION;
 178 our $URLBASE = 'http://www.ncbi.nlm.nih.gov/blast/Blast.cgi';
 179
 180 # In GET/PUTPARAMS the values are regexes which validate the input.
 181 our %PUTPARAMS = (
 182     'AUTO_FORMAT'       => '(Off|(Semi|Full)auto)',     # Off, Semiauto, Fullauto
 183     'COMPOSITION_BASED_STATISTICS'      => '(0|1)',     # yes, no on NCBI's site, but actually binary 0/1
 184     'DATABASE'  =>  '.*',
 185     'DB_GENETIC_CODE' => '([1-9]|1[1-6]|2(1|2))',   # 1..16,21,22
 186     'DISPLAY_SORT'   => '\d',
 187     'ENDPOINTS' => '(yes|no)',                  # yes,no
 188     'ENTREZ_QUERY'      => '.*',
 189     'EXPECT'    => '\d+(\.\d+)?([eE]-\d+)?',    # Positive double
 190     'FILTER'    => '[LRm]',                     # L or R or m
 191     'GAPCOSTS'  => '-?\d+(\.\d+)\s+-?\d+(\.\d+)',
 192                                     # Two space separated float values
 193     'GENETIC_CODE'      => '([1-9]|1[1-6]|2(1|2))',     # 1..16,21,22
 194     'HITLIST_SIZE'      => '\d+',                       # Positive integer
 195     'I_THRESH'  => '-?\d+(\.\d+)([eE]-\d+)?',   # float
 196     'LAYOUT'    => '(One|Two)Windows?',         # onewindow, twowindows
 197     'LCASE_MASK'        => '(yes|no)',                  # yes, no
 198     'MATRIX_NAME'       => '.*',
 199     'NUCL_PENALTY'      => '-\d+',                      # Negative integer
 200     'NUCL_REWARD'       => '-?\d+',                     # Integer
 201     'OTHER_ADVANCED' => '.*',
 202     'PERC_IDENT'        => '\d\d+',                     # Integer, 0-99 inclusive
 203     'PHI_PATTERN'       => '.*',
 204     'PROGRAM'   => 't?blast[pnx]',
 205                                     # tblastp, tblastn, tblastx, blastp, blastn, blastx
 206     'QUERY'             => '.*',
 207     'QUERY_FILE'        => '.*',
 208     'QUERY_BELIEVE_DEFLINE'     => '(yes|no)',          # yes, no
 209     'QUERY_FROM'        => '\d+',                       # Positive integer
 210     'QUERY_TO'  => '\d+',                       # Positive integer
 211     'SEARCHSP_EFF'      => '\d+',                       # Positive integer
 212     'SERVICE'   => '(plain|p[sh]i|(rps|mega)blast)',
 213                                     # plain,psi,phi,rpsblast,megablast
 214     'SHORT_QUERY_ADJUST' => '(true|false)',
 215     'THRESHOLD' => '-?\d+',                     # Integer
 216     'UNGAPPED_ALIGNMENT' => '(yes|no)',         # yes, no
 217     'WORD_SIZE' => '\d+'                        # Positive integer
 218                                       );
 219 our %GETPARAMS = (
 220     'ALIGNMENTS'        => '\d+',                       # Positive integer
 221     'ALIGNMENT_VIEW' =>
 222               '(Pairwise|(Flat)?QueryAnchored(NoIdentities)?|Tabular)',
 223      # Pairwise, QueryAnchored, QueryAnchoredNoIdentities,
 224      # FlatQueryAnchored, FlatQueryAnchoredNoIdentities, Tabular
 225     'DATABASE_SORT' => '\d',
 226     'DESCRIPTIONS'      => '\d+',                       # Positive integer
 227     'ENTREZ_LINKS_NEW_WINDOW' => '(yes|no)',    # yes, no
 228     'EXPECT_LOW'        => '\d+(\.\d+)?([eE]-\d+)?',    # Positive double
 229     'EXPECT_HIGH'       => '\d+(\.\d+)?([eE]-\d+)?',    # Positive double
 230     'FORMAT_ENTREZ_QUERY' => '',
 231     'FORMAT_OBJECT'     =>
 232 '(Alignment|Neighbors|PSSM|SearchInfo|TaxBlast(Parent|MultiFrame)?)',
 233                                     # Alignment, Neighbors, PSSM,  SearchInfo
 234                                     # TaxBlast, TaxblastParent, TaxBlastMultiFrame
 235     'FORMAT_TYPE'       => '((HT|X)ML|ASN\.1|Text)',
 236                                     # HTML, Text, ASN.1, XML
 237     'NCBI_GI'   => '(yes|no)',                  # yes, no
 238     'NEW_VIEW' => '(true|false)',
 239     'RID'               =>  '.*',
 240     'RESULTS_FILE'      =>  '(yes|no)',                 # yes, no
 241     'SERVICE'   =>  '(plain|p[sh]i|(rps|mega)blast)',
 242                                    # plain,psi,phi,rpsblast,megablast
 243     'SHOW_OVERVIEW' =>  '(yes|no)'                      # yes, no
 244                                       );
 245
 246 # Default values go in here for PUT
 247 our %HEADER = (
 248     'CMD'                          => 'Put',
 249     'FORMAT_OBJECT'                => 'Alignment',
 250     'COMPOSITION_BASED_STATISTICS' => 'off',
 251     'DATABASE'                => 'nr',
 252     'EXPECT'                          => '1e-3',
 253     'FILTER'                          => 'L',
 254     'PROGRAM'                 => 'blastp',
 255     'SERVICE'                 => 'plain'
 256            );
 257
 258 # Default values go in here for GET
 259 our %RETRIEVALHEADER = (
 260     'CMD'            => 'Get',
 261     'ALIGNMENTS'         => '50',
 262     'ALIGNMENT_VIEW' => 'Pairwise',
 263     'DESCRIPTIONS'       => '100',
 264     'FORMAT_TYPE'        => 'Text',
 265 );
 266
 267 sub new {
 268         my ($caller, @args) = @_;
 269         # chained new
 270         my $self = $caller->SUPER::new(@args);
 271         # so that tempfiles are cleaned up
 272         $self->_initialize_io();
 273         my ($prog, $data, $readmethod, $url_base) =
 274         $self->_rearrange([qw(PROG DATA READMETHOD URL_BASE)],
 275                                          @args);
 276         # Use these two parameters for backward-compatibility.
 277         # Overridden by PROGRAM and DATABASE if supplied.
 278         $self->submit_parameter('PROGRAM',$prog) if $prog;
 279         $self->submit_parameter('DATABASE',$data) if $data;
 280
 281         $readmethod = 'SearchIO' unless defined $readmethod;
 282         $self->readmethod($readmethod);
 283
 284         # Now read the rest of the parameters and set them all
 285
 286         # PUT parameters first
 287         my @putValues = $self->_rearrange([keys %PUTPARAMS],@args);
 288         my %putNames;
 289         @putNames{keys %PUTPARAMS} = @putValues;
 290         foreach my $putName (keys %putNames) {
 291                 $self->submit_parameter($putName,$putNames{$putName});
 292         }
 293         # GET parameters second
 294         my @getValues = $self->_rearrange([keys %GETPARAMS],@args);
 295         my %getNames;
 296         @getNames{keys %GETPARAMS} = @getValues;
 297         foreach my $getName (keys %getNames) {
 298                 $self->retrieve_parameter($getName,$getNames{$getName});
 299         }
 300         # private variable to keep track of total rids
 301     $self->{'_total_rids'} = 0;
 302     $url_base ||= $URLBASE;  # default to regular NCBI BLAST URL
 303     $self->set_url_base($url_base);
 304         return $self;
 305 }
 306
 307 =head2 retrieve_parameter
 308
 309  Title   : retrieve_parameter
 310  Usage   : my $db = $self->retrieve_parameter
 311  Function: Get/Set the named parameter for the retrieve_blast operation.
 312  Returns : string
 313  Args    : $name : name of GET parameter
 314          $val : optional value to set the parameter to
 315
 316 =cut
 317
 318 sub retrieve_parameter {
 319         my ($self, $name, $val) = @_;
 320         $name = uc($name);
 321         $self->throw($name." is not a valid GET parameter.") unless
 322           exists $GETPARAMS{$name};
 323         if (defined $val) {
 324         my $regex = $GETPARAMS{$name};
 325         $val =~ m/^$regex$/i or
 326                   $self->throw("Value ".$val." for GET parameter ".$name." does not match expression ".$regex.". Rejecting.");
 327                 $RETRIEVALHEADER{$name} = $val;
 328         }
 329         return $RETRIEVALHEADER{$name};
 330 }
 331
 332 =head2 submit_parameter
 333
 334  Title   : submit_parameter
 335  Usage   : my $db = $self->submit_parameter
 336  Function: Get/Set the named parameter for the submit_blast operation.
 337  Returns : string
 338  Args    : $name : name of PUT parameter
 339     $val : optional value to set the parameter to
 340
 341 =cut
 342
 343 sub submit_parameter {
 344     my ($self, $name, $val) = @_;
 345     $name = uc($name);
 346     $self->throw($name." is not a valid PUT parameter.") unless
 347         exists $PUTPARAMS{$name};
 348     if (defined $val) {
 349         my $regex = $PUTPARAMS{$name};
 350         $val =~ m/^$regex$/i or
 351                 $self->throw("Value ".$val." for PUT parameter ".$name." does not match expression ".$regex.". Rejecting.");
 352         $HEADER{$name} = $val;
 353     }
 354     return $HEADER{$name};
 355 }
 356
 357 =head2 header
 358
 359  Title   : header
 360  Usage   : my $header = $self->header
 361  Function: Get HTTP header for blast query
 362  Returns : string
 363  Args    : none
 364
 365 =cut
 366
 367 sub header {
 368     my ($self) = @_;
 369     return %HEADER;
 370 }
 371
 372 =head2 readmethod
 373
 374  Title   : readmethod
 375  Usage   : my $readmethod = $self->readmethod
 376  Function: Get/Set the method to read the blast report
 377  Returns : string
 378  Args    : string [ blast, blasttable, xml ]
 379
 380 =cut
 381
 382 sub readmethod {
 383     my ($self, $val) = @_;
 384     if( defined $val ) {
 385         if ($val =~ /bplite/i) {
 386             $self->throw("Use of Bio::Tools::BPlite is deprecated; use Bio::SearchIO modules instead");
 387         }
 388         $self->{'_readmethod'} = $val;
 389     }
 390     return $self->{'_readmethod'};
 391 }
 392
 393
 394 =head2 program
 395
 396  Title   : program
 397  Usage   : my $prog = $self->program
 398  Function: Get/Set the program to run. Retained for backwards-compatibility.
 399  Returns : string
 400  Args    : string [ blastp, blastn, blastx, tblastn, tblastx ]
 401
 402 =cut
 403
 404 sub program {
 405     my ($self, $val) = @_;
 406     return $self->submit_parameter('PROGRAM',$val);
 407 }
 408
 409
 410 =head2 database
 411
 412  Title   : database
 413  Usage   : my $db = $self->database
 414  Function: Get/Set the database to search. Retained for backwards-compatibility.
 415  Returns : string
 416  Args    : string [ swissprot, nr, nt, etc... ]
 417
 418 =cut
 419
 420 sub database {
 421     my ($self, $val) = @_;
 422     return $self->submit_parameter('DATABASE',$val);
 423 }
 424
 425
 426 =head2 expect
 427
 428  Title   : expect
 429  Usage   : my $expect = $self->expect
 430  Function: Get/Set the E value cutoff. Retained for backwards-compatibility.
 431  Returns : string
 432  Args    : string [ '1e-4' ]
 433
 434 =cut
 435
 436 sub expect {
 437     my ($self, $val) = @_;
 438     return $self->submit_parameter('EXPECT',$val);
 439 }
 440
 441 =head2 ua
 442
 443  Title   : ua
 444  Usage   : my $ua = $self->ua or
 445            $self->ua($ua)
 446  Function: Get/Set a LWP::UserAgent for use
 447  Returns : reference to LWP::UserAgent Object
 448  Args    : none
 449  Comments: Will create a UserAgent if none has been requested before.
 450
 451 =cut
 452
 453 sub ua {
 454     my ($self, $value) = @_;
 455     if( ! defined $self->{'_ua'} ) {
 456         $self->{'_ua'} = LWP::UserAgent->new(env_proxy => 1, parse_head => 0);
 457         my $nm = ref($self);
 458         $nm =~ s/::/_/g;
 459         $self->{'_ua'}->agent("bioperl-$nm/$MODVERSION");
 460     }
 461     return $self->{'_ua'};
 462 }
 463
 464 =head2 proxy
 465
 466  Title   : proxy
 467  Usage   : $httpproxy = $db->proxy('http')  or
 468            $db->proxy(['http','ftp'], 'http://myproxy' )
 469  Function: Get/Set a proxy for use of proxy
 470  Returns : a string indicating the proxy
 471  Args    : $protocol : an array ref of the protocol(s) to set/get
 472            $proxyurl : url of the proxy to use for the specified protocol
 473
 474 =cut
 475
 476 sub proxy {
 477     my ($self,$protocol,$proxy) = @_;
 478     return if ( !defined $self->ua || !defined $protocol
 479                       || !defined $proxy );
 480     return $self->ua->proxy($protocol,$proxy);
 481 }
 482
 483 sub add_rid {
 484     my ($self, @vals) = @_;
 485     foreach ( @vals ) {
 486         $self->{'_rids'}->{$_} = $self->{'_total_rids'};
 487         $self->{'_total_rids'}++;
 488     }
 489     return scalar keys %{$self->{'_rids'}};
 490 }
 491
 492 sub remove_rid {
 493     my ($self, @vals) = @_;
 494     foreach ( @vals ) {
 495         delete $self->{'_rids'}->{$_};
 496     }
 497     return scalar keys %{$self->{'_rids'}};
 498 }
 499
 500 sub each_rid {
 501     my ($self) = @_;
 502     # sort on key value, a little tricky...
 503     my @sort_rids = sort {$self->{'_rids'}->{$a} <=> $self->{'_rids'}->{$b}} keys %{$self->{'_rids'}};
 504     return @sort_rids;
 505 }
 506
 507 =head2 submit_blast
 508
 509  Title   : submit_blast
 510  Usage   : $self->submit_blast([$seq1,$seq2]);
 511  Function: Submit blast jobs to ncbi blast queue on sequence(s)
 512  Returns : Blast report object as defined by $self->readmethod
 513  Args    : input can be:
 514            * sequence object
 515            * array ref of sequence objects
 516            * filename of file containing fasta formatted sequences
 517
 518 =cut
 519
 520 sub submit_blast {
 521     my ($self, $input) = @_;
 522     my @seqs = $self->_load_input($input);
 523     my $url_base = $self->get_url_base;
 524     return 0 unless ( @seqs );
 525     my $tcount = 0;
 526     my %header = $self->header;
 527     $header{$_} ||= $RETRIEVALHEADER{$_} foreach (keys %RETRIEVALHEADER);
 528     foreach my $seq ( @seqs ) {
 529         #If query has a fasta header, the output has the query line.
 530         $header{'QUERY'} = ">".(defined $seq->display_id() ? $seq->display_id() : "").
 531                 " ".(defined $seq->desc() ? $seq->desc() : "")."\n".$seq->seq();
 532         my $request = POST $url_base, [%header];
 533         $self->debug($request->as_string) if ( $self->verbose > 1);
 534         my $response = $self->ua->request( $request);
 535
 536         if( $response->is_success ) {
 537             my @subdata = split(/\n/, $response->content );
 538             my $count = 0;
 539             foreach ( @subdata ) {
 540         if( /^\s+RID\s+=\s+(\S+)/ ) {
 541             $count++;
 542             #$self->debug("RID: $1\n");
 543             $self->add_rid($1);
 544         } elsif (/^\s+RTOE\s+=\s+(.*$)/) {
 545             $self->{rtoe} = $1;
 546             $count++;
 547         }
 548         last if $count >= 2;
 549             }
 550             if( $count == 0 ) {
 551         $self->warn("req was ". $request->as_string() . "\n");
 552         $self->warn(join('', @subdata));
 553             }
 554             $tcount += $count;
 555         } else {
 556             # should try and be a little more verbose here
 557             $self->warn("req was ". $request->as_string() . "\n" .
 558                         $response->error_as_HTML);
 559             $tcount = -1;
 560                 }
 561     }
 562     return $tcount;
 563 }
 564
 565 =head2 retrieve_blast
 566
 567  Title   : retrieve_blast
 568  Usage   : my $blastreport = $blastfactory->retrieve_blast($rid);
 569  Function: Attempts to retrieve a blast report from remote blast queue
 570  Returns : scalar int (constant) or Bio::SearchIO object
 571            Constants:
 572             NOT_FINISHED (= 0)   : 'job not finished'
 573             code on error:
 574               ERR_QBSTATUS (= 1) : return line matches 'Status=ERROR'
 575               ERR_NOCONTENT (= 2): HTTP request successful, but no content
 576                                    returned
 577               ERR_HTTPFAIL (= 4) : HTTP request failed
 578               ERR_QBNONSPEC (= 8): return line matches 'ERROR' (not status line)
 579  Args    : Remote Blast ID (RID)
 580
 581 =cut
 582
 583 sub retrieve_blast {
 584     my($self, $rid) = @_;
 585     my $url_base = $self->get_url_base;
 586     my %hdr = %RETRIEVALHEADER;
 587     $hdr{'RID'} = $rid;
 588
 589     my $req = HTTP::Request->new(
 590             GET => $url_base."?CMD=Get&FORMAT_OBJECT=SearchInfo&RID=$rid",
 591             );
 592     #$self->debug("SearchInfo request is " . $req->as_string());
 593     my $response = $self->ua->request($req);
 594     if( $response->is_success ) {
 595         my $status;
 596         if($response->content =~ /Status=(WAITING|ERROR|FAILED|UNKNOWN|READY)/i ) {
 597             $status = $1;
 598             if( $status eq 'ERROR' ) {
 599                 $self->warn("Server Error");
 600                 return ERR_QBSTATUS;
 601             } elsif( $status eq 'FAILED' ) {
 602                 $self->warn("Request Failed");
 603                 return ERR_QBSTATUS;
 604             }
 605         } else {
 606             $self->warn("Error: No status reported\n");
 607         }
 608         if ( $status ne 'READY' ) {
 609             return 0;
 610         } else {
 611             my ($fh,$tempfile) = $self->tempfile();
 612             close $fh;
 613
 614             my $req = POST $url_base, [%hdr];
 615             $self->debug("retrieve request is " . $req->as_string());
 616             my $response = $self->ua->request($req, $tempfile);
 617
 618             my $blastobj;
 619             my $mthd = $self->readmethod;
 620             $mthd = ($mthd =~ /blasttable/i) ? 'blasttable' :
 621                     ($mthd =~ /xml/i)        ? 'blastxml'   :
 622                     ($mthd =~ /pull/i)       ? 'blast_pull' :
 623                     'blast';
 624             $blastobj = Bio::SearchIO->new(
 625                         -file => $tempfile,
 626                         -format => $mthd);
 627             ## store filename in object ##
 628             $self->file($tempfile);
 629             return $blastobj;
 630         }
 631     } else {
 632         $self->warn($response->error_as_HTML);
 633         return ERR_HTTPFAIL;
 634     }
 635 }
 636
 637 =head2 save_output
 638
 639  Title   : saveoutput
 640  Usage   : my $saveoutput = $self->save_output($filename)
 641  Function: Method to save the blast report
 642  Returns : 1 (throws error otherwise)
 643  Args    : string [rid, filename]
 644
 645 =cut
 646
 647 sub save_output {
 648         my ($self, $filename) = @_;
 649         if( ! defined $filename ) {
 650                 $self->throw("Can't save blast output.  You must specify a filename to save to.");
 651         }
 652         my $blastfile = $self->file;
 653         #open temp file and output file, have to filter out some HTML
 654         open(my $TMP, $blastfile) or $self->throw("cannot open $blastfile");
 655
 656         open(my $SAVEOUT, ">", $filename) or $self->throw("cannot open $filename");
 657         my $seentop = 0;
 658         while(<$TMP>) {
 659                 next if (/<pre>/);
 660                 if(/^(?:[T]?BLAST[NPX])\s*.+$/i ||
 661            /^RPS-BLAST\s*.+$/i ||
 662            /<\?xml\sversion=/ ||
 663            /^#\s+(?:[T]?BLAST[NPX])\s*.+$/) {
 664                         $seentop=1;
 665                 }
 666         next if !$seentop;
 667                 if( $seentop ) {
 668                         print $SAVEOUT $_;
 669                 }
 670         }
 671         return 1;
 672 }
 673
 674 sub _load_input {
 675         my ($self, $input) = @_;
 676
 677         if( ! defined $input ) {
 678                 $self->throw("Calling remote blast with no input");
 679         }
 680         my @seqs;
 681         if( ! ref $input ) {
 682                 if( -e $input ) {
 683                         my $seqio = Bio::SeqIO->new(-format => 'fasta',
 684                                                                                                 -file => $input);
 685                         while( my $seq = $seqio->next_seq ) {
 686                                 push @seqs, $seq;
 687                         }
 688                 } else {
 689                         $self->throw("Input $input was not a valid filename");
 690                 }
 691         } elsif( ref($input) =~ /ARRAY/i ) {
 692                 foreach ( @$input ) {
 693                         if( ref($_) && $_->isa('Bio::PrimarySeqI') ) {
 694                                 push @seqs, $_;
 695                         } else {
 696                                 $self->warn("Trying to add a " . ref($_) .
 697                                                                 " but expected a Bio::PrimarySeqI");
 698                         }
 699                 }
 700                 if( ! @seqs) {
 701                         $self->throw("Did not pass in valid input -- no sequence objects found");
 702                 }
 703         } elsif( $input->isa('Bio::PrimarySeqI') ) {
 704                 push @seqs, $input;
 705         }
 706         return @seqs;
 707 }
 708
 709 =head2 set_url_base
 710
 711  Title   : set_url_base
 712  Usage   : $self->set_url_base($url)
 713  Function: Method to override the default NCBI BLAST database
 714  Returns : None
 715  Args    : string (database url like
 716  NOTE    : This is highly experimental; we cannot maintain support on
 717            databases other than the default NCBI database at this time
 718
 719 =cut
 720
 721 sub set_url_base {
 722     my $self = shift;
 723     $self->{'_urlbase'} = shift if @_;
 724 }
 725
 726 =head2 get_url_base
 727
 728  Title   : get_url_base
 729  Usage   : my $url = $self->set_url_base
 730  Function: Get the current URL for BLAST database searching
 731  Returns : string (URL used for remote blast searches)
 732  Args    : None
 733
 734 =cut
 735
 736 sub get_url_base {
 737     my $self = shift;
 738     return $self->{'_urlbase'};
 739 }
 740
 741 =head2 get_rtoe
 742
 743  Title   : get_rtoe
 744  Usage   : my $url = $self->rtoe
 745  Function: Retrieve the retrieval time (defined after submit_blast())
 746  Returns : number
 747  Args    : None
 748
 749 =cut
 750
 751 sub get_rtoe {
 752     my $self = shift;
 753     return $self->{rtoe};
 754 }
 755
 756 1;
 757
 758 __END__