#!/usr/bin/perl
# remd: ver2l pour (Vérificateur Et Réparateur De Liens Locaux)    *
# remd:  Répare les liens locaux de votre espace de publication    *
# (rep de pages perso, site) en les testant pour chaque fichier.   *
# Il répare les erreurs d'afféctation, de path (absolu ou relatif) *
# UNIX/M$/LX, les fautes d'extentions, doublons, ortografe, etc... *
# Vérif des encres et ré-attribution du 1er flag ou création (-c)  *
# d'une encre #_top (si page existe sans flag). Corrige les fautes *
# d'orthographes et les path erronés.                              *
# Vers:1.0| 08.2010  alain Adelmar Pessac aadelmar@free.fr         *
#      -------------------------------------------------------     *
# (v: Version Especiale Remaniée De Luxe (Lx - M$) Alain Adelmar ) *
# remd: autonome n'utilise que les modules standards  (facultatif) *
#------------------------------------------------------------------*
# usage:  ver2l [-cu] [rep_source]                                 *
#-----------------------------------                               *
# options:                                                         *
# -c (complet) effectuera des tests, logs et pré-réparation style  *
#              marquer d'un tag "top" les pages html pas marquées  *
# -g (gros site) prévoi une sauvegarde du travail pour le passer en*
#             plusieurs fois                                       *
# -u (update) insére la date de mise à jour, en gardant l'original *
#             en commantaire, répare les liens.                    *
# -l (light) essai de reparer par lui meme et tri avant de proposer*
#            a l'utilisateur. (peu simplifier le travail)          *
# -s (silencieux) reparre les liens sans intervention de user, fait*
#             un rapport pour ce qu'il n'a pas réparrer.           *
#------------------------------------------------------------------*
# (script Perl pour environement M$ et UNIX-LIKE)                  *
# créé par alain Adelmar (2002-2010) à Pessac 6 rue de Tunis 33600 *
#*******************************************************************
# $ID$: 
# - Excellent conçu pour les gros site (>1000 pages)               *
# version utf8- encore beaucoup de controle.
#  AAAA-pour Alain Adelmar Alias Asynchrone et Alright- AhAhAhAh!

my $script = "ver2l";
my $vers = "1.0.b  ";
#$Author: alain $:"Adelmar Alain";
my $moi = 'Adelmar Alain <aadelmar@numericable.fr>||';

use strict;
use File::Copy;
use warnings;

use Cwd;
my $dir = cwd;
print "dir vaut :$dir\n";

use locale;

# initialisation des variables utiles --------------------------------------------------------
# date et heure Fr pour maintenant et stat(file)---------------
my $fr_date_now = my $french_date_now = &maintenant;   # utiliser par soucis de compatibilité
my $fr_dt_file = my $fr_date_file = "";
# print "date/heure: " . &maintenant . "\n";
print "date/heure: $french_date_now\n";
my @tmpstat = "";
my $datenum = 0;
my $mode = 8;		# num representant date de dernier acces, 9 modif, 10 change
my $format_d = 0;
my $file = $0;
# a saquer quand ok
print "file vaut $file\n\n";
$fr_date_file = datefinefile($file, $mode, $format_d);
#---------------------------------------------------------------
# cartouche: var diverses presentation et autre
my $lx = "*-" x 25;
my $x_down = "|" . ("*-" x 24) . "||";                      # fioritures qui soulignes
my $y = "__-__*" x 10;                               # idem pour différencier
my $al = "|      === A_l_a_i_n -\/\/- A_d_e_l_m_a_r ===      ||";    # pub perso
my $head_lbl= "script $0\nécris by $moi\nle $fr_date_file\nexecuter le $french_date_now\n";
my $head_lbl_console = "$lx\nscript:      $0\nle $fr_date_file\nécris par:  $moi\n" .
  "executer le: $french_date_now\n$lx\n";
my $lblo = "\n\tCe script $script va controler et réparer les liens locaux de chaque page HTML\n\tSans pour cela toucher à votre dossier de page-perso\n\til placera l integralite de son travail dans le repertoire courant\n\tdans un dossier nommer:\.\/newsite\n";

