Appli.pm


Code Index:

#
#       Sebastien.Letort@toulouse.inra.fr
#       Created: October 08, 2007
#       $Id: Appli.pm 363 2008-07-01 09:48:58Z sletort $
#

#
# Copyright INRA/CNRS

# Emmanuel.Courcelle@toulouse.inra.fr
# Jerome.Gouzy@toulouse.inra.fr
# Thomas.Faraut@toulouse.inra.fr

# This software is a computer program whose purpose is to provide a
# web-based interface for analyzing the different levels of genome
# conservations.

# 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.

package Appli;


NAME

        Appli, a class to describe application


SYNOPSIS

        my %h_general = (
                        name      =>    'NarcisseGetAnnotationsFromLocus_tags', # the only one mandatory
                        descr     =>    "Given a locus tag or a file containing a list of loci tags, it will return the annotation of the sequence.",
                        authors   =>    'sebastien.letort@toulouse.inra.fr',
                        doc       =>    'no doc yet',
                        version   =>    '0.1',
                        cmd       =>    abs_path( $0 ) # default value is the prog name
                        category  =>    'Usefull prog.'
                        reference =>    [],
                        doclink   =>    ['http://www.toulouse.inra.fr/doc/Service/service.html']
                );
        # ouputs
        my %h_outputs = (
                        'Annotation' => {
                                descr       =>  "a list of ids with their annotation.",
                                namespace_biomoby   =>  'Narcisse',
                                type_biomoby=>  'text-formatted',
                                datatype    =>  'text',
                                cmd         =>  '--outfile=$value',
                                card        =>  '1,n',
                                filenames   =>  '*.out'
                        }
                );
        # inputs
        my %h_inputs = (
                        'NarcisseLocus_tags_list'       =>      {
                                descr       =>  "a locus tag or a file containing a list of locus tags.",
                                namespace_biomoby   =>  'Narcisse',
                                type_biomoby=>  'List_Text',
                                datatype    =>  'string',
                                cmd         =>  '--locus=$value',
                                card        =>  '1,1'
                        }
                );
        # parameters
        my %h_parameters = (
                        'db'    =>      {
                                datatype    =>  'Choice',
                                type_biomoby=>  'String',
                                enum        =>  {
                                                                        'proteic' => 'proteic search',
                                                                        'nucleic' => 'nucleic search'
                                                                },
                                default     =>  'proteic',
                                descr       =>  "which DB you want to search into."
                        }
                );
        my $appli = New Appli( -general => \%h_general );
        $appli->AddOutput( %h_output );
        $appli->SetParameters( %h_parameters );
        my $usage = $appli->Usage();
        print $usage;
        $appli = undef;

# -----------------------------------

        $appli = New Appli(
                        -general        => \%h_general,
                        -inputs         => \%h_inputs,
                        -outputs        => \%h_output,
                        -params         => \%h_parameters
                );


DESCRIPTION

        This class aims to describe programs simply.
        It can generate a mobyle formatted file describing the application.
        I will describe here the keys of hashes i use into the methods.
        key marked with * are optional, default value is between parenthesis if not computed.
        'name' : string - should be only one line, name of the thing.
                the name in general hash, will also be used as title of the mobyle file.
        'descr'* : string - description of the thing. ('no description.')
        'cmd'* : string -
                in general = the command that launch the program default is the program name.
                in input/output and params = see playmoby notes.
        what's uniquely into general hash :
        'authors' : string - authors names coma-separated
        'doc' : string - documents the prog
        'version'* : string - version of the prog ('0.0')
        'doclink'* : ref onto a list of strings - each string is an url of online documentation
        'reference'* : ref onto a list of strings - the bibliographics references
        'category'* : string - to classified the programs in group (ex. Service, DNA analysis, phylogeny)
                (Service)
                cf playmoby notes
        what's common to outputs, inputs and params hashs
        'datatype' : string - type of the data, Sequence , Structure , Matrix , Choice
                please refer to the latest mobyle's dtd. As I writing, there's no more explanation.
                but using int, bool, float, string seems acceptable.
        'type_biomoby'* : string - this is a biomoby type
                please consider if you're describing a parameter (secondary article),
                an input or an output (primary article) and have a look to
                http://lipm-bioinfo.toulouse.inra.fr/registry/cgi/registry.cgi?registry=mobycentral&form=choice&what=objects
                if you use datatype int, float bool string, the biomoby type can generally be omitted.
        'mandatory'* : 0 or 1
                by default, it's 1 for inputs and outputs
        what is uniquely into input/output hash :
        'card': cardinality '1,1' or '1,n'
                by default it's '1,1' (single input or output)
                '1,n' means 1 or many input/output from the same type (homogene collection in BioMoby world)
        'filenames': a string describing the name of input/ouput files
                this is very usefules when your program produces many files (number unknown): in that case
                you could produce this files into a directory with the same extension ".foo" and use
                the filenames attribute "*.foo" to use Appli
        what uniquely into params hash :
        'enum'* : a hash ref.
                keys are value of the param, and values are labels.
        'default'* : any type, the default value for the parameter
        'position'* : not yet implemented
        'min'* : numeric, the minimum value for the param.
        'max'* : numeric, the maximum value for the param.

