# # 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;
Appli, a class to describe application
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 );
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.
'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
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
It would be greater to separate mobyle/playmoby output functions to make it easier to maintain.
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
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; }
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
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); }
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); }
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); }
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); }
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); }
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); }
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; }
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; }
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 --------------------------------- # # ------------------------------------------------------------------ #
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; } }
This software is governed by the CeCILL license - www.cecill.info
1;