print "$x_down\n$al\n$x_down\n$head_lbl$x_down$lblo\n";
my $argv = "";	# argument passer à la ligne de commande
our $rootd = "";	# nom du rep source sans path (pour rec)
my $rootfile_file = "";	# racine du nom de fichier à ouvrir
my $o_ext = "";		# extention du fichier à ouvrir
my @adressemail = "";	# liste d'adresses (login@fai)
my @contenu = "";	# contenu du fichier source lu
my @cop = "";		# contenu des lignes du fichier dans reconstruire_ligne
my @copim = "";		# var liste contenant le texte d'un fichier dans recup_all_tags
my @files = "";		# var liste contenant les nom de fichier de /newsite/tmp
my @h_fst = "";		# liste des fichier meta faite dans traite_d
my @ligne = "";		# bout de ligne éclater reconstruite dans reconstruction_ligne
my @lines = "";		# liste des lignes du fichier dans recup_all_tags pour reconstruction_ligne
my @lnk_ftp = "";	# liste des liens ftp
my @lnk_http = "";	# liste des liens http
my @ls_encre_pf = "";	# liste des encre précédé d'une diéze #
my @ls_ext = "";	# liste faite d'extention tmp dans CB4f
my @ls_h_fst = "";	# liste du nom des fichiers
my @ls_file_meta = "";	# liste du nom des fichiers meta
my @ls_m = "";		# liste de (motif/liens) trouvé par ligne (dans controle_file)
my @ls_other_file = "";	# liste du nom des fichiers autre que meta
my @ls_tencre = "";	# liste des liens possible, file#encre, #encre, file (sans doublon)
my @lsfile = "";	# liste du nom des fichiers
my @nwcontenu = "";	#
my @nwlines = "";	# liste contenu de reconstruire_ligne qui est @nwcop (a vrai dire)
my @nwcop = "";		# liste du contenu des lignes passé a reconstruire_balise
my @nwl = "";		#
my @nwlsfile = "";	# liste des noms de fichier faite dans traite_d utiliser pour recup_all_tags
my @pathf = "";		# 
my @pathl = "";		# liste éclaté du path dans degage_path
my @recv = "";		# liste des fichier d'enregistrement
my @rep = "";		# liste de fichier meta déjà traiter
my @sav = "";		# contenu du fichier de sauvegarde REC
my @tr_encre_pf = "";	# liste de choix a presenter a user dans CB4c
my @val = "";		# liste reprise dans boucle choix des valeurs d'un hashage contenant des liens
my %h_fst;		# hachage de nom de fichier seul
my %h_lnkftp;		# hachage de liens ftp trouvés
my %h_lnkhttp;		# hachage de liens http (exterieur)
my %h_rootf;		# hachage de racine de nom de fichier trouvés
my %h_tag;		# hachage d'encre trouvés
my %h_tencre;		# hachage de nom de fichier plus encre (foo.txt#top) trouvés
my %tmpo;		# hashage temporaire monter pour oter les doublons
my %pf;			# hachage constitué avec la liste @tr_encre_pf pour choix CB4c
my $a = "";		# 1er colonne de choix (lien+ numero)
my $b = "";		# 2eme colonne de choix (lien+ numero)
my $body = "";		# compteur incrémente @copim avec $lpp
my $cf = 0;		# compteur de fichiers golobal
my $ch_ext = "";	# var fabriquer avec le %h_rootf fait de $i:$ext
my $contenu = "";	# contenu du fichier dans reconstruire ligne
my $copie = "";		# nom complet de fichier dans /newsite/tmp/file
my $corrompu = 0;	# booléen dans chklnk => control_file
my $countpfl = 0;	# compteur lignes par fichier
my $countpl = 0;	# compteur de lignes
my $d = "";		# premier argument qui doit être le path du repertoire source
my $e = "";		# caractere $_ dans reconstruire_ligne
my $ef = 0;		# compteur erreur adressage
my $el = "";		# element d'une liste @ls _tencre
my $email = "";		# mon email
my $encre_tmp = "";	# encre de $val ($h_tencre[$foo])
my $encre_vue = 0;	# compteur d'encre vue
my $encru = "";		# reponse d'un utilisateur <STDIN> pour une recherche encre
my $ere = 0;		# compteur d'erreur bidon
my $err = "";		# format pour comptabiliser ligne erreur
my $ext = "";		# var scalaire contenant l'extention d'un fichier
my $ext_tmp = "";	# var contenant une extention temporaire dans CB4f
my $fai = "";		# var fournisseur acces internet comme login
my $fcible = "";	# nom complet de fichier traité /newsite/file
my $fichiercible = "";	# nom complet de fichier a traité traite_d /newsite/tmp/file
my $fichiersource = "";	# nom complet de fichiersource a traité dans traite_d /$d/file
$file = "";		# nom du fichier avec path dans recup_all_tags et nom du fichier
my $file_cr = "";	# nom complet pour log FRAP /newsite/tmp/frap_12.log
my $filesrc = "";	# nom complet avec path des fichiers passant à control_file
my $filos = "";		# var scalaire contenant @rep avec des \n entre chaque enrg
my $fpointe = "";	# path avant le nom de fichier (racine de path)
my $ftagsrc = "";	# nom complet du fichier à traiter dans recup_all_tags
my $fz = "";		# var contenant file#encre dans cherche_encre
my $gnus = 0;		# var initialisant $slash par @gnup
my $hdl_file = "";	# var scalaire contenant handle de fichier pour &ouvre_file
my $ht = "";		# nom de fichier recup_all_tags
my $htag = "";		# var contenant l'encre de %h_tag
my $i = 0;		# incrementation dans choix
my $i_h_fst = 0;	# element d'incrementation pour création %h_fst dans recup_all_tags
my $i_h_tag = 0;	# element d'incrementation pour création %h_tag dans recup_all_tags
my $i_h_tencre = 0;	# element d'incrementation pour création %h_tencre dans recup_all_tags
my $ir = 0;		# compteur pour incrementer fichier log (FRAP)
my $j = 0;		# numéro unique du lien
my $k = 0;		# compteur de liens tronqués
my $kefli = "";		# miroir de $likef dans recup_all_tags
my $key = "";		# key du hash %h_tencre
my $kf = 0;		# nombre de meta fichier traités
my $kk = "";		# var fourre tout pour disocier un lien
my $lastrec = "";	# nom du dernier enregistrement
my $likef = "";		# represente le fichier file au debut de recup_all_tags (sans path)
my $line = "";		# represente la ligne etudier controle_file, chklnk
my $lknet_tmp = "";	# racine de $val ($h_tencre[$foo])
my $lnkftp = "";	# liebs ftp trouvé
my $lnkhttp = "";	# liebs http trouvé
my $login = "";		# login trouvé poussé dans @adressemail
my $lpp = 0;		# compteur incrémente @copim
my $lu = "";		# element de @nwlines ou @nwcop dans recup_all_tags
my $max = 40;		# max = 40
my $n = 0;		# compteur servant a donner un numero a newsite
my $na =  0;		# compteur dans choix affichant la selection a
my $nb = 0;		# compteur dans choix affichant la selection b
my $newsite = "";	# path donner par faitmoitmp qui contiendra les feuilles corigées /newsite
my $nltt = 0;		# nombre de ligne lu dans reconstruit ligne
my $nws = "";		# var contenant l'adresse du newsite
my $oldlb = "";		# var contenant le premier lnkbrut non souillé conrole_file
my $ouvert = 0;		# booleen dans reconstruire_ligne
my $pa = 0;		# pour datefinefile pa => petite année sur 3chiffre
my $pair = 0;		# compteur de paire dans utilisateur_n
my $path_newsite = "";	# path donner par faitmoitmp qui contiendra les feuilles corigées /newsite/
my $path_tmp = "";	# path donner par faitmoitmp qui contiendra les log /newsite/tmp
my $point = "";		# reponse utilisateur (STDIN) a voulez vous traiter ./foo dans traite_d
my $prlnkftp = "";	# format d'adresse de liens ftp
my $prlnkhttp = "";	# format d'adresse de liens http
my $q = 0;		# compteur dans une boucle de choix de liens
my $repu = "";		# reponse utilisateur <STDIN> a &regarder
my $resp = "";		# STDIN pour un choix CB4f
my $rl = "";		# var representant un lien dans choix CB4c
my $rootf = "";		# racine de nom de fichier sans ext de %h_fst
my $rootfile = "";	# partie racine du nom de fichier (sans path, sans extention)
my $sous_rep = "";	# nom de rep reconnu dans liste de file dans traite_d
my $srep = "";		# nom d'un éventuel sous-repertoire dans $d (source)
my $tag = "";		# encre trouvé dans cherche_encre
my $tmp = "";		# path du rep temporaire /newsite/tmp (sans slash)
my $tmpflg = "";	# fichier de sauvegarde de la dernière sauvegarde copier ou renomer en recap_ver2l_$rootd_$i.log
my $tout = "";		# contenu d'un fichier de @lines scalarisé en $tout pour reconstruire
my $troncfile = "";	# racine de nom de fichier dans onyva moins ext
my $tronquage = 0;	# booleen dans reconstruire
my $tz = 0;		# comptage d'encre trouvé
my $u = 0;		# comptage dans indice choix
my $v = 0;		# comptage de controle effectué sur des liens bon ou mauvais
my $val = "";		# values de %h_tencre fin de recup_all_tags
my $value = "";		# vazr scalaire represente un choix, un lien possible
my $z = 0;		# compteur de fichiers passé à &faitdcopies
my $zo = 0;		# compteur de file dans %h_fst

