← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to Bio/DB/NCBIHelper.pm

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2014-01-18 11:41:11 UTC
  • mfrom: (3.1.12 sid)
  • Revision ID: package-import@ubuntu.com-20140118114111-zcjaq5edb49dhlat
Tags: 1.6.923-1
* New upstream release.
* Does not need non-free libmath-random-perl anymore.
* Build-depend on libmodule-build-perl (>= 0.420000).  Despite Lintian's
  warning that it is useless, the package does not build without.
* Conforms to Policy version 3.9.5.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/DB/NCBIHelper.pm
86
86
 
87
87
package Bio::DB::NCBIHelper;
88
88
use strict;
89
 
use vars qw($HOSTBASE %CGILOCATION %FORMATMAP $DEFAULTFORMAT $MAX_ENTRIES);
90
89
 
91
90
use Bio::DB::Query::GenBank;
92
91
use HTTP::Request::Common;
97
96
 
98
97
use base qw(Bio::DB::WebDBSeqI Bio::Root::Root);
99
98
 
100
 
BEGIN {
101
 
    $MAX_ENTRIES = 19000;
102
 
    $HOSTBASE = 'http://eutils.ncbi.nlm.nih.gov';
103
 
    %CGILOCATION = (
104
 
                        'batch'  => ['post' => '/entrez/eutils/epost.fcgi'],
105
 
                    'query'  => ['get'  => '/entrez/eutils/efetch.fcgi'],
106
 
                    'single' => ['get'  => '/entrez/eutils/efetch.fcgi'],
107
 
                    'version'=> ['get'  => '/entrez/eutils/efetch.fcgi'],
108
 
                    'gi'   =>   ['get'  => '/entrez/eutils/efetch.fcgi'],
109
 
                        'webenv' => ['get'  => '/entrez/eutils/efetch.fcgi']
110
 
                     );
111
 
 
112
 
    %FORMATMAP = ( 'gb' => 'genbank',
113
 
                                                   'gp' => 'genbank',
114
 
                                                   'fasta' => 'fasta',
115
 
                                                   'asn.1' => 'entrezgene',
116
 
                                                   'gbwithparts' => 'genbank',
117
 
                                          );
118
 
    $DEFAULTFORMAT = 'gb';
119
 
}
120
 
 
121
 
# the new way to make modules a little more lightweight
 
99
our $HOSTBASE = 'http://eutils.ncbi.nlm.nih.gov';
 
100
our $MAX_ENTRIES = 19000;
 
101
our $REQUEST_DELAY = 3;
 
102
our %CGILOCATION = (
 
103
        'batch'   => [ 'post' => '/entrez/eutils/epost.fcgi' ],
 
104
        'query'   => [ 'get'  => '/entrez/eutils/efetch.fcgi' ],
 
105
        'single'  => [ 'get'  => '/entrez/eutils/efetch.fcgi' ],
 
106
        'version' => [ 'get'  => '/entrez/eutils/efetch.fcgi' ],
 
107
        'gi'      => [ 'get'  => '/entrez/eutils/efetch.fcgi' ],
 
108
        'webenv'  => [ 'get'  => '/entrez/eutils/efetch.fcgi' ]
 
109
    );
 
110
our %FORMATMAP = (
 
111
        'gb'          => 'genbank',
 
112
        'gp'          => 'genbank',
 
113
        'fasta'       => 'fasta',
 
114
        'asn.1'       => 'entrezgene',
 
115
        'gbwithparts' => 'genbank',
 
116
    );
 
117
our $DEFAULTFORMAT = 'gb';
 
118
 
 
119
=head2 new
 
120
 
 
121
 Title   : new
 
122
 Usage   :
 
123
 Function: the new way to make modules a little more lightweight
 
124
 Returns : 
 
125
 Args    : 
 
126
 
 
127
=cut
122
128
 
