t/RemoteDB/EUtilities.t

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