# pour l'adressage/les systeme UNIX, Linux, cygwin ou autre (/) et ceux de M$ (\)-------------
my @gnul = ( "\\", "\/");   #pas mal because $slash sera toujours bon, je suis trop fort
if ($dir =~ /^\//) {
    $gnus++;
}
our $slash = $gnul[$gnus];
#---------------------------------------------------------------------------------------------

# -----------traitement arguments - dossier a traiter et verification $d valide----------- debut
if (@ARGV) {
  if ($ARGV[0] =~ /^-/) {
    $ARGV[0] =~ s/-()/($1)/;
    ($argv = "c") if ($ARGV[0]=~ /^c/);   # pour complet
    ($argv = "g") if ($ARGV[0]=~ /^g/);   # pour gros site ou paquets de feuilles
    ($argv = "u") if ($ARGV[0]=~ /^u/);   # pour update
    ($argv = "l") if ($ARGV[0]=~ /^l/);   # pour light
    ($argv = "o") if ($ARGV[0]=~ /^o/);   # pour ortographe
    if ($ARGV[1] ne "") {
      $d = $ARGV[1];
      $srep = $ARGV[2];
      &verifd;
    }
  }
  else {
    $d = $ARGV[0];
    $srep = $ARGV[1];
    &verifd;
  }
}
else {
  print "usage: $script [-cou] [dossier_a_traiter] [sous-dossier_image]\n(made by $moi\n";
  #---------demander quel repertoire traiter et verifier si il existe
  print "$lx\n";
  print "Indiquez le dossier a traiter:\n";
  chomp($d =<STDIN>);
  &verifd;
}
#---------------------------------------------------------------------------------------------- fin

#----------------- ouverture pour sortie formatée de l'affichage fichiers/tags ----------------- ok
format STDOUT_TOP =
Page @<<
$%

 n        lien                    	         n      		lien
=== ===============================             === ==============================
.

#---------------------------------------------------------------------------------------------------

