lib/MOBY/CommonSubs.pm

   1 #$Id: CommonSubs.pm,v 1.72 2005/11/21 12:19:35 pieter Exp $
   2
   3 =head1 NAME
   4
   5 MOBY::CommonSubs.pm - a set of exportable subroutines that are
   6 useful in clients and services to deal with the input/output from
   7 MOBY Services
   8
   9 =head1 DESCRIPTION
  10
  11 CommonSubs are used to do various manipulations of MOBY Messages.  It is useful
  12 both Client and Service side to construct and parse MOBY Messages, and ensure
  13 that the message structure is valid as per the API.
  14
  15 It DOES NOT connect to MOBY Central for any of its functions, though it does
  16 contact the ontology server, so it will require a network connection.
  17
  18 =head1 SYNTAX
  19
  20 =head2 Client Side Paradigm
  21
  22 not written yet
  23
  24 =head2 Service-Side Paradigm
  25
  26 The following is a generalized architecture for *all*
  27 BioMOBY services showing how to parse incoming messages
  28 using the subroutines provided in CommonSubs
  29
  30  sub myServiceName {
  31     my ($caller, $data) = @_;
  32     my $MOBY_RESPONSE; # holds the response raw XML
  33
  34         # genericServiceInputParser
  35         # unpacks incoming message into an array of arrarefs.
  36         # Each element of the array is a queryInput block, or a mobyData block
  37         # the arrayref has the following structure:
  38         # [SIMPLE, $queryID, $simple]
  39         # the first element is an exported constant SIMPLE, COLLECTION, SECONDARY
  40         # the second element is the queryID (required for enumerating the responses)
  41         # the third element is the XML::LibXML for the Simple, Collection, or Parameter block
  42     my (@inputs)= genericServiceInputParser($data);
  43         # or fail properly with an empty response
  44     return SOAP::Data->type('base64' => responseHeader("my.authURI.com") . responseFooter()) unless (scalar(@inputs));
  45
  46         # you only need to do this if you are intending to be namespace aware
  47         # some services might not care what namespace the data is in, so long
  48         # as there is data...
  49     my @validNS_LSID = validateNamespaces("NCBI_gi");  # returns LSID's for each human-readable
  50
  51     foreach (@inputs){
  52         my ($articleType, $qID, $input) = @{$_};
  53         unless (($articleType == SIMPLE) && ($input)){
  54                 # in this example, we are only accepting SIMPLE types as input
  55                 # so write back an empty response block and move on to the next
  56             $MOBY_RESPONSE .= simpleResponse("", "", $qID) ;
  57             next;
  58         } else {
  59                 # now take the namespace and ID from our input article
  60                 # (see pod docs for other possibilities)
  61             my $namespace = getSimpleArticleNamespaceURI($input); # get namespace
  62             my ($identifier) = getSimpleArticleIDs($input);  # get ID (note array output! see pod)
  63
  64             # here is where you do whatever manipulation you need to do
  65             # for your particular service.
  66             # you will be building an XML document into $MOBY_RESPONSE
  67         }
  68     }
  69     return SOAP::Data->type('base64' => (responseHeader("illuminae.com") . $MOBY_RESPONSE . responseFooter));
  70  }
  71
  72
  73 =head1 EXAMPLE
  74
  75
  76 A COMPLETE EXAMPLE OF AN EASY MOBY SERVICE
  77
  78 This is a service that:
  79
  80  CONSUMES:  base Object in the GO namespace
  81  EXECUTES:  Retrieval
  82  PRODUCES:  GO_Term (in the GO namespace)
  83
  84
  85  # this subroutine is called from your dispatch_with line
  86  # in your SOAP daemon
  87
  88
  89  sub getGoTerm {
  90     my ($caller, $message) = @_;
  91     my $MOBY_RESPONSE;
  92     my (@inputs)= genericServiceInputParser($message); # ([SIMPLE, $queryID, $simple],...)
  93     return SOAP::Data->type('base64' => responseHeader('my.authURI.com') . responseFooter()) unless (scalar(@inputs));
  94
  95     my @validNS = validateNamespaces("GO");  # ONLY do this if you are intending to be namespace aware!
  96
  97     my $dbh = _connectToGoDatabase();
  98     return SOAP::Data->type('base64' => responseHeader('my.authURI.com') . responseFooter()) unless $dbh;
  99     my $sth = $dbh->prepare(q{
 100        select name, term_definition
 101        from term, term_definition
 102        where term.id = term_definition.term_id
 103        and acc=?});
 104
 105     foreach (@inputs){
 106         my ($articleType, $ID, $input) = @{$_};
 107         unless ($articleType == SIMPLE){
 108             $MOBY_RESPONSE .= simpleResponse("", "", $ID);
 109             next;
 110         } else {
 111             my $ns = getSimpleArticleNamespaceURI($input);
 112             (($MOBY_RESPONSE .= simpleResponse("", "", $ID)) && (next))
 113                 unless validateThisNamespace($ns, @validNS);  # only do this if you are truly validating namespaces
 114             my ($accession) = defined(getSimpleArticleIDs($ns, [$input]))?getSimpleArticleIDs($ns,[$input]):undef;
 115             unless (defined($accession)){
 116                 $MOBY_RESPONSE .= simpleResponse("", "", $ID);
 117                 next;
 118             }
 119             unless ($accession =~/^GO:/){
 120                  $accession = "GO:$accession";  # we still haven't decided on whether id's should include the prefix...
 121             }
 122             $sth->execute($accession);
 123             my ($term, $def) = $sth->fetchrow_array;
 124             if ($term){
 125                  $MOBY_RESPONSE .= simpleResponse("
 126                  <moby:GO_Term namespace='GO' id='$accession'>
 127                   <moby:String namespace='' id='' articleName='Term'>$term</moby:String>
 128                   <moby:String namespace='' id='' articleName='Definition'>$def</moby:String>
 129                  </moby:GO_Term>", "GO_Term_From_ID", $ID)
 130             } else {
 131                  $MOBY_RESPONSE .= simpleResponse("", "", $ID)
 132             }
 133         }
 134     }
 135
 136     return SOAP::Data->type('base64' => (responseHeader("my.authURI.com") . $MOBY_RESPONSE . responseFooter));
 137  }
 138
 139
 140 =head1 AUTHORS
 141
 142 Mark Wilkinson (markw at illuminae dot com)
 143
 144 BioMOBY Project:  http://www.biomoby.org
 145
 146 =head1 PARSING INPUT
 147
 148 =cut
 149
 150 package MOBY::CommonSubs;
 151 require Exporter;
 152 use XML::LibXML;
 153 use MOBY::CrossReference;
 154 use MOBY::Client::OntologyServer;
 155 use strict;
 156 use warnings;
 157 use MOBY::Client::SimpleArticle;
 158 use MOBY::Client::CollectionArticle;
 159 use MOBY::Client::SecondaryArticle;
 160 use MOBY::MobyXMLConstants;
 161 use constant COLLECTION => 1;
 162 use constant SIMPLE     => 2;
 163 use constant SECONDARY  => 3;
 164 use constant PARAMETER  => 3;    # be friendly in case they use this instead
 165 use constant BE_NICE    => 1;
 166 use constant BE_STRICT  => 0;
 167 our @ISA       = qw(Exporter);
 168 our @EXPORT    = qw(COLLECTION SIMPLE SECONDARY PARAMETER BE_NICE BE_STRICT);
 169 our %EXPORT_TAGS = (
 170         all => [
 171                 qw(
 172                   getSimpleArticleIDs
 173                   getSimpleArticleNamespaceURI
 174                   getInputArticles
 175                   getInputs
 176                   getInputID
 177                   getArticles
 178                   getCollectedSimples
 179                   getNodeContentWithArticle
 180                   extractRawContent
 181                   validateNamespaces
 182                   validateThisNamespace
 183                   isSimpleArticle
 184                   isCollectionArticle
 185                   isSecondaryArticle
 186                   extractResponseArticles
 187                   getResponseArticles
 188                   getCrossReferences
 189                   genericServiceInputParser
 190                   genericServiceInputParserAsObject
 191                   complexServiceInputParser
 192                   whichDeepestParentObject
 193                   getServiceNotes
 194                   simpleResponse
 195                   collectionResponse
 196                   complexResponse
 197                   responseHeader
 198                   responseFooter
 199                   COLLECTION
 200                   SIMPLE
 201                   SECONDARY
 202                   PARAMETER
 203                   BE_NICE
 204                   BE_STRICT
 205                   )
 206         ]
 207 );
 208
 209
 210 our @EXPORT_OK = (@{$EXPORT_TAGS{'all'}});
 211
 212 =head2 genericServiceInputParser
 213
 214 B<function:> For the MOST SIMPLE SERVICES that take single Simple or
 215 Collection inputs and no Secondaries/Parameters this routine takes the
 216 MOBY message and breaks the objects out of it in a useful way
 217
 218 B<usage:>
 219   my @inputs = genericServiceInputParser($MOBY_mssage));
 220
 221 B<args:> C<$message> - this is the SOAP payload; i.e. the XML document containing the MOBY message
 222
 223 B<returns:> C<@inputs> - the structure of @inputs is a list of listrefs.
 224
 225 Each listref has three components:
 226
 227 =over 4
 228
 229 =item *
 230 COLLECTION|SIMPLE (i.e. constants 1, 2)
 231
 232 =item *
 233 queryID
 234
 235 =item *
 236 $data - the data takes several forms
 237
 238 =over 4
 239
 240 =item *
 241 $article XML::LibXML node for Simples  <mobyData...>...</mobyData>
 242
 243 =item *
 244 \@article XML:LibXML nodes for Collections
 245
 246 =back
 247
 248 =back
 249
 250 For example, the input message:
 251
 252   <mobyData queryID = '1'>
 253       <Simple>
 254          <Object namespace=blah id=blah/>
 255       </Simple>
 256   </mobyData>
 257   <mobyData queryID = '2'>
 258       <Simple>
 259          <Object namespace=blah id=blah/>
 260       </Simple>
 261   </mobyData>
 262 will become:
 263             (note that SIMPLE, COLLECTION, and SECONDARY are exported constants from this module)
 264
 265             @inputs = ([SIMPLE, 1, $DOM], [SIMPLE, 2, $DOM]) # the <Simple> block
 266
 267 For example, the input message:
 268
 269     <mobyData queryID = '1'>
 270         <Collection>
 271         <Simple>
 272            <Object namespace=blah id=blah/>
 273         </Simple>
 274         <Simple>
 275            <Object namespace=blah id=blah/>
 276         </Simple>
 277         </Collection>
 278     </mobyData>
 279
 280 will become:
 281
 282  @inputs = ( [COLLECTION, 1, [$DOM, $DOM]] ) # the <Simple> block
 283
 284 =cut
 285
 286 sub genericServiceInputParser {
 287   my ( $message ) = @_;    # get the incoming MOBY query XML
 288   my @inputs;              # set empty response
 289   my @queries = getInputs( $message );   # returns XML::LibXML nodes <mobyData>...</mobyData>
 290   foreach my $query ( @queries ) {
 291     my $queryID = getInputID( $query ); # get the queryID attribute of the mobyData
 292     my @input_articles =
 293       getArticles( $query )
 294         ; # get the Simple/Collection/Secondary articles making up this query <Simple>...</Simple> or <Collection>...</Collection> or <Parameter>...</Parameter>
 295     foreach my $input ( @input_articles ) {    # input is a listref
 296       my ( $articleName, $article ) = @{$input};   # get the named article
 297       if ( isCollectionArticle( $article ) ) {
 298         my @simples = getCollectedSimples( $article );
 299         push @inputs, [ COLLECTION, $queryID, \@simples ];
 300       } elsif ( isSimpleArticle( $article ) ) {
 301         push @inputs, [ SIMPLE, $queryID, $article ];
 302       } elsif ( isSecondaryArticle( $article ) )
 303         {    # should never happen in a generic service parser!
 304           push @inputs, [ SECONDARY, $queryID, $article ];
 305         }
 306     }
 307   }
 308   return @inputs;
 309 }
 310
 311 =head2 serviceInputParser
 312
 313 DO NOT USE!!
 314
 315 B<function:> to take a MOBY message and break the objects out of it.
 316 This is identical to the genericServiceInputParser method above,
 317 except that it returns the data as Objects rather than XML::LibXML
 318 nodes.  This is an improvement!
 319
 320 B<usage:> C<my @inputs = serviceInputParser($MOBY_mssage));>
 321
 322 B<args:> C<$message> - this is the SOAP payload; i.e. the XML document containing the MOBY message
 323
 324 B<returns:> C<@inputs> - the structure of @inputs is a list of listrefs.
 325
 326 Each listref has three components:
 327
 328                 1. COLLECTION|SIMPLE|SECONDARY (i.e. constants 1, 2, 3)
 329                 2. queryID (undef for Secondary parameters)
 330                 3. $data - either MOBY::Client::SimpleArticle, CollectionArticle, or SecondaryArticle
 331
 332 =cut
 333
 334 sub serviceInputParser {
 335   my ( $message ) = @_;    # get the incoming MOBY query XML
 336   my @inputs;              # set empty response
 337   my @queries = getInputs( $message );   # returns XML::LibXML nodes <mobyData>...</mobyData>
 338
 339   # mark, this doesn't work for complex services.  We need to allow more than one input per invocation
 340   foreach my $query ( @queries ) {
 341     my $queryID = getInputID( $query );    # get the queryID attribute of the mobyData
 342     # get the Simple/Collection articles making up this query
 343     #  <Simple>...</Simple> or <Collection>...</Collection>
 344     # or <Parameter>...</Parameter
 345     my @input_articles = getArticlesAsObjects( $query );
 346     foreach my $article ( @input_articles ) {    # input is a listref
 347       if ( $article->isCollection ) {
 348         my @simples = getCollectedSimples( $article->XML );
 349         push @inputs, [ COLLECTION, $queryID, \@simples ];
 350       } elsif ( $article->isSimple ) {
 351         push @inputs, [ SIMPLE, $queryID, $article ];
 352       } elsif ( $article->isSecondary ) {
 353         push @inputs, [ SECONDARY, $queryID, $article ];
 354       }
 355     }
 356   }
 357   return @inputs;
 358 }
 359
 360 =head2 complexServiceInputParser
 361
 362 B<function:> For more complex services that have multiple articles for
 363 each input and/or accept parameters, this routine will take a MOBY
 364 message and extract the Simple/Collection/Parameter objects out of it
 365 in a useful way.
 366
 367 B<usage:> C<my $inputs = complexServiceInputParser($MOBY_mssage));>
 368
 369 B<args:> C<$message> - this is the SOAP payload; i.e. the XML document containing the MOBY message
 370
 371 B<returns:> C<$inputs> is a hashref with the following structure:
 372
 373             $inputs->{$queryID} = [ [TYPE, $DOM], [TYPE, $DOM], [TYPE, $DOM] ]
 374
 375 =head3  Simples
 376
 377 For example, the input message:
 378
 379       <mobyData queryID = '1'>
 380           <Simple articleName='name1'>
 381              <Object namespace=blah id=blah/>
 382           </Simple>
 383           <Parameter articleName='cutoff'>
 384              <Value>10</Value>
 385           </Parameter>
 386       </mobyData>
 387
 388 will become: (note that SIMPLE, COLLECTION, and SECONDARY are exported constants from this module)
 389
 390             $inputs->{1} = [ [SIMPLE, $DOM_name1], # the <Simple> block
 391                              [SECONDARY, $DOM_cutoff]  # $DOM_cutoff= <Parameter> block
 392                            ]
 393
 394 Please see the XML::LibXML pod documentation for information about how to parse XML DOM objects.
 395
 396 =head3            Collections
 397
 398 With inputs that have collections these are presented as a listref of
 399 Simple article DOM's.  So for the following message:
 400
 401    <mobyData>
 402        <Collection articleName='name1'>
 403          <Simple>
 404           <Object namespace=blah id=blah/>
 405          </Simple>
 406          <Simple>
 407           <Object namespace=blah id=blah/>
 408          </Simple>
 409        </Collection>
 410        <Parameter articleName='cutoff'>
 411           <Value>10</Value>
 412        </Parameter>
 413    </mobyData>
 414
 415 will become
 416
 417             $inputs->{1} = [ [COLLECTION, [$DOM, $DOM] ], # $DOM is the <Simple> Block!
 418                              [SECONDARY, $DOM_cutoff]  # $DOM_cutoff = <Parameter> Block
 419                            ]
 420
 421 Please see the XML::LibXML pod documentation for information about how to parse XML DOM objects.
 422
 423 =cut
 424
 425 sub complexServiceInputParser {
 426         my ( $message ) = @_;    # get the incoming MOBY query XML
 427         my @inputs;              # set empty response
 428         my @queries = getInputs( $message );   # returns XML::LibXML nodes <mobyData>...</mobyData>
 429         my %input_parameters;      # $input_parameters{$queryID} = [
 430         foreach my $query ( @queries ) {
 431           my $queryID =  getInputID( $query );    # get the queryID attribute of the mobyData
 432                 my @input_articles =
 433                   getArticles( $query )
 434                   ; # get the Simple/Collection/Secondary articles making up this query <Simple>...</Simple> or <Collection>...</Collection> or <Parameter>...</Parameter>
 435                 foreach my $input ( @input_articles ) {    # input is a listref
 436                         my ( $articleName, $article ) = @{$input};   # get the named article
 437                         if ( isCollectionArticle( $article ) ) {
 438                                 my @simples = getCollectedSimples( $article );
 439                                 push @{ $input_parameters{$queryID} },
 440                                   [ COLLECTION, \@simples ];
 441                         } elsif ( isSimpleArticle( $article ) ) {
 442                                 push @{ $input_parameters{$queryID} }, [ SIMPLE, $article ];
 443                         } elsif ( isSecondaryArticle( $article ) ) {
 444                                 push @{ $input_parameters{$queryID} }, [ SECONDARY, $article ];
 445                         }
 446                 }
 447         }
 448         return \%input_parameters;
 449 }
 450
 451 =head2 getArticles
 452
 453 B<function:> get the Simple/Collection/Parameter articles for a single mobyData
 454
 455 B<usage:> C<@articles = getArticles($XML)>
 456
 457 B<args:> raw XML or XML::LibXML of a queryInput, mobyData, or queryResponse block (e.g. from getInputs)
 458
 459 B<returns:> a list of listrefs; each listref is one component of the
 460 queryInput or mobyData block a single block may consist of one or more
 461 named or unnamed simple, collection, or parameter articles.  The
 462 listref structure is thus C<[name, $ARTICLE_DOM]>:
 463
 464     e.g.:  @articles = ['name1', $SIMPLE_DOM]
 465
 466 generated from the following sample XML:
 467
 468                 <mobyData>
 469                     <Simple articleName='name1'>
 470                       <Object namespace=blah id=blah/>
 471                     </Simple>
 472                 </mobyData>
 473
 474     or  :  @articles = ['name1', $COLL_DOM], ['paramname1', $PARAM_DOM]
 475
 476 generated from the following sample XML:
 477
 478   <mobyData>
 479       <Collection articleName='name1'>
 480         <Simple>
 481          <Object namespace=blah id=blah/>
 482         </Simple>
 483         <Simple>
 484          <Object namespace=blah id=blah/>
 485         </Simple>
 486       </Collection>
 487       <Parameter articleName='e value cutoff'>
 488          <default>10</default>
 489       </Parameter>
 490   </mobyData>
 491
 492 =cut
 493
 494 sub getArticles {
 495   my ( $moby ) = @_;
 496   $moby = _string_to_DOM($moby);
 497   return undef
 498     unless ( ($moby->nodeType == ELEMENT_NODE)
 499              && ( $moby->nodeName =~ /^(moby:|)(queryInput|queryResponse|mobyData)$/ ) );
 500   my @articles;
 501   foreach my $child ( $moby->childNodes )
 502     { # there may be more than one Simple/Collection per input; iterate over them
 503       next unless ( ($child->nodeType == ELEMENT_NODE)    # ignore whitespace
 504                     && ( $child->nodeName =~ /^(moby:|)(Simple|Collection|Parameter)$/ ) );
 505       my $articleName = _moby_getAttribute($child, 'articleName' );
 506       # push the named child DOM elements (which are <Simple> or <Collection>, <Parameter>)
 507       push @articles, [ $articleName, $child ];
 508     }
 509   return @articles;    # return them.
 510 }
 511 #################################################
 512 ##################################
 513 ##################################
 514 # COMMON SUBROUTINES for Clients and Services
 515 ##################################
 516 ##################################
 517 #################################################
 518
 519 =head2 getSimpleArticleIDs
 520
 521 B<function:> to get the IDs of simple articles that are in the given namespace
 522
 523 B<usage:>
 524
 525   my @ids = getSimpleArticleIDs("NCBI_gi", \@SimpleArticles);
 526   my @ids = getSimpleArticleIDs(\@SimpleArticles);
 527
 528 B<args:>
 529
 530 C<$Namespace>  - (optional) a namespace stringfrom the MOBY namespace ontology, or undef if you don't care
 531
 532 C<\@Simples>   - (required) a listref of Simple XML::LibXML nodes i.e. the XML::LibXML representing an XML structure like this:
 533
 534       <Simple>
 535           <Object namespace="NCBI_gi" id="163483"/>
 536       </Simple>
 537
 538 Note : If you provide a namespace, it will return *only* the ids that
 539 are in the given namespace, but will return 'undef' for any articles
 540 in the WRONG namespace so that you get an equivalent number of outputs
 541 to inputs.
 542
 543 Note that if you call this with a single argument, this is assumed to
 544 be C<\@Articles>, so you will get ALL id's regardless of namespace!
 545
 546 =cut
 547
 548
 549 sub getSimpleArticleIDs {
 550   my ( $desired_namespace, $input_nodes ) = @_;
 551   if ( $desired_namespace && !$input_nodes )
 552     {    # if called with ONE argument, then these are the input nodes!
 553       $input_nodes       = $desired_namespace;
 554       $desired_namespace = undef;
 555     }
 556   $input_nodes = [$input_nodes]
 557     unless ref( $input_nodes ) eq 'ARRAY';    # be flexible!
 558   return undef unless scalar @{$input_nodes};
 559   my @input_nodes = @{$input_nodes};
 560   my $OS          = MOBY::Client::OntologyServer->new;
 561   my ( $s, $m, $namespace_lsid );
 562   if ( $desired_namespace ) {
 563     ( $s, $m, $namespace_lsid ) =
 564       $OS->namespaceExists( term => $desired_namespace ); # returns (success, message, lsid)
 565     unless ( $s ) {    # bail if not successful
 566       # Printing to STDERR is not very helpful - we should probably return something that can be dealt iwth programatically....
 567       die("MOBY::CommonSubs: the namespace '$desired_namespace' "
 568            . "does not exist in the MOBY ontology, "
 569            . "and does not have a valid LSID");
 570 #      return undef;
 571     }
 572     $desired_namespace = $namespace_lsid; # Replace namespace with fully-qualified LSID
 573   }
 574   my @ids;
 575   foreach my $in ( @input_nodes ) {
 576     next unless $in;
 577     #$in = "<Simple><Object namespace='' id=''/></Simple>"
 578     next unless $in->nodeName =~ /^(moby:|)Simple$/;    # only allow simples
 579     my @simples = $in->childNodes;
 580     foreach ( @simples ) {    # $_ = <Object namespace='' id=''/>
 581       next unless $_->nodeType == ELEMENT_NODE;
 582       if ( $desired_namespace ) {
 583         my $ns = _moby_getAttributeNode($_, 'namespace' ); # get the namespace DOM node
 584         unless ( $ns ) {    # if we don't get it at all, then move on to the next input
 585             push @ids, undef;    # but push an undef onto teh stack in order
 586             next;
 587           }
 588         $ns = $ns->getValue;    # if we have a namespace, then get its value
 589         ( $s, $m, $ns ) = $OS->namespaceExists( term => $ns );
 590         # A bad namespace will return 'undef' which makes for a bad comparison (Perl warning).
 591         # Better to check directly for success ($s), THEN check that namespace is the one we wanted.
 592         unless ( $s && $ns eq $desired_namespace )
 593           { # we are registering as working in a particular namespace, so check this
 594             push @ids, undef;    # and push undef onto the stack if it isn't
 595             next;
 596           }
 597       }
 598
 599       # Now do the same thing for ID's
 600       my $id = _moby_getAttributeNode($_, 'id' );
 601       unless ( $id ) {
 602         push @ids, undef;
 603         next;
 604       }
 605       $id = $id->getValue;
 606       unless ( defined $id ) {    # it has to have a hope in hell of retrieving something...
 607           push @ids, undef;    # otherwise push undef onto the stack if it isn't
 608           next;
 609         }
 610       push @ids, $id;
 611     }
 612   }
 613   return @ids;
 614 }
 615
 616 =head2 getSimpleArticleNamespaceURI
 617
 618 B<function:> to get the namespace of a simple article
 619
 620 B<usage:> C<my $ns = getSimpleArticleNamespaceURI($SimpleArticle);>
 621
 622 B<args:> C<$Simple> - (required) a single XML::LibXML node
 623 representing a Simple Article i.e. the XML::LibXML representing an XML
 624 structure like this:
 625
 626       <Simple>
 627           <Object namespace="NCBI_gi" id="163483"/>
 628       </Simple>
 629
 630 =cut
 631
 632
 633 sub getSimpleArticleNamespaceURI {
 634
 635 # pass me a <SIMPLE> input node and I will give you the lsid of the namespace of that input object
 636   my ( $input_node ) = @_;
 637   return undef unless $input_node;
 638   my $OS = MOBY::Client::OntologyServer->new;
 639
 640   #$input_node = "<Simple><Object namespace='' id=''/></Simple>"
 641   my @simples = $input_node->childNodes;
 642   foreach ( @simples )
 643     { # $_ = <Object namespace='' id=''/>   # should be just one, so I will return at will from this routine
 644       next unless $_->nodeType == ELEMENT_NODE;
 645       my $ns = _moby_getAttributeNode($_, 'namespace' );     # get the namespace DOM node
 646         return undef unless ( $ns ); # if we don't get it at all, then move on to the next input
 647       my ( $s, $m, $lsid ) =
 648         $OS->namespaceExists( term => $ns->getValue );   # if we have a namespace, then get its value
 649       return undef unless $s;
 650       return $lsid;
 651     }
 652 }
 653
 654 sub _string_to_DOM {
 655 # Convert string to DOM.
 656 # If DOM passed in, just return it (i.e., this should be idempotent)
 657 # By Frank Gibbons, Aug. 2005
 658 # Utility subroutine, not for external use (no export), widely used in this package.
 659   my $XML = shift;
 660   my $moby;
 661   return $XML if ( ref($XML) =~ /^XML\:\:LibXML/ );
 662
 663   my $parser = XML::LibXML->new();
 664   my $doc;
 665   eval { $doc = $parser->parse_string( $XML ) };
 666   die("CommonSubs couldn't parse XML '$XML' because\n\t$@") if $@;
 667   return $doc->getDocumentElement();
 668 }
 669
 670 =head2 getInputs
 671
 672 B<function:> get the mobyData block(s) as XML::LibXML nodes
 673
 674 B<usage:> C<@queryInputs = getInputArticles($XML)>
 675
 676 B<args:> the raw XML of a <MOBY> query, or an XML::LibXML document
 677
 678 B<returns:> a list of XML::LibXML::Node's, each is a queryInput or mobyData block.
 679
 680 B< Note:> Remember that these blocks are enumerated!  This is what you
 681 pass as the third argument to the simpleResponse or collectionResponse
 682 subroutine to associate the numbered input to the numbered response
 683
 684 =cut
 685
 686 sub getInputs {
 687   my ( $XML ) = @_;
 688   my $moby =  _string_to_DOM($XML);
 689   my @queries;
 690   foreach my $querytag qw( queryInput moby:queryInput mobyData moby:mobyData )
 691     {
 692       my $x = $moby->getElementsByTagName( $querytag );    # get the mobyData block
 693       for ( 1 .. $x->size() ) {    # there may be more than one mobyData per message
 694         push @queries, $x->get_node( $_ );
 695       }
 696     }
 697   return @queries;    # return them in the order that they were discovered.
 698 }
 699
 700 =head2 getInputID
 701
 702 B<function:> get the value of the queryID element
 703
 704 B<usage:> C<@queryInputs = getInputID($XML)>
 705
 706 B<args:> the raw XML or XML::LibXML of a queryInput or mobyData block (e.g. from getInputs)
 707
 708 B<returns:> integer, or ''
 709
 710 B< Note:> Inputs and Responses are coordinately enumerated!  The
 711 integer you get here is what you pass as the third argument to the
 712 simpleResponse or collectionResponse subroutine to associate the
 713 numbered input to the numbered response
 714
 715 =cut
 716
 717 sub getInputID {
 718   my ( $XML ) = @_;
 719   my $moby = _string_to_DOM($XML);
 720   return '' unless ( $moby->nodeName =~ /^(moby:|)queryInput|mobyData$/ );
 721   my $qid =  _moby_getAttribute($moby, 'queryID' );
 722   return defined( $qid ) ? $qid : '';
 723 }
 724
 725 =head2 getArticlesAsObjects
 726
 727   DO NOT USE!!
 728
 729 B<function:> get the Simple/Collection articles for a single mobyData
 730 or queryResponse node, rethrning them as SimpleArticle,
 731 SecondaryArticle, or ServiceInstance objects
 732
 733 B<usage:> C<@articles = getArticles($XML)>
 734
 735 B<args:> raw XML or XML::LibXML of a moby:mobyData block
 736
 737 B<returns:>
 738
 739 =cut
 740
 741 sub getArticlesAsObjects {
 742   my ( $moby ) = @_;
 743   $moby = _string_to_DOM($moby);
 744   return undef unless $moby->nodeType == ELEMENT_NODE;
 745   return undef
 746     unless ($moby->nodeName =~ /^(moby:|)(queryInput|queryResponse|mobyData)$/);
 747   my @articles;
 748   foreach my $child ( $moby->childNodes )
 749     { # there may be more than one Simple/Collection per input; iterate over them
 750       next unless $child->nodeType == ELEMENT_NODE;    # ignore whitespace
 751       next
 752         unless ( $child->nodeName =~ /^(moby:|)(Simple|Collection|Parameter)$/ );
 753       my $object;
 754       if ( $child->nodeName =~ /^(moby:|)Simple$/ ) {
 755         $object = MOBY::Client::SimpleArticle->new( XML_DOM => $child );
 756       } elsif ( $child->nodeName =~ /^(moby:|)Collection$/ ) {
 757         $object = MOBY::Client::CollectionArticle->new( XML_DOM => $child );
 758       } elsif ( $child->nodeName =~ /^(moby:|)Parameter$/ ) {
 759         $object = MOBY::Client::SecondaryArticle->new( XML_DOM => $child );
 760       }
 761       next unless $object;
 762       push @articles, $object;  # take the child elements, which are <Simple/> or <Collection/>
 763     }
 764   return @articles;    # return them.
 765 }
 766
 767 =head2 getCollectedSimples
 768
 769 B<function:> get the Simple articles collected in a moby:Collection block
 770
 771 B<usage:> C<@Simples = getCollectedSimples($XML)>
 772
 773 B<args:> raw XML or XML::LibXML of a moby:Collection block
 774
 775 B<returns:> a list of XML::LibXML nodes, each of which is a moby:Simple block
 776
 777 =cut
 778
 779 sub getCollectedSimples {
 780   my ( $moby ) = @_;
 781   $moby = _string_to_DOM($moby);
 782   return undef unless $moby->nodeType == ELEMENT_NODE;
 783   return undef unless ( $moby->nodeName =~ /^(moby\:|)Collection$/ );
 784   my @articles;
 785   foreach my $child ( $moby->childNodes )
 786     { # there may be more than one Simple/Collection per input; iterate over them
 787       next unless $child->nodeType == ELEMENT_NODE;    # ignore whitespace
 788       next unless ( $child->nodeName =~ /^(moby\:|)Simple$/ );
 789       push @articles, $child; # take the child elements, which are <Simple/> or <Collection/>
 790     }
 791   return @articles;    # return them.
 792 }
 793
 794 =head2 getInputArticles
 795
 796
 797 B<function:> get the Simple/Collection articles for each input query, in order
 798
 799 B<usage:> C<@queries = getInputArticles($XML)>
 800
 801 B<args:> the raw XML of a moby:MOBY query
 802
 803 B<returns:> a list of listrefs, each listref is the input to a single
 804 query.  Remember that the input to a single query may be one or more
 805 Simple and/or Collection articles.  These are provided as XML::LibXML
 806 nodes.
 807
 808             i.e.:  @queries = ([$SIMPLE_DOM_NODE], [$SIMPLE_DOM_NODE2])
 809             or  :  @queries = ([$COLLECTION_DOM_NODE], [$COLLECTION_DOM_NODE2])
 810
 811 The former is generated from the following XML:
 812
 813                 ...
 814               <moby:mobyContent>
 815                 <moby:mobyData>
 816                     <Simple>
 817                       <Object namespace=blah id=blah/>
 818                     </Simple>
 819                 </moby:mobyData>
 820                 <moby:mobyData>
 821                     <Simple>
 822                       <Object namespace=blah id=blah/>
 823                     </Simple>
 824                 </moby:mobyData>
 825               </moby:mobyContent>
 826                  ...
 827
 828 =cut
 829
 830 sub getInputArticles {
 831   my ( $moby ) = @_;
 832   $moby = _string_to_DOM($moby);
 833   my $x;
 834   foreach ( 'queryInput', 'moby:queryInput', 'mobyData', 'moby:mobyData' ) {
 835     $x = $moby->getElementsByTagName( $_ );    # get the mobyData block
 836     last if $x->get_node( 1 );
 837   }
 838   return undef unless $x->get_node( 1 );   # in case there was no match at all
 839   my @queries;
 840   for ( 1 .. $x->size() ) {  # there may be more than one mobyData per message
 841     my @this_query;
 842     foreach my $child ( $x->get_node( $_ )->childNodes )
 843       { # there may be more than one Simple/Collection per input; iterate over them
 844         next unless $child->nodeType == ELEMENT_NODE;    # ignore whitespace
 845         push @this_query, $child;  # take the child elements, which are <Simple/> or <Collection/>
 846       }
 847     push @queries, \@this_query;
 848   }
 849   return @queries;    # return them in the order that they were discovered.
 850 }
 851
 852 =head2 extractRawContent
 853
 854 B<function:> pass me an article (Simple, or Collection) and I'll give
 855 you the content AS A STRING - i.e. the raw XML of the contained MOBY
 856 Object(s)
 857
 858 B<usage:> C<extractRawContent($simple)>
 859
 860 B<input:> the one element of the output from getArticles
 861
 862 B<returns:> string
 863
 864 =cut
 865
 866 sub extractRawContent {
 867   my ( $article ) = @_;
 868   return "" unless ( $article || (ref( $article ) =~ /XML\:\:LibXML/) );
 869   my $response;
 870   foreach ( $article->childNodes ) {
 871     $response .= $_->toString;
 872   }
 873 #  print STDERR "RESPONSE = $response\n";
 874   return $response;
 875 }
 876
 877 =head2 getNodeContentWithArticle
 878
 879 B<function:> a very flexible way to get the stringified content of a
 880 node that has the correct element and article name or get the value of
 881 a Parameter element.
 882
 883 B<usage:> C<@strings = getNodeContentWithArticle($node, $tagname, $articleName)>
 884
 885 B<args:> (in order)
 886
 887 C<$node>        - an XML::LibXML node, or straight XML.  It may even be the entire mobyData block.
 888 C<$tagname>     - the tagname (effectively from the Object type ontology),  or "Parameter" if you are trying to get secondaries
 889 C<$articleName> - the articleName that we are searching for.  to get the content of the primary object, leave this field blank!
 890
 891
 892 B<returns:> an ARRAY of the stringified text content for each
 893 node that matched the tagname/articleName specified; one
 894 array element for each matching node.  Newlines are NOT considered
 895 new nodes (as they are in normal XML).
 896
 897 B<notes:> This was written for the purpose of getting the values of
 898 String, Integer, Float, Date_Time, and other such primitives.
 899
 900 For example, in the following XML:
 901
 902              ...
 903              <moby:mobyContent>
 904                 <moby:mobyData>
 905                     <Simple>
 906                       <Sequence namespace=blah id=blah>
 907                            <Integer namespace='' id='' articleName="Length">3</Integer>
 908                            <String namespace='' id='' articleName="SequenceString">ATG</String>
 909                       </Sequence>
 910                     </Simple>
 911                 </moby:mobyData>
 912              </moby:mobyContent>
 913              ...
 914
 915 would be analysed as follows:
 916
 917               # get $input - e.g. from genericServiceInputParser or complexServiceInputParser
 918               @sequences = getNodeContentWithArticle($input, "String", "SequenceString");
 919
 920 For Parameters, such as the following
 921
 922              ...
 923              <moby:mobyContent>
 924                 <moby:mobyData>
 925                     <Simple>
 926                       <Sequence namespace=blah id=blah>
 927                            <Integer namespace='' id='' articleName="Length">3</Integer>
 928                            <String namespace='' id='' articleName="SequenceString">ATG</String>
 929                       </Sequence>
 930                     </Simple>
 931                     <Parameter articleName='cutoff'>
 932                         <Value>24</Value>
 933                     </Parameter>
 934                 </moby:mobyData>
 935              </moby:mobyContent>
 936              ...
 937
 938 You would parse it as follows:
 939
 940               # get $input - e.g. from genericServiceInputParser or complexServiceInputParser
 941               @sequences = getNodeContentWithArticle($input, "String", "SequenceString");
 942               @cutoffs = getNodeContentWithArticle($input, "Parameter", "cutoff");
 943
 944
 945  EXAMPLE  :
 946            my $inputs = complexServiceInputParser($MOBY_mssage));
 947                # $inputs->{$queryID} = [ [TYPE, $DOM], [TYPE, $DOM], [TYPE, $DOM] ]
 948            my (@enumerated) = keys %{$inputs};
 949            foreach $no (@enumerated){
 950              my @articles = @{$inputs->{$no}};
 951              foreach my $article(@articles){
 952                 my ($type, $DOM) = @{$article};
 953                 if ($type == SECONDARY){
 954                     ($cutoff) = getNodeContentsWithArticle($DOM, "Parameter", "cutoff");
 955                 } else {
 956                    @sequences = getNodeContentWithArticle($DOM, "String", "SequenceString");
 957                 }
 958              }
 959            }
 960
 961 =cut
 962
 963 sub getNodeContentWithArticle {
 964   # give me a DOM, a TagName, an articleName and I will return you the content
 965   # of that node **as a string** (beware if there are additional XML tags in there!)
 966   # this is meant for MOBYesque PRIMITIVES - things like:
 967   # <String articleName="SequenceString">TAGCTGATCGAGCTGATGCTGA</String>
 968   # call _getNodeContentsWithAttribute($DOM_NODE, "String", "SequenceString")
 969   # and I will return "TACGATGCTAGCTAGCGATCGG"
 970   # Caveat Emptor - I will NOT chop off leading and trailing whitespace or
 971   # carriage returns, as these might be meaningful!
 972   my ( $node, $element, $articleName ) = @_;
 973   my @contents;
 974   return () unless ( (ref( $node ) =~ /XML\:\:LibXML/) &&  $element);
 975
 976
 977   my $nodes = $node->getElementsByTagName( $element );
 978   unless ( $nodes->get_node( 1 ) ) {
 979     $nodes = $node->getElementsByTagName("moby:$element");
 980   }
 981   $node = $nodes->get_node(1);  # this routine should only ever be called if there is only one possible answer, so this is safe
 982
 983   unless ($articleName){  # the request is for root node if no articleName
 984     my $resp;
 985     foreach my $child($node->childNodes){
 986       next unless ($child->nodeType == TEXT_NODE
 987                    || $child->nodeType == CDATA_SECTION_NODE);
 988       $resp .= $child->nodeValue;
 989     }
 990     push @contents, $resp;
 991     return @contents;
 992   }
 993
 994   # if there is an articleName, then get that specific node
 995   for ( 1 .. $nodes->size() ) {
 996     my $child = $nodes->get_node( $_ );
 997     if ( _moby_getAttribute($child, "articleName")
 998          && ( $child->getAttribute("articleName") eq $articleName )
 999        )
1000       {
1001         # now we have a valid child, get the content... stringified... regardless of what it is
1002         if ( isSecondaryArticle( $child ) ) {
1003           my $resp;
1004           my $valuenodes = $child->getElementsByTagName('Value');
1005           unless ( $valuenodes->get_node( 1 ) ) {
1006             $valuenodes = $child->getElementsByTagName("moby:Value");
1007           }
1008           for ( 1 .. $valuenodes->size() ) {
1009             my $valuenode = $valuenodes->get_node( $_ );
1010             foreach my $amount ( $valuenode->childNodes ) {
1011               next unless ($amount->nodeType == TEXT_NODE
1012                            || $amount->nodeType == CDATA_SECTION_NODE);
1013               $resp .= $amount->nodeValue;
1014             }
1015           }
1016           push @contents, $resp;
1017         } else {
1018           my $resp;
1019           foreach ( $child->childNodes ) {
1020             next unless ($_->nodeType == TEXT_NODE
1021                          || $_->nodeType == CDATA_SECTION_NODE);
1022             $resp .= $_->nodeValue;
1023           }
1024           push @contents, $resp;
1025         }
1026       }
1027   }
1028   return @contents;
1029 }
1030
1031 *getResponseArticles = \&extractResponseArticles;
1032 *getResponseArticles = \&extractResponseArticles;
1033
1034 =head2 getResponseArticles (a.k.a. extractResponseArticles)
1035
1036 B<function:> get the DOM nodes corresponding to individual Simple or Collection outputs from a MOBY Response
1037
1038 B<usage:> C<($collections, $simples) = getResponseArticles($node)>
1039
1040 B<args:> C<$node> - either raw XML or an XML::LibXML::Document to be searched
1041
1042 B<returns:> an array-ref of Collection article XML::LibXML::Node's or  an array-ref of Simple article XML::LibXML::Node's
1043
1044 =cut
1045
1046 sub extractResponseArticles {
1047         my ( $result ) = @_;
1048         return ( [], [] ) unless $result;
1049         my $moby;
1050         unless ( ref( $result ) =~ /XML\:\:LibXML/ ) {
1051                 my $parser = XML::LibXML->new();
1052                 my $doc    = $parser->parse_string( $result );
1053                 $moby = $doc->getDocumentElement();
1054         } else {
1055                 $moby = $result->getDocumentElement();
1056         }
1057         my @objects;
1058         my @collections;
1059         my @Xrefs;
1060         my $success = 0;
1061         foreach my $which ( 'moby:queryResponse', 'queryResponse',
1062                             'mobyData', 'moby:mobyData' )
1063         {
1064                 my $responses = $moby->getElementsByTagName( $which );
1065                 next unless $responses;
1066                 foreach my $n ( 1 .. ( $responses->size() ) ) {
1067                         my $resp = $responses->get_node( $n );
1068                         foreach my $response_component ( $resp->childNodes ) {
1069                                 next unless $response_component->nodeType == ELEMENT_NODE;
1070                                 if ( $response_component->nodeName =~ /^(moby:|)Simple$/ )
1071                                   {
1072                                         foreach my $Object ( $response_component->childNodes ) {
1073                                                 next unless $Object->nodeType == ELEMENT_NODE;
1074                                                 $success = 1;
1075                                                 push @objects, $Object;
1076                                         }
1077                                 } elsif ( $response_component->nodeName =~ /^(moby:|)Collection$/ )
1078                                 {
1079                                         my @objects;
1080                                         foreach my $simple ( $response_component->childNodes ) {
1081                                                 next unless $simple->nodeType == ELEMENT_NODE;
1082                                                 next unless ( $simple->nodeName =~ /^(moby:|)Simple$/ );
1083                                                 foreach my $Object ( $simple->childNodes ) {
1084                                                         next unless $Object->nodeType == ELEMENT_NODE;
1085                                                         $success = 1;
1086                                                         push @objects, $Object;
1087                                                 }
1088                                         }
1089                                         push @collections, \@objects
1090                                           ;  #I'm not using collections yet, so we just use Simples.
1091                                 }
1092                         }
1093                 }
1094         }
1095         return ( \@collections, \@objects );
1096 }
1097
1098
1099
1100 =head1 IDENTITY AND VALIDATION
1101
1102 This section describes functionality associated with identifying parts of a message,
1103 and checking that it is valid.
1104
1105 =head2 isSimpleArticle, isCollectionArticle, isSecondaryArticle
1106
1107 B<function:> tests XML (text) or an XML DOM node to see if it represents a Simple, Collection, or Secondary article
1108
1109 B<usage:>
1110
1111   if (isSimpleArticle($node)){do something to it}
1112
1113 or
1114
1115   if (isCollectionArticle($node)){do something to it}
1116
1117 or
1118
1119  if (isSecondaryArticle($node)){do something to it}
1120
1121 B< input :> an XML::LibXML node, an XML::LibXML::Document or straight XML
1122
1123 B<returns:> boolean
1124
1125 =cut
1126
1127 sub isSimpleArticle {
1128   my ( $DOM ) = @_;
1129   eval { $DOM = _string_to_DOM($DOM) };
1130   return 0 if $@;
1131   $DOM = $DOM->getDocumentElement if ( $DOM->isa( "XML::LibXML::Document" ) );
1132   return ($DOM->nodeName =~ /^(moby:|)Simple$/) ? 1 : 0; #Optional 'moby:' namespace prefix
1133 }
1134
1135 sub isCollectionArticle {
1136   my ( $DOM ) = @_;
1137   eval {$DOM = _string_to_DOM($DOM) };
1138   return 0 if $@;
1139   $DOM = $DOM->getDocumentElement if ( $DOM->isa( "XML::LibXML::Document" ) );
1140   return ( $DOM->nodeName =~ /^(moby\:|)Collection$/ ) ? 1 : 0; #Optional 'moby:' prefix
1141 }
1142
1143 sub isSecondaryArticle {
1144   my ( $XML ) = @_;
1145   my $DOM;
1146   eval {$DOM = _string_to_DOM($XML)} ;
1147   return 0 if $@;
1148   $DOM = $DOM->getDocumentElement if ( $DOM->isa( "XML::LibXML::Document" ) );
1149   return ($DOM->nodeName =~ /^(moby\:|)Parameter$/) ? 1 : 0; #Optional 'moby:' prefix
1150 }
1151
1152
1153 =head2 validateNamespaces
1154
1155 B<function:> checks the namespace ontology for the namespace lsid
1156
1157 B<usage:> C<@LSIDs = validateNamespaces(@namespaces)>
1158
1159 B<args:> ordered list of either human-readable or lsid presumptive namespaces
1160
1161 B<returns:> ordered list of the LSID's corresponding to those
1162 presumptive namespaces; undef for each namespace that was invalid
1163
1164 =cut
1165
1166 sub validateNamespaces {
1167   # give me a list of namespaces and I will return the LSID's in order
1168   # I return undef in that list position if the namespace is invalid
1169   my ( @namespaces ) = @_;
1170   my $OS = MOBY::Client::OntologyServer->new;
1171   my @lsids;
1172   foreach ( @namespaces ) {
1173     my ( $s, $m, $LSID ) = $OS->namespaceExists( term => $_ );
1174     push @lsids, $s ? $LSID : undef;
1175   }
1176   return @lsids;
1177 }
1178
1179 =head2 validateThisNamespace
1180
1181 B<function:> checks a given namespace against a list of valid namespaces
1182
1183 B<usage:> C<$valid = validateThisNamespace($ns, @validNS);>
1184
1185 B<args:> ordered list of the namespace of interest and the list of valid NS's
1186
1187 B<returns:> boolean
1188
1189 =cut
1190
1191 sub validateThisNamespace {
1192   my ( $ns, @namespaces ) = @_;
1193   return 1 unless scalar @namespaces; # if you don't give me a list, I assume everything is valid...
1194   @namespaces = @{$namespaces[0]}  # if you send me an arrayref I should be kind... DWIM!
1195     if ( ref $namespaces[0] eq 'ARRAY' );
1196   return grep /$ns/, @namespaces;
1197 }
1198
1199
1200 =head1 ANCILIARY ELEMENTS
1201
1202 This section contains subroutines that handle processing of optional message elements containing
1203 meta-data. Examples are the ServiceNotes, and CrossReference blocks.
1204
1205 =head2 getServiceNotes
1206
1207 B<function:> to get the content of the Service Notes block of the MOBY message
1208
1209 B<usage:> C<getServiceNotes($message)>
1210
1211 B<args:> C<$message> is either the XML::LibXML of the MOBY message, or plain XML
1212
1213 B<returns:> String content of the ServiceNotes block of the MOBY Message
1214
1215 =cut
1216
1217 sub getServiceNotes {
1218   my ( $result ) = @_;
1219   return ( "" ) unless $result;
1220   my $moby = _string_to_DOM($result);
1221
1222   my $responses = $moby->getElementsByTagName( 'moby:serviceNotes' )
1223     || $moby->getElementsByTagName( 'serviceNotes' );
1224   my $content;
1225   foreach my $n ( 1 .. ( $responses->size() ) ) {
1226     my $resp = $responses->get_node( $n );
1227     foreach my $response_component ( $resp->childNodes ) {
1228       #            $content .= $response_component->toString;
1229       $content .= $response_component->nodeValue
1230         if ( $response_component->nodeType == TEXT_NODE );
1231       $content .= $response_component->nodeValue
1232         if ( $response_component->nodeType == CDATA_SECTION_NODE );
1233     }
1234   }
1235   return ( $content );
1236 }
1237
1238 =head2 getCrossReferences
1239
1240 B<function:> to get the cross-references for a Simple article
1241
1242 B<usage:> C<@xrefs = getCrossReferences($XML)>
1243
1244 B<args:> C<$XML> is either a SIMPLE article (<Simple>...</Simple>) or an
1245 object (the payload of a Simple article), and may be either raw XML or
1246 an XML::LibXML node.
1247
1248 B<returns:> an array of MOBY::CrossReference objects
1249
1250 B<example:>
1251
1252    my (($colls, $simps) = getResponseArticles($query);  # returns DOM nodes
1253    foreach (@{$simps}){
1254       my @xrefs = getCrossReferences($_);
1255       foreach my $xref(@xrefs){
1256           print "Cross-ref type: ",$xref->type,"\n";
1257           print "namespace: ",$xref->namespace,"\n";
1258           print "id: ",$xref->id,"\n";
1259           if ($xref->type eq "Xref"){
1260              print "Cross-ref relationship: ", $xref->xref_type,"\n";
1261           }
1262       }
1263    }
1264
1265 =cut
1266
1267 sub getCrossReferences {
1268   my ( $XML ) = @_;
1269   $XML = _string_to_DOM($XML);
1270   my @xrefs;
1271   my @XREFS;
1272   return () if ( $XML->nodeName =~ /^(moby:|)Collection$/ );
1273   if ( $XML->nodeName =~ /^(moby:|)Simple$/ ) {
1274     foreach my $child ( $XML->childNodes ) {
1275       next unless $child->nodeType == ELEMENT_NODE;
1276       $XML = $child;
1277       last;    # enforce proper MOBY message structure
1278     }
1279   }
1280   foreach ( $XML->childNodes ) {
1281     next unless (($_->nodeType == ELEMENT_NODE)
1282                  || ($_->nodeName =~ /^(moby:|)CrossReference$/) );
1283     foreach my $xref ( $_->childNodes ) {
1284       next unless ( ($xref->nodeType == ELEMENT_NODE)
1285                     || ($xref->nodeName =~ /^(moby:|)(Xref|Object)$/) );
1286       push @xrefs, $xref;
1287     }
1288   }
1289   foreach ( @xrefs ) {
1290     my $x;
1291     if ($_->nodeName =~ /^(moby:|)Xref$/) { $x = _makeXrefType( $_ ) }
1292     elsif ($_->nodeName =~ /^(moby:|)Object$/) { $x = _makeObjectType( $_ ) }
1293     push @XREFS, $x if $x;
1294   }
1295   return @XREFS;
1296 }
1297
1298
1299 =head1 CONSTRUCTING OUTPUT
1300
1301 This section describes how to construct output, in response to an
1302 incoming message. Responses come in three varieties:
1303
1304 =over 4
1305
1306 =item *
1307 Simple     - Only simple article(s)
1308
1309 =item *
1310 Collection - Only collection(s) of simples
1311
1312 =item *
1313 Complex    - Any combination of simple and/or collection and/or secondary articles.
1314
1315 =back
1316
1317 =head2 simpleResponse
1318
1319 B<function:> wraps a simple article in the appropriate (mobyData) structure.
1320 Works only for simple articles. If you need to mix simples with collections and/or
1321 secondaries use complexReponse instead.
1322
1323 B<usage:> C<$responseBody = simpleResponse($object, $ArticleName, $queryID);>
1324
1325 B<args:> (in order)
1326 C<$object>      - (optional) a MOBY Object as raw XML.
1327 C<$articleName> - (optional) an article name for this article.
1328 C<$queryID>     - (optional, but strongly recommended) the query ID value for the mobyData block to which you are responding.
1329
1330 B<notes:> As required by the API you must return a response for every
1331 input.  If one of the inputs was invalid, you return a valid (empty)
1332 MOBY response by calling simpleResponse(undef, undef, $queryID) with
1333 no arguments.
1334
1335 =cut
1336
1337 sub simpleResponse {
1338   my ( $data, $articleName, $qID ) = @_;    # articleName optional
1339   $qID = _getQueryID( $qID )
1340     if ref( $qID ) =~ /XML\:\:LibXML/;    # in case they send the DOM instead of the ID
1341   $data        ||= '';    # initialize to avoid uninit value errors
1342   $articleName ||= "";
1343   $qID         ||= "";
1344   if ( $articleName || $data) { # Linebreaks in XML make it easier for human debuggers to read!
1345     return "
1346         <moby:mobyData moby:queryID='$qID'>
1347             <moby:Simple moby:articleName='$articleName'>$data</moby:Simple>
1348         </moby:mobyData>
1349         ";
1350   } else {
1351     return "
1352         <moby:mobyData moby:queryID='$qID'/>
1353         ";
1354   }
1355 }
1356
1357
1358 =head2 collectionResponse
1359
1360 B<function:> wraps a set of articles in the appropriate mobyData structure.
1361 Works only for collection articles. If you need to mix collections with simples and/or
1362 secondaries use complexReponse instead.
1363
1364 B<usage:> C<$responseBody = collectionResponse(\@objects, $articleName, $queryID);>
1365
1366 B<args:> (in order)
1367 C<\@objects>    - (optional) a listref of MOBY Objects as raw XML.
1368 C<$articleName> - (optional) an artice name for this article.
1369 C<$queryID>     - (optional, but strongly recommended) the ID of the query to which you are responding.
1370
1371 B<notes:> as required by the API you must return a response for every
1372 input.  If one of the inputs was invalid, you return a valid (empty)
1373 MOBY response by calling collectionResponse(undef, undef, $queryID).
1374
1375 =cut
1376
1377 sub collectionResponse {
1378   my ( $data, $articleName, $qID ) = @_;    # articleName optional
1379   my $content = "";
1380   $data ||= [];
1381   $qID  ||= '';
1382   # The response should only be completely empty when the input $data is completely empty.
1383   # Testing just the first element is incorrect.
1384   my $not_completely_empty = 0;
1385   foreach (@{$data}) { $not_completely_empty += defined $_ }
1386   unless ( ( ref($data) eq 'ARRAY' ) && $not_completely_empty )
1387     {    # we're expecting an arrayref as input data, and it must not be empty
1388       return "<moby:mobyData moby:queryID='$qID'/>";
1389     }
1390   foreach ( @{$data} ) { # Newlines are for ease of human reading (pretty-printing).
1391     # 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.
1392     if ( $_ ) {
1393       $content .= "<moby:Simple>$_</moby:Simple>\n";
1394     } else {
1395       $content .= "<moby:Simple/>\n";
1396     }
1397   }
1398   if ( $articleName ) {
1399     return "
1400         <moby:mobyData moby:queryID='$qID'>
1401             <moby:Collection moby:articleName='$articleName'>
1402                 $content
1403             </moby:Collection>
1404         </moby:mobyData>
1405         ";
1406   } else {
1407     return "
1408         <moby:mobyData moby:queryID='$qID'>
1409             <moby:Collection moby:articleName='$articleName'>$content</moby:Collection>
1410         </moby:mobyData>
1411         ";
1412   }
1413 }
1414
1415 =head2 complexResponse
1416
1417 B<function:> wraps articles in the appropriate (mobyData) structure.
1418 Can be used to send any combination of the three BioMOBY article types -
1419 simple, collection and secondary - back to a client.
1420
1421 B<usage:> C<$responseBody = complexResponse(\@articles, $queryID);>
1422
1423 B<args:> (in order)
1424
1425 C<\@articles>   - (optional) a listref of arrays. Each element of @articles is
1426 itself a listref of [$articleName, $article], where $article is either
1427 the article's raw XML for simples and secondaries or a reference to an array containing
1428 [$articleName, $simpleXML] elements for a collection of simples.
1429
1430 C<$queryID> - (optional, but strongly recommended) the queryID value for
1431 the mobyData block to which you are responding
1432
1433 B<notes:> as required by the API you must return a response for every
1434 input.  If one of the inputs was invalid, you return a valid (empty)
1435 MOBY response by calling complexResponse(undef, $queryID) with no
1436 arguments.
1437
1438 =cut
1439
1440 sub complexResponse {
1441   my ( $data, $qID ) = @_;
1442   #return 'ERROR:  expected listref [element1, element2, ...] for data' unless ( ref( $data ) =~ /array/i );
1443   return "<moby:mobyData moby:queryID='$qID'/>\n"
1444     unless ( ref( $data ) eq 'ARRAY' );
1445   $qID = _getQueryID( $qID )
1446     if ref( $qID ) =~ /XML\:\:LibXML/;    # in case they send the DOM instead of the ID
1447   my @inputs = @{$data};
1448   my $output = "<moby:mobyData queryID='$qID'>";
1449   foreach ( @inputs ) {
1450     #return 'ERROR:  expected listref [articleName, XML] for data element' unless ( ref( $_ ) =~ /array/i );
1451     return "<moby:mobyData moby:queryID='$qID'/>\n"
1452       unless ( ref($_) eq 'ARRAY' );
1453     while ( my ( $articleName, $XML ) = splice( @{$_}, 0, 2 ) ) {
1454       if ( ref($XML) ne 'ARRAY' ) {
1455         $articleName ||= "";
1456         $XML         ||= "";
1457         if ( $XML =~ /\<(moby:|)Value\>/ ) {
1458           $output .=
1459             "<moby:Parameter moby:articleName='$articleName'>$XML</moby:Parameter>\n";
1460         } else {
1461           $output .=
1462             "<moby:Simple moby:articleName='$articleName'>\n$XML\n</moby:Simple>\n";
1463         }
1464       # Need to do this for collections also!!!!!!
1465       } else {
1466         my @objs = @{$XML};
1467         $output .= "<moby:Collection moby:articleName='$articleName'>\n";
1468         foreach ( @objs ) {
1469           $output .= "<moby:Simple>$_</moby:Simple>\n";
1470         }
1471         $output .= "</moby:Collection>\n";
1472       }
1473     }
1474   }
1475   $output .= "</moby:mobyData>\n";
1476   return $output;
1477 }
1478
1479 =head2 responseHeader
1480
1481 B<function:> print the XML string of a MOBY response header +/- serviceNotes
1482
1483 B<usage:>
1484
1485   responseHeader('illuminae.com')
1486
1487   responseHeader(
1488                 -authority => 'illuminae.com',
1489                 -note => 'here is some data from the service provider')
1490
1491 B<args:> a string representing the service providers authority URI, OR
1492 a set of named arguments with the authority and the service provision
1493 notes.
1494
1495 B< caveat   :>
1496
1497 B<notes:>  returns everything required up to the response articles themselves. i.e. something like:
1498
1499  <?xml version='1.0' encoding='UTF-8'?>
1500     <moby:MOBY xmlns:moby='http://www.biomoby.org/moby'>
1501        <moby:Response moby:authority='http://www.illuminae.com'>
1502
1503 =cut
1504
1505 sub responseHeader {
1506   use HTML::Entities ();
1507   my ( $auth, $notes ) = _rearrange( [qw[AUTHORITY NOTE]], @_ );
1508   $auth  ||= "not_provided";
1509   $notes ||= "";
1510   my $xml =
1511     "<?xml version='1.0' encoding='UTF-8'?>"
1512       . "<moby:MOBY xmlns:moby='http://www.biomoby.org/moby' xmlns='http://www.biomoby.org/moby'>"
1513         . "<moby:mobyContent moby:authority='$auth'>";
1514   if ( $notes ) {
1515     my $encodednotes = HTML::Entities::encode( $notes );
1516     $xml .= "<moby:serviceNotes>$encodednotes</moby:serviceNotes>";
1517   }
1518   return $xml;
1519 }
1520
1521 =head2 responseFooter
1522
1523 B<function:> print the XML string of a MOBY response footer
1524
1525 B<usage:>
1526
1527  return responseHeader('illuminae.com') . $DATA . responseFooter;
1528
1529 B<notes:>  returns everything required after the response articles themselves i.e. something like:
1530
1531   </moby:Response>
1532      </moby:MOBY>
1533
1534 =cut
1535
1536 sub responseFooter {
1537   return "</moby:mobyContent></moby:MOBY>";
1538 }
1539
1540
1541
1542 =head1 MISCELLANEOUS
1543
1544 This section contains routines that didn't quite seem to fit anywhere else.
1545
1546 =cut
1547
1548 =head2 _moby_getAttributeNode, _moby_getAttribute
1549
1550 B<function:> Perform the same task as the DOM routine
1551 getAttribute(Node), but check for both the prefixed and un-prefixed
1552 attribute name (the prefix in question being, of course,
1553 "moby:").
1554
1555 B<usage:>
1556
1557   $id = _moby_getAttribute($xml_libxml, "id");
1558
1559 where C<id> is an attribute in the XML block given as C<$xml_libxml>
1560
1561 B<notes:> This function is intended for use internal to this package
1562 only. It's not exported.
1563
1564 =cut
1565
1566 sub _moby_getAttributeNode {
1567   # Mimics behavior of XML::LibXML method getAttributeNode, but if the unqualified attribute cannot be found,
1568   # we qualify it with "moby:" and try again.
1569   # We do this so often this module, it's worth having a separate subroutine to do this.
1570   my ($xref, $attr) = @_;
1571   my ($package, $filename, $line) = caller;
1572   if ( !(ref($xref) =~ "^XML\:\:LibXML") ) {
1573     warn "_moby_getAttributeNode: Looking for attribute '$attr'"
1574       . "Can't parse non-XML argument '$xref',\n"
1575         . " called from line $line";
1576     return '';
1577   }
1578   if (!defined $attr) {
1579     warn "_moby_getAttributeNode: Non-empty attribute is required"
1580       . "\n called from line $line";
1581     return '';
1582   }
1583   return ( $xref->getAttributeNode($attr) || $xref->getAttributeNode( "moby:$attr" ) );
1584 }
1585
1586 sub _moby_getAttribute {
1587   # Mimics behavior of XML::LibXML method getAttribute, but if the unqualified attribute cannot be found,
1588   # we qualify it with "moby:" and try again.
1589   # We do this so often this module, it's worth having a separate subroutine to do this.
1590   my ($xref, $attr) = @_;
1591   my ($package, $filename, $line) = caller;
1592   if ( !(ref($xref) =~ "^XML\:\:LibXML")) {
1593     warn "_moby_getAttribute: Looking for attribute '$attr', "
1594     ."can't parse non-XML argument '$xref'\n"
1595       . "_moby_getAttribute called from line $line";
1596     return '';
1597   }
1598   if (!defined $attr) {
1599     warn "_moby_getAttribute: Non-empty attribute is required"
1600     . "\n called from line $line";
1601     return '';
1602   }
1603   return (   $xref->getAttribute($attr) || $xref->getAttribute("moby:$attr") );
1604 }
1605
1606 =head2 whichDeepestParentObject
1607
1608 B<function:> select the parent node from nodeList that is closest to the querynode
1609
1610 B<usage:>
1611
1612   ($term, $lsid) = whichDeepestParentObject($CENTRAL, $queryTerm, \@termList)
1613
1614 B<args:>
1615
1616 C<$CENTRAL> - your MOBY::Client::Central object
1617
1618 C<$queryTerm> - the object type I am interested in
1619
1620 C<\@termlist> - the list of object types that I know about
1621
1622 B<returns:> an ontology term and LSID as a scalar, or undef if there is
1623 no parent of this node in the nodelist.  note that it will only return
1624 the term if you give it term names in the @termList.  If you give it
1625 LSID's in the termList, then both the parameters returned will be
1626 LSID's - it doesn't back-translate...)
1627
1628 =cut
1629
1630 sub whichDeepestParentObject {
1631         my ( $CENTRAL, $queryTerm, $termlist ) = @_;
1632         return ( undef, undef )
1633           unless ( $CENTRAL && $queryTerm
1634                    && $termlist && ( ref( $termlist ) eq 'ARRAY' ) );
1635         my %nodeLSIDs;
1636         my $queryLSID = $CENTRAL->ObjLSID( $queryTerm );
1637         foreach ( @$termlist ) {    # get list of known LSIDs
1638           my $lsid = $CENTRAL->ObjLSID( $_ );
1639           return ( $_, $lsid )
1640             if ( $lsid eq $queryLSID );   # of course, if we find it in the list, then return it right away!
1641           $nodeLSIDs{$lsid} = $_;
1642         }
1643         return ( undef, undef ) unless keys( %nodeLSIDs );
1644         my $isa =
1645           $CENTRAL->ISA( $queryTerm, 'Object' )
1646           ;       # set the complete parentage in the cache if it isn't already
1647         return ( undef, undef )
1648           unless $isa;    # this should return true or we are in BIIIG trouble!
1649         my @ISAlsids =
1650           $CENTRAL->ISA_CACHE( $queryTerm )
1651           ;    # returns **LSIDs** in order, so we can shift our way back to root
1652         while ( my $thislsid = shift @ISAlsids ) {    # @isas are lsid's
1653                 return ( $nodeLSIDs{$thislsid}, $thislsid ) if $nodeLSIDs{$thislsid};
1654         }
1655         return ( undef, undef );
1656 }
1657
1658
1659 sub _makeXrefType {
1660   my ( $xref ) = @_;
1661   my $ns = _moby_getAttributeNode($xref, 'namespace' );
1662   return undef unless $ns;
1663   my $id = _moby_getAttributeNode($xref, 'id' );
1664   return undef unless $id;
1665   my $xr = _moby_getAttributeNode($xref, 'xref_type' );
1666   return undef unless $xr;
1667   my $ec = _moby_getAttributeNode($xref, 'evidence_code' );
1668   return undef unless $ec;
1669   my $au = _moby_getAttributeNode($xref, 'authURI' );
1670   return undef unless $au;
1671   my $sn = _moby_getAttributeNode($xref, 'serviceName' );
1672   return undef unless $sn;
1673   my $XREF = MOBY::CrossReference->new(
1674                                        type          => "xref",
1675                                        namespace     => $ns->getValue,
1676                                        id            => $id->getValue,
1677                                        authURI       => $au->getValue,
1678                                        serviceName   => $sn->getValue,
1679                                        evidence_code => $ec->getValue,
1680                                        xref_type     => $xr->getValue
1681                                       );
1682   return $XREF;
1683 }
1684
1685
1686 sub _makeObjectType {
1687   my ( $xref ) = @_;
1688   my $ns = _moby_getAttributeNode($xref, 'namespace' );
1689   return undef unless $ns;
1690   my $id = _moby_getAttributeNode($xref, 'id');
1691   return undef unless $id;
1692   my $XREF = MOBY::CrossReference->new(
1693                                        type      => "object",
1694                                        namespace => $ns->getValue,
1695                                        id        => $id->getValue,
1696                                       );
1697 }
1698
1699 =head2 _rearrange (stolen from BioPerl ;-) )
1700
1701 B<usage:>
1702          $object->_rearrange( array_ref, list_of_arguments)
1703
1704 B<Purpose :> Rearranges named parameters to requested order.
1705
1706 B<Example:>
1707    $self->_rearrange([qw(SEQUENCE ID DESC)],@param);
1708 Where C<@param = (-sequence => $s,  -desc     => $d,  -id       => $i);>
1709
1710 B<returns:> C<@params> - an array of parameters in the requested order.
1711
1712 The above example would return ($s, $i, $d).
1713 Unspecified parameters will return undef. For example, if
1714        C<@param = (-sequence => $s);>
1715 the above _rearrange call would return ($s, undef, undef)
1716
1717 B<Argument:> C<$order> : a reference to an array which describes the desired order of the named parameters.
1718
1719 C<@param :> an array of parameters, either as a list (in which case the function
1720 simply returns the list), or as an associative array with hyphenated
1721 tags (in which case the function sorts the values according to
1722 @{$order} and returns that new array.)  The tags can be upper, lower,
1723 or mixed case but they must start with a hyphen (at least the first
1724 one should be hyphenated.)
1725
1726 B< Source:> This function was taken from CGI.pm, written by
1727 Dr. Lincoln Stein, and adapted for use in Bio::Seq by Richard Resnick
1728 and then adapted for use in Bio::Root::Object.pm by Steve Chervitz,
1729 then migrated into Bio::Root::RootI.pm by Ewan Birney.
1730
1731 B<Comments:>
1732 Uppercase tags are the norm, (SAC) This method may not be appropriate
1733 for method calls that are within in an inner loop if efficiency is a
1734 concern.
1735
1736 Parameters can be specified using any of these formats:
1737   @param = (-name=>'me', -color=>'blue');
1738   @param = (-NAME=>'me', -COLOR=>'blue');
1739   @param = (-Name=>'me', -Color=>'blue');
1740   @param = ('me', 'blue');
1741
1742 A leading hyphenated argument is used by this function to indicate
1743 that named parameters are being used.  Therefore, the ('me', 'blue')
1744 list will be returned as-is.
1745
1746 Note that Perl will confuse unquoted, hyphenated tags as function
1747 calls if there is a function of the same name in the current
1748 namespace:  C<-name => 'foo'> is interpreted as C<-&name => 'foo'>
1749
1750 For ultimate safety, put single quotes around the tag: C<('-name'=>'me', '-color' =>'blue');>
1751
1752 This can be a bit cumbersome and I find not as readable as using all
1753 uppercase, which is also fairly safe:C<(-NAME=>'me', -COLOR =>'blue');>
1754
1755 Personal note (SAC): I have found all uppercase tags to be more
1756 managable: it involves less single-quoting, the key names stand out
1757 better, and there are no method naming conflicts.  The drawbacks are
1758 that it's not as easy to type as lowercase, and lots of uppercase can
1759 be hard to read. Regardless of the style, it greatly helps to line the parameters up
1760 vertically for long/complex lists.
1761
1762 =cut
1763
1764 sub _rearrange {
1765         #    my $dummy = shift;
1766         my $order = shift;
1767         return @_ unless ( substr( $_[0] || '', 0, 1 ) eq '-' );
1768         push @_, undef unless $#_ % 2;
1769         my %param;
1770         while ( @_ ) {
1771                 ( my $key = shift ) =~ tr/a-z\055/A-Z/d;    #deletes all dashes!
1772                 $param{$key} = shift;
1773         }
1774         map { $_ = uc( $_ ) } @$order;  # for bug #1343, but is there perf hit here?
1775         return @param{@$order};
1776 }
1777
1778 sub _getQueryID {
1779   my ( $query ) = @_;
1780   $query = _string_to_XML($query);
1781   return '' unless ( $query->nodeName =~ /^(moby:|)(queryInput|mobyData)$/ ); #Eddie - unsure
1782   return _moby_getAttribute($query, 'queryID' );
1783 }
1784