[MOBY-guts] biomoby commit

Frank Gibbons fgibbons at pub.open-bio.org
Tue Aug 30 15:19:05 UTC 2005


fgibbons
Tue Aug 30 11:19:05 EDT 2005
Update of /home/repository/moby/moby-live/Perl/t
In directory pub.open-bio.org:/tmp/cvs-serv22707/t

Modified Files:
	CommonSubs.t 
Log Message:
 - Almost complete check of CommonSubs API (phew)

moby-live/Perl/t CommonSubs.t,1.1,1.2
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/t/CommonSubs.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- /home/repository/moby/moby-live/Perl/t/CommonSubs.t	2005/08/29 19:10:47	1.1
+++ /home/repository/moby/moby-live/Perl/t/CommonSubs.t	2005/08/30 15:19:05	1.2
@@ -18,6 +18,9 @@
 #Is the client-code even installed?
 BEGIN { use_ok('MOBY::CommonSubs') };
 use MOBY::CommonSubs qw /:all/;
+use XML::LibXML;
+use MOBY::MobyXMLConstants;
+
 END {
   # Clean up after yourself, in case tests fail, or the interpreter is interrupted partway though...
 };
@@ -62,8 +65,6 @@
 #   complexServiceInputParser
 
 ########   EXTRACT CONTENTS    #########
-#   extractRawContent
-#   getInputArticles
 my $msg = <<EOF; # All possible types of input block: (moby:|)(queryInput|mobyData)
 <queryInput queryID='1'></queryInput>
 <moby:queryInput queryID='a'></moby:queryInput>
@@ -74,14 +75,10 @@
 my @inputs = getInputs(responseHeader() . $msg . responseFooter());
 is(scalar @inputs, 4)
   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]");
+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]");
 
 # This message contains two articles: Collection, and Parameter
 # The Collection, of course, contains some Simple Articles, but they are not top-level articles.
@@ -102,16 +99,148 @@
 ARTICLES
 
 my @articles = getArticles($article_msg);
-is(scalar @articles, 2)
-  or diag("Wrong number of articles returned");
-is(isCollectionArticle( $articles[0][1]), 1)
-  or diag("Expected Collection");
-is(isSecondaryArticle($articles[1][1]), 1)
+is(scalar @articles, 2) or diag("Wrong number of articles returned");
+my ($collection, $parameter) = @articles;
+# Check that first one is a Collection...
+is(isCollectionArticle($collection->[1]), 1) or diag("Expected Collection");
+# ...then pull out the Simples contained in it.
+is(scalar getCollectedSimples($collection->[1]), 2)
+  or diag("Expected 2 Simples, didn't find them.");
+is(isSecondaryArticle($parameter->[1]), 1)
   or diag("Expected Secondary/Parameter");
-#   getSimpleArticleIDs
-#   getSimpleArticleNamespaceURI
-#   getCollectedSimples
-#   getNodeContentWithArticle
+
+TODO: {
+local $TODO = "Need test for extractRawContent";
+#ok(extractRawContent($collection->[1])
+#   =~ "<Simple>.*<\/Simple><Simple>.*<\/Simple>")
+#  or diag("Couldn't extract raw content.");
+}
+
+# Test getInputArticles with one, and with more  than one mobyData block.
+my $two_mobyDatas = <<INP_ART;
+    <moby:mobyContent>
+      <moby:mobyData>
+          <Simple>
+            <Object namespace="blah" id="blah"/>
+          </Simple>
+      </moby:mobyData>
+      <moby:mobyData>
+          <Simple>
+            <Object namespace="blah" id="blah"/>
+          </Simple>
+      </moby:mobyData>
+    </moby:mobyContent>
+INP_ART
+
+is(scalar getInputArticles(responseHeader()
+			   . $article_msg
+			   . responseFooter()), 1)
+  or diag("Couldn't find right number of input articles");
+
+is(scalar getInputArticles(responseHeader()
+			   . $two_mobyDatas 
+			   . responseFooter()), 2)
+  or diag("Couldn't find right number of input articles");
+
+# getSimpleArticleIDs can be called in a number of ways, and of course, we have to test them all.
+# 1. If just one argument, it's assumed to be listref of Simple DOMs, and all ID's should be returned,
+# regardless of namespace
+# 2. If two arguments, first is taken to be namespace. Only articlenames from that namespace will 
+# be returned; other articlenames will generate a 'undef' response, so that the number of inputs
+# matches the number of outputs.
+
+my @NS = ("NCBI_gi", "SGD");
+my $articles = [ XML_maker("<Simple><Object namespace='$NS[0]' id='163483'/></Simple>"), 
+		 XML_maker("<Simple><Object namespace='invalid_ns' id='163483'/></Simple>"),
+		 XML_maker("<Simple><Object namespace='$NS[1]' id='S0005111'/></Simple>")
+	       ];
+
+is(getSimpleArticleIDs($articles), 3)
+  or diag("Wrong number of Simple Articles IDs returned (no namespace)");
+for my $ns (@NS) { # Should get three responses (one for each input), but two should be 'undef'
+  my @responses = getSimpleArticleIDs($ns, $articles);
+  is(scalar @responses, 3)
+    or diag("Wrong number of Simple Articles IDs returned (with namespace)");
+  my $count_undef = 0;
+  for my $r (@responses) { $count_undef++ if (!defined ($r)) }
+  is($count_undef, 2)
+    or diag("Wrong number of 'undef's returned by getSimpleArticleIDs");
+}
+
+is(scalar getSimpleArticleIDs('bogus NS', $articles), undef)
+  or diag("Wrong number of Simple Articles IDs returned " .
+	  "(expected zero for bogus namespace)");
+
+is(scalar getSimpleArticleIDs('SGD_LOCUS', $articles), 3)
+  or diag("Wrong number of Simple Articles IDs returned " .
+	  "(expected zero for valid but unused namespace)");
+
+ok(getSimpleArticleNamespaceURI($articles->[0])
+   =~ /^urn\:lsid\:biomoby\.org\:namespacetype\:/)
+  or diag("Got bad LSID for valid namespace");
+
+is( getSimpleArticleNamespaceURI($articles->[1]), undef)
+#       =~ /^urn\:lsid\:biomoby\.org\:namespacetype\:/ ) )
+  or diag("Got valid LSID for invalid namespace");
+
+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 = <<ARTICLES;
+<mobyData>
+    <Collection articleName='name1'>
+      <Simple>
+       <Object namespace="blah" id="blah"/>
+       <CrossReference>
+         <Object namespace='Global_Keyword' id='bla'/>"
+</CrossReference>
+foo
+      </Simple>
+    </Collection>
+    <Parameter articleName='e value cutoff'>
+       <default>10</default>
+    </Parameter>
+<serviceNotes>$servicenotes</serviceNotes>
+</mobyData>
+ARTICLES
+
+is(getServiceNotes(responseHeader() . $servicenotes_msg . responseFooter()),
+   $servicenotes)
+  or diag("Couldn't get services notes from message");
+
+my $xref_msg = <<XREF;
+<Simple>
+   <String  namespace="taxon" id="foo">
+   <CrossReference>
+     <Object namespace='Global_Keyword' id='bla'/>"
+   </CrossReference>
+   <CrossReference>
+     <Object namespace='Global_Keyword' id='bar'/>"
+   </CrossReference>
+   foo
+</String>
+</Simple>
+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,
@@ -123,27 +252,27 @@
   my $parser = XML::LibXML->new();
   my $doc;
   eval { $doc = $parser->parse_string( $XML ); };
