~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to t/RemoteDB/EUtilities.t

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
* 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:
 
1
# -*-Perl-*- Test Harness script for Bioperl
 
2
# $Id: EUtilities.t 15112 2008-12-08 18:12:38Z sendu $
 
3
#
 
4
 
 
5
use strict;
 
6
our $NUMTESTS;
 
7
our $DEBUG;
 
8
our %EUTILS;
 
9
 
 
10
BEGIN {
 
11
    $NUMTESTS = 4; # base number of tests (those not in blocks)
 
12
 
 
13
    # I have set up eutils tests to run in sections for easier test maintenance
 
14
    # and keeping track of problematic tests. The below hash is the list of
 
15
    # tests, with test number and coderef.
 
16
    
 
17
    # these now run very simple tests for connectivity and data sampling
 
18
    # main tests now with the parser
 
19
 
 
20
    %EUTILS = (
 
21
        'efetch'        => {'tests' => 5,
 
22
                            'sub'   => \&efetch},
 
23
        'epost'         => {'tests' => 11,
 
24
                            'sub'   => \&epost},
 
25
        'esummary'      => {'tests' => 254,
 
26
                            'sub'   => \&esummary},
 
27
        'esearch'       => {'tests' => 13,
 
28
                            'sub'   => \&esearch},
 
29
        'einfo'         => {'tests' => 10,
 
30
                            'sub'   => \&einfo},
 
31
        'elink1'        => {'tests' => 8,
 
32
                            'sub'   => \&elink1},
 
33
        'egquery'       => {'tests' => 4,
 
34
                            'sub'   => \&egquery},
 
35
        );
 
36
    $NUMTESTS += $EUTILS{$_}->{'tests'} for (keys %EUTILS);
 
37
    $DEBUG = $ENV{'BIOPERLDEBUG'} || 0;
 
38
    # this seems to work for perl 5.6 and perl 5.8
 
39
 
 
40
        use Bio::Root::Test;
 
41
        
 
42
        test_begin(-tests               => $NUMTESTS,
 
43
                           -requires_modules    => [qw(XML::Simple LWP::UserAgent)],
 
44
                           -requires_networking => 1,
 
45
                          );
 
46
    
 
47
    use_ok('Bio::DB::EUtilities');
 
48
    use_ok('LWP::UserAgent');
 
49
    use_ok('Bio::Tools::EUtilities');
 
50
    use_ok('Bio::Tools::EUtilities::EUtilParameters');
 
51
}
 
52
 
 
53
# NOTE : Bio::DB::EUtilities is just a specialized pipeline to get any 
 
54
# data available via NCBI's Entrez interface, with a few convenience methods
 
55
# to get UIDs and other additional information.  All data returned
 
56
# using EFetch is raw (not Bioperl objects) and is meant to be piped into
 
57
# other Bioperl modules at a later point for further processing
 
58
 
 
59
#   protein acc
 
60
my @acc = qw(MUSIGHBA1 P18584 CH402638);
 
61
 
 
62
# protein GI
 
63
my @ids = sort qw(1621261 89318838 68536103 20807972 730439);
 
64
 
 
65
# test search term
 
66
my $term = 'dihydroorotase AND human';
 
67
 
 
68
my ($eutil, $response);
 
69
 
 
70
my %dbs = (taxonomy => 1,
 
71
           nucleotide => 1,
 
72
           pubmed => 1);
 
73
my %links = (protein_taxonomy => 1,
 
74
             protein_nucleotide => 1,
 
75
             protein_nucleotide_wgs => 1,
 
76
             protein_pubmed => 1,
 
77
             protein_pubmed_refseq => 1
 
78
             );
 
79
 
 
80
# this loops through the required tests, only running what is in %EUTILS
 
81
for my $test (keys %EUTILS) {
 
82
    $EUTILS{$test}->{'sub'}->();
 
83
}
 
84
 
 
85
# Simple EFetch
 
