package PmbTest; # Copyright INRA # Sebastien.Carrere@toulouse.inra.fr # Jerome.Gouzy@toulouse.inra.fr # This software is a computer program whose purpose is to provide # a code generator framework for BioMoby web-services. # This software is governed by the CeCILL license under French law and # abiding by the rules of distribution of free software. You can use, # modify and/ or redistribute the software under the terms of the CeCILL # license as circulated by CEA, CNRS and INRIA at the following URL # "http://www.cecill.info". # As a counterpart to the access to the source code and rights to copy, # modify and redistribute granted by the license, users are provided only # with a limited warranty and the software's author, the holder of the # economic rights, and the successive licensors have only limited # liability. # In this respect, the user's attention is drawn to the risks associated # with loading, using, modifying and/or developing or reproducing the # software by the user in light of its specific status of free software, # that may mean that it is complicated to manipulate, and that also # therefore means that it is reserved for developers and experienced # professionals having in-depth computer knowledge. Users are therefore # encouraged to load and test the software's suitability as regards their # requirements in conditions enabling the security of their systems and/or # data to be ensured and, more generally, to use and operate it in the # same conditions as regards security. # The fact that you are presently reading this means that you have had # knowledge of the CeCILL license and that you accept its terms.
PmbTest
Playmoby Test routines used mainly in pmb_CheckWS.pl
Sebastien.Carrere@toulouse.inra.fr
use strict; use ParamParser; use Carp; use vars qw(@ISA @EXPORT); use XML::Twig; use MOBY::MOBYXSLT; require Exporter; @ISA = qw(Exporter); @EXPORT = qw( &LoadPmbTestXml &TestArticle &PrintTestResult );
Title : LoadPmbTestXml Usage : my $rh_pmbtests = PmbTest::LoadPmbTestXml( $file, [$rh_pmbtests]); Prerequiste: none Function : parse and Load PlayMOBY tests from a XML test file Returns : an hashref where keys are biomoby output article names foreach article name, 2 tests are loaded : - format test - content test Args : $file, XML PlayMOBY test file (cf. Appli.pm) optionnal $rh_pmbtests, predefined hashref to be filled Error : none Globals : none
sub LoadPmbTestXml { my $xml_file = shift; my $rh_pmbtests = shift; my %h_pmbtests = (); %h_pmbtests = %{$rh_pmbtests} if (defined $rh_pmbtests); my $o_xml = new XML::Twig(); $o_xml->parsefile($xml_file); my $o_root_elt = $o_xml->root; my @a_o_article_elts = $o_root_elt->get_xpath("/playmoby:test/playmoby:service/playmoby:article"); foreach my $o_article_elt (@a_o_article_elts) { my $article_name = $o_article_elt->{att}->{name}; my ($o_format_test_elt) = $o_article_elt->get_xpath("playmoby:format"); my $format_test = $o_format_test_elt->text; my ($o_content_test_elt) = $o_article_elt->get_xpath("playmoby:content"); my $content_test = $o_content_test_elt->text; $h_pmbtests{$article_name} = {format => "$format_test", content => "$content_test"}; } return \%h_pmbtests; }
Title : TestArticle Usage : my $rh_pmbtests = PmbTest::TestArticle( $rh_pmbtests,$article_name,$data_article); Prerequiste: none Function : Test every biomoby output article name extracted from BioMOBY message; if no test defined for one of the articles it's mentioned and global status as a special value of '2' Returns : an hashref with test eval results Args : $rh_pmbtests, predefined hashref with articles to be evaluated $article_name, the name of tested output article extracted from BioMOBY message $data_article, content of this article Error : none Globals : none
sub TestArticle { my ($rh_pmbtests, $article_name, $data_article) = (@_); if (defined $rh_pmbtests->{$article_name}) { $rh_pmbtests->{$article_name}->{raw} = $data_article; $_ = $data_article; if (defined $rh_pmbtests->{$article_name}->{format}) { $rh_pmbtests->{$article_name}->{format_result} = {}; ( $rh_pmbtests->{$article_name}->{format_result}->{code}, $rh_pmbtests->{$article_name}->{format_result}->{label} ) = eval($rh_pmbtests->{$article_name}->{format}); $rh_pmbtests->{$article_name}->{format_result}->{perl} = $rh_pmbtests->{$article_name}->{format}; } if (defined $rh_pmbtests->{$article_name}->{content}) { $rh_pmbtests->{$article_name}->{content_result} = {}; ( $rh_pmbtests->{$article_name}->{content_result}->{code}, $rh_pmbtests->{$article_name}->{content_result}->{label} ) = eval($rh_pmbtests->{$article_name}->{content}); $rh_pmbtests->{$article_name}->{content_result}->{perl} = $rh_pmbtests->{$article_name}->{content}; } } else { $rh_pmbtests->{$article_name}->{format_result} = {}; ( $rh_pmbtests->{$article_name}->{format_result}->{code}, $rh_pmbtests->{$article_name}->{format_result}->{label} ) = (1, "No test available"); $rh_pmbtests->{$article_name}->{format_result} = {}; ( $rh_pmbtests->{$article_name}->{format_result}->{code}, $rh_pmbtests->{$article_name}->{format_result}->{label} ) = (1, "No test available"); $rh_pmbtests->{global_status} = 2; $rh_pmbtests->{fatal} = "$article_name has not been tested"; } return $rh_pmbtests; }
Title : PrintTestResult Usage : my $xml_string = PmbTest::PrintTestResult( $rh_pmbtests,$xml_file); Prerequiste: none Function : Print Test results in an XML (root element = playmoby:monitoring) file using data from test hashref Returns : a XML string (root element = playmoby:test) Args : $rh_pmbtests, predefined hashref with articles test evaluations $xml_file, output file (STDOUT if not defined) Error : none Globals : #http_path# (for XSL access)
sub PrintTestResult { my ($rh_pmbtests, $xml_file) = (@_); my $date = &__GetDate; my $xml_test_result = "<playmoby:test date=\"$date\" >"; my $service_name = $rh_pmbtests->{service_name}; my $service_authuri = $rh_pmbtests->{auth_uri}; my $service_registry = $rh_pmbtests->{registry}; my $service_duration = $rh_pmbtests->{duration}; my $service_rdf = $rh_pmbtests->{rdf}; my $service_contact = $rh_pmbtests->{contact}; my $mobyexceptioncode = $rh_pmbtests->{mobyexceptioncode}; my $mobyexceptionmessage = $rh_pmbtests->{mobyexceptionmessage}; $xml_test_result .= "<playmoby:service name=\"$service_name\" auth_uri=\"$service_authuri\" registry=\"$service_registry\" contact=\"$service_contact\" rdf=\"$service_rdf\">"; $xml_test_result .= "<playmoby:duration>$service_duration</playmoby:duration>"; $xml_test_result .= "<playmoby:mobyexception>"; $xml_test_result .= "<playmoby:code>" . $mobyexceptioncode . "</playmoby:code>"; $xml_test_result .= "<playmoby:label><![CDATA[" . $mobyexceptionmessage . "]]></playmoby:label>"; $xml_test_result .= "</playmoby:mobyexception>"; my $global_status = 1; $global_status = 0 if (defined $rh_pmbtests->{fatal}); foreach my $article_name (keys %$rh_pmbtests) { next if (ref($rh_pmbtests->{$article_name}) !~ /hash/i); $xml_test_result .= "<playmoby:article name=\"$article_name\" >"; $xml_test_result .= "<playmoby:format>"; $xml_test_result .= "<playmoby:code>" . $rh_pmbtests->{$article_name}->{format_result}->{code} . "</playmoby:code>"; $xml_test_result .= "<playmoby:label><![CDATA[" . $rh_pmbtests->{$article_name}->{format_result}->{label} . "]]></playmoby:label>"; $xml_test_result .= "<playmoby:perl><![CDATA[" . $rh_pmbtests->{$article_name}->{format_result}->{perl} . "]]></playmoby:perl>"; $xml_test_result .= "</playmoby:format>"; $xml_test_result .= "<playmoby:content>"; $xml_test_result .= "<playmoby:code>" . $rh_pmbtests->{$article_name}->{content_result}->{code} . "</playmoby:code>"; $xml_test_result .= "<playmoby:label><![CDATA[" . $rh_pmbtests->{$article_name}->{content_result}->{label} . "]]></playmoby:label>"; $xml_test_result .= "<playmoby:perl><![CDATA[" . $rh_pmbtests->{$article_name}->{content_result}->{perl} . "]]></playmoby:perl>"; $xml_test_result .= "</playmoby:content>"; $xml_test_result .= "<playmoby:raw><![CDATA[" . $rh_pmbtests->{$article_name}->{raw} . "]]></playmoby:raw>"; $xml_test_result .= "</playmoby:article>"; $global_status = 0 if ( ($rh_pmbtests->{$article_name}->{format_result}->{code} == 0) || ($rh_pmbtests->{$article_name}->{content_result}->{code} == 0)); } $global_status = $rh_pmbtests->{global_status} if (defined $rh_pmbtests->{global_status}); $xml_test_result .= "<playmoby:global_status>$global_status</playmoby:global_status>"; if ($global_status == 0) { $rh_pmbtests->{fatal} = "Functionnal tests failed" if (!defined $rh_pmbtests->{fatal} || ($rh_pmbtests->{fatal} eq '')); } my $test_fatal = $rh_pmbtests->{fatal}; $xml_test_result .= "<playmoby:fatal>$test_fatal</playmoby:fatal>"; $xml_test_result .= "</playmoby:service>"; $xml_test_result .= "</playmoby:test>"; my $o_xml = new XML::Twig(pretty_print => 'indented', empty_tags => 'html'); $o_xml->parse( '<playmoby:monitoring xmlns:playmoby="http://lipm-bioinfo.toulouse.inra.fr/biomoby/playmoby">' . $xml_test_result . '</playmoby:monitoring>'); $o_xml->add_stylesheet(xsl => "#http_path#/web/xsl/report.xsl"); $o_xml->set_encoding(); $o_xml->set_output_encoding('utf-8'); if (defined $xml_file) { $o_xml->print_to_file($xml_file); } else { print STDOUT $o_xml->sprint(); } return $xml_test_result; }
Title : GetFullReport Usage : my $xml_string = PmbTest::GetFullReport( $xml_string); Prerequiste: test are done for every single webservice Function : Print Test results in an XML (root element = playmoby:monitoring) for all tested webservices Returns : a XML string (root element = playmoby:monitoring) Args : $xml_string, concatenation of all services playmoby:test XML strings Error : none Globals : #http_path# (for XSL access)
sub GetFullReport { my $xml_string = shift; my $o_xml = new XML::Twig(pretty_print => 'indented', empty_tags => 'html'); $o_xml->parse($xml_string); $o_xml->add_stylesheet(xsl => "#http_path#/web/xsl/report.xsl"); $o_xml->set_encoding(); $o_xml->set_output_encoding('utf-8'); return ($o_xml->sprint()); }
Title : GetArticlesData Usage : my $rh_articles_data = PmbTest::GetArticlesData( $query ); Prerequiste: none Function : analyse MOBY:query element to extract data for each article WARNING 1: if the objecttype of your article is a complex one (compound of several objects - has relationship type) data are concatenated. In PlayMOBY we recommend to use simple objects (just one hasa relationship) which corresponds generally to the content of a file (ex: FASTA, png, csv, etc ...) WARNING 2: data from collection are also concatenated. Returns : $rh_articles_data, keys are article names Args : $query, MOBY query element Error : none Globals : none
sub GetArticlesData { my $query = shift; my %h_articles_data = (); my @a_input_articles = &MOBYXSLT::getArticles($query); foreach my $input_article (@a_input_articles) { my ($article_name, $article) = @{$input_article}; if (&MOBYXSLT::isSimpleArticle($article)) { my @a_hasa_elements = &MOBYXSLT::getObjectHasaElements($article); my $data_article = ''; if ($#a_hasa_elements >= 0) { foreach my $hasa_element (@a_hasa_elements) { $data_article .= &MOBYXSLT::getObjectContent($hasa_element) if (&MOBYXSLT::getObjectName($hasa_element) eq 'content'); } } else #pour les objets primaires (string,float,integer ...) { $data_article = &MOBYXSLT::getObjectContent($article); } $h_articles_data{$article_name} = $data_article; } elsif (&MOBYXSLT::isCollectionArticle($article)) { my @a_simple_articles = &MOBYXSLT::getCollectedSimples($article); my $data_article = ''; foreach $article (@a_simple_articles) { my @a_hasa_elements = &MOBYXSLT::getObjectHasaElements($article); if ($#a_hasa_elements >= 0) { foreach my $hasa_element (@a_hasa_elements) { $data_article .= &MOBYXSLT::getObjectContent($hasa_element) if (&MOBYXSLT::getObjectName($hasa_element) eq 'content'); } } else #pour les objets primaires (string,float,integer ...) { $data_article .= &MOBYXSLT::getObjectContent($article); } } $h_articles_data{$article_name} = $data_article; } } return \%h_articles_data; }
Title : __GetDate Usage : my $date = __GetDate(); Prerequiste: none Function : Formatted date Returns : $date, year.mon.day hour:min:sec Args : none Error : none Globals : none
sub __GetDate { my $time = time(); my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time); $year += 1900; $mon += 1; $mon = sprintf("%02d", $mon); $mday = sprintf("%02d", $mday); $hour = sprintf("%02d", $hour); $min = sprintf("%02d", $min); $sec = sprintf("%02d", $sec); return "$year.$mon.$mday $hour:$min:$sec"; } 1;