PmbTest.pm

Code Index:


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.


NAME

PmbTest


DESCRIPTION

Playmoby Test routines used mainly in pmb_CheckWS.pl


AUTHORS

 Sebastien.Carrere@toulouse.inra.fr


METHODS

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
  );

Function LoadPmbTestXml

        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;

}

Function TestArticle

        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;

}

Function PrintTestResult

        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;
}

Function GetFullReport

        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());
}

Function GetArticlesData

        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;
}


PRIVATE METHODS

Function __GetDate

        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;