[MOBY-guts] biomoby commit
Frank Gibbons
fgibbons at pub.open-bio.org
Wed Sep 21 19:05:14 UTC 2005
fgibbons
Wed Sep 21 15:05:14 EDT 2005
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv12383/MOBY
Modified Files:
CommonSubs.pm
Log Message:
- Major re-arrangement of code, with a few small additions, which I try to
describe below:
- Code re-arranged into blocks, according to broad functional category.
This module is one of the most confusing to newbies, since there's all
this stuff just thrown in, with no apparent order to it.
- POD adjusted to take more advantage of HTML output. Previously, it was
just all one big dump of text - it's a lot easier to read when there's
bolding and different sized fonts. Also those annoying "Title" headings
are gone.
- Because we're so lax about namespaces, any time we try to getAttribute()
on a DOM node, we have to check for two things. Now there are two new
routines that take care of that: _moby_getAttribute and _moby_getAttributeNode
They're not exported, since they're intended for internal use only.
- In generating a collectionResponse, we want to return an empty message
if the $data passed in is empty. There's a bug fix that tests for an
entirely empty $data arrayref. Previously, it just tested the first
element.
- Most tags are tightened up, and regexps are contracted.
moby-live/Perl/MOBY CommonSubs.pm,1.68,1.69
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/CommonSubs.pm,v
retrieving revision 1.68
retrieving revision 1.69
diff -u -r1.68 -r1.69
--- /home/repository/moby/moby-live/Perl/MOBY/CommonSubs.pm 2005/09/01 14:00:00 1.68
+++ /home/repository/moby/moby-live/Perl/MOBY/CommonSubs.pm 2005/09/21 19:05:14 1.69
@@ -6,14 +6,21 @@
useful in clients and services to deal with the input/output from
MOBY Services
-=cut
+=head1 DESCRIPTION
+
+CommonSubs are used to do various manipulations of MOBY Messages. It is useful
+both Client and Service side to construct and parse MOBY Messages, and ensure
+that the message structure is valid as per the API.
+
+It DOES NOT connect to MOBY Central for any of its functions, though it does
+contact the ontology server, so it will require a network connection.
+
+=head1 SYNTAX
=head2 Client Side Paradigm
not written yet
-=cut
-
=head2 Service-Side Paradigm
The following is a generalized architecture for *all*
@@ -23,7 +30,7 @@
sub myServiceName {
my ($caller, $data) = @_;
my $MOBY_RESPONSE; # holds the response raw XML
-
+
# genericServiceInputParser
# unpacks incoming message into an array of arrarefs.
# Each element of the array is a queryInput block, or a mobyData block
@@ -31,11 +38,11 @@
# [SIMPLE, $queryID, $simple]
# the first element is an exported constant SIMPLE, COLLECTION, SECONDARY
# the second element is the queryID (required for enumerating the responses)
- # the third element is the XML::LibXML for the Simple, Collection, or Parameter block
- my (@inputs)= genericServiceInputParser($data);
+ # the third element is the XML::LibXML for the Simple, Collection, or Parameter block
+ my (@inputs)= genericServiceInputParser($data);
# or fail properly with an empty response
return SOAP::Data->type('base64' => responseHeader("my.authURI.com") . responseFooter()) unless (scalar(@inputs));
-
+
# you only need to do this if you are intending to be namespace aware
# some services might not care what namespace the data is in, so long
# as there is data...
@@ -53,16 +60,15 @@
# (see pod docs for other possibilities)
my $namespace = getSimpleArticleNamespaceURI($input); # get namespace
my ($identifier) = getSimpleArticleIDs($input); # get ID (note array output! see pod)
-
+
# here is where you do whatever manipulation you need to do
# for your particular service.
- # you will be building an XML document into $MOBY_RESPONSE
+ # you will be building an XML document into $MOBY_RESPONSE
}
}
- return SOAP::Data->type('base64' => (responseHeader("illuminae.com") . $MOBY_RESPONSE . responseFooter));
+ return SOAP::Data->type('base64' => (responseHeader("illuminae.com") . $MOBY_RESPONSE . responseFooter));
}
-=cut
=head1 EXAMPLE
@@ -113,7 +119,7 @@
unless ($accession =~/^GO:/){
$accession = "GO:$accession"; # we still haven't decided on whether id's should include the prefix...
}
- $sth->execute($accession);
+ $sth->execute($accession);
my ($term, $def) = $sth->fetchrow_array;
if ($term){
$MOBY_RESPONSE .= simpleResponse("
@@ -126,19 +132,9 @@
}
}
}
-
- return SOAP::Data->type('base64' => (responseHeader("my.authURI.com") . $MOBY_RESPONSE . responseFooter));
- }
-
-
-=head1 DESCRIPTION
-
-CommonSubs are used to do various manipulations of MOBY Messages. It is useful
-both Client and Service side to construct and parse MOBY Messages, and ensure
-that the message structure is valid as per the API.
-It DOES NOT connect to MOBY Central for any of its functions, though it does
-contact the ontology server, so it will require a network connection.
+ return SOAP::Data->type('base64' => (responseHeader("my.authURI.com") . $MOBY_RESPONSE . responseFooter));
+ }
=head1 AUTHORS
@@ -147,9 +143,7 @@
BioMOBY Project: http://www.biomoby.org
-=cut
-
-=head1 METHODS
+=head1 PARSING INPUT
=cut
@@ -172,41 +166,6 @@
use constant BE_STRICT => 0;
our @ISA = qw(Exporter);
our @EXPORT = qw(COLLECTION SIMPLE SECONDARY PARAMETER BE_NICE BE_STRICT);
-our @EXPORT_OK = qw(
- getSimpleArticleIDs
- getSimpleArticleNamespaceURI
- simpleResponse
- collectionResponse
- complexResponse
- responseHeader
- responseFooter
- getInputArticles
- getInputs
- getInputID
- getArticles
- getCollectedSimples
- getNodeContentWithArticle
- extractRawContent
- validateNamespaces
- validateThisNamespace
- isSimpleArticle
- isCollectionArticle
- isSecondaryArticle
- extractResponseArticles
- getResponseArticles
- getCrossReferences
- genericServiceInputParser
- genericServiceInputParserAsObject
- complexServiceInputParser
- whichDeepestParentObject
- getServiceNotes
- COLLECTION
- SIMPLE
- SECONDARY
- PARAMETER
- BE_NICE
- BE_STRICT
-);
our %EXPORT_TAGS = (
all => [
qw(
@@ -244,98 +203,127 @@
BE_STRICT
)
]
-);
+);# complexResponse is *not* here, but is in @EXPORT_OK
+
+
+our @EXPORT_OK = ("collectionResponse", @{$EXPORT_TAGS{'all'}});
=head2 genericServiceInputParser
- function : For the MOST SIMPLE SERVICES that take single Simple or Collection inputs
- and no Secondaries/Parameters this routine takes the MOBY message and
- breaks the objects out of it in a useful way
- usage : my @inputs = genericServiceInputParser($MOBY_mssage));
- args : $message - this is the SOAP payload; i.e. the XML document containing the MOBY message
- returns : @inputs - the structure of @inputs is a list of listrefs.
- Each listref has three components:
- 1. COLLECTION|SIMPLE (i.e. constants 1, 2)
- 2. queryID
- 3. $data - the data takes several forms
- a. $article XML::LibXML node for Simples
- <mobyData...>...</mobyData>
- b. \@article XML:LibXML nodes for Collections
-
- for example, the input message:
-
- <mobyData queryID = '1'>
- <Simple>
- <Object namespace=blah id=blah/>
- </Simple>
- </mobyData>
- <mobyData queryID = '2'>
- <Simple>
- <Object namespace=blah id=blah/>
- </Simple>
- </mobyData>
+B<function:> For the MOST SIMPLE SERVICES that take single Simple or
+Collection inputs and no Secondaries/Parameters this routine takes the
+MOBY message and breaks the objects out of it in a useful way
+
+B<usage:>
+ my @inputs = genericServiceInputParser($MOBY_mssage));
+
+B<args:> C<$message> - this is the SOAP payload; i.e. the XML document containing the MOBY message
+
+B<returns:> C<@inputs> - the structure of @inputs is a list of listrefs.
+
+Each listref has three components:
+
+=over 4
+
+=item *
+COLLECTION|SIMPLE (i.e. constants 1, 2)
+
+=item *
+queryID
+
+=item *
+$data - the data takes several forms
+
+=over 4
+
+=item *
+$article XML::LibXML node for Simples <mobyData...>...</mobyData>
+
+=item *
+\@article XML:LibXML nodes for Collections
- will become:
+=back
+
+=back
+
+For example, the input message:
+
+ <mobyData queryID = '1'>
+ <Simple>
+ <Object namespace=blah id=blah/>
+ </Simple>
+ </mobyData>
+ <mobyData queryID = '2'>
+ <Simple>
+ <Object namespace=blah id=blah/>
+ </Simple>
+ </mobyData>
+will become:
(note that SIMPLE, COLLECTION, and SECONDARY are exported constants from this module)
@inputs = ([SIMPLE, 1, $DOM], [SIMPLE, 2, $DOM]) # the <Simple> block
- for example, the input message:
-
- <mobyData queryID = '1'>
- <Collection>
- <Simple>
- <Object namespace=blah id=blah/>
- </Simple>
- <Simple>
- <Object namespace=blah id=blah/>
- </Simple>
- </Collection>
- </mobyData>
+For example, the input message:
- will become:
+ <mobyData queryID = '1'>
+ <Collection>
+ <Simple>
+ <Object namespace=blah id=blah/>
+ </Simple>
+ <Simple>
+ <Object namespace=blah id=blah/>
+ </Simple>
+ </Collection>
+ </mobyData>
- @inputs = ( [COLLECTION, 1, [$DOM, $DOM]] ) # the <Simple> block
+will become:
+
+ @inputs = ( [COLLECTION, 1, [$DOM, $DOM]] ) # the <Simple> block
=cut
sub genericServiceInputParser {
- my ( $message ) = @_; # get the incoming MOBY query XML
- my @inputs; # set empty response
- my @queries =
- getInputs( $message ); # returns XML::LibXML nodes <mobyData>...</mobyData>
- foreach my $query ( @queries ) {
- my $queryID =
- getInputID( $query ); # get the queryID attribute of the mobyData
- my @input_articles =
- getArticles( $query )
- ; # get the Simple/Collection/Secondary articles making up this query <Simple>...</Simple> or <Collection>...</Collection> or <Parameter>...</Parameter>
- foreach my $input ( @input_articles ) { # input is a listref
- my ( $articleName, $article ) = @{$input}; # get the named article
- if ( isCollectionArticle( $article ) ) {
- my @simples = getCollectedSimples( $article );
- push @inputs, [ COLLECTION, $queryID, \@simples ];
- } elsif ( isSimpleArticle( $article ) ) {
- push @inputs, [ SIMPLE, $queryID, $article ];
- } elsif ( isSecondaryArticle( $article ) )
- { # should never happen in a generic service parser!
- push @inputs, [ SECONDARY, $queryID, $article ];
- }
- }
+ my ( $message ) = @_; # get the incoming MOBY query XML
+ my @inputs; # set empty response
+ my @queries = getInputs( $message ); # returns XML::LibXML nodes <mobyData>...</mobyData>
+ foreach my $query ( @queries ) {
+ my $queryID = getInputID( $query ); # get the queryID attribute of the mobyData
+ my @input_articles =
+ getArticles( $query )
+ ; # get the Simple/Collection/Secondary articles making up this query <Simple>...</Simple> or <Collection>...</Collection> or <Parameter>...</Parameter>
+ foreach my $input ( @input_articles ) { # input is a listref
+ my ( $articleName, $article ) = @{$input}; # get the named article
+ if ( isCollectionArticle( $article ) ) {
+ my @simples = getCollectedSimples( $article );
+ push @inputs, [ COLLECTION, $queryID, \@simples ];
+ } elsif ( isSimpleArticle( $article ) ) {
+ push @inputs, [ SIMPLE, $queryID, $article ];
+ } elsif ( isSecondaryArticle( $article ) )
+ { # should never happen in a generic service parser!
+ push @inputs, [ SECONDARY, $queryID, $article ];
}
- return @inputs;
+ }
+ }
+ return @inputs;
}
=head2 serviceInputParser
- DO NOT USE!!
- function : to take a MOBY message and break the objects out of it. This is identical
- to the genericServiceInputParser method above, except that it returns the data as
- Objects rather than XML::LibXML nodes. This is an improvement!
- usage : my @inputs = serviceInputParser($MOBY_mssage));
- args : $message - this is the SOAP payload; i.e. the XML document containing the MOBY message
- returns : @inputs - the structure of @inputs is a list of listrefs.
- Each listref has three components:
+DO NOT USE!!
+
+B<function:> to take a MOBY message and break the objects out of it.
+This is identical to the genericServiceInputParser method above,
+except that it returns the data as Objects rather than XML::LibXML
+nodes. This is an improvement!
+
+B<usage:> C<my @inputs = serviceInputParser($MOBY_mssage));>
+
+B<args:> C<$message> - this is the SOAP payload; i.e. the XML document containing the MOBY message
+
+B<returns:> C<@inputs> - the structure of @inputs is a list of listrefs.
+
+Each listref has three components:
+
1. COLLECTION|SIMPLE|SECONDARY (i.e. constants 1, 2, 3)
2. queryID (undef for Secondary parameters)
3. $data - either MOBY::Client::SimpleArticle, CollectionArticle, or SecondaryArticle
@@ -343,108 +331,103 @@
=cut
sub serviceInputParser {
- my ( $message ) = @_; # get the incoming MOBY query XML
- my @inputs; # set empty response
- my @queries =
- getInputs( $message ); # returns XML::LibXML nodes <mobyData>...</mobyData>
-
-# mark, this doesn't work for complex services. We need to allow more than one input per invocation
- foreach my $query ( @queries ) {
- my $queryID =
- getInputID( $query ); # get the queryID attribute of the mobyData
- my @input_articles =
- getArticlesAsObjects( $query )
- ; # get the Simple/Collection articles making up this query <Simple>...</Simple> or <Collection>...</Collection> or <Parameter>...</Parameter
- foreach my $article ( @input_articles ) { # input is a listref
- if ( $article->isCollection ) {
- my @simples = getCollectedSimples( $article->XML );
- push @inputs, [ COLLECTION, $queryID, \@simples ];
- } elsif ( $article->isSimple ) {
- push @inputs, [ SIMPLE, $queryID, $article ];
- } elsif ( $article->isSecondary ) {
- push @inputs, [ SECONDARY, $queryID, $article ];
- }
- }
- }
- return @inputs;
+ my ( $message ) = @_; # get the incoming MOBY query XML
+ my @inputs; # set empty response
+ my @queries = getInputs( $message ); # returns XML::LibXML nodes <mobyData>...</mobyData>
+
+ # mark, this doesn't work for complex services. We need to allow more than one input per invocation
+ foreach my $query ( @queries ) {
+ my $queryID = getInputID( $query ); # get the queryID attribute of the mobyData
+ # get the Simple/Collection articles making up this query
+ # <Simple>...</Simple> or <Collection>...</Collection>
+ # or <Parameter>...</Parameter
+ my @input_articles = getArticlesAsObjects( $query );
+ foreach my $article ( @input_articles ) { # input is a listref
+ if ( $article->isCollection ) {
+ my @simples = getCollectedSimples( $article->XML );
+ push @inputs, [ COLLECTION, $queryID, \@simples ];
+ } elsif ( $article->isSimple ) {
+ push @inputs, [ SIMPLE, $queryID, $article ];
+ } elsif ( $article->isSecondary ) {
+ push @inputs, [ SECONDARY, $queryID, $article ];
+ }
+ }
+ }
+ return @inputs;
}
=head2 complexServiceInputParser
- function : For more complex services that have multiple articles for each input
- and/or accept parameters, this routine will take a MOBY message and
- extract the Simple/Collection/Parameter objects out of it in a
- useful way.
- usage : my $inputs = complexServiceInputParser($MOBY_mssage));
- args : $message - this is the SOAP payload; i.e. the XML document containing the MOBY message
- returns : $inputs is a hashref with the following structure:
-
+B<function:> For more complex services that have multiple articles for
+each input and/or accept parameters, this routine will take a MOBY
+message and extract the Simple/Collection/Parameter objects out of it
+in a useful way.
+
+B<usage:> C<my $inputs = complexServiceInputParser($MOBY_mssage));>
+
+B<args:> C<$message> - this is the SOAP payload; i.e. the XML document containing the MOBY message
+
+B<returns:> C<$inputs> is a hashref with the following structure:
+
$inputs->{$queryID} = [ [TYPE, $DOM], [TYPE, $DOM], [TYPE, $DOM] ]
-
- Simples ------------------------
-
- for example, the input message:
-
- <mobyData queryID = '1'>
- <Simple articleName='name1'>
- <Object namespace=blah id=blah/>
- </Simple>
- <Parameter articleName='cutoff'>
- <Value>10</Value>
- </Parameter>
- </mobyData>
- will become:
- (note that SIMPLE, COLLECTION, and SECONDARY are exported constants from this module)
-
+=head3 Simples
+
+For example, the input message:
+
+ <mobyData queryID = '1'>
+ <Simple articleName='name1'>
+ <Object namespace=blah id=blah/>
+ </Simple>
+ <Parameter articleName='cutoff'>
+ <Value>10</Value>
+ </Parameter>
+ </mobyData>
+
+will become: (note that SIMPLE, COLLECTION, and SECONDARY are exported constants from this module)
+
$inputs->{1} = [ [SIMPLE, $DOM_name1], # the <Simple> block
[SECONDARY, $DOM_cutoff] # $DOM_cutoff= <Parameter> block
]
- Please see the XML::LibXML pod documentation for information about how
- to parse XML DOM objects.
+Please see the XML::LibXML pod documentation for information about how to parse XML DOM objects.
+=head3 Collections
- Collections --------------------
-
- With inputs that have collections these are presented as a
- listref of Simple article DOM's. So for the following message:
-
- <mobyData>
- <Collection articleName='name1'>
- <Simple>
- <Object namespace=blah id=blah/>
- </Simple>
- <Simple>
- <Object namespace=blah id=blah/>
- </Simple>
- </Collection>
- <Parameter articleName='cutoff'>
- <Value>10</Value>
- </Parameter>
- </mobyData>
+With inputs that have collections these are presented as a listref of
+Simple article DOM's. So for the following message:
+
+ <mobyData>
+ <Collection articleName='name1'>
+ <Simple>
+ <Object namespace=blah id=blah/>
+ </Simple>
+ <Simple>
+ <Object namespace=blah id=blah/>
+ </Simple>
+ </Collection>
+ <Parameter articleName='cutoff'>
+ <Value>10</Value>
+ </Parameter>
+ </mobyData>
+
+will become
- will become
-
$inputs->{1} = [ [COLLECTION, [$DOM, $DOM] ], # $DOM is the <Simple> Block!
[SECONDARY, $DOM_cutoff] # $DOM_cutoff = <Parameter> Block
]
- Please see the XML::LibXML pod documentation for information about how
- to parse XML DOM objects.
-
+Please see the XML::LibXML pod documentation for information about how to parse XML DOM objects.
=cut
sub complexServiceInputParser {
my ( $message ) = @_; # get the incoming MOBY query XML
my @inputs; # set empty response
- my @queries =
- getInputs( $message ); # returns XML::LibXML nodes <mobyData>...</mobyData>
+ my @queries = getInputs( $message ); # returns XML::LibXML nodes <mobyData>...</mobyData>
my %input_parameters; # $input_parameters{$queryID} = [
foreach my $query ( @queries ) {
- my $queryID =
- getInputID( $query ); # get the queryID attribute of the mobyData
+ my $queryID = getInputID( $query ); # get the queryID attribute of the mobyData
my @input_articles =
getArticles( $query )
; # get the Simple/Collection/Secondary articles making up this query <Simple>...</Simple> or <Collection>...</Collection> or <Parameter>...</Parameter>
@@ -466,14 +449,17 @@
=head2 getArticles
- function : get the Simple/Collection/Parameter articles for a single mobyData
- usage : @articles = getArticles($XML)
- args : raw XML or XML::LibXML of a queryInput, mobyData, or queryResponse block (e.g. from getInputs)
- returns : a list of listrefs; each listref is one component of the queryInput or mobyData block
- a single block may consist of one or more named or unnamed
- simple, collection, or parameter articles.
- The listref structure is thus [name, $ARTICLE_DOM]:
-
+B<function:> get the Simple/Collection/Parameter articles for a single mobyData
+
+B<usage:> C<@articles = getArticles($XML)>
+
+B<args:> raw XML or XML::LibXML of a queryInput, mobyData, or queryResponse block (e.g. from getInputs)
+
+B<returns:> a list of listrefs; each listref is one component of the
+queryInput or mobyData block a single block may consist of one or more
+named or unnamed simple, collection, or parameter articles. The
+listref structure is thus C<[name, $ARTICLE_DOM]>:
+
e.g.: @articles = ['name1', $SIMPLE_DOM]
generated from the following sample XML:
@@ -483,24 +469,24 @@
<Object namespace=blah id=blah/>
</Simple>
</mobyData>
-
+
or : @articles = ['name1', $COLL_DOM], ['paramname1', $PARAM_DOM]
generated from the following sample XML:
- <mobyData>
- <Collection articleName='name1'>
- <Simple>
- <Object namespace=blah id=blah/>
- </Simple>
- <Simple>
- <Object namespace=blah id=blah/>
- </Simple>
- </Collection>
- <Parameter articleName='e value cutoff'>
- <default>10</default>
- </Parameter>
- </mobyData>
+ <mobyData>
+ <Collection articleName='name1'>
+ <Simple>
+ <Object namespace=blah id=blah/>
+ </Simple>
+ <Simple>
+ <Object namespace=blah id=blah/>
+ </Simple>
+ </Collection>
+ <Parameter articleName='e value cutoff'>
+ <default>10</default>
+ </Parameter>
+ </mobyData>
=cut
@@ -509,16 +495,15 @@
$moby = _string_to_DOM($moby);
return undef
unless ( ($moby->nodeType == ELEMENT_NODE)
- && ( $moby->nodeName =~ /queryInput|queryResponse|mobyData/ ) );
+ && ( $moby->nodeName =~ /^(moby:|)(queryInput|queryResponse|mobyData)$/ ) );
my @articles;
foreach my $child ( $moby->childNodes )
{ # there may be more than one Simple/Collection per input; iterate over them
next unless ( ($child->nodeType == ELEMENT_NODE) # ignore whitespace
- && ( $child->nodeName =~ /Simple|Collection|Parameter/ ) );
- my $articleName = $child->getAttribute( 'articleName' )
- || $child->getAttribute( 'moby:articleName' );
+ && ( $child->nodeName =~ /^(moby:|)(Simple|Collection|Parameter)$/ ) );
+ my $articleName = _moby_getAttribute($child, 'articleName' );
# push the named child DOM elements (which are <Simple> or <Collection>, <Parameter>)
- push @articles, [ $articleName, $child ];
+ push @articles, [ $articleName, $child ];
}
return @articles; # return them.
}
@@ -532,25 +517,34 @@
=head2 getSimpleArticleIDs
- function : to get the IDs of simple articles that are in the given namespace
- usage : my @ids = getSimpleArticleIDs("NCBI_gi", \@SimpleArticles);
- my @ids = getSimpleArticleIDs(\@SimpleArticles);
- args : $Namespace - (optional) a namespace stringfrom the MOBY namespace ontology, or undef if you don't care
- \@Simples - (required) a listref of Simple XML::LibXML nodes
- i.e. the XML::LibXML representing an XML structure like this:
- <Simple>
- <Object namespace="NCBI_gi" id="163483"/>
- </Simple>
- note : If you provide a namespace, it will return *only* the ids that are in the given namespace,
- but will return 'undef' for any articles in the WRONG namespace so that you get an
- equivalent number of outputs to inputs.
-
- Note that if you call this with a single argument, this is assumed to
- be \@Articles, so you will get ALL id's regardless of namespace!
+B<function:> to get the IDs of simple articles that are in the given namespace
+
+B<usage:>
+
+ my @ids = getSimpleArticleIDs("NCBI_gi", \@SimpleArticles);
+ my @ids = getSimpleArticleIDs(\@SimpleArticles);
+
+B<args:>
+
+C<$Namespace> - (optional) a namespace stringfrom the MOBY namespace ontology, or undef if you don't care
+
+C<\@Simples> - (required) a listref of Simple XML::LibXML nodes i.e. the XML::LibXML representing an XML structure like this:
+
+ <Simple>
+ <Object namespace="NCBI_gi" id="163483"/>
+ </Simple>
+
+Note : If you provide a namespace, it will return *only* the ids that
+are in the given namespace, but will return 'undef' for any articles
+in the WRONG namespace so that you get an equivalent number of outputs
+to inputs.
+
+Note that if you call this with a single argument, this is assumed to
+be C<\@Articles>, so you will get ALL id's regardless of namespace!
=cut
-#Eddie - converted
+
sub getSimpleArticleIDs {
my ( $desired_namespace, $input_nodes ) = @_;
if ( $desired_namespace && !$input_nodes )
@@ -569,9 +563,10 @@
$OS->namespaceExists( term => $desired_namespace ); # returns (success, message, lsid)
unless ( $s ) { # bail if not successful
# Printing to STDERR is not very helpful - we should probably return something that can be dealt iwth programatically....
- print STDERR "MOBY::CommonSubs WARNING ** the namespace '$desired_namespace' "
- . "does not exist in the MOBY ontology, and does not have a valid LSID\n";
- return undef;
+ die("MOBY::CommonSubs: the namespace '$desired_namespace' "
+ . "does not exist in the MOBY ontology, "
+ . "and does not have a valid LSID");
+# return undef;
}
$desired_namespace = $namespace_lsid; # Replace namespace with fully-qualified LSID
}
@@ -579,13 +574,12 @@
foreach my $in ( @input_nodes ) {
next unless $in;
#$in = "<Simple><Object namespace='' id=''/></Simple>"
- next unless $in->nodeName =~ /Simple/; # only allow simples
+ next unless $in->nodeName =~ /^(moby:|)Simple$/; # only allow simples
my @simples = $in->childNodes;
foreach ( @simples ) { # $_ = <Object namespace='' id=''/>
next unless $_->nodeType == ELEMENT_NODE;
if ( $desired_namespace ) {
- my $ns = $_->getAttributeNode( 'namespace' ) # get the namespace DOM node
- || $_->getAttributeNode( 'moby:namespace' );
+ my $ns = _moby_getAttributeNode($_, 'namespace' ); # get the namespace DOM node
unless ( $ns ) { # if we don't get it at all, then move on to the next input
push @ids, undef; # but push an undef onto teh stack in order
next;
@@ -594,7 +588,7 @@
( $s, $m, $ns ) = $OS->namespaceExists( term => $ns );
# A bad namespace will return 'undef' which makes for a bad comparison (Perl warning).
# Better to check directly for success ($s), THEN check that namespace is the one we wanted.
- unless ( $s && $ns eq $desired_namespace )
+ unless ( $s && $ns eq $desired_namespace )
{ # we are registering as working in a particular namespace, so check this
push @ids, undef; # and push undef onto the stack if it isn't
next;
@@ -602,7 +596,7 @@
}
# Now do the same thing for ID's
- my $id = $_->getAttributeNode( 'id' ) || $_->getAttributeNode( 'moby:id' );
+ my $id = _moby_getAttributeNode($_, 'id' );
unless ( $id ) {
push @ids, undef;
next;
@@ -620,31 +614,34 @@
=head2 getSimpleArticleNamespaceURI
- function : to get the namespace of a simple article
- usage : my $ns = getSimpleArticleNamespaceURI($SimpleArticle);
- args : $Simple - (required) a single XML::LibXML node representing a Simple Article
- i.e. the XML::LibXML representing an XML structure like this:
- <Simple>
- <Object namespace="NCBI_gi" id="163483"/>
- </Simple>
+B<function:> to get the namespace of a simple article
+
+B<usage:> C<my $ns = getSimpleArticleNamespaceURI($SimpleArticle);>
+
+B<args:> C<$Simple> - (required) a single XML::LibXML node
+representing a Simple Article i.e. the XML::LibXML representing an XML
+structure like this:
+
+ <Simple>
+ <Object namespace="NCBI_gi" id="163483"/>
+ </Simple>
=cut
-#Eddie - converted
+
sub getSimpleArticleNamespaceURI {
# pass me a <SIMPLE> input node and I will give you the lsid of the namespace of that input object
my ( $input_node ) = @_;
return undef unless $input_node;
my $OS = MOBY::Client::OntologyServer->new;
-
+
#$input_node = "<Simple><Object namespace='' id=''/></Simple>"
my @simples = $input_node->childNodes;
foreach ( @simples )
{ # $_ = <Object namespace='' id=''/> # should be just one, so I will return at will from this routine
next unless $_->nodeType == ELEMENT_NODE;
- my $ns = $_->getAttributeNode( 'namespace' ) # get the namespace DOM node
- || $_->getAttributeNode( 'moby:namespace' );
+ my $ns = _moby_getAttributeNode($_, 'namespace' ); # get the namespace DOM node
return undef unless ( $ns ); # if we don't get it at all, then move on to the next input
my ( $s, $m, $lsid ) =
$OS->namespaceExists( term => $ns->getValue ); # if we have a namespace, then get its value
@@ -653,306 +650,111 @@
}
}
-=head2 simpleResponse
+sub _string_to_DOM {
+# Convert string to DOM.
+# If DOM passed in, just return it (i.e., this should be idempotent)
+# By Frank Gibbons, Aug. 2005
+# Utility subroutine, not for external use (no export), widely used in this package.
+ my $XML = shift;
+ my $moby;
+ return $XML if ( ref($XML) =~ /^XML\:\:LibXML/ );
- function : wraps a simple article in the appropriate (mobyData) structure
- usage : $resp .= &simpleResponse($object, 'MyArticleName', $queryID);
- args : (in order)
- $object - (optional) a MOBY Object as raw XML
- $article - (optional) an articeName for this article
- $query - (optional, but strongly recommended) the queryID value for the
- mobyData block to which you are responding
- notes : as required by the API you must return a response for every input.
- If one of the inputs was invalid, you return a valid (empty) MOBY
- response by calling &simpleResponse(undef, undef, $queryID) with no arguments.
+ my $parser = XML::LibXML->new();
+ my $doc;
+ eval { $doc = $parser->parse_string( $XML ) };
+ die("CommonSubs couldn't parse XML '$XML' because\n\t$@") if $@;
+ return $doc->getDocumentElement();
+}
-=cut
+=head2 getInputs
-sub simpleResponse {
- my ( $data, $articleName, $qID ) = @_; # articleName optional
- $qID = &_getQueryID( $qID )
- if ref( $qID ) =~ /XML\:\:LibXML/; # in case they send the DOM instead of the ID
- $data ||= ''; # initialize to avoid uninit value errors
- $articleName ||= "";
- $qID ||= "";
- if ( $articleName || $data) { # Linebreaks in XML make it easier for human debuggers to read!
- return "
- <moby:mobyData moby:queryID='$qID'>
- <moby:Simple moby:articleName='$articleName'>$data</moby:Simple>
- </moby:mobyData>
- ";
- } else {
- return "
- <moby:mobyData moby:queryID='$qID'/>
- ";
- }
-}
+B<function:> get the mobyData block(s) as XML::LibXML nodes
-#Eddie - converted
-sub _getQueryID {
- my ( $query ) = @_;
- $query = _string_to_XML($query);
- return '' unless ( $query->nodeName =~ /queryInput|mobyData/ ); #Eddie - unsure
- return ($query->getAttribute( 'queryID' )
- || $query->getAttribute( 'moby:queryID' ));
-}
+B<usage:> C<@queryInputs = getInputArticles($XML)>
-=head2 collectionResponse
+B<args:> the raw XML of a <MOBY> query, or an XML::LibXML document
- function : wraps a set of articles in the appropriate mobyData structure
- usage : return responseHeader . &collectionResponse(\@objects, 'MyArticleName', $queryID) . responseFooter;
- args : (in order)
- \@objects - (optional) a listref of MOBY Objects as raw XML
- $article - (optional) an articeName for this article
- $queryID - (optional, but strongly recommended) the mobyData ID
- to which you are responding
- notes : as required by the API you must return a response for every input.
- If one of the inputs was invalid, you return a valid (empty) MOBY
- response by calling &collectionResponse(undef, undef, $queryID).
+B<returns:> a list of XML::LibXML::Node's, each is a queryInput or mobyData block.
+
+B< Note:> Remember that these blocks are enumerated! This is what you
+pass as the third argument to the simpleResponse or collectionResponse
+subroutine to associate the numbered input to the numbered response
=cut
-sub collectionResponse {
- my ( $data, $articleName, $qID ) = @_; # articleName optional
- my $content = "";
- $data ||= [];
- $qID ||= '';
- unless ( ( ref($data) eq 'ARRAY' ) && $data->[0] )
- { # we're expecting an arrayref as input data,and it must not be empty
- return "<moby:mobyData moby:queryID='$qID'/>";
- }
- foreach ( @{$data} ) {
- if ( $_ ) {
- $content .= "
- <moby:Simple>$_</moby:Simple>
- ";
- } else {
- $content .= "
- <moby:Simple/>
- ";
+sub getInputs {
+ my ( $XML ) = @_;
+ my $moby = _string_to_DOM($XML);
+ my @queries;
+ foreach my $querytag qw( queryInput moby:queryInput mobyData moby:mobyData )
+ {
+ my $x = $moby->getElementsByTagName( $querytag ); # get the mobyData block
+ for ( 1 .. $x->size() ) { # there may be more than one mobyData per message
+ push @queries, $x->get_node( $_ );
+ }
}
- }
- if ( $articleName ) {
- return "
- <moby:mobyData moby:queryID='$qID'>
- <moby:Collection moby:articleName='$articleName'>
- $content
- </moby:Collection>
- </moby:mobyData>
- ";
- } else {
- return "
- <moby:mobyData moby:queryID='$qID'>
- <moby:Collection moby:articleName='$articleName'>$content</moby:Collection>
- </moby:mobyData>
- ";
- }
+ return @queries; # return them in the order that they were discovered.
}
-=head2 complexResponse
+=head2 getInputID
- function : wraps articles in the appropriate (mobyData) structure
- usage : $resp .= &complexResponse(\@data, $qID);
- args : (in order)
- \@data - (optional) a listref of arrays.
- each element of @data is itself a listref of [$articleName, $XML]
- $qID - (optional, but strongly recommended) the queryID value for the
- mobyData block to which you are responding
- notes : as required by the API you must return a response for every input.
- If one of the inputs was invalid, you return a valid (empty) MOBY
- response by calling &complexResponse(undef, $queryID) with no arguments.
+B<function:> get the value of the queryID element
-=cut
+B<usage:> C<@queryInputs = getInputID($XML)>
-sub complexResponse {
- my ( $data, $qID ) = @_;
- #return 'ERROR: expected listref [element1, element2, ...] for data' unless ( ref( $data ) =~ /array/i );
- return "<moby:mobyData moby:queryID='$qID'/>\n"
- unless ( ref( $data ) eq 'ARRAY' );
- $qID = &_getQueryID( $qID )
- if ref( $qID ) =~ /XML\:\:LibXML/; # in case they send the DOM instead of the ID
- my @inputs = @{$data};
- my $output = "<moby:mobyData queryID='$qID'>";
- foreach ( @inputs ) {
- #return 'ERROR: expected listref [articleName, XML] for data element' unless ( ref( $_ ) =~ /array/i );
- return "<moby:mobyData moby:queryID='$qID'/>\n" unless ( ref($_) eq 'ARRAY' );
- while ( my ( $articleName, $XML ) = splice( @{$_}, 0, 2 ) ) {
- if ( ref($XML) ne 'ARRAY' ) {
- $articleName ||= "";
- $XML ||= "";
- if ( ( $XML =~ /\<Value\>/ ) || ( $XML =~ /\<moby\:Value\>/ ) )
- {
- $output .=
- "<moby:Parameter moby:articleName='$articleName'>$XML</moby:Parameter>";
- } else {
- $output .=
- "<moby:Simple moby:articleName='$articleName'>\n$XML\n</moby:Simple>\n";
- }
-
- # need to do this for collections also!!!!!!
- } elsif ( ref($XML) eq 'ARRAY' ) {
- my @objs = @{$XML};
- $output .= "<moby:Collection moby:articleName='$articleName'>\n";
- foreach ( @objs ) {
- $output .= "<moby:Simple>$_</moby:Simple>\n";
- }
- $output .= "</moby:Collection>\n";
- }
- }
- }
- $output .= "</moby:mobyData>\n";
- return $output;
-}
+B<args:> the raw XML or XML::LibXML of a queryInput or mobyData block (e.g. from getInputs)
-=head2 responseHeader
+B<returns:> integer, or ''
- function : print the XML string of a MOBY response header +/- serviceNotes
- usage : responseHeader('illuminae.com')
- responseHeader(
- -authority => 'illuminae.com',
- -note => 'here is some data from the service provider')
- args : a string representing the service providers authority URI,
- OR a set of named arguments with the authority and the
- service provision notes.
- caveat :
- notes : returns everything required up to the response articles themselves.
- i.e. something like:
- <?xml version='1.0' encoding='UTF-8'?>
- <moby:MOBY xmlns:moby='http://www.biomoby.org/moby'>
- <moby:Response moby:authority='http://www.illuminae.com'>
-
-
-=cut
-
-sub responseHeader {
- use HTML::Entities ();
- my ( $auth, $notes ) = &_rearrange( [qw[AUTHORITY NOTE]], @_ );
- $auth ||= "not_provided";
- $notes ||= "";
- my $xml =
- "<?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='$auth'>";
- if ( $notes ) {
- my $encodednotes = HTML::Entities::encode( $notes );
- $xml .= "<moby:serviceNotes>$encodednotes</moby:serviceNotes>";
- }
- return $xml;
-}
-
-=head2 responseFooter
-
- function : print the XML string of a MOBY response footer
- usage : return responseHeader('illuminae.com') . $DATA . responseFooter;
- notes : returns everything required after the response articles themselves
- i.e. something like:
-
- </moby:Response>
- </moby:MOBY>
-
-=cut
-
-sub responseFooter {
- return "</moby:mobyContent></moby:MOBY>";
-}
-
-
-sub _string_to_DOM {
-# Convert string to DOM.
-# If DOM passed in, just return it (i.e., this should be idempotent)
-# By Frank Gibbons, Aug. 2005
-# Utility subroutine, not for external use (no export), widely used in this package.
- my $XML = shift;
- my $moby;
- return $XML if ( ref($XML) =~ /^XML\:\:LibXML/ );
-
- my $parser = XML::LibXML->new();
- my $doc;
- eval { $doc = $parser->parse_string( $XML ) };
- die("CommonSubs couldn't parse XML '$XML' because\n\t$@") if $@;
- return $doc->getDocumentElement();
-}
-
-=head2 getInputs
-
- function : get the mobyData block(s) as XML::LibXML nodes
- usage : @queryInputs = getInputArticles($XML)
- args : the raw XML of a <MOBY> query, or an XML::LibXML document
- returns : a list of XML::LibXML::Node's, each is a queryInput or mobyData block.
- Note : Remember that these blocks are enumerated! This is what you
- pass as the third argument to the simpleResponse or collectionResponse
- subroutine to associate the numbered input to the numbered response
-
-=cut
-
-#Eddie - converted
-sub getInputs {
- my ( $XML ) = @_;
- my $moby = _string_to_DOM($XML);
- my @queries;
- foreach my $querytag qw( queryInput moby:queryInput mobyData moby:mobyData )
- {
- my $x = $moby->getElementsByTagName( $querytag ); # get the mobyData block
- for ( 1 .. $x->size() ) { # there may be more than one mobyData per message
- push @queries, $x->get_node( $_ );
- }
- }
- return @queries; # return them in the order that they were discovered.
-}
-
-=head2 getInputID
-
- function : get the value of the queryID element
- usage : @queryInputs = getInputID($XML)
- args : the raw XML or XML::LibXML of a queryInput or mobyData block (e.g. from getInputs)
- returns : integer, or ''
- Note : Inputs and Responses are coordinately enumerated!
- The integer you get here is what you
- pass as the third argument to the simpleResponse or collectionResponse
- subroutine to associate the numbered input to the numbered response
+B< Note:> Inputs and Responses are coordinately enumerated! The
+integer you get here is what you pass as the third argument to the
+simpleResponse or collectionResponse subroutine to associate the
+numbered input to the numbered response
=cut
sub getInputID {
my ( $XML ) = @_;
my $moby = _string_to_DOM($XML);
- return '' unless ( $moby->nodeName =~ /queryInput|mobyData/ );
- my $qid = $moby->getAttribute( 'queryID' )
- || $moby->getAttribute( 'moby:queryID' );
+ return '' unless ( $moby->nodeName =~ /^(moby:|)queryInput|mobyData$/ );
+ my $qid = _moby_getAttribute($moby, 'queryID' );
return defined( $qid ) ? $qid : '';
}
=head2 getArticlesAsObjects
DO NOT USE!!
- function : get the Simple/Collection articles for a single mobyData
- or queryResponse node, rethrning them as SimpleArticle,
- SecondaryArticle, or ServiceInstance objects
- usage : @articles = getArticles($XML)
- args : raw XML or XML::LibXML of a moby:mobyData block
- returns :
+
+B<function:> get the Simple/Collection articles for a single mobyData
+or queryResponse node, rethrning them as SimpleArticle,
+SecondaryArticle, or ServiceInstance objects
+
+B<usage:> C<@articles = getArticles($XML)>
+
+B<args:> raw XML or XML::LibXML of a moby:mobyData block
+
+B<returns:>
=cut
-#Eddie - converted
sub getArticlesAsObjects {
my ( $moby ) = @_;
$moby = _string_to_DOM($moby);
return undef unless $moby->nodeType == ELEMENT_NODE;
return undef
- unless ($moby->nodeName =~ /queryInput|queryResponse|mobyData/);
+ unless ($moby->nodeName =~ /^(moby:|)(queryInput|queryResponse|mobyData)$/);
my @articles;
foreach my $child ( $moby->childNodes )
{ # there may be more than one Simple/Collection per input; iterate over them
next unless $child->nodeType == ELEMENT_NODE; # ignore whitespace
next
- unless ( $child->nodeName =~ /Simple|Collection|Parameter/ );
+ unless ( $child->nodeName =~ /^(moby:|)(Simple|Collection|Parameter)$/ );
my $object;
- if ( $child->nodeName =~ /Simple/ ) {
+ if ( $child->nodeName =~ /^(moby:|)Simple$/ ) {
$object = MOBY::Client::SimpleArticle->new( XML_DOM => $child );
- } elsif ( $child->nodeName =~ /Collection/ ) {
+ } elsif ( $child->nodeName =~ /^(moby:|)Collection$/ ) {
$object = MOBY::Client::CollectionArticle->new( XML_DOM => $child );
- } elsif ( $child->nodeName =~ /Parameter/ ) {
+ } elsif ( $child->nodeName =~ /^(moby:|)Parameter$/ ) {
$object = MOBY::Client::SecondaryArticle->new( XML_DOM => $child );
}
next unless $object;
@@ -963,10 +765,13 @@
=head2 getCollectedSimples
- function : get the Simple articles collected in a moby:Collection block
- usage : @Simples = getCollectedSimples($XML)
- args : raw XML or XML::LibXML of a moby:Collection block
- returns : a list of XML::LibXML nodes, each of which is a moby:Simple block
+B<function:> get the Simple articles collected in a moby:Collection block
+
+B<usage:> C<@Simples = getCollectedSimples($XML)>
+
+B<args:> raw XML or XML::LibXML of a moby:Collection block
+
+B<returns:> a list of XML::LibXML nodes, each of which is a moby:Simple block
=cut
@@ -974,31 +779,36 @@
my ( $moby ) = @_;
$moby = _string_to_DOM($moby);
return undef unless $moby->nodeType == ELEMENT_NODE;
- return undef unless ( $moby->nodeName =~ /Collection$/ );
+ return undef unless ( $moby->nodeName =~ /^(moby\:|)Collection$/ );
my @articles;
foreach my $child ( $moby->childNodes )
{ # there may be more than one Simple/Collection per input; iterate over them
next unless $child->nodeType == ELEMENT_NODE; # ignore whitespace
- next unless ( $child->nodeName =~ /Simple$/ );
+ next unless ( $child->nodeName =~ /^(moby\:|)Simple$/ );
push @articles, $child; # take the child elements, which are <Simple/> or <Collection/>
}
- return ( @articles ); # return them.
+ return @articles; # return them.
}
=head2 getInputArticles
- function : get the Simple/Collection articles for each input query, in order
- usage : @queries = getInputArticles($XML)
- args : the raw XML of a moby:MOBY query
- returns : a list of listrefs, each listref is the input to a single query.
- Remember that the input to a single query may be one or more Simple
- and/or Collection articles. These are provided as XML::LibXML nodes.
-
+
+B<function:> get the Simple/Collection articles for each input query, in order
+
+B<usage:> C<@queries = getInputArticles($XML)>
+
+B<args:> the raw XML of a moby:MOBY query
+
+B<returns:> a list of listrefs, each listref is the input to a single
+query. Remember that the input to a single query may be one or more
+Simple and/or Collection articles. These are provided as XML::LibXML
+nodes.
+
i.e.: @queries = ([$SIMPLE_DOM_NODE], [$SIMPLE_DOM_NODE2])
or : @queries = ([$COLLECTION_DOM_NODE], [$COLLECTION_DOM_NODE2])
-
+
The former is generated from the following XML:
-
+
...
<moby:mobyContent>
<moby:mobyData>
@@ -1016,7 +826,6 @@
=cut
-#Eddie - converted
sub getInputArticles {
my ( $moby ) = @_;
$moby = _string_to_DOM($moby);
@@ -1039,71 +848,17 @@
return @queries; # return them in the order that they were discovered.
}
-=head2 isSimpleArticle
-
- function : tests XML (text) or an XML DOM node to see if it represents a Simple article
- usage : if (isSimpleArticle($node)){do something to it}
- input : an XML::LibXML node, an XML::LibXML::Document or straight XML
- returns : boolean
-
-=cut
-
-#Eddie - converted
-sub isSimpleArticle {
- my ( $DOM ) = @_;
- eval { $DOM = _string_to_DOM($DOM) };
- if ($@) {
- return 0;
- }
- $DOM = $DOM->getDocumentElement if ( $DOM->isa( "XML::LibXML::Document" ) );
- return ($DOM->nodeName =~ /^(moby:|)Simple$/) ? 1 : 0; #Optional 'moby:' namespace prefix
-}
-
-=head2 isCollectionArticle
-
- function : tests XML (text) or an XML DOM node to see if it represents a Collection article
- usage : if (isCollectionArticle($node)){do something to it}
- input : an XML::LibXML node, an XML::LibXML::Document or straight XML
- returns : boolean
-
-=cut
-
-#Eddie - converted
-sub isCollectionArticle {
- my ( $DOM ) = @_;
- eval {$DOM = _string_to_DOM($DOM) };
- return 0 if $@;
- $DOM = $DOM->getDocumentElement if ( $DOM->isa( "XML::LibXML::Document" ) );
- return ( $DOM->nodeName =~ /^(moby\:|)Collection$/ ) ? 1 : 0; #Optional 'moby:' prefix
-}
-
-=head2 isSecondaryArticle
-
- function : tests XML (text) or an XML DOM node to see if it represents a Secondary article
- usage : if (isSecondaryArticle($node)){do something to it}
- input : an XML::LibXML node, an XML::LibXML::Document or straight XML
- returns : boolean
-
-=cut
+=head2 extractRawContent
-#Eddie - converted
-sub isSecondaryArticle {
- my ( $XML ) = @_;
- my $DOM;
- eval {$DOM = _string_to_DOM($XML)} ;
- return 0 if $@;
- $DOM = $DOM->getDocumentElement if ( $DOM->isa( "XML::LibXML::Document" ) );
- return ($DOM->nodeName =~ /^(moby\:|)Parameter$/) ? 1 : 0; #Optional 'moby:' prefix
-}
+B<function:> pass me an article (Simple, or Collection) and I'll give
+you the content AS A STRING - i.e. the raw XML of the contained MOBY
+Object(s)
+B<usage:> C<extractRawContent($simple)>
-=head2 extractRawContent
+B<input:> the one element of the output from getArticles
- function : pass me an article (Simple, or Collection) and I'll give you the
- content AS A STRING - i.e. the raw XML of the contained MOBY Object(s)
- usage : extractRawContent($simple)
- input : the one element of the output from getArticles
- returns : string
+B<returns:> string
=cut
@@ -1114,37 +869,36 @@
foreach ( $article->childNodes ) {
$response .= $_->toString;
}
- print STDERR "RESPONSE = $response\n";
+# print STDERR "RESPONSE = $response\n";
return $response;
}
=head2 getNodeContentWithArticle
- function : a very flexible way to get the stringified content of a node
- that has the correct element and article name
- or get the value of a Parameter element.
- usage : @strings = getNodeContentWithArticle($node, $tagname, $articleName)
- args : (in order)
- $node - an XML::LibXML node, or straight XML. It may even
- be the entire mobyData block.
- $tagname - the tagname (effectively from the Object type ontology),
- or "Parameter" if you are trying to get secondaries
- $articleName - the articleName that we are searching for.
- to get the content of the primary object, leave
- this field blank!
-
- returns : an ARRAY of the stringified text content for each
- node that matched the tagname/articleName specified; one
- array element for each matching node. Newlines are NOT considered
- new nodes (as they are in normal XML).
-
- notes : This was written for the purpose of getting the values of
- String, Integer, Float, Date_Time, and other such primitives.
+B<function:> a very flexible way to get the stringified content of a
+node that has the correct element and article name or get the value of
+a Parameter element.
+
+B<usage:> C<@strings = getNodeContentWithArticle($node, $tagname, $articleName)>
+
+B<args:> (in order)
+
+C<$node> - an XML::LibXML node, or straight XML. It may even be the entire mobyData block.
+C<$tagname> - the tagname (effectively from the Object type ontology), or "Parameter" if you are trying to get secondaries
+C<$articleName> - the articleName that we are searching for. to get the content of the primary object, leave this field blank!
+
+
+B<returns:> an ARRAY of the stringified text content for each
+node that matched the tagname/articleName specified; one
+array element for each matching node. Newlines are NOT considered
+new nodes (as they are in normal XML).
+
+B<notes:> This was written for the purpose of getting the values of
+String, Integer, Float, Date_Time, and other such primitives.
For example, in the following XML:
...
- ...
<moby:mobyContent>
<moby:mobyData>
<Simple>
@@ -1156,8 +910,7 @@
</moby:mobyData>
</moby:mobyContent>
...
- ...
-
+
would be analysed as follows:
# get $input - e.g. from genericServiceInputParser or complexServiceInputParser
@@ -1166,7 +919,6 @@
For Parameters, such as the following
...
- ...
<moby:mobyContent>
<moby:mobyData>
<Simple>
@@ -1181,7 +933,6 @@
</moby:mobyData>
</moby:mobyContent>
...
- ...
You would parse it as follows:
@@ -1208,7 +959,6 @@
=cut
-#Eddie - converted
sub getNodeContentWithArticle {
# give me a DOM, a TagName, an articleName and I will return you the content
# of that node **as a string** (beware if there are additional XML tags in there!)
@@ -1241,13 +991,8 @@
# if there is an articleName, then get that specific node
for ( 1 .. $nodes->size() ) {
my $child = $nodes->get_node( $_ );
- if (
- ( $child->getAttribute("articleName")
- && ( $child->getAttribute("articleName") eq $articleName )
- )
- || ( $child->getAttribute("moby:articleName")
- && ( $child->getAttribute("moby:articleName") eq $articleName )
- )
+ if ( _moby_getAttribute($child, "articleName")
+ && ( $child->getAttribute("articleName") eq $articleName )
)
{
# now we have a valid child, get the content... stringified... regardless of what it is
@@ -1280,62 +1025,21 @@
return @contents;
}
-=head2 validateNamespaces
-
- function : checks the namespace ontology for the namespace lsid
- usage : @LSIDs = validateNamespaces(@namespaces)
- args : ordered list of either human-readable or lsid presumptive namespaces
- returns : ordered list of the LSID's corresponding to those
- presumptive namespaces; undef for each namespace that was invalid
-
-
-=cut
-
-sub validateNamespaces {
- # give me a list of namespaces and I will return the LSID's in order
- # I return undef in that list position if the namespace is invalid
- my ( @namespaces ) = @_;
- my $OS = MOBY::Client::OntologyServer->new;
- my @lsids;
- foreach ( @namespaces ) {
- my ( $s, $m, $LSID ) = $OS->namespaceExists( term => $_ );
- push @lsids, $s ? $LSID : undef;
- }
- return @lsids;
-}
-
-=head2 validateThisNamespace
+*getResponseArticles = \&extractResponseArticles;
+*getResponseArticles = \&extractResponseArticles;
- function : checks a given namespace against a list of valid namespaces
- usage : $valid = validateThisNamespace($ns, @validNS);
- args : ordered list of the namespace of interest and the list of valid NS's
- returns : boolean
+=head2 getResponseArticles (a.k.a. extractResponseArticles)
-=cut
+B<function:> get the DOM nodes corresponding to individual Simple or Collection outputs from a MOBY Response
-sub validateThisNamespace {
- my ( $ns, @namespaces ) = @_;
- return 1 unless scalar @namespaces; # if you don't give me a list, I assume everything is valid...
- @namespaces = @{$namespaces[0]} # if you send me an arrayref I should be kind... DWIM!
- if ( ref $namespaces[0] eq 'ARRAY' );
- return grep /$ns/, @namespaces;
-}
+B<usage:> C<($collections, $simples) = getResponseArticles($node)>
-=head2 getResponseArticles (a.k.a. extractResponseArticles)
+B<args:> C<$node> - either raw XML or an XML::LibXML::Document to be searched
- function : get the DOM nodes corresponding to individual
- Simple or Collection outputs from a MOBY Response
- usage : ($collections, $simples) = getResponseArticles($node)
- args : $node - either raw XML or an XML::LibXML::Document to be searched
- returns : an array-ref of Collection article XML::LibXML::Node's
- an array-ref of Simple article XML::LibXML::Node's
+B<returns:> an array-ref of Collection article XML::LibXML::Node's or an array-ref of Simple article XML::LibXML::Node's
=cut
-*getResponseArticles = \&extractResponseArticles;
-*getResponseArticles = \&extractResponseArticles;
-
-#Eddie - converted
sub extractResponseArticles {
my ( $result ) = @_;
return ( [], [] ) unless $result;
@@ -1351,8 +1055,8 @@
my @collections;
my @Xrefs;
my $success = 0;
- foreach my $which ( 'moby:queryResponse', 'queryResponse', 'mobyData',
- 'moby:mobyData' )
+ foreach my $which ( 'moby:queryResponse', 'queryResponse',
+ 'mobyData', 'moby:mobyData' )
{
my $responses = $moby->getElementsByTagName( $which );
next unless $responses;
@@ -1360,23 +1064,19 @@
my $resp = $responses->get_node( $n );
foreach my $response_component ( $resp->childNodes ) {
next unless $response_component->nodeType == ELEMENT_NODE;
- if ( ( $response_component->nodeName eq "Simple" )
- || ( $response_component->nodeName eq "moby:Simple" ) )
- {
+ if ( $response_component->nodeName =~ /^(moby:|)Simple$/ )
+ {
foreach my $Object ( $response_component->childNodes ) {
next unless $Object->nodeType == ELEMENT_NODE;
$success = 1;
push @objects, $Object;
}
- } elsif ( ( $response_component->nodeName eq "Collection" )
- || ( $response_component->nodeName eq "moby:Collection" ) )
+ } elsif ( $response_component->nodeName =~ /^(moby:|)Collection$/ )
{
my @objects;
foreach my $simple ( $response_component->childNodes ) {
next unless $simple->nodeType == ELEMENT_NODE;
- next
- unless ( ( $simple->nodeName eq "Simple" )
- || ( $simple->nodeName eq "moby:Simple" ) );
+ next unless ( $simple->nodeName =~ /^(moby:|)Simple$/ );
foreach my $Object ( $simple->childNodes ) {
next unless $Object->nodeType == ELEMENT_NODE;
$success = 1;
@@ -1392,16 +1092,125 @@
return ( \@collections, \@objects );
}
+
+
+=head1 IDENTITY AND VALIDATION
+
+This section describes functionality associated with identifying parts of a message,
+and checking that it is valid.
+
+=head2 isSimpleArticle, isCollectionArticle, isSecondaryArticle
+
+B<function:> tests XML (text) or an XML DOM node to see if it represents a Simple, Collection, or Secondary article
+
+B<usage:>
+
+ if (isSimpleArticle($node)){do something to it}
+
+or
+
+ if (isCollectionArticle($node)){do something to it}
+
+or
+
+ if (isSecondaryArticle($node)){do something to it}
+
+B< input :> an XML::LibXML node, an XML::LibXML::Document or straight XML
+
+B<returns:> boolean
+
+=cut
+
+sub isSimpleArticle {
+ my ( $DOM ) = @_;
+ eval { $DOM = _string_to_DOM($DOM) };
+ return 0 if $@;
+ $DOM = $DOM->getDocumentElement if ( $DOM->isa( "XML::LibXML::Document" ) );
+ return ($DOM->nodeName =~ /^(moby:|)Simple$/) ? 1 : 0; #Optional 'moby:' namespace prefix
+}
+
+sub isCollectionArticle {
+ my ( $DOM ) = @_;
+ eval {$DOM = _string_to_DOM($DOM) };
+ return 0 if $@;
+ $DOM = $DOM->getDocumentElement if ( $DOM->isa( "XML::LibXML::Document" ) );
+ return ( $DOM->nodeName =~ /^(moby\:|)Collection$/ ) ? 1 : 0; #Optional 'moby:' prefix
+}
+
+sub isSecondaryArticle {
+ my ( $XML ) = @_;
+ my $DOM;
+ eval {$DOM = _string_to_DOM($XML)} ;
+ return 0 if $@;
+ $DOM = $DOM->getDocumentElement if ( $DOM->isa( "XML::LibXML::Document" ) );
+ return ($DOM->nodeName =~ /^(moby\:|)Parameter$/) ? 1 : 0; #Optional 'moby:' prefix
+}
+
+
+=head2 validateNamespaces
+
+B<function:> checks the namespace ontology for the namespace lsid
+
+B<usage:> C<@LSIDs = validateNamespaces(@namespaces)>
+
+B<args:> ordered list of either human-readable or lsid presumptive namespaces
+
+B<returns:> ordered list of the LSID's corresponding to those
+presumptive namespaces; undef for each namespace that was invalid
+
+=cut
+
+sub validateNamespaces {
+ # give me a list of namespaces and I will return the LSID's in order
+ # I return undef in that list position if the namespace is invalid
+ my ( @namespaces ) = @_;
+ my $OS = MOBY::Client::OntologyServer->new;
+ my @lsids;
+ foreach ( @namespaces ) {
+ my ( $s, $m, $LSID ) = $OS->namespaceExists( term => $_ );
+ push @lsids, $s ? $LSID : undef;
+ }
+ return @lsids;
+}
+
+=head2 validateThisNamespace
+
+B<function:> checks a given namespace against a list of valid namespaces
+
+B<usage:> C<$valid = validateThisNamespace($ns, @validNS);>
+
+B<args:> ordered list of the namespace of interest and the list of valid NS's
+
+B<returns:> boolean
+
+=cut
+
+sub validateThisNamespace {
+ my ( $ns, @namespaces ) = @_;
+ return 1 unless scalar @namespaces; # if you don't give me a list, I assume everything is valid...
+ @namespaces = @{$namespaces[0]} # if you send me an arrayref I should be kind... DWIM!
+ if ( ref $namespaces[0] eq 'ARRAY' );
+ return grep /$ns/, @namespaces;
+}
+
+
+=head1 ANCILIARY ELEMENTS
+
+This section contains subroutines that handle processing of optional message elements containing
+meta-data. Examples are the ServiceNotes, and CrossReference blocks.
+
=head2 getServiceNotes
- function : to get the content of the Service Notes block of the MOBY message
- usage : getServiceNotes($message)
- args : $message is either the XML::LibXML of the MOBY message, or plain XML
- returns : String content of the ServiceNotes block of the MOBY Message
+B<function:> to get the content of the Service Notes block of the MOBY message
+
+B<usage:> C<getServiceNotes($message)>
+
+B<args:> C<$message> is either the XML::LibXML of the MOBY message, or plain XML
+
+B<returns:> String content of the ServiceNotes block of the MOBY Message
=cut
-#Eddie - converted
sub getServiceNotes {
my ( $result ) = @_;
return ( "" ) unless $result;
@@ -1425,13 +1234,17 @@
=head2 getCrossReferences
- function : to get the cross-references for a Simple article
- usage : @xrefs = getCrossReferences($XML)
- args : $XML is either a SIMPLE article (<Simple>...</Simple>)
- or an object (the payload of a Simple article), and
- may be either raw XML or an XML::LibXML node.
- returns : an array of MOBY::CrossReference objects
- example :
+B<function:> to get the cross-references for a Simple article
+
+B<usage:> C<@xrefs = getCrossReferences($XML)>
+
+B<args:> C<$XML> is either a SIMPLE article (<Simple>...</Simple>) or an
+object (the payload of a Simple article), and may be either raw XML or
+an XML::LibXML node.
+
+B<returns:> an array of MOBY::CrossReference objects
+
+B<example:>
my (($colls, $simps) = getResponseArticles($query); # returns DOM nodes
foreach (@{$simps}){
@@ -1448,14 +1261,13 @@
=cut
-#Eddie - converted
sub getCrossReferences {
my ( $XML ) = @_;
$XML = _string_to_DOM($XML);
my @xrefs;
my @XREFS;
- return () if ( $XML->nodeName =~ /Collection/ );
- if ( $XML->nodeName =~ /Simple/ ) {
+ return () if ( $XML->nodeName =~ /^(moby:|)Collection$/ );
+ if ( $XML->nodeName =~ /^(moby:|)Simple$/ ) {
foreach my $child ( $XML->childNodes ) {
next unless $child->nodeType == ELEMENT_NODE;
$XML = $child;
@@ -1464,54 +1276,352 @@
}
foreach ( $XML->childNodes ) {
next unless (($_->nodeType == ELEMENT_NODE)
- || ($_->nodeName =~ /CrossReference/) );
+ || ($_->nodeName =~ /^(moby:|)CrossReference$/) );
foreach my $xref ( $_->childNodes ) {
next unless ( ($xref->nodeType == ELEMENT_NODE)
- || ($xref->nodeName =~ /Xref|Object/) );
+ || ($xref->nodeName =~ /^(moby:|)(Xref|Object)$/) );
push @xrefs, $xref;
}
}
foreach ( @xrefs ) {
my $x;
- if ($_->nodeName =~ /Xref/) { $x = &_makeXrefType( $_ ) }
- elsif ($_->nodeName =~ /Object/) { $x = &_makeObjectType( $_ ) }
+ if ($_->nodeName =~ /^(moby:|)Xref$/) { $x = _makeXrefType( $_ ) }
+ elsif ($_->nodeName =~ /^(moby:|)Object$/) { $x = _makeObjectType( $_ ) }
push @XREFS, $x if $x;
}
return @XREFS;
}
+
+=head1 CONSTRUCTING OUTPUT
+
+This section describes how to construct output, in response to an
+incoming message. Responses come in three varieties: 'Simple', 'Collection', and
+'Complex' (Collections and Simples together).
+
+=head2 simpleResponse
+
+B<function:> wraps a simple article in the appropriate (mobyData) structure
+
+B<usage:>
+
+ $resp .= simpleResponse($object, 'MyArticleName', $queryID);
+
+B<args:> (in order)
+C<$object> - (optional) a MOBY Object as raw XML
+C<$article> - (optional) an articeName for this article
+C<$query> - (optional, but strongly recommended) the queryID value for the mobyData block to which you are responding
+
+B<notes:> As required by the API you must return a response for every
+input. If one of the inputs was invalid, you return a valid (empty)
+MOBY response by calling simpleResponse(undef, undef, $queryID) with
+no arguments.
+
+=cut
+
+sub simpleResponse {
+ my ( $data, $articleName, $qID ) = @_; # articleName optional
+ $qID = _getQueryID( $qID )
+ if ref( $qID ) =~ /XML\:\:LibXML/; # in case they send the DOM instead of the ID
+ $data ||= ''; # initialize to avoid uninit value errors
+ $articleName ||= "";
+ $qID ||= "";
+ if ( $articleName || $data) { # Linebreaks in XML make it easier for human debuggers to read!
+ return "
+ <moby:mobyData moby:queryID='$qID'>
+ <moby:Simple moby:articleName='$articleName'>$data</moby:Simple>
+ </moby:mobyData>
+ ";
+ } else {
+ return "
+ <moby:mobyData moby:queryID='$qID'/>
+ ";
+ }
+}
+
+
+=head2 collectionResponse
+
+B<function:> wraps a set of articles in the appropriate mobyData structure
+
+B<usage:>
+
+ return responseHeader . collectionResponse(\@objects, 'MyArticleName', $queryID) . responseFooter;
+
+B<args:> (in order)
+C<\@objects> - (optional) a listref of MOBY Objects as raw XML
+C<$article> - (optional) an articeName for this article
+C<$queryID> - (optional, but strongly recommended) the mobyData ID to which you are responding
+
+B<notes:> as required by the API you must return a response for every
+input. If one of the inputs was invalid, you return a valid (empty)
+MOBY response by calling collectionResponse(undef, undef, $queryID).
+
+=cut
+
+sub collectionResponse {
+ my ( $data, $articleName, $qID ) = @_; # articleName optional
+ my $content = "";
+ $data ||= [];
+ $qID ||= '';
+ # The response should only be completely empty when the input $data is completely empty.
+ # Testing just the first element is incorrect.
+ my $not_completely_empty = 0;
+ foreach (@{$data}) { $not_completely_empty += defined $_ }
+ unless ( ( ref($data) eq 'ARRAY' ) && $not_completely_empty )
+ { # we're expecting an arrayref as input data, and it must not be empty
+ return "<moby:mobyData moby:queryID='$qID'/>";
+ }
+ foreach ( @{$data} ) { # Newlines are for ease of human reading (pretty-printing).
+ # It's really hard to keep this kind of thing in sync with itself, but for what it's worth, let's leave it in.
+ if ( $_ ) {
+ $content .= "<moby:Simple>$_</moby:Simple>\n";
+ } else {
+ $content .= "<moby:Simple/>\n";
+ }
+ }
+ if ( $articleName ) {
+ return "
+ <moby:mobyData moby:queryID='$qID'>
+ <moby:Collection moby:articleName='$articleName'>
+ $content
+ </moby:Collection>
+ </moby:mobyData>
+ ";
+ } else {
+ return "
+ <moby:mobyData moby:queryID='$qID'>
+ <moby:Collection moby:articleName='$articleName'>$content</moby:Collection>
+ </moby:mobyData>
+ ";
+ }
+}
+
+=head2 complexResponse
+
+B<function:> wraps articles in the appropriate (mobyData) structure
+
+B<usage:> $resp .= complexResponse(\@data, $qID);
+
+B<args:> (in order)
+
+C<\@data> - (optional) a listref of arrays. each element of @data is
+itself a listref of [$articleName, $XML]
+
+C<$qID> - (optional, but strongly recommended) the queryID value for
+the mobyData block to which you are responding
+
+B<notes:> as required by the API you must return a response for every
+input. If one of the inputs was invalid, you return a valid (empty)
+MOBY response by calling complexResponse(undef, $queryID) with no
+arguments.
+
+=cut
+
+sub complexResponse {
+ my ( $data, $qID ) = @_;
+ #return 'ERROR: expected listref [element1, element2, ...] for data' unless ( ref( $data ) =~ /array/i );
+ return "<moby:mobyData moby:queryID='$qID'/>\n"
+ unless ( ref( $data ) eq 'ARRAY' );
+ $qID = _getQueryID( $qID )
+ if ref( $qID ) =~ /XML\:\:LibXML/; # in case they send the DOM instead of the ID
+ my @inputs = @{$data};
+ my $output = "<moby:mobyData queryID='$qID'>";
+ foreach ( @inputs ) {
+ #return 'ERROR: expected listref [articleName, XML] for data element' unless ( ref( $_ ) =~ /array/i );
+ return "<moby:mobyData moby:queryID='$qID'/>\n"
+ unless ( ref($_) eq 'ARRAY' );
+ while ( my ( $articleName, $XML ) = splice( @{$_}, 0, 2 ) ) {
+ if ( ref($XML) ne 'ARRAY' ) {
+ $articleName ||= "";
+ $XML ||= "";
+ if ( $XML =~ /\<(moby:|)Value\>/ )
+ {
+ $output .=
+ "<moby:Parameter moby:articleName='$articleName'>$XML</moby:Parameter>\n";
+ } else {
+ $output .=
+ "<moby:Simple moby:articleName='$articleName'>\n$XML\n</moby:Simple>\n";
+ }
+
+ # need to do this for collections also!!!!!!
+ } else {
+ my @objs = @{$XML};
+ $output .= "<moby:Collection moby:articleName='$articleName'>\n";
+ foreach ( @objs ) {
+ $output .= "<moby:Simple>$_</moby:Simple>\n";
+ }
+ $output .= "</moby:Collection>\n";
+ }
+ }
+ }
+ $output .= "</moby:mobyData>\n";
+ return $output;
+}
+
+=head2 responseHeader
+
+B<function:> print the XML string of a MOBY response header +/- serviceNotes
+
+B<usage:>
+
+ responseHeader('illuminae.com')
+
+ responseHeader(
+ -authority => 'illuminae.com',
+ -note => 'here is some data from the service provider')
+
+B<args:> a string representing the service providers authority URI, OR
+a set of named arguments with the authority and the service provision
+notes.
+
+B< caveat :>
+
+B<notes:> returns everything required up to the response articles themselves. i.e. something like:
+
+ <?xml version='1.0' encoding='UTF-8'?>
+ <moby:MOBY xmlns:moby='http://www.biomoby.org/moby'>
+ <moby:Response moby:authority='http://www.illuminae.com'>
+
+=cut
+
+sub responseHeader {
+ use HTML::Entities ();
+ my ( $auth, $notes ) = _rearrange( [qw[AUTHORITY NOTE]], @_ );
+ $auth ||= "not_provided";
+ $notes ||= "";
+ my $xml =
+ "<?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='$auth'>";
+ if ( $notes ) {
+ my $encodednotes = HTML::Entities::encode( $notes );
+ $xml .= "<moby:serviceNotes>$encodednotes</moby:serviceNotes>";
+ }
+ return $xml;
+}
+
+=head2 responseFooter
+
+B<function:> print the XML string of a MOBY response footer
+
+B<usage:>
+
+ return responseHeader('illuminae.com') . $DATA . responseFooter;
+
+B<notes:> returns everything required after the response articles themselves i.e. something like:
+
+ </moby:Response>
+ </moby:MOBY>
+
+=cut
+
+sub responseFooter {
+ return "</moby:mobyContent></moby:MOBY>";
+}
+
+
+
+=head1 MISCELLANEOUS
+
+This section contains routines that didn't quite seem to fit anywhere else.
+
+=cut
+
+=head2 _moby_getAttributeNode, _moby_getAttribute
+
+B<function:> Perform the same task as the DOM routine
+getAttribute(Node), but check for both the prefixed and un-prefixed
+attribute name (the prefix in question being, of course,
+"moby:").
+
+B<usage:>
+
+ $id = _moby_getAttribute($xml_libxml, "id");
+
+where C<id> is an attribute in the XML block given as C<$xml_libxml>
+
+B<notes:> This function is intended for use internal to this package
+only. It's not exported.
+
+=cut
+
+sub _moby_getAttributeNode {
+ # Mimics behavior of XML::LibXML method getAttributeNode, but if the unqualified attribute cannot be found,
+ # we qualify it with "moby:" and try again.
+ # We do this so often this module, it's worth having a separate subroutine to do this.
+ my ($xref, $attr) = @_;
+ my ($package, $filename, $line) = caller;
+ if ( !(ref($xref) =~ "^XML\:\:LibXML") ) {
+ warn "_moby_getAttributeNode: Looking for attribute '$attr'"
+ . "Can't parse non-XML argument '$xref',\n"
+ . " called from line $line";
+ return '';
+ }
+ if (!defined $attr) {
+ warn "_moby_getAttributeNode: Non-empty attribute is required"
+ . "\n called from line $line";
+ return '';
+ }
+ return ( $xref->getAttributeNode($attr) || $xref->getAttributeNode( "moby:$attr" ) );
+}
+
+sub _moby_getAttribute {
+ # Mimics behavior of XML::LibXML method getAttribute, but if the unqualified attribute cannot be found,
+ # we qualify it with "moby:" and try again.
+ # We do this so often this module, it's worth having a separate subroutine to do this.
+ my ($xref, $attr) = @_;
+ my ($package, $filename, $line) = caller;
+ if ( !(ref($xref) =~ "^XML\:\:LibXML")) {
+ warn "_moby_getAttribute: Looking for attribute '$attr', "
+ ."can't parse non-XML argument '$xref'\n"
+ . "_moby_getAttribute called from line $line";
+ return '';
+ }
+ if (!defined $attr) {
+ warn "_moby_getAttribute: Non-empty attribute is required"
+ . "\n called from line $line";
+ return '';
+ }
+ return ( $xref->getAttribute($attr) || $xref->getAttribute("moby:$attr") );
+}
+
=head2 whichDeepestParentObject
- function : select the parent node from nodeList that is
- closest to the querynode
- usage : ($term, $lsid) = whichDeepestParentObject($CENTRAL, $queryTerm, \@termList)
- args : $CENTRAL - your MOBY::Client::Central object
- $queryTerm - the object type I am interested in
- \@termlist - the list of object types that I know about
- returns : an ontology term and LSID as a scalar, or undef if there
- is no parent of this node in the nodelist.
- (note that it will only return the term if you give it
- term names in the @termList. If you give it
- LSID's in the termList, then both the parameters
- returned will be LSID's - it doesn't back-translate...)
+B<function:> select the parent node from nodeList that is closest to the querynode
+
+B<usage:>
+
+ ($term, $lsid) = whichDeepestParentObject($CENTRAL, $queryTerm, \@termList)
+
+B<args:>
+
+C<$CENTRAL> - your MOBY::Client::Central object
+
+C<$queryTerm> - the object type I am interested in
+
+C<\@termlist> - the list of object types that I know about
+
+B<returns:> an ontology term and LSID as a scalar, or undef if there is
+no parent of this node in the nodelist. note that it will only return
+the term if you give it term names in the @termList. If you give it
+LSID's in the termList, then both the parameters returned will be
+LSID's - it doesn't back-translate...)
=cut
sub whichDeepestParentObject {
my ( $CENTRAL, $queryTerm, $termlist ) = @_;
return ( undef, undef )
- unless ( $CENTRAL
- && $queryTerm
- && $termlist
- && ( ref( $termlist ) =~ /ARRAY/ ) );
+ unless ( $CENTRAL && $queryTerm
+ && $termlist && ( ref( $termlist ) eq 'ARRAY' ) );
my %nodeLSIDs;
my $queryLSID = $CENTRAL->ObjLSID( $queryTerm );
foreach ( @$termlist ) { # get list of known LSIDs
- my $lsid = $CENTRAL->ObjLSID( $_ );
- return ( $_, $lsid )
- if ( $lsid eq $queryLSID )
- ; # of course, if we find it in the list, then return it right away!
- $nodeLSIDs{$lsid} = $_;
+ my $lsid = $CENTRAL->ObjLSID( $_ );
+ return ( $_, $lsid )
+ if ( $lsid eq $queryLSID ); # of course, if we find it in the list, then return it right away!
+ $nodeLSIDs{$lsid} = $_;
}
return ( undef, undef ) unless keys( %nodeLSIDs );
my $isa =
@@ -1528,26 +1638,20 @@
return ( undef, undef );
}
-#Eddie - converted
+
sub _makeXrefType {
my ( $xref ) = @_;
- my $ns = $xref->getAttributeNode( 'namespace' )
- || $xref->getAttributeNode( 'moby:namespace' );
+ my $ns = _moby_getAttributeNode($xref, 'namespace' );
return undef unless $ns;
- my $id = $xref->getAttributeNode( 'id' )
- || $xref->getAttributeNode( 'moby:id' );
+ my $id = _moby_getAttributeNode($xref, 'id' );
return undef unless $id;
- my $xr = $xref->getAttributeNode( 'xref_type' )
- || $xref->getAttributeNode( 'moby:xref_type' );
+ my $xr = _moby_getAttributeNode($xref, 'xref_type' );
return undef unless $xr;
- my $ec = $xref->getAttributeNode( 'evidence_code' )
- || $xref->getAttributeNode( 'moby:evidence_code' );
+ my $ec = _moby_getAttributeNode($xref, 'evidence_code' );
return undef unless $ec;
- my $au = $xref->getAttributeNode( 'authURI' )
- || $xref->getAttributeNode( 'moby:authURI' );
+ my $au = _moby_getAttributeNode($xref, 'authURI' );
return undef unless $au;
- my $sn = $xref->getAttributeNode( 'serviceName' )
- || $xref->getAttributeNode( 'moby:serviceName' );
+ my $sn = _moby_getAttributeNode($xref, 'serviceName' );
return undef unless $sn;
my $XREF = MOBY::CrossReference->new(
type => "xref",
@@ -1561,14 +1665,12 @@
return $XREF;
}
-#Eddie - converted
+
sub _makeObjectType {
my ( $xref ) = @_;
- my $ns = $xref->getAttributeNode( 'namespace' )
- || $xref->getAttributeNode( 'moby:namespace' );
+ my $ns = _moby_getAttributeNode($xref, 'namespace' );
return undef unless $ns;
- my $id = $xref->getAttributeNode( 'id' )
- || $xref->getAttributeNode( 'moby:id' );
+ my $id = _moby_getAttributeNode($xref, 'id');
return undef unless $id;
my $XREF = MOBY::CrossReference->new(
type => "object",
@@ -1577,76 +1679,72 @@
);
}
-# _rearrange stolen from BioPerl's Bio::RootI.pm
-# because it is just so useful!
-
=head2 _rearrange (stolen from BioPerl ;-) )
- Usage : $object->_rearrange( array_ref, list_of_arguments)
- Purpose : Rearranges named parameters to requested order.
- Example : $self->_rearrange([qw(SEQUENCE ID DESC)], at param);
- : Where @param = (-sequence => $s,
- : -desc => $d,
- : -id => $i);
- Returns : @params - an array of parameters in the requested order.
- : The above example would return ($s, $i, $d).
- : Unspecified parameters will return undef. For example, if
- : @param = (-sequence => $s);
- : the above _rearrange call would return ($s, undef, undef)
- Argument : $order : a reference to an array which describes the desired
- : order of the named parameters.
- : @param : an array of parameters, either as a list (in
- : which case the function simply returns the list),
- : or as an associative array with hyphenated tags
- : (in which case the function sorts the values
- : according to @{$order} and returns that new array.)
- : The tags can be upper, lower, or mixed case
- : but they must start with a hyphen (at least the
- : first one should be hyphenated.)
- Source : This function was taken from CGI.pm, written by Dr. Lincoln
- : Stein, and adapted for use in Bio::Seq by Richard Resnick and
- : then adapted for use in Bio::Root::Object.pm by Steve Chervitz,
- : then migrated into Bio::Root::RootI.pm by Ewan Birney.
- Comments :
- : Uppercase tags are the norm,
- : (SAC)
- : This method may not be appropriate for method calls that are
- : within in an inner loop if efficiency is a concern.
- :
- : Parameters can be specified using any of these formats:
- : @param = (-name=>'me', -color=>'blue');
- : @param = (-NAME=>'me', -COLOR=>'blue');
- : @param = (-Name=>'me', -Color=>'blue');
- : @param = ('me', 'blue');
- : A leading hyphenated argument is used by this function to
- : indicate that named parameters are being used.
- : Therefore, the ('me', 'blue') list will be returned as-is.
- :
- : Note that Perl will confuse unquoted, hyphenated tags as
- : function calls if there is a function of the same name
- : in the current namespace:
- : -name => 'foo' is interpreted as -&name => 'foo'
- :
- : For ultimate safety, put single quotes around the tag:
- : ('-name'=>'me', '-color' =>'blue');
- : This can be a bit cumbersome and I find not as readable
- : as using all uppercase, which is also fairly safe:
- : (-NAME=>'me', -COLOR =>'blue');
- :
- : Personal note (SAC): I have found all uppercase tags to
- : be more managable: it involves less single-quoting,
- : the key names stand out better, and there are no method naming
- : conflicts.
- : The drawbacks are that it's not as easy to type as lowercase,
- : and lots of uppercase can be hard to read.
- :
- : Regardless of the style, it greatly helps to line
- : the parameters up vertically for long/complex lists.
+B<usage:>
+ $object->_rearrange( array_ref, list_of_arguments)
+
+B<Purpose :> Rearranges named parameters to requested order.
+
+B<Example:>
+ $self->_rearrange([qw(SEQUENCE ID DESC)], at param);
+Where C<@param = (-sequence => $s, -desc => $d, -id => $i);>
+
+B<returns:> C<@params> - an array of parameters in the requested order.
+
+The above example would return ($s, $i, $d).
+Unspecified parameters will return undef. For example, if
+ C<@param = (-sequence => $s);>
+the above _rearrange call would return ($s, undef, undef)
+
+B<Argument:> C<$order> : a reference to an array which describes the desired order of the named parameters.
+
+C<@param :> an array of parameters, either as a list (in which case the function
+simply returns the list), or as an associative array with hyphenated
+tags (in which case the function sorts the values according to
+@{$order} and returns that new array.) The tags can be upper, lower,
+or mixed case but they must start with a hyphen (at least the first
+one should be hyphenated.)
+
+B< Source:> This function was taken from CGI.pm, written by
+Dr. Lincoln Stein, and adapted for use in Bio::Seq by Richard Resnick
+and then adapted for use in Bio::Root::Object.pm by Steve Chervitz,
+then migrated into Bio::Root::RootI.pm by Ewan Birney.
+
+B<Comments:>
+Uppercase tags are the norm, (SAC) This method may not be appropriate
+for method calls that are within in an inner loop if efficiency is a
+concern.
+
+Parameters can be specified using any of these formats:
+ @param = (-name=>'me', -color=>'blue');
+ @param = (-NAME=>'me', -COLOR=>'blue');
+ @param = (-Name=>'me', -Color=>'blue');
+ @param = ('me', 'blue');
+
+A leading hyphenated argument is used by this function to indicate
+that named parameters are being used. Therefore, the ('me', 'blue')
+list will be returned as-is.
+
+Note that Perl will confuse unquoted, hyphenated tags as function
+calls if there is a function of the same name in the current
+namespace: C<-name => 'foo'> is interpreted as C<-&name => 'foo'>
+
+For ultimate safety, put single quotes around the tag: C<('-name'=>'me', '-color' =>'blue');>
+
+This can be a bit cumbersome and I find not as readable as using all
+uppercase, which is also fairly safe:C<(-NAME=>'me', -COLOR =>'blue');>
+
+Personal note (SAC): I have found all uppercase tags to be more
+managable: it involves less single-quoting, the key names stand out
+better, and there are no method naming conflicts. The drawbacks are
+that it's not as easy to type as lowercase, and lots of uppercase can
+be hard to read. Regardless of the style, it greatly helps to line the parameters up
+vertically for long/complex lists.
=cut
sub _rearrange {
-
# my $dummy = shift;
my $order = shift;
return @_ unless ( substr( $_[0] || '', 0, 1 ) eq '-' );
@@ -1659,3 +1757,11 @@
map { $_ = uc( $_ ) } @$order; # for bug #1343, but is there perf hit here?
return @param{@$order};
}
+
+sub _getQueryID {
+ my ( $query ) = @_;
+ $query = _string_to_XML($query);
+ return '' unless ( $query->nodeName =~ /^(moby:|)(queryInput|mobyData)$/ ); #Eddie - unsure
+ return _moby_getAttribute($query, 'queryID' );
+}
+
More information about the MOBY-guts
mailing list