#--------si rec existe que voulez vous faire-------------------------------------------
#--ouvre $dir et regarde les versions de recap_ver2l
opendir DC, "$dir" or die "Ouverture de $dir impossible $!";
my @herefiles = (sort readdir DC);
closedir DC || die "Fermeture de $dir impossible (putain de merde) $!";
foreach (@herefiles) {
  next if /~$/;
  (push @recv, $_) if /recap_ver2l_$rootd.+\d?\.pl/;
  }
@recv = sort(@recv);
$lastrec = pop @recv;
print "dernier enregistrement connu: $lastrec\n";
#my $flg = "recap_ver2l_" . "$rootd" . ".pl";
my $flg = $lastrec;
if (-e $flg) {
  $mode = 9;
  print "voulez vous continuer le travail commencer le " . datefinefile($flg, $mode, $format_d) . ": [o,n] (o)\n";
  chomp(my $reponse = <STDIN>);
  if($reponse =~ /^n/i) {
    $tmpflg = "recap_ver2l_$rootd.log";
    #rename $flg,$tmpflg || die "impossible de détruire $flg, faite le à la main $!"; #rename nom puisque num sauve
    copy($flg, $tmpflg) || die "impossible de détruire $flg, faite le à la main $!";
    print "le fichier de sauvegarde $flg en $tmpflg\n";
    &openrec($flg);
    &premier_passage;
    }
  elsif ($reponse =~ /^recap_ver2l/) {
    unless (-e $reponse) {
      print "choisissez dans la liste ci-dessous:\n";
      foreach (@recv) {
	print "$_\n";
	}
      chomp(my $reponse = <STDIN>);
      }

    open REC, "$reponse" or die "ouverture de $flg impossible $!";
    @sav = <REC>;
    close REC || die "Fermeture de $flg impossible $!";
    # poursuite du chargement des variables
    }
  else {
    open REC, "$flg" or die "ouverture de $flg impossible $!";
    @sav = <REC>;
    close REC || die "Fermeture de $flg impossible $!";
    # poursuite du chargement des variables
    }
  }
else {
  &openrec($flg);
  &premier_passage;
  }
#-----------------------------------------------------------------------------------------

#-----ouverture de recap_ver2l (fichier sauvegarde de travail) si inexistant -----------------------
sub openrec {
  my ($flg)= @_;
  
  $rootfile_file = "recap_ver2l_$rootd";
  #print "dans openrec rootfile_file vaut $rootfile_file\n";
  $hdl_file = "REC";
  $o_ext = "pl"; 
  &ouvre_rec($rootfile_file, $hdl_file, $o_ext);
  }
#---------------------------------------------------------------------------------------------------

sub premier_passage {
  #-----ouverture de vrl (fichier log)
  $rootfile_file = "vrl";
  $hdl_file = "VRL";
  $o_ext = "log";
  &ouvre_file($rootfile_file, $hdl_file, $o_ext);
  
  #création et ouverture d'un rep temporaire pour placer le nouveau site -------------- debut
  $newsite = "$dir$slash" . "newsite";
  print "le newsite sera adresser comme : $newsite\n";
  &faitmoitmp;   #johnny, johnny
  # $path_tmp = "$tmp" . "$slash";  # cette ligne existe deja dans &faitmoitmp
  print "$lx$lx\n";
  &traite_d;
  &recup_all_tags;
}

# passe en revue page/page, ligne/ligne, $lien/lien les copie crées dans $path_tmp
opendir RC, "$path_tmp" or die "Ouverture de $path_tmp impossible $!";
@files = (sort readdir RC);
closedir RC || die "Fermeture de $path_tmp impossible (putain de merde) $!";




# donne la date et l'heure en Fr--------------------------------------------------------------------------
sub maintenant {
  #------date et temps en Français et numerique pour maintenant et pour dater les fichiers
  (my $sec,my $min,my $heure,my $mjour,my $mois,my $annee,my $sjour,my $ajour,my $isdst) =  localtime(time);
  my @lssjour = qw( Dim Lun Mar Mer Jeu Ven Sam);
  my @lssmois = qw ( Janvier Fevrier Mars Avril Mai Juin Juillet Aout Septembre Octobre Novembre Decembre );
  # mettre le format que vous désirez ici
  my $french_date_now = "$lssjour[$sjour] $mjour $lssmois[$mois] " . ($annee+=1900) . " - $heure:$min:$sec";
  return $french_date_now;
}
#---------------------------------------------------------------------------------------------------------

