t/RemoteDB/EUtilities/EUtilities.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3 #
   4 # Note this uses Test::More; this should catch the few perl versions w/o
   5 # this test suite
   6
   7 use strict;
   8 our $NUMTESTS;
   9 our $DEBUG;
  10 our %EUTILS;
  11
  12 BEGIN {
  13     $NUMTESTS = 3;
  14
  15     # I have set up eutils tests to run in sections for easier test maintenance
  16     # and keeping track of problematic tests. The below hash is the list of
  17     # tests, with test number and coderef.
  18
  19     %EUTILS = (
  20         #'efetch'        => {'tests' => 5,
  21         #                    'sub'   => \&efetch},
  22         #'epost'         => {'tests' => 13,
  23         #                    'sub'   => \&epost},
  24         #'esummary'      => {'tests' => 254,
  25         #                    'sub'   => \&esummary},
  26         #'esearch'       => {'tests' => 15,
  27         #                    'sub'   => \&esearch},
  28         #'einfo'         => {'tests' => 10,
  29         #                    'sub'   => \&einfo},
  30         #'elink1'        => {'tests' => 9,
  31         #                    'sub'   => \&elink1},
  32         #'egquery'       => {'tests' => 3,
  33         #                    'sub'   => \&egquery},
  34
  35         # The following tests either fail sporadically due to unknown client- or
  36         # server-side issues, contain volatile data, or are still being worked
  37         # on; uncomment to test
  38
  39         #'elink2'        => {'tests' => 18,
  40         #                    'sub'   => \&elink2},
  41         #'elink3'        => {'tests' => 28,
  42         #                    'sub'   => \&elink3},
  43         #'elink4'        => {'tests' => 28,
  44         #                    'sub'   => \&elink4},
  45         #'multilink1'    => {'tests' => 40,
  46         #                    'sub'   => \&multilink1},
  47         #'multilink2'    => {'tests' => 49,
  48         #                    'sub'   => \&multilink2},
  49         #'multilink3'    => {'tests' => 0,
  50         #                    'sub'   => \&multilink3},
  51         #'scores'        => {'tests' => 0,
  52         #                    'sub'   => \&scores},
  53         );
  54     $NUMTESTS += $EUTILS{$_}->{'tests'} for (keys %EUTILS);
  55     $DEBUG = $ENV{'BIOPERLDEBUG'} || 0;
  56     # this seems to work for perl 5.6 and perl 5.8
  57     eval {require Test::More;};
  58
  59     if ($@) {
  60         use lib '.';
  61     }
  62
  63     use Test::More;
  64         use Bio::Root::Test;
  65
  66         test_begin(-tests               => $NUMTESTS,
  67                            -requires_modules    => [qw(XML::Simple LWP::UserAgent)],
  68                            -requires_networking => 1,
  69                           );
  70
  71     use_ok('Bio::DB::EUtilities');
  72     use_ok('LWP::UserAgent');
  73     use_ok('XML::Simple');
  74 }
  75
  76 # NOTE : Bio::DB::EUtilities is just a specialized pipeline to get any
  77 # data available via NCBI's Entrez interface, with a few convenience methods
  78 # to get UIDs and other additional information.  All data returned
  79 # using EFetch is raw (not Bioperl objects) and is meant to be piped into
  80 # other Bioperl modules at a later point for further processing
  81
  82 #   protein acc
  83 my @acc = qw(MUSIGHBA1 P18584 CH402638);
  84
  85 # protein GI
  86 my @ids = sort qw(1621261 89318838 68536103 20807972 730439);
  87
  88 # test search term
  89 my $term = 'dihydroorotase AND human';
  90
  91 my ($eutil, $response);
  92
  93 my %dbs = (taxonomy => 1,
  94            nucleotide => 1,
  95            pubmed => 1);
  96 my %links = (protein_taxonomy => 1,
  97              protein_nucleotide => 1,
  98              protein_nucleotide_wgs => 1,
  99              protein_pubmed => 1,
 100              protein_pubmed_refseq => 1
 101              );
 102
 103 # this loops through the required tests, only running what is in %EUTILS
 104 for my $test (keys %EUTILS) {
 105     $EUTILS{$test}->{'sub'}->();
 106 }
 107
 108 # Simple EFetch
 109
 110 sub efetch {
 111     SKIP: {
 112         $eutil = Bio::DB::EUtilities->new(
 113                                         -db         => 'protein',
 114                                         -id         => [$ids[0]],
 115                                         -rettype    => 'fasta'
 116                                           );
 117
 118         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 119         eval {$response = $eutil->get_response; };
 120         skip("EFetch HTTP error: $@", 4) if $@;
 121         isa_ok($response, 'HTTP::Response');
 122         my $content = $response->content;
 123         like($content, qr(PYRR \[Mycobacterium tuberculosis H37Rv\]),
 124              'EFetch: Fasta format');
 125
 126         # reuse the EUtilities webagent
 127         $eutil->parameter_base->id([$ids[1]]);
 128         $eutil->parameter_base->rettype('gb');
 129         eval {$response = $eutil->get_response; };
 130         skip("EFetch HTTP error: $@", 2) if $@;
 131         isa_ok($response, 'HTTP::Response');
 132         $content = $response->content;
 133         like($content, qr(^LOCUS\s+NP_623143),'EFetch: GenBank format');
 134     }
 135 }
 136
 137 # EPost->EFetch with History (Cookie)
 138
 139 sub epost {
 140     SKIP: {
 141         $eutil = Bio::DB::EUtilities->new(
 142                                         -eutil      => 'epost',
 143                                         -db         => 'protein',
 144                                         -id         => \@ids,
 145                                           );
 146
 147         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 148         eval {$response = $eutil->get_response; };
 149         skip("EPost HTTP error", 12) if $@;
 150         isa_ok($response, 'HTTP::Response');
 151         my $cookie = $eutil->next_cookie;
 152         isa_ok($cookie, 'Bio::DB::EUtilities::Cookie');
 153
 154         # set for epost, esearch, elink
 155         is($cookie->eutil, 'epost', '$epost->cookie->eutil()');
 156         is($cookie->database, 'protein', '$epost->cookie->database()');
 157
 158         # these are not set using epost
 159         is($cookie->elink_dbfrom, undef, '$epost->cookie->elink_dbfrom()');
 160         is($cookie->esearch_total, undef, '$epost->cookie->esearch_total()');
 161         is($cookie->esearch_query, undef, '$epost->cookie->esearch_query()');
 162         is($cookie->elink_queryids, undef, '$epost->cookie->elink_queryids()');
 163         is($cookie->elink_linkname, undef, '$epost->cookie->elink_linkname()');
 164
 165         # check the actual cookie
 166         my ($webenv, $key) = @{ $cookie->cookie };
 167         like($webenv, qr{^\S{50}}, '$epost->cookie->cookie() WebEnv');
 168         like($key, qr{^\d+}, '$epost->cookie->cookie() query key');
 169
 170         # can we fetch the sequences using the cookie
 171         my $efetch = Bio::DB::EUtilities->new(
 172                                     -cookie     => $cookie,
 173                                     -rettype    => 'fasta'
 174                                       );
 175         # look for fasta headers
 176         my $total;
 177         eval{ $total = grep(m{^>.*$}, split "\n", $efetch->get_response->content);};
 178         skip("EPost HTTP error", 1) if $@;
 179         is($total, 5, 'EPost to EFetch');
 180     }
 181 }
 182
 183 # ESummary
 184
 185 sub esummary {
 186     my %docsum = (1621261=> { 'Caption' => ['String','CAB02640'],
 187     'Title' => ['String','PROBABLE PYRIMIDINE OPERON REGULATORY PROTEIN PYRR '.
 188      '[Mycobacterium tuberculosis H37Rv]'],
 189     'Extra' => ['String','gi|1621261|emb|CAB02640.1|[1621261]'],
 190     'Gi' => ['Integer','1621261'],
 191     'CreateDate' => ['String','2003/11/21'],
 192     'UpdateDate' => ['String','2005/04/17'],
 193     'Flags' => ['Integer',''],
 194     'TaxId' => ['Integer','83332'],
 195     'Length' => ['Integer','193'],
 196     'Status' => ['String','live'],
 197     'ReplacedBy' => ['String',''],
 198     'Comment' => ['String',''], },
 199     20807972 => {'Caption' => ['String','NP_623143'],
 200     'Title' => ['String','pyrimidine regulatory protein PyrR '.
 201      '[Thermoanaerobacter tengcongensis MB4]'],
 202     'Extra' => ['String','gi|20807972|ref|NP_623143.1|[20807972]'],
 203     'Gi' => ['Integer','20807972'],
 204     'CreateDate' => ['String','2002/05/09'],
 205     'UpdateDate' => ['String','2005/12/03'],
 206     'Flags' => ['Integer','512'],
 207     'TaxId' => ['Integer','273068'],
 208     'Length' => ['Integer','178'],
 209     'Status' => ['String','live'],
 210     'ReplacedBy' => ['String',''],
 211     'Comment' => ['String',''], },
 212     68536103 => {'Caption' => ['String','YP_250808'],
 213     'Title' => ['String','putative pyrimidine operon regulatory protein '.
 214      '[Corynebacterium jeikeium K411]'],
 215     'Extra' => ['String','gi|68536103|ref|YP_250808.1|[68536103]'],
 216     'Gi' => ['Integer','68536103'],
 217     'CreateDate' => ['String','2005/07/04'],
 218     'UpdateDate' => ['String','2006/03/30'],
 219     'Flags' => ['Integer','512'],
 220     'TaxId' => ['Integer','306537'],
 221     'Length' => ['Integer','195'],
 222     'Status' => ['String','live'],
 223     'ReplacedBy' => ['String',''],
 224     'Comment' => ['String',''], },
 225     730439 => {'Caption' => ['String','P41007'],
 226     'Title' => ['String','PyrR bifunctional protein '.
 227      '[Includes: Pyrimidine operon regulatory protein; '.
 228      'Uracil phosphoribosyltransferase (UPRTase)]'],
 229     'Extra' => ['String','gi|730439|sp|P41007|PYRR_BACCL[730439]'],
 230     'Gi' => ['Integer','730439'],
 231     'CreateDate' => ['String','1995/02/01'],
 232     'UpdateDate' => ['String','2006/07/25'],
 233     'Flags' => ['Integer',''],
 234     'TaxId' => ['Integer','1394'],
 235     'Length' => ['Integer','179'],
 236     'Status' => ['String','live'],
 237     'ReplacedBy' => ['String',''],
 238     'Comment' => ['String',''] },
 239     89318838 => { 'Caption' => ['String','EAS10332'],
 240     'Title' => ['String','Phosphoribosyltransferase '.
 241      '[Mycobacterium gilvum PYR-GCK]'],
 242     'Extra' => ['String','gi|89318838|gb|EAS10332.1|[89318838]'],
 243     'Gi' => ['Integer','89318838'],
 244     'CreateDate' => ['String','2006/03/09'],
 245     'UpdateDate' => ['String','2006/03/09'],
 246     'Flags' => ['Integer',''],
 247     'TaxId' => ['Integer','350054'],
 248     'Length' => ['Integer','193'],
 249     'Status' => ['String','live'],
 250     'ReplacedBy' => ['String',''],
 251     'Comment' => ['String',''] } );
 252     SKIP: {
 253         $eutil = Bio::DB::EUtilities->new(
 254                                          -eutil      => 'esummary',
 255                                          -db         => 'protein',
 256                                          -id            => \@ids,
 257                                            );
 258         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 259
 260         eval {$response = $eutil->get_response; };
 261         skip("ESummary HTTP error:$@", 253) if $@;
 262         isa_ok($response, 'HTTP::Response');
 263
 264         my @docs = $eutil->get_all_docsums();
 265         is(scalar(@docs), 5, '$esum->get_all_docsums()');
 266
 267         my $ct = 0;
 268         while (my $ds = $eutil->next_docsum) {
 269             isa_ok($ds, 'Bio::DB::EUtilities::DocSum');
 270
 271             my $id = $ds->esummary_id();
 272             ok(exists($docsum{$id}), '$docsum->esummary_id()');
 273
 274             my %items = %{ $docsum{$id} };
 275
 276             # iterate using item names
 277
 278             for my $name ($ds->get_all_names()) {
 279                 $ct++;
 280                 my %data = $ds->get_item_by_name($name);
 281                 ok(exists $items{$name},'DocSum Name exists');
 282                 is($data{Name}, $name, 'get_item_by_name(),DocSum Name');
 283                 is($ds->get_Type_by_name($name), $items{$name}->[0],
 284                    'get_Type_by_name()');
 285                 is($data{Type}, $items{$name}->[0], 'get_item_by_name(),DocSum Type');
 286             }
 287         }
 288         is($ct, 60);
 289     }
 290 }
 291
 292 # ESearch, ESearch History
 293
 294 sub esearch {
 295     SKIP: {
 296         $eutil = Bio::DB::EUtilities->new(
 297                                         -eutil      => 'esearch',
 298                                         -db         => 'protein',
 299                                         -term       => $term,
 300                                         -retmax     => 100
 301                                           );
 302
 303         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 304         eval {$response = $eutil->get_response; };
 305         skip("ESearch HTTP error:$@", 3) if $@;
 306         isa_ok($response, 'HTTP::Response');
 307
 308         # can't really check for specific ID's but can check total ID's returned
 309         my @esearch_ids = $eutil->get_ids;
 310         is(scalar(@esearch_ids), 100, '$esearch->get_ids()');
 311
 312         cmp_ok($eutil->esearch_count, '>', 117, '$esearch->esearch_count()');
 313
 314         # usehistory (get a cookie)
 315         $eutil = Bio::DB::EUtilities->new(
 316                                         -eutil      => 'esearch',
 317                                         -db         => 'protein',
 318                                         -usehistory => 'y',
 319                                         -term       => $term,
 320                                           );
 321
 322         eval {$response = $eutil->get_response; };
 323         skip("ESearch HTTP error:$@", 11) if $@;
 324         my $cookie = $eutil->next_cookie;
 325         isa_ok($cookie, 'Bio::DB::EUtilities::Cookie');
 326         is($cookie->eutil, 'esearch', '$esearch->cookie->eutil()');
 327         is($cookie->database, 'protein', '$esearch->cookie->database()');
 328         cmp_ok($cookie->esearch_total, '>', 117, '$esearch->cookie->esearch_total()');
 329         is($cookie->esearch_query, $term, '$esearch->cookie->esearch_query()');
 330
 331         # these are not set using esearch
 332         is($cookie->elink_dbfrom, undef, '$esearch->cookie->elink_dbfrom()');
 333         is($cookie->elink_queryids, undef, '$esearch->cookie->elink_queryids()');
 334         is($cookie->elink_linkname, undef, '$esearch->cookie->elink_linkname()');
 335
 336         # check the actual cookie
 337         my ($webenv, $key) = @{ $cookie->cookie };
 338         like($webenv, qr{^\S{50}}, '$esearch->cookie->cookie() WebEnv');
 339         like($key, qr{^\d+}, '$esearch->cookie->cookie() query key');
 340
 341         # can we fetch the sequences using the cookie?
 342         my $efetch = Bio::DB::EUtilities->new(
 343                                     -cookie     => $cookie,
 344                                     -rettype    => 'fasta',
 345                                     -retmax     => 5
 346                                       );
 347         # look for the fasta headers
 348         my $total = grep(m{^>.*$}, split "\n", $efetch->get_response->content);
 349         is($total, 5, 'ESearch to EFetch');
 350     }
 351 }
 352
 353 # EInfo
 354
 355 sub einfo {
 356     SKIP: {
 357         $eutil = Bio::DB::EUtilities->new(
 358                                         -eutil      => 'einfo',
 359                                         -db         => 'protein',
 360                                           );
 361         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 362         eval {$response = $eutil->get_response; };
 363         skip("EInfo HTTP error:$@", 10) if $@;
 364         isa_ok($response, 'HTTP::Response');
 365         like($response->content, qr(<eInfoResult>), 'EInfo response');
 366         is($eutil->einfo_dbs->[0], 'protein', '$einfo->einfo_dbs()');
 367         like($eutil->einfo_db_lastupdate, qr(\d{4}\/\d{2}\/\d{2}\s\d{2}:\d{2}),
 368              '$einfo->einfo_db_lastupdate()');
 369         cmp_ok($eutil->einfo_db_count, '>', 9200000, '$einfo->einfo_db_count()');
 370         is($eutil->einfo_db_desc, 'Protein sequence record', '$einfo->einfo_db_desc()');
 371         my @links = $eutil->einfo_dblink_info;
 372         my @fields = $eutil->einfo_dbfield_info;
 373         cmp_ok(scalar(@links), '>',30, '$einfo->einfo_dblink_info()');
 374         cmp_ok(scalar(@fields), '>',24, '$einfo->einfo_dbfield_info()');
 375
 376         # all databases (list)
 377         $eutil = Bio::DB::EUtilities->new(
 378                                         -eutil      => 'einfo',
 379                                           );
 380
 381         eval {$response = $eutil->get_response; };
 382         skip("EInfo HTTP error:$@", 1) if $@;
 383
 384         my @db = sort qw(pubmed  protein  nucleotide  nuccore  nucgss  nucest  structure
 385         genome  books  cancerchromosomes  cdd  domains  gene  genomeprj  gensat
 386         geo  gds  homologene  journals  mesh  ncbisearch  nlmcatalog  omia  omim
 387         pmc  popset  probe  pcassay  pccompound  pcsubstance  snp  taxonomy toolkit
 388         unigene  unists);
 389
 390         my @einfo_dbs = sort $eutil->einfo_dbs;
 391         cmp_ok(scalar(@einfo_dbs), '>=', scalar(@db), 'All EInfo databases');
 392     }
 393 }
 394
 395
 396 # ELink - normal (single ID array) - single db - ElinkData tests
 397
 398 sub elink1 {
 399     SKIP: {
 400         $eutil = Bio::DB::EUtilities->new(
 401                                         -eutil      => 'elink',
 402                                         -db         => 'taxonomy',
 403                                         -dbfrom     => 'protein',
 404                                         -id         => \@ids,
 405                                           );
 406
 407         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 408         eval {$response = $eutil->get_response; };
 409         skip("ELink HTTP error:$@", 8) if $@;
 410         isa_ok($response, 'HTTP::Response');
 411         like($response->content, qr(<eLinkResult>), 'ELink response');
 412         # Data is too volatile to test; commenting for now...
 413         #my @ids2 = qw(350054 306537 273068 83332 1394);
 414         cmp_ok(@{$eutil->get_ids}, '>=', 4);
 415         #is_deeply([sort $eutil->get_ids], [sort @ids2],'$elink->get_ids()');
 416
 417         # Linkset tests
 418         is($eutil->get_linkset_count, 1, '$elink->get_linkset_count()');
 419         my $linkobj = $eutil->next_linkset;
 420         isa_ok($linkobj, 'Bio::DB::EUtilities::ElinkData');
 421         is($linkobj->elink_dbfrom, 'protein', '$linkdata->elink_dbfrom()');
 422         #is_deeply([sort $linkobj->elink_queryids],
 423         #          [sort @ids], '$linkdata->elink_queryids()');
 424         is($linkobj->elink_command, 'neighbor', '$linkdata->elink_command()');
 425         my $db = $linkobj->next_linkdb;
 426         is($db, 'taxonomy', '$linkdata->next_linkdb()');
 427         #is_deeply([sort $linkobj->get_LinkIds_by_db($db)],
 428         #          [sort @ids2], '$linkdata->get_LinkIds_by_db($db)');
 429     }
 430 }
 431
 432 # ELink - normal (single ID array), multiple dbs
 433
 434 sub elink2 {
 435     SKIP: {
 436         # can use 'all' for db, but takes a long time; use named dbs instead
 437         $eutil = Bio::DB::EUtilities->new(
 438                                         -eutil      => 'elink',
 439                                         -db         => 'taxonomy,nucleotide,pubmed',
 440                                         -dbfrom     => 'protein',
 441                                         -id         => \@ids,
 442                                           );
 443
 444         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 445         eval {$response = $eutil->get_response; };
 446         skip("ELink HTTP error:$@", 17) if $@;
 447         isa_ok($response, 'HTTP::Response');
 448         like($response->content, qr(<eLinkResult>), 'ELink response');;
 449
 450         # This is designed to fail; grabbing IDs w/o knowing which DB
 451         # they belong to in a multiple DB search is fatal
 452         my @ids2;
 453         eval {@ids2 = $eutil->get_ids;};
 454         ok($@,'$elink->get_ids()');
 455
 456         # Must grab the linkset first...
 457         is($eutil->get_linkset_count, 1, '$elink->get_linkset_count()');
 458         my $linkobj = $eutil->next_linkset;
 459         isa_ok($linkobj, 'Bio::DB::EUtilities::ElinkData');
 460
 461         # then iterate through each database, grabbing the IDs for each database
 462         my %ids = (
 463                 'taxonomy' => [sort qw(350054 306537 273068 83332 1394)],
 464                 'nucleotide' => [sort qw(89318678 68535062 38490250 20806542)],
 465                 'pubmed' => [sort qw(15968079 12368430 11997336 9634230 8206848)],
 466                );
 467
 468         my $ct = 4;
 469         # tests per iteration
 470         my $ti = 2;
 471         while (my $db = $linkobj->next_linkdb) {
 472             ok(exists $ids{$db}, "ElinkData database: $db");
 473             @ids2 = sort $linkobj->get_LinkIds_by_db($db);
 474             is_deeply($ids{$db}, \@ids2, "ElinkData database IDs: $db");
 475         }
 476         is($ct, 0);
 477         # other ElinkData methods
 478         is($linkobj->elink_dbfrom, 'protein', '$linkdata->elink_dbfrom()');
 479         is_deeply([sort $linkobj->elink_queryids],
 480                   [sort @ids], '$linkdata->elink_queryids()');
 481         is($linkobj->elink_command, 'neighbor', '$linkdata->elink_command()');
 482         skip('No elink data: possible server problem',$ct*$ti);
 483     }
 484 }
 485
 486 # ELink - normal (single ID array), multiple dbs, cookies)
 487
 488 sub elink3 {
 489     SKIP: {
 490         # can use 'all' for db, but takes a long time; use named dbs instead
 491         # this retrieves cookies instead (no ElinkData objects are stored)
 492         $eutil = Bio::DB::EUtilities->new(
 493                                         -eutil      => 'elink',
 494                                         -db         => 'taxonomy,nucleotide,pubmed',
 495                                         -dbfrom     => 'protein',
 496                                         -id         => \@ids,
 497                                         -cmd        => 'neighbor_history',
 498                                           );
 499         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 500         eval {$response = $eutil->get_response; };
 501         skip("ELink HTTP error", 27) if $@;
 502         isa_ok($response, 'HTTP::Response');
 503         like($response->content, qr(<eLinkResult>), 'ELink response');;
 504
 505         # This is designed to fail; grabbing IDs w/o knowing which DB
 506         # they belong to in a multiple DB search is fatal
 507         my @ids2;
 508         eval {@ids2 = $eutil->get_ids;};
 509         ok($@,'$elink->get_ids()');
 510
 511         # No ElinkData objs
 512         is($eutil->get_linkset_count, 0, '$elink->get_linkset_count()');
 513
 514         # There are ELink cookies instead
 515         is($eutil->get_cookie_count, 5, '$elink->get_cookie_count()');
 516         my $ct = 2;
 517         my $content;
 518
 519         # tests per iteration
 520         my $ti = 10;
 521         while (my $cookie = $eutil->next_cookie) {
 522             isa_ok($cookie, 'Bio::DB::EUtilities::Cookie');
 523             is($cookie->eutil, 'elink', '$elink->cookie->eutil()');
 524             ok(exists $dbs{$cookie->database},  '$elink->cookie->database()');
 525             is($cookie->elink_dbfrom, 'protein', '$elink->cookie->elink_dbfrom()');
 526             @ids2 = sort $cookie->elink_queryids;
 527             is_deeply(\@ids2, \@ids, '$elink->cookie->elink_queryids()');
 528             ok(exists $links{$cookie->elink_linkname}, '$elink->cookie->elink_linkname()');
 529
 530             # these are not set using elink
 531             is($cookie->esearch_query, undef, '$elink->cookie->esearch_query()');
 532             is($cookie->esearch_total, undef, '$elink->cookie->esearch_total()');
 533
 534             # check the actual cookie data
 535             my ($webenv, $key) = @{ $cookie->cookie };
 536             like($webenv, qr{^\S{50}}, '$elink->cookie->cookie() WebEnv');
 537             like($key, qr{^\d+}, '$elink->cookie->cookie() query key');
 538
 539             # can we retrieve the data via efetch?  Test one...
 540             # Note the cookie has all the information contained to
 541             # retrieve data; no additional parameters needed
 542             if($cookie->database eq 'taxonomy') {
 543                 my $efetch = Bio::DB::EUtilities->new(-cookie => $cookie);
 544                 $content = $efetch->get_response->content;
 545             }
 546             $ct--;
 547             last if $ct == 0;
 548         }
 549         like($content, qr(<TaxaSet>), 'ELink to EFetch : taxonomy');
 550         is($ct,0,'Cookie count');
 551         skip('No cookies returned; possible server problem',$ct*$ti);
 552     }
 553 }
 554
 555 # ELink (multi_id), single db
 556 # this is a flag set to get one-to-one correspondence for ELink data
 557
 558 sub elink4 {
 559     SKIP: {
 560         $eutil = Bio::DB::EUtilities->new(
 561                                         -eutil      => 'elink',
 562                                         -db         => 'taxonomy',
 563                                         -dbfrom     => 'protein',
 564                                         -multi_id   => 1,
 565                                         -id         => \@ids,
 566                                           );
 567
 568         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 569         eval {$response = $eutil->get_response; };
 570
 571         skip("ELink HTTP error", 27) if $@;
 572         isa_ok($response, 'HTTP::Response');
 573         like($response->content, qr(<eLinkResult>), 'ELink response');
 574         my @ids2 = qw(350054 306537 273068 83332 1394);
 575
 576         # This is designed to fail; IDs present in individual ElinkData objects
 577         # for one-to-one correspondence with ID groups
 578         eval{$eutil->get_ids;};
 579         ok($@,'$elink->get_ids()');
 580
 581         # Linkset tests
 582         is($eutil->get_linkset_count, 5, '$elink->get_linkset_count()');
 583         my @qids;
 584         my @retids;
 585         my $ct = 5;
 586         my $ti = 4;
 587         # ids may not be returned in same order as array, so need to grab and sort
 588         while ( my $linkobj = $eutil->next_linkset) {
 589             isa_ok($linkobj, 'Bio::DB::EUtilities::ElinkData');
 590             is($linkobj->elink_dbfrom, 'protein', '$linkdata->elink_dbfrom()');
 591             is($linkobj->elink_command, 'neighbor', '$linkdata->elink_command()');
 592             push @qids, $linkobj->elink_queryids;
 593             my $db = $linkobj->next_linkdb;
 594             is($db, 'taxonomy', '$linkdata->next_linkdb()');
 595             push @retids, $linkobj->get_LinkIds_by_db($db);
 596             $ct--;
 597             last if $ct == 0;
 598         }
 599         is($ct,0);
 600         is_deeply([sort @qids], [sort @ids], '$linkdata->elink_queryids()');
 601         is_deeply([sort @retids], [sort @ids2], '$linkdata->get_LinkIds_by_db($db)');
 602         skip('No Elink data returned; possible server problem',$ct*$ti);
 603     }
 604 }
 605
 606 # ELink (multi_id, cookies)
 607 # these need to be cleaned up
 608
 609 sub multilink1 {
 610     SKIP: {
 611         $eutil = Bio::DB::EUtilities->new(
 612                                         -eutil      => 'elink',
 613                                         -db         => 'taxonomy',
 614                                         -dbfrom     => 'protein',
 615                                         -multi_id   => 1,
 616                                         -id         => \@ids,
 617                                         -cmd        => 'neighbor_history',
 618                                         -verbose    => 2
 619                                           );
 620
 621         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 622         eval {$response = $eutil->get_response; };
 623
 624         # check this number, likely wrong
 625         skip("ELink HTTP error", 39) if $@;
 626         isa_ok($response, 'HTTP::Response');
 627         like($response->content, qr(<eLinkResult>), 'ELink response');
 628         my @ids2 = qw(350054 306537 273068 83332 1394);
 629
 630         # This is designed to fail; IDs present in individual ElinkData objects
 631         # for one-to-one correspondence with ID groups
 632         eval{$eutil->get_ids;};
 633         ok($@,'$elink->get_ids()');
 634
 635         # Linkset tests (there aren't any)
 636         is($eutil->get_linkset_count, 0, '$elink->get_linkset_count()');
 637         cmp_ok($eutil->get_cookie_count, '>=', 4, '$elink->get_cookie_count()');
 638
 639         my $efetch = Bio::DB::EUtilities->new();
 640         my $ct = 2;
 641         my $content;
 642         while (my $cookie = $eutil->next_cookie) {
 643             isa_ok($cookie, 'Bio::DB::EUtilities::Cookie');
 644             is($cookie->eutil, 'elink', '$elink->cookie->eutil()');
 645             is($cookie->database, 'taxonomy',  '$elink->cookie->database()');
 646             is($cookie->elink_dbfrom, 'protein', '$elink->cookie->elink_dbfrom()');
 647             @ids2 = $cookie->elink_queryids;
 648
 649             # should be single IDs, one per ElinkData obj
 650             is(scalar(@ids2), 1, '$elink->cookie->elink_queryids()');
 651             is($cookie->elink_linkname, 'protein_taxonomy',
 652                '$elink->cookie->elink_linkname()');
 653             # these are not set using elink
 654             is($cookie->esearch_query, undef, '$elink->cookie->esearch_query()');
 655             is($cookie->esearch_total, undef, '$elink->cookie->esearch_total()');
 656
 657             # check the actual cookie data
 658             my ($webenv, $key) = @{ $cookie->cookie };
 659             like($webenv, qr{^\S{50}}, '$elink->cookie->cookie() WebEnv');
 660             like($key, qr{^\d+}, '$elink->cookie->cookie() query key');
 661
 662             # can we retrieve the data via efetch?  Test one...
 663             # Note the cookie has all the information contained to
 664             # retrieve data; no additional parameters needed
 665
 666             if($cookie->database eq 'taxonomy') {
 667                 $efetch->add_cookie($cookie);
 668                 $content = $efetch->get_response->content;
 669                 like($content, qr(<TaxaSet>), 'ELink to EFetch : taxonomy');
 670             }
 671             last if $ct == 0;
 672             $ct--;
 673         }
 674         is($ct, 0);
 675     }
 676 }
 677
 678 # ELink (multi_id, multidbs)
 679
 680 sub multilink2 {
 681     SKIP: {
 682         $eutil = Bio::DB::EUtilities->new(
 683                                         -eutil      => 'elink',
 684                                         -db         => 'taxonomy,nucleotide,pubmed',
 685                                         -dbfrom     => 'protein',
 686                                         -multi_id   => 1,
 687                                         -id         => \@ids,
 688                                         -verbose    => 2
 689                                           );
 690
 691         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 692         eval {$response = $eutil->get_response; };
 693
 694         # check this number, likely wrong
 695         skip("ELink HTTP error", 20) if $@;
 696         isa_ok($response, 'HTTP::Response');
 697         like($response->content, qr(<eLinkResult>), 'ELink response');
 698         my @ids2 = qw(350054 306537 273068 83332 1394);
 699
 700         # This is designed to fail; IDs present in individual ElinkData objects
 701         # for one-to-one correspondence with ID groups
 702         eval{$eutil->get_ids;};
 703         ok($@,'$elink->get_ids()');
 704
 705         # Linkset tests (there aren't any)
 706         is($eutil->get_linkset_count, 5, '$elink->get_linkset_count()');
 707         is($eutil->get_cookie_count, 0, '$elink->get_cookie_count()');
 708
 709         # Linkset tests
 710         my $ct = 4;
 711
 712         while ( my $linkobj = $eutil->next_linkset) {
 713             isa_ok($linkobj, 'Bio::DB::EUtilities::ElinkData');
 714             is($linkobj->elink_dbfrom, 'protein', '$linkdata->elink_dbfrom()');
 715             is($linkobj->elink_command, 'neighbor', '$linkdata->elink_command()');
 716             my @dbs = $linkobj->get_all_linkdbs;
 717             cmp_ok(scalar(@dbs), '>=' , 2, '$linkobj->get_all_linkdbs()');
 718             while ( my $db = $linkobj->next_linkdb) {
 719                 is($dbs{$db}, 1, '$linkdata->next_linkdb()');
 720                 my @ids2 = $linkobj->get_LinkIds_by_db($db);
 721                 cmp_ok(scalar(@ids2), '>=', 1, '$linkdata->get_LinkIds_by_db($db)');
 722             }
 723             $ct--;
 724             last if $ct == 0;
 725         }
 726         is($ct, 0);
 727         skip();
 728     }
 729 }
 730
 731 # ELink (multi_id, multidb, cookies)
 732
 733 sub multilink3 {
 734     SKIP: {
 735         $eutil = Bio::DB::EUtilities->new(
 736                                         -eutil      => 'elink',
 737                                         -db         => 'taxonomy,nucleotide,pubmed',
 738                                         -dbfrom     => 'protein',
 739                                         -multi_id   => 1,
 740                                         -id         => \@ids,
 741                                         -cmd        => 'neighbor_history'
 742                                           );
 743
 744         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 745         eval {$response = $eutil->get_response; };
 746
 747         # check this number, likely wrong
 748         skip("ELink HTTP error:$@", 20) if $@;
 749         isa_ok($response, 'HTTP::Response');
 750         like($response->content, qr(<eLinkResult>), 'ELink response');
 751         my @ids2 = qw(350054 306537 273068 83332 1394);
 752
 753         # This is designed to fail; IDs present in individual ElinkData objects
 754         # for one-to-one correspondence with ID groups
 755         eval{$eutil->get_ids;};
 756         ok($@,'$elink->get_ids()');
 757
 758         # Linkset tests (there aren't any)
 759         is($eutil->get_linkset_count, 0, '$elink->get_linkset_count()');
 760         cmp_ok($eutil->get_cookie_count, '>', 15, '$elink->get_cookie_count()');
 761         my $ct = 0;
 762         while (my $cookie = $eutil->next_cookie) {
 763             isa_ok($cookie, 'Bio::DB::EUtilities::Cookie');
 764             is($cookie->eutil, 'elink', '$elink->cookie->eutil()');
 765             is($dbs{$cookie->database}, 1,  '$elink->cookie->database()');
 766             is($cookie->elink_dbfrom, 'protein', '$elink->cookie->elink_dbfrom()');
 767             @ids2 = $cookie->elink_queryids;
 768
 769             # should be single IDs, one per ElinkData obj
 770             is(scalar(@ids2), 1, '$elink->cookie->elink_queryids()');
 771             is($links{$cookie->elink_linkname}, 1,
 772                '$elink->cookie->elink_linkname()');
 773             # these are not set using elink
 774             is($cookie->esearch_query, undef, '$elink->cookie->esearch_query()');
 775             is($cookie->esearch_total, undef, '$elink->cookie->esearch_total()');
 776
 777             # check the actual cookie data
 778             my ($webenv, $key) = @{ $cookie->cookie };
 779             like($webenv, qr{^\S{50}}, '$elink->cookie->cookie() WebEnv');
 780             like($key, qr{^\d+}, '$elink->cookie->cookie() query key');
 781             last if $ct == 14;
 782             $ct++;
 783         }
 784     }
 785 }
 786
 787 # ELink (scores)
 788
 789 sub scores {
 790     my %scores = (   1621261 =>   2147483647,
 791                     20807972 =>          423,
 792                     68536103 =>          554,
 793                       730439 =>          411,
 794                     89318838 =>          '',);
 795
 796     SKIP: {
 797         # an elink back to the same db (db eq dbfrom) returns similarity scores
 798         $eutil = Bio::DB::EUtilities->new(
 799                                         -eutil      => 'elink',
 800                                         -db         => 'protein',
 801                                         -dbfrom     => 'protein',
 802                                         -id         => $ids[0],
 803                                           );
 804
 805         isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 806         eval {$response = $eutil->get_response; };
 807
 808         # check this number, likely wrong
 809         skip("ELink HTTP error:$@", 20);# if $@;
 810         isa_ok($response, 'HTTP::Response');
 811         like($response->content, qr(<eLinkResult>), 'ELink response');
 812
 813         # only one linkset, so this actually works (not recommended)
 814         my @ids2 = $eutil->get_ids;
 815         cmp_ok(scalar(@ids2), '>' ,765 ,'$elink->get_ids()');
 816
 817         # Linkset tests (there aren't any)
 818         is($eutil->get_linkset_count, 1, '$elink->get_linkset_count()');
 819         is($eutil->get_cookie_count, 0, '$elink->get_cookie_count()');
 820
 821         while ( my $linkobj = $eutil->next_linkset) {
 822             isa_ok($linkobj, 'Bio::DB::EUtilities::ElinkData');
 823             is($linkobj->elink_dbfrom, 'protein', '$linkdata->elink_dbfrom()');
 824             is($linkobj->elink_command, 'neighbor', '$linkdata->elink_command()');
 825
 826             # get db with scores
 827             while ( my $db = $linkobj->next_scoredb) {
 828                 my $ct = 0;
 829                 is($db,'protein', '$linkdata->next_scoredb()');
 830                 my @ids2 = $linkobj->get_LinkIds_by_db($db);
 831                 cmp_ok(scalar(@ids2), '>', 765, '$linkdata->get_LinkIds_by_db($db)');
 832                 for my $id (@ids) {
 833                     last if $ct++ == 6;
 834                     is($linkobj->get_score($id), $scores{$id}, '$linkdata->get_score()');
 835                 }
 836             }
 837         }
 838     }
 839 }
 840
 841 # Although the other EUtilities are available, no postprocessing is done on the
 842 # returned XML yet
 843
 844 sub egquery {
 845     $eutil = Bio::DB::EUtilities->new(
 846                                     -eutil      => 'egquery',
 847                                     -term       => $term,
 848                                       );
 849
 850     isa_ok($eutil, 'Bio::DB::GenericWebDBI');
 851     eval {$response = $eutil->get_response; };
 852     skip("EGQuery HTTP error:$@", 2) if $@;
 853     isa_ok($response, 'HTTP::Response');
 854     like($response->content, qr(<eGQueryResult>), 'EGQuery response');
 855 }
 856
 857 1;