# 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 = <CONTENT10
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$tag>"
. 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)