Notes for playmoby user

        'cmd' will be evaluated _don't be mean please.
                Because sometime cmd are complicated like
                "($value != 0) ? '-bad joker' : 'batman'"
                it is important to us to have a variable that will contain the value of
                        the parameter when the service will be executed.
                As mobyle responsables use $value in their code, we choose to use the same.
                So your command should have the string '$value' inside.
                Here are some common example of cmd string for parameters.
                *with GetOptLong* => '--param=$value'
                        => Note that $value will not be evaluated here.
                *if the param is just a value in the command string* => '$value'
                *if your program wrap another complicated one you could have something like*
                 => 'if(0==$value){ return "zero"; }elsif(5==$value){ return "anything"; }else{ return $value; }'
        'category' we use this as the ServiceType Biomoby.
                You can find a list of possible values here :           http://lipm-bioinfo.toulouse.inra.fr/registry/cgi/registry.cgi?registry=mobycentral&form=choice&what=servicetypes
        'namespace' is another key of the input/output hashes. It is the biomoby namespace.
                you can have a look of the possible vlues here :
                http://lipm-bioinfo.toulouse.inra.fr/registry/cgi/registry.cgi?registry=mobycentral&form=choice&what=namespaces

Notes for developpers

Appli->{
name => 'nemo',# prog name


        descr => 'no description.', # string that describe the prog
        cmd => undef, # name of the command
        authors => 'no author', # authors names coma-separated
        doc => 'no doc', # string that documents the prog
        version => '0.0', # version of the prog
        category => 'Service', # category of the prog
        reference=> [], # prog. references
        doclink => [] # urls of online doc.
                # no default value set yet : TODO
        inputs => {
                'in_name1' => {
                        datatype => '',
                        type_biomoby => '',
                        descr => '',
                        mandatory => 0/1,
                        cmd => '',
                        namespace_biomoby => '',
                        card => '',
                        filenames => ''
                },
                'another_input_name' => { ... } # there can be many inputs
        }, # inputs key
        outputs => {
                'out_name1' => {
                        ...     # this is exactely the same keys as inputs
                },
                'another_outputs_name' => { ... } # there can be many outputs
        }, # outputs key
        params => {
                'par_name1' => {
                        datatype => '',
                        type_biomoby => '',
                        descr => '',
                        mandatory => 0/1,
                        cmd => '',
                        default => '',
                        position => i,  # integer
                        min => num, # any numerical value
                        max => num,
                        enum => { 'value1' => 'label for this value', num => 'another label' }
                },
                'another_param_name' => { ... } # there can be many params
        } # params key
} # Appli


TODO

        It would be greater to separate mobyle/playmoby output functions
        to make it easier to maintain.


SUBROUTINES

use base qw( LipmObject );
use strict;
use warnings;

use XML::Twig;
use IO::File;

#use Data::Dumper;

## de lipmutils
use LipmError::ParameterException;
use LipmError::IOException;

# use Enum;
use General;    #IsDefined SetUnlessDefined

BEGIN
{
    our $VERSION = do {my @r = (q$Rev: 363 $ =~ /\d+/g); $r[0]};
}

# fermeture
{
    my @__a_biomoby_primitives = qw( String Boolean Integer Float DateTime );

    sub GetTypeBiomoby
    {
        my ($type) = @_;

        # /!\ ATTENTION datetime renverra Datetime qui n'est pas DateTime /!\ #
        return ucfirst($type) if (map(/^$type$/i, @__a_biomoby_primitives));

        return 'Object';
    }

    sub GetTypeMobyle
    {
        my ($type) = @_;

        eval 'use OntologyMap';
        return 0 if $@;

        return OntologyMap::BiomobyToMobyle($type);

    }

    # keys attr common to inputs, outputs and params
    my @__a_attrs = qw( descr datatype mandatory type_biomoby cmd );

    # keys attr common to inputs and outputs
    my @__a_xputs_attrs = (@__a_attrs, qw( namespace_biomoby card filenames ));

    sub GetXputsKeys {return @__a_xputs_attrs;}

    # keys attr for params
    my @__a_params_attrs = (@__a_attrs, qw( default position enum min max ));

    sub GetParamsKeys {return @__a_params_attrs;}
}    #fermeture

Function New

        Title      :    New
        Usage      :    my $o_appli = New Appli( -general => \%h_gen,
                                                                        -inputs => \%h_in,
                                                                        -outputs => \%h_out,
                                                                        -params => \%h_params
                                                                );
        Prerequiste:    none
        constructor:    an Appli object should be used to described simply application
        Args       :    a hash with at least the -general key with a ref to another hash as value
                                this hash have descr, author, doc, and version for keys
                                cf SetOutputs, SetInputs and Set param for others
        Error      :    LipmError::ParameterException
        Globals    :    none
