← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/bioperl/oneiric

« back to all changes in this revision

Viewing changes to Bio/DB/EUtilities/esearch.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (3.1.2 squeeze)
  • Revision ID: james.westby@ubuntu.com-20090310071911-ever3si2bbzx1iks
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/DB/EUtilities/esearch.pm
1
 
# $Id: esearch.pm,v 1.11.4.2 2006/10/02 23:10:16 sendu Exp $
2
 
#
3
 
# BioPerl module for Bio::DB::EUtilities::esearch
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::esearch - Base interface class for handling web
18
 
queries and data retrieval from Entrez Utilities from NCBI.
19
 
You shouldn't use this class directly.
20
 
 
21
 
=head1 SYNOPSIS
22
 
 
23
 
*** Give standard usage here
24
 
 
25
 
=head1 DESCRIPTION
26
 
 
27
 
*** Describe the object here
28
 
 
29
 
=head1 FEEDBACK
30
 
 
31
 
=head2 Mailing Lists
32
 
 
33
 
User feedback is an integral part of the
34
 
evolution of this and other Bioperl modules. Send
35
 
your comments and suggestions preferably to one
36
 
of the Bioperl mailing lists. Your participation
37
 
is much appreciated.
38
 
 
39
 
  bioperl-l@bioperl.org                  - General discussion
40
 
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
41
 
 
42
 
=head2 Reporting Bugs
43
 
 
44
 
Report bugs to the Bioperl bug tracking system to
45
 
help us keep track the bugs and their resolution.
46
 
Bug reports can be submitted via the web.
47
 
 
48
 
  http://bugzilla.open-bio.org/
49
 
 
50
 
=head1 AUTHOR 
51
 
 
52
 
Email cjfields at uiuc dot edu
53
 
 
54
 
=head1 APPENDIX
55
 
 
56
 
The rest of the documentation details each of the
57
 
object methods. Internal methods are usually
58
 
preceded with a _
59
 
 
60
 
=cut
61
 
 
62
 
# Let the code begin...
63
 
 
64
 
package Bio::DB::EUtilities::esearch;
65
 
use strict;
66
 
use warnings;
67
 
use Bio::DB::EUtilities::Cookie;
68
 
use XML::Simple;
69
 
#use Data::Dumper;
70
 
 
71
 
use vars qw($EUTIL);
72
 
 
73
 
use base qw(Bio::DB::EUtilities);
74
 
 
75
 
our $EUTIL = 'esearch';
76
 
 
77
 
sub _initialize {
78
 
    my ($self, @args ) = @_;
79
 
    $self->SUPER::_initialize(@args);
80
 
        my ($term, $field, $reldate, $mindate, $maxdate, $datetype, $rettype, $retstart, 
81
 
        $retmax, $sort, $usehistory) = 
82
 
          $self->_rearrange([qw(TERM FIELD RELDATE MINDATE MAXDATE DATETYPE RETTYPE
83
 
        RETSTART RETMAX SORT USEHISTORY)],
84
 
                @args);    
85
 
    # set by default
86
 
    $self->_eutil($EUTIL);
87
 
    $datetype ||= 'mdat';
88
 
    $self->datetype($datetype) if $datetype;
89
 
        $term                   && $self->term($term);
90
 
        $field                  && $self->field($field);
91
 
        $reldate                && $self->reldate($reldate);
92
 
        $mindate                && $self->mindate($mindate);
93
 
        $maxdate                && $self->maxdate($maxdate);
94
 
    $retstart       && $self->retstart($retstart);
95
 
    $retmax         && $self->retmax($retmax);
96
 
    $rettype        && $self->rettype($rettype);
97
 
    $sort           && $self->sort_results($sort);
98
 
        $usehistory             && $self->usehistory($usehistory);
99
 
}
100
 
 
101
 
=head2 parse_response
102
 
 
103
 
 Title   : parse_response
104
 
 Usage   : $db->_parse_response($content)
105
 
 Function: parse out response for cookie
106
 
 Returns : empty
107
 
 Args    : none
108
 
 Throws  : 'unparseable output exception'
109
 
 
110
 
=cut
111
 
 
112
 
sub parse_response {
113
 
    my $self    = shift;
114
 
    my $response = shift if @_;
115
 
    if (!$response || !$response->isa("HTTP::Response")) {
116
 
        $self->throw("Need HTTP::Response object");
117
 
    }
118
 
    my $history = $self->usehistory;
119
 
    my $db = $self->db;
120
 
    my $xs = XML::Simple->new();
121
 
    my $simple = $xs->XMLin($response->content);
122
 
    #$self->debug("Response dumper:\n".Dumper($simple));
123
 
    # check for major and minor errors and warnings
124
 
    if ($simple->{ERROR}) {
125
 
        $self->throw("NCBI esearch nonrecoverable error: ".$simple->{ERROR});
126
 
    }
127
 
    if ($simple->{ErrorList} || $simple->{WarningList}) {
128
 
        my %errorlist = %{ $simple->{ErrorList} };
129
 
        my %warninglist = %{ $simple->{WarningList} };
130
 
        my ($err_warn);
131
 
        for my $key (sort keys %errorlist) {
132
 
            $err_warn .= "Error : $key = $errorlist{$key}\n";
133
 
        }    
134
 
        for my $key (sort keys %warninglist) {
135
 
            $err_warn .= "Warning : $key = $warninglist{$key}\n";
136
 
        }
137
 
        chomp($err_warn);
138
 
        $self->warn("NCBI esearch Errors/Warnings:\n".$err_warn)
139
 
    }
140
 
        my $count = $simple->{Count};
141
 
        $self->esearch_count($count);
142
 
    my $id_ref = $simple->{IdList}->{Id};
143
 
    $self->_add_db_ids($id_ref) if ($id_ref);
144
 
    if ($history && $history eq 'y') {
145
 
        my $webenv = $simple->{WebEnv};
146
 
        my $querykey = $simple->{QueryKey};
147
 
                my $cookie = Bio::DB::EUtilities::Cookie->new(
148
 
                                                                                 -term          => $self->term,
149
 
                                                                                 -webenv    => $webenv,
150
 
                                                                                 -querykey  => $querykey,
151
 
                                                                                 -eutil     => 'esearch',
152
 
                                         -database  => $db,
153
 
                                                                                 -total         => $count
154
 
                                                                                );
155
 
        $self->add_cookie($cookie);
156
 
        }
157
 
}
158
 
 
159
 
=head2 esearch_count
160
 
 
161
 
 Title   : esearch_count
162
 
 Usage   : $count = $db->esearch_count;
163
 
 Function: return count of number of entries retrieved by query
164
 
 Returns : integer
165
 
 Args    : none
166
 
 
167
 
=cut
168
 
 
169
 
sub esearch_count   {
170
 
    my $self = shift;
171
 
    return $self->{'_esearch_count'} = shift if @_;
172
 
    return $self->{'_esearch_count'};
173
 
}
174
 
 
175
 
1;
176
 
__END__
 
 
b'\\ No newline at end of file'