#!/usr/bin/perl #!/usr/local/bin/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) 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 $fic_rapport;#option -rpt : nom du fichier de rapport a exploiter (non defini par defaut; si utilisation de l option -rpt => lancement uniquement des tests ayant echoue de ce rapport (ECHEC) #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') { ($#ARGV != -1) or die "\nErreur (prog:$NOM_PROG, opt:-rpt) : l option -rpt necessite de specifier un nom de fichier rapport...\n\n"; $fic_rapport = shift(@ARGV); #verif de l existence du fichier rapport (-e $fic_rapport) or die "\nErreur (prog:$NOM_PROG, opt:-rpt) : fichier rapport $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"; ; } #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 VERIF EN LIEN AVEC UNE NOUVELLE OPTION OU UN NOUVEL ARGUMENT #* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #-------------------------------------------------------------------------- # 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 l existence et de la validite du fichier rapport $fic_rapport if(defined $fic_rapport) { #existence (-e $fic_rapport) or die "\nErreur (prog:$NOM_PROG, opt:-rpt) : fichier $fic_rapport introuvable...\n\n"; #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, "<$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 $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 # ########################################################################## ########################################################################## ########################################################################## #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) : la presence d un repertoire de nom Rapport est necessaire mais le repertoire contient 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 $fic_rapport (et sortie du programme) #-------------------------------------------------------------------------- my @LISTE_TESTS_ECHEC; if(defined $fic_rapport) { open(FIC, "<$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); #dans la ligne suivante, on evite 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 $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) 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 &"); } #on arrete le script exit; }#fin option -rpt #-------------------- #lancement des tests rapides (sauf en cas d option -L) #-------------------- unless($is_opt_L) { #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) 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) #-------------------- unless($is_opt_R) { #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) 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 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 { use Term::ReadKey; my $nb_char_largeur_terminal = ( GetTerminalSize() )[0];#largeur du terminal en nombre de caracteres (via package Term::ReadKey) my $funct_disp = shift; 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 aboslu 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