# donne la date et heure sous plusieurs format Français et numerique--------------------------------------
sub datefinefile {
  my ($file, $mode, $format_d)= @_;
  
  my $datenum = ((stat($file))[$mode]);
  (my $sec,my $min,my $heure,my $mjour,my $mois,my $annee,my $sjour,my $ajour,my $isdst) =  localtime($datenum);
  my @lssjour = qw( Dim Lun Mar Mer Jeu Ven Sam);
  my @lssmois = qw ( Janvier Fevrier Mars Avril Mai Juin Juillet Aout Septembre Octobre Novembre Decembre );
  my $pa = "";
  if ($mois <= 9) {
    $mois= "0" . ($mois+1);
  }
  if ($mjour <= 9) {
    $mjour = "0" . "$mjour";
  }
  if ($heure <= 9) {
    $heure = "0" . "$heure";
  }
  if ($min <= 9) {
    $min = "0" . "$min";
  }
  if ($sec <= 9) {
    $sec = "0" . "$sec";
  }
  my $cj = $lssjour[$sjour];
  my $pj = substr($cj, 0, 2);
  my $pm = substr("$lssmois[$mois]", 0 , 3);
  if ($annee < 100) {
    my $pa = $annee;
  }
  elsif ($annee <=109) {
    my $pa = "0" . ($annee-100);
  }
  else {
    my $pa = ($annee-100);
  }
  if ($format_d == 1) {
    # format differants 1: 20100131-203001 
    $fr_date_file = ($annee+=1900) . "$mois$mjour-$heure$min$sec";
  }
  elsif ($format_d == 2) {
    # format differants 2: 31/01/2010-20:30
    $fr_date_file = "$mjour\/$mois\/" . ($annee+=1900) . "-$heure:$min";
  }
  elsif ($format_d == 3) {
    # format differants 2:  Di-31/01/2010-20:30:02
    $fr_date_file = "$pj-$mjour\/$mois\/" . ($annee+=1900) . "-$heure:$min:$sec";
  }
  elsif ($format_d == 4) {
    # format differants: $fr_dt_file = 31Jan10-20h
    $fr_date_file = "$mjour$pm" . "$pa" . "-$heure" . "h";
  }
  elsif ($format_d == 5) {
    # format differants: $fr_dt_file = Di 31 Jan 10 - 20h30
    $fr_date_file = "$pj $mjour $pm" . " $pa" . "- $heure" . "h$min";
  }
  else {
    # format differants: $fr_date_file = Dim 31 Janvier 2010 - 20:30:02
    $fr_date_file = "$lssjour[$sjour] $mjour $lssmois[$mois] " . ($annee+=1900) . " - $heure:$min:$sec";
  }
  return $fr_date_file;
}
#---------------------------------------------------------------------------------------------------------

#--------------------verifd---ou----verification de l'exsitence du rep source-------------------------
sub verifd {
  
  until (-e $d) {
    print "Veuillez ré-entrer le chemin complet du dossier à traiter, expl:" . 
	'/home/pub/monsite ou //perl//pub//toto' . "\n";
    chomp($d = <STDIN>);
  }
  if ($d =~ /^\./) {
    $d =~ s/^\.//;
    print "dmoins vaut: $d\n";
    $d = "$dir$d";
    print "d vaut: $d\n";
    # recherche de rootd
    my @pathl = split(/$slash/, $d);
    my $fpointe = pop @pathl;
    $rootd = $fpointe;
    # a saquer quand ok
    print "verifd:rootd = $rootd\n";
  }
  elsif($d =~ /^$slash/) {
    my @pathl = split(/$slash/, $d);
    my $fpointe = pop @pathl;
    $rootd = $fpointe;
    # a saquer quand ok
    print "verifd:rootd = $rootd\n";
  }
  else {
    $rootd = $d;
    print "verifd:rootd = $rootd\n";
  }
}
#-----------------------------------------------------------------------------------------------------

#-------------------------------------ouvre_rec ---------------------------------------- 
sub ouvre_rec {
  my ($rootfile_file, $hdl_file, $ext)= @_;
  
  my $i = 0;
  #-----------creation d'un fichier d'enregistrement ----------
  if ($rootfile_file =~ /^recap_ver2l_$rootd/) {
    $flg = "$dir$slash$rootfile_file" . ".$ext";
    
    
    while (-e $flg) {
      $flg = "$dir$slash$rootfile_file" . "_$i" . ".$ext";
      $i++;
    }
  }
  #-------------------------------------------------------------
  no strict 'refs';
  my $handle = \$hdl_file;
  open $$handle, ">$flg" or die "Ouverture de $flg impossible $!";
  
  print "script: $script (V: $vers) - date: $fr_date_now\n$lx\n";
}
#-------------------------------------------------------------------------------------------------------


#-------------------------------------ouvre_file ou log ---------------------------------------- géant
sub ouvre_file {
  my ($rootfile_file, $hdl_file, $ext)= @_;
  
  my $i = 0;
  #-----------creation d'un fichier d'enregistrement ----------
  if ($rootfile_file =~ /^recap_ver2l_/) {
    $flg = "$dir$slash$rootfile_file" . "_$rootd.$ext";
    
    while (-e $flg) {
      $flg = "$dir$slash$rootfile_file" . "_$rootf" . "_$i" . ".$ext";
      $i++;
    }
  }
  #-------------------------------------------------------------
  
  if ($path_tmp eq "") {
    $path_tmp = $dir;
  }
  $flg = "$path_tmp$slash$rootfile_file.$ext";
  
  while (-e $flg) {
    $flg = "$path_tmp$slash$rootfile_file" . "_$i" . ".$ext";
    $i++;
  }
  no strict 'refs';
  my $handle = \$hdl_file;
  open $$handle, ">$flg" or die "Ouverture de $flg impossible $!";
  print REC '#!/usr/bin/perl' . "\n";
  print REC "\n" . 'use strict;' . "\n" . 'use warnings;' . "\n";
  print REC "\n" . 'our $slash = "' . "$slash" . '";' . "\n";
  #close REC || die "fermeture de REC impossible $!";
  print $hdl_file "script: $script (V: $vers) - date: $fr_date_now\n$lx\n";
}
#-------------------------------------------------------------------------------------------------------

