527 lines
22 KiB
Prolog
Executable file
527 lines
22 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 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
|