86
 
 
87
sub efetch {
 
88
    SKIP: {
 
89
        $eutil = Bio::DB::EUtilities->new(
 
90
                                        -db         => 'protein',
 
91
                                        -id         => [$ids[0]],
 
92
                                        -rettype    => 'fasta'
 
93
                                          );
 
94
              
 
95
        isa_ok($eutil, 'Bio::DB::GenericWebAgent');
 
96
        eval {$response = $eutil->get_Response; };
 
97
        skip("EFetch HTTP error: $@", 4) if $@;
 
98
        isa_ok($response, 'HTTP::Response');
 
99
        my $content = $response->content;
 
100
        like($content, qr(PYRR \[Mycobacterium tuberculosis H37Rv\]),
 
101
             'EFetch: Fasta format');
 
102
        
 
103
        # reuse the EUtilities webagent
 
104
        $eutil->parameter_base->id([$ids[1]]);
 
105
        $eutil->parameter_base->rettype('gb');
 
106
        eval {$response = $eutil->get_Response; };
 
107
        skip("EFetch HTTP error: $@", 2) if $@;
 
108
        isa_ok($response, 'HTTP::Response');
 
109
        $content = $response->content;
 
110
        like($content, qr(^LOCUS\s+NP_623143),'EFetch: GenBank format');
 
111
    }
 
112
}
 
113
 
 
114
# EPost->EFetch with History
 
115
 
 
116
sub epost {
 
117
    SKIP: {
 
118
        $eutil = Bio::DB::EUtilities->new(
 
119
                                        -eutil      => 'epost',
 
120
                                        -db         => 'protein',
 
121
                                        -id         => \@ids,
 
122
                                          );
 
123
              
 
124
        isa_ok($eutil, 'Bio::DB::GenericWebAgent');
 
125
        eval {$response = $eutil->get_Response; };
 
126
        skip("EPost HTTP error: $@", 10) if $@;
 
127
        isa_ok($response, 'HTTP::Response');
 
128
        # Any parameters are passed in to the parser, so these should be set.
 
129
        # Databases and IDs always default back to the submitted ones unless
 
130
        # the data being retrieved are IDs or contain new IDs (esearch, elink)
 
131
        
 
132
        is($eutil->get_database, 'protein', '$epost->get_database()');
 
133
        is(join(',',$eutil->get_ids), '1621261,20807972,68536103,730439,89318838', '$epost->get_ids()');
 
134
        
 
135
        # these are not set using epost
 
136
        is($eutil->get_count, undef, '$epost->get_count()');
 
137
        is($eutil->get_term, undef, '$epost->get_term()');
 
138
 
 
139
        my $history = $eutil->next_History;
 
140
        is($history->eutil, 'epost', 'History->eutil()');
 
141
        isa_ok($history, 'Bio::Tools::EUtilities::HistoryI');
 
142
        
 
143
        # check the actual History
 
144
        my ($webenv, $key) = $history->history;
 
145
        like($webenv, qr{^\S{50}}, '$epost WebEnv');
 
146
        like($key, qr{^\d+}, '$epost query key');
 
147
        
 
148
        # can we fetch the sequences?
 
149
        $eutil->set_parameters(
 
150
            -eutil => 'efetch',
 
151
            -history     => $history,
 
152
            -rettype    => 'fasta'
 
153
        );
 
154
        # look for fasta headers
 
155
        my ($r, $t);
 
156
        eval{ $r = $eutil->get_Response->content;};
 
157
        skip("EPost HTTP error", 1) if $@;
 
158
        $t = grep m{^>.*$}, split("\n", $r);
 
159
        is($t, 5, 'EPost to EFetch');
 
160
    }
 
161
}
 
162
 
 
163
# ESummary
 
