2
0
Fork 0
Verif_Herezh/Perl/verif_existence_repertoire_test.pl

172 lines
7.2 KiB
Perl
Raw Normal View History

#!/usr/bin/env perl
use strict;
use warnings;
use English;
use File::Basename;
my $NOM_PROG = basename $PROGRAM_NAME;
#####################################################################################################
# script pour savoir si il existe deja un repertoire de test d un certain nom
# (utile lorsque l on veut ajouter un test dans la batterie, pour verifier si le nom que
# l on souhaite donner au repertoire existe deja ou non)
#
# IMPORTANT : 1) on considere comme nom d un repertoire de test, uniquement la partie apres Test_R_ ou Test_L_
# par exemple : nom reel du repertoire : Test_R_non_dynamique => nom retenu : non_dynamique
#
# ainsi, par exemple, ce script considerera que les repertoires Test_R_blabla et Test_L_blabla
# ont le meme nom : blabla
#
# 2) les comparaisons sont insensibles a la casse (BlaBla est considere comme egal a blabla)
#####################################################################################################
##########################################################################
##########################################################################
##########################################################################
#
# 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 " script pour savoir si un nom de repertoire de test existe deja\n";
print " quelque part dans l arborescence.\n";
print " 3 cas possibles :\n";
print " - le repertoire existe deja\n";
print " - le repertoire existe mais dans l autre type\n";
print " (Test_R au lieu de Test_L ou inversement)\n";
print " - le repertoire n existe si en Test_R, ni en Test_L\n";
print "\n";
print " Usage : $NOM_PROG nom_rep\n";
print "\n";
print " Argument obligatoire :\n";
print " nom_rep : nom de repertoire (doit commencer par Test_R_ ou Test_L_)\n";
print "\n";
print " Options :\n";
print " aucune...\n";
print "\n";
print " Remarques :\n";
print " 1) le prefixe Test_R_ ou Test_L_ est considere comme faisant\n";
print " partie du nom\n";
print " (exemple : on considere que Test_R_abcdef n est pas egal\n";
print " a Test_L_abcdef)\n";
print " 2) test insensible a la casse\n";
print " (exemple : on considere Test_R_AbCDef egal a Test_R_abcdef)\n";
afficher_ligne_tirets('print');
print "\n";
exit;
}
#nom du repertoire a rechercher
my $nom_rep_propose = shift(@ARGV);
($nom_rep_propose =~ /^(Test_[RL])_/) or die "\nErreur (prog:$NOM_PROG) : repertoire donne en argument doit commencer par Test_R_ ou TesT_L_ ...\n\n";
#type de test (Rapide ou Long) (connu grace a la regexp de la ligne precedente)
my $type_test_propose = $1;
#nom du test sans son type
my ($nom_rep_propose_sans_type) = $nom_rep_propose =~ /^Test_[RL]_+(\S+)/;
#liste des repertoires de test existants (en chemin complet)
##
## RAPPEL : le repertoire Tests_en_attente_debug n est pas concerne (on le squizze avec une option "-not -path" dans la recherche find
##
#--tests rapides (Test_R_)
my @rep_tests_existants_R = map {chomp; $_} qx(find . -not -path "*Tests_en_attente_debug*" -name "Test_R_*" -type d);
#--tests rapides (Test_L_)
my @rep_tests_existants_L = map {chomp; $_} qx(find . -not -path "*Tests_en_attente_debug*" -name "Test_L_*" -type d);
###print "$_\n" for (@rep_tests_existants_R, @rep_tests_existants_L); exit;
#comparaison entre les repertoires @rep_tests_existants et le repertoire propose en argument $nom_rep_propose
foreach my $rep_test_existant (@rep_tests_existants_R, @rep_tests_existants_L) {
#on va tester uniquement le nom du repertoire (et non son chemin complet)
# donc, on ne garde que le basename
my $nom_rep_existant_basename = basename $rep_test_existant;
#recuperation de son type (Rapide ou Long) que l on supprime de la chaine
my ($type_test_existant) = $nom_rep_existant_basename =~ /^(Test_[RL])/;
#nom sans le type
my ($nom_rep_existant_sans_type) = $nom_rep_existant_basename =~ /^Test_[RL]_+(\S+)/;
#-----------------------------------
#comparaison (insensible a la casse)
#-----------------------------------
if($nom_rep_existant_sans_type =~ /^$nom_rep_propose_sans_type$/i) {
# cas 1) meme type de test => le repertoire existe deja => affichage du chemin complet vers le repertoire existant
if($type_test_existant eq $type_test_propose) {
print "\n";
print "Le repertoire $nom_rep_propose existe deja :\n";
print " => $rep_test_existant\n";
print "\n";
exit;
}
# cas 2) pas le meme type de test => le repertoire n existe pas mais existe sous un autre type de test => affichage du chemin complet vers le repertoire existant
else {
print "\n";
print "Le repertoire $nom_rep_propose n existe pas mais existe sous une version $type_test_existant :\n";
print " => $rep_test_existant\n";
print "\n";
exit;
}
}
}#foreach my $rep_test_existant (@rep_tests_existants_R, @rep_tests_existants_L)
#si on arrive ici, c est que le repertoire n existe ni en version Rapide, ni en version Long => affichage de sa non existence
print "\n";
print "Le repertoire $nom_rep_propose n existe pas\n";
print "\n";
##########################################################################
##########################################################################
##########################################################################
#
# 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