#!/usr/bin/perl
# remd: vv2l comme Vaillant Verificateur De Liens - by asynchrone  *
# 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 :4.3  | 01.04 2009  alain Adelmar Pessac aadelmar@free.fr   *
#      -------------------------------------------------------     *
# (v: Vaillante De Luxe (Unix-Like - Windows)  Alain Adelmar )  ** *
# remd: utilise mon module Datefr pour dater les logs (facultatif) *
#------------------------------------------------------------------*
# usage:  vv2l.pl [-cu] [rep_source] [sous-rep(image)]             *
#-----------------------------------                               *
# 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) pour les site dépassant les 50 pages ou 1000 liens*
#             cette option adapte la sortie formaté pour le choix  *
# -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 (2008.11)   à Pessac 6 rue de Tunis 33600 *
#*******************************************************************
# $ID$: - Excellent conçu pour les gros site (>1000 pages)         *
# la meilleur version car elle fonctionne- enormisime - Alain A
# version utf8- encore beaucoup de controle. 
#  AAAA-pour Alain Adelmar Alias Asynchrone - AhAhAhAh!

my $script = "vv2l.pl";
my $vers = "4.3";
#$Author: alain $:"Adelmar Alain";
my $moi = "Adelmar Alain";


# use DateFrench donc installé FrDate.pm dans /Perl/lib ou /usr/lib/perl5x
# use File::Copy;   #a voir car cda ne marche pas sur M$
# voir de toute façon la maniere de recopier (binmode et >:utf8 activé)

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

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

use DateFrench;
our $format_affichage = 2;
our $opt_date_file = 2;
our $fr_date_now = maintenant("$format_affichage");
print "$fr_date_now\n";

my $gnus = 0;
my $lx = "*-" x 25;
my $slx = "\n\n\n\n\n\n\n\n\n\n$lx";   # pour eviter le clear ou autre system nettoyage ecran 
my $argv = "noting";
my @vh = values(%pf);

# pour l'adressage/les systeme UNIX, Linux, cygwin ou autre (/) et ceux de M$ (\)
my @gnul = ( "\\", "\/");   #pas mal because $gnul[$gnus] sera toujours bon, je suis trop fort
my $cong= "this is a real gnu OS, congratulation\n";
if ($0 =~ /[msys|cygwin|linux]$/) {
  $gnus++;
  print "$cong";
  }
elsif ($dir =~ /\//) {
  $gnus++;
  print "$cong";
  }
else {
  print "Vous etes sur une machine Petite et Molle (MicroSoft), beuuurk...\n";
  print "enfin quoi, sur un OS de merde\n";
  print "gnus ne vaut que $gnus, et en plus, vos fichiers sont du style:\n";
  print "C:" . "$gnul[$gnus]" . "caca" . "$gnul[$gnus]boudin au lieu de /super/extra\n os: $^O \n";
  print "Mais $0 fonctionnera tout de meme sur cette grosse chiote de systeme\n";
  }


# -----------traitement argument - dossier a traiter et verification $d valide------ debut
my $d = my $srep = "";

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$lx\n";
  print "Indiquez le dossier a traiter:\n";
  chomp($d =<STDIN>);
  &verifd;
}

#----------------------------------------------------------------------------- fin

#--------------- initialisation des variables ------------------------- debut
my @copim = my @lines = my @nwlines = ();
my @nieme = ("zorro", "premier", "deuxieme", "troisieme", "quatrieme");
my $userx = "";
sub regarder($);
my $e_mailp = 'aadelmar@numericable.fr';
my $etlencre = my $fp = my $ff = my $fe = 0;
my $fileo = my $fileso = "";
my $encre = my $lnknet = my $lnkbrut = my $ext = my $lnkbrt = my $lnkt = "";
$cnta = $cntlnkhttp = $cnttl = $encre_vue = $cntlnkftp = $z = $ef = $eb = $fr = $ea = 0;
my $firstline = "Editer par le script $script vers:$vers ce jour $fr_date_now :\n";
my $psr = "Veuillez ré-entrer le nom simple du sous répertoire: expl: image\nil aura comme path $d\/image ou passer en tapant Enter\n";
my $psr1 = "avez vous un sous-repertoire (pour les photos, icones, etc)\nsi oui lequel: (expl: images)\n";
my $x_down = " " x 47;
# $x_down = ("*-" x 24) . "||";                      # fioritures qui soulignes
my $y = "__-__*" x 15;                               # idem pour différencier
my $al = "\t|     === A_l_a_i_n -\/\/- A_d_e_l_m_a_r ===      ||";    # pub perso
#--- explication pour l'utilisateur
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";

#----------------- sortie formatée pour l'affichage fichiers/tags --------- ok

format STDOUT_TOP =
Page @<<
$%

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


$rootfile_log = "vrl";
$hdl_log = "VRL";
&ouvre_log;

#création et ouverture d'un rep temporaire pour placer le nouveau site -------------- debut
$newsite = "$dir" . "$gnul[$gnus]" . "newsite";
print "le newsite sera adresser comme : $newsite\n";
&faitmoitmp;   #johnny, johnny
# $path_tmp = "$tmp" . "$gnul[$gnus]";  # cette ligne existe deja dans &faitmoitmp
print "$lx$lx\n";
#vrl est ouvert pour un log de constat d'encre possible en local
&traite_d;
&recup_all_tags;
#----------------------------------------------------------------(1