164
 
 
165
sub esummary {
 
166
    my %docsum = (1621261=> { 'Caption' => ['String','CAB02640'],
 
167
    'Title' => ['String','PROBABLE PYRIMIDINE OPERON REGULATORY PROTEIN PYRR '.
 
168
     '[Mycobacterium tuberculosis H37Rv]'],
 
169
    'Extra' => ['String','gi|1621261|emb|CAB02640.1|[1621261]'],
 
170
    'Gi' => ['Integer','1621261'],
 
171
    'CreateDate' => ['String','2003/11/21'],
 
172
    'UpdateDate' => ['String','2005/04/17'],
 
173
    'Flags' => ['Integer',''],
 
174
    'TaxId' => ['Integer','83332'],
 
175
    'Length' => ['Integer','193'],
 
176
    'Status' => ['String','live'],
 
177
    'ReplacedBy' => ['String',''],
 
178
    'Comment' => ['String',''], },
 
179
    20807972 => {'Caption' => ['String','NP_623143'],
 
180
    'Title' => ['String','pyrimidine regulatory protein PyrR '.
 
181
     '[Thermoanaerobacter tengcongensis MB4]'],
 
182
    'Extra' => ['String','gi|20807972|ref|NP_623143.1|[20807972]'],
 
183
    'Gi' => ['Integer','20807972'],
 
184
    'CreateDate' => ['String','2002/05/09'],
 
185
    'UpdateDate' => ['String','2005/12/03'],
 
186
    'Flags' => ['Integer','512'],
 
187
    'TaxId' => ['Integer','273068'],
 
188
    'Length' => ['Integer','178'],
 
189
    'Status' => ['String','live'],
 
190
    'ReplacedBy' => ['String',''],
 
191
    'Comment' => ['String',''], },
 
192
    68536103 => {'Caption' => ['String','YP_250808'],
 
193
    'Title' => ['String','putative pyrimidine operon regulatory protein '.
 
194
     '[Corynebacterium jeikeium K411]'],
 
195
    'Extra' => ['String','gi|68536103|ref|YP_250808.1|[68536103]'],
 
196
    'Gi' => ['Integer','68536103'],
 
197
    'CreateDate' => ['String','2005/07/04'],
 
198
    'UpdateDate' => ['String','2006/03/30'],
 
199
    'Flags' => ['Integer','512'],
 
200
    'TaxId' => ['Integer','306537'],
 
201
    'Length' => ['Integer','195'],
 
202
    'Status' => ['String','live'],
 
203
    'ReplacedBy' => ['String',''],
 
204
    'Comment' => ['String',''], },
 
205
    730439 => {'Caption' => ['String','P41007'],
 
206
    'Title' => ['String','PyrR bifunctional protein '.
 
207
     '[Includes: Pyrimidine operon regulatory protein; '.
 
208
     'Uracil phosphoribosyltransferase (UPRTase)]'],
 
209
    'Extra' => ['String','gi|730439|sp|P41007|PYRR_BACCL[730439]'],
 
210
    'Gi' => ['Integer','730439'],
 
211
    'CreateDate' => ['String','1995/02/01'],
 
212
    'UpdateDate' => ['String','2006/07/25'],
 
213
    'Flags' => ['Integer',''],
 
214
    'TaxId' => ['Integer','1394'],
 
215
    'Length' => ['Integer','179'],
 
216
    'Status' => ['String','live'],
 
217
    'ReplacedBy' => ['String',''],
 
218
    'Comment' => ['String',''] },
 
219
    89318838 => { 'Caption' => ['String','EAS10332'],
 
220
    'Title' => ['String','Phosphoribosyltransferase '.
 
221
     '[Mycobacterium gilvum PYR-GCK]'],
 
222
    'Extra' => ['String','gi|89318838|gb|EAS10332.1|[89318838]'],
 
223
    'Gi' => ['Integer','89318838'],
 
224
    'CreateDate' => ['String','2006/03/09'],
 
225
    'UpdateDate' => ['String','2006/03/09'],
 
226
    'Flags' => ['Integer',''],
 
227
    'TaxId' => ['Integer','350054'],
 
228
    'Length' => ['Integer','193'],
 
229
    'Status' => ['String','live'],
 
230
    'ReplacedBy' => ['String',''],
 
231
    'Comment' => ['String',''] } );
 
232
    SKIP: {
 
233
        $eutil = Bio::DB::EUtilities->new(
 
234
                                         -eutil      => 'esummary',
 
235
                                         -db         => 'protein',
 
236
                                         -id            => \@ids,
 
237
                                           );
 
238
        isa_ok($eutil, 'Bio::DB::GenericWebAgent');
 
239
        
 
240
        eval {$response = $eutil->get_Response; };
 
241
        skip("ESummary HTTP error:$@", 253) if $@;
 
242
        isa_ok($response, 'HTTP::Response');
 
243
        
 
244
        my @docs = $eutil->get_DocSums();
 
245
        is(scalar(@docs), 5, '$esum->get_DocSums()');
 
246
        
 
247
        my $ct = 0;
 
248
        while (my $ds = $eutil->next_DocSum) {
 
249
            isa_ok($ds, 'Bio::Tools::EUtilities::Summary::DocSum');
 
250
            
 
251
            my $id = $ds->get_id();
 
252
            ok(exists($docsum{$id}), '$docsum->get_id()');
 
253
            
 
254
            my %items = %{ $docsum{$id} };
 
255
            
 
256
            # iterate using item names
 
257
            
 
258
            for my $name ($ds->get_all_names()) {
 
259
                $ct++;
 
260
                my ($it) = $ds->get_Items_by_name($name);
 
261
                ok(exists $items{$name},'DocSum Name exists');
 
262
                is($it->get_name, $name, 'get_name(),DocSum Name');
 
263
                is($ds->get_type_by_name($name), $items{$name}->[0],
 
264
                   'get_type_by_name() from DocSum');
 
265
                is($it->get_type, $items{$name}->[0], 'get_type() from Item');
 
266
            }
 
267
        }
 
268
        is($ct, 60);
 
269
    }
 
270
}
 
