Bio/Tools/EUtilities/Query.pm

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