← Back to branch summary

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

« back to all changes in this revision

Viewing changes to Bio/Tools/EUtilities/Query.pm

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
http://bugs.debian.org/722910
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
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