sub _Init
{
    my $self = shift;
    my %h_attrs = (
                   -general => {},
                   -inputs  => {},
                   -outputs => {},
                   -params  => {},
                   @_
                   );

    # general data
    my $rh_general = $h_attrs{-general};
    LipmError::ParameterException::Assert('name' => $$rh_general{name});

    # the default attributes values
    my %h_default_general = (
                             name      => 'nemo',               # prog name
                             descr     => 'no description.',    # string that describe the prog
                             cmd       => undef,                # name of the command
                             authors   => 'no author',          # authors names coma-separated
                             doc       => 'no doc',             # string that documents the prog
                             version   => '0.0',                # version of the prog
                             category  => 'Service',            # category of the prog
                             reference => [],                   # prog. references
                             doclink   => []                    # urls of online doc.
                             );

    # I want only keys of %h_def_general as attributes
    foreach my $key (keys %h_default_general)
    {
        my $user_val    = $$rh_general{$key};
        my $default_val = $h_default_general{$key};
        $self->{$key} = (defined($user_val)) ? $user_val : $default_val;
    }
    $self->{cmd}   = $self->{name} unless ($self->{cmd});
    $self->{descr} = $self->{name} unless ($self->{descr});

    # other affectation of attributes
    # set $self->{ inputs }
    $self->__Set('inputs', $h_attrs{-inputs}, &TRUE);

    # set $self->{ outputs }
    $self->__Set('outputs', $h_attrs{-outputs}, &TRUE);

    # set $self->{ params }
    $self->__Set('params', $h_attrs{-params}, &TRUE);

    return $self;
}

Procedure __Set

        Title      :    __Set
        Usage      :    $o_appli->__Set( $key, $r_hash, $do_erase );
        Prerequiste:    none
        Procedure  :    set the outputs/inputs/params for the current application
        Args       :    $key, a string which should be 'outputs', 'inputs' or 'params'
                        $r_hash, a ref to an hash
                                which keys are the name of the in/out/params
                                and values are ref to hash
                                                which keys should be in/out attrs or params attrs
                        $do_erase, a boolean, if true will erase previous data.
        Error      :    LipmError::ParameterException
        Globals    :    none
        Note       :    you can have more than one object but in that case, the type should be Collection
sub __Set
{
    my $self = shift;
    my ($key, $rh_attr, $do_erase) = @_;

    $self->{$key} = {} if ($do_erase);

    # mandatory attributes
    my @a_attrs = ();
    @a_attrs = GetXputsKeys()  if ($key eq 'inputs');
    @a_attrs = GetXputsKeys()  if ($key eq 'outputs');
    @a_attrs = GetParamsKeys() if ($key eq 'params');

    while (my ($name, $rh_data) = each(%$rh_attr))
    {

        # all the $$rh_data{ $key } will be copied into $h_params{ $key }
        # where $key is an element of the @a_attrs list.
        my %h_params;
        @h_params{@a_attrs} = @$rh_data{@a_attrs};

        # 1- mandatories

        if ((!defined $$rh_data{datatype}) && (defined $$rh_data{type_biomoby}))
        {
            my $alternate_mobyle_type = GetTypeMobyle($$rh_data{type_biomoby});
            $$rh_data{datatype} = $alternate_mobyle_type;

            SetUnlessDefined(\$h_params{datatype}, $alternate_mobyle_type);
        }

        LipmError::ParameterException::Assert(
            'name' => $name    #,
                               #'datatype' => $$rh_data{ datatype }
              );

        #all

        my $alternate_biomoby_type = GetTypeBiomoby($$rh_data{datatype}) if (!defined $$rh_data{type_biomoby});
        SetUnlessDefined(\$h_params{type_biomoby}, $alternate_biomoby_type);

        SetUnlessDefined(\$h_params{cmd}, " --$name=\$value");

        if ($key eq 'inputs' or $key eq 'outputs')
        {
            SetUnlessDefined(\$h_params{card},      '1,1');
            SetUnlessDefined(\$h_params{mandatory}, '1');     # utile ou futile ?

            # namespace remplace par namespace_biomoby
            #		SetUnlessDefined( \$h_params{ namespace }, $self->{ def_namespace } );
            # verif de filenames si key == outputs ?
            # => besoin d'avoir une valeur par défaut
        }

        $self->{$key}{$name} = \%h_params;
    }

    return;
}    # __Set

Procedure SetInputs

        Title      :    SetInputs
        Usage      :    $o_appli->SetInputs( %hash );
        Prerequiste:    none
        Procedure  :    this is an encapsulation of the __Set private methods
        Args       :    %hash cf __Set
        Error      :    none
        Globals    :    none
        Note       :    you can have more than one object but in that case, the type should be Collection
sub SetInputs
{
    my $self = shift;
    my (%h_inputs) = @_;

    return $self->__Set('inputs', \%h_inputs);
}

Procedure SetOutputs

        Title      :    SetOutputs
        Usage      :    $o_appli->SetOutputs( %hash );
        Prerequiste:    none
        Procedure  :    this is an encapsulation of the __Set private methods
        Args       :    %hash cf __Set
        Error      :    none
        Globals    :    none
        Note       :    you can have more than one object but in that case, the type should be Collection
sub SetOutputs
{
    my $self = shift;
    my (%h_outputs) = @_;

    return $self->__Set('outputs', \%h_outputs);
}

Procedure SetParams

        Title      :    SetParams
        Usage      :    $o_appli->SetParams( %hash );
        Prerequiste:    none
        Procedure  :    Set params to the current application.
        Args       :    a hash which keys are the name of the parameters
                        values are ref to hash like
                                datatype        =>      'string',
                                mandatory       =>      0,      a boolean
                                descr           =>      "part of the long name or begining of the short name."
                                position        =>      1,      an integer
                                cmd             =>      "--string="
                                default         =>      ''
                                type_biomoby=>  'String'
        Error      :    Error::ParameterException
        Globals    :    none