123
129
sub new {
124
 
    my ($class, @args ) = @_;
 
130
    my ( $class, @args ) = @_;
125
131
    my $self = $class->SUPER::new(@args);
126
 
    my ($seq_start,$seq_stop,$no_redirect, $redirect, $complexity,$strand) =
127
 
         $self->_rearrange([qw(SEQ_START SEQ_STOP NO_REDIRECT REDIRECT_REFSEQ COMPLEXITY STRAND)],
128
 
                                                         @args);
129
 
        $seq_start     && $self->seq_start($seq_start);
130
 
    $seq_stop      && $self->seq_stop($seq_stop);
131
 
    $no_redirect   && $self->no_redirect($no_redirect);
132
 
    $redirect      && $self->redirect_refseq($redirect);
133
 
    $strand        && $self->strand($strand);
134
 
        # adjust statement to accept zero value
135
 
        defined $complexity && ($complexity >=0 && $complexity <=4)
136
 
                && $self->complexity($complexity);
 
132
    my ($seq_start, $seq_stop,   $no_redirect,
 
133
        $redirect,  $complexity, $strand
 
134
        )
 
135
        = $self->_rearrange(
 
136
        [ qw(SEQ_START SEQ_STOP NO_REDIRECT REDIRECT_REFSEQ COMPLEXITY STRAND) ],
 
137
        @args
 
138
        );
 
139
    $seq_start   && $self->seq_start($seq_start);
 
140
    $seq_stop    && $self->seq_stop($seq_stop);
 
141
    $no_redirect && $self->no_redirect($no_redirect);
 
142
    $redirect    && $self->redirect_refseq($redirect);
 
143
    $strand      && $self->strand($strand);
 
144
 
 
145
    # adjust statement to accept zero value
 
146
    defined $complexity
 
147
        && ( $complexity >= 0 && $complexity <= 4 )
 
148
        && $self->complexity($complexity);
137
149
    return $self;
138
150
}
139
151
 
142
154
 
143
155
 Title   : get_params
144
156
 Usage   : my %params = $self->get_params($mode)
145
 
 Function: Returns key,value pairs to be passed to NCBI database
 
157
 Function: returns key,value pairs to be passed to NCBI database
146
158
           for either 'batch' or 'single' sequence retrieval method
147
159
 Returns : a key,value pair hash
148
160
 Args    : 'single' or 'batch' mode for retrieval
158
170
 
159
171
 Title   : default_format
160
172
 Usage   : my $format = $self->default_format
161
 
 Function: Returns default sequence format for this module
 
173
 Function: returns default sequence format for this module
162
174
 Returns : string
163
175
 Args    : none
164
176
 
179
191
=cut
180
192
 