#---------- choix et creation du repertoire temporaire-------------------------------------------------\
sub faitmoitmp {
  my $n = 0;
  if (-e $newsite) {
    while (-e $newsite) {
      $n++;
      $newsite = "$dir$slash" . "newsite" . "_$n";
    }
    mkdir $newsite or die "ouverture de $newsite impossible $!";
    # initialiser les variables pour la sauvegarde dans rec
    print REC 'my $newsite = "' . "$newsite" . '";' . "\n";
  }
  else {
    mkdir $newsite or die "ouverture de $newsite impossible $!";
  }
  $tmp = "$newsite$slash" . "tmp";
  mkdir $tmp or die "création de $tmp impossible $!";
  $path_tmp = "$tmp$slash";
  $path_newsite = "$newsite$slash";
  
  # ca ne veut rien dire si $srep est du style /home/pub/image ca marchera pas
  if (defined $srep) {
    if ($srep =~ /\w$/i) {
      $srep = "$path_newsite" . "$srep";
      mkdir $srep or die "ouverture de $srep impossible $!";
    }
  }
  
  # initialiser les variables pour la sauvegarde dans rec
#  print REC 'my $newsite = "$dir$slash" . "newsite_$n";' . "\n";
  print REC 'my $tmp = "$newsite$slash" . "tmp";' . "\n";
  print REC 'my $path_tmp = "$tmp$slash";' . "\n";
  print REC 'my $path_newsite = "$newsite$slash";' . "\n";
  #  je laisse la place pour s-rep mais ...
  
  print "Un dossier newsite contiendra vos pages corrigées\net $slash" . 
      "newsite$slash" . "tmp contiendra les logs de synthése\n";
}
#-------------------------------------------------------------------------------------------------------

#---traite le repertoire source ($d)------------------------------------------------------------------------
sub traite_d {
  #-----------ouverture lecture, assignation @lsfile, controle srep != sous_rep
  opendir R, "$d" or die "Ouverture de $d impossible $!";
  @lsfile = (sort readdir R);
  closedir R or die "Fermeture du repertoire R impossible $!";
  foreach $file(@lsfile) {
    
    if ($file =~ /^\./) {
      print "voulez vous traiter ce fichier [o,n](n): $file\n";
      chomp ($point = <STDIN>);
      if($point =~ /^o/i) {
	push @ls_other_file, $fichiercible;
	}
      }
    # vérifier si un rep est $srep (donc juste rep_rootname ou plus bas) et le traiter à la place de &faitmoitmp
    if (-d "$d$slash$file") {
      $sous_rep = $file;
      # vérifier si un rep est $srep (donc sous la forme /home/pub/foo/bar)et le traiter à la place de &faitmoitmp
      #demander a user si on traite $sous-rep
      }
    else {
      my $fichiersource = "$d$slash$file";
      #print "$lx\navant copy fichiersource vaut $fichiersource\n";
      my $fichiercible = "$path_tmp$file";
      #print "$lx\napres copy fichiercible vaut $fichiercible\n";
      if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {
	push @h_fst, $file;
	push @ls_file_meta, $fichiercible;
	copy($fichiersource, $fichiercible) or die "impossibilité de copier $fichiersource sur $fichiercible $!";
      }
      else {
	push @h_fst, $file;
	my $fichiercible = "$path_newsite$likef";
	push @ls_other_file, $fichiercible;
	copy($fichiersource, $fichiercible) or die "impossibilité de copier $fichiersource sur $fichiercible $!";
      }
      #copy($fichiersource, $fichiercible) or die "impossibilité de copier $fichiersource sur $fichiercible $!";
      # exec dos2unix "$d$slash$likef"; # voir si ca marche
      push @nwlsfile, $file;
    }
  }
  # rend compte sur VRL
  print VRL "\n$lx\nliste des fichiers meta que recup_all recopiera dans $path_tmp\n";
  foreach (@ls_file_meta) {
    print VRL "$_\n";
  }
  print VRL "\n$lx\nliste des autre fichiers que recopier dans $path_newsite\n";
  foreach (@ls_other_file) {
    print VRL "$_\n";
  }
  print VRL "\n$lx\n";
}
#-------------------------------------------------------------------------------------------------------------

