view release on metacpan or  search on metacpan

lib/Bio/DB/Query/GenBank.pm  view on Meta::CPAN

 Usage   : $db->_parse_response($content)
 Function: parse out response
 Returns : empty
 Args    : none
 Throws  : 'unparseable output exception'

=cut

sub _parse_response {
  my $self    = shift;
  my $content = shift;
  if (my ($warning) = $content =~ m!<ErrorList>(.+)</ErrorList>!s) {
    $self->warn("Warning(s) from GenBank: $warning\n");
  }
  if (my ($error) = $content =~ /<OutputMessage>([^<]+)/) {
    $self->throw("Error from Genbank: $error");
  }

  my ($count) = $content =~  /<Count>(\d+)/;
  my ($max)   = $content =~  /<RetMax>(\d+)/;
  my $truncated = $count > $max;
  $self->count($count);
  if (!$truncated) {
    my @ids = $content =~ /<Id>(\d+)/g;
    $self->ids(\@ids);
  } else {
    $self->debug("ids truncated at $max\n");
  }
  $self->_truncated($truncated);
  my ($cookie)    = $content =~ m!<WebEnv>(\S+)</WebEnv>!;
  my ($querykey)  = $content =~ m!<QueryKey>(\d+)!;
  $self->cookie(uri_unescape($cookie),$querykey);
}

=head2 _generate_id_string

 Title   : _generate_id_string
 Usage   : $string = $db->_generate_id_string
 Function: joins IDs together in string (possibly implementation-dependent)
 Returns : string of concatenated IDs
 Args    : array ref of ids (normally passed into the constructor)

=cut

sub _generate_id_string {
    my ($self, $ids) = @_;
    # this attempts to separate out accs (alphanumeric) from UIDs (numeric only)
    # recent changes to esearch has wrought this upon us.. cjf 4/19/07
    return sprintf('%s',join('|',map {
      ($_ =~ m{^\d+$}) ? $_.'[UID]' : $_.'[PACC]'
    } @$ids));
}

=head2 delay_policy

  Title   : delay_policy
  Usage   : $secs = $self->delay_policy
  Function: NCBI requests a delay of 4 seconds between requests unless email is
            provided. This method implements a 4 second delay; use 'delay()' to
            override, though understand if no email is provided we are not
            responsible for users being IP-blocked by NCBI
  Returns : number of seconds to delay
  Args    : none

=cut

sub delay_policy {
    my $self = shift;
    return $REQUEST_DELAY;
}

1;