181
193
sub get_request {
182
 
        my ($self, @qualifiers) = @_;
183
 
        my ($mode, $uids, $format, $query, $seq_start, $seq_stop, $strand, $complexity) =
184
 
          $self->_rearrange([qw(MODE UIDS FORMAT QUERY SEQ_START SEQ_STOP STRAND COMPLEXITY)],
185
 
                                                          @qualifiers);
186
 
        $mode = lc $mode;
187
 
        ($format) = $self->request_format() unless ( defined $format);
188
 
        if( !defined $mode || $mode eq '' ) { $mode = 'single'; }
189
 
        my %params = $self->get_params($mode);
190
 
        if( ! %params ) {
191
 
                $self->throw("must specify a valid retrieval mode 'single' or 'batch' not '$mode'")
192
 
        }
193
 
        my $url = URI->new($HOSTBASE . $CGILOCATION{$mode}[1]);
194
 
        unless( $mode eq 'webenv' || defined $uids || defined $query) {
195
 
                $self->throw("Must specify a query or list of uids to fetch");
196
 
        }
197
 
        if ($query && $query->can('cookie')) {
198
 
                @params{'WebEnv','query_key'} = $query->cookie;
199
 
                $params{'db'}                 = $query->db;
200
 
        }
201
 
        elsif ($query) {
202
 
                $params{'id'} = join ',',$query->ids;
203
 
        }
204
 
        # for batch retrieval, non-query style
205
 
        elsif ($mode eq 'webenv' && $self->can('cookie')) {
206
 
                @params{'WebEnv','query_key'} = $self->cookie;
207
 
        }
208
 
        elsif ($uids) {
209
 
                if( ref($uids) =~ /array/i ) {
210
 
                        $uids = join(",", @$uids);
211
 
                }
212
 
                $params{'id'}      = $uids;
213
 
        }
214
 
        $seq_start && ($params{'seq_start'} = $seq_start);
215
 
        $seq_stop && ($params{'seq_stop'} = $seq_stop);
216
 
        $strand && ($params{'strand'} = $strand);
217
 
        if (defined $complexity && ($seq_start || $seq_stop || $strand)) {
218
 
                $self->warn("Complexity set to $complexity; seq_start and seq_stop may not work!")
219
 
                        if ($complexity != 1 && ($seq_start || $seq_stop));
220
 
                $self->warn("Complexity set to 0; expect strange results with strand set to 2")
221
 
                        if ($complexity == 0 && $strand == 2 && $format eq 'fasta');
222
 
        }
223
 
        defined $complexity && ($params{'complexity'} = $complexity);
224
 
        $params{'rettype'} = $format unless $mode eq 'batch';
225
 
        # for now, 'post' is batch retrieval
226
 
        if ($CGILOCATION{$mode}[0] eq 'post') {
227
 
                my $response = $self->ua->request(POST $url,[%params]);
228
 
                $response->proxy_authorization_basic($self->authentication)
229
 
                        if ( $self->authentication);
230
 
                $self->_parse_response($response->content);
231
 
                my ($cookie, $querykey) = $self->cookie;
232
 
                my %qualifiers = ('-mode'                       => 'webenv',
233
 
                                                  '-seq_start'          => $seq_start,
234
 
                                                  '-seq_stop'           => $seq_stop,
235
 
                                                  '-strand'                     => $strand,
236
 
                                                  '-complexity'         => $complexity,
237
 
                                                  '-format'                     => $format);
238
 
                return $self->get_request(%qualifiers);
239
 
        } else {
240
 
                $url->query_form(%params);
241
 
                return GET $url;
242
 
        }
 
194
    my ( $self, @qualifiers ) = @_;
 
195
    my ( $mode, $uids, $format, $query, $seq_start, $seq_stop, $strand,
 
196
        $complexity )
 
197
        = $self->_rearrange(
 
198
        [qw(MODE UIDS FORMAT QUERY SEQ_START SEQ_STOP STRAND COMPLEXITY)],
 
199
        @qualifiers );
 
200
    $mode = lc $mode;
 
201
    ($format) = $self->request_format() unless ( defined $format );
 
202
    if ( !defined $mode || $mode eq '' ) { $mode = 'single'; }
 
203
    my %params = $self->get_params($mode);
 
204
    if ( !%params ) {
 
205
        $self->throw(
 
206
            "must specify a valid retrieval mode 'single' or 'batch' not '$mode'"
 
207
        );
 
208
    }
 
209
    my $url = URI->new( $HOSTBASE . $CGILOCATION{$mode}[1] );
 
210
    unless ( $mode eq 'webenv' || defined $uids || defined $query ) {
 
211
        $self->throw("Must specify a query or list of uids to fetch");
 
212
    }
 
213
    if ( $query && $query->can('cookie') ) {
 
214
        @params{ 'WebEnv', 'query_key' } = $query->cookie;
 
215
        $params{'db'} = $query->db;
 
216
    }
 
217
    elsif ($query) {
 
218
        $params{'id'} = join ',', $query->ids;
 
219
    }
 
220
 
 
221
    # for batch retrieval, non-query style
 
222
    elsif ( $mode eq 'webenv' && $self->can('cookie') ) {
 
223
        @params{ 'WebEnv', 'query_key' } = $self->cookie;
 
224
    }
 
225
    elsif ($uids) {
 
226
        if ( ref($uids) =~ /array/i ) {
 
227
            $uids = join( ",", @$uids );
 
228
        }
 
229
        $params{'id'} = $uids;
 
230
    }
 
231
    $seq_start && ( $params{'seq_start'} = $seq_start );
 
232
    $seq_stop  && ( $params{'seq_stop'}  = $seq_stop );
 
233
    $strand    && ( $params{'strand'}    = $strand );
 
234
    if ( defined $complexity && ( $seq_start || $seq_stop || $strand ) ) {
 
235
        $self->warn(
 
236
            "Complexity set to $complexity; seq_start and seq_stop may not work!"
 
237
        ) if ( $complexity != 1 && ( $seq_start || $seq_stop ) );
 
238
        $self->warn(
 
239
            "Complexity set to 0; expect strange results with strand set to 2"
 
240
        ) if ( $complexity == 0 && $strand == 2 && $format eq 'fasta' );
 
241
    }
 
242
    defined $complexity && ( $params{'complexity'} = $complexity );
 
243
    $params{'rettype'} = $format unless $mode eq 'batch';
 
244
 
 
245
    # for now, 'post' is batch retrieval
 
246
    if ( $CGILOCATION{$mode}[0] eq 'post' ) {
 
247
        my $response = $self->ua->request( POST $url, [%params] );
 
248
        $response->proxy_authorization_basic( $self->authentication )
 
249
            if ( $self->authentication );
 
250
        $self->_parse_response( $response->content );
 
251
        my ( $cookie, $querykey ) = $self->cookie;
 
252
        my %qualifiers = (
 
253
            '-mode'       => 'webenv',
 
254
            '-seq_start'  => $seq_start,
 
255
            '-seq_stop'   => $seq_stop,
 
256
            '-strand'     => $strand,
 
257
            '-complexity' => $complexity,
 
258
            '-format'     => $format
 
259
        );
 
260
        return $self->get_request(%qualifiers);
 
261
    }
 
262
    else {
 
263
        $url->query_form(%params);
 
264
        return GET $url;
 
265
    }
243
266
}
244
267
 
 
268
 