sub SetParams
{
    my $self = shift;
    my (%h_params) = @_;

    return $self->__Set('params', \%h_params);
}

Procedure AddParam

        Title      : AddParam
        Usage      :    $o_appli->AddParam( %hash );
        Prerequiste:    none
        Procedure  : alias of SetParams
        Args       :    a hash which keys are
                                name    => "ppp",
                                datatype        =>      'string',
                                mandatory       =>      0,      a boolean
                                descr           =>      "part of the long name or begining of the short name."
                                position        =>      1,      an integer
                                cmd             =>      "--string="
                                default         =>      ''
                                type_biomoby=>  'String'
                                min             => 1,   an integer
                                max             => 100, an integer
        Error      :    Error::ParameterException
        Globals    :    none
sub AddParam
{
    my $self   = shift;
    my (%hash) = @_;
    my $name   = delete $hash{name};

    return $self->SetParams($name => \%hash);
}

Procedure AddOutput

        Title      :    AddOutput
        Usage      :    $o_appli->AddOutput( %hash);
        Prerequiste:    none
        Procedure  :    Add one output to the application.
        Args       :    a hash with the following keys
                        name descr namespace type_biomoby datatype mandatory
        Error      :    none
        Globals    :    none
sub AddOutput
{
    my $self = shift;
    my (%hash) = @_;

    my $name = delete $hash{name};

    return $self->SetOutputs($name => \%hash);
}

Procedure AddInput

        Title      :    AddInput
        Usage      :    $o_appli->AddInput( %hash);
        Prerequiste:    exactly the same as AddOutput
        Procedure  :    Add one input to the application.
        Args       :    a hash with the following keys
                        name descr namespace type_biomoby datatype mandatory card
        Error      :    none
        Globals    :    none
sub AddInput
{
    my $self = shift;
    my (%hash) = @_;

    my $name = delete $hash{name};

    return $self->SetInputs($name => \%hash);
}

Procedure AddDoclink

        Title      :    AddDoclink
        Usage      :    $o_appli->AddDoclink( @a_urls );
        Prerequiste:    none
        Procedure  :    Add all strings of @a_urls as mobyle doclink.
        Args       :    @a_urls, a list of string representing the urls of the online doc.
        Error      :    none
sub AddDoclink
{
    my $self = shift;
    my (@a_urls) = @_;

    my $ra_doclink = $self->{doclink};

    push(@$ra_doclink, @a_urls);

    return;
}

Function GetUsage

        Title      :    GetUsage
        Usage      :    my $page = $o_appli->GetUsage();
        Prerequiste:    none
        Function   :    build a standardized usage string which explain how to use the application
        Returns    :    a string
        Args       :    none
        Error      :    none
        Globals    :    none
sub GetUsage
{
    my $self = shift;
    my $page;

    return $page;
}

Function GetMobyleXml

        Title      :    GetMobyleXml
        Usage      :    my $xml = $o_appli->GetMobyleXml( $outdir );
        Prerequiste:    none
        Function   :    write an xml based on the Mobyle dtd which describe the application
        Returns    :    undef if $outdir is defined and not empty
                        a string containing the xml otherwise.
        Args       :    $outdir, facultative string, the output directory
        Error      :    none
        Globals    :    none
sub GetMobyleXml
{
    my $self = shift;
    my ($outdir) = @_;

    my $o_xml = new XML::Twig(pretty_print => 'indented',
                              empty_tags   => 'html');
    $o_xml->parse("<program></program>");

    # $o_xml->print( *STDOUT );

    # head element

    my $head = $self->__GetMobyleXmlHead();
    $head->paste(last_child => $o_xml->root());

    # parameters element
    my $parameters = $self->__GetMobyleXmlParameters();
    $parameters->paste(last_child => $o_xml->root());

    #L'element superieur mobyle n'existe plus
    #$o_xml->root()->wrap_in('mobyle');

    $o_xml->set_encoding();
    $o_xml->set_output_encoding('utf-8');

    #plutot mettre l'adresse de la dtd de pasteur
    #$o_xml->set_doctype( 'mobyle', "" );
    if (defined $outdir && ($outdir ne ''))
    {
        my $file       = '>' . $outdir . '/' . $self->{name} . '.xml';
        my $outfile_fh = new IO::File($file)
          or throw LipmError::IOException($file, 'f');
        $o_xml->print($outfile_fh);
        $outfile_fh->close;

        return;
    }

    my $page = $o_xml->sprint();
    return $page;
}

#	------------------------------------------------------------------	#
#	----------------------- MOBYLE -----------------------------------	#
#	------------------------------------------------------------------	#

