2
0
Fork 0
Verif_Herezh/verifier_exeHZ.pl

551 lines
23 KiB
Prolog
Executable file

#!/usr/bin/env perl
use strict;
use warnings;
use English;
use File::Basename;
use File::Spec::Functions qw(splitpath rel2abs);#($volume, $rep, $fic) = splitpath($path); $absolute_path = rel2abs($relative_path)
use Module::Load::Conditional qw(check_install);#pour verifier existence d une librairie
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*)?';
#fichier de communication avec le script ./Perl/test.pl (pour gerer l arret force de la batterie)
# !!!!ATTENTION : tout changement dans le nom de ce fichier doit etre repercute dans le script ./Perl/test.pl
my $FIC_COMMUNICATION = "/tmp/verifier_exeHZ_2_test_$PID.com";
##########################################################################
##########################################################################
##########################################################################
#
# RECUPERATION ET VERIFICATION DES ARGUMENTS ET OPTIONS 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 < 0) {
afficher_ligne_tirets('print');
print "Script $NOM_PROG \n";
afficher_ligne_tirets('print');
print " Description :\n";
print " Lancement de la batterie de verification Herezh\n";
print " Par defaut, ce script lance tous les tests disponibles dans l arborescence.\n";
print " Un certain nombre d options sont proposees pour modifier le fonctionnement.\n";
print "\n";
print " Pour les tests rapides : le rapport sera contenu dans Rapport/rapport_Test_R.txt\n";
print " Pour les tests longs : le rapport sera contenu dans Rapport/rapport_Test_L.txt\n";
print " En cas d option -rpt : le rapport sera contenu dans Rapport/rapport_test_debugECHEC.txt\n";
print "\n";
print " Usage : $NOM_PROG [-R] [-L] [-rpt fic_rapport] exeHZ\n";
print "\n";
print " Argument obligatoire :\n";
print " exeHZ : nom de l executable Herezh\n";
print "\n";
print " Options :\n";
print " -R : ne lancer que les tests rapides (Test_R)\n";
print "\n";
print " -L : ne lancer que les tests longs (Test_L)\n";
print "\n";
print " -rpt fic_rapport : seuls les tests presents dans le fichier de rapport\n";
print " fic_rapport et ayant un indicateur ECHEC seront lances\n";
print "\n";
print " Remarque :\n";
print " contrairement aux commandes linux classiques, les options de ce script\n";
print " peuvent etre placees n importe ou. Par exemple, les commandes suivantes\n";
print " fonctionnent de maniere equivalente :\n";
print " > $NOM_PROG -R HZppfast_Vn-1\n";
print " > $NOM_PROG HZppfast_Vn-1 -R\n";
afficher_ligne_tirets('print');
print "\n";
exit;
}
#--------------------------------------------------------------------------
# recuperation des arguments et options
#--------------------------------------------------------------------------
my $exeHZ;#argument obligatoire : nom de l executable Herezh
my $is_opt_R = 0;#indicateur de l option -R (0 par defaut; si egal 1 => lancement des tests rapides Test_R uniquement)
my $is_opt_L = 0;#indicateur de l option -L (0 par defaut; si egal 1 => lancement des tests longs Test_L uniquement)
my $is_opt_rpt = 0;#indicateur de l option -rpt (0 par defaut; si egal 1 => lancement uniquement des tests ayant un status ECHEC dans un rapport precedent)
my $opt_rpt_fic_rapport;#option -rpt : nom du fichier de rapport a exploiter (non defini par defaut)
#On vide le contenu de @ARGV en conservant les arguments obligatoires dans @args et traiter les options au cas par cas
my $opt;
my @args;
while($#ARGV != -1) {
$opt = shift(@ARGV);
#option -R
if($opt eq '-R') {
$is_opt_R = 1;
}
#option -L
elsif($opt eq '-L') {
$is_opt_L = 1;
}
#option -rpt
elsif($opt eq '-rpt') {
$is_opt_rpt = 1;
($#ARGV != -1) or die "\nErreur (prog:$NOM_PROG, opt:-rpt) : l option -rpt necessite de specifier un nom de fichier rapport...\n\n";
$opt_rpt_fic_rapport = shift(@ARGV);
#verif de l existence du fichier rapport
(-e $opt_rpt_fic_rapport) or die "\nErreur (prog:$NOM_PROG, opt:-rpt) : fichier rapport $opt_rpt_fic_rapport introuvable...\n\n";
}
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
#note aux developpeurs : AJOUTER ICI LE TRAITEMENT D UNE NOUVELLE OPTION
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
#cas d une option inconnue (on l ignore)
elsif($opt =~ /^-/) {
warn "Attention (prog:$NOM_PROG) : l option $opt est inconnue (et ignoree)...\n";
warn "(taper entree pour continuer...)\n";
<STDIN>;#attend jusqu a ce que la touche entree soit tapee
}
#sinon on enregistre l argument dans @args
else {
push(@args, $opt);
}
}#while($#ARGV != -1)
#a ce stade, les arguments restants sont dans @args
($#args >= 0) or die "\nErreur (prog:$NOM_PROG) : arguments manquants ($NOM_PROG -h pour afficher l aide)...\n\n";
#premier argument obligatoire : nom de l executable Herezh
$exeHZ = shift(@args);
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
#note aux developpeurs : AJOUTER ICI DE NOUVELLES AFFECTATIONS DE VARIABLE EN FONCTION DES ARGUMENTS @args
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
#--------------------------------------------------------------------------
# verification generale
# => verification de divers pre-requis qui seront necessaires par la suite
# dans les divers executions de la procedure de verification
#--------------------------------------------------------------------------
#commande tcsh
(verif_commande("tcsh") ne '0') or die "\nErreur (prog:$NOM_PROG) : commande tcsh introuvable...\n\n";
#presence du repertoire Perl/ et presence des scripts suivants :
# - Perl/genere_rapport.pl
# - Perl/test.pl
# rq : ces scripts doivent etre executables
(-d "Perl/") or die "\nErreur (prog:$NOM_PROG) : repertoire Perl/ introuvable dans le repertoire courant...\n\n";
(-e "Perl/genere_rapport.pl") or die "\nErreur (prog:$NOM_PROG) : script Perl/genere_rapport.pl introuvable...\n\n";
(-x "Perl/genere_rapport.pl") or die "\nErreur (prog:$NOM_PROG) : script Perl/genere_rapport.pl n est pas executable...\n\n";
(-e "Perl/test.pl") or die "\nErreur (prog:$NOM_PROG) : script Perl/test.pl introuvable...\n\n";
(-x "Perl/test.pl") or die "\nErreur (prog:$NOM_PROG) : script Perl/test.pl n est pas executable...\n\n";
#--------------------------------------------------------------------------
# verification des arguments et options
#--------------------------------------------------------------------------
#validite de l executable Herezh
(verif_commande($exeHZ) ne '0') or die "\nErreur (prog:$NOM_PROG) : commande Herezh $exeHZ introuvable ou non executable...\n\n";
#option -R et -L mutuellement exclusives (si les 2 ont ete utilisees => erreur)
if($is_opt_R and $is_opt_L) {
die "\nErreur (prog:$NOM_PROG, opt:-R/-L) : interdiction d utiliser les options -R et -L en meme temps...\n\n";
}
#si option -rpt : verif de la validite du fichier rapport $opt_rpt_fic_rapport
if($is_opt_rpt) {
#validite (par une heuristique : est valide si on y trouve la chaine "RAPPORT DE TEST", sensible a la casse)
my $fichier_valide = 0;
open(FIC, "<$opt_rpt_fic_rapport");
while(<FIC>) {next if(not /RAPPORT DE TEST/); $fichier_valide = 1; last;}
close(FIC);
$fichier_valide or die "\nErreur (prog:$NOM_PROG, opt:-rpt) : fichier $opt_rpt_fic_rapport existe mais n est pas un fichier de rapport genere par le script $NOM_PROG...\n\n";
}
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
#note aux developpeurs : AJOUTER ICI DE NOUVELLES VERIF EN LIEN AVEC UNE NOUVELLE OPTION OU UN NOUVEL ARGUMENT
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
##########################################################################
##########################################################################
##########################################################################
#
# GESTION D UNE INTERRUPTION (Ctrl-c ou kill -15)
# actions a gerer :
# - arreter proprement le test en cours
# - supprimer d eventuels fichiers temporaires ou inutiles (liste des fichiers a effacer dans la liste @FICHIERS_A_EFFACER)
# - finaliser le fichier rapport de tests en l etat actuel
#
##########################################################################
##########################################################################
##########################################################################
#variable pour connaitre le nom du rapport a finaliser
# 3 possibilites : option -rpt => $NOM_FIC_RAPPORT = "Rapport/rapport_test_debugECHEC.txt"
# tests rapides => $NOM_FIC_RAPPORT = "Rapport/rapport_test_R.txt"
# tests longs => $NOM_FIC_RAPPORT = "Rapport/rapport_test_L.txt"
#
# (rq : quelque soit la procedure en cours, le fichier rapport temporaire sera toujours "Rapport/rapport_test.txt")
#
my $NOM_FIC_RAPPORT;
#liste des fichiers a effacer
my @FICHIERS_A_EFFACER = ($FIC_COMMUNICATION);
#indicateur de test en cours (=0 si pas de test en cours, =1 si test en cours)
my $TEST_EN_COURS = 0;
#subroutine arret_force : - sera appelee pour toute interruption Ctrl-c (signal INT) ou kill -15 (signal TERM)
# - ferme le programme ("exit")
sub arret_force {
#attente de l arret d un eventuel script ./Perl/test.pl en cours
# on attend que le script ./Perl/test.pl ecrive la chaine "FIN_TEST" dans le fichier de communication $FIC_COMMUNICATION
while(-e $FIC_COMMUNICATION and not join(' ', qx(cat $FIC_COMMUNICATION)) =~ /\bFIN_TEST\b/) {select(undef,undef,undef,0.25);}
#creation du fichier rapport final (en l etat actuel)
system("mv -f Rapport/rapport_test.txt $NOM_FIC_RAPPORT");
#on signale a l utilisateur que le fichier de rapport a quand meme ete cree (mais on ne l affiche pas)
warn "\n\n\n\n";
warn " * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n";
warn " * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n";
warn " * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n";
warn "\n";
warn " --------------------------------------------------------------\n";
warn " | ARRET FORCE |\n";
warn " --------------------------------------------------------------\n";
warn " => le rapport de test $NOM_FIC_RAPPORT a \n";
warn " quand meme ete cree\n";
warn "\n";
warn " * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n";
warn " * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n";
warn " * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n";
warn "\n";
#suppression des eventuels fichiers de la liste @FICHIERS_A_EFFACER
system("rm -rf $_") for @FICHIERS_A_EFFACER;
#fin du programme
exit;
}
#capture : Ctrl-c (INT)
$SIG{INT} = \&arret_force;
#capture : kill -15 (TERM)
$SIG{TERM} = \&arret_force;
##########################################################################
##########################################################################
##########################################################################
#
# LANCEMENT DES TESTS
# actuellement 3 options a gerer :
# -R : lancement uniquement des tests rapides
# -L : lancement uniquement des tests longs
# -rpt : lancement uniquement des tests ayant echoue du rapport $opt_rpt_fic_rapport
#
##########################################################################
##########################################################################
##########################################################################
#verification prealable de la presence du repertoire Rapport
# > si existe deja mais est un fichier => arret avec message d erreur
if(-f "./Rapport") {
die "\nErreur (prog:$NOM_PROG) : impossible de creer le repertoire Rapport car il existe deja un fichier de nom Rapport...\n\n";
}
# > si absent => on le cree
mkdir "./Rapport" if(not -e "./Rapport");
#--------------------------------------------------------------------------
# option -rpt => lancement uniquement des tests ayant echoue du rapport $opt_rpt_fic_rapport (et sortie du programme)
#--------------------------------------------------------------------------
my @LISTE_TESTS_ECHEC;
if(defined $opt_rpt_fic_rapport) {
#nom du fichier rapport final : Rapport/rapport_test_debugECHEC.txt
$NOM_FIC_RAPPORT = "Rapport/rapport_test_debugECHEC.txt";
open(FIC, "<$opt_rpt_fic_rapport");
my $is_test_ECHEC;
my $nom_repertoire_test;
while(<FIC>) {
#si c est une ligne finissant par .CVisu[no], alors cette ligne contient un nom de repertoire de test
if(/^\s*(.+).CVisu\d+/) {
$nom_repertoire_test = $1;#on actualise le nom de repertoire de test courant
$is_test_ECHEC = 0;#on reset l indicateur d echec
#petite retouche cosmetique => suppression d eventuels / en fin de nom de repertoire
$nom_repertoire_test =~ s/\/+$//;
}
#si le mot ECHEC est trouve => on enregistre le repertoire (sauf si ca a deja ete fait precedemment)
elsif(/ECHEC/) {
push(@LISTE_TESTS_ECHEC, $nom_repertoire_test);
#si le dernier element et l avant dernier element de la liste @LISTE_TESTS_ECHEC sont identiques, on supprime (pop) le
# dernier element pour eviter d enregistrer plusieurs fois un meme repertoire
pop(@LISTE_TESTS_ECHEC) if($#LISTE_TESTS_ECHEC >= 1 and $LISTE_TESTS_ECHEC[-1] eq $LISTE_TESTS_ECHEC[-2]);
}
}
close(FIC);
##print "$_\n" for @LISTE_TESTS_ECHEC; exit;
#si il n y a aucun test ECHEC dans @LISTE_TESTS_ECHEC => tant mieux! on affiche la bonne nouvelle et on exit
if($#LISTE_TESTS_ECHEC == -1) {
print "\n";
print "Aucun test ECHEC n a ete trouve dans le fichier $opt_rpt_fic_rapport ...\n\n";
print " - arret -\n";
exit;
}
#sinon => lancement des tests
else {
#renommage d un eventuel rapport precedent en _OLD (et la liste des tests associee)
system("mv -f Rapport/rapport_test_debugECHEC.txt Rapport/rapport_test_debugECHEC_OLD.txt");
system("mv -f Rapport/Liste_Tests_debugECHEC.txt Rapport/Liste_Tests_debugECHEC.txt");
#creation du rapport temporaire
system("./Perl/genere_rapport.pl Rapport/rapport_test.txt $exeHZ");
#liste des tests
foreach my $rep_test (@LISTE_TESTS_ECHEC) {
system("echo $rep_test >> Rapport/Liste_Tests_debugECHEC.txt");
}
#lancement des tests (dont le resultat s ecrit dans le rapport temporaire Rapport/rapport_test.txt)
foreach my $rep_test (@LISTE_TESTS_ECHEC) {
system("echo DEBUT_TEST > $FIC_COMMUNICATION");
system("./Perl/test.pl $rep_test $exeHZ $PID");
system("rm -f $FIC_COMMUNICATION");
}
#creation du fichier rapport final
system("mv -f Rapport/rapport_test.txt $NOM_FIC_RAPPORT");
#affichage du rapport
system("nedit $NOM_FIC_RAPPORT \&");
}
}#fin option -rpt
#--------------------
#lancement des tests rapides (sauf en cas d option -L ou -rpt)
#--------------------
unless($is_opt_L or $is_opt_rpt) {
#nom du fichier rapport final : Rapport/rapport_test_R.txt
$NOM_FIC_RAPPORT = "Rapport/rapport_test_R.txt";
#recherche des tests Test_R dans l arborescence (utilisation de find et suppression de chaque retour a la ligne avec chomp)
##
## RAPPEL : le repertoire Tests_en_attente_debug n est pas concerne (on le squizze avec une option "-not -path" dans la recherche find
##
my @LISTE_TESTS_R = map {chomp; $_} qx(find . -not -path "*Tests_en_attente_debug*" -name "Test_R*" -type d);
#si il n y a aucun test dans @LISTE_TESTS_R => on le signale
if($#LISTE_TESTS_R == -1) {
print "\n";
print "Aucun test rapide Test_R n a ete trouve...\n\n";
}
#sinon => lancement des tests
else {
#renommage d un eventuel rapport precedent en _OLD (et la liste des tests associee)
system("mv -f Rapport/rapport_test_R.txt Rapport/rapport_test_R_OLD.txt");
system("mv -f Rapport/Liste_Tests_R.txt Rapport/Liste_Tests_R.txt");
#creation du rapport temporaire
system("./Perl/genere_rapport.pl Rapport/rapport_test.txt $exeHZ");
#liste des tests
foreach my $rep_test (@LISTE_TESTS_R) {
system("echo $rep_test >> Rapport/Liste_Tests_R.txt");
}
#lancement des tests (dont le resultat s ecrit dans le rapport temporaire Rapport/rapport_test.txt)
foreach my $rep_test (@LISTE_TESTS_R) {
system("echo DEBUT_TEST > $FIC_COMMUNICATION");
system("./Perl/test.pl $rep_test $exeHZ $PID");
system("rm -f $FIC_COMMUNICATION");
}
#creation du fichier rapport final
system("mv -f Rapport/rapport_test.txt $NOM_FIC_RAPPORT");
#affichage du rapport
system("nedit $NOM_FIC_RAPPORT \&");
}
}
#--------------------
#lancement des tests longs (sauf en cas d option -R ou -rpt)
#--------------------
unless($is_opt_R or $is_opt_rpt) {
#nom du fichier rapport final : Rapport/rapport_test_L.txt
$NOM_FIC_RAPPORT = "Rapport/rapport_test_L.txt";
#recherche des tests Test_L dans l arborescence (utilisation de find et suppression de chaque retour a la ligne avec chomp)
##
## RAPPEL : le repertoire Tests_en_attente_debug n est pas concerne (on le squizze avec une option "-not -path" dans la recherche find
##
my @LISTE_TESTS_L = map {chomp; $_} qx(find . -not -path "*Tests_en_attente_debug*" -name "Test_L*" -type d);
#si il n y a aucun test dans @LISTE_TESTS_L => on le signale
if($#LISTE_TESTS_L == -1) {
print "\n";
print "Aucun test long Test_L n a ete trouve...\n\n";
}
#sinon => lancement des tests
else {
#renommage d un eventuel rapport precedent en _OLD (et la liste des tests associee)
system("mv -f Rapport/rapport_test_L.txt Rapport/rapport_test_L_OLD.txt");
system("mv -f Rapport/Liste_Tests_L.txt Rapport/Liste_Tests_L.txt");
#creation du rapport temporaire
system("./Perl/genere_rapport.pl Rapport/rapport_test.txt $exeHZ");
#liste des tests
foreach my $rep_test (@LISTE_TESTS_L) {
system("echo $rep_test >> Rapport/Liste_Tests_L.txt");
}
#lancement des tests (dont le resultat s ecrit dans le rapport temporaire Rapport/rapport_test.txt)
foreach my $rep_test (@LISTE_TESTS_L) {
system("echo DEBUT_TEST > $FIC_COMMUNICATION");
system("./Perl/test.pl $rep_test $exeHZ $PID");
system("rm -f $FIC_COMMUNICATION");
}
#creation du fichier rapport final
system("mv -f Rapport/rapport_test.txt $NOM_FIC_RAPPORT");
#affichage du rapport
system("nedit $NOM_FIC_RAPPORT \&");
}
}
##########################################################################
##########################################################################
##########################################################################
#
# SUBROUTINES
#
##########################################################################
##########################################################################
##########################################################################
#####################################################################################################
#subroutine permettant de terminer proprement le script en cas de ctrl-z
#####################################################################################################
sub fin_script {
}
#####################################################################################################
#subroutine permettant d ecrire une ligne de tirets de la largeur du terminal
#####################################################################################################
#
# en entree :
# - print ou warn (suivant que l on souhaite afficher avec print (donc vers STDOUT) ou warn (donc vers STDERR)
#
sub afficher_ligne_tirets {
my $funct_disp = shift;
($funct_disp eq 'print') or ($funct_disp eq 'warn') or die "\nErreur (sub:afficher_ligne_tirets) : l argument d entree doit etre \"print\" ou \"warn\" (argument recu : $funct_disp)...\n\n";
#utilisation de Term::ReadKey pour connaitre la largeur du terminal en nombre de caracteres
# (seulement si la librairie existe. si non, la ligne de tirets aura une largeur de 78)
my $nb_char_largeur_terminal = 78;
if(check_install( module => 'Term::ReadKey')) {
require Term::ReadKey; Term::ReadKey->import(qw(GetTerminalSize));
$nb_char_largeur_terminal = ( GetTerminalSize() )[0];#largeur du terminal en nombre de caracteres (via package Term::ReadKey)
}
my $ligne_tirets = '';
$ligne_tirets .= '-' for(1 .. $nb_char_largeur_terminal);
print "$ligne_tirets\n" if($funct_disp eq 'print');
warn "$ligne_tirets\n" if($funct_disp eq 'warn');
}#sub afficher_ligne_tirets
#####################################################################################################
#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 :
# - chemin absolu de la commande (0 si commande introuvable)
#
sub verif_commande {
my $cmd = shift;#nom de la commande
#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 =~ /^\//) {
#on passe la commande en chemin absolu
$cmd = rel2abs($cmd);
return $cmd;
}
#sinon on regarde dans la variable environnement $PATH
foreach my $path (split(/\s*:\s*/, $ENV{PATH})) {
if(-x "$path/$cmd") {
#on s assure que c est un chemin absolu
$cmd = rel2abs("$path/$cmd");
return $cmd;
}
}
#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;
}
#cas ou la commande est introuvable
return 0;
}#sub verif_commande