245
269
=head2 get_Stream_by_batch
246
270
 
247
271
  Title   : get_Stream_by_batch
248
272
  Usage   : $seq = $db->get_Stream_by_batch($ref);
249
273
  Function: Retrieves Seq objects from Entrez 'en masse', rather than one
250
274
            at a time.  For large numbers of sequences, this is far superior
251
 
            than get_Stream_by_[id/acc]().
 
275
            than get_Stream_by_id or get_Stream_by_acc.
252
276
  Example :
253
277
  Returns : a Bio::SeqIO stream object
254
278
  Args    : $ref : either an array reference, a filename, or a filehandle
255
279
            from which to get the list of unique ids/accession numbers.
256
280
 
257
 
NOTE: deprecated API.  Use get_Stream_by_id() instead.
 
281
            NOTE: deprecated API.  Use get_Stream_by_id() instead.
258
282
 
259
283
=cut
260
284
 
270
294
  Usage   : $seq = $db->get_Stream_by_query($query);
271
295
  Function: Retrieves Seq objects from Entrez 'en masse', rather than one
272
296
            at a time.  For large numbers of sequences, this is far superior
273
 
            than get_Stream_by_[id/acc]().
 
297
            to get_Stream_by_id and get_Stream_by_acc.
274
298
  Example :
275
299
  Returns : a Bio::SeqIO stream object
276
 
  Args    : $query :   An Entrez query string or a
277
 
            Bio::DB::Query::GenBank object.  It is suggested that you
278
 
            create a Bio::DB::Query::GenBank object and get the entry
279
 
            count before you fetch a potentially large stream.
 
300
  Args    : An Entrez query string or a Bio::DB::Query::GenBank object.
 
301
            It is suggested that you create a Bio::DB::Query::GenBank object and get 
 
302
            the entry count before you fetch a potentially large stream.
280
303
 
281
304
=cut
282
305
 
292
315
 
293
316
 Title   : postprocess_data
294
317
 Usage   : $self->postprocess_data ( 'type' => 'string',
295
 
                                                         'location' => \$datastr);
296
 
 Function: process downloaded data before loading into a Bio::SeqIO
 
318
                                                             'location' => \$datastr );
 
319
 Function: Process downloaded data before loading into a Bio::SeqIO. This
 
320
           works for Genbank and Genpept, other classes should override
 
321
           it with their own method.
297
322
 Returns : void
298
 
 Args    : hash with two keys - 'type' can be 'string' or 'file'