# tester l'acces depuis l'exterieur :
# my $test = Appli::__BuildTwigElement
# doit merder pour etre bon.
# <-- ne fonctionne pas, seules les variables on une portee limitee dans une fermeture
{

    # $head est la balise racine renvoyee
    # $ra_child est une ref sur une liste de ref de hash
    #	tq	<head><key1>value1</key1><key2>value2</key2><head>
    sub __BuildTwigElement
    {
        my ($head, $ra_child) = @_;

        my $head_elt = new XML::Twig::Elt($head);
        foreach my $rh (@$ra_child)
        {
            my ($tag, $value) = each(%$rh);

            my $elt = new XML::Twig::Elt($tag => $value);
            $elt->paste(last_child => $head_elt);
        }

        return $head_elt;
    }

    # add each val of the $ra_val list after the $dad elt with the tag $tag
    sub __AddLastToElt
    {
        my ($tag, $ra_val, $dad) = @_;

        foreach my $val (@$ra_val)
        {
            my $elt = new XML::Twig::Elt($tag => $val);
            $elt->paste(last_child => $dad);
        }

        return;
    }

    #<head>
    #	<name>$self->{ name }</name>
    #	<version>$self->{ version }</version>
    #	<doc>
    #		<title>$self->{ name }</title>
    #		<description><text></text></description>
    #		<authors>$self->{ authors }</authors>
    #		<reference>$self->{ reference }</reference>
    #		<doclink>$self->{ doclink }</doclink>
    #		<help><text>$self->GetUsage()</text></help>
    #	</doc>
    #	<category>$self->{ category }</category>
    #</head>
    sub __GetMobyleXmlHead
    {
        my $self = shift;

        my @a_head =
          ({name => $self->{name}}, {version => $self->{version}}, {doc => ''}, {category => $self->{category}});
        my $head = __BuildTwigElement('head', \@a_head);

        # doc element, part of head element
        my @a_doc = (
            {title   => $self->{name}},
            {authors => $self->{authors}}    #,

            # 				{ reference => undef },
            # 				{ doclink => undef }
            );
        my $doc = __BuildTwigElement('doc', \@a_doc);

        # description elt, part of doc element, follows 'title'
        my $descr = new XML::Twig::Elt('description' => $self->{descr});

        $descr->paste(after => $doc->first_child('title'));

        # ref elt, part of doc element
        my $tag = 'reference';
        __AddLastToElt($tag, $self->{$tag}, $doc);

        # doclink elt, part of doc element
        $tag = 'doclink';
        __AddLastToElt($tag, $self->{$tag}, $doc);

        # help elt, part of doc element
        #SEB 26.05.2008 DISPARU DERNIERE DTD
        #my $help = new XML::Twig::Elt('text' => $self->GetUsage())->wrap_in('help');
        #$help->paste(last_child => $doc);

        $doc->replace($head->first_child('doc'));
        ## fin doc elt

        # env elt, part of head
        # besoin d'analyser le xml contenant les variable d'environnement.

        return $head;
    }

    # return a valid parameters Elt
    sub __GetMobyleXmlParameters
    {
        my $self = shift;

        my $params_elt = new XML::Twig::Elt('parameters');

        # la commande : le nom du programme est celui du service
        #	par defaut la commande a executer est le nom du service

        my $param_elt = $self->__GetMobyleXmlXputs(
                                                   'command',
                                                   $self->{name},
                                                   {
                                                    descr    => 'command',
                                                    datatype => 'String',
                                                    cmd      => $self->{cmd}
                                                   }
                                                   );
        $param_elt->paste(last_child => $params_elt);

        #plus tard gerer peut-etre les paragraphes
        #inputs
        my $rh_inputs = $self->{inputs};
        while (my ($name, $rh_attr) = each(%$rh_inputs))
        {
            $param_elt = $self->__GetMobyleXmlXputs('inputs', $name, $rh_attr);

            $param_elt->paste(last_child => $params_elt);
        }

        #outputs
        my $rh_outputs = $self->{outputs};
        while (my ($name, $rh_attr) = each(%$rh_outputs))
        {
            my ($param_a_elt, $param_b_elt) = $self->__GetMobyleXmlOutputs('outputs', $name, $rh_attr);
            $param_b_elt->paste(last_child => $params_elt);
            $param_a_elt->paste(last_child => $params_elt);
        }

        #params
        my $rh_param = $self->{params};
        while (my ($name, $rh_attr) = each(%$rh_param))
        {
            my $param_elt = $self->__GetMobyleXmlParams($name, $rh_attr);
            $param_elt->paste(last_child => $params_elt);
        }

        return $params_elt;
    }

    # renvoie
    #<parameter (attr) >
    #	<name>$name</name>
    #	<prompt>$$rh_attr{ descr }</prompt>
    #	<type>cf __GetMobyleXmlType</type>
    #	<></>
    #</parameter>
    sub __GetMobyleXmlXputs
    {
        my $self = shift;
        my ($key, $name, $rh_attr) = @_;

        $$rh_attr{descr} = $name if (!defined $$rh_attr{descr} || ($$rh_attr{descr} eq ''));

        my @a_param = ({name => $name}, {prompt => $$rh_attr{descr}});
        my $parameter = __BuildTwigElement('parameter', \@a_param);

        #attributs
        my $rh_in_out = {ismaininput => '1'} if ($key eq 'inputs');

        $rh_in_out = {iscommand => '1', ishidden => '1'} if ($key eq 'command');

        $parameter->set_atts($rh_in_out);

        my $type_elt = __GetMobyleXmlType($$rh_attr{datatype}, $$rh_attr{type_biomoby}, $$rh_attr{namespace_biomoby},
                                          $$rh_attr{card});
        $type_elt->paste(last_child => $parameter);

        if (defined($$rh_attr{cmd}))
        {

            #ICI pour passer le vrai nom de l'executable
            #my $format_elt = new XML::Twig::Elt( code => { proglang => 'perl' },
            #									"\" $$rh_attr{ cmd }\"" )
            #					->wrap_in('format');

            #$format_elt->paste(last_child => $parameter);
            my $format_elt = new XML::Twig::Elt('format');

            my $perl_cmd = $$rh_attr{cmd};
            my $code_perl_elt = new XML::Twig::Elt(code => {proglang => 'perl'}, "\" $perl_cmd\"");
            $code_perl_elt->paste(last_child => $format_elt);
            my $python_cmd = $perl_cmd;

            #$python_cmd =~ s/"/\\"/g;
            $python_cmd =~ s/\\"//g;
            $python_cmd =~ s/["']//g;

            if ($python_cmd =~ /\$/)
            {
                $python_cmd =~ s/\$(\w+)/%s" % $1/;
            }
            else
            {
                $python_cmd .= '"';
            }
            my $code_python_elt = new XML::Twig::Elt(code => {proglang => 'python'}, "\" $python_cmd");
            $code_python_elt->paste(last_child => $format_elt);

            $format_elt->paste(last_child => $parameter);
        }

        if (defined($$rh_attr{filenames}))
        {

            my $filenames_elt = new XML::Twig::Elt(
                                                   code => {proglang => 'perl'},
                                                   "\"$$rh_attr{ filenames }\""
                                                   )->wrap_in('filenames');
            $filenames_elt->paste(last_child => $parameter);
        }

        return $parameter;
    }

    sub __GetMobyleXmlOutputs
    {
        my $self = shift;
        my ($key, $name, $rh_attr) = @_;
        $$rh_attr{descr} = $name if (!defined $$rh_attr{descr} || ($$rh_attr{descr} eq ''));
        my $no_dash_name = $name;
        $no_dash_name =~ s/-/_/g;

        my @a_param = ({name => $name}, {prompt => $$rh_attr{descr}});
        my $parameter_a = __BuildTwigElement('parameter', \@a_param);

        #attributs
        my $rh_in_out = {isout => '1'} if ($key eq 'outputs');
        $parameter_a->set_atts($rh_in_out);

        my $type_elt = __GetMobyleXmlType($$rh_attr{datatype}, $$rh_attr{type_biomoby}, $$rh_attr{namespace_biomoby},
                                          $$rh_attr{card});
        $type_elt->paste(last_child => $parameter_a);

        #<code proglang="perl">$RmesReport_name</code>
        #<code proglang="python">RmesReport_name</code>

        if (defined($$rh_attr{filenames}))
        {
            my $filenames       = $$rh_attr{filenames};
            my $format_elt      = new XML::Twig::Elt('filenames');
            my $code_perl_elt   = new XML::Twig::Elt(code => {proglang => 'perl'}, "\"$filenames\"");
            my $code_python_elt = new XML::Twig::Elt(code => {proglang => 'python'}, "\"$filenames\"");
            my $filenames_elt   = new XML::Twig::Elt('filenames');
            $code_perl_elt->paste(last_child => $filenames_elt);
            $code_python_elt->paste(last_child => $filenames_elt);
            $filenames_elt->paste(last_child => $parameter_a);
        }
        else
        {
            my $code_perl_elt   = new XML::Twig::Elt(code => {proglang => 'perl'},   '$' . $no_dash_name . '_name');
            my $code_python_elt = new XML::Twig::Elt(code => {proglang => 'python'}, $no_dash_name . '_name');
            my $filenames_elt = new XML::Twig::Elt('filenames');
            $code_perl_elt->paste(last_child => $filenames_elt);
            $code_python_elt->paste(last_child => $filenames_elt);
            $filenames_elt->paste(last_child => $parameter_a);
        }

        my @a_param_b = ({name => $no_dash_name . '_name'}, {prompt => $name . ' output file name'});

        my $parameter_b = __BuildTwigElement('parameter', \@a_param_b);
        $parameter_b->set_atts({ishidden => 1});

        my $datatype_elt = __BuildTwigElement('datatype', [{class => 'Filename'}]);

        $type_elt = new XML::Twig::Elt('type');
        $datatype_elt->paste(last_child => $type_elt);
        $type_elt->paste(last_child => $parameter_b);

        my $extension = 'out';
        if (ref($$rh_attr{datatype}) =~ /XML::Twig::Elt/i)
        {
            if (defined $$rh_attr{datatype}->{att}->{dataformat} && ($$rh_attr{datatype}->{att}->{dataformat} ne ''))
            {
                $extension = $$rh_attr{datatype}->{att}->{dataformat};
            }
            elsif (defined $$rh_attr{datatype}->{att}->{fileextension}
                   && ($$rh_attr{datatype}->{att}->{fileextension} ne ''))
            {
                $extension = $$rh_attr{datatype}->{att}->{fileextension};
            }
        }
        my $vdef_elt = __BuildTwigElement('vdef', [{value => $no_dash_name . '.' . $extension}]);
        $vdef_elt->paste(last_child => $parameter_b);

        if (defined($$rh_attr{cmd}))
        {

            #ICI pour passer le vrai nom de l'executable
            my $format_elt = new XML::Twig::Elt('format');

            my $perl_cmd = $$rh_attr{cmd};
            my $code_perl_elt = new XML::Twig::Elt(code => {proglang => 'perl'}, "\" $perl_cmd\"");
            $code_perl_elt->paste(last_child => $format_elt);

            #on va essayer de traduire du perl vers le python
            #pour les cmd simples !

            #$python_cmd =~ s/"/\\"/g;
            my $python_cmd = $perl_cmd;
            $python_cmd =~ s/\\"//g;
            $python_cmd =~ s/["']//g;

            $python_cmd =~ s/\$(\w+)/%s" % $1/;

            my $code_python_elt = new XML::Twig::Elt(code => {proglang => 'python'}, "\" $python_cmd");
            $code_python_elt->paste(last_child => $format_elt);

            $format_elt->paste(last_child => $parameter_b);
        }

        return ($parameter_a, $parameter_b);
    }

    sub __GetMobyleXmlParams
    {
        my $self = shift;
        my ($name, $rh_attr) = @_;

        $$rh_attr{descr} = $name if (!defined $$rh_attr{descr} || ($$rh_attr{descr} eq ''));
        my @a_param = (
            {name   => $name},
            {prompt => $$rh_attr{descr}},
            {type   => ''},

            # 				# la commande est -$name=xxx
            # 				{ cmd	=>	"-$name=" }
            );
        my $parameter = __BuildTwigElement('parameter', \@a_param);

        #attributs
        if (defined $$rh_attr{mandatory}) {$parameter->set_atts({ismandatory => $$rh_attr{mandatory}});}

        $self->__CompleteParameterElement($parameter, $rh_attr);

        return $parameter;
    }

    sub __CompleteParameterElement
    {
        my $self = shift;
        my ($param_elt, $rh_attr) = @_;

        my $type_elt = __GetMobyleXmlType($$rh_attr{datatype}, $$rh_attr{type_biomoby}, '', '', $$rh_attr{enum});
        $type_elt->replace($param_elt->first_child('type'));

        if (defined $$rh_attr{default})
        {

            # la dtd considere que plusieurs valeurs par defaut sont possibles
            #	pas de ça chez nous !
            my $vdef = new XML::Twig::Elt('value' => $$rh_attr{default})->wrap_in('vdef');
            $vdef->paste(last_child => $param_elt);
        }

        # enum <=> vlist
        if (defined $$rh_attr{enum})
        {
            my $vlist = new XML::Twig::Elt('vlist');

            my $rh_enum = $$rh_attr{enum};
            while (my ($instance, $label) = each(%$rh_enum))
            {
                my @a_velem = ({value => $instance}, {label => $label});
                my $velem = __BuildTwigElement('velem', \@a_velem);
                $velem->paste(last_child => $vlist);
            }
            $vlist->paste(last_child => $param_elt);
        }    #fin Enum <=> vlist

        # cmd <=> format

        #        my $format_elt = new XML::Twig::Elt(
        #                                            code => {proglang => 'perl'},
        #                                            "\"$$rh_attr{ cmd }\""
        #                                            )->wrap_in('format');
        #        $format_elt->paste(last_child => $param_elt);

        my $format_elt = new XML::Twig::Elt('format');

        my $perl_cmd = $$rh_attr{cmd};
        my $code_perl_elt = new XML::Twig::Elt(code => {proglang => 'perl'}, "\" $perl_cmd\"");
        $code_perl_elt->paste(last_child => $format_elt);

        #on va essayer de traduire du perl vers le python
        #pour les cmd simples !
        my $python_cmd = $perl_cmd;

        #$python_cmd =~ s/"/\\"/g;
        $python_cmd =~ s/\\"//g;
        $python_cmd =~ s/["']//g;

        $python_cmd =~ s/\$(\w+)/%s" % $1/;

        if (!defined $$rh_attr{enum})
        {
            $python_cmd = '(""," ' . $python_cmd . ')[' . $1 . ' is not None]';
        }
        else
        {
            $python_cmd = '" ' . $python_cmd;
        }
        my $code_python_elt = new XML::Twig::Elt(code => {proglang => 'python'}, "$python_cmd");
        $code_python_elt->paste(last_child => $format_elt);

        $format_elt->paste(last_child => $param_elt);

        #fin cmd <=> format

        # min-max <=> scale
        if (defined $$rh_attr{min} or defined $$rh_attr{max})
        {
            my $scale_elt = new XML::Twig::Elt('scale');
            my $min_elt = new XML::Twig::Elt('value' => $$rh_attr{min})->wrap_in('min');
            $min_elt->paste(last_child => $scale_elt);
            my $max_elt = new XML::Twig::Elt('value' => $$rh_attr{max})->wrap_in('max');
            $max_elt->paste(last_child => $scale_elt);

            $scale_elt->paste(last_child => $param_elt);
        }    #fin min-max <=> scale

        return;
    }

    # return
    #<type>
    #	<datatype><class>$type</class></datatype>
    #	<card>$card</card>
    #	<biomoby>$type_biomoby</biomoby>
    #	<biomoby_namespace>$namespace_biomoby</biomoby_namespace>
    #</type>

    sub __GetMobyleXmlType
    {
        my ($type, $type_biomoby, $namespace_biomoby, $card, $enum) = @_;

        # type element part of parameter element
        my $type_elt = new XML::Twig::Elt('type');

        if ((defined $enum) && ($enum ne ''))
        {
            $type = 'Choice';
            my $datatype = new XML::Twig::Elt(class => ucfirst($type))->wrap_in('datatype');
            $datatype->paste(last_child => $type_elt);
        }
        elsif (ref($type) !~ /xml::twig::elt/i)
        {

            my $datatype = new XML::Twig::Elt(class => ucfirst($type))->wrap_in('datatype');
            $datatype->paste(last_child => $type_elt);
        }
        else
        {
            my $datatype = new XML::Twig::Elt('datatype');

            if ($type->{att}->{class} ne '')
            {
                my $class = new XML::Twig::Elt(class => $type->{att}->{class});
                $class->paste(last_child => $datatype);
            }
            if ($type->{att}->{superclass})
            {
                my $superclass = new XML::Twig::Elt(superclass => $type->{att}->{superclass});
                $superclass->paste(last_child => $datatype);
            }

            $datatype->paste(last_child => $type_elt);

            if ($type->{att}->{biotype} ne '')
            {
                my $biotype = new XML::Twig::Elt(biotype => $type->{att}->{biotype});
                $biotype->paste(last_child => $type_elt);
            }

            if ($type->{att}->{dataformat} ne '')
            {
                my $dataformat = new XML::Twig::Elt(dataFormat => $type->{att}->{dataformat});
                my $accepteddataformats = new XML::Twig::Elt('acceptedDataFormats');
                $dataformat->paste(last_child => $accepteddataformats);
                $accepteddataformats->paste(last_child => $type_elt);
            }
        }

        if (IsDefined($card))
        {
            my $card_elt = new XML::Twig::Elt('card' => $card);
            $card_elt->paste(last_child => $type_elt);
        }

        #<biomoby><datatype>FASTA</datatype><namespace>NCBI</namespace></biomoby>
        if (IsDefined($type_biomoby) || IsDefined($namespace_biomoby))
        {
            my $biomoby = new XML::Twig::Elt('biomoby');

            if (IsDefined($type_biomoby))
            {
                my $biomoby_datatype = new XML::Twig::Elt('datatype' => $type_biomoby);
                $biomoby_datatype->paste(last_child => $biomoby);
            }

            if (IsDefined($namespace_biomoby))
            {
                my $biomoby_namespace = new XML::Twig::Elt('namespace' => $namespace_biomoby);
                $biomoby_namespace->paste(last_child => $biomoby);
            }
            $biomoby->paste(last_child => $type_elt);
        }
        return $type_elt;
    }

}

#	------------------------------------------------------------------	#
#	----------------------- PLAYMOBY ---------------------------------	#
#	------------------------------------------------------------------	#

Function GetPlaymobyTestXml

        Title      :    GetPlaymobyTestXml
        Usage      :    my $xml = $o_appli->GetPlaymobyTestXml( $outdir );
        Prerequiste:    none
        Function   :    write an xml to launch Playmoby tests
        Returns    :    undef if $outdir is defined and not empty
                        a string containing the xml otherwise.
        Args       :    $outdir, facultative string, the output directory
        Error      :    none
        Globals    :    none
sub GetPlaymobyTestXml
{
    my $self = shift;
    my ($outdir) = @_;

    my $servicename = $self->{name};

    my $xml_for_test = "<playmoby:test>";
    $xml_for_test .= "<playmoby:service name=\"$servicename\" >";

    foreach my $output_name (keys %{$self->{outputs}})
    {
        $xml_for_test .= "<playmoby:article name=\"$output_name\" >";
        $xml_for_test .= "<playmoby:format>";
        $xml_for_test .= <<END;
<![CDATA[

#these are default tests for format consistancy
#you can/should write your own test 
#your test MUST return a boolean and a free text

return (0, "empty article") if (\$_ eq '');
return (1, "ok");
]]>
END
        $xml_for_test .= "</playmoby:format>";
        $xml_for_test .= "<playmoby:content>";
        $xml_for_test .= <<END;
<![CDATA[

#these are default tests for content analysis
#you can/should write your own test 
#your test MUST return a boolean and a free text

return (0, "empty article") if (\$_ eq '');
return (1, "ok");
]]>
END
        $xml_for_test .= "</playmoby:content>";
        $xml_for_test .= "</playmoby:article>";

    }

    $xml_for_test .= "</playmoby:service>";
    $xml_for_test .= "</playmoby:test>";

    my $o_xml = new XML::Twig(pretty_print => 'indented',
                              empty_tags   => 'html');
    $o_xml->parse($xml_for_test);
    $o_xml->set_encoding();
    $o_xml->set_output_encoding('utf-8');

    if (defined $outdir && ($outdir ne ''))
    {
        my $outfile_fh = new IO::File('>' . $outdir . '/' . $self->{name} . '.pmb.t');
        $o_xml->print($outfile_fh);
        $outfile_fh->close;

        return;
    }
    else
    {
        my $page;
        $page = $o_xml->sprint();
        return $page;
    }

}


COPYRIGHT NOTICE

This software is governed by the CeCILL license - www.cecill.info

1;