package MyAsynchronousWebService; use Cwd 'abs_path'; use IO::Dir; BEGIN { # je cherche dans l'arborescence tous les sous dossier lib de services my $path = ''; my $cwd = Cwd::getcwd(); while ($cwd =~ /(.+?services\/)/g) { $path .= $1; if (-d $path . '../lib') { #on l'inclue dans le path my $lib = abs_path($path . '../lib'); unshift(@INC, $lib); } } } use Biomoby::Service; use File::Which; use General qw(:DEFAULT GetDirectoryFile); use base qw(MOBY::Async::SimpleServer); # le nom du hash qui va contenir les valeurs des parametres # necessaire pour tester la 'precondition' # cette constante est egalement definie dans MobyleElement.pm # elle ne devrait etre defini au'une seule fois. #use constant HASH_PARAM => 'h_param'; use constant SPECIAL_FILE => 'biomoby.cfg'; use constant LOCAL_PATH => GetDirectoryFile('MyAsynchronousWebService.pm'); my $playmobypath_rel = '/../../'; if (&LOCAL_PATH =~ /\/services$/) { $playmobypath_rel = '/../'; } #global vars because constants are builded before $playmobypath_rel set my $PLAYMOBY_PATH = abs_path(&LOCAL_PATH . $playmobypath_rel); my $UNIX_CMD = $PLAYMOBY_PATH . '/cfg/unix_cmd.cfg'; { my $path = &LOCAL_PATH; close(STDERR); open(STDERR, ">>$path/MyAsynchronousWebService/log"); #print STDERR " __MyAsynchronousWebService__\n"; }
Description : #param:service_description# Contact : #param:service_contact#
Template : Sebastien.Carrere@toulouse.inra.fr and Sebastien.Letort@toulouse.inra.fr
Description : where the job is done (BioMOBY stuff and real stuff) =cut
sub MyAsynchronousWebService_sub { &_Log_MyAsynchronousWebService("In MyAsynchronousWebService subroutine"); use Data::Dumper; my ($caller, $message) = @_; my $moby_response; my %h_input_data = (); my $exception; my $cfg = &LOCAL_PATH . "/MyAsynchronousWebService/MyAsynchronousWebService.cfg"; # faudrait virer ce o_param, il y a doublon avec $o_bm_service ! my $o_param = New ParamParser($cfg); my $o_bm_service = New Biomoby::Service(-conf => $cfg, -spe => &SPECIAL_FILE); my $service_name = $o_bm_service->{name}; #&_Log_MyAsynchronousWebService("service name $service_name"); $o_param->Update($UNIX_CMD, 'A'); my $service_doc = $o_bm_service->{doc}; # Analyse du message entrant # AnalyseMessage($message, \%h_input_data); # # Analyse du message entrant # ## je me demande si un New Biomoby::Service('moby'=> $message) serait possible ## ça me simplifierait la tache en criss # sub AnalyseMessage # { # my ($message, $rh_input_data ) = @_; my ($service_notes, $ra_queries) = &MOBYXSLT::getInputs($message); foreach my $query (@{$ra_queries}) { my $query_id = &MOBYXSLT::getInputID($query); my @a_input_articles = &MOBYXSLT::getArticles($query); my $input_data = ''; foreach my $input_article (@a_input_articles) { my ($article_name, $article) = @{$input_article}; # my $article_param_root_key = $rh_registered_input_article_names->{$article_name}; my $o_bm_article = $o_bm_service->{o_inputs}->GetByName($article_name); my $article_param_root_key = &Biomoby::Service::KEY_INPUT . $o_bm_article->{id}; if (&MOBYXSLT::isSimpleArticle($article)) { my $o_object = $o_bm_article->GetObject(); my $moby_object_type_for_input = $o_object->{tp}; my $moby_object_namespace_for_input = $o_object->{ns}; my $object_type = &MOBYXSLT::getObjectType($article); &_Log_MyAsynchronousWebService("Input: simple article $article_name:$object_type"); if (&BiomobyUtils::IsTheCorrectObject($object_type, $moby_object_type_for_input)) { my @a_hasa_elements = &MOBYXSLT::getObjectHasaElements($article); if ($#a_hasa_elements >= 0) { foreach my $hasa_element (@a_hasa_elements) { #ca doit pas marcher pour les objets complexes de type GenericSequence mais ce type d'objet #ne correspond pas a un contenu de fichier manipulable par des programme; il s'agit plus #d'abstractions informatiques $h_input_data{$article_param_root_key} = &MOBYXSLT::getObjectContent($hasa_element) if (&MOBYXSLT::getObjectName($hasa_element) eq 'content'); } } else #pour les objets primaires (string,float,integer ...) { $h_input_data{$article_param_root_key} = &MOBYXSLT::getObjectContent($article); } } } elsif (&MOBYXSLT::isCollectionArticle($article)) { #on va commencer par les collections homogenes ... my @a_simple_articles = &MOBYXSLT::getCollectedSimples($article); foreach $article (@a_simple_articles) { my $simple_input_data = ''; $h_input_data{$article_param_root_key} = [] if (!defined $h_input_data{$article_param_root_key}); foreach my $o_object ($o_bm_article->GetObjects()) { my $moby_object_type_for_input = $o_object->{tp}; my $moby_object_namespace_for_input = $o_object->{ns}; my $object_type = &MOBYXSLT::getObjectType($article); &_Log_MyAsynchronousWebService("Input: collection article $article_name:$object_type"); if (&BiomobyUtils::IsTheCorrectObject($object_type, $moby_object_type_for_input)) { my @a_hasa_elements = &MOBYXSLT::getObjectHasaElements($article); if ($#a_hasa_elements >= 0) { foreach my $hasa_element (@a_hasa_elements) { #ca doit pas marcher pour les objets complexes de type GenericSequence mais ce type d'objet #ne correspond pas a un contenu de fichier manipulable par des programme; il s'agit plus #d'abstractions informatiques $simple_input_data = &MOBYXSLT::getObjectContent($hasa_element) if (&MOBYXSLT::getObjectName($hasa_element) eq 'content'); } } else #pour les objets primaires (string,float,integer ...) { $h_input_data{$article_param_root_key} = &MOBYXSLT::getObjectContent($article); } } push(@{$h_input_data{$article_param_root_key}}, $simple_input_data); } } } elsif (&MOBYXSLT::isSecondaryArticle($article)) { &_Log_MyAsynchronousWebService("Input: secondary article $article_name"); ($rh_param_service->{$article_name}) = &MOBYXSLT::getNodeContentWithArticle($query, 'Parameter', $article_name); } } # # Preparation des fichiers et commandes # my $file_root = $service_name . "." . $$ . time; my $tmpdir = $o_param->Get('tmp_dir') . "/$file_root"; mkdir("$tmpdir"); chmod(0777, "$tmpdir"); chdir($tmpdir); my $cmd = $o_param->Get("bin_cmd"); my $code = &SubstituteBin(\$cmd, $o_bm_service); return $cmd if (!$code); # &_Log_MyAsynchronousWebService("1- cmd : $cmd"); ($code, $cmd) = &CreateInputFiles_MyAsynchronousWebService($query_id, $tmpdir, $file_root, $cmd, \%h_input_data, $o_param, $o_bm_service->{o_inputs}); return $cmd if (!$code); # &_Log_MyAsynchronousWebService("2- cmd : $cmd"); $cmd = &NameOutputFiles_MyAsynchronousWebService($tmpdir, $file_root, $cmd, $o_bm_service->{o_outputs}); # $cmd = &NameOutputFiles_MyAsynchronousWebService($tmpdir,$file_root,$cmd,$o_param); # &_Log_MyAsynchronousWebService("3- cmd : $cmd"); { # pour limiter la portee de %h_protpars my %h_param; # j'ouvre ici tous les fichiers où seront écrits les paramètres my %h_files; foreach my $filename ($o_bm_service->GetFilenames()) { my $o_fs = new IO::File("$tmpdir/$filename", "w"); if (!$o_fs) { #throw error print STDERR "$tmpdir/$filename n'a pu etre ouvert en ecriture\n"; } $h_files{$filename} = $o_fs; } while ($cmd =~ m/(maskparam#(\w+)#)/g) { #0- virer les variables system my $art_name = $2; my $mask = $1; #1- obtenir l'objet attribut correspondant my $o_2d_art = $o_bm_service->{o_2d_articles}->GetByName($art_name); #print STDERR Dumper $o_2d_art; #2- substituer le masque par la valeur du parametre my $vdef = $o_2d_art->{default}; my $value = $h_param{$art_name} = $rh_param_service->{$art_name} || $vdef; # &_Log_MyAsynchronousWebService("($art_name)\tvalue=$value [$vdef]"); #2- precond : si pas verifie on passe à la suite. my $precond = $o_2d_art->{precond}; # si precond verifiee, on controle #il faudrait une ideee super geniale pour differencier les 3 cas suivants : # - $precond est verifiee # - $precond n'est pas verifiee # et celle qui pose pb : # - $precond contient au moins une variable non definie ou sa corrolaire ! # pour le moment les parametres dont la precondition n'est pas verifie ne sont jamais subtitues dans cette boucle. if (IsDefined($precond) and eval("$precond ? 0 : 1;")) { # &_Log_MyAsynchronousWebService("\tprecond=$precond _non verifiee\n"); next; } # on controle la valeur reçue my $ctrl = $o_2d_art->{ctrl}; # &_Log_MyAsynchronousWebService("\tprecond=$precond\tctrl=$ctrl") unless $ctrl eq ''; if ( ((1 == $o_2d_art->{mandatory}) and (!IsDefined($value))) or (IsDefined($ctrl) and eval("$ctrl ? 0 : 1;"))) { my $msg = $o_2d_art->{ctrl_msg}; $msg = "$art_name not respect rules" if $msg eq ''; $exception = &MOBYXSLT::encodeException( -refElement => '', -refQueryID => $query_id, -severity => 'error', -exceptionCode => '202', #INPUTS_INVALID -exceptionMessage => "$msg" ); return SOAP::Data->type( 'base64' => ( &MOBYXSLT::responseHeader( -authority => $o_param->Get('auth_uri'), -note => "Documentation available at $service_doc", -exception => $exception ) ) . &MOBYXSLT::responseFooter() ); } my $param_cmd = $o_2d_art->{cmd}; &SubstituteParamCmd(\$param_cmd, \%h_param); #&_Log_MyAsynchronousWebService("\tparam_cmd:$param_cmd\n"); my $substi = eval($param_cmd); $substi = '' if (($value eq '') && ($o_2d_art->{type} !~ /boolean/i)); # s'il faut ecrire dans un fichier c'est ici my $file = $o_2d_art->{infile}; if (defined $file) { # &_Log_MyAsynchronousWebService("\file:$file\tsubsti=$substi"); my $o_file = $h_files{$file}; print $o_file $substi; # et on efface le parametre ## on ne peut avoir une ecriture dans un fichier ET une substitution de parametre $cmd =~ s/$mask//; } else { # on substitue $cmd =~ s/$mask/$substi/; } } # s'il reste des parametres non substitués, c'est que leur precond est fausse # donc je les efface sans soucis $cmd =~ s/maskparam#\w+#//g; my $cmd_to_log = $cmd; $cmd_to_log =~ s/password=\S+/password=\*\*\*\*\*\*\*\*\*\*/g; &_Log_MyAsynchronousWebService("cmd = $cmd_to_log"); # si des noms de fichiers de parametres ont été ajouté, on leur donne un chemin absolu &SubstituteParamsFile(\$cmd, $tmpdir, %h_files); # je ferme tous les fichiers foreach my $o_file (values %h_files) {$o_file->close;} } # # Execution # # &_Log_MyAsynchronousWebService("$service_name cmd:$cmd"); (my $code_run, $exception) = &ExecuteCmd_MyAsynchronousWebService($query_id, $cmd, $o_param); if (!$code_run) { return SOAP::Data->type( 'base64' => ( &MOBYXSLT::responseHeader( -authority => $o_param->Get('auth_uri'), -note => "Documentation available at $service_doc", -exception => $exception ) ) . &MOBYXSLT::responseFooter() ); } # # Preparation des resultats # ($moby_response, $exception) = &CatOutputFiles_MyAsynchronousWebService($query_id, $tmpdir, $file_root, $moby_response, $o_param, $o_bm_service); # c'est pas propre, mais c'est pas ma faute ! if ((defined $exception) and ($exception ne '')) { return SOAP::Data->type( 'base64' => ( &MOBYXSLT::responseHeader( -authority => $o_param->Get('auth_uri'), -note => "Documentation available at $service_doc", -exception => $exception ) ) . &MOBYXSLT::responseFooter() ); } #nettoyage du repertoire temporaire my $o_dir = new IO::Dir($tmpdir) or die("$tmpdir can't be opened !"); while (defined($file = $o_dir->read)) { unlink($file) if ($file !~ /^\./); } rmdir $tmpdir; } # # Message sortant # if ((!defined $exception) || ($exception eq '')) { $exception = &MOBYXSLT::encodeException( -refElement => '', -refQueryID => '', -severity => 'information', -exceptionCode => '700', -exceptionMessage => "OK" ); } return SOAP::Data->type( 'base64' => ( &MOBYXSLT::responseHeader( -authority => $o_param->Get('auth_uri'), -note => "Documentation available at $service_doc", -exception => $exception ) ) . $moby_response . &MOBYXSLT::responseFooter() ); }
Title : MyAsynchronousWebService Usage : Function: Try to execute the webservice (subroutine MyAsynchronousWebService_sub) in synchronous mode using #mask_timeout# minutes as limit. Returns : BioMOBY message
sub MyAsynchronousWebService { my $self = shift @_; # Here you can choose between sync or error return $self->sync(\&MyAsynchronousWebService_sub, 10 * 60 - 30, @_); #return $self->error(@_); }
Title : MyAsynchronousWebService_submit Usage : Function: Executes the webservice (subroutine MyAsynchronousWebService_sub) in asynchronous mode using. Returns : BioMOBY message
sub MyAsynchronousWebService_submit { my $self = shift @_; return $self->async(\&MyAsynchronousWebService_sub, @_); }
Title : CreateInputFiles_MyAsynchronousWebService Usage : ($code, $cmd) = CreateInputFiles_MyAsynchronousWebService($tmpdir, $file_root, $cmd, $rh_input_data, $o_param) Function: Creates input files for each input article to be used in the shell command line. Makes substitutions in the command line with the temporary file names. If input file can not be created, returns 0 and SOAP message Else, return 1 and the command line. Args : $query_id Moby query ID $tmpdir temporary dir $file_root temporary file name $cmd original masked command line $rh_input_data hash reference of input articles data $o_param ParamParser object Returns : code (0|1) SOAP message|command
sub CreateInputFiles_MyAsynchronousWebService { my ($query_id, $tmpdir, $file_root, $cmd, $rh_input_data, $o_param, $o_inputs) = (@_); foreach my $input_key (keys %{$rh_input_data}) { my @a_input_data = ($rh_input_data->{$input_key}); @a_input_data = @{$rh_input_data->{$input_key}} if (ref($rh_input_data->{$input_key}) =~ /array/i); my $value; for (my $i = 0; $i <= $#a_input_data; $i++) { my $input_data = $a_input_data[$i]; $input_data =~ s/\r/\n/g; my @a_input_data_lines = split(/\n/, $input_data); $input_data = ''; foreach my $input_data_line (@a_input_data_lines) { chomp $input_data_line; if (($input_data_line ne '') && ($input_data_line ne "\n")) { $input_data .= $input_data_line . "\n"; } } use IO::File; my $tmp_file = "$tmpdir/$file_root.$input_key#$i.input"; my $input_fh = new IO::File('>' . $tmp_file); #pour faciliter la lecture my @a_excep_param = ($o_param, $input_key, $query_id); if (!defined $input_fh) { my $msg = "$tmp_file can not be written"; my $exception = BuildException(@a_excep_param, $msg, '600'); return (0, $exception); } elsif ($input_data eq '') { my $msg = "empty object"; my $exception = BuildException(@a_excep_param, $msg, '226'); return (0, $exception); } else { print $input_fh $input_data; $input_fh->close; #substitution de la ligne de commande #1- obtenir l'article en question # rien ne me garanti que l'identifiant est bon ! $value .= $tmp_file . ' '; } } $value =~ s/\s$//; my $iar = Biomoby::Service::KEY_INPUT; my $tmp_id = $input_key; $tmp_id =~ s/$iar//; my $o_article = $o_inputs->GetById($tmp_id); my $substi = eval($o_article->{cmd}); if (!defined $substi) { $substi = '--' . $o_article->{name} . '=' . $value; } $cmd =~ s/mask#$input_key#/$substi/; } return (1, $cmd); }
Title : NameOutputFiles_MyAsynchronousWebService Usage : ($cmd) = NameOutputFiles_MyAsynchronousWebService($cmd, $o_param) Function: Makes substitutions in the command line with the temporary file names. Args : $tmpdir temporary dir $file_root temporary file name $cmd original masked command line $o_param ParamParser object Returns : command
sub NameOutputFiles_MyAsynchronousWebService { my ($tmpdir, $file_root, $cmd, $o_outputs) = (@_); foreach my $id ($o_outputs->GetIds()) { my $o_output = $o_outputs->GetById($id); if ($o_output->{type} =~ /simple/i) { my $value = "$tmpdir/$file_root.oar$id.output"; my $substi = eval($o_output->{cmd}); $substi = '' if ((!defined $substi) || ($substi eq '')); $cmd =~ s/mask#oar$id#/$substi/; } else { #collection ... #on peut faire la meme substitution et exploser le fichier dans un post-traintement dans la sub CatOutputFiles_toppred my $value = "$tmpdir/$file_root.oar$id.output"; my $substi = eval($o_output->{cmd}); $substi = '' if ((!defined $substi) || ($substi eq '')); $cmd =~ s/mask#oar$id#/$substi/; } } # my @a_output_article_name_keys = $o_param->GetKeys('oar\d+_nm'); # foreach my $output_article_name_key (@a_output_article_name_keys) # { # my ($article_root_key) = ($output_article_name_key =~ /^(oar\d+)/); # if ($o_param->Get($article_root_key . '_tp') =~ /simple/i) # { # my $value = "$tmpdir/$file_root.$article_root_key.output"; # my $cmd_output = $o_param->Get($article_root_key . '_cmd'); # my $substi = eval ($cmd_output); # $substi = $value if ((!defined $substi) || ($substi eq '')); # $cmd =~ s/mask#$article_root_key#/$substi/; # } # else # { # #collection ... # #on peut faire la meme substitution et exploser le fichier dans un post-traintement dans la sub CatOutputFiles_MyAsynchronousWebService # } # } return $cmd; }
Title : ExecuteCmd_MyAsynchronousWebService Usage : ($code_run,$exception) = ExecuteCmd_MyAsynchronousWebService($query_id,$cmd,$o_param) Function: Execute the shell command and deal with error message. Returns an integer (code_run): 0 means that error is fatal (main program should return an empty BioMoby message). Args : $query_id Moby query ID $cmd shell command $o_param ParamParser object Returns : $code_run $exception Moby Encoded Exception
sub ExecuteCmd_MyAsynchronousWebService { my ($query_id, $cmd, $o_param) = (@_); my $error = `($cmd) 2>&1 1>/dev/null`; chomp $error; my %h_default_exception = (code => 700, severity => 'information', message => 'ok'); my $exception = &MOBYXSLT::encodeException( -refElement => '', -refQueryID => $query_id, -severity => $h_default_exception{severity}, -exceptionCode => $h_default_exception{code}, -exceptionMessage => $h_default_exception{message} ); my $code_run = 1; #on traite le message d'erreur #il peut s'agir uniquement de warning, dans ce cas le code_run n'est pas forcement a 0. # 0 signifiant une erreur fatale if ($error =~ /[\w\d]+/) { use HTML::Entities; $error = HTML::Entities::encode($error); $exception = &MOBYXSLT::encodeException( -refElement => '', -refQueryID => $query_id, -severity => 'error', -exceptionCode => '222', -exceptionMessage => "$error" ); $code_run = 0; } return ($code_run, $exception); }
Title : CatOutputFiles_MyAsynchronousWebService Usage : $moby_response = CreateInputFiles_MyAsynchronousWebService($tmpdir, $file_root, $moby_response, $o_param) Function: Get content of generated output files and add to moby response message Args : $query_id Moby query ID $tmpdir temporary dir $file_root temporary file name $moby_response original moby response to be completed $o_param ParamParser object Returns : $moby_response completed moby response
sub CatOutputFiles_MyAsynchronousWebService { my ($query_id, $tmpdir, $file_root, $moby_response, $o_param, $o_bm_service) = (@_); my $unix_cat = $o_param->Get('unix_cat'); my @a_output_article_name_keys = $o_param->GetKeys('oar\d+_nm'); my @a_complexresponse_articles = (); # for each output article foreach my $output_article_name_key (@a_output_article_name_keys) { my ($article_root_key) = ($output_article_name_key =~ /^(oar\d+)/); my $art_name = $o_param->Get($article_root_key . '_nm'); print STDERR "$art_name\n"; my $o_article = $o_bm_service->{o_outputs}->GetByName($art_name); if ($o_param->Get($article_root_key . '_tp') =~ /simple/i) { my $file = $o_article->{filename}; if (IsDefined($file)) { $file = "$tmpdir/$file"; } else {$file = "$tmpdir/$file_root.$article_root_key.output";} my @a_object = $o_article->GetObjects(); # should be a list of one element $object_content = CreateMobyResponse($file, $query_id, $unix_cat, $a_object[0]); my %h_article = (article_type => 'simple', article_content => $object_content, article_name => $art_name); push(@a_complexresponse_articles, \%h_article); #$moby_response .= &MOBYXSLT::simpleResponse( $object_content, $art_name, $query_id); } else #collection { my $dir_to_look_for_files = $tmpdir; $dir_to_look_for_files = "$tmpdir/$file_root.$article_root_key.output" if (-d "$tmpdir/$file_root.$article_root_key.output"); my @a_files = FindFiles($dir_to_look_for_files, $o_article->{filename}); #print STDERR Dumper ($o_article->{ filename }, \@a_files); my @a_object = $o_article->GetObjects(); # should be a list of one element if it's an homogenous collection my @a_objects_content; foreach my $file (@a_files) { #?? et pour les collections heterogenes ? my $object_content = CreateMobyResponse($file, $query_id, $unix_cat, $a_object[0]); push(@a_objects_content, $object_content); } my %h_article = (article_type => 'collection', article_content => \@a_objects_content, article_name => $art_name); push(@a_complexresponse_articles, \%h_article); #$moby_response .= &MOBYXSLT::collectionResponse(\@a_objects_content, $art_name, $query_id); } } $moby_response .= &MOBYXSLT::complexResponse(\@a_complexresponse_articles, $query_id); return $moby_response; }
Title : _Log_MyAsynchronousWebService Usage : _Log_MyAsynchronousWebService($message) Function: Write execution log message into MyAsynchronousWebService/log file Args : $message Returns : none
sub _Log_MyAsynchronousWebService { my $message = shift(); # if ((-w "$LOCAL_PATH/MyAsynchronousWebService/log") || (-W "$LOCAL_PATH/MyAsynchronousWebService/log")) my $path = &LOCAL_PATH . "/MyAsynchronousWebService/log"; my ($date, $ra_date) = &GetDate; if ((!-e $path . '.stop') && ((-w $path) || (-W $path))) { open(LOG, ">> $path") || die("$! $path"); print LOG "$date\t$message\n"; close LOG; } chmod 0777, $path; return; } #Exception codes @ http://biomoby.open-bio.org/CVS_CONTENT/moby-live/Perl/docs/html/MOBY/Client/Exception/MobyExceptionCodes.html sub BuildException { my ($o_param, $input_key, $query_id, $msg, $code) = @_; my $exception = &MOBYXSLT::encodeException( -refElement => $o_param->Get($input_key . '_nm'), -refQueryID => $query_id, -severity => 'error', -exceptionCode => $code, -exceptionMessage => $msg ); my $note = "$! : Documentation available at " . $o_param->Get('service_documentation'); my $chose = SOAP::Data->type( 'base64' => ( &MOBYXSLT::responseHeader( -authority => $o_param->Get('auth_uri'), -note => $note, -exception => $exception ) ) . &MOBYXSLT::responseFooter() ); return $chose; } sub SubstituteBin { my ($r_cmd, $o_service) = @_; my $substitute = $o_service->GetPrebin(); $substitute .= $o_service->GetCmd(); $$r_cmd =~ s/#$o_service->{ name }#/$substitute/; return 1; } sub SubstituteParamsFile { my ($r_cmd, $tmpdir, %h_files) = @_; foreach my $filename (keys %h_files) { $$r_cmd =~ s/([^\/])$filename/$1$tmpdir\/$filename/; } return; } sub SubstituteParamCmd { my ($r_cmd, $rh_param) = @_; # 1- isoler le premier mot, un eventuel nom de programme # j'ai des doutes sur l'exp rationnelle if (($$r_cmd =~ /[^-](\w+)/) and ($$r_cmd !~ /-\w+/) and (my $abs_path = which($1))) {$$r_cmd =~ s/$1/$abs_path/;} # 2- je remplace les variables $var de la commande par leur valeur si elle existe # _attention value et vdef ne doivent pas �tre des noms de parametre while ($$r_cmd =~ /\$(\w+)/g) { my $variable = $1; next if ($variable eq 'value' or $variable eq 'vdef'); my $value = $$rh_param{$variable}; $$r_cmd =~ s/\$$variable/$value/g if (defined $value); } } sub CreateMobyResponse { my ($file, $query_id, $unix_cat, $o_object) = @_; if (!-e $file) { #exception my $exception = &MOBYXSLT::encodeException( -refElement => '', -refQueryID => $query_id, -severity => 'warning', -exceptionCode => 600, -exceptionMessage => "output file ($file) not found" ); return ($moby_response, $exception); } my $data = `chmod 777 $file; $unix_cat $file`; #binary encoding pour les images if (-B $file) { use MIME::Base64; $data = MIME::Base64::encode($data); } # #A faire uniquement si on renvoie autre chose qu'un objet de base (String, Object, Integer ...) # if (!IsABaseMobyleObject($o_object->{tp})) { $data = "<moby:String id=\"\" namespace=\"\" articleName=\"content\"><![CDATA[$data]]></moby:String>"; } my $output_object_type = $o_object->{tp}; my $output_object_namespace = $o_object->{ns}; my $output_article_name = $o_article->{name}; return "<moby:$output_object_type namespace=\"$output_object_namespace\">$data</moby:$output_object_type>"; } sub FindFiles { my ($dir, $motif) = @_; my @a_files; #le motif est un motif "systeme" genre "*.png" # on change ca en expression reguliere $motif =~ s/\./\\./g; # *.* => *\.* $motif =~ s/\*/\.\*/g; # * => .* $motif =~ s/^"//; $motif =~ s/"$//; my $o_dir = new IO::Dir($dir) or die("$dir can't be opened !"); while (defined($file = $o_dir->read)) { chomp $file; if ($file =~ /^$motif$/) { push(@a_files, "$dir/$file"); } } return @a_files; } sub IsABaseMobyleObject { my ($type) = @_; return 1 if ('String' eq $type); return 1 if ('Boolean' eq $type); return 1 if ('Integer' eq $type); return 1 if ('Float' eq $type); return 1 if ('Object' eq $type); return 0; } 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", [$year, $mon, $mday, $hour, $min, $sec]); } 1;