# 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);
foreach $file(@files) {
  next if ($files =~ /\.log$/g);
  $opt_date_file = 1;
  our $fr_date_file = datefichier($format_affichage, $opt_date_file, $file);
  
  #($troncfile, $ext)=split(/\./, $file);
  #$rootfile_log = "rap_$troncfile";
  #$hdl_log = "RAP";
  #&ouvre_log;
  print "$firstline$lx\n";
  #----------------------------------------------a là

  if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {
    ($troncfile, $ext)=split(/\./, $file);
    $rootfile_log = "rap_$troncfile";
    $hdl_log = "RAP";
    &ouvre_log;
    # attention de pas confondre rootfile ext et encre avec celle des liens
    $rootfile = $ext = $encre = "";
    $countpfl = $countpl = 0;
    print "$lx\n";
    &controle_file;
    &reparation;
    &compte_rendu;
    #close FSR || die "Fermeture de fsr impossible $!";
    push @rep, $file;
  }
}

close RAP || die "far toi encouler granda connassa rap $!";
closedir RC || die "Fermeture de $path_tmp impossible (putain de merde) $!"; 
#-------------------------------------------------------------------fin


sub controle_file {
  #initialisation des variables
  my (@contenu)= "";
  $filesrc = "$path_tmp" . "$file";
  $format_affichage = 12;
  $opt_date_file = 1;
  our $fr_date_file = datefichier();
  print RAP "\t$lx\n$file du $fr_date_file\n";
  #----------------------------------
  open FI, "$filesrc" or die "Ouverture du fichier $file impossible $!";
  @contenu = <FI>;
  close FI || die "Fermeture impossible $!";
  $countpl = 0;
  #--------------------------- voila regler ca et fermer les fichier ouverts
  
  foreach $line(@contenu) {
    $countpl++;     #compteur de ligne par file
    $fl = "file: $file \|ligne:$countpl ";   #ok preindication file origine ligne (pour RAP_a)
    $flplus = "$fl :lnknet:$lnknet encre:$encre rootfile:$rootfile ext:$ext\n";  # ceci n'est pas initialisé a deplacer
    $countpfl = 0;      # ok initialise compteur par lien de la ligne
    $mot = "href=\"(.*?)\"\>";
    @ls_m = ($line =~ /$mot/ig);
    foreach (@ls_m) {
      $j++;   # que fait ce $j?
      $corrompu = $etlencre = 0;
      $encre = "";
      $lnkbrut = $_;
      # ok compteur par liens dans la ligne (3 max)
      $countpfl++;
      # a degager quand tout tourne ca c'est du bla bla
      $oldlb = $lnkbrut;
      $q++;     #numero unique du lien 
      print RAP "$lx\n$fl lien brut: $lnkbrut c\'est le $nieme[$countpfl]\n";
      $err = "err $fl lkb:$lnkbrut l: $countpl n: $countpfl\n";
      print "$lnkbrut\t$countpl\n";
      if ($lnkbrut=~ /^mailto/) {
        ($kk, $email) = split(/:/, $lnkbrut);
        ($login, $fai) = split(/\@/, $email);
        $cnta++;
        $eb++;
        $v++;
        print RAP "login = $login et fai = $fai\n";
        #------------------------modification perso
        if ($email =~ /^a.?adelmar\@wanadoo\.fr/) {
          $e_mailp = "aadelmar\@free\.fr";
          print RAP "erreur adresse corrigé $email deviens $e_mailp\n";
          $ea++;
          $line =~  s/()\Q$email\E()/$1$e_mailp$2/;
          $v++;
          # a saquer because c'est line qu'il faut modifier
          $nwline = $line;
          print "line: $nwline\n";
          #$nwmot =  s/()$email()/($1)$e_mailp($2)/;
          print "modif d'adresse mail effectué sur $file fraction de ligne $mot $countpl\n";
	}
        push @adressemail, "$login\@$fai";
        &chklnk;
        $v++;
      }
      #--------lien vers news-groupes trouvé
      elsif ($lnkbrut=~ /^news/) {
        ($kk, $nws) =split(/:/, $lnkbrut);
        print RAP "news-groupes trouvé $nws\n";
        $eb++;  #pas sur
        &chklnk;
        $v++;
      }
      #--------------------http
      elsif ($lnkbrut=~ /^http:\/\//i) {
        $encre ="";
        ($lnkhttp, $encre) = split(/\#/, $lnkbrut);
        $cntlnkhttp++;
        $prlnkhttp = "$file ligne:$countpl\t$lnkhttp\t$encre";
        push @lnk_http, $prlnkhttp;
        # ou en hashage
        $h_lnkhttp{"$lnkhttp" . "_$cntlnkhttp"} = $encre;
        $eb++;  #pas sur
        $encre= "";
        &chklnk;
        $v++;
      }
      #------------------ftp
      elsif ($lnkbrut=~ /^ftp:\/\//i) {
        $encre= "";
        ($lnkftp, $encre) = split(/\#/, $lnkbrut);
        $cntlnkftp++;
        $prlnkftp = "$file ligne:$countpl\t$lnkftp\t$encre"; 
        push @lnk_ftp, $prlnkftp;	
        #-------------- ou en hashage
        $h_lnkftp{"$lnkftp" . "_$cntlnkftp"} = $encre;
        $eb++;  #pas sur
        $encre= "";
        &chklnk;
        $v++;
      }
      #-------------------local (ce qui nous interresse)
      #-----------------------------------------------------------------ici
      else {
      SCONTROL:if (exists ${{reverse %h_tencre}} {$lnkbrut}) {
	  # *CB1 tout bon
	  print RAP " *CB1 good tb $lnkbrut n\:$q nc\:$v\n";
          $v++;
          $eb++;
	}
	# *CB2 
        elsif (exists ${{reverse %h_fst}} {$lnkbrut}) {
          print RAP " *CB2 good vfile $lnkbrut n\:$q nc\:$v\n";
          $v++;
          $eb++;
	}
        # *CB3(2/2) peut etre le lien ne pointe que sur encre
        elsif (exists ${{reverse %h_tag}} {$lnkbrut}) {
	  # *CB3(1) si le nom de la page + le lien colle-------------------------pass 3 ok--v
          if(exists ${{reverse %h_tencre}} {"$file" . "$lnkbrut"}) {
            print RAP " *CB3(1) good sf $lnkbrut nlien\:$q nc\:$v\n";
            $v++;
            $eb++;
	  }
	  #------------------------------------------------------------------------------°
	  # sinon 
          else {
	    # *CB3(2)
	    print "ceci est fortement improbable mais votre lien $lnkbrut doit etre reparrer\nufull:\n";
	    print RAP " *CB3(2) good sf $lnkbrut nlien\:$q nc\:$v\n";
	    &utilisateur_full;
	  }
	}
	# *CB4 --apres la moulinette a bon liens on entre dans le vif------
	elsif ($lnkbrut =~ /[\/]|[\\]/) {
	  # if ($lnknet =~ /[\/]|[\\]/) {
	  $ef++;
	  $v++;
	  print RAP " *CB4a part a dp $lnkbrut nlien\:$q nc\:$v\n";
	  &degage_path;
	}
	else {
	  # assignation des valeurs lnknet et encre et stockage des parametres existants
	  &decortique_file;
	  $fl = "file: $file \|ligne:$countpl ";
	  $flplus = "$fl :lnknet:$lnknet encre:$encre rootfile: $rootfile ext:$ext\n";
	  print RAP " *CB4 $flplus\n";
	  # *CB4b(2/2)------------------------------------------------------------| pass 2 ok --v
	  if ($lnkbrut=~ /^\#/) {
	    $lnkbrut = "$file" . "$lnkbrut";
	    print RAP "*CB4b $lnkbrut nlien\:$q nc\:$v\n";
	    #---------------------------------------------------------------------------°
	    # *CB4b1
	    if (exists ${{reverse %h_tencre}} {$lnkbrut}) {
	      print RAP "$flplus fff encre seule a reparrer $lnknet deviens $lnkbrut\n";
	      &utilisateur_full;
	      $v++;
	      print RAP "*CB4b1 $lnkbrut nlien\:$q nc\:$v\n";
	      goto SCONTROL;
	    }
	    else {
	      #---------------------------------------------------------------------|pass 2 ok --v
	      # *CB4b2
	      print RAP "*CB4b2 $flplus commence par dieze mais encre pas bonne $lnkbrut\n";
	      $etlencre= 1;
	      $lnknet = $file;
	      ($rootfile, $ext)=split(/\./, $lnknet);
	      &utilisateur_fe;
	      $v++;
	      goto SCONTROL;
	    }
	    #--------------------------------------------------------------------------------------°
	  }
	  # *CB4c ici on ce rend compte que file est bon mais y a autre chose qui pourri le lien
	  elsif (exists ${{reverse %h_fst}} {$lnknet}) {
	    my $q = 0;
	    @val= ();
	    @tr_encre_pf= ();
	    @val = (values (%h_tencre));
	    foreach (@val) {
	      ($lknet_tmp, $encre_tmp)= split(/\#/, $_);
	      if ("$lnknet" eq "$lknet_tmp") {
		$rl = "$lknet_tmp" . "\#" . "$encre_tmp";
		push @tr_encre_pf, $rl;
		$q++
	      }
	    }
	    print "$lx\n$flplus Pas bon\t $lnknet\t $encre :\n *CB4c \n";
	    $y = 0;
	    $a = $b = "";
	    $na = $nb = 0;
	    @tr_encre_pf = sort @tr_encre_pf;
	    for (0 .. (@tr_encre_pf/2)) {
	      for $i(0..1) {
		$u = $y + $i;
		#$pf{$i} = "$tr_file[$u]";
		$pf{$i} = $tr_encre_pf[$u];
	      }
	      $a = $pf{0};
	      $na = $u - 1;
	      $b = $pf{1};
	      $nb = $u;
	      write;
	      #print "\t$_\t$y\n";
	      $y += 2;
	    }
	    print "[enter] suprimera l encre mais pas le liens\n";
	    chomp($encru = <STDIN>);
	    # *CB4c1 passe
	    if ($encru eq "") {
	      print "rien ne sera fait\n";
	      $lnkbrut = "$lnknet";
	      print RAP " *CB4c1 $lnkbrut nlien\:$q nc\:$v\n";
	      $v++;
	    }
	    # *CB4c2 chiffre entrer -------------------------------------------- |pass 1 ok-----v
	    elsif($encru =~/^\d/) {
	      print RAP "votre choix num qui vaut $tr_encre_pf[$encru]\n";
	      print "votre choix num qui vaut $tr_encre_pf[$encru]\n";
	      $lnkbrut = $tr_encre_pf[$encru];
	      print RAP " *CB4c2 $lnkbrut nlien\:$q nc\:$v\n";
	      $v++;
	      &chklnk;
	      goto SCONTROL;
	    }
	    #-----------------------------------------------------------------------------------°
	    # *CB4c3 encre entrer a la main
	    elsif($encru=~ /^\w/) {
	      print RAP "vous avez entrer la chaine $encru\n";
	      print "vous avez entrer la chaine $encru\n";
	      $lnkbrut = "$encru";
	      print RAP " *CB4c3 $lnkbrut nlien\:$q nc\:$v\n";
	      &chklnk;
	      $v++;
	      goto SCONTROL;
	    }
	    print "ici la fin du buzz encre\n";
	  }
	  # *CB4d ici on se rend compte que c'est l'extention qui daille
	  elsif (exists ${{reverse %h_tencre}} {"$rootfile\.html\#$encre"}) {
	    print RAP "ok c'etait l'extention qui daillait, donc ext=html\n";
	    print RAP "gagne lien vers encre du meme fichier $lnkbrut nlien\:$q nc\:$v\n";
	    $lnkbrut = "$rootfile\.html\#$encre";
	    print RAP " *CB4d $lnkbrut nlien\:$q nc\:$v\n";
	    &chklnk;
	    $v++;
	  }
	  # *CB4e ici on se rend compte que c'est l'extention qui daille
	  elsif (exists ${{reverse %h_fst}} {"$rootfile\.html"}) {
	    print RAP "*CB4e $fl : ici c'est rootfile qui est ok\n";
	    # *CB4e1-----------------------------------------------------| pass 5 ok ---v
	    if($encre == 0) {
	      $lnkbrut = "$rootfile\.html";
	      print RAP " *CB4e1 $lnkbrut nlien\:$q nc\:$v\n";
	      print RAP "gagne lien vers $lnkbrut nlien\:$q nc\:$v\n";
	      &chklnk;
	      $v++;
	    }
	    #---------------------------------------------------------------------------°
	    # *CB4e2
	    else {
	      # si cette construction est infructueuse faire lnknet=rootfile.html =>ufe
	      $lnkbrut = "$rootfile\.html\#$encre";
	      print RAP " *CB4e2 $lnkbrut nlien\:$q nc\:$v\n";
	      print RAP "aurai du etre traiter en CB4d look that $lnkbrut gagné $v\n";
	      &chklnk;
	      $v++;
	      goto SCONTROLE;
	    }
	  }
	  # *CB4f ici il n'y a que rootfile qui matche
	  elsif (exists ${{reverse %h_rootf}} {$rootfile}) {
	    print "quel lien match, choisissez:\n";
	    $i = 0;
	    while ( ($key, $value) = each %h_rootf) {
	      if($value eq $rootfile) {
		$ch_ext = $key;
		($kk, $ext_tmp)= split(/:/, $ch_ext);
		push @ls_ext, $ext_tmp;
		print "pour $rootfile\.$ext_tmp taper $i\n";
	      }
	      $i++;
	    }
	    $resp= <STDIN>;
	    chomp $resp;
	    $lnkbrut = "$rootfile\." . $ls_ext[$resp]; 
	    print "vous avez valider $lnkbrut\n";
	    print RAP " *CB4f $lnkbrut nlien\:$q nc\:$v\n";
	    &chklnk;
	    $v++;
	    goto SCONTROL;
	  }
	  # *CB4g
	  else {
	    # si il y a une encre (reparrer)et aussi un faux nom de fichier creer un if
	    # $p++;
	    # *CB4g1----------------------------------------------------------------------Pass 4 ok --v
	    if ($encre eq "") {
	      # Dernier else | sans encre ce liens part a uf: code erreur "desauf"
	      print "$lx desauf\n$flplus\n";
	      print RAP " *CB4g1 (mais pas sorti) $lx desauf\n$flplus\n";
	      &utilisateur_f;
	    }
	    #--------------------------------------------------------------------------------°
	    # *CB4g2 --------------------------------------------------------------------Pass 6 ok--v
	    else {
	      # choisir un fichier puis une encre
	      # Dernier else num: $p| avec encre ce liens part a ufull: code erreur deaafull
	      print "$lx deaafull\n$flplus\n";
	      print RAP "*CB4g2 $lx deaafull\n$flplus\n";
	      &utilisateur_full;
	      #-----------------------------------------------------------------------------------°
	    }
	  }
	}
      }
    }
    # $j = 1; # $j est le compteur de liens total
    push @nwcontenu, $line;
  }
}	



#-----------------------------Recup_all_tags---------------------------- debut
sub recup_all_tags {
  # --le handle est pour RAP

  foreach $likef(@nwlsfile) {
    $cf++;     #compteur de fichiers
    next if ($likef=~ /^\./);
    $file = $likef;
    $encre_vue = 0;
    # re-ajouter le path au nom de fichier
    if ($d =~ /"$gnul[$gnus]"$/) {
      $ftagsrc = "$d" . "$file";
    }
    else {
      $ftagsrc = "$d" . "$gnul[$gnus]" . "$file";
    }
    # vérif mode (html, tml, htm, xml, etc..)
    if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {
      $format_affichage = 12;
      $opt_date_file = 1;
      our $fr_date_file = datefichier($format_affichage, $opt_date_file, $file);
      @lines = @nwlines =();
      open FT, "$ftagsrc" or die "Ouverture du fichier $file impossible $!";
      binmode(FT);
      $lpp = 0;
      @lines = <FT>;
      close FT || die "Fermeture impossible $!";
      #while (@lines) {
      #  (push @encref, $encre_t and $encre_t = $1) if (/<a name\=\"()\"\>/);
      #}
      &reconstruire_ligne;
      
      foreach $line(@nwlines) {
        if ($line =~ /<body\>/i) {
          $body = $lpp;
          &cherche_encre;
          push @copim, $line;
	  $lpp++;
	}
        else {
          &cherche_encre;
          push @copim, $line;
	  $lpp++;
	}
      }
      # tout ce qui suit est faut jusqu'a &faitdcopies, mais pas grave car ne peut etre utiliser - a saquer
      if ($encre_vue == 0) {
        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") {
        $copim[$body] .= "\n<-- mise à jour du document par $script le $fr_date_now \ninitialement daté du " . $fr_date_file . "\n";
        print VRL "pour voir body trouvé\n$copim[$body]\n";
      }
      &faitdcopies;
      @copim = ();
      # detail des encres trouvées par fichiers
      print VRL "\npour $file $encre_vue encre trouvé\/s\nDétail:\n";
      while ($une_encre = shift(@ls_encre_pf)) {
        print VRL ("\t$une_encre\n");
      }
    }
    else {
      $fileo = "$d" . $gnul[$gnus] . "$file";
      $fileso = "$path_newsite" . "$file";
      # il faut recopier ce qui n'est pas html dans le rep cible et pas dans temporaire
      open(LIRE, "$fileo") or die "Ouverture du script ou image $fileo impossible $!";
      binmode(LIRE);
      open(ECRIRE, ">$fileso") or die "Impossible de creer $fileso $!";
      binmode(ECRIRE);
      foreach (<LIRE>) {
        print ECRIRE $_;
      }
      close LIRE || die "Fermeture du fichier script/image $fileo imposible $!";
      close ECRIRE || die "Fermeture du script/image $fileso impossible $!";
      # on ne sait jamais peut etre un lien fait reference à un script donc
      $h_fst{$cf}= "$file";
      # attention 
      push @ls_encre_pf, $file;
    }
  }

  #----------a degager quand pris en compte---voici les trois hachage
  print VRL "\n$lx\nvoici les trois hachage:\n$lx\nh_tencre\n";
  while (($zo, $hf) = each %h_tencre) {
    print VRL "\t$zo:$hf\n";
  }
  print VRL "\n$lx\nh_fst\n";
  my $i= 0;
  while (($zo, $ht) = each %h_fst) {
    ($rootf, $ext)= split(/\./, $ht);
    $h_rootf{"$i:$ext"}= $rootf;
    print VRL "\t$zo:$ht\n";
  }
  print VRL "\n$lx\nh_tag\n";
  while (($zo, $htag) = each %h_tag) {
    print VRL "\t$zo:$htag\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é $!";
}

#--------------------------------------------------------------------------------- fin

sub cherche_encre {
  if ($line=~ /<a\sname="(.*?)"/i) {
    $tag = $1;
    $encre_vue++;
    $fz = "$file#$tag";
    $kh = "$cf:$tz";
    $h_tencre{$kh}= "$file" . '#' . "$tag";
    $h_tag{$kh}= "#" . "$tag";
    #push @lsctag, $fz;
    push @ls_encre_pf, $tag;
    push @ls_encre_pf, $fz;
    $tz++;
    }
}

#---------------------------------------------------------- debut
sub reparation {
  $fcible = "$path_newsite" . "$file";
  open FR, ">$fcible" or die "Ouverture de $fcible impossible $!";
  print FR @nwcontenu;
  #réinitialisation des listes par fichiers
  @nwcontenu = ();  # ou @nwcontenu = @nwl = "";
  close FR || die "Fermeture de $fcible impossible $!";
}

sub utilisateur_f {

  $userx = "f";
  @val =();
  # @valalpha = "";  #en prevision du tri des concordances (voir 5 lignes plus bas)
  print RAP "uf:Ce liens n a pas de corresp $lnkbrut il par a user\n";
 # print "Choisissez un fichier vers lequel $lnkbrut pointera\n";
  print "$lx\nChanger fielname: $lnkbrut [num]|[Enter]|[q] quitter\n";
  @val = (values (%h_fst));
  @val = (sort @val);
 # # trier par ordre alphabétique par concordance, si option -l activé--------
 # if ($argv eq "l") {
 #   $deb_lkbrut = substr($lnkbrut, 0, 1);
 #   foreach $element(@val) {
 #     my $deb_ancre = substr($element, 0, 1);
 #     (push @valalpha, $element) if ($deb_ancre eq $deb_lkbrut);
 #     } 
 #   }
 # if (@valalpha ne "") {
 #   @val = @valalpha;
 #   }
 # #----------------------------------------------------------------------------
  $i = 0;
  $pair = 0;
  $ff++;
  foreach (@val) {
    $lknet_tmp = $_;
    $max = 40;
    DEBF:if($pair == $max) {
      &regarder($userx);
      }
    else {
      if($pair%2 == 0) {
        $na = $i;
        $a = $lknet_tmp;
        if($lknet_tmp eq "$val[$#val]") {
	  $b = "n\/a";
          write;
          }
        $i++;
        $pair++;
        }
      else {
        $nb = $i;
        $b = $lknet_tmp;
        write;
        $pair++;
        $i++;
        }
      }
    }
  &regarder($userx);
}


sub utilisateur_fe {

  $userx = "fe";
  @val =();
  # @valalpha = "";  #en prevision du tri des concordances (voir 5 lignes plus bas)
  # ligne dessous a saquer quand bon
  print RAP "fe:pas de corresp pour $lnkbrut il par a user\n";
 # print "Choisissez une encre vers lequel $lnkbrut pointera\n";
  print "$lx\nChanger ancre: $lnkbrut [num]|[Enter]|[q] quitter\n";
  @val = (values (%h_tencre));
  @val = (sort @val);
 # # trier par ordre alphabétique par concordance, si option -l activé---------
 # if ($argv eq "l") {
 #   $deb_lkbrut = substr($lnkbrut, 0, 1);
 #   foreach $element(@val) {
 #     my $deb_ancre = substr($element, 0, 1);
 #     (push @valalpha, $element) if ($deb_ancre eq $deb_lkbrut);
 #     } 
 #   }
 # if (@valalpha ne "") {
 #   @val = @valalpha;
 #   }
 # #-----------------------------------------------------------------------------
  $pair = 0;
  $i = 0;
  foreach (@val) {
    #---pour limiter a lnknet
    $value = $_;
    ($lknet_tmp, $encre_tmp)= split(/\#/, $_);
    if($lknet_tmp eq $lnknet) {
      $max = 40;
      DEBFE:if($pair == $max) {
        &regarder($userx);
        }
      else {
        if($pair%2 == 0) {
          $na = $i;
          $a = $value;
          if($value eq "$val[$#val]") {
	    $b = "n\/a";
            write;
            }
          $i++;
          $pair++;
          }
        else {
          $nb = $i;
          $b = $value;
          write;
          $pair++;
          $i++;
          }
        }
      }
    }
  &regarder($userx);
  }


sub utilisateur_full {

  $userx = "full";
  @val = ();
  # @valalpha = "";  #en prevision du tri des concordances (voir 5 lignes plus bas)
  print RAP "ufull:Ce liens n a pas de corresp $lnkbrut il par a user\n";
  print "$lx\nChanger lien: $lnkbrut [num]|[Enter]|[q] quitter\n";
  @val = (values (%h_tencre));
  @val = (sort @val);
 # # trier par ordre alphabétique par concordance, si option -l activé---
 # if ($argv eq "l") {
 #   $deb_lkbrut = substr($lnkbrut, 0, 1);
 #   foreach $element(@val) {
 #     my $deb_ancre = substr($element, 0, 1);
 #     (push @valalpha, $element) if ($deb_ancre eq $deb_lkbrut);
 #     } 
 #   }
 # if (@valalpha ne "") {
 #   @val = @valalpha;
 #   }
 # #----------------------------------------------------------------------
  $i = 0;
  $pair = 0;
  foreach (@val) {
    $value = $_;
    $max = 40;
    DEBFULL:if($pair == $max) {
      &regarder($userx);
      }
    # ceci affiche les valeurs $values et les chiffres represantant les valeur indexés sur $i
    else {
      if($pair%2 == 0) {
        $na = $i;
        $a = $value;
        if($value eq "$val[$#val]") {
	  $b = "n\/a";
          write;
          }
        $pair++;
        $i++;
        }
      else {
        $nb = $i;
        $b = $value;
        write;
        $pair++;
        $i++;
        }
      }
    }
  &regarder($userx);
}



sub faitdcopies {
  # les copies de fichier en meta langage doivent etre copier dans /newsite_x/tmp
  $copie = "$path_tmp" . "$file";

  #&reconstruire_ligne;

  print VRL "fichier $file,de $j lignes dont $k ligne href couper\n";

  open FC, ">$copie" or die "Ouverture de $copie impossible $!";
  print FC "@copim";
  if ($argv eq "u") {
    print FC '<!-- fichier initial ' . "$file daté du $fr_date_file" . ' -->';
    }
  close FC || die "Fermeture de $copie impossible $!";

  @copim=();
  @nwlines = @lines =();

  $h_tencre{$z}= "$file";
  $h_fst{$z}= "$file";
  $z++;
}

#------------------------------------------------------------------------verifd
sub verifd {

  unless (-e $d) {
    print "Veuillez ré-entrer le chemin complet du dossier à traiter, expl:" . '/home/pub/monsite ou //perl//pub//toto' . "\n";
    chomp($d = <STDIN>);
  }
}

sub traite_d {
  #-----------ouverture lecture, assignation @lsfile, controle srep != sous_rep
  opendir R, "$d" or die "Ouverture de $d impossible $!";
  my @lsfile = (sort readdir R);
  closedir R or die "Fermeture du repertoire R impossible $!";
  foreach $file(@lsfile) {
    # vérifier si un rep est $srep (donc juste rep_rootname ou plus bas) et le traiter à la place de &faitmoitmp
    if (-d "$d$gnul[$gnus]$file") {
      my $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 {
      $fichiersource = "$d" . "$gnul[$gnus]" . "$file";
      $fichiercible = "$path_tmp" . "$gnul[$gnus]" . "$file";
      copy($fichiersource, $fichiercible) or die "impossibilité de copier $fichiersource sur $fichiercible $!";
      # exec dos2unix "$d$gnul[$gnus]$file"; # voir si ca marche
      push @nwlsfile, $file;
    }
  }
}


#---------- choix du repertoire temporaire-------------\
sub faitmoitmp {
  my $q = 0;
  if (-e $newsite) {
    while (-e $newsite) {
      $q++;
      $newsite = "$dir" . "$gnul[$gnus]newsite" . "_$q";
    }
    mkdir $newsite or die "ouverture de $newsite impossible $!";
  }
  else {
    mkdir $newsite or die "ouverture de $newsite impossible $!";
  }
  $tmp = "$newsite" . "$gnul[$gnus]" . "tmp";
  mkdir $tmp or die "création de $tmp impossible $!";
  $path_tmp = "$tmp" . "$gnul[$gnus]";
  $path_newsite = "$newsite" . "$gnul[$gnus]";
  
  # 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 $!";
    }
  }


  print "Un dossier newsite contiendra vos pages corrigées\net $gnul[$gnus]newsite$gnul[$gnus]tmp contiendra les logs de synthése\n";
}


#--------------------------sous procedure qui modifie les portions de ligne
sub chklnk {
  if($corrompu == 0) {
    $line =~ s/()\Q$oldlb\E()/$1$lnkbrut$2/;
    $oldlb = $lnkbrut;
    $corrompu++;
  }
  else {
    $line =~ s/()\Q$oldlb\E()/$1$lnkbrut$2/;
    $oldlb = $lnkbrut;
  }
    # $line =~ s/$oldlb/$lnkbrut/xmg;
    # $line =~ s/()\Q$oldlb\E()/$1$lnkbrut$2/;

}


#---------------------------------------------------------------degage_path
sub degage_path {
  print RAP "DP: path trop long $err\n";
  &decortique_file;
  while ($lnknet =~ /$gnul[$gnus]/) {
    @pathl = split(/$gnul[$gnus]/, $lnknet);
    $fpointe = pop @pathl;
   # $presquesrep = pop @path1;
   # ($fpointe = $presquesrep) if ($presquesrep=~ /$srep$/);   # laisse srep dans le nom si il exsiste
    if ($encre gt "") {
      $lnknet = $fpointe;
      $lnkbrut = "$lnknet" . "\#$encre";
      print RAP "Correction faite $lnkbrut par dp\n";
      print "Correction faite $lnkbrut par dp\n";
    }
    #
    #------------------------------------------------pass 4 ok -------v
    else {
      $lnkbrut = $lnknet = $fpointe;
      print RAP "Corriger: $lnkbrut par dp\n";
      print "Correction faite $lnkbrut par dp\n";
    }
    #-----------------------------------------------------------------°
  }
  $v++;
  $fr++;
  &chklnk;
  goto SCONTROL;
}



# lknet2lnkbrut-----------------debut (ne sert qu'a controler au debuggage)
sub lknet2lnkbrut {
  print RAP "LKNET2LB: etat des liens en entrer:\nln: $lnknet\nlb: $lnkbrut\n";
  if($encre eq "") {
    $lnkbrut = "$lnknet";
  }
  else {
    $lnkbrut = "$lnknet" . "\#" . "$encre";
  }
  &chklnk;
  print RAP "LKNET2LB: etat des liens en sortie:\nln: $lnknet\nlb: $lnkbrut\n$lx\n";
  goto SCONTROL;
}
#--------------------------------- fin


#-------------------------------------ouvre_log-- géant
sub ouvre_log {
  print "mon rootlog vaut $rootfile_log\n";
  my $i = 0;

  if ($path_tmp eq "") {
    $path_tmp = $dir;
  }
  $flg = "$path_tmp" . "$gnul[$gnus]" . "$rootfile_log.log";

  while (-e $flg) {
    $flg = "$path_tmp" . "$gnul[$gnus]" . "$rootfile_log" . "_$i" . ".log";
    $i++;
  }
  open $hdl_log, ">$flg" or die "Ouverture de $flg impossible $!";
  print $hdl_log "script: $script (V: $vers) - date: $fr_date_now\n$lx\n";
}

#----------------------------------------Compte rendu ---------------------------debut
sub compte_rendu {
  
  if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {
    $file_cr= "$path_tmp" . "rap_" . "$ir.log";

    open FRAP, ">$file_cr" or die "Ouverture de $file_cr impossible $!";
    print "$firstline$lx\n";
    print FRAP "Liens http de $file trouvé avec liste:\n";
    foreach $lk(@lnk_http) {
      print FRAP "adresse Web: $lk\n";
      }
    print FRAP "\n$lx\navec le hashage maintenant\n";
    while ( ($key, $value) = each %h_lnkhttp) {
      print FRAP "$key = $value\n";
      }
    print FRAP "\n$lx\n";
    print FRAP "liens ftp de $file trouvé:\n";
    foreach $lk(@lnk_ftp) {
      print FRAP "adresse ftp: $lk\n";
    }
    print FRAP "\n$lx\navec hashage now:\n";
    while ( ($key, $value) = each %h_lnkftp) {
      print FRAP "$key " . "=" . "$value\n";
    }
    print FRAP "$lx\n$lx\navec le nouveau hashage h_tencre\n";
    while ( ($key, $value) = each %h_tencre) {
      print FRAP "$key = $value\n";
      }
    #-----------login now----
    print FRAP "$lx\n\tlogin trouvé:\n";
    $login = join("\n", @adressemail);
    print FRAP "$login\n";
    if($ea >= 1) {
      print FRAP "$ea erreurs reparés par $e_mailp\n";
    }
    #------------stat
    print FRAP "$lx\n";
    print FRAP "Sur un total de $cnttl lignes controler\npour un total de $j liens controler :\n";
    print FRAP "$cntlnkhttp liens http: " . "\nnon controler\n" . "\n$cntlnkftp liens ftp:\nnon controler pour le moment\n";
    print FRAP "Les lnknet maintenant\n";
    print FRAP "$j liens controler sur $file\n";
    print FRAP "recap total de $j liens:\n$eb bon adressage\n$ef erreur adressage\n$fr erreur adressage fichier réparer\n$eb bonne encre\nN\/A erreur encre\n$err encre reparrer\nerreur adresse web $ea\n";
    $filos = join("\n", @rep);
    print FRAP "effectuer sur les fichiers:\n" . "\n$filos\n$lx\n";  #ca marche
    print FRAP "fait le $fr_date_now\n";
    close FRAP || die "dreumer ca bloque $!";
    }

  # --------------------------------remise a zero de nwlines et incremente index rapport
  @nwcontenu = "";
  $ir++;
}
#------------------------------------------------------------------------------------- fin

sub regarder($) {
  my $userx = @_;
  # print "$lx\nChanger lien: $lnkbrut [num]|[Enter]|[q] quitter\n";
  chomp($repu = <STDIN>);
  # si l'user ne veux pas ce prononcer| ou n'est pas dans les 40 propositions pour uf et uef
  if($repu eq "") {
    #$max = $max + 40;
    $pair = 0;
    (goto DEBF and undef $repu) if ($userx eq "f");
    (goto DEBFE and undef $repu) if ($userx eq "fe");
    (goto DEBFULL and undef $repu) if ($userx eq "full");
#    if ($userx eq "f") {
#      undef $repu;
#      goto DEBF;
#    }
#    elsif ($userx eq "fe") {
#      undef $repu;
#      goto DEBFE;
#    }
#    elsif ($userx eq "full") {
#      undef $repu;
#      goto DEBFULL;
#    }
    }
  elsif($repu =~ /^\d/) {
    $lnkbrut = $val[$repu];
    print RAP "\n $userx important\n$lnkbrut\n";
    $lnkbrt = $lnkbrut;
    ($lnknet, $encre)= split(/\#/, $lnkbrt);
    print "Votre choix valider:\t $lnkbrut\n";
    $userx = "";
    $v++;
    &chklnk;
    undef $repu;
    goto SCONTROL;
  }
  elsif($repu =~ /^q$/i) {
    $userx = "";
    $v++;
    print "Ce programme va se fermer, retrouver les log dans /newsite/tmp \n";
    print RAP "Programme $script vers:$vers d\' $moi\nfermer par utilisateur à $fr_date_now,\nbonne journée\n";
    close RAP || die "far toi encouler granda connassa rap $!";
    closedir RC || die "Fermeture de $path_tmp impossible (putain de merde) $!";
  }
  else {
    print "Vous avez entrer $repu ca remplacera $lnkbrut\n";
    $lnkbrut = $repu;
    $lnkbrt = $lnkbrut;
    ($lnknet, $encre)= split(/\#/, $lnkbrt);
    &chklnk;
    undef $repu;
    $userx = "";
    $v++;
    goto SCONTROL;
  }
}

sub reconstruire_ligne {

  foreach $l(@lines) {
    if ($l=~ /^\s/) {
      $l=~ s/^\s{1}?//;
    }
    if ($l =~ /<a[^>]\n$/i) {
      $l =~ s/\x0d\x0a$//;
      $k++;
      $j++;
    }
    # sinon ôter juste le \r (retour chariot)
    else {
      $l =~ s/\x0d$//;
      $j++;
    }
    push @nwlines, $l;
  }
  print "fichier $file,de $j lignes dont $k ligne href couper\n";
}

sub decortique_file {

  # decortique le nom complet($lnkbrut) en lnknet, encre, rootfile et ext, sans toucher a lnkbrut et lnknet
  $lnkbrt = $lnkbrut;
  ($lnknet, $encre) = split(/\#/, $lnkbrt);
  $lnkt = $lnknet;
  ($rootfile, $ext) = split(/\./, $lnkt);
}


format STDOUT =
@<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<     @<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$na, $a, $nb, $b
.

# script Perl écrit par alain Adelmar alias alCoolfort
# ce script repare plus de 9 liens sur 10

END;