299
 
                              - 'location' either file location or string
300
 
                                           reference containing data
 
323
 Args    : hash with two keys:
 
324
 
 
325
           'type' can be 'string' or 'file'
 
326
           'location' either file location or string reference containing data
301
327
 
302
328
=cut
303
329
 
304
 
# the default method, works for genbank/genpept, other classes should
305
 
# override it with their own method.
306
 
 
307
330
sub postprocess_data {
308
331
        # retain this in case postprocessing is needed at a future date
309
332
}
324
347
=cut
325
348
 
326
349
sub request_format {
327
 
        my ($self, $value) = @_;
328
 
        if( defined $value ) {
329
 
                $value = lc $value;
330
 
                if( defined $FORMATMAP{$value} ) {
331
 
                        $self->{'_format'} = [ $value, $FORMATMAP{$value}];
332
 
                } else {
333
 
                        # Try to fall back to a default. Alternatively, we could throw
334
 
                        # an exception
335
 
                        $self->{'_format'} = [ $value, $value ];
336
 
                }
337
 
        }
338
 
        return @{$self->{'_format'}};
 
350
    my ( $self, $value ) = @_;
 
351
    if ( defined $value ) {
 
352
        $value = lc $value;
 
353
        if ( defined $FORMATMAP{$value} ) {
 
354
            $self->{'_format'} = [ $value, $FORMATMAP{$value} ];
 
355
        }
 
356
        else {
 
357
            # Try to fall back to a default. Alternatively, we could throw
 
358
            # an exception
 
359
            $self->{'_format'} = [ $value, $value ];
 
360
        }
 
361
    }
 
362
    return @{ $self->{'_format'} };
339
363
}
340
364
 
 
365
 
341
366
=head2 redirect_refseq
342
367
 
343
368
 Title   : redirect_refseq
348
373
 Throws  : 'unparseable output exception'
349
374
 Note    : This replaces 'no_redirect' as a more straightforward flag to
350
375
           redirect possible RefSeqs to use Bio::DB::RefSeq (EBI interface)
351
 
           instead of retrievign the NCBI records
 
376
           instead of retrieving the NCBI records
352
377
 
353
378
=cut
354
379
 
366
391
 Returns : value from 0-4 indicating level of complexity
367
392
 Args    : value from 0-4 (optional); if unset server assumes 1
368
393
 Throws  : if arg is not an integer or falls outside of noted range above
369
 
 Note    : From efetch docs:
370
 
 
371
 
    Complexity regulates the display:
372
 
 
373
 
       * 0 - get the whole blob
374
 
       * 1 - get the bioseq for gi of interest (default in Entrez)
375
 
       * 2 - get the minimal bioseq-set containing the gi of interest
376
 
       * 3 - get the minimal nuc-prot containing the gi of interest
377
 
       * 4 - get the minimal pub-set containing the gi of interest
 
394
 Note    : From efetch docs, the complexity regulates the display:
 
395
 
 
396
           0 - get the whole blob
 
397
           1 - get the bioseq for gi of interest (default in Entrez)
 
398
           2 - get the minimal bioseq-set containing the gi of interest
 
399
           3 - get the minimal nuc-prot containing the gi of interest
 
400
           4 - get the minimal pub-set containing the gi of interest
378
401
 
379
402
=cut
380
403
 