271
 
 
272
# ESearch, ESearch History
 
273
 
 
274
sub esearch {
 
275
    SKIP: {
 
276
        $eutil = Bio::DB::EUtilities->new(
 
277
                                        -eutil      => 'esearch',
 
278
                                        -db         => 'protein',
 
279
                                        -term       => $term,
 
280
                                        -retmax     => 100
 
281
                                          );
 
282
              
 
283
        isa_ok($eutil, 'Bio::DB::GenericWebAgent');
 
284
        eval {$response = $eutil->get_Response; };
 
285
        skip("ESearch HTTP error:$@", 12) if $@;
 
286
        isa_ok($response, 'HTTP::Response');
 
287
        
 
288
        # can't really check for specific ID's but can check total ID's returned
 
289
        my @esearch_ids = $eutil->get_ids;
 
290
        is(scalar(@esearch_ids), 100, '$esearch->get_ids()');
 
291
        
 
292
        cmp_ok($eutil->get_count, '>', 117, '$esearch->get_count()');
 
293
    
 
294
        # usehistory
 
295
        $eutil = Bio::DB::EUtilities->new(
 
296
                                        -eutil      => 'esearch',
 
297
                                        -db         => 'protein',
 
298
                                        -usehistory => 'y',
 
299
                                        -term       => $term,
 
300
                                        -retmax     => 100                                        
 
301
                                          );
 
302
        
 
303
        eval {$response = $eutil->get_Response; };
 
304
        skip("ESearch HTTP error:$@", 9) if $@;
 
305
        is($eutil->eutil, 'esearch', 'eutil()');
 
306
        is($eutil->get_database, 'protein', 'get_database()');
 
307
        cmp_ok($eutil->get_count, '>', 117, 'get_count()');
 
308
        is($eutil->get_term, $term, 'get_term()');
 
309
        is($eutil->get_ids, 100, 'History->get_ids()');
 
310
        
 
311
        my $history = $eutil->next_History;
 
312
        isa_ok($history, 'Bio::Tools::EUtilities::HistoryI');
 
313
        
 
314
        # check the actual data
 
315
        my ($webenv, $key) = $history->history;
 
316
        like($webenv, qr{^\S{50}}, 'WebEnv');
 
317
        like($key, qr{^\d+}, 'query key');
 
318
        
 
319
        # can we fetch the sequences?
 
320
        $eutil->set_parameters(
 
321
            -eutil      => 'efetch',
 
322
            -history    => $history,
 
323
            -rettype    => 'fasta',
 
324
            -retmax     => 5
 
325
        );
 
326
        # look for fasta headers
 
327
        my ($r, $t);
 
328
        eval{ $r = $eutil->get_Response->content;};
 
329
        skip("EPost HTTP error", 1) if $@;
 
330
        $t = grep m{^>.*$}, split("\n", $r);
 
331
        is($t, 5, 'EPost to EFetch');
 
332
    }
 
333
}
 
334
 
 
335
# EInfo
 