-  die ("Couldn't parse '$XML' because:\n\t$EVAL_ERROR") if ( $EVAL_ERROR );
+  return '' if ( $EVAL_ERROR ); #("Couldn't parse '$XML' because:\n\t$EVAL_ERROR") 
   return $doc->getDocumentElement();
 }
 
-# Check simple text format: No namespaces allowed 
+# Check simple text format: No namespaces allowed (i.e., no "moby:" prefix)
 my @simples = ("<Simple/>", "<Simple>foo</Simple>");
 foreach (@simples) { 
-  is(isSimpleArticle($_), 1)
-    or diag("Not a SimpleArticle ($_)");
+  is(isSimpleArticle($_), 1) or diag("Not a SimpleArticle ($_)");
+  is(isSimpleArticle(XML_maker($_)), 1) or diag("Not XML for SimpleArticle");
 }
 
 my @collections = ("<Collection/>", "<Collection>foo</Collection>");
 foreach (@collections) { 
-  is(isCollectionArticle($_), 1)
-    or diag("Not a CollectionArticle ($_)");
+  is(isCollectionArticle($_), 1) or diag("Not a CollectionArticle ($_)");
+  is(isCollectionArticle(XML_maker($_)), 1) or diag("Not XML for CollectionArticle");
 }
 
 my @parameters = ("<Parameter/>", "<Parameter>foo</Parameter>");
 foreach (@parameters) {
-  is(isSecondaryArticle($_), 1)
-    or diag("Not a SecondaryArticle ($_)");
+  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:
@@ -155,10 +284,9 @@
 		   "<Colection/>", "<Single/>", "<Colletion/>");
 for my $a (@not_articles) {
   for my $test (\&isSimpleArticle, \&isCollectionArticle, \&isSecondaryArticle) {
-    isnt($test->($a), 1)
-      or diag("Non-article '$a' passed as valid article");
-#    is($test->(XML_maker(responseHeader() . $a . responseFooter())), 0)
-#      or diag("Non-article '$a' passed as valid article");
+    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
@@ -188,13 +316,54 @@
 }
 
 ######## GENERATE RESPONSE    #########
-#   simpleResponse
-#   collectionResponse
-#   complexResponse
+
+# 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)
+  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)
+  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++;}
+}
+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 =~ /\<moby\:mobyData moby\:queryID='$qID'\/>/)
+  or diag("SimpleResponse not correctly formed (articleName/data deliberately missing, should give empty mobyData).");
+
+TODO: {
+  local $TODO = "Need tests for collectionResponse and complexResponse";
+  #   collectionResponse
+  #   complexResponse
+}
+
+# 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\:MOBY xmlns\:moby='http\:\/\/www.biomoby.org\/moby' xmlns='http\:\/\/www.biomoby.org\/moby'><moby\:mobyContent moby\:authority='$authURI'><moby\:serviceNotes>.*<\/moby\:serviceNotes>$/)
+  or diag("responseHeader incorrect ($header)");
+
 my $footer = responseFooter();
 ok ($footer =~ /^\s*<\/moby\:mobyContent>\s*<\/moby\:MOBY>\s*$/m )
   or diag("responseFooter incorrect");
-my $header = responseHeader();
-ok( $header =~ /^<\?xml version='1.0' encoding='UTF-8'\?><moby\:MOBY xmlns\:moby='http\:\/\/www.biomoby.org\/moby' xmlns='http\:\/\/www.biomoby.org\/moby'><moby\:mobyContent moby\:authority='[\w\.\:]*'>$/)
-  or diag("responseHeader incorrect");
+
+# Put header and footer together, should be valid XML.
+#ok($header . $footer)
+




More information about the MOBY-guts mailing list