#!/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) #--tests rapides (Test_R_) my @rep_tests_existants_R = map {chomp; $_} qx(find . -name "Test_R_*" -type d); #--tests rapides (Test_L_) my @rep_tests_existants_L = map {chomp; $_} qx(find . -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