336
 
 
337
sub einfo {
 
338
    SKIP: {
 
339
        $eutil = Bio::DB::EUtilities->new(
 
340
                                        -eutil      => 'einfo',
 
341
                                        -db         => 'protein',
 
342
                                          );
 
343
        isa_ok($eutil, 'Bio::DB::GenericWebAgent');
 
344
        eval {$response = $eutil->get_Response; };
 
345
        skip("EInfo HTTP error:$@", 10) if $@;
 
346
        isa_ok($response, 'HTTP::Response');
 
347
        like($response->content, qr(<eInfoResult>), 'EInfo response');
 
348
        is(($eutil->get_database)[0], 'protein', '$einfo->get_database()');
 
349
        like($eutil->get_last_update, qr(\d{4}\/\d{2}\/\d{2}\s\d{2}:\d{2}),
 
350
             '$einfo->get_last_update()');
 
351
        cmp_ok($eutil->get_record_count, '>', 9200000, '$einfo->get_record_count()');
 
352
        is($eutil->get_description, 'Protein sequence record', '$einfo->get_description()');
 
353
        my @links = $eutil->get_LinkInfo;
 
354
        my @fields = $eutil->get_FieldInfo;
 
355
        cmp_ok(scalar(@links), '>',30, '$einfo->get_LinkInfo()');
 
356
        cmp_ok(scalar(@fields), '>',24, '$einfo->get_FieldInfo()');
 
357
    
 
358
        # all databases (list)
 
359
        $eutil = Bio::DB::EUtilities->new(
 
360
                                        -eutil      => 'einfo',
 
361
                                          );
 
362
        
 
363
        eval {$response = $eutil->get_Response; };
 
364
        skip("EInfo HTTP error:$@", 1) if $@;
 
365
        
 
366
        my @db = sort qw(pubmed  protein  nucleotide  nuccore  nucgss  nucest  structure
 
367
        genome  books  cancerchromosomes  cdd  domains  gene  genomeprj  gensat
 
368
        geo  gds  homologene  journals  mesh  ncbisearch  nlmcatalog  omia  omim
 
369
        pmc  popset  probe  pcassay  pccompound  pcsubstance  snp  taxonomy toolkit
 
370
        unigene  unists);
 
371
        
 
372
        my @einfo_dbs = sort $eutil->get_databases;
 
373
        cmp_ok(scalar(@einfo_dbs), '>=', scalar(@db), 'All EInfo databases');
 
374
    }
 
375
}
 
376
 
 
377
 
 
378
# ELink - normal (single ID array) - single db - ElinkData tests
 
379
 
 
380
sub elink1 {
 
381
    SKIP: {
 
382
        $eutil = Bio::DB::EUtilities->new(
 
383
                                        -eutil      => 'elink',
 
384
                                        -db         => 'taxonomy',
 
385
                                        -dbfrom     => 'protein',
 
386
                                        -id         => \@ids,
 
387
                                          );
 
388
              
 
389
        isa_ok($eutil, 'Bio::DB::GenericWebAgent');
 
390
        eval {$response = $eutil->get_Response; };
 
391
        skip("ELink HTTP error:$@", 7) if $@;
 
392
        isa_ok($response, 'HTTP::Response');
 
393
        like($response->content, qr(<eLinkResult>), 'ELink response');
 
394
        # Data is too volatile to test; commenting for now...
 
395
        #my @ids2 = qw(350054 306537 273068 83332 1394);
 
396
        cmp_ok($eutil->get_ids, '>=', 4);
 
397
        #is_deeply([sort $eutil->get_ids], [sort @ids2],'$elink->get_ids()');
 
398
        
 
399
        # Linkset tests
 
400
        is($eutil->get_LinkSets, 1, '$elink->get_LinkSets()');
 
401
        my $linkobj = $eutil->next_LinkSet;
 
402
        isa_ok($linkobj, 'Bio::Tools::EUtilities::Link::LinkSet');
 
403
        is($linkobj->get_dbfrom, 'protein', '$linkdata->get_dbfrom()');
 
404
        #is_deeply([sort $linkobj->elink_queryids],
 
405
        #          [sort @ids], '$linkdata->elink_queryids()');
 
406
        my $db = $linkobj->get_dbto;
 
407
        is($db, 'taxonomy', '$linkdata->get_dbto()');
 
408
        #is_deeply([sort $linkobj->get_LinkIds_by_db($db)],
 
409
        #          [sort @ids2], '$linkdata->get_LinkIds_by_db($db)');   
 
410
    }
 
411
}
 
412
 
 
413
sub egquery {
 
414
    SKIP: {
 
415
    $eutil = Bio::DB::EUtilities->new(
 
416
                                    -eutil      => 'egquery',
 
417
                                    -term       => $term,
 
418
                                      );
 
419
          
 
420
    isa_ok($eutil, 'Bio::DB::GenericWebAgent');
 
421
    eval {$response = $eutil->get_Response; };
 
422
    skip("EGQuery HTTP error:$@", 3) if $@;
 
423
    isa_ok($response, 'HTTP::Response');
 
424
    like($response->content, qr(<eGQueryResult>), 'EGQuery response');
 
425
    my @gq = $eutil->get_GlobalQueries;
 
426
    cmp_ok(scalar(@gq), '>=', 30, 'get_GlobalQueries')
 
427
    }
 
428
}
 
429
 
 
430
1;