#!/usr/bin/perl -w
# 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-Like=>M$, les fautes d'extentions, doublons, etc...         *
# Vérif des encres et ré-attribution du premier flag ou création   *
# d'une encre #top (si page existe sans flag). Corrige les fautes  *
# d'orthographes et les path erronés.                              *
# Version :4.2 | 21.03 2004  alain Adelmar Pessac aadelmar@free.fr *
# (v: DX&DY   (Unix-Like - Windows)  alain Adelmar - Pessac) **    *
# Accepte le nom du répértoire à traiter en guise d'argument:      *
# et le sous-rep (si il y a lieu expl: images) en dernier argument *
#------------------------------------------------------------------*
# usage:  vlnk.pl [-cou] [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  *
# -o (orthographe) verifi si pas de fautes d'orthographe dans le   *
#              lien brut (ralentit l'exécution)                    *
# -u (update) insére la date de mise à jour, en gardant l'original *
#             en commantaire, répare les liens.                    *
#------------------------------------------------------------------*
# (script Perl pour environement M$ et UNIX-LIKE)                  *
# créé par alain Adelmar (2003~4.03) à Pessac 6 rue de Tunis 33600 *
#*******************************************************************
# $ID$ - se script fonctionne et répare pas mal d'erreurs
# chargement et initialisation de var systeme
use Cwd;
$dir = cwd;

local $mod_affichage = 7;
local $opd = 3;
use FrDate;
$fd = maintenant($mod_affichage);
print "$fd\n";

if ($ENV{"MACHTYPE"}=~ /[msys|cygwin|gnu]$/) {
	$gnus++;
	print "perhaps you drive on like-gnu OS, engage!\n";
}
elsif ($ENV{"PATH"}=~ /^\//) {
	$gnus =1;
	print "this is a real gnu OS, congratulation\n";
	}

$lx = "*-" x 25;
@gnul = ( "\\", "\/");   #pas mal because $gnul[$gnus] sera toujours bon, je suis trop fort


# -----------traitement argument - 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 = "u") if ($ARGV[0]=~ /^u/);   # pour update
    ($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: vlnk.pl [-cou] [dossier_a_traiter] [sous-dossier_image]\n(made by $programmeur\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;
}

#--------------- initialisation des variables ------------------------- debut
$e_mailp = 'aadelmar@free.fr';
$countlnk = $cnta = $cntlnkhttp = $countpl = $cntlnknet = $cntlnkftp = $z = $c = 0;
$programmeur = "alain Adelmar (the great)";
$firstline = "Editer par la vers: 3.5 de vlnk.pl " . "@ARGV" . " ce jour $fd :\n";

$x_down = " " x 47;
# $x_down = ("*-" x 24) . "||";                      # fioritures qui soulignes
$y = "__-__*" x 15;                                         # idem pour différencier
$al = "\t|     === A_l_a_i_n -\/\/- A_d_e_l_m_a_r ===      ||";    # pub perso
#--- explication pour l'utilisateur
$lbl = "\n\tCe script $ARGV[0] 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";
&ouvre_vrl;

#----------------- sortie formatée pour l'affichage fichiers/tags --------- ok
format VRL_TOP =
Page @<<
$%

 Fichier              							Flags               Num     Rep
===============      							==============      =====   ======== 
.

#création et ouverture d'un rep temporaire pour placer le nouveau site
$newsite = "$dir" . "\/nw" . "$ds";
&faitmoitmp;   #johnny, johnny
$path_tmp = "$tmp\\";
print "\t$lx\n$al\n\t" . "|" . "$x_down" . "||" . "\n\t$lx\n\n$lbl\n";

#---------- choix du repertoire temporaire-------------\
sub faitmoitmp {
  my $q = 0;
  if (-e $newsite) {
    while (-e $newsite) {
      $q++;
			$newsite = "$dir" . "\/newsite" . "_$q";
    }
    mkdir $newsite or die "ouverture de $newsite impossible $!";
  }
  else {
    mkdir $newsite or die "ouverture de $newsite impossible $!";
  }
	$tmp = "$newsite" . "$gnul[$gnus]" . "log_tmp";
	mkdir $tmp or die "création de $tmp impossible $!";
	$path_tmp = "$tmp" . "$gnul[$gnus]";
	$path_newsite = "$newsite" . "$gnul[$gnus]";

  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";
}


#----------ouverture du rep, lecture lsfile => recup_all_tags = %h_tencre
opendir R, "$d" or die "Ouverture repertoire $d impossible $!";
@lsfile = (sort readdir R);
closedir R or die "Fermeture du repertoire R impossible $!";
print "$lx$lx\n";
&ouvre_fut;
print FUT "récapitulatif de tout les liens avec encres\n$lx\n\n";
&recup_all_tags;
close FUT || die "Oups $fut ne peut pas ce fermer $!";
#----------------------------------------------------------------(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) {
  $c++;
	&ouvre_fsr;
  print "$firstline$lx\n";
  #----------------------------------------------a là
  if ($file =~ /\.htm|\.dat|\.txt|\.log|html$/) {
    print "$lx\n";
    &controle_file;
    &reparation;
    &compte_rendu;
    push @rep, $file;
  }
  #-------------facultatif
  $pfile = "\t$file\n\t" . '*******' . "\n"; 
  print FSR "$pfile";
}
close FSR || die "fermeture de $fsr impossible $!";
closedir RC || die "Fermeture de $path_tmp impossible (putain de merde) $!"; 
#-------------------------------------------------------------------fin


