[MOBY-guts] biomoby commit
Frank Gibbons
fgibbons at pub.open-bio.org
Wed Sep 21 19:08:28 UTC 2005
fgibbons
Wed Sep 21 15:08:28 EDT 2005
Update of /home/repository/moby/moby-live/Perl/t
In directory pub.open-bio.org:/tmp/cvs-serv12437/t
Modified Files:
CommonSubs.t
Log Message:
- Added new test of collectionResponse, including tests for correct failure.
- Still needs tests for complexResponse, whatever that is ....
- Fixed earlier test that tried to create article from empty string.
moby-live/Perl/t CommonSubs.t,1.2,1.3
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/t/CommonSubs.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- /home/repository/moby/moby-live/Perl/t/CommonSubs.t 2005/08/30 15:19:05 1.2
+++ /home/repository/moby/moby-live/Perl/t/CommonSubs.t 2005/09/21 19:08:28 1.3
@@ -11,13 +11,13 @@
# change 'tests => 1' to 'tests => last_test_to_print';
#use SOAP::Lite +trace;
-use Test::More 'no_plan'; #tests => 127; # perldoc Test::More for details
+use Test::More 'no_plan'; #skip_all => "Turned off for development"; #'no_plan';
use strict;
use English;
use Data::Dumper;
#Is the client-code even installed?
BEGIN { use_ok('MOBY::CommonSubs') };
-use MOBY::CommonSubs qw /:all/;
+use MOBY::CommonSubs qw/:all/;
use XML::LibXML;
use MOBY::MobyXMLConstants;
@@ -26,33 +26,34 @@
};
my @must_implement = qw/
- genericServiceInputParser
- genericServiceInputParserAsObject
+ collectionResponse
+ complexResponse
complexServiceInputParser
extractRawContent
- validateNamespaces
- validateThisNamespace
+ extractResponseArticles
+ genericServiceInputParser
+ genericServiceInputParserAsObject
+ getArticles
+ getCollectedSimples
+ getCrossReferences
getInputArticles
- getInputs
getInputID
- getArticles
+ getInputs
+ getNodeContentWithArticle
+ getResponseArticles
+ getServiceNotes
getSimpleArticleIDs
getSimpleArticleNamespaceURI
- getCollectedSimples
- getNodeContentWithArticle
- isSimpleArticle
isCollectionArticle
isSecondaryArticle
- extractResponseArticles
- getResponseArticles
- getCrossReferences
- simpleResponse
- collectionResponse
- complexResponse
- responseHeader
+ isSimpleArticle
responseFooter
+ responseHeader
+ simpleResponse
+ validateNamespaces
+ validateThisNamespace
whichDeepestParentObject
- getServiceNotes/;
+/;
can_ok('MOBY::CommonSubs', @must_implement)
or diag("CommonSubs doesn't implement all the methods that it should");
@@ -65,21 +66,21 @@
# complexServiceInputParser
######## EXTRACT CONTENTS #########
+my @query_ids = (1, 'a', 23, 24);
my $msg = <<EOF; # All possible types of input block: (moby:|)(queryInput|mobyData)
-<queryInput queryID='1'></queryInput>
-<moby:queryInput queryID='a'></moby:queryInput>
-<mobyData queryID='23'/>
-<moby:mobyData queryID='24'>foo</moby:mobyData>
+<queryInput queryID='$query_ids[0]'></queryInput>
+<moby:queryInput queryID='$query_ids[1]'></moby:queryInput>
+<mobyData queryID='$query_ids[2]'/>
+<moby:mobyData queryID='$query_ids[3]'>foo</moby:mobyData>
EOF
my @inputs = getInputs(responseHeader() . $msg . responseFooter());
-is(scalar @inputs, 4)
+is(scalar @inputs, scalar @query_ids)
or diag("Wrong number of inputs returned from getInputs");
-is(getInputID($inputs[0]), 1) or diag("Wrong input ID returned for $inputs[0]");
-is(getInputID($inputs[1]), 'a') or diag("Wrong input ID returned for $inputs[1]");
-is(getInputID($inputs[2]), 23) or diag("Wrong input ID returned for $inputs[2]");
-is(getInputID($inputs[3]), 24) or diag("Wrong input ID returned for $inputs[3]");
-
+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 $article_msg = <<ARTICLES;
@@ -167,11 +168,16 @@
or diag("Wrong number of 'undef's returned by getSimpleArticleIDs");
}
-is(scalar getSimpleArticleIDs('bogus NS', $articles), undef)
+my @bogus;
+my $bogus_ns = "bogus NS";
+eval { @bogus = getSimpleArticleIDs($bogus_ns, $articles) };
+isnt($@, undef)
+ or diag("Invalid namespace '$bogus_ns' should have 'die'd, but didn't");
+is(scalar @bogus , 0)
or diag("Wrong number of Simple Articles IDs returned " .
"(expected zero for bogus namespace)");
-is(scalar getSimpleArticleIDs('SGD_LOCUS', $articles), 3)
+is(scalar getSimpleArticleIDs('SGD_LOCUS', $articles), scalar @{$articles})
or diag("Wrong number of Simple Articles IDs returned " .
"(expected zero for valid but unused namespace)");
@@ -224,7 +230,7 @@
my $xref_msg = <<XREF;
<Simple>
- <String namespace="taxon" id="foo">
+ <String namespace="taxon" id="foo">
<CrossReference>
<Object namespace='Global_Keyword' id='bla'/>"
</CrossReference>
@@ -252,7 +258,11 @@
my $parser = XML::LibXML->new();
my $doc;
eval { $doc = $parser->parse_string( $XML ); };
- return '' if ( $EVAL_ERROR ); #("Couldn't parse '$XML' because:\n\t$EVAL_ERROR")
+ 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();
}
@@ -280,7 +290,7 @@
# and for completely fictitious parameters.
# Examples here should be syntactically correct (namespace should be correct)
# just wrong article-types.
-my @not_articles = ("", "<Param/>", "<Paramater>foo</Paramater>",
+my @not_articles = ("<Param/>", "<Paramater>foo</Paramater>",
"<Colection/>", "<Single/>", "<Colletion/>");
for my $a (@not_articles) {
for my $test (\&isSimpleArticle, \&isCollectionArticle, \&isSecondaryArticle) {
@@ -322,18 +332,19 @@
my $sresp = XML_maker(responseHeader() # Need header for namespace def
. simpleResponse($data, $articleName, $qID)
. responseFooter());
-$sresp = $sresp->getElementsByTagName('moby:mobyData')
- || $sresp->getElementsByTagName('mobyData');
+$sresp = $sresp->getElementsByTagName('moby:mobyData');
+# || $sresp->getElementsByTagName('mobyData');
is($sresp->size(), 1)
or diag("SimpleResponse should contain only a single mobyData element.");
my $mobyData = $sresp->get_node(1);
-is($mobyData->getAttribute('queryID') || $mobyData->getAttribute('moby:queryID'), $qID)
+is($mobyData->getAttribute('moby:queryID') || $mobyData->getAttribute('queryID'),
+ $qID)
or diag("SimpleResponse didn't contain right queryID");
-my $children = $mobyData->childNodes;
+
my $simple;
my $count_elements = 0;
-foreach ($children->get_nodelist) {
- if ($_->nodeType == ELEMENT_NODE) { $simple = $_; $count_elements++;}
+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:");
@@ -347,10 +358,80 @@
TODO: {
local $TODO = "Need tests for collectionResponse and complexResponse";
- # collectionResponse
- # 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 namespace='$ns' id='$id'>$string</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* \<moby\:mobyData \s+
+moby\:queryID \s* = \s* ['"]$qID['"] \s* \> # Top-level tag should be mobyData
+\s* \<moby\:Collection \s+ moby\:articleName \s* = \s* ['"]$aname['"] \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->getElementsByTagName('moby:mobyData');
+ is($mData->size(), 1)
+ 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->getElementsByTagName("moby:Collection");
+ is ($colls->size(), 1)
+ 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 = getInputs(responseHeader() . $coll_resp . responseFooter() );
+ is(scalar @inputs, 1)
+ or diag("CollectionResponse should contain only one mobyData block");
+ is(getInputID($inputs[0]), $qID)
+ or diag("CollectionResponse returned mobyData block with incorrect queryID attribute");
+ my @articles = getArticles($inputs[0]);
+ is(scalar @articles, 1)
+ or diag("CollectionResponse should contain only one Collection");
+ is($articles[0]->[0], $aname)
+ or diag("CollectionResponse had incorrect articleName");
+ my @collected_simples = getCollectedSimples($articles[0]->[1]);
+ is(scalar @collected_simples , scalar @{$data})
+ or diag("CollectionResponse contained incorrect number of Simples");
+
+# 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*\<moby\:mobyData\s+moby\:queryID\s*=['"]$qID['"]\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*\<moby\:mobyData\s+moby\:queryID\s*=['"]$qID['"]\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",
More information about the MOBY-guts
mailing list