#-----------------------------Recup_all_tags-------------------------------------- debut
sub recup_all_tags {
  # --le handle est pour RAP
  
  foreach $likef(@nwlsfile) {
    $cf++;     #compteur de fichiers
    (next and print "fichier vide degager\n") if "";
    (next and print "fichier $likef degager\n") if ($likef=~ /^\./);
    $kefli = $likef;
    $file = "$d$slash$likef";
    $encre_vue = 0;
    # re-ajouter le path au nom de fichier
    $ftagsrc = "$path_tmp$slash$likef";
    # vérif mode (html, tml, htm, xml, etc..)
    if ($likef =~ /\.{1}s?h?x?t?m{1}l?$/i) {
      if($likef =~ /~$/) {
	print "voulez vous traiter ce fichier $file qui est un fichier de sauvegarde ?[o,n](n)\n";
	chomp(my $reponse = <STDIN>);
	next if ($reponse =~ /^n/i);
      }
      $mode = 9;
      $fr_date_file = datefinefile($file, $mode, $format_d);
      (push @ls_h_fst, $likef) unless ( scalar(grep(/$likef/, @ls_h_fst)) );
      (push @ls_tencre, $likef) unless ( scalar(grep(/$likef/, @ls_tencre)) );
      @lines = @nwlines = "";
      open FT, "$ftagsrc" or die "Ouverture du fichier $file impossible $!";
     # binmode(FT);
      $lpp = 0;
      @lines = <FT>;
      close FT || die "Fermeture impossible $!";
      # reconstruit les balises tronquées et sort sur @nwlines
      @nwlines = &reconstruire_ligne(@lines);
      
      foreach $lu(@nwlines) {
        if ($lu =~ /<body\>/i) {
          $body = $lpp;
	  # discutable si &cherche_encre pas $tz++ et vice versa
          &cherche_encre($lu);
	  $tz++;
          push @copim, $lu;
	  $lpp++;
	}
        else {
          &cherche_encre($lu);
          push @copim, $lu;
	  $lpp++;
	}
      }
      # tout ce qui suit est faut jusqu'a &faitdcopies, mais pas grave car ne peut etre utiliser - a saquer
      if ($encre_vue == 0) {
	# si argv = c
	if ($argv eq "c") {
	  # $copim[$body].= "<a name=\"_top\"\>\n"; # je ne comprend pas cette ligne surement une erreur
	  $copim[$body] = "<a name=\"_top\"\>\n";
	  print VRL "pour voir body trouvé\n$copim[$body]\n";
	}
	else {
          # ce else est à degagez quand testé
          print VRL "pour voir body trouvé\n$copim[$body]\n";
	}
      }
      if ($argv eq "u") {
	$mode = 8;
        $copim[$body] .= "\n<-- mise à jour du document par $script le $fr_date_now \ninitialement daté du " . datefinefile($file, $mode, $format_d) . "\n";
        print VRL "pour voir body trouvé\n$copim[$body]\n";
      }
      print "\nfile $file et likef $likef \n";
      &faitdcopies($kefli);
      @copim = "";
      @nwlines = "";
      # detail des encres trouvées par fichiers
      print VRL "\npour $likef $encre_vue encre trouvé\/s\nDétail:\n";
      
    }
    else {
      # on ne sait jamais peut etre un lien fait reference à un script donc
      # attention 
      (print "ok pour ls_h_fst $likef\n" and push @ls_h_fst, $likef) unless ( scalar(grep(/$likef/, @ls_h_fst)) );
      (print "ok pour ls_tencre: $likef\n" and push @ls_tencre, $likef) unless ( scalar(grep(/$likef/, @ls_tencre)) );
    }
  }
  
  
  #---passage de la liste contenant tous les liens @ls_tencre au tableau de hashage %h_tencre
  # ote les doublons
  $i = 0;
  foreach $el (@ls_tencre) {
    next if ($el eq "");
    $tmpo{$el} = $i++;
  }
  @ls_tencre = keys %tmpo;
  @ls_tencre = sort(@ls_tencre);
  #--recopiage de @ls_tencre dans rec-------------
  print REC "\n" . 'our @ls_tencre = qw(' . "\n";
  foreach (@ls_tencre) {
    $h_tencre{$i_h_tencre} = $_;
    $i_h_tencre++;
    print REC "\t$_\n";
  }
  print REC '};' . "\n\n";
  print REC 'foreach (@ls_tencre) {' . "\n\t" . 
    '$h_tencre{$i_h_tencre} = $_;' . "\n\t" . 
    '$i_h_tencre++;' . "\n\t" . 
    '}' . "\n";
  #--- idem pour les encres seules------------------
  @ls_encre_pf = sort(@ls_encre_pf);
  #--recopiage de @ls_encre_pf dans rec-------------
  print REC "\n" . 'our @ls_encre_pf = qw(' . "\n";
  foreach (@ls_encre_pf) {
    $h_tag{$i_h_tag} = $_;
    $i_h_tag++;
    print REC "\t$_\n";
  }
  print REC ');' . "\n\n";
  print REC 'foreach (@ls_encre_pf) {' . "\n\t" . 
    '$h_tag{$i_h_tag} = $_;' . "\n\t" .
    '$i_h_tag++;' . "\n\t" .
    '}' . "\n";
  #-----------------------------------------------
  #--- idem pour les fichiers seul--------------------
  #--recopiage de @ls_h_fst dans rec-------------
  print REC "\n" . 'our @ls_h_fst = qw(' . "\n";
  foreach (@ls_h_fst) {
    $h_fst{$i_h_fst} = $_;
    $i_h_fst++;
    print REC "\t$_\n";
  }
  print REC "};\n\n";
  print REC 'foreach (@ls_h_fst) {' . "\n\t" .  
    '$h_fst{$i_h_fst} = $_;' . "\n\t" . 
    '$i_h_fst++;' . "\n\t" .
    '}' . "\n";
  #-----------------------------------------------
  @ls_h_fst = sort(@ls_h_fst);
  #----------a degager quand pris en compte---voici les trois hachage
  print VRL "\n$lx\nvoici les trois hachage:\n$lx\nh_tencre\n";
  
  foreach $key (sort keys %h_tencre) {
    $val = $h_tencre{$key};
    print VRL "\t$val\n";
  }
  print VRL "\n$lx\nh_fst\n";
  my $i= 0;
  while ((my $zo, my $ht) = each %h_fst) {
    print "$lx\navant le split zo vaut $zo et ht vaut $ht\n";
    ($rootf, $ext)= split(/\./, $ht);
    print "rootf vaut $rootf et ext vaut $ext\n";
    $h_rootf{$i, $ext}= $rootf;
    $i++;
    print VRL "\t$zo:$ht\n";
  }
  
  print REC 'while (($zo, $ht) = each %h_fst) {' . "\n\t" .
    '($rootf, $ext)= split(/\./, $ht);' . "\n\t" .
    '$h_rootf{"$i:$ext"}= $rootf;' . "\n\t" .
    '$i++;' . "\n" .
  '}' . "\n";
  print VRL "\n$lx\nh_tag\n";
  while (($zo, $htag) = each %h_tag) {
    print VRL "\t$zo:$htag\n";
  }
  print VRL "nombre total de fichiers traité $cf\n";
  print VRL "\n$lx\n$moi vous remercie d\'utiliser $script vers:$vers \n- $fr_date_now\n";
  #-----------------------------------
  close VRL || die "double dremmer closure of $flg not possibilé $!";
  close REC || die "double dremmer closure of rec not possibilé $!";
}
#---------------------------------------------------------------------------------------------