#-----recherche de concordance entre liens et encre ------------------------debut
sub controle_file {
  #initialisation des variables
  my (@contenu)= "";
  $filesrc = "$path_tmp" . "$file";
  $mod_affichage = 7;
  $opd = 1;
  $frd = datefichier;
  print "\t$lx\n$file du $frd\n";
  #----------------------------------
  open FI, "$filesrc" or die "Ouverture du fichier $file impossible $!";
  @contenu = <FI>;
  close FI || die "Fermeture impossible $!";
  my $countpl = 0;
  ($troncfile, $ext)=split(/\./, $file);
  $fili = "$dir" . "\/" . "topo_" . "$troncfile" . "\.log";
  &gnotise($fili);
  foreach $line(@contenu) {
		$countpl++;
		my $countpfl = 0;
		my $mot = "href=\"(.*?)\"\>";
		my @ls_m = ($line =~ /$mot/ig);
		foreach (@ls_m) {
			$lnkbrut = $_;
			$oldlb = $lnkbrut;
			my $countpfl++;
			$i++;
			print FSR "fichier $file lien brut: $lnkbrut ligne: $countpl num: $countpfl\n";
			$err = "err f:$file lkb:$lnkbrut l: $countpl n: $countpfl\n";
			print "$lnkbrut\t$i\n";
			if ($lnkbrut=~ /^mailto/) {
				($kk, $email) = split(/:/, $lnkbrut);
				($login, $fai) = split(/\@/, $email);
				$cnta++;
				$eb++;
				print FL "login = $login et fai = $fai\n";
				#------------------------modification perso
				if ($email =~ /^a.?adelmar\@wanadoo\.fr/) {
					$e_mailp = "aadelmar\@free\.fr";
					print FSR "erreur adresse corrigé $email deviens $e_mailp\n";
					print FL "erreur adresse corrigé $email deviens $e_mailp\n";
					$ea++;
					$line =~  s/()$email()/$1$e_mailp$2/;
					# 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;
			}
			#--------lien vers news-groupes trouvé
			elsif ($lnkbrut=~ /^news/) {
				($kk, $nws) =split(/:/, $lnkbrut);
				print FL "news-groupes trouvé $nws\n";
				$eb++;  #pas sur
				&chklnk;
			}
			#--------------------http
			elsif ($lnkbrut=~ /^http:\/\//i) {
				($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
				&chklnk;
			}
			#------------------ftp
			elsif ($lnkbrut=~ /^ftp:\/\//i) {
				($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
				&chklnk;
			}
			#-------------------local (ce qui nous interresse)
			else {
			SCONTROL:if (exists ${{reverse %h_tencre}} {$lnkbrut}) {
					print FL "gagné lien n°:$v\n";
					$v++;
					$eb++;
					&chklnk;
				}
				else {
					# assignation des valeurs lnknet et encre
					($lnknet, $encre) = split(/\#/, $lnkbrut);
					$cntlnknet++;
					$prlnknet = "$file ligne:" . "$countpl\t" . "$lnknet\t" . "$encre";
					print FL "premier pas bon $err\n$prinknet\n";
					push @lnk_net, $prlnknet;
					# nettoyage du path (Unix et Windaube)
					if ($lnknet =~ /[\/]|[\\]|[\.]/) {
						$ef++;
						print FL "ce lien ete trop long et maintenant vaut\n";
						&degage_path;
						print FL "$err\n$line\n";
					}
					elsif(exists ${{reverse %h_tencre}} {$lnknet}) {
						$ef++;
						$lnkbrut = $lnknet;
						print FSR "$lx\nLe lien $lnkbrut n\'a pas de correspondance\n";
						print FSR "il a été remplacer par $lnknet\n";
						print FSR "pour situer $err\n$lx\n";
						print FL "tout est ok donc avec $err\n";
						$fr++;
						&chklnk;
					}
					else {
						print FSR "pour traquef $err";
						print FL "$lx:real probleme (ca va passer a traquef\n";
						$ef++;
						&traquef;
						print FL "ok, maintenant la line vaut $line\n";
						$h_lnknet{"$lnknet" . ":" . "$cntlnknet"} = $encre;
					}
				}
			}
		}
		push @nwcontenu, $line;
	}
	close FL || die "Fermeture de $fili impossible $!";
}


			




#-------------------------------------------Traque file -------------------------- Debut
sub traquef {
  # ici traité les local (if ($lnknet eq "") { &traite_encre}
  # les encres seules en guise de linknet (a voir pasposs no h_tencre)
  if ($linknet =~ ~/^\#/) {
    #--a tége
    print FSR "zarb traq av(1b) $err\n";
    #-------------
    $lnkbrut = "$file" . "$linknet";
    #--a tége
    print FSR "zarb traq ap(1b) $err\n";
    #-------------
	 &chklnk;
  }
  elsif ($lnkbrut =~ ~/^\#/) {
    $lnkbrut = "$file" . "$lnkbrut";
    #--a tége
    print FSR "zarb traq ap(1b) $err\n";
    #-------------
	 &chklnk;
  }
  elsif ($lnkbrut =~ /[^\/]|[^\\]|[^\.]/) {
    #--a tége
    print FSR "troplong traq av(3b) $err\n";
    #-------------
    my (@lch) = split(/\\/, $lnkbrut);
    $lnkbrut = pop @lch;
    #--a tége
    print FSR "troplong traq ap(3b) $err\n";
    #-------------
	 &chklnk;
  }
  else {
    print FSR "pb lnknet a resoudre / user pour $err\n";
    $gf++;
    unless (&regarde) {
	 	# voir si reparef soigne déja le mot
      &reparef;
    }
	&chklnk;
  }
}
#------------------------------------------------------------------------- fin



#----------------------------------------Compte rendu ---------------------------debut
sub compte_rendu {
  $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 "\n$lx\n";
  print FRAP "liens de $file trouvé:\n";
  foreach $lk(@lnk_net) {
    print FRAP "liens vers la page: $lk\n";
  }
  print FRAP "$lx\navec le hashage now\n";
  while ( ($key, $value) = each %h_lnknet) {
    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 $countlnk liens dans le fichier $file :\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 "$cntlnknet sur $file\n";
  print FRAP "recap total de $cntlnknet liens \/page:\n$gf 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 $frd\n";
  close FRAP || die "dreumer ca bloque $!";
  # --------------------------------remise a zero de nwlines et incremente index rapport
  @nwcontenu = "";
  $ir++;
}
#------------------------------------------------------------------------------------- fin


#-----------------------------repare file---------------debut
sub reparef {
  print "$y\nProbléme:dans traquef (page non reconnu):file:$filesrc ligne:$countpl\nAucune correspondance pour le lien:\n\t$lnknet: et ou l\'encre $encre\nchoisissez dans la liste ci-dessous puis\n[0 99] entrer le numero à droite du fichier vers qui il doit pointer:\n[Enter] - Si vous désirez laisser en l\'etat\nR:monlien_a_ne_pas_verifier - Si vous entrez un substitut et que vous ne voulez pas qu\'il soit vérifié\n";
  print "$lx\nregader la liste des fichiers\n";
  $ef++;
  $cp= substr($lnknet, 0 , 1);
  $num_sel = 0;
  foreach $f(@rep) {
    if ($f =~ /^$cp/i) {
      print "$f \t$num_sel\n";
      push @numf, $f;
      $num_sel++;
    }
  }
	#si rien ne match affiche tout les fichiers
	if (scalar @numf == 0) {
		foreach $f(@rep) {
			print "$f \t$num_sel\n";
			push @numf, $f;
			$num_sel++;
		}
		&choise;
	}
	else {
		&choise;
	}
}
#---------------------------------------------------------------------- fin



#-----------------------------Recup_all_tags------------------------------ debut
sub recup_all_tags {
  #--activer format VRL et stockage de toutes les encres de tout les fichiers dans vrl.log
  # voir les variables  du script dans vrlk_var.log
  $vrl = select(VRL);
  $~ = "VRL";
  $^ = "VRL_TOP";
  select ($vrl);
	
  foreach $likef(@lsfile) {
		next if ($likef=~ /^\./);
		if (-d $likef) {
			opendir SR, "$likef" or die "Ouverture de $likef impossible $!";
			@lf2srep = readdir SR;
			closedir SR or die "scregneugneu what thats $likef ne veut pas se fermer $!";
			foreach $sf(@lf2srep) {
				next if ($fs=~ /^\./);
				$afrep = $likef;
				$file = $sf;
				$relatpathname = "$likef" . "$gnul[$gnus]" . "$file";
				print "Boucle dans image rep: $afrep file: $file relatpathname: $relatpathname\n";
				# encre pointant juste sur un fichier (images)
				$h_tencre{$z}= "$relatpathname";
				push @prfile, $relatpathname;
				$z++;
				#ici controler si srep = $likef
				#a completer ici si on veut pouvoir ouvrir aussi ceux-la.
			}
		}
		$file = $likef;	
		$afrep = $sd;
		# ici vont les fichiers du rep source
    # reinitialisation de $avec_tag
    $avec_tag = 0;
    # encre pointant juste sur un fichier (images)
    $h_tencre{$z}= "$file";
    $z++;
    # re-ajouter le path au nom de fichier
    if ($d =~ /\/$/) {
      $ftagsrc = "$d" . "$file";
    }
    else {
      $ftagsrc = "$d\/$file";
    }
    # vérif mode (html, tml, htm, xml, etc..)
    if ($file =~ /\.h?tml?$/) {
			$mod_affichage = 7;
			$opd = 1;
			$frd = datefichier($mod_affichage, $opd, $file);
      open FT, "$ftagsrc" or die "Ouverture du fichier $file impossible $!";
      @lines = <FT>;
      close FT || die "Fermeture impossible $!";
      foreach $line(@lines) {
				if ($line =~ /<body\>/i) {
					# traitement de l\'option c et u en prevision (pour pas reouvrir)
					if ($argv eq "c") {
						$line = $line . '\n<a name="_top">' . "\n";
						print FUT "ajout par $ARGV[0] de l'encre top a la ligne:\n$ligne\n";
						push @copim, $line;
					}
					elsif ($argv eq "u") {
						$line = $line . '\n<-- mise à jour du document par ' . "$ARGV[-1]" . "le $fd \ninitialement daté du $frd" . "\n";
						print FUT "ajout par $ARGV[0] de l'encre top a la ligne:\n$ligne\n";
						push @copim, $line;
					}
					else {
						&cherche_encre;
						push @copim, $line;
					}
        }
				else {
					&cherche_encre;
					push @copim, $line;
					$linetag++;
				}
      }
      &faitdcopies;
      @copim = "";
    }
  }
  #--------surement a degager mais voir diff avec FAT 
	print FUT "fichier:n°ligne:encre:compteur\n";
	foreach $e(@lsctag) {
		print FUT "$e" . "\n";
	}
  #----------a degager quand pris en compte---voici les trois hachage
  print FUT "$lx\nvoici les trois hachage:\nh_tencre\n";
  while (($zo, $hf) = each %h_tencre) {
    print FUT "$zo:$hf\n";
  }
  #-----------------------------------
  close VRL || die "double dremmer closure of $vrl not possibilé $!";
}

#------------------------------------------------------------------------------------ fin


#---------------------------------------------------------- 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
  unlink (@nwcontenu);  # ou @nwcontenu = @nwl = "";
  close FR || die "Fermeture de $fcible impossible $!";
}


sub cherche_encre {
  if ($line=~ /<a\sname="(.*?)"/i) {
    $avec_tag++;    # marquer si le fichier à un tag, si il n'en a pas le marquer (option c)
    $tag = $1;
    $fz = "$file:$linetag:$tag:$z";
		print FSR "encre ok dans $fz\n";
    # --- encre seule pour lien pointant a l'interieur de son fichier
    $h_tencre{$z}= '#' . "$tag";    # peut etre enlevé la ligne dessous si celle là fonctione
    $h_tag{$z}= "#" . "$tag";
    # --- liste composant un lien pointant sur un tag de ce meme fichier
    $h_tencre{$z}= "$file" . '#' . "$tag";
    write(VRL);
    # ici on peut mettre le controle comme on veut (en @ ou %)
    push @lsctag, $fz;
    $z++;
  }
}

sub regarde {
	$lnktmp = "$lnknet" . "#" . "$encre";
	$lnktmpe = "#" . "$encre";
	
	if (exists ${{reverse %h_tencre}} {$lnktmp}) {
		print FSR "cool ca marche $v\n";
		&chklnk;
		return 1;
	}
	elsif (exists ${{reverse %h_tencre}} {"$file" . "$lnktmpe"}) {
		print FSR "réparé $v\n";
		$lnkbrut = "$file" . "$lnktmpe";
		&chklnk;
		return 1;
	}
	elsif ($encre eq "") {
		&chklnk;
		return 1;
	}
	else {
		print FSR "zarb regarde fail => reparfile $err\n";
		return 0;
	}
}

#---------------------------------------------------------------degage_path
sub degage_path {
	print FSR "path trop long $err\n";
	# nettoyage du lnkbrut du chemin UNIX-Like
	if ($lnknet =~ /\//) {
		@pathl = split(/\//, $lnknet);
	}
	# nettoyage du lnkbrut du chemin MS
	elsif ($lnknet =~ /\\/) {
		@pathl = split(/\//, $lnknet);
	}
	else {
		while ($lnknet =~ /^\./) {
			$lnknet =~ s/^.()/$1/;
			&lknet2lnkbrut;
			&control_file;
		}
	}
	# a tége quand good--------------------
	print FSR "$lx\nliste pathl:" . "@pathl" . "\n";
	$fpointe = pop @pathl;
	print FSR "fpointe: $fpointe\n";
	if (($pathl[scalar @pathl - 1]) eq "$srep") {
		$lnknet = "$srep\/$fpointe";
		if ($encre eq "") {
			$lnkbrut = "$lnknet";
			$fr++;
			#--a tége
			print FSR "reparer par L257 $err\n";
			#unless (&regarde) {
			#				&reparef;
			#			}
			&chklnk;	
			print FSR "reparer par L642 $line\n";
		}
		else {
			$lnkbrut = "$lnknet" . "#" . "$encre";
			#	unless (&regarde) {
			#				&reparef;
			#			}
			$fr++;
			&chklnk;
			print FSR "reparer par L642 $line\n";
		}
	}
	else {
		$lnkbrut = $lnknet = $fpointe;
		#$mot =  s/()$oldlb()/$1$fpointe$2/;
		#&chklnk;
		#--a tége
		print FSR "reparer par L271 $err\n";
		#		unless (&regarde) {
		#			&reparef;
		#		}
		$fr++;
		&chklnk;
	}
}

#-----------------------------------------ouvre_fut
sub ouvre_fut {
	my $i = 0;

	$fut = "$path_tmp" . "encre.log";
	while (-e $fut) {
		$fut = "$path_tmp" . "$gnul[$gnus]" . "encre_" . "$i" . ".log";
		$i++;
	}
	open FUT, ">$fut" or die "Ouverture de $fut impossible $!";
	print FUT "script: vlnk.pl (V.3.1)- date: $fd\n$lx\n\nfichier:n°ligne:encre:compteur\n";	
}


sub faitdcopies {
  $copie = "$path_tmp" . "$file";
  open FC, ">$copie" or die "Ouverture de $copie impossible $!";
  print FC "@copim";
  print FC '<-- fichier initial ' . "$file daté du $frd" . ' !-->';
  close FC || die "Fermeture de $copie impossible $!";
  
  $h_tencre{$z}= "$file";
  $h_fst{$z}= "$file";
  $z++;
}

sub lknet2lnkbrut {
	if($encre eq "") {
		$lnkbrut = "$lnknet";
	}
	else {
		$lnkbrut = "$lnknet" . "\#" . "$encre";
	}
}

#-------------------------------------ouvre_vrl
sub ouvre_vrl {
	my $i = 0;

	$vrl = "\.\/vrl.log";
	while (-e $vrl) {
		$vrl = "\.\/vrl_" . "$i" . ".log";
		$i++;
	}
	open VRL, ">$vrl" or die "Ouverture de $vrl impossible $!";
	print VRL "script: vlnk.pl (V.3.1)- date: $fd\n$lx\n";	
}

#--------------------------------ouvre fsr
sub ouvre_fsr {
	my $c =0;
	
	$fsr = "$path_tmp" . "sorti_vlnk_" . "$c" . "\.log";
	while (-f $fsr) {
		$c++;
		$fsr = "$path_tmp" . "sorti_vlnk_" . "$c" . "\.log";
	}
	open FSR, ">$fsr" or die "Ouverture de $fsr impossible $!";
	$remd = "vers 3.0 de vlnk.pl - ce script repare les liens brisés\n";
	print FSR "script $ARGV[-1]" . "@ARGV" . " le $frd\nremarque: $remd\n";
}

sub choise {
	print "\n\nNom du fichier désigné:";
	$user_lnknet = <STDIN>;
  chomp $user_lnknet;
	
  if ($user_lnknet =~ /^\d/) {
    $lnknet = "$numf[$user_lnknet]";
    #le nouveau nom de fichier viens ici----_
    if ($encre eq "") {
			$lnkbrut = $lnknet;
			&chklnk;
    }
    else {
      $lnkbrut = "$lnknet\#$encre";
			# pas sur qu'il serve a quelque chose ce controle mais a voir
			#      unless (&regarde) {
			#				&control_encre;
			#			}
			
			&chklnk;
    }
    print "$lx\nvotre choix est $user_lnknet donc $lnknet\n";
    # tmp no controle d'encre ici
	 unlink @numf;
    @numf = "";
    $fr++;
    goto LABELPARDEF;
  }
  elsif ($user_lnknet=~ /^R:\w/) {
    ($kk, $lnknet)=split(/:/, $user_lnknet);
    $lnkbrut = "$lnknet";       #ce que rentre l'user doit etre le lien complet ou
    #$lnkbrut = "$lnknet\#$encre";
		&chklnk;
    $fr++;
    goto LABELPARDEF;
  }
  elsif ($user_lnknet eq "") {
    &chklnk;
    $fr++;
    goto LABELPARDEF;
  }
  else {
		$lnkbrut = $user_lnknet;
		&chklnk;
    goto SCONTROL;
  }
}



#------------------------------------------------------------------------verifd
sub verifd {
	$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";
	$psr1 = "avez vous un sous-repertoire (pour les photos, icones, etc)\nsi oui lequel: (expl: images)\n";
  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>);
  }
	(@ds = split(/\\/, $d)) if ($gnus == 0);
	(@ds = split(/\//, $d)) if ($gnus == 1);
	#-----------ouverture lecture, assignation @lsfile, controle srep
	opendir R, "$d" or die "Ouverture de $d impossible $!";
	@lsfile = (sort readdir R);
	closedir R or die "Fermeture du repertoire R impossible $!";
	foreach 
	
  $ds = pop @ds;
	#avoir $d propre
	#chop $d if ($d = ~/\/$|\\$/);
	#-------------probleme
	if ($srep =~ /\w/i) {
		if (!(-e $srep)) {
			print "$psr\n";
			chomp ($srep = <STDIN>);
		}
	}
	else {
		# --demande si il doit y avoir un sous-repertoire (style ./images)
		print "$psr1\n";
		chomp ($srep = <STDIN>);
	}
}

sub chklnk {
	$line =~ s/()$oldlb()/$1$lnkbrut$2/;
}

sub gnotise($fili) {
	my($fili)=@_;
	
	while (-e $fili) {
		$arch= "$fili" . "~";
		rename $fili, $arch or die "Renomage de $fili impossible $!";
		}
		open FL, ">$fili" or die "Ouverture de $fili impossible $!";
		print FL "log cree par vlnk.pl (v:4.0) le $fd\n";
	}
	

format VRL =
@<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<< @<<<< @<<<<<<<<<<<
$file, $tag, $z, $afrep
.

# script Perl écrit par alain Adelmar
END;

#-------------pour tous les fous de code voir en police (Lucida Console 9)
#
#                                   ,-::%%%%%%=.
#                                  /:::%%%(:  "-:.
#                                ,:::%:%%%f:     :
#                                f:::%:%%%%,   ."`.
#                               i::::%%:%%%%, .',-t 
#                              j::::::%:%%%%i 'i  `i 
#                              :::::::%:%%%%%  :_-=".
#                             /:::::::%%%%%%%i      t 
#                            ,:::::::::%%%%%%; .    ]
#                            f:::::::::%%%%%;  ,.   j,-""-.
#                           /::::::::::l%%%%f <-*`,'/      `.
#                          /::::::::::l%%%%;:: "`","         \\
#                         /:::::::::::l%%%;:-:__.,"           \\ 
#                        ;:::::::::::l%%%;::::: /              :
#                       j::::::::::::l%%; ' '        .      __,| 
#                       :::::::;:-''"                `.  ,%8888&n
#                      j::::::'  _.                  :`.n88%888&i
#                      |:::::+,-"     ,-  _.n%%%n.. :::<&88%888&b
#                      |::;+%%%n. ..:/  .n%%%%%%%%%. :::&888%888&
#                      |:/%%%%%%%8+:i  +%%%%%+%%%o%%.::::&88%888&
#                      `(%%*%%%%*88%|.%%%*%%%%%%%%%%|::::&888%88&i
#                        %%%%%%%%888888%%%%%%(@)%%%8::::::&88%88&H
#                        `%o%%%*%8o88888%%%%%%%%%888i::::/|&88%88&i
#                          `%%%%%88888%%%\8888U88888;:::/ `888%888&
#                            `%%8%%%%%%8888886888*88j::/   H888%88&h
#                              i%*%%%%o%%88888888888i:/    `888%888&
#                              `%%%%%%%%%%8888888888%Y      H888%88&i
#                               |%%%%%%%%%%%%8888888/        }88%88&i
#                               (-__-_@@-_-_-_-_-_-_|         `888%88&)
#                               (-_-_-@@-*-_-.-_-..,-\         |88%88&.
#                               $%%%% %%%%%%%%%%%%%%%%`.        '88%8&|
#                              /%%%%% %%%%%%%%%%%%%%%%%`.        88&88a
#                             /\%+%%%% %%%%%%/=          \        888%8i
#                            /  \%%%%%% %%%%'             \       `88%8a
#                           /    `%%%%%%%%'                \      '|-°'8¤88a
#                          /      `%%%%%'                   + -----`nmi nn--\-=
#                         /        `%%%'                     :      `mun|
#                        /          `%'                       |       `u.)
#                       /            '                        :========-.====aa
#-----------------------------------------------------------------------------|
