2015-04-14 21:36:00 +02:00
#!/usr/bin/perl
#!/usr/local/bin/perl
use strict ;
2015-04-22 17:18:47 +02:00
use warnings ;
2015-04-14 21:36:00 +02:00
use English ;
use File::Basename ; ###---Package pour saisir le nom d un fichier (sans son repertoire)
use Cwd ; ###---Package pour connaitre le repertoire courant
use File::Spec::Functions qw( splitpath rel2abs ) ; ###---Package pour utiliser fonctions rel2abs et splitpath (
#nom du programme
my $ NOM_PROG = basename $ PROGRAM_NAME ;
#pattern d un reel pour les regex (desormais redondant avec $RE{num}{real} de Regexp::Common)
my $ format_reel = '[+-]?[\.]?\d+[\.]?\d*(?:[eE][+-]?\d*)?' ;
#####################################################################################################
# script pour lancer tous les tests d un repertoire de test
#
# Notes aux developpeurs :
# - utiliser print puis exit au lieu de die (pour envoyer l affichage sur STDOUT et non sur STDERR)
# - utiliser print au lieu de warn (meme raison que remarque precedente)
#
#####################################################################################################
#####################################
#####################################
#
# PRECISION DES TESTS PAR DEFAUT
#
#####################################
#####################################
#remarque : a mettre entre guillements (pour des raisons d affichage dans le rapport de test)
my $ PREC_ABSOLU = "1.e-6" ; #precision pour la comparaison absolue
my $ PREC_RELATIVE_POURCENT = "1.e-3" ; #precision pour la comparaison relative (en pourcent)
#####################################
#####################################
#
# AUTRES PARAMETRES
#
#####################################
#####################################
2015-04-22 17:18:47 +02:00
#taille maximale du fichier de redirection de l affichage d un calcul Herezh (en octets) rq : le but de cette limite est principalement de contrer le risque de remplissage du disque dur
# dans le cas ou Herezh affiche beaucoup trop de chose dans le terminal
2015-04-14 21:36:00 +02:00
# => fixee a 250 Mo le 2015-04-14
# Mo Ko
my $ TAILLE_MAX_FIC_REDIR = 250 * 1024 * 1024 ; #octets
########################### Variables de fichier ###########################
my $ repertoire_racine = cwd ; ###---Repertoire racine (celui dans lequel le script verifier_exeHZ a ete lance)
my $ repertoire_test ; ###---Repertoire test
my $ fichier_test = 'test0' ; ###---Fichier .info a tester
my $ fichier_rapport = 'rapport_test.txt' ; ###---Fichier de rapport des tests
my $ fichier_temp_maple = 'xxx_princ.maple' ; ###---Fichier pour recuperer $valeur
my @ fichiers ; ###---Liste du contenu initial du repertoire de test
########################### Variables executable Herezh ###########################
my $ exeHZ ; ###---Executable Herezh
my $ hzchemin ; ###---path vers l executable Herezh
##########################################################################
##########################################################################
##########################################################################
#
# (DEBUT) RECUPERATION ET VERIFICATION DES ARGUMENTS DU SCRIPT
#
##########################################################################
##########################################################################
##########################################################################
#indicateur de l option -h ou -help => affichage aide
my $ is_opt_help = 0 ;
foreach my $ arg ( @ ARGV ) {
if ( $ arg =~ /-h/i or $ arg =~ /-help/i ) {
$ is_opt_help = 1 ;
last ;
}
}
#affichage de l aide si option -h ou -help ou si il n y a pas assez d arguments
if ( $ is_opt_help or $# ARGV < 1 ) {
print "USAGE (prog:$NOM_PROG)... \n" ;
print "Ce script Perl s'utilise avec 2 arguments : \n" ;
print " -> 1] Nom du repertoire Test dans lequel se situe un fichier '.info'.\n" ;
print " -> 2] Nom de l executable Herezh\n" ;
exit ;
}
#nom du repertoire du test
$ repertoire_test = shift ( @ ARGV ) ;
#nom de l executable Herezh
$ exeHZ = shift ( @ ARGV ) ;
#verification de l existence du repertoire de test
( - d $ repertoire_test ) or do {
printRapport ( "$repertoire_test\n -> ECHEC : repertoire $repertoire_test introuvable\n\n" ) ;
print "**Erreur Test $repertoire_test : repertoire $repertoire_test introuvable\n" ;
exit ;
} ;
#verification de la presence d un unique fichier .info dans ce repertoire
@ _ = glob ( "$repertoire_test/*.info" ) ;
my $ nb_finfo = $# _ + 1 ;
( $ nb_finfo == 1 ) or do {
printRapport ( "$repertoire_test\n -> ECHEC : le repertoire ne contient pas exactement un seul fichier .info (nombre de fichiers trouves : $nb_finfo)\n\n" ) ;
print "**Erreur Test $repertoire_test : le repertoire ne contient pas exactement un seul fichier .info (nombre de fichiers trouves : $nb_finfo)\n" ;
exit ;
} ;
#verification de l executable Herezh (enregistrement du chemin complet dans $hzchemin)
$ hzchemin = verif_commande ( $ exeHZ ) ;
( $ hzchemin ne '0' ) or do {
printRapport ( "$repertoire_test\n -> ECHEC : executable Herezh ($exeHZ) introuvable\n\n" ) ;
print "**Erreur Test $repertoire_test : executable Herezh ($exeHZ) introuvable\n" ;
exit ;
} ;
##########################################################################
##########################################################################
##########################################################################
#
# (FIN) RECUPERATION ET VERIFICATION DES ARGUMENTS DU SCRIPT
#
##########################################################################
##########################################################################
##########################################################################
##########################################################################
##########################################################################
##########################################################################
#
# (DEBUT) PRE-TRAITEMENT :
# - deplacement dans repertoire de test
# - liste du contenu initial de ce repertoire
# - nom du fichier .info (sauvegarde du .info d origine en .info_OLD)
# - nom du fichier .maple
# - verification de la possibilite de lire le fichier .info
# - nombre de fichiers .CVisu[no] (on lancera autant de calcul qu il y a de .CVisu)
#
##########################################################################
##########################################################################
##########################################################################
print "\n" ;
print " TYPE DE CALCUL = $exeHZ\n" ;
print "############################################################\n" ;
print "############################################################\n" ;
print "#################### ####################\n" ;
print "#################### DEBUT DE TEST.PL ####################\n" ;
print "#################### ####################\n" ;
print "############################################################\n" ;
print "############################################################\n" ;
print " Nom du repertoire test = $repertoire_test\n" ;
print " $exeHZ se trouve ici : $hzchemin\n" ;
print " Nom du repertoire racine = $repertoire_racine\n" ;
#deplacement dans le repertoire de test
print " Deplacement dans le repertoire Test\n" ;
chdir ( "$repertoire_test" ) ;
#liste du contenu initial du repertoire de test (rq : servira plus tard a retablir l etat d origine du repertoire avant de terminer ce script)
@ fichiers = glob ( "*" ) ;
$ _ = $# fichiers + 1 ;
print " Nombre de fichiers dans le repertoire $repertoire_test = $_\n" ;
#nom du fichier .info
$ fichier_test = glob ( "*.info" ) ;
$ fichier_test =~ s/.info$// ; #suppression de l extension
print " Nom du fichier teste dans le repertoire test = $fichier_test.info\n" ;
#sauvegarde du fichier .info d origine
system ( "cp -nf $fichier_test.info $fichier_test.info_OLD" ) ;
#nom du fichier .maple
$ fichier_temp_maple = $ fichier_test . "_princ.maple" ;
#verification de l ouverture du fichier .info
open ( Finfo , "<$fichier_test.info" ) or do {
printRapport ( "$repertoire_test\n -> ECHEC : Impossible d'ouvrir $fichier_test.info\n\n" ) ;
print "**Erreur Test $repertoire_test : Impossible d'ouvrir $fichier_test.info\n" ;
exit ;
} ;
close ( Finfo ) ;
#
#nombre de fichiers .CVisu[no] (il doit y en avoir au moins 1)
# remarque : si il y a une rupture dans la numerotation, seuls les premiers .CVisu seront exploites
# par exemple : si on a : .CVisu1, .CVisu2, .CVisu4 (il manque le 3) => seuls les .CVisu1 et .CVisu2 seront traites (le .CVisu4 sera purement et simplement oublie)
my $ nb_CVisu = 1 ;
#-premiere verification : presence du fichier .CVisu1
( - e "$fichier_test.CVisu$nb_CVisu" ) or do {
printRapport ( "$repertoire_test\n -> ECHEC : fichier $fichier_test.CVisu1 introuvable\n\n" ) ;
print "**Erreur Test $repertoire_test : fichier $fichier_test.CVisu1 introuvable\n" ;
exit ;
} ;
#-autres fichiers .CVisu
LOOP1:while ( ) {
my $ indice_tmp = $ nb_CVisu + 1 ;
foreach my $ fic ( @ fichiers ) {
if ( - e "$fichier_test.CVisu$indice_tmp" ) {
$ nb_CVisu + + ;
next LOOP1 ;
}
}
last ;
}
print " Nombre de fichiers .CVisu dans le repertoire test = $nb_CVisu\n" ;
##########################################################################
##########################################################################
##########################################################################
#
# (FIN) PRE-TRAITEMENT
#
##########################################################################
##########################################################################
##########################################################################
##########################################################################
##########################################################################
##########################################################################
#
# (DEBUT) LANCEMENT DES TESTS (un test par fichier .CVisu)
#
##########################################################################
##########################################################################
##########################################################################
################################################
#(debut) boucle de test (sur les numeros de .CVisu)
################################################
# **IMPORTANT : ne pas utiliser de "die", "exit" ou autre sortie brutale dans cette boucle. Utiliser a la place l instruction " last BOUCLE_TEST; " pour sortir simplement de la boucle et permettre a ce script de faire des derniers traitements avant de quitter
BOUCLE_TEST:for ( my $ no_test = 1 ; $ no_test <= $ nb_CVisu ; $ no_test + + ) {
print "\n" ;
print " --------------------------------------\n" ;
print " lancement test fichier .CVisu$no_test\n" ;
print " --------------------------------------\n" ;
print "\n" ;
#ecriture du repertoire de test et .CVisu en cours dans le rapport
printRapport ( "$repertoire_test/.CVisu$no_test\n" ) ;
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# SAISIE DES EVENTUELS FICHIERS FACULTATIFS : - fichier de commande .commande
# - fichier de precision .precision
# - script de verification .verif
2015-04-29 18:36:49 +02:00
# - fichier d arguments .argument
2015-04-14 21:36:00 +02:00
#----------------------------------------------------------------------------------------------------
#####################################################################################################
my $ fic_commande = "" ; $ fic_commande = "$fichier_test.commande$no_test" if ( - e "$fichier_test.commande$no_test" ) ;
my $ fic_precision = "" ; $ fic_precision = "$fichier_test.precision$no_test" if ( - e "$fichier_test.precision$no_test" ) ;
my $ script_verif = "" ; $ script_verif = "$fichier_test.verif$no_test" if ( - e "$fichier_test.verif$no_test" ) ;
2015-04-29 18:36:49 +02:00
my $ fic_arguement = "" ; $ fic_argument = "$fichier_test.argument$no_test" if ( - e "$fichier_test.argument$no_test" ) ;
2015-04-14 21:36:00 +02:00
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# CONSTRUCTION DE LA COMMANDE HEREZH
2015-04-29 18:36:49 +02:00
# rq : en l absence d un fichier .argument, on considere qu il s agit d un calcul (-f fic.info) si le mot-cle dimension est repere dans le fichier .info
2015-04-14 21:36:00 +02:00
# sinon, on considere qu il s agit d une creation de fichier .info (-n fic.info)
#----------------------------------------------------------------------------------------------------
#####################################################################################################
#---initialisation de la commande a lancer
my $ cmd_HZ = "" ;
#################################################################################
2015-04-29 18:36:49 +02:00
#---cas d un fichier d arguments (la commande est construite via le contenu du fichier $fic_argument si il existe)
2015-04-14 21:36:00 +02:00
#################################################################################
2015-04-29 18:36:49 +02:00
if ( - e $ fic_argument ) {
open ( FIC , "<$fic_argument" ) ;
2015-04-14 21:36:00 +02:00
while ( <FIC> ) {
next if ( /^\s*\#/ ) ;
next if ( /^\s*$/ ) ;
chomp ;
$ cmd_HZ . = " $_" ;
}
close ( FIC ) ;
}
#################################################################################
2015-04-29 18:36:49 +02:00
#---cas general (pas de fichier .argument => calcul -f ou creation .info -n)
2015-04-14 21:36:00 +02:00
#################################################################################
else {
##############################################################
#---calcul classique (option -f) : mode selectionne si le mot-cle dimension est repere dans le fichier .info
# => on s assure que le mot-cle controle est present pour gerer les RESTART
##############################################################
if ( is_mot_in_fic ( "$fichier_test.info" , '^\s*dimension ' , '#' ) ) {
#ajout de "-f fic.info" a la commande Herezh
$ cmd_HZ . = " -f $fichier_test.info" ;
2015-04-16 18:14:34 +02:00
#suppression du fichier .maple (raison : si il y a erreur Herezh, il n y aura pas de .maple cree et donc il y aura un risque d utiliser un ancien .maple pour la comparaison)
system ( "rm -f $fichier_temp_maple" ) ;
2015-04-14 21:36:00 +02:00
#---verification : la presence du mot-cle controle est necessaire (pour la gestion des RESTART)
# => on ajoute ce mot-cle si besoin (avant le mot-cle resultats qui est obligatoire)
if ( not is_mot_in_fic ( "$fichier_test.info" , '^\s*controle' , '#' ) ) { #ajout du mot-cle controle si besoin
open ( Finfo , "<$fichier_test.info" ) ;
open ( Finfo_tmp , ">$fichier_test.info.tmp" ) ;
my $ presence_mot_cle_resultats = 0 ; #indicateur de presence du mot-cle resultats
while ( <Finfo> ) {
if ( /^\s*resultats/ ) { #le mot-cle resultats est repere => ecriture du mot-cle controle
$ presence_mot_cle_resultats = 1 ;
print Finfo_tmp "\ncontrole\n\n" ;
}
print Finfo_tmp ;
}
close ( Finfo ) ;
close ( Finfo_tmp ) ;
system ( "mv -f $fichier_test.info.tmp $fichier_test.info" ) ;
#on verifie que le mot-cle resultats a bien ete trouve (et donc que donc le mot-cle controle a bien ete ecrit)
$ presence_mot_cle_resultats or do {
printRapport ( " -> ECHEC : le mot-cle resultats n a pas ete trouve dans le fichier $fichier_test.info (impossible de rajouter le mot-cle controle)\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : le mot-cle resultats n a pas ete trouve dans le fichier $fichier_test.info (impossible de rajouter le mot-cle controle)\n" ;
last BOUCLE_TEST ;
} ;
}
#---activation eventuelle d un RESTART si existence du .PI
#-numero du dernier increment
my $ incr_restart = 0 ;
# rq : si le fichier .PI n existe pas, $incr_restart restera egal a 0 (pas d activation du RESTART)
# sinon, $incr_restart sera egal au dernier increment lu dans le fichier .PI
open ( FIC , "<$fichier_test.PI" ) ;
while ( <FIC> ) {
last if ( /^\s*$/ ) ;
next if ( not /^\s*incre_posi_\(nb_et_posi\):\s+(\d+)/ ) ;
$ incr_restart = $ 1 ;
}
close ( FIC ) ;
#-reecriture du .info avec RESTART (si $incr_restart different de 0)
active_RESTART ( "$fichier_test.info" , $ incr_restart ) ;
}
##############################################################
#---cas d une creation de fichier .info (option -n)
# => on s assure qu un fichier .commande existe
##############################################################
else {
#ajout de "-n fic.info" a la commande Herezh
$ cmd_HZ . = " -n $fichier_test.info" ;
#--- la presence d un fichier de commande est obligatoire pour une creation de fichier .info
if ( not - e $ fic_commande ) {
printRapport ( " -> ECHEC : probleme pour un test de creation de fichier .info (option -n) => le fichier $fic_commande est obligatoire et n a pas ete trouve\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : probleme pour un test de creation de fichier .info (option -n) => le fichier $fic_commande est obligatoire et n a pas ete trouve\n" ;
last BOUCLE_TEST ;
}
}
}
#################################################################################
#---suppression des espaces multiples dans la commande et des espaces en debut et en fin
# (pas forcement utile, c est juste a titre de prevention...)
#################################################################################
$ cmd_HZ =~ s/\s+/ /g ;
$ cmd_HZ =~ s/^\s+// ;
$ cmd_HZ =~ s/\s+$// ;
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# LANCEMENT DU CALCUL
#----------------------------------------------------------------------------------------------------
#####################################################################################################
#recopie du .CVisu[$no_test] vers .CVisu
system ( "cp -nf $fichier_test.CVisu$no_test $fichier_test.CVisu" ) ;
#lancement de la commande via subroutine lancement_commande() dont les arguments sont :
# 1- chemin complet vers l executable Herezh
# 2- la commande Herezh construite precedemment
# 3- le nom du fichier de redirection de l affichage Herezh
# 4- le nom du fichier .commande
my $ status_calcul = lancement_commande ( $ hzchemin , $ cmd_HZ , "$fichier_test.log" , $ fic_commande ) ;
2015-04-22 17:18:47 +02:00
# - si le calcul a termine normalement (converge ou non) => $status_calcul = "ok"
# - si le calcul a conduit a un trop gros fichier de redirection => $status_calcul = "depassement taille maximum"
# - si il y a eu un probleme de redirection d affichage => $status_calcul = "probleme redirection affichage"
# - si le calcul ne s arretait pas alors qu il avait une activite cpu nulle => $status_calcul = "activite cpu nulle"
2015-04-14 21:36:00 +02:00
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# VERIFICATION DU TEST
#----------------------------------------------------------------------------------------------------
#####################################################################################################
#################################################################################
#premiere verification selon status renvoye par la subroutine lancement_commande
#################################################################################
#---cas d un calcul ayant conduit a un trop gros fichier de redirection
if ( $ status_calcul eq "depassement taille maximum" ) {
printRapport ( " -> ECHEC : le calcul Herezh a conduit a la creation d un trop gros fichier de redirection (fichier $fichier_test.log a depasse la taille maximum autorisee egale a $TAILLE_MAX_FIC_REDIR octets).\n" ) ;
printRapport ( " Les causes possibles sont un probleme de menu interactif, un long calcul associe a une frequence trop grande d affichage des increments et iterations, ...\n" ) ;
printRapport ( " Si ce depassement est un fonctionnement normal, il faut augmenter la taille admissible dans la variable \$TAILLE_MAX_FIC_REDIR au debut du script de test $NOM_PROG pour rendre possible ce test.\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : le calcul Herezh a conduit a la creation d un trop gros fichier de redirection (fichier $fichier_test.log a depasse la taille maximum autorisee egale a $TAILLE_MAX_FIC_REDIR octets).\n" ;
print " Les causes possibles sont un probleme de menu interactif, un long calcul associe a une frequence trop grande d affichage des increments et iterations, ...\n" ;
print " Si ce depassement est un fonctionnement normal, il faut augmenter la taille admissible dans la variable \$TAILLE_MAX_FIC_REDIR au debut du script de test $NOM_PROG pour rendre possible ce test.\n" ;
last BOUCLE_TEST ;
}
2015-04-22 17:18:47 +02:00
2015-04-14 21:36:00 +02:00
#---cas d un probleme de redirection d affichage (sans doute probleme lie a la commande "tee")
elsif ( $ status_calcul eq "probleme redirection affichage" ) {
printRapport ( " -> ECHEC : il y a eu un probleme dans la redirection de l affichage via la commande \"tee\" (le fichier $fichier_test.log n a pas ete cree). Cause possible : commande tee introuvable\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : il y a eu un probleme dans la redirection de l affichage via la commande \"tee\" (le fichier $fichier_test.log n a pas ete cree). Cause possible : commande tee introuvable\n" ;
last BOUCLE_TEST ;
}
2015-04-22 17:18:47 +02:00
#---cas d un arret a cause d une activite cpu nulle
elsif ( $ status_calcul eq "activite cpu nulle" ) {
printRapport ( " -> ECHEC : le calcul ne s arretait pas alors qu il avait une activite cpu nulle\n" ) ;
printRapport ( " La cause possible est un probleme de menu interactif (verifiez le fichier .commande si il existe)\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : le calcul ne s arretait pas alors qu il avait une activite cpu nulle\n" ;
print " La cause possible est un probleme de menu interactif (verifiez le fichier .commande si il existe)\n" ;
last BOUCLE_TEST ;
}
2015-04-14 21:36:00 +02:00
#################################################################################
#cas d une verification via un script dedie (fichier .verif)
#################################################################################
if ( - e $ script_verif ) {
print " Comparaison via un script : utilisation de $script_verif\n" ;
#verification des droits du script (doit etre executable. si il n est pas executable, on le rend executable)
system ( "chmod +x $script_verif" ) if ( not - x $ script_verif ) ;
#execution du script (avec redirection vers un .log)
system ( "rm -f $script_verif.log" ) ;
2015-04-16 18:14:34 +02:00
print " \#----------------\n" ;
print " \# Debut de l affichage produit par le script $script_verif\n" ;
print " \#----------------\n" ;
system ( "$script_verif $hzchemin $fichier_test.log | tee $script_verif.log" ) ;
print " \#----------------\n" ;
print " \# Fin de l affichage produit par le script $script_verif\n" ;
print " \#----------------\n" ;
2015-04-14 21:36:00 +02:00
#saisie du resultat (on s attend a trouver une chaine de la forme "resultat verification : STATUS" dans le .log)
my $ resu_verif = '' ;
open ( FIC , "<$script_verif.log" ) ;
while ( <FIC> ) {
next if ( not /^\s*resultat\s+verification\s*:\s*(\S+)/i ) ; #rq : recherche insensible a la casse
$ resu_verif = $ 1 ;
last ;
}
close ( FIC ) ;
#verif du resultat (doit etre ECHEC ou OK)
( $ resu_verif eq 'OK' or $ resu_verif eq 'ECHEC' ) or do {
printRapport ( " -> ECHEC : resultat non conforme de la verification via le script $script_verif. Cause possible : la chaine \"resultat verification : ...\" n a pas ete trouvee ou alors le resultat n etait ni OK, ni ECHEC\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : resultat non conforme de la verification via le script $script_verif. Cause possible : la chaine \"resultat verification : ...\" n a pas ete trouvee ou alors le resultat n etait ni OK, ni ECHEC\n" ;
last BOUCLE_TEST ;
} ;
printRapport ( " -> $resu_verif (resultat fourni par le script de verification $script_verif)\n\n" ) ;
} #if(-e $script_verif)
#################################################################################
#cas d une verification classique (comparaison entre .maple et .maple.ref[$no_test])
# rq : on suppose qu il s agit d une verification classique si il y a la presence d un fichier .maple.ref
#################################################################################
elsif ( - e "$fichier_temp_maple.ref$no_test" ) {
##############################################################
# pretraitement
##############################################################
#nom du fichier maple de reference
my $ fichier_ref_maple = "$fichier_temp_maple.ref$no_test" ;
print " Comparaison maple : utilisation de $fichier_ref_maple\n" ;
#liste des donnees contenues dans le fichier maple de reference
my @ donnees_ref_maple = ( ) ;
#liste des donnees contenues dans le fichier maple du calcul en cours
my @ donnees_temp_maple = ( ) ;
#liste des precisions absolues
my @ precisions_abolues = ( ) ;
#liste des precisions relatives
my @ precisions_relatives = ( ) ;
##############################################################
# saisie des donnees du fichier maple de reference
##############################################################
open ( FIC , "<$fichier_ref_maple" ) or do {
printRapport ( " -> ECHEC : impossible d ouvrir fichier maple de reference $fichier_ref_maple\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : impossible d ouvrir fichier maple de reference $fichier_ref_maple\n" ;
last BOUCLE_TEST ;
} ;
while ( <FIC> ) {
next if ( not /^\s*$format_reel/ ) ;
$ _ =~ s/^\s+// ; $ _ =~ s/\s+$// ; #suppression d espaces eventuels en debut et fin
@ donnees_ref_maple = split ( /\s+/ , $ _ ) ;
}
close ( FIC ) ;
##############################################################
# saisie des donnees du fichier maple du calcul en cours
##############################################################
open ( FIC , "<$fichier_temp_maple" ) or do {
printRapport ( " -> ECHEC : impossible d ouvrir fichier maple $fichier_temp_maple (cause possible : erreur execution Herezh)\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : impossible d ouvrir fichier maple $fichier_temp_maple (cause possible : erreur execution Herezh)\n" ;
last BOUCLE_TEST ;
} ;
while ( <FIC> ) {
next if ( not /^\s*$format_reel/ ) ;
$ _ =~ s/^\s+// ; $ _ =~ s/\s+$// ; #suppression d espaces eventuels en debut et fin
@ donnees_temp_maple = split ( /\s+/ , $ _ ) ;
}
close ( FIC ) ;
##############################################################
# verification sur les donnees : nombre de donnees de reference doit etre egal au nombre de donnees generees par le calcul en cours
##############################################################
( $# donnees_temp_maple == $# donnees_ref_maple ) or do {
printRapport ( " -> ECHEC : pas le meme nombre de valeurs en sortie dans le .maple et dans le maple.ref$no_test\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : pas le meme nombre de valeurs en sortie dans le .maple et dans le .maple.ref$no_test\n" ;
last BOUCLE_TEST ;
} ;
##############################################################
# constitution des listes de precision
##############################################################
#---initialisation avec les precisions par defaut
for ( my $ i = 0 ; $ i <= $# donnees_temp_maple ; $ i + + ) {
$ precisions_abolues [ $ i ] = $ PREC_ABSOLU ;
$ precisions_relatives [ $ i ] = $ PREC_RELATIVE_POURCENT ;
}
#---modification eventuelle des precisions si un fichier .precision existe
if ( - e $ fic_precision ) {
open ( Fprec , "<$fic_precision" ) or do {
printRapport ( " -> ECHEC : impossible d ouvrir le fichier de precision $fic_precision\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : impossible d ouvrir le fichier de precision $fic_precision\n" ;
last BOUCLE_TEST ;
} ;
while ( <Fprec> ) {
next if ( not /^\s*\[\s*(\d+)\s*\]\s+($format_reel)\s+($format_reel)/ ) ;
$ precisions_abolues [ $ 1 - 1 ] = "$2" ;
$ precisions_relatives [ $ 1 - 1 ] = "$3" ;
print " modif precision absolue pour colonne $1 : precision absolue = $2\n" ;
print " modif precision relative pour colonne $1 : precision relative = $3\n" ;
}
close ( Fprec ) ;
}
##############################################################
# boucle de comparaison des donnees (test entre chaque valeur des listes @donnees_temp_maple et @donnees_ref_maple)
##############################################################
for ( my $ i_valeur = 0 ; $ i_valeur <= $# donnees_temp_maple ; $ i_valeur + + ) {
#numero de colonne dans le .maple
my $ no_colonne_maple = $ i_valeur + 1 ;
#valeur a comparer
my $ valeur_temp = $ donnees_temp_maple [ $ i_valeur ] ; #calcul en cours
my $ valeur_ref = $ donnees_ref_maple [ $ i_valeur ] ; #valeur de reference
#precisions
my $ precision_absolue = $ precisions_abolues [ $ i_valeur ] ;
my $ precision_relative = $ precisions_relatives [ $ i_valeur ] ;
#nombre de decimales des precisions (pour afficher des valeurs arrondies dans le rapport de test)
my $ nb_decimales_prec_absolue = return_nb_decimales ( $ precision_absolue ) ;
my $ nb_decimales_prec_relative = return_nb_decimales ( $ precision_relative ) ;
#difference absolue arrondie au nombre de decimales de la precision $precision_absolue
my $ diff_absolue = sprintf ( "%.${nb_decimales_prec_absolue}f" , $ valeur_temp - $ valeur_ref ) ;
#difference relative en pourcent arrondie au nombre de decimale de la precision $precision_relative
my $ diff_relative_pourcent ;
#-si $valeur_temp et $valeur_ref sont nulles, pas de souci, la difference relative est forcement nulle
if ( $ valeur_ref == 0 and $ valeur_temp == 0 ) {
$ diff_relative_pourcent = sprintf ( "%.${nb_decimales_prec_relative}f" , 0 . ) ;
}
#si $valeur_ref est nulle mais pas $valeur_temp, la comparaison relative est impossible
elsif ( $ valeur_ref == 0 ) {
$ diff_relative_pourcent = "impossible car valeur de reference egale a 0" ;
}
#cas general : difference relative par rapport a $valeur_ref
else {
$ diff_relative_pourcent = sprintf ( "%.${nb_decimales_prec_relative}f" , 100 . * ( $ valeur_temp - $ valeur_ref ) / $ valeur_ref ) ;
}
#ouverture du rapport de test
open ( FSOR , ">> $repertoire_racine/Rapport/$fichier_rapport" ) || do {
printRapport ( "$repertoire_test/.CVisu$no_test\n -> ECHEC : Impossible d'ouvrir $repertoire_racine/Rapport/$fichier_rapport\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : Impossible d'ouvrir $repertoire_racine/Rapport/$fichier_rapport\n" ;
last BOUCLE_TEST ;
} ;
print FSOR " -> grandeur testee : colonne \[$no_colonne_maple\]\n" ;
#############################
#comparaison absolue };
#############################
#---OK
if ( abs ( $ diff_absolue ) <= $ PREC_ABSOLU ) {
print FSOR " - comparaison absolue (precision : $precision_absolue) -> OK\n" ;
}
#---ECHEC
else {
print FSOR " - comparaison absolue (precision : $precision_absolue) -> ECHEC\n" ;
print FSOR " -> Valeur = $valeur_temp\n" ;
print FSOR " -> Valeur reference = $valeur_ref\n" ;
print FSOR " -> Difference = $diff_absolue\n" ;
}
#############################
#comparaison relative
#############################
#---cas d une comparaison impossible => affichage d un message d erreur (mais pas du mot ECHEC : ce n est pas un echec car la valeur de reference est egale a 0)
if ( $ diff_relative_pourcent =~ /impossible/ ) {
print FSOR " - comparaison relative : impossible car valeur de reference egale a 0\n" ;
}
#---OK
elsif ( abs ( $ diff_relative_pourcent ) <= $ precision_relative ) {
print FSOR " - comparaison relative (precision : $precision_relative\%) -> OK\n" ;
}
#---ECHEC
else {
print FSOR " - comparaison relative (precision : $precision_relative\%) -> ECHEC\n" ;
print FSOR " -> Valeur = $valeur_temp\n" ;
print FSOR " -> Valeur reference = $valeur_ref\n" ;
print FSOR " -> Difference relative = $diff_relative_pourcent\%\n" ;
}
print FSOR "\n" ;
} #for(my $i_valeur=0; $i_valeur<=$#donnees_temp_maple; $i_valeur++)
close ( FSOR ) ;
} #elsif(-e $fichier_temp_maple)
#################################################################################
#cas sans verification
#################################################################################
else {
printRapport ( " -> OK (pas de verification pour ce test)\n\n" ) ;
}
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# DERNIERS TRAITEMENT AVANT LANCEMENT DU PROCHAIN .CVisu
#----------------------------------------------------------------------------------------------------
#####################################################################################################
#suppression du fichier de redirection
system ( "rm -f $fichier_test.log" ) ;
#suppression des eventuels fichiers resultats (ATTENTION : ne pas supprimer les fichiers .BI et .PI pour permettre un RESTART)
#--- fichier .maple
system ( "rm -f $fichier_temp_maple" ) ;
#--- fichiers Gmsh
system ( "rm -rf $fichier_test\_Gmsh.msh $fichier_test\_Gmsh" ) ;
#--- fichiers _cab.isoe
system ( "rm -f $fichier_test*_cab.isoe" ) ;
#--- fichier reac
system ( "rm -f $fichier_test.reac" ) ;
#--- fichier res
system ( "rm -f $fichier_test.res" ) ;
#--- fichier cont
system ( "rm -f $fichier_test.cont" ) ;
#--- fichier ddl
system ( "rm -f $fichier_test.ddl" ) ;
#--- fichiers _dpl.points
system ( "rm -f $fichier_test*_dpl.points" ) ;
#--- fichier ancienNom
system ( "rm -f ancienNom" ) ;
} #BOUCLE_TEST:for(my $no_test=1; $no_test<=$nb_CVisu; $no_test++)
################################################
#(fin) boucle de test (sur les numeros de .CVisu)
################################################
##########################################################################
##########################################################################
##########################################################################
#
# (FIN) LANCEMENT DES TESTS
#
##########################################################################
##########################################################################
##########################################################################
##########################################################################
##########################################################################
##########################################################################
#
# FIN DU SCRIPT : derniers traitements avant sortie
#
##########################################################################
##########################################################################
##########################################################################
#####################################################################################################
# derniers traitements avant retour au repertoire racine
#####################################################################################################
#restauration du .info d origine
system ( "mv -f $fichier_test.info_OLD $fichier_test.info" ) ;
#suppression de tout ce qui n etait pas present initialement dans le repertoire de test (fichiers et repertoires)
my % TAB_FICHIER_INITIAL ;
#---on cree une table d indicateur de presence pour les fichiers initiaux (fichiers et repertoires contenus dans la liste @fichiers qui a ete constituee en debut de script)
foreach my $ fic ( @ fichiers ) { $ TAB_FICHIER_INITIAL { $ fic } = 1 ; }
#---et on supprime tout ce qui n a pas d indicateur
foreach my $ fic ( glob ( "*" ) ) {
next if ( defined ( $ TAB_FICHIER_INITIAL { $ fic } ) ) ; #pas de suppression en cas d indicateur
system ( "rm -rf $fic" ) ;
}
#####################################################################################################
# retour au repertoire racine
#####################################################################################################
print " Deplacement jusqu'au repertoire d'origine\n" ;
chdir ( $ repertoire_racine ) ;
print "##########################################################\n" ;
print "##########################################################\n" ;
print "#################### ####################\n" ;
print "#################### FIN DE TEST.PL ####################\n" ;
print "#################### ####################\n" ;
print "##########################################################\n" ;
print "##########################################################\n" ;
##########################################################################
##########################################################################
##########################################################################
#
# SUBROUTINES
#
##########################################################################
##########################################################################
##########################################################################
#####################################################################################################
#subroutine pour ecrire une chaine de caractere dans le fichier de rapport des tests : $repertoire_racine/Rapport/$fichier_rapport
#####################################################################################################
# en entree :
# - chaine de caracteres a afficher dans le rapport
#
sub printRapport {
open ( FSOR , ">>$repertoire_racine/Rapport/$fichier_rapport" ) or do {
print "Impossible d'ouvrir $repertoire_racine/Rapport/$fichier_rapport\n" ;
exit ;
} ;
print FSOR $ _ [ 0 ] ;
close ( FSOR ) ;
}
#####################################################################################################
#subroutine pour lancer la commande Herezh
#####################################################################################################
# en entree :
# - executable Herezh (IMPORTANT : chemin complet vers la commande. Par exemple : ../HZpp, /Users/dupont/bin/HZppfast, ./HZppfast, ...)
# - commande (une chaine de caracteres donnant les instructions a la suite de l executable Herezh. Par exemple : -f fic.info)
# - fichier redirection affichage (fichier pour redirection affichage avec "tee")
# - fichier de commande (reponses en interactif)
#
# en sortie :
2015-04-22 17:18:47 +02:00
# - indicateur sur le status du calcul : "ok" => calcul a termine normalement (converge ou non)
# "depassement taille maximum" => calcul a conduit a un depassement du maximum autorise pour la taille du fichier de redirection
# "probleme redirection affichage" => la redirection de l affichage n a pas ete faite correctement (dans ce cas, probleme lie a la commande tee)
# "activite cpu nulle" => calcul ne s arretait pas alors qu il avait une activite cpu nulle
2015-04-14 21:36:00 +02:00
sub lancement_commande {
2015-04-22 17:18:47 +02:00
use IO::Handle ;
2015-04-14 21:36:00 +02:00
my $ hzchemin_original = shift ;
my $ commande = shift ;
my $ fredir_tee = shift ;
my $ fic_commande = shift ;
#suppression d un eventuel fichier de redirection deja existant
system ( "rm -f $fredir_tee" ) ;
##############################################################
#creation d un lien symbolique vers l executable Herezh original
# rq : l utilite de ce lien est qu il permettra de rechercher les pid de processus en reperant ce nom unique genere aleatoirement (pour eviter de tuer d autres processus Herezh qui n ont rien a voir avec la batterie de test)
##############################################################
#creation d un nom aleatoire
my $ lien_symbolique_HZ = 'HZ' . int ( rand ( 99999999999 ) ) ;
#creation du lien symbolique
system ( "ln -s $hzchemin_original $lien_symbolique_HZ" ) ;
##############################################################
2015-04-22 17:18:47 +02:00
#lancement du calcul Herezh dans un pipe
2015-04-14 21:36:00 +02:00
# rq : redirection de l affichage dans le fichier $fredir_tee
##############################################################
2015-04-22 17:18:47 +02:00
open ( PIPE , "|$lien_symbolique_HZ $commande | tee $fredir_tee" ) ;
PIPE - > autoflush ( 1 ) ; #forcer a vider le tampon (methode autoflush du package IO::Handle)
2015-04-14 21:36:00 +02:00
2015-04-22 17:18:47 +02:00
#ecriture des reponses interactives si le fichier $fic_commande existe
if ( - e $ fic_commande ) {
open ( FIC , "<$fic_commande" ) ;
while ( <FIC> ) {
print PIPE ;
}
close ( FIC ) ;
}
2015-04-14 21:36:00 +02:00
##############################################################
#recuperation des pid de processus Herezh (dans la variable @HZpid)
# rq : pour pouvoir les tuer en cas de probleme
##############################################################
2015-04-22 17:18:47 +02:00
#saisie de la liste des processus sous la forme "pid %cpu commande" en ne gardant (grep) que les processus comportant la chaine $lien_symbolique_HZ pour l utilisateur courant $ENV{USER}
# et en ne gardant pas (grep -v) les processus contenant le mot grep
my @ processus = qx( ps -U $ENV{USER} -o pid,%cpu,command | grep $lien_symbolique_HZ | grep -v grep ) ;
# remarque : idealement, @processus ne contient qu un seul processus (celui du calcul) grace au filtrage grep
# mais si il en contient plus, ca ne posera pas de probleme car de toute facon, tous les processus contenant le mot $lien_symbolique_HZ
# peuvent etre tues sans perturber le reste de l activite de la machine
2015-04-14 21:36:00 +02:00
#on ne garde que le pid des processus et on les stocke dans @HZpid
my @ HZpid = ( ) ;
foreach my $ processus ( @ processus ) {
next if ( not $ processus =~ /^\s*(\d+)/ ) ;
push ( @ HZpid , $ 1 ) ;
}
##############################################################
#on s assure que le fichier de redirection a ete cree
# si ce n est pas le cas, on retourne un probleme lie a la redirection de l affichage
##############################################################
if ( not - e $ fredir_tee ) {
#suppression des processus de calcul
2015-04-22 17:18:47 +02:00
kill ( "TERM" , @ HZpid ) ;
2015-04-14 21:36:00 +02:00
#suppression lien symbolique
system ( "rm -f $lien_symbolique_HZ" ) ;
return "probleme redirection affichage" ;
}
2015-04-22 17:18:47 +02:00
#
#...maintenant, on va lancer un processus fils pour surveiller le calcul. On provoque son arret force (kill -9) dans les cas suivants :
# 1) si la taille du fichier $fredir_tee depasse $TAILLE_MAX_FIC_REDIR octets
# 2) si le calcul a une activite cpu nulle mais ne s arrete pas
#
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
# surveillance en continu dans un processus fils :
# - de la taille du fichier de redirection
# - de l activite cpu du calcul
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
#la creation du fichier $fic_com_taille_max permettra d indiquer au processus pere que le fichier $fredir_tee a depasse la taille maximum autorisee $TAILLE_MAX_FIC_REDIR octets
my $ fic_com_taille_max = "$lien_symbolique_HZ.TAILLE_MAX_FIC_REDIR" ; system ( "rm -f $fic_com_taille_max" ) ;
#la creation du fichier $fic_com_activite_cpu permettra d indiquer au processus pere que les processus ont une activite nulle
my $ fic_com_activite_cpu = "$lien_symbolique_HZ.ACTIVITE_CPU" ; system ( "rm -f $fic_com_activite_cpu" ) ;
2015-04-14 21:36:00 +02:00
2015-04-22 17:18:47 +02:00
my $ PID_SURVEILLANCE = fork ( ) ;
2015-04-14 21:36:00 +02:00
#
#le bloc suivant ne concerne que le processus fils
2015-04-22 17:18:47 +02:00
if ( $ PID_SURVEILLANCE == 0 ) {
#compteur pour reperer si l activite cpu est nulle plusieurs fois d affilee ($nb_fois_cpu_nul_MAX fois)
my $ nb_fois_cpu_nul = 0 ;
my $ nb_fois_cpu_nul_MAX = 10 ;
LOOP_SURVEILLANCE:while ( ) {
2015-04-14 21:36:00 +02:00
#pause de 0.5 seconde
select ( undef , undef , undef , 0.5 ) ;
2015-04-22 17:18:47 +02:00
##
## SURVEILLANCE DE LA TAILLE DU FICHIER
##
#taille actuelle du fichier de redirection
2015-04-14 21:36:00 +02:00
my $ taille_fichier = - s $ fredir_tee ;
2015-04-22 17:18:47 +02:00
#si la taille du fichier a depasse la limite => on cree le fichier de communication $fic_com_taille_max, on tue les processus de calcul et on sort de la boucle
2015-04-14 21:36:00 +02:00
if ( $ taille_fichier > $ TAILLE_MAX_FIC_REDIR ) {
2015-04-22 17:18:47 +02:00
open ( FCOM , ">$fic_com_taille_max" ) ;
close ( FCOM ) ;
kill ( "TERM" , @ HZpid ) ;
last ;
}
##
## SURVEILLANCE DE L ACTIVITE CPU
##
#liste des processus sous le format "%cpu commande" dont la commande contient le mot $lien_symbolique_HZ et pas le mot grep
my @ process = qx( ps -U $ENV{USER} -o %cpu,command | grep $lien_symbolique_HZ | grep -v grep ) ;
#on sort de la boucle si aucun processus ne tourne
last if ( $# process == - 1 ) ;
#liste des activites cpu
my @ activite_cpu = ( ) ;
foreach my $ process ( @ process ) {
next if ( not $ process =~ /^\s*\d/ ) ;
$ process =~ s/^\s+// ; #suppression espaces en debut
( $ process ) = split ( /\s+/ , $ process ) ; #separation suivant les espaces et on ne garde que le premier element retourne par split
$ process =~ s/,/./ ; #remplacement d une eventuelle virgule par un . dans le nombre reel representant l activite cpu
push ( @ activite_cpu , $ process ) ;
}
#si l un des processus a une activite non nulle, on en deduit que le calcul tourne encore => on remet a 0 le compteur $nb_fois_cpu_nul et on recommence la boucle
foreach my $ activite_cpu ( @ activite_cpu ) {
if ( $ activite_cpu > 0 ) {
$ nb_fois_cpu_nul = 0 ;
next LOOP_SURVEILLANCE ;
}
}
#sinon, on est dans le cas ou l activite cpu est nulle => on incremente le compteur
$ nb_fois_cpu_nul + + ;
#si le compteur est egal au max, on kill les processus, on cree le fichier de communication $fic_com_activite_cpu et on sort de la boucle
if ( $ nb_fois_cpu_nul == $ nb_fois_cpu_nul_MAX ) {
open ( FCOM , ">$fic_com_activite_cpu" ) ;
close ( FCOM ) ;
kill ( 'TERM' , @ HZpid ) ;
2015-04-14 21:36:00 +02:00
last ;
}
}
2015-04-22 17:18:47 +02:00
2015-04-14 21:36:00 +02:00
exit ;
2015-04-22 17:18:47 +02:00
} #fin du fils
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
#fermeture du pipe
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
close ( PIPE ) ;
2015-04-14 21:36:00 +02:00
2015-04-22 17:18:47 +02:00
#attente de la fin du processus fils de surveillance
waitpid ( $ PID_SURVEILLANCE , 0 ) ;
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
# etat du calcul
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
my $ status_calcul ;
2015-04-14 21:36:00 +02:00
2015-04-22 17:18:47 +02:00
#si le fichier $fic_com_taille_max existe, cela veut dire qu il y a eu un depassement de la taille maximum autorisee
# => status => depassement taille maximum
if ( - e $ fic_com_taille_max ) {
$ status_calcul = 'depassement taille maximum' ;
2015-04-14 21:36:00 +02:00
}
2015-04-22 17:18:47 +02:00
#si le fichier $fic_com_activite_cpu existe, cela veut dire qu il y a eu un arret a cause d un calcul qui attend sans activite
# => status => activite cpu nulle
elsif ( - e $ fic_com_activite_cpu ) {
$ status_calcul = 'activite cpu nulle' ;
}
#sinon ca veut dire que le calcul Herezh s est arrete normalement (qu il ait converge ou non)
2015-04-14 21:36:00 +02:00
# => status calcul = ok
else {
2015-04-22 17:18:47 +02:00
$ status_calcul = 'ok' ;
2015-04-14 21:36:00 +02:00
}
2015-04-22 17:18:47 +02:00
#suppression des eventuels fichiers de communication
system ( "rm -f $fic_com_taille_max $fic_com_activite_cpu" ) ;
#suppression du lien symbolique
system ( "rm -f $lien_symbolique_HZ" ) ;
return $ status_calcul ;
2015-04-14 21:36:00 +02:00
} #sub lancement_commande
#####################################################################################################
#subroutine qui recherche l existence d une commande et renvoie le premier path trouve (renvoie 0 si commande introuvable)
#####################################################################################################
# en entree :
# - nom de la commande
#
# en sortie :
2015-04-16 18:14:34 +02:00
# - chemin aboslu de la commande (0 si commande introuvable)
2015-04-14 21:36:00 +02:00
#
sub verif_commande {
my $ cmd = shift ; #nom de la commande
2015-04-29 18:36:49 +02:00
#cas d un chemin absolu ou relatif (si la commande commence par . ou /. Par exemple : ./HZpp ../HZppfast ou /Users/dupont/bin/HZppfast)
if ( $ cmd =~ /^\./ or $ cmd =~ /^\// ) {
2015-04-16 18:14:34 +02:00
#on passe la commande en chemin absolu
$ cmd = rel2abs ( $ cmd ) ;
return $ cmd ;
2015-04-14 21:36:00 +02:00
}
2015-04-16 18:14:34 +02:00
#sinon on regarde dans la variable environnement $PATH
2015-04-14 21:36:00 +02:00
foreach my $ path ( split ( /\s*:\s*/ , $ ENV { PATH } ) ) {
2015-04-16 18:14:34 +02:00
if ( - x "$path/$cmd" ) {
#on s assure que c est un chemin absolu
$ cmd = rel2abs ( "$path/$cmd" ) ;
return $ cmd ;
}
2015-04-14 21:36:00 +02:00
}
2015-04-29 18:36:49 +02:00
#on regarde a nouveau si la commande est en chemin absolu ou relatif
# (cas d une commande qui ne commence pas par . ou / et qui n est pas dans les PATH. Par exemple : rep/HZpp)
if ( - x $ cmd ) {
#on passe la commande en chemin absolu
$ cmd = rel2abs ( $ cmd ) ;
return $ cmd ;
}
2015-04-14 21:36:00 +02:00
#cas ou la commande est introuvable
return 0 ;
} #sub verif_commande
#####################################################################################################
#subroutine pour activer/desactiver RESTART dans fichier .info
#####################################################################################################
# en entree :
# - nom du fichier .info
# - numero d increment de RESTART (0 pour desactiver RESTART)
sub active_RESTART {
my $ finfo = shift ; #nom fichier .info
my $ increment = shift ; #increment de RESTART
#suppression d un eventuel RESTART deja present
open ( Finfo , "<$finfo" ) ;
open ( Finfo_tmp , ">$finfo.tmp" ) ;
while ( <Finfo> ) {
next if ( /^\s*RESTART / ) ; #pas d ecriture si la ligne commence par RESTART
print Finfo_tmp ; #ecriture de la ligne du fichier d origine
#ajout de RESTART si la ligne actuelle est positionnee au mot-cle controle et que $increment n est pas egal a 0
if ( /^\s*controle/ and $ increment > 0 ) {
print Finfo_tmp "RESTART $increment\n" ;
}
}
close ( Finfo ) ;
close ( Finfo_tmp ) ;
system ( "mv -f $finfo.tmp $finfo" ) ;
} #sub active_RESTART
#####################################################################################################
#subroutine qui renvoie le nombre de decimales d un reel
#####################################################################################################
# en entree :
# - un reel
#
# en sortie :
# - nombre de decimales
#
sub return_nb_decimales {
my $ nombre = shift ;
$ nombre = "$nombre" ;
return 0 if ( $ nombre =~ /^\d+$/ ) ; #cas d un entier
#saisie d une eventuelle puissance de 10
my $ exp = 0 ;
$ nombre =~ s/[Ee]([+-]?\d+)// ;
$ exp = $ 1 if ( defined ( $ 1 ) ) ;
#calcul du nombre de decimales du reel sans son eventuelle puissance de 10
my @ tab = split ( // , $ nombre ) ;
my $ nb_decimales = 0 ;
my $ i ;
for ( $ i = 0 ; $ i <= $# tab ; $ i + + ) { last if ( $ tab [ $ i ] eq '.' ) ; }
for ( my $ j = $ i + 1 ; $ j <= $# tab ; $ j + + ) { $ nb_decimales + + ; }
#rajout du decalage de virgule selon l eventuelle puissance de 10
$ nb_decimales -= $ exp ;
return $ nb_decimales ;
} #sub return_nb_decimales
#####################################################################################################
#subroutine pour rechercher la presence d un mot dans un fichier en parcourant egalement les sous-fichiers
# declares dans le fichier (lignes de la forme : "< nom_fichier")
#####################################################################################################
# en entree :
# - arg 1 : nom du fichier
# - arg 2 : mot a trouver
# - arg 3 : symbole de fin de ligne (par exemple le symbole # pour un fichier .info)
#
# en sortie :
# - renvoie 1 si le fichier ou l un de ses sous-fichiers contient le mot
# renvoie 0 si le mot n a pas ete trouve ou si le fichier n est pas lisible
#
sub is_mot_in_fic {
local $ _ ;
my $ fic = shift ; #fichier a traiter
my $ mot = shift ; #mot a rechercher
my $ symbole_fin_ligne = shift ; #symbole indiquant la fin d une ligne
#repertoire du fichier (on utilise le chemin absolu pour connaitre ce repertoire)
my $ rep_absolu = ( splitpath ( rel2abs $ fic ) ) [ 1 ] ;
#parcours du fichier (et enregistrement de ses eventuels sous-fichiers)
my @ sous_fic ; #liste des sous-fichiers
open ( FIC , "<$fic" ) or return 0 ; #on renvoie 0 si le fichier n est pas lisible
while ( <FIC> ) {
#troncature de la ligne selon le premier symbole $symbole_fin_ligne trouve
s/${symbole_fin_ligne}.*$// ;
#cas ou le mot a ete trouve (on ferme le fichier et on renvoie "vrai")
if ( /$mot/ ) {
close ( FIC ) ;
return 1 ;
} #if(/$mot/)
#cas d un sous-fichier (on garde son nom pour l instant en lui ajoutant le repertoire du fichier)
push ( @ sous_fic , "$rep_absolu$1" ) if ( /^\s*\<\s*(\S+)/ ) ;
} #while(<FIC>)
close ( FIC ) ;
#parcours des sous-fichiers
foreach my $ sous_fic ( @ sous_fic ) {
#repertoire du sous-fichier (rq : le chemin de $sous_fic est deja absolu, donc pas besoin de faire appel a la sub rel2abs() )
$ rep_absolu = ( splitpath $ sous_fic ) [ 1 ] ;
open ( FIC , "<$sous_fic" ) or next ; #on ne fait rien si le fichier n est pas lisible
while ( <FIC> ) {
#troncature de la ligne selon le premier symbole $symbole_fin_ligne trouve
s/${symbole_fin_ligne}.*$// ;
#cas ou le mot a ete trouve (on ferme le fichier et on renvoie "vrai")
if ( /$mot/ ) {
close ( FIC ) ;
return 1 ;
} #if(/$mot/)
#cas d un sous-fichier de sous-fichier (est-ce vraiment raisonnable!!!!) (on l ajoute a la liste)
push ( @ sous_fic , "$rep_absolu$1" ) if ( /^\s*\<\s*(\S+)/ ) ;
}
close ( FIC ) ;
}
return 0 ;
} #sub is_mot_in_fic
