2
0
Fork 0
Verif_Herezh/verifier_exeHZ.pl

424 lines
17 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*)?';
##########################################################################
##########################################################################
##########################################################################
#
# 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 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
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
##########################################################################
##########################################################################
##########################################################################
#
# 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) {
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("./Perl/test.pl $rep_test $exeHZ");
}
#creation du fichier rapport final
system("mv -f Rapport/rapport_test.txt Rapport/rapport_test_debugECHEC.txt");
#affichage du rapport
system("nedit Rapport/rapport_test_debugECHEC.txt &");
}
}#fin option -rpt
#--------------------
#lancement des tests rapides (sauf en cas d option -L ou -rpt)
#--------------------
unless($is_opt_L or $is_opt_rpt) {
#recherche des tests Test_R dans l arborescence (utilisation de find et suppression de chaque retour a la ligne avec chomp)
my @LISTE_TESTS_R = map {chomp; $_} qx(find . -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("./Perl/test.pl $rep_test $exeHZ");
}
#creation du fichier rapport final
system("mv -f Rapport/rapport_test.txt Rapport/rapport_test_R.txt");
#affichage du rapport
system("nedit Rapport/rapport_test_R.txt &");
}
}
#--------------------
#lancement des tests longs (sauf en cas d option -R ou -rpt)
#--------------------
unless($is_opt_R or $is_opt_rpt) {
#recherche des tests Test_L dans l arborescence (utilisation de find et suppression de chaque retour a la ligne avec chomp)
my @LISTE_TESTS_L = map {chomp; $_} qx(find . -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("./Perl/test.pl $rep_test $exeHZ");
}
#creation du fichier rapport final
system("mv -f Rapport/rapport_test.txt Rapport/rapport_test_L.txt");
#affichage du rapport
system("nedit Rapport/rapport_test_L.txt &");
}
}
##########################################################################
##########################################################################
##########################################################################
#
# 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