#!/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"; ;#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() {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() { #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