t/SoapEU-unit.t

   1 #-*-perl-*-
   2 #$Id$
   3 #testing SoapEUtilities and components
   4 use strict;
   5 use warnings;
   6 our $home;
   7 BEGIN {
   8     use Bio::Root::Test;
   9     use lib '.';
  10     $home = '.'; # set to '.' for Build use,
  11                       # '..' for debugging from .t file
  12     unshift @INC, $home;
  13     test_begin(-tests => 139,
  14                -requires_modules => [qw(Bio::DB::ESoap
  15                                         Bio::DB::ESoap::WSDL
  16                                         Bio::DB::SoapEUtilities
  17                                         Bio::DB::SoapEUtilities::Result
  18                                         Bio::DB::SoapEUtilities::FetchAdaptor
  19                                         Bio::DB::SoapEUtilities::LinkAdaptor
  20                                         Bio::DB::SoapEUtilities::DocSumAdaptor
  21                                         SOAP::Lite
  22                                         XML::Twig
  23                                         )]);
  24 }
  25
  26 # use data files for most unit testing
  27 # see skip section for network tests
  28
  29 # ESoap::WSDL
  30 my $NCBI_SOAP_SVC = "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/soap/v2.0/soap_adapter_2_0.cgi";
  31 my @EUTILS = qw( einfo esearch elink egquery epost espell esummary);
  32
  33 diag("NOTE: No network access required for these tests; all are local file-based.");
  34
  35 ok my $wsdl = Bio::DB::ESoap::WSDL->new(-wsdl => test_input_file('eutils.wsdl')), "wsdl parse from file";
  36
  37 is_deeply ( [sort values %{$wsdl->operations}], [sort @EUTILS ], "available operations (as of 1/9/10)" );
  38 is $wsdl->service, $NCBI_SOAP_SVC, "correct soap svc url (as of 1/9/10)";
  39
  40 is_deeply( $wsdl->request_parameters('einfo'),
  41            { 'eInfoRequest' => [
  42                  { 'db' => 1 },
  43                  { 'tool' => 1 },
  44                  { 'email' => 1 }
  45                  ] } , 'einfo request parameters');
  46 is_deeply( $wsdl->response_parameters('einfo'),
  47            {'eInfoResult' =>
  48                 [ {'ERROR' => 1},
  49                   {'DbList' => [{'DbName|' => 1 }]},
  50                   {'DbInfo' => [
  51                        {'DbName' => 1 },
  52                        {'MenuName' => 1},
  53                        {'Description' => 1},
  54                        {'Count' => 1},
  55                        {'LastUpdate' => 1},
  56                        {'FieldList' => [
  57                             {'Field' => [
  58                                  {'Name' => 1},
  59                                  {'FullName' => 1},
  60                                  {'Description' => 1},
  61                                  {'TermCount' => 1},
  62                                  {'IsDate' => 1},
  63                                  {'IsNumerical' => 1},
  64                                  {'SingleToken' => 1},
  65                                  {'Hierarchy' => 1},
  66                                  {'IsHidden' => 1}
  67                                  ]}
  68                             ]},
  69                        {'LinkList' => [
  70                             {'Link' => [
  71                                  {'Name' => 1},
  72                                  {'Menu' => 1},
  73                                  {'Description' => 1},
  74                                  {'DbTo' => 1}
  75                                  ]}
  76                             ]}
  77                        ]}
  78              ]}, 'einfo response parameters');
  79 is_deeply( $wsdl->request_parameters('egquery'),
  80            { 'eGqueryRequest' => [
  81                  { 'term' => 1 },
  82                  { 'tool' => 1 },
  83                  { 'email' => 1 }
  84                  ] } , 'egquery request parameters');
  85 is_deeply( $wsdl->response_parameters('egquery'),
  86            { 'Result' => [
  87                  { 'Term' => 1 },
  88                  { 'eGQueryResult' => [
  89                        {'ERROR' => 1},
  90                        {'ResultItem' => [
  91                             {'DbName' => 1},
  92                             {'MenuName' => 1},
  93                             {'Count' => 1},
  94                             {'Status' => 1}
  95                             ]}
  96                        ]}
  97                  ]} , 'egquery response parameters');
  98
  99 # ESoap
 100
 101 ok my $dumfac = Bio::DB::ESoap->new( -util => 'run_eLink',
 102                                      -wsdl_file => test_input_file('eutils.wsdl') ), "dummy ESoap factory";
 103
 104 is $dumfac->util, 'run_eLink', 'operation accessor';
 105 ok $dumfac = Bio::DB::ESoap->new( -util => 'elink',
 106                                      -wsdl_file => test_input_file('eutils.wsdl') ), "dummy ESoap factory";
 107 is $dumfac->util, 'run_eLink', 'operation name converted';
 108 require File::Spec;
 109 is( (File::Spec->splitpath($dumfac->wsdl_file))[-1], 'eutils.wsdl', 'wsdl filename accessor' );
 110 is $dumfac->_request_elt_name, 'eLinkRequest', 'request element name';
 111 is $dumfac->_result_elt_name, 'eLinkResult', 'result element name';
 112 is_deeply( [sort $dumfac->available_parameters], [sort qw( db id reldate mindate maxdate datetype term dbfrom linkname WebEnv query_key cmd tool email )], 'elink available parameters via Bio::ParameterBaseI');
 113 ok $dumfac->set_parameters( -db => 'gene', -id => 12345, -tool => 'ESoapTest' ), 'set_parameters';
 114 ok $dumfac->parameters_changed, "parameters_changed flag set";
 115 is_deeply( [$dumfac->get_parameters], [qw( db gene id 12345 tool ESoapTest )],
 116            'get_parameters' );
 117 ok !$dumfac->parameters_changed, "parameters_changed flag cleared";
 118 is $dumfac->db, 'gene', 'parameter as accessor';
 119 is $dumfac->tool, 'ESoapTest', 'parameter as accessor (2)';
 120 ok $dumfac->reset_parameters, "reset_parameters";
 121 ok $dumfac->parameters_changed, "parameters_changed flipped";
 122
 123 # SoapEUtilities
 124
 125 ok $dumfac = Bio::DB::SoapEUtilities->new( -wsdl_file => test_input_file('eutils.wsdl') ), "make SoapEU factory";
 126
 127 ok $dumfac->esearch( -db => 'gene', -term => 'bat guano' ), "esearch instance";
 128 ok $dumfac->elink( -dbfrom => 'protein', -db => 'taxonomy', -id => [1234,5678] ),
 129     "elink instance";
 130 is_deeply( [$dumfac->esearch->get_parameters],
 131            [qw( db gene term ), "bat guano"], "esearch get_parameters");
 132 is_deeply( [$dumfac->elink->get_parameters],
 133            [qw(db taxonomy dbfrom protein id ), [1234, 5678]],
 134            "elink get_parameters" );
 135 is $dumfac->esearch->db, 'gene', "esearch delegation";
 136 is $dumfac->elink->db, 'taxonomy', "elink delegation";
 137 ok $dumfac->esearch->db('protein'), "esearch set parameter by accessor";
 138 ok $dumfac->esearch->parameters_changed, "esearch parameters_changed";
 139 is $dumfac->esearch->db, 'protein', "was set";
 140 ok !$dumfac->elink->parameters_changed, "elink not parameters_changed";
 141
 142 # work over SoapEUtilities::Result
 143
 144 $dumfac->esummary();
 145 open my $xmlsumf, test_input_file('esum_result.xml');
 146 { local $/ = undef;
 147   $dumfac->{'_response_message'} = SOAP::Deserializer->deserialize(<$xmlsumf>);
 148 }
 149
 150 ok my $result = Bio::DB::SoapEUtilities::Result->new($dumfac), "create Result object (esummary)";
 151 is $result->util, 'esummary', 'util accessor';
 152 is $result->count, 3, "count";
 153 is_deeply( $result->ids, [828392, 790, 470338], "ids" );
 154
 155 $dumfac->esearch;
 156 open my $xmlf, test_input_file('esearch_result.xml');
 157 { local $/ = undef;
 158   $dumfac->{'_response_message'} = SOAP::Deserializer->deserialize(<$xmlf>);
 159 }
 160 ok $result = Bio::DB::SoapEUtilities::Result->new($dumfac), "create Result object (esearch)";
 161 is $result->util, 'esearch', 'util accessor';
 162 is $result->count, 777, "count";
 163 is_deeply $result->ids, [qw(
 164            4212556
 165            7103559
 166            7036330
 167            7005509
 168            6515581
 169            6333573
 170            6067533
 171            5849183
 172            5625162
 173            5613996
 174            5451592
 175            5188376
 176            5182770
 177            5174340
 178            5132346
 179            5079123
 180            4625535
 181            4233539
 182            4227906
 183            4171988)], "ids";
 184
 185
 186 $dumfac->elink;
 187 open $xmlf, test_input_file('elink_result.xml');
 188 { local $/ = undef;
 189   $dumfac->{'_response_message'} = SOAP::Deserializer->deserialize(<$xmlf>);
 190 }
 191 ok $result = Bio::DB::SoapEUtilities::Result->new($dumfac, -no_parse=>1), "create Result object (elink, don't parse)";
 192 ok !$result->count, "as requested, did not parse accessors";
 193 ok $result->parse_methods( { 'ids' => 'LinkSet_IdList_Id' } ), "parse_methods on object";
 194 is $result->util, 'elink', 'util accessor';
 195 is $result->count, 3, "count";
 196 is_deeply( [sort @{$result->ids}], [sort qw(828392 790 470338)], "ids" );
 197
 198 # check accessors; one for each xml tree tip below <eLinkResult>
 199 is_deeply( [sort $result->accessors], [ sort qw(
 200                                      count ids
 201                                      LinkSet_DbFrom LinkSet_IdList_Id
 202                                      LinkSet_LinkSetDb_DbTo
 203                                      LinkSet_LinkSetDb_LinkName
 204                                      LinkSet_LinkSetDb_Link_Id) ],
 205            "accessors for each response tip" );
 206
 207 is ( ref $result->LinkSet, 'HASH', "autoload higher level accessor returns hashref");
 208 is( ref $result->LinkSet_LinkSetDb_DbTo, 'ARRAY', "created accessor return arrayref" );
 209 is ( $result->count, scalar @{$result->LinkSet_LinkSetDb_DbTo}, "count same as number of records same as number elts returned by accessor");
 210 is_deeply( [sort keys %{$result->LinkSet_LinkSetDb}], [sort qw(
 211                                      LinkSet_LinkSetDb_DbTo
 212                                      LinkSet_LinkSetDb_LinkName
 213                                      LinkSet_LinkSetDb_Link_Id) ],
 214            "autoload higher level accessor, return list");
 215 ok $result->LinkSet_LinkSetDb_LinkName, "LinkName is present";
 216 ok $result = Bio::DB::SoapEUtilities::Result->new($dumfac,
 217                                                   -alias_hash =>
 218                                                   { 'gefilte_fish' =>
 219                                                         'LinkSet_DbFrom' },
 220                                                   -prune_at_nodes =>
 221                                                       '//LinkSet/LinkSetDb/LinkName'
 222     ), "result, parse but prune at single node //LinkSet/LinkSetDb/LinkName";
 223 is ($result->LinkSet_DbFrom->[0], 'gene', "DbFrom");
 224 is ($result->gefilte_fish->[0], 'gene', "alias correct");
 225 ok $result->LinkSet_LinkSetDb_DbTo, "DbTo present, but..";
 226 ok !$result->LinkSet_LinkSetDb_LinkName, "LinkName is not";
 227 ok $result = Bio::DB::SoapEUtilities::Result->new($dumfac,
 228                                                   -prune_at_nodes =>
 229                                                   ['//LinkSet/LinkSetDb',
 230                                                    '//LinkSet/DbFrom']
 231     ), " prune at multiple nodes: //LinkSet/LinkSetDb, //LinkSet/";
 232
 233 ok grep(/LinkSet_IdList_Id/, $result->accessors), "IdList_Id present";
 234 ok !grep(/LinkSet_LinkSetDb/, $result->accessors), "LinkSet_LinkSetDb not present";
 235
 236 # Adaptors
 237
 238 # linkset
 239 my $i;
 240
 241 my %testdata = (
 242     'db_from' => 'gene',
 243     'db_to' => 'taxonomy',
 244     'link_name' => 'gene_taxonomy',
 245     'submitted_ids' => [ [790], [828392], [470338] ],
 246     'ids' => [ [9606], [3702], [9598] ],
 247     'submitted_ids_flat' => [790, 828392, 470338 ],
 248     'ids_flat' => [ 9606, 3702, 9598 ]
 249     );
 250
 251 ok my $links = Bio::DB::SoapEUtilities::LinkAdaptor->new(
 252     -result => $result
 253     ), "get linkset adapator";
 254
 255 for ($i = 0; my $linkset = $links->next_linkset; $i++) {
 256     for ( keys %testdata ) {
 257         next if /flat/;
 258         if (/ids/) {
 259             is_deeply( [$linkset->$_], $testdata{$_}->[$i], "linkset accessor ($_)");
 260         }
 261         else {
 262             is $linkset->$_, $testdata{$_}, "linkset accessor ($_)";
 263         }
 264     }
 265     is ($links->id_map($testdata{'submitted_ids_flat'}->[$i]),
 266         $testdata{'ids_flat'}->[$i], 'id_map correct correspondence');
 267
 268 }
 269
 270 is ($i, 3, "all linksets accessed");
 271 $links->rewind;
 272 ok $links->next_linkset, "rewind works";
 273
 274
 275
 276 # docsum
 277 $dumfac->esummary;
 278 open $xmlf, test_input_file('esum_result.xml');
 279 {local $/=undef;
 280 $dumfac->{'_response_message'} = SOAP::Deserializer->deserialize(<$xmlf>);
 281 }
 282 $result = Bio::DB::SoapEUtilities::Result->new($dumfac, -no_parse=>1);
 283
 284 ok my $docsums = Bio::DB::SoapEUtilities::DocSumAdaptor->new(
 285     -result => $result
 286     ), "get docsum adaptor";
 287
 288
 289 %testdata = (
 290     'id' => [828392, 790, 470338],
 291     'Name' => [qw(PYR4 CAD CAD)],
 292     'Orgname' => [qw(Arabidopsis Homo Pan)],
 293     'TaxID' => [3702, 9606, 9598],
 294     'ChrAccVer' => [qw( NC_003075.7 NC_000002.11 NC_006469.2 )]
 295     );
 296
 297 for ( $i=0; my $docsum = $docsums->next_docsum; $i++ ) {
 298     foreach (keys %testdata) {
 299         if (!/Chr/) {
 300             my $t =  $testdata{$_}->[$i];
 301             like $docsum->$_, qr/$t/, "docsum accessor ($_)";
 302         }
 303         else {
 304             is ($docsum->GenomicInfo->{$_}, $testdata{$_}->[$i], "docsum hash accessor (GenomicInfo/$_)");
 305         }
 306     }
 307 }
 308 is ($i, 3, "all docsums accessed");
 309 $docsums->rewind;
 310 ok $docsums->next_docsum, "rewind works";
 311
 312 my @item_names = qw(
 313                     Name
 314                     Description
 315                     Orgname
 316                     Status
 317                     CurrentID
 318                     Chromosome
 319                     GeneticSource
 320                     MapLocation
 321                     OtherDesignations
 322                     NomenclatureSymbol
 323                     NomenclatureName
 324                     NomenclatureStatus
 325                     TaxID
 326                     Mim
 327                     GenomicInfo
 328                     GeneWeight
 329                     Summary
 330                     ChrSort
 331                     ChrStart
 332                    );
 333 is_deeply( [$docsums->next_docsum->item_names], [@item_names], "docsum item list" );
 334
 335
 336 ### test FetchAdaptors : add test set with local wsdls and xml result data
 337 ### for each new subclass...
 338 ### create local wsdls by including and importing types/schemas by hand into
 339 ### the local copy (to avoid network hits in this .t)
 340 ###
 341
 342 # fetch genbank
 343
 344 #my ($dumfac, $xmlf,$result,%testdata,$i);
 345 # change wsdls
 346 ok $dumfac = Bio::DB::SoapEUtilities->new( -wsdl_file => test_input_file('efetch_seq.wsdl') ), "change wsdl";
 347 $dumfac->efetch();
 348 open $xmlf, test_input_file('gb_result.xml');
 349 { local $/ = undef;
 350   $dumfac->{'_response_message'} = SOAP::Deserializer->deserialize(<$xmlf>);
 351 }
 352 ok $result = Bio::DB::SoapEUtilities::Result->new($dumfac, -no_parse=>1), "create Result object (efetch protein (GenBank), don't parse methods)";
 353
 354 ok my $seqio = Bio::DB::SoapEUtilities::FetchAdaptor->new( -result => $result ),
 355     "create FetchAdaptor";
 356
 357 isa_ok $seqio, 'Bio::DB::SoapEUtilities::FetchAdaptor::seq';
 358
 359 %testdata = (
 360     'id' => [qw( CAB02640 EAS10332 )],
 361     'seq' => [qw( mgaagdaaigres mgapdqsgsdrelmsa )],
 362     'alphabet' => [qw( protein protein )],
 363     'molecule' => [qw( AA AA )],
 364     'seq_version' => [ 1, 1 ],
 365     'feats' => [{ 'Region' => { 'start' => [11,11],
 366                                 'end' => [193, 186],
 367                                 'tags' => {
 368                                     'region_name' => [qw( Pribosyltran Pribosyltran )]
 369                                 }
 370                   },
 371                   'CDS' => {
 372                       'start' => [1, 1],
 373                       'end'   => [193, 193],
 374                       'tags'  => {
 375                           'coded_by' => [qw( BX842576.1:169611..170192
 376                                              AAPA01000007.1:178491..179072)]
 377                       }
 378                   }
 379
 380                 }],
 381     'annotation' => [{
 382         'reference' => {
 383             'title' => ['Deciphering the biology',
 384                        'Sequencing of the draft'],
 385             'consortium' => [ undef, 'JGI-PGF' ],
 386             'pubmed' => [9634230, undef]
 387         }
 388                      }],
 389     'species' => {
 390         'genus' => [qw( Mycobacterium Mycobacterium )],
 391         'binomial' => [qw( tuberculosis gilvum ) ]
 392     }
 393     );
 394
 395
 396 for ( $i=0; my $seq = $seqio->next_seq; $i++ ) {
 397     is( $seq->id, $testdata{id}->[$i], 'id' );
 398     like $seq->seq, qr/${$testdata{seq}}[$i]/, 'seq';
 399     is $seq->alphabet, $testdata{alphabet}->[$i], 'alphabet';
 400     is $seq->molecule, $testdata{molecule}->[$i], 'molecule';
 401     is $seq->version, 1, 'seq_version';
 402     like $seq->species->genus, qr/${$testdata{species}}{genus}[$i]/, 'species/genus';
 403     like $seq->species->binomial, qr/${$testdata{species}}{binomial}[$i]/,
 404     'species/binomial';
 405     my @feats = $seq->get_SeqFeatures;
 406     foreach my $testf (@{$testdata{feats}}) {
 407         foreach my $pt (keys %$testf) {
 408             my ($feat) = grep { $_->primary_tag eq $pt } @feats;
 409             is $feat->start, $testf->{$pt}{'start'}[$i], "$pt/start";
 410             is $feat->end, $testf->{$pt}{'end'}[$i], "$pt/end";
 411             foreach my $tag (keys %{$testf->{$pt}{tags}}) {
 412                 my $tdata = $testf->{$pt}{tags}{$tag}[$i];
 413                 is (($feat->get_tag_values($tag))[0], $tdata, "$pt/$tag");
 414             }
 415         }
 416     }
 417
 418     foreach my $testa (@{$testdata{annotation}}) {
 419         foreach (keys %$testa) {
 420             my ($ann) = $seq->annotation->get_Annotations($_);
 421             foreach my $key (keys %{$testa->{$_}}) {
 422                 my $tdata = $testa->{$_}{$key}[$i];
 423                 if (!defined $tdata && !defined $ann->$key) {
 424                     ok 1;
 425                 }
 426                 else {
 427                     like $ann->$key, qr/$tdata/, "$_/$key";
 428                 }
 429             }
 430         }
 431     }
 432 }
 433 is ($i, 2, "got all seqs");
 434 1;
 435
 436 # remove later
 437 #sub test_input_file { "data/".shift };