381
404
sub complexity {
382
 
    my ($self, $comp) = @_;
383
 
    if (defined $comp) {
384
 
        $self->throw("Complexity value must be integer between 0 and 4") if
385
 
            $comp !~ /^\d+$/ || $comp < 0 || $comp > 4;
 
405
    my ( $self, $comp ) = @_;
 
406
    if ( defined $comp ) {
 
407
        $self->throw("Complexity value must be integer between 0 and 4")
 
408
            if $comp !~ /^\d+$/ || $comp < 0 || $comp > 4;
386
409
        $self->{'_complexity'} = $comp;
387
410
    }
388
411
    return $self->{'_complexity'};
461
484
 
462
485
  Title   : get_Stream_by_acc
463
486
  Usage   : $seq = $db->get_Stream_by_acc([$acc1, $acc2]);
464
 
  Function: Gets a series of Seq objects by accession numbers
 
487
  Function: gets a series of Seq objects by accession numbers
465
488
  Returns : a Bio::SeqIO stream object
466
489
  Args    : $ref : a reference to an array of accession numbers for
467
490
                   the desired sequence entries
470
493
=cut
471
494
 
472
495
sub get_Stream_by_acc {
473
 
    my ($self, $ids ) = @_;
 
496
    my ( $self, $ids ) = @_;
474
497
    my $newdb = $self->_check_id($ids);
475
 
    if (defined $newdb && ref($newdb) && $newdb->isa('Bio::DB::RefSeq')) {
476
 
        return $newdb->get_seq_stream('-uids' => $ids, '-mode' => 'single');
477
 
    } else {
478
 
        return $self->get_seq_stream('-uids' => $ids, '-mode' => 'single');
 
498
    if ( defined $newdb && ref($newdb) && $newdb->isa('Bio::DB::RefSeq') ) {
 
499
        return $newdb->get_seq_stream( '-uids' => $ids, '-mode' => 'single' );
 
500
    }
 
501
    else {
 
502
        return $self->get_seq_stream( '-uids' => $ids, '-mode' => 'single' );
479
503
    }
480
504
}
481
505
 
482
 
 
483
506
=head2 _check_id
484
507
 
485
508
  Title   : _check_id
486
509
  Usage   :
487
510
  Function:
488
 
  Returns : A Bio::DB::RefSeq reference or throws
 
511
  Returns : a Bio::DB::RefSeq reference or throws
489
512
  Args    : $id(s), $string
490
513
 
491
514
=cut
492
515
 
493
516
sub _check_id {
494
 
        my ($self, $ids) = @_;
495
 
 
496
 
        # NT contigs can not be retrieved
497
 
        $self->throw("NT_ contigs are whole chromosome files which are not part of regular".
498
 
                                         "database distributions. Go to ftp://ftp.ncbi.nih.gov/genomes/.")
499
 
          if $ids =~ /NT_/;
500
 
 
501
 
        # Asking for a RefSeq from EMBL/GenBank
502
 
 
503
 
        if ($self->redirect_refseq) {
504
 
                if ($ids =~ /N._/) {
505
 
                        $self->warn("[$ids] is not a normal sequence database but a RefSeq entry.".
506
 
                                                        " Redirecting the request.\n")
507
 
                          if $self->verbose >= 0;
508
 
                        return  Bio::DB::RefSeq->new();
509
 
                }
510
 
        }
 
517
    my ( $self, $ids ) = @_;
 
518
 
 
519
    # NT contigs can not be retrieved
 
520
    $self->throw("NT_ contigs are whole chromosome files which are not part of regular"
 
521
            . "database distributions. Go to ftp://ftp.ncbi.nih.gov/genomes/.") 
 
522
      if $ids =~ /NT_/;
 
523
 
 
524
    # Asking for a RefSeq from EMBL/GenBank
 
525
    if ( $self->redirect_refseq ) {
 
526
        if ( $ids =~ /N._/ ) {
 
527
            $self->warn(
 
528
                "[$ids] is not a normal sequence database but a RefSeq entry."
 
529
                    . " Redirecting the request.\n" )
 
530
                if $self->verbose >= 0;
 
531
            return Bio::DB::RefSeq->new();
 
532
        }
 
533
    }
511
534
}
512
535
 
 
536
 
513
537
=head2 delay_policy
514
538
 
515
539
  Title   : delay_policy
516
540
  Usage   : $secs = $self->delay_policy
517
 
  Function: return number of seconds to delay between calls to remote db
 
541
  Function: NCBI requests a delay of 3 seconds between requests. This method
 
542
            implements that policy.
518
543
  Returns : number of seconds to delay
519
544
  Args    : none
520
545
 
521
 
  NOTE: NCBI requests a delay of 3 seconds between requests.  This method
522
 
        implements that policy.
523
 
 
524
546
=cut
525
547
 
526
548
sub delay_policy {
527
 
  my $self = shift;
528
 
  return 3;
 
549
    my $self = shift;
 
550
    return $REQUEST_DELAY;
529
551
}
530
552
 
531
553
=head2 cookie
532
554
 
533
555
 Title   : cookie
534
556
 Usage   : ($cookie,$querynum) = $db->cookie
535
 
 Function: return the NCBI query cookie
 
557
 Function: return the NCBI query cookie, this information is used by 
 
558
           Bio::DB::GenBank in conjunction with efetch, ripped from 
 
559
           Bio::DB::Query::GenBank
536
560
 Returns : list of (cookie,querynum)
537
561
 Args    : none
538
562
 
539
 
NOTE: this information is used by Bio::DB::GenBank in
540
 
conjunction with efetch.
541
 
 
542
563
=cut
543
564
 
544
 
# ripped from Bio::DB::Query::GenBank
545
565
sub cookie {
546
 
  my $self = shift;
547
 
  if (@_) {
548
 
    $self->{'_cookie'}   = shift;
549
 
    $self->{'_querynum'} = shift;
550
 
  }
551
 
  else {
552
 
    return @{$self}{qw(_cookie _querynum)};
553
 
  }
 
566
    my $self = shift;
 
567
    if (@_) {
 
568
        $self->{'_cookie'}   = shift;
 
569
        $self->{'_querynum'} = shift;
 
570
    }
 
571
    else {
 
572
        return @{$self}{qw(_cookie _querynum)};
 
573
    }
554
574
}
555
575
 
556
576
=head2 _parse_response
557
577
 
558
578
 Title   : _parse_response
559
579
 Usage   : $db->_parse_response($content)
560
 
 Function: parse out response for cookie
 
580
 Function: parse out response for cookie, this is a trimmed-down version 
 
581
           of _parse_response from Bio::DB::Query::GenBank
561
582
 Returns : empty
562
583
 Args    : none
563
584
 Throws  : 'unparseable output exception'
564
585
 
565
586
=cut
566
587
 
567
 
# trimmed-down version of _parse_response from Bio::DB::Query::GenBank
568
588
sub _parse_response {
569
 
  my $self    = shift;
570
 
  my $content = shift;
571
 
  if (my ($warning) = $content =~ m!<ErrorList>(.+)</ErrorList>!s) {
572
 
    $self->warn("Warning(s) from GenBank: $warning\n");
573
 
  }
574
 
  if (my ($error) = $content =~ /<OutputMessage>([^<]+)/) {
575
 
    $self->throw("Error from Genbank: $error");
576
 
  }
577
 
  my ($cookie)    = $content =~ m!<WebEnv>(\S+)</WebEnv>!;
578
 
  my ($querykey)  = $content =~ m!<QueryKey>(\d+)!;
579
 
  $self->cookie(uri_unescape($cookie),$querykey);
 
589
    my $self    = shift;
 
590
    my $content = shift;
 
591
    if ( my ($warning) = $content =~ m!<ErrorList>(.+)</ErrorList>!s ) {
 
592
        $self->warn("Warning(s) from GenBank: $warning\n");
 
593
    }
 
594
    if ( my ($error) = $content =~ /<OutputMessage>([^<]+)/ ) {
 
595
        $self->throw("Error from Genbank: $error");
 
596
    }
 
597
    my ($cookie)   = $content =~ m!<WebEnv>(\S+)</WebEnv>!;
 
598
    my ($querykey) = $content =~ m!<QueryKey>(\d+)!;
 
599
    $self->cookie( uri_unescape($cookie), $querykey );
580
600
}
581
601
 
582
 
########### DEPRECATED!!!! ###########
583
 
 
584
602
=head2 no_redirect
585
603
 
586
604
 Title   : no_redirect
587
605
 Usage   : $db->no_redirect($content)
588
 
 Function: Used to indicate that Bio::DB::GenBank instance retrieves
 
606
 Function: DEPRECATED - Used to indicate that Bio::DB::GenBank instance retrieves
589
607
           possible RefSeqs from EBI instead; default behavior is now to
590
608
           retrieve directly from NCBI
591
609
 Returns : None