Verif_Herezh/Perl/verif_existence_repertoire_test.pl

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