172 lines
7.2 KiB
Perl
Executable file
172 lines
7.2 KiB
Perl
Executable file
#!/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
|