[MOBY-guts] biomoby commit
Sebastien Carrere
carrere at dev.open-bio.org
Wed Jun 20 12:36:32 UTC 2007
carrere
Wed Jun 20 08:36:24 EDT 2007
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory dev.open-bio.org:/tmp/cvs-serv19023
Modified Files:
MOBYXSLT.pm
Log Message:
Exceptions are now parsed
moby-live/Perl/MOBY MOBYXSLT.pm,1.4,1.5
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/MOBYXSLT.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- /home/repository/moby/moby-live/Perl/MOBY/MOBYXSLT.pm 2005/12/15 14:03:41 1.4
+++ /home/repository/moby/moby-live/Perl/MOBY/MOBYXSLT.pm 2007/06/20 12:36:23 1.5
@@ -2,7 +2,7 @@
my $TMP_DIR = '/tmp/';#Where your temporary files will be written
my $XSLTPROC = '/usr/bin/xsltproc';#Where your xsltproc binary is located
-my $XSL_SHEET = '/bioinfo/www/bioinfo/services/biomoby/cgi-bin/Services/LIPM/lib/parseMobyMessage.xsl';#Where your xsltproc style-sheet is located
+my $XSL_SHEET = 'xsl/parseMobyMessage.xsl';#Where your xsltproc style-sheet is located
#$Id$
@@ -150,21 +150,23 @@
my $parsed_message = `$XSLTPROC $XSL_SHEET $TMP_DIR$tmp_file`;
-# open (PARSED, ">$TMP_DIR$tmp_file" . ".xsl");
-# print PARSED "$XSLTPROC $XSL_SHEET $TMP_DIR$tmp_file\n\n\n";
-# print PARSED "$parsed_message";
-# close PARSED;
-
+
+
my $servicenotes = '';
+ my $ra_exceptions = ();
my @a_queries = ();
my $servicenotes_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES#';
-
- if ($parsed_message =~ /$servicenotes_tag(.+)$servicenotes_tag/)
+ $parsed_message =~ s/\n/__nl__/g;
+ if ($parsed_message =~ /$servicenotes_tag(.*)$servicenotes_tag/)
{
- ($servicenotes) = ($parsed_message =~ /$servicenotes_tag(.+)$servicenotes_tag/);
+ my $notes = $1;
+
+ ($servicenotes,$ra_exceptions) = _AnalyseServiceNotes($notes);
+ #($servicenotes) = ($parsed_message =~ /$servicenotes_tag(.+)$servicenotes_tag/);
}
-
+ $parsed_message =~ s/__nl__/\n/g;
+
my $mobydata_tag = '#XSL_LIPM_MOBYPARSER_DATA_START#';
my ($header, @a_mobydata_blocs) = split($mobydata_tag, $parsed_message);
@@ -239,7 +241,7 @@
}
unlink("$TMP_DIR$tmp_file");
- return ($servicenotes, \@a_queries);
+ return ($servicenotes, \@a_queries, $ra_exceptions);
}
=head2 function getInputID
@@ -322,14 +324,71 @@
{
my $rh_simple_article = shift();
- if ($rh_simple_article->{'object_crossreference'} ne '')
+ if (defined $rh_simple_article->{'article_objects'})
{
- return (@{$rh_simple_article->{'object_crossreference'}});
+ if ($rh_simple_article->{'article_objects'}->{'object_crossreference'} ne '')
+ {
+ return (@{$rh_simple_article->{'article_objects'}->{'object_crossreference'}});
+ }
+ else
+ {
+ return ();
+ }
}
else
{
- return ();
+ if ($rh_simple_article->{'object_crossreference'} ne '')
+ {
+ return @{$rh_simple_article->{'object_crossreference'}};
+ }
+ else
+ {
+ return ();
+ }
}
+
+}
+
+=head2 function getProvisionInformation
+
+ Title : getProvisionInformation
+ Usage : my @a_pib =getProvisionInformation($rh_simple_article);
+ Prerequisite :
+ Function : Takes a simple article structure (from getArticles or getCollectedSimples)
+ and retrieve the list of Provision Information HASHREF
+ Returns : @a_pib: ARRAY of provisionInformation HASHREF
+ Args : $rh_simple_article: simple article HASHREF structure from getArticles or getCollectedSimples
+ Globals : none
+
+=cut
+
+sub getProvisionInformation
+{
+ my $rh_simple_article = shift();
+
+ if (defined $rh_simple_article->{'article_objects'})
+ {
+ if ($rh_simple_article->{'article_objects'}->{'object_pib'} ne '')
+ {
+ return (@{$rh_simple_article->{'article_objects'}->{'object_pib'}});
+ }
+ else
+ {
+ return ();
+ }
+ }
+ else
+ {
+ if ($rh_simple_article->{'object_pib'} ne '')
+ {
+ return @{$rh_simple_article->{'object_pib'}};
+ }
+ else
+ {
+ return ();
+ }
+ }
+
}
=head2 function getObjectHasaElements
@@ -733,6 +792,7 @@
{
my $simple_bloc = shift();
my @a_crossref = ();
+ my @a_pib = ();
my @a_hasa = ();
my ($object_type,$object_name,$object_id,$object_namespace) = ('','','','');
@@ -771,7 +831,8 @@
while ($simple_bloc =~ m/$crossref_start_tag(.*)$crossref_sep_tag(.*)$crossref_sep_tag(.*)$crossref_end_tag/g)
{
- my %h_crossref = ('type' => $1, 'id' => $2, 'namespace' => $3);
+ my %h_crossref = ('type' => $1, 'id' => $2, 'namespace' => $3);
+ $simple_bloc =~ s/$crossref_start_tag$1$crossref_sep_tag$2$crossref_sep_tag$3$crossref_end_tag//;
push(@a_crossref, \%h_crossref);
}
@@ -781,16 +842,96 @@
$ra_crossref = '';
}
+ #19/12/2005
+ #Provision Information Block
+
+ my $pib_start_tag = '#XSL_LIPM_MOBYPARSER_PIB_START#';
+ my $pib_end_tag = '#XSL_LIPM_MOBYPARSER_PIB_END#';
+ my $pib_software_start_tag = '#XSL_LIPM_MOBYPARSER_SOFTWARE_START#';
+ my $pib_software_end_tag = '#XSL_LIPM_MOBYPARSER_SOFTWARE_END#';
+ my $pib_software_sep_tag = '#XSL_LIPM_MOBYPARSER_SOFTWARE_SEP#';
+ my $pib_database_start_tag = '#XSL_LIPM_MOBYPARSER_DATABASE_START#';
+ my $pib_database_end_tag = '#XSL_LIPM_MOBYPARSER_DATABASE_END#';
+ my $pib_database_sep_tag = '#XSL_LIPM_MOBYPARSER_DATABASE_SEP#';
+ my $pib_comment_start_tag = '#XSL_LIPM_MOBYPARSER_COMMENT_START#';
+ my $pib_comment_end_tag = '#XSL_LIPM_MOBYPARSER_COMMENT_END#';
+
+
+ while ($simple_bloc =~ m/$pib_start_tag(.*)$pib_end_tag/g)
+ {
+ my $provision_block = $1;
+ $simple_bloc =~ s/$pib_start_tag$provision_block$pib_end_tag//;
+ my ($software_name,$software_version,$software_comment) = ('','','');
+ if ($provision_block =~ /$pib_software_start_tag(.*)$pib_software_end_tag/)
+ {
+ ($software_name,$software_version,$software_comment) = split (/$pib_software_sep_tag/,$1);
+ }
+ my ($database_name,$database_version,$database_comment) = ('','','');
+ if ($provision_block =~ /$pib_database_start_tag(.*)$pib_database_end_tag/)
+ {
+ ($database_name,$database_version,$database_comment) = split (/$pib_database_sep_tag/,$1);
+ }
+ my ($service_comment) = ('');
+ if ($provision_block =~ /$pib_comment_start_tag(.*)$pib_comment_end_tag/)
+ {
+ ($service_comment) = ($1);
+ }
+
+ my %h_pib = (
+ 'software_name' => $software_name,
+ 'software_version' => $software_version,
+ 'software_comment' => $software_comment,
+ 'database_name' => $database_name,
+ 'database_version' => $database_version,
+ 'database_comment' => $database_comment,
+ 'service_comment' => $service_comment
+ );
+
+ open (TMP, ">>/tmp/pib.txt");
+ print TMP <<END;
+'software_name' => $software_name,
+'software_version' => $software_version,
+'software_comment' => $software_comment,
+'database_name' => $database_name,
+'database_version' => $database_version,
+'database_comment' => $database_comment,
+'service_comment' => $service_comment
+END
+ close TMP;
+ chmod 0777, "/tmp/pib.txt";
+
+ push(@a_pib, \%h_pib);
+ }
+
+ my $ra_pib = \@a_pib;
+ if ($#a_pib < 0)
+ {
+ $ra_pib = '';
+ }
+
+
+
+
+
my $object_content_tag = '#XSL_LIPM_MOBYPARSER_OBJECTCONTENT#';
my ($before, $object_content, $after) = ('','','');
($before, $object_content, $after) = split($object_content_tag, $simple_bloc);
- my $object_hasa_start_tag = '#XSL_LIPM_MOBYPARSER_OBJECTHASA_START#';
+ #Sebastien 21/12/2005
+ #
+ $object_content =~ s/^\s+//g;
+ $object_content =~ s/\s+$//g;
+ #
+
+ my $object_hasa_start_tag = '#XSL_LIPM_MOBYPARSER_OBJECTHASA_START#';
if ($simple_bloc =~ /$object_hasa_start_tag/)
{
my (@a_hasa_blocs) = split($object_hasa_start_tag, $simple_bloc);
+ #Sebastien 19/12/2005
+ #le premier est le pere
+ #shift @a_hasa_blocs;
foreach my $hasa_bloc (@a_hasa_blocs)
{
if ($hasa_bloc ne '')
@@ -828,6 +969,7 @@
'object_content' => $object_content,
'object_xml' => $object_xml,
'object_crossreference' => $ra_crossref,
+ 'object_pib' => $ra_pib,
'object_hasa' => $ra_hasa
);
@@ -943,45 +1085,166 @@
}
}
+
+=head2 complexResponse (stolen from MOBY::CommonSubs)
+
+ name : complexResponse
+ function : wraps a set of articles in the one mobyData structure
+ usage : return responseHeader . &complexResponse(\@a_article_structures, $queryID) . responseFooter;
+ args : (in order)
+ \@a_article_structures - (optional) a listref of structured articles
+ %h_article = (
+ article_type => 'collection/simple',
+ article_content => 'MOBY XML formatted content',
+ article_name => 'articleName attribut')
+ $queryID - (optional, but strongly recommended) the mobyData ID
+ to which you are responding
+=cut
+
+
+sub complexResponse
+{
+ my ($ra_data, $qID) = @_;
+
+ $ra_data ||= [];
+ $qID ||= '';
+ unless ((ref($ra_data) =~ /array/i) && $ra_data->[0])
+ { # we're expecting an arrayref as input data,and it must not be empty
+ return "<moby:mobyData moby:queryID='$qID'/>";
+ }
+ my $moby_data_content = '';
+ foreach my $rh_data_block (@{$ra_data})
+ {
+ my $article_name = $rh_data_block->{article_name};
+ my $article_content = $rh_data_block->{article_content};
+
+ if ($rh_data_block->{article_type} =~ /collection/i)
+ {
+ my $collection_content = "<moby:Collection moby:articleName='$article_name'>\n";
+ if ((ref($article_content) =~ /array/i) && $article_content->[0])
+ {
+ foreach my $simple_element (@{$article_content})
+ {
+ $collection_content .= "\t<moby:Simple>\n\t$simple_element\n\t</moby:Simple>\n";
+ }
+ }
+ else
+ {
+ $collection_content .= "\t<moby:Simple/>\n";
+ }
+ $collection_content .= "</moby:Collection>\n";
+
+ $moby_data_content .= $collection_content;
+
+ }
+ else
+ {
+ my $simple_content = "<moby:Simple moby:articleName='$article_name'>\n\t$article_content\n</moby:Simple>";
+ $moby_data_content .= $simple_content;
+ }
+ }
+
+ return "<moby:mobyData moby:queryID='$qID'>\n\t$moby_data_content\n</moby:mobyData>\n";
+}
+
+
=head2 responseHeader (stolen from MOBY::CommonSubs)
- name : responseHeader
- function : print the XML string of a MOBY response header +/- serviceNotes
- usage : responseHeader('illuminae.com')
- responseHeader(
+B<function:> print the XML string of a MOBY response header +/- serviceNotes +/- Exceptions
+
+B<usage:>
+
+ responseHeader('illuminae.com')
+
+ responseHeader(
-authority => 'illuminae.com',
- -note => 'here is some data from the service provider')
- args : a string representing the service providers authority URI,
- OR a set of named arguments with the authority and the
- service provision notes.
- caveat :
- notes : returns everything required up to the response articles themselves.
- i.e. something like:
+ -note => 'here is some data from the service provider'
+ -exception=>'an xml encoded exception string')
+
+
+B<args:> a string representing the service providers authority URI, OR
+a set of named arguments with the authority and the service provision
+notes which can include already xml encoded exceptions
+
+B< caveat :>
+
+B<notes:> returns everything required up to the response articles themselves. i.e. something like:
+
<?xml version='1.0' encoding='UTF-8'?>
<moby:MOBY xmlns:moby='http://www.biomoby.org/moby'>
<moby:Response moby:authority='http://www.illuminae.com'>
-
=cut
-sub responseHeader
-{
- use HTML::Entities ();
- my ($auth, $notes) = &_rearrange([qw[AUTHORITY NOTE]], @_);
- $auth ||= "not_provided";
- $notes ||= "";
- my $xml =
- "<?xml version='1.0' encoding='UTF-8'?>"
- . "<moby:MOBY xmlns:moby='http://www.biomoby.org/moby' xmlns='http://www.biomoby.org/moby'>"
- . "<moby:mobyContent moby:authority='$auth'>";
- if ($notes)
- {
- my $encodednotes = HTML::Entities::encode($notes);
- $xml .= "<moby:serviceNotes>$encodednotes</moby:serviceNotes>";
+sub responseHeader {
+ use HTML::Entities ();
+ my ( $auth, $notes, $exception ) = _rearrange( [qw[AUTHORITY NOTE EXCEPTION]], @_ );
+ $auth ||= "not_provided";
+ $notes ||= "";
+ $exception ||="";
+ my $xml =
+ "<?xml version='1.0' encoding='UTF-8'?>"
+ . "<moby:MOBY xmlns:moby='http://www.biomoby.org/moby' xmlns='http://www.biomoby.org/moby'>"
+ . "<moby:mobyContent moby:authority='$auth'>";
+ if ($exception) {
+ $xml .= "<moby:serviceNotes>$exception";
+ if ( $notes ) {
+ my $encodednotes = HTML::Entities::encode( $notes );
+ $xml .= "<moby:Notes>$encodednotes</moby:Notes>";
}
- return $xml;
+ $xml .="</moby:serviceNotes>";
+ }
+
+ elsif ( $notes ) {
+ my $encodednotes = HTML::Entities::encode( $notes );
+ $xml .= "<moby:serviceNotes><moby:Notes>$encodednotes</moby:Notes></moby:serviceNotes>";
+ }
+ return $xml;
+}
+
+
+=head2 encodeException (stolen from MOBY::CommonSubs)
+
+B<function:> wraps a Biomoby Exception with all its parameters into the appropiate MobyData structure
+
+B<usage:>
+
+ encodeException(
+ -refElement => 'refers to the queryID of the offending input mobyData',
+ -refQueryID => 'refers to the articleName of the offending input Simple or Collection'
+ -severity=>'error'
+ -exceptionCode=>'An error code '
+ -exceptionMessage=>'a human readable description for the error code')
+
+B<args:>the different arguments required by the mobyException API
+ severity can be either error, warning or information
+ valid error codes are decribed on the biomoby website
+
+
+B<notes:> returns everything required to use for the responseHeader:
+
+ <moby:mobyException moby:refElement='input1' moby:refQueryID='1' moby:severity =''>
+ <moby:exceptionCode>600</moby:exceptionCode>
+ <moby:exceptionMessage>Unable to execute the service</moby:exceptionMessage>
+ </moby:mobyException>
+
+=cut
+
+sub encodeException{
+ use HTML::Entities ();
+ my ( $refElement, $refQueryID, $severity, $code, $message ) = _rearrange( [qw[REFELEMENT REFQUERYID SEVERITY EXCEPTIONCODE EXCEPTIONMESSAGE]], @_ );
+ $refElement ||= "";
+ defined($refQueryID) || ($refQueryID= "");
+ $severity ||= "";
+ defined($code) || ($code = "");
+ $message ||= "not provided";
+ my $xml="<moby:mobyException moby:refElement='$refElement' moby:refQueryID='$refQueryID' moby:severity ='$severity'>".
+ "<moby:exceptionCode>$code</moby:exceptionCode>".
+ "<moby:exceptionMessage>".HTML::Entities::encode($message)."</moby:exceptionMessage>".
+ "</moby:mobyException>";
}
+
=head2 responseFooter (stolen from MOBY::CommonSubs)
name : responseFooter
@@ -1110,4 +1373,110 @@
return @param{@$order};
}
+
+=head2 function _AnalyseServiceNotes
+
+ Title : _AnalyseServiceNotes
+ Usage : _AnalyseServiceNotes($simple_bloc)
+ Prerequisite :
+ Function : Analyse a "Simple Bloc" from XSL transformation parsing
+ Build a $rh_simple_article structure with fields:
+ 'object_name' => moby:articleName
+ 'object_type' => moby:Class
+ 'object_namespace' => moby:namespace
+ 'object_id' => moby:id
+ 'object_content' => text content of simple article
+ 'object_xml' => full xml content of article
+ 'object_hasa' => ARRAYREF of hasa elements
+ (each one is structured in a same
+ structured hash (recursivity)
+ 'object_crossreference' => ARRAYREF of crossreferences objects
+ (each one is structured in a hash with fields
+ 'type', 'id', 'namespace')
+
+ Returns : $services_notes: article HASHREF
+ $ra_exceptions: article HASHREF
+ Args : $service_notes_bloc: from parsing of a "serviceNotes" XSLT transformation
+ Globals : none
+
+=cut
+
+sub _AnalyseServiceNotes
+{
+ my $service_notes_block = shift();
+ my @a_exceptions = ();
+ my $service_notes = '';
+
+
+ my $exception_start_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_START#';
+ my $exception_end_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_END#';
+ my $exception_refelement_start_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_REFELEMENT_START#';
+ my $exception_refelement_end_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_REFELEMENT_END#';
+ my $exception_refqueryid_start_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_REFQUERYID_START#';
+ my $exception_refqueryid_end_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_REFQUERYID_END#';
+ my $exception_severity_start_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_SEVERITY_START#';
+ my $exception_severity_end_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_SEVERITY_END#';
+ my $exception_code_start_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_CODE_START#';
+ my $exception_code_end_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_CODE_END#';
+ my $exception_message_start_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_MESSAGE_START#';
+ my $exception_message_end_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_EXCEPTION_MESSAGE_END#';
+
+
+ while ($service_notes_block =~ m/$exception_start_tag(.*)$exception_end_tag/g)
+ {
+ my $exception_block = $1;
+ my ($refelement,$refqueryid,$severity,$code,$message) = ('','','','','');
+ if ($exception_block =~ /$exception_refelement_start_tag(.*)$exception_refelement_end_tag/)
+ {
+ $refelement = $1;
+ }
+ if ($exception_block =~ /$exception_refqueryid_start_tag(.*)$exception_refqueryid_end_tag/)
+ {
+ $refqueryid = $1;
+ }
+ if ($exception_block =~ /$exception_severity_start_tag(.*)$exception_severity_end_tag/)
+ {
+ $severity = $1;
+ }
+ if ($exception_block =~ /$exception_code_start_tag(.*)$exception_code_end_tag/)
+ {
+ $code = $1;
+ }
+ if ($exception_block =~ /$exception_message_start_tag(.*)$exception_message_end_tag/)
+ {
+ $message = $1;
+ $message =~ s/__nl__/\n/g;
+
+ }
+
+ my %h_exception = (
+ 'refelement' => $refelement,
+ 'refqueryid' => $refqueryid,
+ 'severity' => $severity,
+ 'code' => $code,
+ 'message' => $message
+ );
+
+
+ push(@a_exceptions, \%h_exception);
+ }
+ my $ra_exceptions = \@a_exceptions;
+ if ($#a_exceptions < 0)
+ {
+ $ra_exceptions = '';
+ }
+
+
+ my $notes_start_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_NOTES_START#';
+ my $notes_end_tag = '#XSL_LIPM_MOBYPARSER_SERVICENOTES_NOTES_END#';
+
+ if ($service_notes_block =~ /$notes_start_tag(.*)$notes_end_tag/)
+ {
+ $service_notes = $1;
+ }
+
+ return ($service_notes,$ra_exceptions);
+}
+
+
1;
More information about the MOBY-guts
mailing list