Verif_Herezh/verifier_exeHZ.pl

#!/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