lib/MOBY/MOBYXSLT.pm

   1 package MOBYXSLT;
   2
   3 my $TMP_DIR   = '/tmp/';#Where your temporary files will be written
   4 my $XSLTPROC  = '/usr/bin/xsltproc';#Where your xsltproc binary is located
   5 my $XSL_SHEET = '/bioinfo/www/bioinfo/services/biomoby/cgi-bin/Services/LIPM/lib/parseMobyMessage.xsl';#Where your xsltproc style-sheet is located
   6
   7 #$Id: MOBYXSLT.pm,v 1.4 2005/12/15 14:03:41 carrere Exp $
   8
   9 =pod
  10
  11 =head1 NAME
  12
  13 MOBYXSLT - CommonSubs using XSLT
  14
  15 =head1 WHY
  16
  17 Because huge XML message parsing with XML::Dom take too much time.
  18 xsltproc is a binary very  very efficient to parse huge files.
  19
  20
  21 =head1 TO BE EDITED
  22
  23     Globals variables are defined in this package:
  24
  25         my $TMP_DIR   = '/tmp/'; #Where your temporary files will be written
  26         my $XSLTPROC  = '/usr/bin/xsltproc'; #Where your xsltproc binary is located
  27         my $XSL_SHEET = './parseMobyMessage.xsl'; #Where your xsltproc style-sheet is located
  28
  29
  30 =head1 SYNOPSIS
  31
  32 sub MonWebservice
  33 {
  34
  35     my ($caller, $message) = (@_);
  36
  37     my $moby_response;
  38
  39     my $service_name = 'MonWebservice';
  40
  41     #Message Parsing
  42     my ($service_notes,$ra_queries) = MOBYXSLT::getInputs($message); #Message Parsing
  43
  44     foreach my $query (@{$ra_queries})
  45     {
  46         my $query_id = MOBYXSLT::getInputID($query);#Retrieve Query ID
  47             my @a_input_articles = MOBYXSLT::getArticles($query);#Retrieve articles
  48
  49         my ($fasta_sequences, $fasta_namespace, $fasta_id)  = ('','','');
  50
  51         foreach my $input_article (@a_input_articles)
  52         {
  53             my ($article_name, $article) = @{$input_article};
  54
  55             if (MOBYXSLT::isSimpleArticle($article))
  56             {
  57                         my $object_type = MOBYXSLT::getObjectType($article);
  58
  59                         if (IsTheCorrectType($object_type))
  60                 {
  61                         $fasta_sequences = MOBYXSLT::getObjectContent($article);
  62                                     $fasta_namespace = MOBYXSLT::getObjectNamespace($article);
  63                                     $fasta_id = MOBYXSLT::getObjectId($article);
  64                 }
  65             }
  66             elsif (MOBYXSLT::isCollectionArticle($article))
  67             {
  68             }
  69
  70             elsif (MOBYXSLT::isSecondaryArticle($article))
  71             {
  72                     my ($param_name,$param_value) = MOBYXSLT::getParameter($article);#Retrieve parameters
  73             }
  74         }
  75
  76         ######
  77         #What you want to do with your data
  78         ######
  79
  80
  81         my $cmd ="...";
  82
  83         system("$cmd");
  84
  85
  86
  87
  88         #########
  89         #Send result
  90         #########
  91
  92         $moby_response .= MOBYXSLT::simpleResponse("<$output_object_type1>$out_data</$output_object_type1>", $output_article_name1, $query_id);
  93      }
  94
  95
  96     return SOAP::Data->type(
  97          'base64' => (MOBYXSLT::responseHeader(-authority => $auth_uri, -note => "Documentation about $service_name at $url_doc"))
  98            . $moby_response
  99            . MOBYXSLT::responseFooter());
 100
 101 }
 102
 103 =head1 GLOBALS
 104
 105         my $TMP_DIR   = '/tmp/'; #Where your temporary files will be written
 106         my $XSLTPROC  = '/usr/bin/xsltproc'; #Where your xsltproc binary is located
 107         my $XSL_SHEET = './parseMobyMessage.xsl'; #Where your xsltproc style-sheet is located
 108
 109
 110 =head1 DESCRIPTION
 111
 112         Note: many functions have same names as those from MOBY::CommonSubs
 113
 114 =cut
 115
 116
 117 use strict;
 118 use Carp;
 119
 120 =head2 function getInputs
 121
 122  Title        : getInputs
 123  Usage        : my ($servicenotes, $ra_queries) = getInputs($moby_message)
 124  Prerequisite :
 125  Function     : Parse Moby message and build Perl structures to access
 126                 for each query to their articles and objects.
 127  Returns      : $servicenotes: Notes returned by service provider
 128                 $ra_queries: ARRAYREF of all queries analysed in MOBY message
 129  Args         : $moby_message: MOBY XML message
 130  Globals      : $XSLTPROC: /path/to/xsltproc binary
 131                 $XSL_SHEET: XSL Sheet for MobyMessage Parsing
 132                 $TMP_DIR: /where
 133
 134 =cut
 135
 136 sub getInputs
 137 {
 138     my ($moby_message) = (@_);
 139
 140     my $tmp_file       = 'MOBYXSLT' . $$ . $^T;
 141     my $header_with_ns = "<moby:MOBY xmlns:moby='http://www.biomoby.org/moby' ";
 142
 143     $moby_message =~ s/xmlns:moby/xmlns:moby2/;
 144
 145     $moby_message =~ s/<moby:MOBY/$header_with_ns/;
 146
 147     open(TMP, ">$TMP_DIR$tmp_file") || confess("$! :$TMP_DIR$tmp_file");
 148     print TMP $moby_message;
 149     close TMP;
 150
 151     my $parsed_message = `$XSLTPROC $XSL_SHEET $TMP_DIR$tmp_file`;
 152
 153 #    open (PARSED, ">$TMP_DIR$tmp_file" . ".xsl");
 154 #    print PARSED "$XSLTPROC $XSL_SHEET $TMP_DIR$tmp_file\n\n\n";
 155 #    print PARSED "$parsed_message";
 156 #    close PARSED;
 157
 158     my $servicenotes = '';
 159     my @a_queries    = ();
 160
 161     my $servicenotes_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES#';
 162
 163     if ($parsed_message =~ /$servicenotes_tag(.+)$servicenotes_tag/)
 164     {
 165         ($servicenotes) = ($parsed_message =~ /$servicenotes_tag(.+)$servicenotes_tag/);
 166     }
 167
 168     my $mobydata_tag = '#XSL_LIPM_MOBYPARSER_DATA_START#';
 169     my ($header, @a_mobydata_blocs) = split($mobydata_tag, $parsed_message);
 170
 171     my $query_count = 0;
 172
 173     foreach my $mobydata_bloc (@a_mobydata_blocs)
 174     {
 175
 176         my $queryid_tag = '#XSL_LIPM_MOBYPARSER_QUERYID#';
 177         my ($queryid) = ($mobydata_bloc =~ /$queryid_tag(.+)$queryid_tag/);
 178
 179         my $article_start_tag = '#XSL_LIPM_MOBYPARSER_ARTICLE_START#';
 180         my ($header_article, @a_article_blocs) = split($article_start_tag, $mobydata_bloc);
 181
 182         my @a_input_articles = ();
 183
 184         foreach my $article_bloc (@a_article_blocs)
 185         {
 186             my $articlename_tag = '#XSL_LIPM_MOBYPARSER_ARTICLENAME#';
 187             my ($articlename) = ($article_bloc =~ /$articlename_tag(.+)$articlename_tag/);
 188
 189             my $articletype_tag = '#XSL_LIPM_MOBYPARSER_ARTICLETYPE#';
 190             my ($articletype) = ($article_bloc =~ /$articletype_tag(.+)$articletype_tag/);
 191             $articletype =~ s/^moby://;
 192
 193             my $simple_start_tag = '#XSL_LIPM_MOBYPARSER_SIMPLE_START#';
 194
 195             my $article_objects = '';
 196             if (_IsCollection($articletype))
 197             {
 198                 my ($header_collec, @a_simple_blocs) = split($simple_start_tag, $article_bloc);
 199                 my @a_simple_objects = ();
 200                 foreach my $simple_bloc (@a_simple_blocs)
 201                 {
 202                     my $rh_simple = _AnalyseSimple($simple_bloc);
 203                     push(@a_simple_objects, $rh_simple);
 204                 }
 205                 $article_objects = \@a_simple_objects;
 206             }
 207             elsif (_IsSimple($articletype))
 208             {
 209                 my ($header_collec, $simple_bloc) = split($simple_start_tag, $article_bloc);
 210                 $article_objects = _AnalyseSimple($simple_bloc);
 211             }
 212             elsif (_IsSecondary($articletype))
 213             {
 214
 215                 my $secondary_start = '#XSL_LIPM_MOBYPARSER_SECONDARY_START#';
 216                 my $secondary_end   = '#XSL_LIPM_MOBYPARSER_SECONDARY_END#';
 217                 my $secondary_sep   = '#XSL_LIPM_MOBYPARSER_SECONDARY_SEP#';
 218                 my (@a_param) = ($article_bloc =~ /$secondary_start(.+)$secondary_sep(.+)$secondary_end/);
 219                 $article_objects = \@a_param;
 220             }
 221
 222             my %h_input_article = (
 223                                    'article_type'    => $articletype,
 224                                    'article_name'    => $articlename,
 225                                    'article_objects' => $article_objects
 226                                    );
 227
 228             push(@a_input_articles, \%h_input_article);
 229
 230         }
 231
 232         my %h_query = (
 233                        'query_id'       => $queryid,
 234                        'query_articles' => \@a_input_articles
 235                        );
 236
 237         push(@a_queries, \%h_query);
 238
 239     }
 240
 241     unlink("$TMP_DIR$tmp_file");
 242     return ($servicenotes, \@a_queries);
 243 }
 244
 245 =head2 function getInputID
 246
 247  Title        : getInputID
 248  Usage        : my $query_id =getInputID($rh_query);
 249  Prerequisite :
 250  Function     : Return query_id of a query from getInputs
 251  Returns      : $query_id
 252  Args         : $rh_query: query HASHREF structure from getInputs
 253  Globals      : none
 254
 255 =cut
 256
 257 sub getInputID
 258 {
 259     my $rh_query = shift();
 260     return $rh_query->{'query_id'};
 261 }
 262
 263 =head2 function getArticles
 264
 265  Title        : getArticles
 266  Usage        : my @a_input_articles =getArticles($rh_query);
 267  Prerequisite :
 268  Function     : For a query from getInputs, retrieve list of articles
 269                 represented by a ARRAYREF corresponding to REF(articleName, articlePerlStructure)
 270  Returns      : @a_input_articles: ARRAY of articles ARRAYREF
 271  Args         : $rh_query: query HASHREF structure from getInputs
 272  Globals      : none
 273
 274 =cut
 275
 276 sub getArticles
 277 {
 278     my $rh_query         = shift();
 279     my @a_input_articles = ();
 280
 281     foreach my $rh_input_article (@{$rh_query->{'query_articles'}})
 282     {
 283         my @a_input_article = ($rh_input_article->{'article_name'}, $rh_input_article);
 284         push(@a_input_articles, \@a_input_article);
 285     }
 286     return (@a_input_articles);
 287 }
 288
 289 =head2 function getCollectedSimples
 290
 291  Title        : getCollectedSimples
 292  Usage        : my @a_simple_articles =getCollectedSimples($rh_collection_article);
 293  Prerequisite :
 294  Function     : For a collection query from getArticles, retrieve list of
 295                 simple articles
 296  Returns      : @a_simple_articles: ARRAY of articles HASHREF
 297  Args         : $rh_collection_article: collection article HASHREF structure from getArticles
 298  Globals      : none
 299
 300 =cut
 301
 302 sub getCollectedSimples
 303 {
 304     my $rh_collection_article = shift();
 305     return @{$rh_collection_article->{'article_objects'}};
 306 }
 307
 308 =head2 function getCrossReferences
 309
 310  Title        : getCrossReferences
 311  Usage        : my @a_crossreferences =getCrossReferences($rh_simple_article);
 312  Prerequisite :
 313  Function     : Takes a simple article structure (from getArticles or getCollectedSimples)
 314                 and retrieve the list of crossreferences HASHREF
 315  Returns      : @a_crossreferences: ARRAY of crossreferences HASHREF
 316  Args         : $rh_simple_article: simple article HASHREF structure from getArticles or getCollectedSimples
 317  Globals      : none
 318
 319 =cut
 320
 321 sub getCrossReferences
 322 {
 323     my $rh_simple_article = shift();
 324
 325     if ($rh_simple_article->{'object_crossreference'} ne '')
 326     {
 327         return (@{$rh_simple_article->{'object_crossreference'}});
 328     }
 329     else
 330     {
 331         return ();
 332     }
 333 }
 334
 335 =head2 function getObjectHasaElements
 336
 337  Title        : getObjectHasaElements
 338  Usage        : my @a_hasa_elements =getObjectHasaElements($rh_simple_article);
 339  Prerequisite :
 340  Function     : Takes a simple article structure (from getArticles or getCollectedSimples)
 341                 and retrieve the list of "HASA" element HASHREF
 342  Returns      : @a_hasa_elements: ARRAY of "HASA" element HASHREF
 343  Args         : $rh_object: simple article HASHREF structure from getArticles or getCollectedSimples
 344  Globals      : none
 345
 346 =cut
 347
 348 sub getObjectHasaElements
 349 {
 350     my $rh_simple_article = shift();
 351
 352     if (defined $rh_simple_article->{'article_objects'})
 353     {
 354         if ($rh_simple_article->{'article_objects'}->{'object_hasa'} ne '')
 355         {
 356             return (@{$rh_simple_article->{'article_objects'}->{'object_hasa'}});
 357         }
 358         else
 359         {
 360             return ();
 361         }
 362     }
 363     else
 364     {
 365         if ($rh_simple_article->{'object_hasa'} ne '')
 366         {
 367             return @{$rh_simple_article->{'object_hasa'}};
 368         }
 369         else
 370         {
 371             return ();
 372         }
 373     }
 374
 375 #    if ($rh_object->{'object_hasa'} ne '')
 376 #    {
 377 #       return (@{$rh_object->{'object_hasa'}});
 378 #    }
 379 #    else
 380 #    {
 381 #        return ();
 382 #    }
 383 }
 384
 385 =head2 function getObjectType
 386
 387  Title        : getObjectType
 388  Usage        : my $object_type =getObjectType($rh_object);
 389  Prerequisite :
 390  Function     : Returns object MOBY class/type
 391  Returns      : $object_type: object MOBY class/type
 392  Args         : $rh_object: simple article (object) HASHREF structure from getArticles,getCollectedSimples or getObjectHasaElements
 393  Globals      : none
 394
 395 =cut
 396
 397 sub getObjectType
 398 {
 399     my $rh_object = shift();
 400     if (defined $rh_object->{'article_objects'})
 401     {
 402         return ($rh_object->{'article_objects'}->{'object_type'});
 403     }
 404     else
 405     {
 406         return $rh_object->{'object_type'};
 407     }
 408 }
 409
 410 =head2 function getObjectName
 411
 412  Title        : getObjectName
 413  Usage        : my $object_name =getObjectName($rh_object);
 414  Prerequisite :
 415  Function     : Returns object moby:articleName
 416  Returns      : $object_name:  moby:articleName
 417  Args         : $rh_object: simple article (object) HASHREF structure from getArticles,getCollectedSimples or getObjectHasaElements
 418  Globals      : none
 419
 420 =cut
 421
 422 sub getObjectName
 423 {
 424     my $rh_object = shift();
 425     if (defined $rh_object->{'article_objects'})
 426     {
 427         return ($rh_object->{'article_objects'}->{'object_name'});
 428     }
 429     else
 430     {
 431         return $rh_object->{'object_name'};
 432     }
 433 }
 434
 435 =head2 function getObjectNamespace
 436
 437  Title        : getObjectNamespace
 438  Usage        : my $object_namespace =getObjectNamespace($rh_object);
 439  Prerequisite :
 440  Function     : Returns object moby:namespace
 441  Returns      : $object_name:  moby:namespace
 442  Args         : $rh_object: simple article (object) HASHREF structure from getArticles,getCollectedSimples or getObjectHasaElements
 443  Globals      : none
 444
 445 =cut
 446
 447 sub getObjectNamespace
 448 {
 449     my $rh_object = shift();
 450     if (defined $rh_object->{'article_objects'})
 451     {
 452         return ($rh_object->{'article_objects'}->{'object_namespace'});
 453     }
 454     else
 455     {
 456         return $rh_object->{'object_namespace'};
 457     }
 458 }
 459
 460 =head2 function getObjectContent
 461
 462  Title        : getObjectContent
 463  Usage        : my $object_content =getObjectContent($rh_object);
 464  Prerequisite :
 465  Function     : Returns object content (using HTML::Entities::decode)
 466                 Warning: this content could contain emptylines if
 467                         your objects contains Crossreferences or Hasa Elements ...
 468  Returns      : $object_content:  object content (decoded using HTML::Entities::decode)
 469  Args         : $rh_object: simple article (object) HASHREF structure from getArticles,getCollectedSimples or getObjectHasaElements
 470  Globals      : none
 471
 472 =cut
 473
 474 sub getObjectContent
 475 {
 476     use HTML::Entities ();
 477     my $rh_object       = shift();
 478     my $encoded_content = '';
 479     if (defined $rh_object->{'article_objects'})
 480     {
 481         $encoded_content = $rh_object->{'article_objects'}->{'object_content'};
 482     }
 483     else
 484     {
 485         $encoded_content = $rh_object->{'object_content'};
 486     }
 487     my $decoded_object = HTML::Entities::decode($encoded_content);
 488     return ($decoded_object);
 489 }
 490
 491 =head2 function getObjectXML
 492
 493  Title        : getObjectXML
 494  Usage        : my $object_xml =getObjectXML($rh_object);
 495  Prerequisite :
 496  Function     : Returns full object moby:xml string
 497  Returns      : $object_xml:  object moby:xml string
 498  Args         : $rh_object: simple article (object) HASHREF structure from getArticles,getCollectedSimples or getObjectHasaElements
 499  Globals      : none
 500
 501 =cut
 502
 503 sub getObjectXML
 504 {
 505     my $rh_object = shift();
 506     if (defined $rh_object->{'article_objects'})
 507     {
 508         return ($rh_object->{'article_objects'}->{'object_xml'});
 509     }
 510     else
 511     {
 512         return $rh_object->{'object_xml'};
 513     }
 514
 515 }
 516
 517 =head2 function getObjectId
 518
 519  Title        : getObjectId
 520  Usage        : my $object_id =getObjectId($rh_object);
 521  Prerequisite :
 522  Function     : Returns object moby:id
 523  Returns      : $object_id:  moby:id
 524  Args         : $rh_object: simple article (object) HASHREF structure from getArticles,getCollectedSimples or getObjectHasaElements
 525  Globals      : none
 526
 527 =cut
 528
 529 sub getObjectId
 530 {
 531     my $rh_object = shift();
 532
 533     if (defined $rh_object->{'article_objects'})
 534     {
 535         return ($rh_object->{'article_objects'}->{'object_id'});
 536     }
 537     else
 538     {
 539         return $rh_object->{'object_id'};
 540     }
 541 }
 542
 543 =head2 function getParameter
 544
 545  Title        : getParameter
 546  Usage        : my ($parameter_name,$parameter_value) =getParameter($rh_article);
 547  Prerequisite :
 548  Function     : Returns parameter name an value for a Secondary aricle
 549  Returns      : $parameter_name
 550                 $parameter_value
 551  Args         : $rh_article: secondary article HASHREF structure from getArticles
 552  Globals      : none
 553
 554 =cut
 555
 556 sub getParameter
 557 {
 558     my $rh_article = shift();
 559     if (_IsSecondary($rh_article->{'article_type'}))
 560     {
 561         return (@{$rh_article->{'article_objects'}});
 562     }
 563
 564     return;
 565 }
 566
 567 =head2 function getNodeContentWithArticle
 568
 569  Title        : getNodeContentWithArticle
 570  Usage        : my $content = getNodeContentWithArticle($rh_query, $article_type, $article_name)
 571  Prerequisite :
 572  Function     : inside a mobyData bloc (structured in $rh_query),
 573                 look for an article of a defined type (Simple, Collection or Parameter).
 574                 Foreach matching article, search for an object named $article_name.
 575                 If found, return its content.
 576  Returns      : $content: content of article requested
 577  Args         : $rh_query: query HASHREF structure from getInputs
 578                 $article_type: 'Simple/Collection/Parameter'
 579                 $article_name: attribute moby:articleName
 580  Globals      :
 581
 582 =cut
 583
 584 sub getNodeContentWithArticle
 585 {
 586     my ($rh_query, $article_type, $article_name) = (@_);
 587
 588     foreach my $rh_article (@{$rh_query->{'query_articles'}})
 589     {
 590         if (   (_IsSecondary($article_type))
 591             && ($rh_article->{'article_type'} =~ /^$article_type$/i)
 592             && ($article_name eq $rh_article->{'article_name'}))
 593         {
 594             my ($article_name, $article_value) = @{$rh_article->{'article_objects'}};
 595             return $article_value;
 596         }
 597         elsif (_IsSimple($article_type))
 598         {
 599             if ($rh_article->{'article_type'} =~ /^$article_type$/i)
 600             {
 601
 602                 if ($rh_article->{'article_name'} eq $article_name)
 603                 {
 604                     return $rh_article->{'article_objects'}->{'object_content'};
 605                 }
 606                 elsif ($rh_article->{'article_objects'}->{'object_hasa'} ne '')
 607                 {
 608                     foreach my $rh_object (@{$rh_article->{'article_objects'}->{'object_hasa'}})
 609                     {
 610                         if ($rh_object->{'object_name'} eq $article_name)
 611                         {
 612                             return $rh_object->{'object_content'};
 613                         }
 614                     }
 615                 }
 616             }
 617         }
 618         elsif (_IsCollection($article_type))
 619         {
 620             if ($rh_article->{'article_type'} =~ /^$article_type$/i)
 621             {
 622                 if ($rh_article->{'article_name'} eq $article_name)
 623                 {
 624                     my $content = '';
 625                     foreach my $rh_object (@{$rh_article->{'article_objects'}})
 626                     {
 627                         $content .= $rh_object->{'object_content'};
 628                     }
 629                     return $content;
 630                 }
 631                 else
 632                 {
 633                     foreach my $rh_object (@{$rh_article->{'article_objects'}})
 634                     {
 635                         if ($rh_object->{'object_name'} eq $article_name)
 636                         {
 637                             return $rh_object->{'object_content'};
 638                         }
 639                     }
 640                 }
 641
 642             }
 643         }
 644     }
 645
 646     return;
 647 }
 648
 649 =head2 function isSimpleArticle
 650
 651  Title        : isSimpleArticle
 652  Usage        : isSimpleArticle($rh_article)
 653  Prerequisite :
 654  Function     : Test if an article is a moby:Simple
 655  Returns      : $response: BOOLEAN
 656  Args         : $rh_article: article HASHREF structure from getArticles
 657  Globals      : none
 658
 659 =cut
 660
 661 sub isSimpleArticle
 662 {
 663     my $rh_article = shift();
 664     my $response   = _IsSimple($rh_article->{article_type});
 665     return $response;
 666 }
 667
 668 =head2 function isCollectionArticle
 669
 670  Title        : isCollectionArticle
 671  Usage        : isCollectionArticle($rh_article)
 672  Prerequisite :
 673  Function     : Test if an article is a moby:Collection
 674  Returns      : $response: BOOLEAN
 675  Args         : $rh_article: article HASHREF structure from getArticles
 676  Globals      : none
 677
 678 =cut
 679
 680 sub isCollectionArticle
 681 {
 682     my $rh_article = shift();
 683     my $response   = _IsCollection($rh_article->{article_type});
 684     return $response;
 685 }
 686
 687 =head2 function isSecondaryArticle
 688
 689  Title        : isSecondaryArticle
 690  Usage        : isSecondaryArticle($rh_article)
 691  Prerequisite :
 692  Function     : Test if articleType is moby:Parameter (secondary article)
 693  Returns      : $response: BOOLEAN
 694  Args         : $rh_article: article HASHREF structure from getArticles
 695  Globals      : none
 696
 697 =cut
 698
 699 sub isSecondaryArticle
 700 {
 701     my $rh_article = shift();
 702     my $response   = _IsSecondary($rh_article->{article_type});
 703     return $response;
 704 }
 705
 706 =head2 function _AnalyseSimple
 707
 708  Title        : _AnalyseSimple
 709  Usage        : _AnalyseSimple($simple_bloc)
 710  Prerequisite :
 711  Function     : Analyse a "Simple Bloc" from XSL transformation parsing
 712                 Build a $rh_simple_article structure with fields:
 713                         'object_name'           => moby:articleName
 714                         'object_type'           => moby:Class
 715                         'object_namespace'      => moby:namespace
 716                         'object_id'             => moby:id
 717                         'object_content'        => text content of simple article
 718                         'object_xml'            => full xml content of article
 719                         'object_hasa'           => ARRAYREF of hasa elements
 720                                                    (each one is structured in a same
 721                                                    structured hash (recursivity)
 722                         'object_crossreference' => ARRAYREF of crossreferences objects
 723                                                    (each one is structured in a hash with fields
 724                                                    'type', 'id', 'namespace')
 725
 726  Returns      : $rh_simple: article HASHREF
 727  Args         : $simple_bloc: from parsing of a "simple" XSLT transformation
 728  Globals      : none
 729
 730 =cut
 731
 732 sub _AnalyseSimple
 733 {
 734     my $simple_bloc = shift();
 735     my @a_crossref  = ();
 736     my @a_hasa      = ();
 737
 738     my ($object_type,$object_name,$object_id,$object_namespace) = ('','','','');
 739     my $object_type_tag = '#XSL_LIPM_MOBYPARSER_OBJECTTYPE#';
 740
 741     if ($simple_bloc =~ /$object_type_tag(.+)$object_type_tag/)
 742     {
 743         $object_type = $1;
 744         $object_type =~ s/^moby://i;
 745     }
 746
 747     my $object_namespace_tag = '#XSL_LIPM_MOBYPARSER_OBJECTNAMESPACE#';
 748
 749     if ($simple_bloc =~ /$object_namespace_tag(.+)$object_namespace_tag/)
 750     {
 751         $object_namespace = $1;
 752     }
 753
 754     my $object_id_tag = '#XSL_LIPM_MOBYPARSER_OBJECTID#';
 755
 756     if ($simple_bloc =~ /$object_id_tag(.+)$object_id_tag/)
 757     {
 758         $object_id = $1;
 759     }
 760
 761     my $object_name_tag = '#XSL_LIPM_MOBYPARSER_OBJECTNAME#';
 762
 763     if ($simple_bloc =~ /$object_name_tag(.+)$object_name_tag/)
 764     {
 765         $object_name = $1
 766     }
 767
 768     my $crossref_start_tag = '#XSL_LIPM_MOBYPARSER_CROSSREF_START#';
 769     my $crossref_end_tag   = '#XSL_LIPM_MOBYPARSER_CROSSREF_END#';
 770     my $crossref_sep_tag   = '#XSL_LIPM_MOBYPARSER_CROSSREF_SEP#';
 771
 772     while ($simple_bloc =~ m/$crossref_start_tag(.*)$crossref_sep_tag(.*)$crossref_sep_tag(.*)$crossref_end_tag/g)
 773     {
 774         my %h_crossref = ('type' => $1, 'id' => $2, 'namespace' => $3);
 775         push(@a_crossref, \%h_crossref);
 776     }
 777
 778     my $ra_crossref = \@a_crossref;
 779     if ($#a_crossref < 0)
 780     {
 781         $ra_crossref = '';
 782     }
 783
 784     my $object_content_tag = '#XSL_LIPM_MOBYPARSER_OBJECTCONTENT#';
 785     my ($before, $object_content, $after) = ('','','');
 786     ($before, $object_content, $after) = split($object_content_tag, $simple_bloc);
 787
 788     my $object_hasa_start_tag = '#XSL_LIPM_MOBYPARSER_OBJECTHASA_START#';
 789
 790     if ($simple_bloc =~ /$object_hasa_start_tag/)
 791     {
 792         my (@a_hasa_blocs) = split($object_hasa_start_tag, $simple_bloc);
 793
 794         foreach my $hasa_bloc (@a_hasa_blocs)
 795         {
 796             if ($hasa_bloc ne '')
 797             {
 798                 my $rh_hasa = _AnalyseSimple($hasa_bloc);
 799                 push(@a_hasa, $rh_hasa);
 800             }
 801         }
 802     }
 803
 804     my $ra_hasa    = \@a_hasa;
 805     my $object_xml = '';
 806
 807     if ($#a_hasa < 0)
 808     {
 809         $ra_hasa    = '';
 810         $object_xml =
 811           "<moby:$object_type moby:id='$object_id' moby:namespace='$object_namespace'>$object_content</moby:$object_type>";
 812     }
 813     else
 814     {
 815         $object_xml = "<moby:$object_type moby:id='$object_id' moby:namespace='$object_namespace'>\n";
 816         foreach my $rh_hasa (@a_hasa)
 817         {
 818             $object_xml .= $rh_hasa->{'object_content'} . "\n";
 819         }
 820         $object_xml .= "</moby:$object_type>";
 821     }
 822
 823     my %h_simple = (
 824                     'object_name'           => $object_name,
 825                     'object_type'           => $object_type,
 826                     'object_namespace'      => $object_namespace,
 827                     'object_id'             => $object_id,
 828                     'object_content'        => $object_content,
 829                     'object_xml'            => $object_xml,
 830                     'object_crossreference' => $ra_crossref,
 831                     'object_hasa'           => $ra_hasa
 832                     );
 833
 834     return \%h_simple;
 835 }
 836
 837 =head2 simpleResponse (stolen from MOBY::CommonSubs)
 838
 839  name     : simpleResponse
 840  function : wraps a simple article in the appropriate (mobyData) structure
 841  usage    : $resp .= &simpleResponse($object, 'MyArticleName', $queryID);
 842  args     : (in order)
 843             $object   - (optional) a MOBY Object as raw XML
 844             $article  - (optional) an articeName for this article
 845             $query    - (optional, but strongly recommended) the queryID value for the
 846                         mobyData block to which you are responding
 847  notes    : as required by the API you must return a response for every input.
 848             If one of the inputs was invalid, you return a valid (empty) MOBY
 849             response by calling &simpleResponse(undef, undef, $queryID) with no arguments.
 850
 851 =cut
 852
 853 sub simpleResponse
 854 {
 855     my ($data, $articleName, $qID) = @_;    # articleName optional
 856
 857     $data        ||= '';                    # initialize to avoid uninit value errors
 858     $qID         ||= "";
 859     $articleName ||= "";
 860     if ($articleName)
 861     {
 862         return "
 863         <moby:mobyData moby:queryID='$qID'>
 864             <moby:Simple moby:articleName='$articleName'>$data</moby:Simple>
 865         </moby:mobyData>
 866         ";
 867     }
 868     elsif ($data)
 869     {
 870         return "
 871         <moby:mobyData moby:queryID='$qID'>
 872             <moby:Simple moby:articleName='$articleName'>$data</moby:Simple>
 873         </moby:mobyData>
 874         ";
 875     }
 876     else
 877     {
 878         return "
 879         <moby:mobyData moby:queryID='$qID'/>
 880         ";
 881     }
 882 }
 883
 884 =head2 collectionResponse (stolen from MOBY::CommonSubs)
 885
 886  name     : collectionResponse
 887  function : wraps a set of articles in the appropriate mobyData structure
 888  usage    : return responseHeader . &collectionResponse(\@objects, 'MyArticleName', $queryID) . responseFooter;
 889  args     : (in order)
 890             \@objects - (optional) a listref of MOBY Objects as raw XML
 891             $article  - (optional) an articeName for this article
 892             $queryID  - (optional, but strongly recommended) the mobyData ID
 893                         to which you are responding
 894  notes    : as required by the API you must return a response for every input.
 895             If one of the inputs was invalid, you return a valid (empty) MOBY
 896             response by calling &collectionResponse(undef, undef, $queryID).
 897
 898 =cut
 899
 900 sub collectionResponse
 901 {
 902     my ($data, $articleName, $qID) = @_;    # articleName optional
 903     my $content = "";
 904     $data ||= [];
 905     $qID  ||= '';
 906     unless ((ref($data) =~ /array/i) && $data->[0])
 907     {                                       # we're expecting an arrayref as input data,and it must not be empty
 908         return "<moby:mobyData moby:queryID='$qID'/>";
 909     }
 910
 911     foreach (@{$data})
 912     {
 913         if ($_)
 914         {
 915             $content .= "
 916                 <moby:Simple>$_</moby:Simple>
 917             ";
 918         }
 919         else
 920         {
 921             $content .= "
 922                 <moby:Simple/>
 923             ";
 924         }
 925     }
 926     if ($articleName)
 927     {
 928         return "
 929         <moby:mobyData moby:queryID='$qID'>
 930             <moby:Collection moby:articleName='$articleName'>
 931                 $content
 932             </moby:Collection>
 933         </moby:mobyData>
 934         ";
 935     }
 936     else
 937     {
 938         return "
 939         <moby:mobyData moby:queryID='$qID'>
 940             <moby:Collection moby:articleName='$articleName'>$content</moby:Collection>
 941         </moby:mobyData>
 942         ";
 943     }
 944 }
 945
 946 =head2 responseHeader (stolen from MOBY::CommonSubs)
 947
 948  name     : responseHeader
 949  function : print the XML string of a MOBY response header +/- serviceNotes
 950  usage    : responseHeader('illuminae.com')
 951             responseHeader(
 952                 -authority => 'illuminae.com',
 953                 -note => 'here is some data from the service provider')
 954  args     : a string representing the service providers authority URI,
 955             OR a set of named arguments with the authority and the
 956             service provision notes.
 957  caveat   :
 958  notes    :  returns everything required up to the response articles themselves.
 959              i.e. something like:
 960  <?xml version='1.0' encoding='UTF-8'?>
 961     <moby:MOBY xmlns:moby='http://www.biomoby.org/moby'>
 962        <moby:Response moby:authority='http://www.illuminae.com'>
 963
 964
 965 =cut
 966
 967 sub responseHeader
 968 {
 969     use HTML::Entities ();
 970     my ($auth, $notes) = &_rearrange([qw[AUTHORITY NOTE]], @_);
 971     $auth  ||= "not_provided";
 972     $notes ||= "";
 973     my $xml =
 974         "<?xml version='1.0' encoding='UTF-8'?>"
 975       . "<moby:MOBY xmlns:moby='http://www.biomoby.org/moby' xmlns='http://www.biomoby.org/moby'>"
 976       . "<moby:mobyContent moby:authority='$auth'>";
 977     if ($notes)
 978     {
 979         my $encodednotes = HTML::Entities::encode($notes);
 980         $xml .= "<moby:serviceNotes>$encodednotes</moby:serviceNotes>";
 981     }
 982     return $xml;
 983 }
 984
 985 =head2 responseFooter (stolen from MOBY::CommonSubs)
 986
 987  name     : responseFooter
 988  function : print the XML string of a MOBY response footer
 989  usage    : return responseHeader('illuminae.com') . $DATA . responseFooter;
 990  notes    :  returns everything required after the response articles themselves
 991              i.e. something like:
 992
 993   </moby:Response>
 994      </moby:MOBY>
 995
 996 =cut
 997
 998 sub responseFooter
 999 {
1000     return "</moby:mobyContent></moby:MOBY>";
1001 }
1002
1003 =head2 function _IsCollection
1004
1005  Title        : _IsCollection
1006  Usage        : _IsCollection($article_type)
1007  Prerequisite :
1008  Function     : Compares a string to string 'collection'
1009                 Remove namespace 'moby:' from parameter string
1010                 Case insensitive
1011  Returns      : BOOLEAN
1012  Args         : $articletype: a string
1013  Globals      : none
1014
1015 =cut
1016
1017 sub _IsCollection
1018 {
1019     my $articletype = shift();
1020
1021     $articletype =~ s/^moby://;
1022     if ($articletype =~ /^collection$/i)
1023     {
1024         return 1;
1025     }
1026     else
1027     {
1028         return 0;
1029     }
1030 }
1031
1032 =head2 function _IsSimple
1033
1034  Title        : _IsSimple
1035  Usage        : _IsSimple($article_type)
1036  Prerequisite :
1037  Function     : Compares a string to string 'simple'
1038                 Remove namespace 'moby:' from parameter string
1039                 Case insensitive
1040  Returns      : BOOLEAN
1041  Args         : $articletype: a string
1042  Globals      : none
1043
1044 =cut
1045
1046 sub _IsSimple
1047 {
1048     my $articletype = shift();
1049
1050     $articletype =~ s/^moby://;
1051     if ($articletype =~ /^simple$/i)
1052     {
1053         return 1;
1054     }
1055     else
1056     {
1057         return 0;
1058     }
1059 }
1060
1061 =head2 function _IsSecondary
1062
1063  Title        : _IsSecondary
1064  Usage        : _IsSecondary($article_type)
1065  Prerequisite :
1066  Function     : Compares a string to string 'parameter'
1067                 Remove namespace 'moby:' from parameter string
1068                 Case insensitive
1069  Returns      : BOOLEAN
1070  Args         : $articletype: a string
1071  Globals      : none
1072
1073 =cut
1074
1075 sub _IsSecondary
1076 {
1077     my $articletype = shift();
1078
1079     $articletype =~ s/^moby://;
1080     if ($articletype =~ /^parameter$/i)
1081     {
1082         return 1;
1083     }
1084     else
1085     {
1086         return 0;
1087     }
1088 }
1089
1090 =head2 _rearrange (stolen from MOBY::CommonSubs)
1091
1092
1093 =cut
1094
1095 sub _rearrange
1096 {
1097
1098     #    my $dummy = shift;
1099     my $order = shift;
1100
1101     return @_ unless (substr($_[0] || '', 0, 1) eq '-');
1102     push @_, undef unless $#_ % 2;
1103     my %param;
1104     while (@_)
1105     {
1106         (my $key = shift) =~ tr/a-z\055/A-Z/d;    #deletes all dashes!
1107         $param{$key} = shift;
1108     }
1109     map {$_ = uc($_)} @$order;                    # for bug #1343, but is there perf hit here?
1110     return @param{@$order};
1111 }
1112
1113 1;