# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' # Note added by Frank Gibbons. # Tests should, as far as possible, avoid the use of literals. # If you register a service with authURI => mysite.com, # and you want to test a retrieved description of the service, don't test that the service returns authURI eq "mysite.com", # test so that it returns the same value as you used to register it in the first place. ######################### # change 'tests => 1' to 'tests => last_test_to_print'; #use SOAP::Lite +trace; use Test::More 'no_plan'; #skip_all => "Turned off for development"; #'no_plan'; use strict; use FindBin qw ($Bin); use lib "$Bin/../lib/"; use English; use Data::Dumper; #Is the client-code even installed? BEGIN { use_ok('MOBY::CommonSubs') }; use MOBY::CommonSubs qw/:all/; use XML::LibXML; use MOBY::MobyXMLConstants; use MOBY::Client::Central; BEGIN { use_ok('MOBY::Client::OntologyServer'); # initialize with a couple of useless things that we can guarantee to find my $C = MOBY::Client::Central->new(); my %Namespace = ( namespaceType => 'Rub1', authURI => 'your.authority.URI', description => "human readable description of namespace", contactEmail => 'your@address.here' ); my $r = $C->registerNamespace( %Namespace ); %Namespace = ( namespaceType => 'Rub2', authURI => 'your.authority.URI', description => "human readable description of namespace", contactEmail => 'your@address.here' ); $r = $C->registerNamespace( %Namespace ); }; END { # Define cleanup of registry, to return it to its 'pristine' state, # so that later attempts to run tests don't run into problems caused # by failure of these tests, or abortion of the test script. # Reconnect to MOBY Central here, since other connections # will have gone out of scope by the time we get to this END block. # Also can't use %Obj, my $C = MOBY::Client::Central->new(); my $r = $C->deregisterNamespace( namespaceType => 'Rub1' ); $r = $C->deregisterNamespace( namespaceType => 'Rub2' ); }; my @must_implement = qw/ serviceInputParser serviceResponseParser simpleResponse collectionResponse complexResponse isCollectionArticle isSecondaryArticle isSimpleArticle extractRawContent getCrossReferences getNodeContentWithArticle getServiceNotes responseFooter responseHeader validateNamespaces validateThisNamespace whichDeepestParentObject /; can_ok('MOBY::CommonSubs', @must_implement) or diag("CommonSubs doesn't implement all the methods that it should"); ######## EXTRACT CONTENTS ######### #my @query_ids = (1, 'a', 23, 24); #my $msg = < #foo #EOF # #my @inputs = getInputs(responseHeader() . $msg . responseFooter()); #is(scalar @inputs, scalar @query_ids) # or diag("Wrong number of inputs returned from getInputs"); #for (my $i = 0; $i < @query_ids; $i++) { # is(getInputID($inputs[$i]), $query_ids[$i]) # or diag("Wrong input ID returned for queryID $i: $inputs[$i]"); #} # This message contains two articles: Collection, and Parameter # The Collection, of course, contains some Simple Articles, but they are not top-level articles. my $moby_msg = < CONTENT 10 ARTICLES my $responses = serviceResponseParser($moby_msg); # returns MOBY objects isa_ok ($responses, "HASH", "response parser returned a HASH" ) or die "serviceResponseParser didn't return a hashref\n"; my @ids = keys %{$responses}; ok (scalar(@ids) == 1) or die "serviceResponseParser didn't find right number of invocation messages\n"; ok ($ids[0] eq "query1") or die "service4ResponseParser didn't find the query1 query id\n"; my $this_invocation = $responses->{$ids[0]}; ok ($this_invocation->{'simple1'}) or die "parser didn't find simple article in message\n"; ok ($this_invocation->{'collection1'}) or die "parser didn't find collection article in message\n"; ok ($this_invocation->{'e value cutoff'}) or die "parser didn't find secondary parameter article in message\n"; my $simple = $this_invocation->{'simple1'}; my $collection = $this_invocation->{'collection1'}; my $secondary = $this_invocation->{'e value cutoff'}; isa_ok($simple, "MOBY::Client::SimpleArticle") or die "retrieved Simple isn't a MOBY::Client::SimpleArticle object\n"; isa_ok($collection, "MOBY::Client::CollectionArticle") or die "retrieved Collection isn't a MOBY::Client::CollectionArticle Object\n"; isa_ok($secondary, "MOBY::Client::SecondaryArticle") or die "retrieved Secondary isn't a MOBY::Client::SecondaryArticle object\n"; # other tests of the MOBY::Client::*Article should be done in their own test suite # Test getInputArticles with one, and with more than one mobyData block. my $two_mobyDatas = < INP_ART $responses = serviceResponseParser($two_mobyDatas); # returns MOBY objects isa_ok ($responses, "HASH", "response parser returned a HASH" ) or die "serviceResponseParser didn't return a hashref for multiple input test\n"; @ids = keys %{$responses}; ok (scalar(@ids) == 2) or die "serviceResponseParser didn't find right number of invocation messages when two were passed\n"; ok ($ids[0] eq "first") or die "serviceResponseParser didn't find the first query id\n"; ok ($ids[1] eq "second") or die "serviceResponseParser didn't find the second query id that included a moby: namespace\n"; # pass 2 invalid messages ... should not parse $two_mobyDatas = < INP_ART $responses = serviceResponseParser($two_mobyDatas); # returns MOBY objects print Dumper($responses); isa_ok ($responses, "HASH", "response parser returned a HASH" ) or die "serviceResponseParser didn't return a hashref for multiple input test\n"; @ids = keys %{$responses}; ok (scalar(@ids) == 0) or die "serviceResponseParser didn't find right number of invocation messages when two invalid ones were passed\n"; my $sequence = "TAGCTGATCGAGCTGATGCTGA"; my $articlename = "SequenceString"; my $tag = "String"; my $simple_node_with_article = responseHeader() . "<$tag articleName=\"$articlename\">$sequence" . responseFooter(); TODO: { # If no articleName is specified, should return root node. local $TODO = "getNodeContentWithArticle() with articleName=''"; } my @nodes = getNodeContentWithArticle(XML_maker($simple_node_with_article), $tag, $articlename); is(scalar @nodes, 1) or diag("Couldn't find right number of nodes"); is($nodes[0], $sequence) or diag("Couldn't get node content."); my $servicenotes = "You can put all kinds of useful info here."; my $servicenotes_msg = < " foo 10 $servicenotes ARTICLES is(getServiceNotes(responseHeader() . $servicenotes_msg . responseFooter()), $servicenotes) or diag("Couldn't get services notes from message"); #what we encode we should be able to decode again my @ex1=( -exceptionmessage=>"hello", -severity=>"warning", -exceptioncode=>999, -refelement=>1, -refqueryid=>"input1"); my @ex2=( -exceptionmessage=>"hello2", -severity=>"warning2", -exceptioncode=>111, -refelement=>2, -refqueryid=>"input2"); my @except=getExceptions(responseHeader(-authority=>"illuminae.com", -notes=>$servicenotes, -exception=>encodeException(@ex1). encodeException(@ex2)). responseFooter()); is (scalar (@except),2) or diag("Could not extract all exceptions"); is ($except[0]->{exceptionMessage}.$except[0]->{severity}.$except[0]->{exceptionCode}. $except[0]->{refQueryID}.$except[0]->{refElement}, "hellowarning999input11") or diag("Could not extract complete exceptions"); my $xref_msg = < " " foo XREF is (scalar getCrossReferences($xref_msg), 2) or diag("Couldn't extract CrossReferences."); is (scalar getCrossReferences(XML_maker($xref_msg)), 2) or diag("Couldn't extract CrossReferences (XML mode)."); ####### TEST IDENTITY & VALIDATE ######### # Since allowed inputs are both XML text, and XML::DOM elements, # we need to test on both. # Wrap messages as response so that namespaces are properly defined. sub XML_maker { # Turn XML text into DOM. my $XML = shift; my $parser = XML::LibXML->new(); my $doc; eval { $doc = $parser->parse_string( $XML ); }; if ($EVAL_ERROR) { my ($package, $filename, $line) = caller; die "XML_maker called from line $line:Couldn't parse '$XML' because:\n\t" . "$EVAL_ERROR"; } return $doc->getDocumentElement(); } # Check simple text format: No namespaces allowed (i.e., no "moby:" prefix) my @simples = ("", "foo"); foreach (@simples) { is(isSimpleArticle($_), 1) or diag("Not a SimpleArticle ($_)"); is(isSimpleArticle(XML_maker($_)), 1) or diag("Not XML for SimpleArticle"); } my @collections = ("", "foo"); foreach (@collections) { is(isCollectionArticle($_), 1) or diag("Not a CollectionArticle ($_)"); is(isCollectionArticle(XML_maker($_)), 1) or diag("Not XML for CollectionArticle"); } my @parameters = ("", "foo"); foreach (@parameters) { is(isSecondaryArticle($_), 1) or diag("Not a SecondaryArticle ($_)"); is(isSecondaryArticle(XML_maker($_)), 1) or diag("Not XML for SecondaryArticle"); } # Now check that other messages fail each of those tests: # We should test for the empty string, for various misspellings of valid parameters, # and for completely fictitious parameters. # Examples here should be syntactically correct (namespace should be correct) # just wrong article-types. my @not_articles = ("", "foo", "", "", ""); for my $a (@not_articles) { for my $test (\&isSimpleArticle, \&isCollectionArticle, \&isSecondaryArticle) { isnt($test->($a), 1) or diag("Non-article '$a' passed as valid article"); isnt($test->(XML_maker($a)), 1) or diag("Non-article XML '$a' passed as valid article"); } } # Check that bona-fide namespaces are valid, regardless of position in the list of valid namespaces my @ns = ('Rub1', 'Rub2'); foreach (@ns) { ok (validateThisNamespace($_, @ns), "Validate namespace") or diag("Namespace ($_) not in list of namespaces"); ok (validateThisNamespace($_, \@ns), "Validate namespace") or diag("Namespace ($_) not in listref of namespaces"); } # Check that bogus namespaces are not valid. ok(!validateThisNamespace('Non-existent namespace', @ns)) or diag("Invalid namespace was incorrectly validated (list of namespaces)"); ok(!validateThisNamespace('Non-existent namespace', \@ns)) or diag("Invalid namespace was incorrectly validated (listref of namespaces)"); # Check that bona-fide namespaces have an LSID, # and that bogus ones do NOT. my @LSIDs = validateNamespaces('bogus-ns', @ns, 'other bogus-ns'); foreach ($LSIDs[0], $LSIDs[-1]) { is($_, undef,"validate namespace lsids") or diag("Bogus namespace ($LSIDs[0]) got an LSID"); } foreach (@LSIDs[1..-2]) { isnt($_, undef, "validate namespace lsids2") or diag("Bona fide namespace ($_) had no LSID"); } ######## GENERATE RESPONSE ######### # Simple response should be mobyData containing Simple, my ($data, $articleName, $qID) = ('my response', 'foo', 1); my $sresp = XML_maker(responseHeader() # Need header for namespace def . simpleResponse($data, $articleName, $qID) . responseFooter()); $sresp = $sresp->getElementsByTagName('moby:mobyData'); # || $sresp->getElementsByTagName('mobyData'); is($sresp->size(), 1,"response size OK") or diag("SimpleResponse should contain only a single mobyData element."); my $mobyData = $sresp->get_node(1); is($mobyData->getAttribute('moby:queryID') || $mobyData->getAttribute('queryID'), $qID) or diag("SimpleResponse didn't contain right queryID"); my $count_elements = 0; foreach ($mobyData->childNodes->get_nodelist) { if ($_->nodeType == ELEMENT_NODE) { $count_elements++ } } is($count_elements, 1) or diag("SimpleResponse's mobyData should have only a single child element:"); #ok($simple->nodeName =~ /(moby\:|)Simple/) # or diag("SimpleResponse's only child must be (moby:)Simple"); # Check for correct behavior with empty simpleResponse() too. $sresp = simpleResponse('', '', $qID); ok($sresp =~ /\/) or diag("SimpleResponse not correctly formed (articleName/data deliberately missing, should give empty mobyData)."); TODO: { local $TODO = "Need tests for collectionResponse and complexResponse"; # complexResponse takes two arguments: $data, $qID # $data is arrayref, elements can also be arrayref, or string. #my $data = ''; } { # collectionResponse takes 3 args: $data, $articlename, $qID # $data is a arrayref of MOBY OBjects as raw XML. my ($qID, $aname, $ns, $id, $string) = ("23", "my_artIcLe", "taxon", "foo", "some_text"); my $simple = "$string"; my $data = [$simple, $simple, $simple]; my $coll_resp = collectionResponse($data, $aname, $qID); # Regular expressions are not the best way (!) to validate XML, but it's worth a quick check. ok($coll_resp =~ /^\s* \ # Top-level tag should be mobyData \s* \ .* # Don't worry too much about the innermost details - we'll get them with DOM. \s* \<\/moby\:Collection\> \s* \<\/moby\:mobyData\> \s* $/sx) # In above regexpt, 's' allows matching in multiline strings; # 'x' ignores comments and literal whitespace in regexp # Because we attempt to return 'pretty' XML, we need to allow for whitespace between all tags, # which explains why the regexp is peppered with '\s*' or diag("collectionResponse should have mobyData as outermost tag: got '$coll_resp'"); # Now parse the XML, and make sure it checks out according to DOM my $coll_resp_dom = XML_maker(responseHeader() . $coll_resp . responseFooter()); my $mData = $coll_resp_dom->getElementsByLocalName('mobyData'); is($mData->size(), 1,"collection response size is correct") or diag("CollectionResponse should contain only a single mobyData element."); $mData = $mData->get_node(1); is($mData->getAttribute('moby:queryID') || $mData->getAttribute('queryID'), $qID) or diag("CollectionResponse's mobyData element didn't contain correct queryID"); my $colls = $mData->getElementsByLocalName("Collection"); is ($colls->size(), 1,"collection has wrong number of children") or diag("CollectionResponse should have only a single child: Collection."); my $Coll = $colls->get_node(1); is($Coll->getAttribute('moby:articleName') || $Coll->getAttribute('articleName'), $aname) or diag("CollectionResponse didn't contain correct articleName"); my $simples = $Coll->getElementsByTagName("moby:Simple") || $Coll->getElementsByTagName("Simple"); is(scalar @{$simples}, scalar @{$data}) or diag("CollectionResponse contains wrong number of Simples"); # # Finally, parse the sucker with the tools in CommonSubs: it should be able to understand its own creations! my $inputs = serviceInputParser(responseHeader() . $coll_resp . responseFooter() ); ok (scalar(keys %{$inputs}) == 1) or diag("can't eat my own dogfood!"); # Test response when one or more simples are empty/undef. # They should result in empty Simple tags, but the total response should NOT be empty. $coll_resp = collectionResponse([], $aname, $qID); ok($coll_resp =~ /^\s*\$/) or diag("CollectionResponse should be empty mobyData tag when empty data supplied"); $data = [undef, $simple, $simple]; $coll_resp = collectionResponse($data, $aname, $qID); ok( !($coll_resp =~ /^\s*\$/sx)) or diag("CollectionResponse should not be empty " . "just because first element evaluates to false"); } #------------------ # Check header/footer # How can we parse incomplete XML for correctness....? my ($authURI, $service_notes) = ("your.site.here", "This message brought to you by our sponsors."); my $header = responseHeader(-authority => $authURI, -note => $service_notes); ok( $header =~ /^<\?xml version='1.0' encoding='UTF-8'\?>.*<\/moby\:serviceNotes>$/) or diag("responseHeader incorrect ($header)"); my $footer = responseFooter(); ok ($footer =~ /^\s*<\/moby\:mobyContent>\s*<\/moby\:MOBY>\s*$/m ) or diag("responseFooter incorrect"); # Put header and footer together, should be valid XML. #ok($header . $footer)