Bio/Tools/EUtilities/Query.pm

   1 #
   2 # BioPerl module for Bio::Tools::EUtilities::Query
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Chris Fields
   7 #
   8 # Copyright Chris Fields
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11 #
  12 # POD documentation - main docs before the code
  13 #
  14 # Part of the EUtilities BioPerl package
  15
  16 =head1 NAME
  17
  18 Bio::Tools::EUtilities::Query - parse and collect esearch, epost, espell,
  19 egquery information
  20
  21 =head1 SYNOPSIS
  22
  23   ### should not create instance directly; Bio::Tools::EUtilities does this ###
  24
  25   # can also use '-response' (for HTTP::Response objects) or '-fh' (for
  26   # filehandles)
  27
  28   my $info = Bio::Tools::EUtilities->new(-eutil => 'esearch',
  29                                          -file => 'esearch.xml');
  30
  31   # esearch
  32
  33   # esearch with history
  34
  35   # egquery
  36
  37   # espell (just for completeness, really)
  38
  39 =head1 DESCRIPTION
  40
  41 Pluggable module for handling query-related data returned from eutils.
  42
  43 =head1 FEEDBACK
  44
  45 =head2 Mailing Lists
  46
  47 User feedback is an integral part of the
  48 evolution of this and other Bioperl modules. Send
  49 your comments and suggestions preferably to one
  50 of the Bioperl mailing lists. Your participation
  51 is much appreciated.
  52
  53   bioperl-l@lists.open-bio.org               - General discussion
  54   http://www.bioperl.org/wiki/Mailing_lists  - About the mailing lists
  55
  56 =head2 Support
  57
  58 Please direct usage questions or support issues to the mailing list:
  59
  60 I<bioperl-l@bioperl.org>
  61
  62 rather than to the module maintainer directly. Many experienced and
  63 reponsive experts will be able look at the problem and quickly
  64 address it. Please include a thorough description of the problem
  65 with code and data examples if at all possible.
  66
  67 =head2 Reporting Bugs
  68
  69 Report bugs to the Bioperl bug tracking system to
  70 help us keep track the bugs and their resolution.
  71 Bug reports can be submitted via the web.
  72
  73   https://redmine.open-bio.org/projects/bioperl/
  74
  75 =head1 AUTHOR
  76
  77 Email cjfields at bioperl dot org
  78
  79 =head1 APPENDIX
  80
  81 The rest of the documentation details each of the
  82 object methods. Internal methods are usually
  83 preceded with a _
  84
  85 =cut
  86
  87 # Let the code begin...
  88
  89 package Bio::Tools::EUtilities::Query;
  90 use strict;
  91 use warnings;
  92 use Bio::Tools::EUtilities::Query::GlobalQuery;
  93 use Bio::Tools::EUtilities::History;
  94
  95 use base qw(Bio::Tools::EUtilities);
  96
  97 =head1 Bio::Tools::EUtilities::Query methods
  98
  99 =cut
 100
 101 # private EUtilDataI method
 102
 103 {
 104 my %TYPE = (
 105     'espell'    => 'spelling',
 106     'esearch'   => 'singledbquery',
 107     'egquery'   => 'multidbquery',
 108     'epost'     => 'history'
 109     );
 110
 111 sub _add_data {
 112     my ($self, $qdata) = @_;
 113     my $eutil = $self->eutil;
 114     if (!$qdata || ref($qdata) !~ /HASH/i) {
 115         $self->throw("Bad $eutil data");
 116     }
 117     if (exists $qdata->{WebEnv}) {
 118         my $cookie = Bio::Tools::EUtilities::History->new(-eutil => $eutil,
 119                             -verbose => $self->verbose);
 120         $cookie->_add_data($qdata);
 121         push @{$self->{'_histories'}}, $cookie;
 122     }
 123     my $type = exists $TYPE{$eutil} ? $TYPE{$eutil} :
 124         $self->throw("Unrecognized eutil $eutil");
 125     $self->datatype($type); # reset type based on what's present
 126     for my $key (sort keys %$qdata) {
 127         if ($key eq 'eGQueryResult' && exists $qdata->{$key}->{ResultItem}) {
 128             for my $gquery (@{ $qdata->{eGQueryResult}->{ResultItem} }) {
 129                 $self->{'_term'} = $gquery->{Term} = $qdata->{Term};
 130                 my $qd = Bio::Tools::EUtilities::Query::GlobalQuery->new(-eutil => 'egquery',
 131                                                             -datatype => 'globalquery',
 132                                                             -verbose => $self->verbose);
 133                 $qd->_add_data($gquery);
 134                 push @{ $self->{'_globalqueries'} }, $qd;
 135             }
 136         }
 137         if ($key eq 'IdList' &&
 138             exists $qdata->{IdList}->{Id}) {
 139             $self->{'_id'} = $qdata->{IdList}->{Id};
 140             delete $qdata->{IdList};
 141         }
 142         if ($key eq 'TranslationSet' &&
 143             exists $qdata->{TranslationSet}->{Translation}) {
 144             $self->{'_translation'} = $qdata->{TranslationSet}->{Translation};
 145             delete $qdata->{TranslationSet};
 146         }
 147         next if (ref $qdata->{$key} eq 'HASH' && !keys %{$qdata->{$key}});
 148         $self->{'_'.lc $key} = $qdata->{$key};
 149     }
 150 }
 151
 152 }
 153
 154 =head2 to_string
 155
 156  Title    : to_string
 157  Usage    : $foo->to_string()
 158  Function : converts current object to string
 159  Returns  : none
 160  Args     : (optional) simple data for text formatting
 161  Note     : Used generally for debugging and for the print_* methods
 162
 163 =cut
 164
 165 sub to_string {
 166     my $self = shift;
 167     my %data = (
 168         'DB'    => [1, join(', ',$self->get_databases) || ''],
 169         'Query' => [2, $self->get_term || ''],
 170         'IDs'   => [4, join(', ',$self->get_ids) || ''],
 171     );
 172     my $string = $self->SUPER::to_string;
 173     if ($self->eutil eq 'esearch') {
 174         $data{'Count'} = [3, $self->get_count ];
 175         $data{'Translation From'} = [5, $self->get_translation_from || ''];
 176         $data{'Translation To'} = [6, $self->get_translation_to || ''];
 177         $data{'RetStart'} = [7, $self->get_retstart];
 178         $data{'RetMax'} = [8, $self->get_retmax];
 179         $data{'Translation'} = [9, $self->get_query_translation || ''];
 180     }
 181     if ($self->eutil eq 'espell') {
 182         $data{'Corrected'} = [3, $self->get_corrected_query || ''];
 183         $data{'Replaced'} = [4, join(',',$self->get_replaced_terms) || ''];
 184     }
 185     for my $k (sort {$data{$a}->[0] <=> $data{$b}->[0]} keys %data) {
 186         $string .= sprintf("%-20s:%s\n",$k, $self->_text_wrap('',' 'x 20 .':', $data{$k}->[1]));
 187     }
 188     while (my $h = $self->next_History) {
 189         $string .= $h->to_string;
 190     }
 191     while (my $gq = $self->next_GlobalQuery) {
 192         $string .= $gq->to_string;
 193     }
 194     return $string;
 195 }
 196
 197 1;
 198