#--------------detronque les balises----------------------------------------------------------
sub reconstruire_ligne {
  my ($lines) = @_;
  
  # on split tout ca a plat
  $tout = "@lines";
  @cop = split(//, $tout);
  
  
  # balise $ouvert = 1 ==> vrai; 0 ==> faux
  $ouvert = $tronquage = $nltt = 0;
  @ligne = @nwcop = "";
  foreach $e(@cop) {
    if ($ouvert == 0) {
      $i++;
      if($e eq "<") {
	# signale qu'une balise est ouverte et pousse la ligne
	$ouvert = 1;
	push @ligne, $e;
      }
      elsif ($e eq "\n") {
	# pousse \n dans @ligne puis @ligne dans @nwcop et réinitialise @ligne
	push @ligne, $e;
	my $ligne = join('', @ligne);
	push @nwcop, $ligne;
	@ligne ="";
	$i = 0;
	$nltt++;
      }
      else {
	# pousse le caractère dans la ligne
	push @ligne, $e;
      }
    }
    # un balise à été ouverte donc passage en ouvert
    else {
      $i++;
      if ($e eq "\n") {
	# balise tronquées 
	$tronquage = 1;
	$k++;
	$nltt++;
      }
      elsif ($e eq ">") {
	$ouvert = 0;
	if ($tronquage == 1) {
	  # si tronqué pousser le caractère dans ligne et lui ajouter une fin de ligne
	  # puis remettre à zero $ligne, $tronquage et ouvert
	  push @ligne, "$e\n";
	  my $ligne = join('', @ligne);
	  push @nwcop, $ligne;
	  $i = 0;
	  @ligne = "";
	  $tronquage = 0;
	}
	elsif ($tronquage == 0) {
	  # si il n'y a pas eu de tronquage pousser dans ligne
	  push @ligne, $e;
	}
      }
      else {
	# print "je passe en ouvert quelconque $i:$e:\n";
	# si c'est un caractere quelconque, le pousser dans ligne
	push @ligne, $e;
      }
    }
  }	
  # le texte reparer ce trouve dans @nwcopim
  @nwlines = @nwcop;
}
#------------------------------------------------------------------------------

#---------recherche l'encre dans la ligne
sub cherche_encre {
  my ($lu) = @_;
  
  print "je suis dans cherche_encre\n";
  if ($lu=~ /<a\sname=\"(.*?)\"/i) {
    $tag = $1;
    $encre_vue++;
    $fz = "$likef#$tag";
    print "oh oh encre trouver $tag pour ls_tencre\n" and push @ls_tencre, $fz;
    print "oh oh encre trouver $tag pour ls_encre_pf\n" and push @ls_encre_pf, "#$tag";
    $tz++;
    print "encre trouvée ||| $tag|\n";
  }
  # si aucune encre trouvé peut etre interessant...
}
#--------------------------------------------------------------------------------

#--------------------------------fait des copies la ou il faut-------------------
sub faitdcopies {
  my ($likef)= @_;
  # les copies de fichier en meta langage doivent etre copier dans /newsite_x/tmp
  $copie = "$path_tmp" . "$likef";
  
  print VRL "fichier $likef,de $nltt lignes dont $k ligne href couper\n";
  print "fichier $likef,de $nltt lignes dont $k ligne href couper\n";

  open FC, ">$copie" or die "Ouverture de $copie impossible $!";
  print FC "@nwlines";
  #print FC "@copim";
  #---
  if ($argv eq "u") {
    $mode = 8;
    print FC '<!-- fichier initial ' . "$likef daté du " . datefinefile($file, $mode, $format_d) . "$fr_date_file" . ' -->';
  }
  close FC || die "Fermeture de $copie impossible $!";
  
  @copim = @nwcop = "";
  @nwlines = @lines = "";
  
  $z++;
}
#---------------------------------------------------------------------------------