Verylink  _ vers: 1.0 _ Un vérificateur de liens pour vos pages perso.   aal

alain Adelmar
                                                                          aadelmar@numericable.fr beuuh c est quoi ca

Verylink est un script Perl écrit pour vérifier les liens du répértoire contenant votre site (publications, page perso).
C'est à dire qu'il vérifie tous les liens de tout les fichiers (html, htm):
Travaille sur une copie de votre travail et la place dans un répétoire temporaire:  ~ temp\newsite
Recherche la corespondance dans chaque cible locale.
Répare les erreurs d'acheminement local, expl: <a href="C:\pub\monsite\index.html">sommaire</a>
Attribut à defaut la première encre trouvé ou la remplace par <a href="nom_du_fichier.ext#top_">
Fait un rapport complet de chaque liens par page avec numero de ligne et changement de couleur/problème >rap_page.log.
Regroupe l'essentiel (les statistiques, les erreurs) dans un fichier:    verylnk.log
Le tout dans le dossier temporaire, pour ne rien modifier dans votre dossier source.
Deux script: un couleur pour UNIX l'autre pour le MSDOS de Windows et l'autre pour le shell de Linux (UNIX-Like).
Ce script s'exécute a partir d'un terminal (console MSDOS, Bash ou Scite) ou tout autre éditeur qui prend en compte le STDIN et le STDOUT.
La prochaine vérsion sera automatique ou exécutable en mode graphique.

Ce script est très vieux et quasiment obsolête, il a plus de 10ans (voir la dernière moture dans ver2l.html

alain Adelmar



#!/usr/bin/perl -w
# remd:  Répare les liens en local (avant de publier) en les testant. version :1.08 | 03 Mai 2003        *
# répare les erreurs d'afféctation et les incompatibilité dues aux changements de systeme UNIX-Like=>M$. *
# Vérif des encres et ré-attribution du premier flag et/ou création d'un #top_ (si page existe sans flag)*
# écrit par alain Adelmar a.adelmar@wanadoo.fr | vers: 1.09 (beta)    |  date: 2002 ~ 05/05/2003 19h     *
# fignolé la séléction par l'utilisateur en se servant des flêches directionnelles pour choisir          *
#--------------------------------------------------------------------------------------------------------*
#                 ca marche mais il y a des retouches a faire                 | (version pour UNIX-Like) *
#*********************************************************************************************************
$programmeur = "alain Adelmar";
# remet une page blanche au shell
system '/usr/bin/clear'; 
# sortie formatée pour l'affichage fichiers/tags
format VRL_TOP =
Page @ << 
$% 

 
Fichier                     Flags                 Num
===============             ==============        =====
.


# initialisation des variables
$e_mailp = 'a.adelmar@wanadoo.fr';
$countlnk = $cnta = $cntlnkhttp = $cntl = $cntlnknet = $cntlnkftp = $z = $c = 0; 
$maintime = localtime(time);
$firstline = "Editer par " . $ARGV[-1] . "ce jour $maintime :\n";
#-------------------------------------------------------------------------------------
$x = "*-" x 25;
$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 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";

#création et ouverture d'un rep temporaire pour placer le nouveau site ainsi créé (pour UNIX-Like).
$stemp = "\/tmp";
$newsite = "\.\/newsite";
$fsr = "\.\/sorti_verylink_" . "$c" . "\.log";
open FSR, ">$fsr" or die "ouverture de $fsr impossible $!"; 
print FSR "récapitulatif de tout les liens avec encres\n$x\n\n";
print "\t$x\n$al\n\t" . "|" . "$x_down" . "||" . "\n\t$x\n\n$lbl\n";
#------------------------------------- choix du repertoire temporaire
while (!(-e $newsite)) {
  
print "La copie réparer de votre site sera copié sur $newsite:[Oui-Non] ou [path dossier] ou Quitte\n";
  
$rcible =<STDIN>;
  
chomp $rcible;
  
if ($rcible =~ /^o|y|\n/i) {
    
mkdir $newsite,0777 or die "ouverture de $newsite impossible $!";
  
}
  
elsif ($rcible =~ /^n/i) {
      
print "ok le dossier cible se trouvera dans le repertoire temporaire \/tmp\/newsite\n";
      
$nws = "\/newsite";
      
if (-e $stemp) {
   
mkdir $nws,0774 or die "Création du dossier newsite impossible $!";
   
print "création du dossier newsite effectué\nil sera dans le repértoire: \/home\/newsite\n";
   
$newsite = "\/home\/newsite";
      
}
      
else { die "Vous avez un gros problême vu que vous n'avez pas de répértoire \/tmp\nconseil le prochain coup repondez oui\nou donner un chemin correct\n $!" }
    
}
  
elsif ($rcible =~ /^q/i) {
    
die "Tchao !!! a la prochaine\n";
  
}
  
else {
    
$newsite = $rcible;
  
}
}


#--------------------------demander quel repertoire traiter et verifier si il existe
print "$x$x\n";
print "Indiquez le dossier a traiter:\n"; 
chomp($d =<STDIN>); 

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

#--------------juste pour recapitulatif
# $fout = "\.\/repV.log"; 
#----------ouverture du repertoire, assign de la list de file, et traitement file/file
opendir R, "$d" or die "Ouverture repertoire impossible $!"; 
@lsfile = (sort readdir R);
print "$x$x\n";
&recup_all_tags;

foreach $file(@lsfile) {
  
#---- juste pour voir comment ca tourne ---- de là
  
close FSR || die "fermeture de $fsr impossible $!";
  
$c++;
  
open FSR, ">$fsr" or die "ouverture de $fsr impossible $!";
  
print "$firstline$x\n";
  
#----------------------------------------------a là
  
if ($file =~ /\.htm|\.dat|\.txt|\.log|html$/) {
    
print "$x\n";
    
&controle_file;
    
&reparation;
    
&compte_rendu;
    
push @rep, $file;
  
}
  
#-------------facultatif
  
$pfile = "\t$file\n\t" . '*******' . "\n"; 
  
print FS $pfile; 
  
  
#--------------
}
closedir R or die "Fermeture du repertoire R impossible $!"; 
#---------------------------------recherche des flags

#--------------------------------------------pour chaque fichiers voulu, ligne par ligne
sub controle_file {
  
$filesrc = "$d\/$file";
  
$fs = "\.\/rap_vlnk_" . "$file" . "\.log";
  
# a degager quand ok---------------
  
open FS, ">$fs" or die "Ouverture de $fs impossible $!";
  
print "\t$x\n$file\n";
  
#----------------------------------
  
open FI, "$filesrc" or die "Ouverture du fichier $file impossible $!";
  
@lines = <FI>;
  
close FI || die "Fermeture impossible $!";
  
  
foreach $line(@lines) {
    
$cnttl++;  #compteur de lignes traité (total)
    
$cntl++;   #index de ligne, par document, pour recherche.
    
if ($line=~ /<a\shref="(.*?)"/i) {
      
$lnkbrut = $1;
      
$countlnk++;
      
#--------lien mailto trouvé
      
if ($lnkbrut=~ /^mailto/) {
   
($kk, $email) =split(/:/, $lnkbrut);
   
# ($login, $fai) = split(/\@/, $email); # si on veut sortir les logins
   
push @man2mail, $email;
   
$cnta++;
   
#------------------------modification perso
   
if ($email =~ /^aadelmar/) {
     
s/$email/$e_mailp/;
     
print FS "modification d'adresse mail effectué sur $file ligne $cntl\n";
   
}
      
}
      
#--------lien vers news-groupes trouvé
      
elsif ($lnkbrut=~ /^news/) {
   
($kk, $nws) =split(/:/, $lnkbrut);
   
print FS "news-groupes trouvé $nws\n";
      
}
      
#--------------------http
      
elsif ($lnkbrut=~ /^http:\/\//i) {
   
($lnkhttp, $encre) = split(/\#/, $lnkbrut);
   
$cntlnkhttp++;
   
$prlnkhttp = "$file ligne:$cntl\t$lnkhttp\t$encre";
   
push @lnk_http, $prlnkhttp;
   
# ou en hashage
   
$h_lnkhttp{"$lnkhttp" . "_" . "$cntlnkhttp"} = $encre;
      
}
      
#------------------ftp
      
elsif ($lnkbrut=~ /^ftp:\/\//i) {
   
($lnkftp, $encre) = split(/\#/, $lnkbrut);
   
$cntlnkftp++;
   
$prlnkftp = "$file ligne:$cntl\t$lnkftp\t$encre"; 
   
push @lnk_ftp, $prlnkftp;
   
   
#-------------- ou en hashage
   
$h_lnkftp{"$lnkftp" . "_" . "$cntlnkftp"} = $encre;
      
}
      
#---------------------local
      
else {
   
# nettoyage du lnkbrut du chemin MS ou UNIX
   
if ($lnkbrut =~ /\//) {
     
print FSR "trop long lnkbrut UNIX dans ( $file :l $cntl ) $lnkbrut \n";
     
@lsl = split(/\//, $lnkbrut);
     
$lnkbrut = pop @lsl;
   
}
   
elsif ($lnkbrut =~ /\\/) {
     
print FSR "trop long lnkbrut MS dans ( $file :l $cntl ) $lnkbrut \n";
     
@lsl = split(/\\/, $lnkbrut);
     
$lnkbrut = pop @lsl;
   
}
   
# assignation des valeurs lnknet et encre
   
($lnknet, $encre) = split(/\#/, $lnkbrut);
   
# $encrep = "#" . "$encre";
   
$cntlnknet++;
   
$prlnknet = "$file ligne:" . "$cntl\t" . "$lnknet\t" . "$encre";
   
push @lnk_net, $prlnknet;      # pour avoir une liste de liens par pages
   
#------------------------------controle les ceux qui fonctionne dessuite
   
# ceux qui pointent vers une autre page existante avec encre
   
if (exists ${{reverse %h_fntag}} {$lnkbrut}) {
     
print FSR "gagné lien n°:$v\n";
     
$v++;
   
} 
        
# ceux qui pointe sur un fichier seul (sans encre)
        
elsif (exists ${{reverse %h_fst}} {$lnkbrut}) {
          
print FSR "gagné lien n°:$v\n";
     
$v++;
     
undef $encre;
   
}
        
# ceux qui pointent sur eux meme
   
elsif (exists ${{reverse %h_tag}} {$lnkbrut}) {
          
print FSR "gagné en local avec h_fntag sur eux meme n°:$v\n";
     
$v++;
   
}
         
#-----------a degager si non sorti because 2 ctrl au dessus fait pareil (ligne 182)
        
elsif (exists ${{reverse %h_fst}} {$lnknet}) {
          
print FSR "xxxxxxxx rare xxx gagné en local avec h_fst pas d encre n°:$v\n";
     
$v++;
   
} 
        
#------------------- pour traquef
        
else {
     
print FSR "pour traquef $file:" . "$lnknet:" . "$encre ligne $cntl\n";
     
&traquef;
     
$h_lnknet{$lnknet . ":" . $cntlnknet} = $encre;
     
# etre bien explicite car c'est la que ca repare (encre doit avoir un diese si linknet pas "")
     
print FS "avant $line\n";
     
&reecrirelaligne; 
     
print FS "aprés $line\n";
   
}
      
}
      
# il faut que $line soit impeccable
      
push @nwlines, $line;
    
}
    
    
else {
      
# pousser le reste dans le nouveau document
    
LABELPARDEF:$err++;$fr;
      
&reecrirelaligne;
      
push @nwlines, $line;
      
$cntl = 0;
      
undef $encre;
    
}
  
}
 
# push @LoL_http, [ @lnk_http ]; 
 
# push @LoL_ftp, [ @lnk_ftp ]; 
 
# push @LoL_net, [ @lnk_net ]; 
}


sub traquef {
  
  
# ici traité les local (if ($lnknet eq "") { &traite_encre}
  
# -----------pour controle_encre definir full_filname
 
VOIR:print FSR "ltf";
  
$full_filename= "$d\/$lnknet";
  
if (-e $full_filename) {
    
# ici tombe les fichiers qui ont, soit just lnknet (donc sans diese) soit l'encre
    
print FS "Ce linknet | $lnknet | existe donc, l'encre | $encre | pourkoi pas glop avec h\n";
    
print FSR "Ce linknet | $lnknet | existe donc, l'encre | $encre | pourkoi pas glop avec h\n";
    
$gf++;
    
if (! regarde($lnknet, $encre)) {
      
&control_encre;
    
} 
  
}
  
else {
    
print FSR "pb lnknet a resoudre / user dans ( $file :l $cntl ) $lnknet|$encre \n";
    
&reparef;
  
}
}

sub compte_rendu {
  
$file_cr= "$newsite" . "\/rap" . "$ir.log";
  
  
  
open FRAP, ">$file_cr" or die "Ouverture de $file_cr impossible $!";
  
print "$firstline$x\n";
  
print FRAP "Liens http de $file trouvé avec liste:\n";
  
foreach $lk(@lnk_http) {
    
print FRAP "adresse Web: $lk\n";
  
}
  
  
print FRAP "\n$x\navec le hashage maintenant\n";
  
while ( ($key, $value) = each %h_lnkhttp) {
    
print FRAP "$key = $value\n";
  
}
  
print FRAP "\n$x\n";
  
print FRAP "liens ftp de $file trouvé:\n";
  
foreach $lk(@lnk_ftp) {
    
print FRAP "adresse ftp: $lk\n";
  
}
  
print FRAP "\n$x\navec hashage now:\n";
  
while ( ($key, $value) = each %h_lnkftp) {
    
print FRAP "$key = $value\n";
  
}
  
print FRAP "\n$x\n";
  
print FRAP "liens de $file trouvé:\n";
  
foreach $lk(@lnk_net) {
    
print FRAP "liens vers la page: $lk\n";
  
}
  
print FRAP "$x\navec le hashage now\n";
  
while ( ($key, $value) = each %h_lnknet) {
    
print FRAP "$key = $value\n";
  
}
  
#-----------login now----
  
print FRAP "$x\n\tlogin trouvé:\n";
  
$login = join("\n", @man2mail);
  
print FRAP "$login\n";
  
print FRAP "ayant pour fai :\n";

  
#------------stat
  
print FRAP "$x\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\n$ee erreur encre\n$err encre reparrer\n";
  
$filos = join("\n", @rep);
  
print FRAP "effectuer sur les fichiers:\n" . "\n$filos\n$x\n";  #ca marche
  
print FRAP "fait le $maintime\n";
  
close FRAP || die "dreumer ca bloque $!";
  
# --------------------------------remise a zero de nwlines et incremente index rapport
  
@nwlines = "";
  
$ir++;
}

sub reparef {
  
print "$y\nProbléme:dans traquef (page non reconnu):file:$filesrc ligne:$cntl\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 "$x\nregader la liste des fichiers\n";
  
$ef++;
  
$cp= substr($lnknet, 0 , 1);
  
$num_sel = 0;
  
foreach $file(@reph) {
    
if ($file =~ /^$cp/i) {
      
print "$file \t$num_sel\n";
      
push @numf, $file;
      
$num_sel++;
    
}
  
}
  
print "\n\nNom du fichier désigné:";
  
$user_lnknet = <STDIN>;
  
chomp $user_lnknet;
  
if ($user_lnknet =~ /\d/) {
    
$lnknet = $numf[$user_lnknet];
    
print "$x\n$lnknet\n";
    
if (! regarde($lnknet, $encre)) {
      
&control_encre;
    
}
    
@numf = "";
    
$fr++;
    
goto LABELPARDEF;
  
}
  
elsif ($user_lnknet=~ /^R:\w/) {
    
($kk, $lnknet)=split(/R:/, $user_lnknet);
    
$fr++;
    
goto LABELPARDEF;
  
}
  
elsif ($user_lnknet eq "") {
    
$fr++;
    
goto LABELPARDEF;
  
}
  
else {
    
$lnknet = $user_lnknet;
    
&traquef;
  
}
}

sub elencre {
  
# ici simplement mettre un controle pour voir si ca marche sinon poursuivre
  
print FS "elencre $file $cntl | $lnknet | $encre\n";
  
print "$y\nProbléme:d'encre (non reconnu):file:$filesrc ligne:$cntl\nAucune correspondance pour l'encre:\n\t $encre\nchoisissez dans la liste ci-dessous puis\n[#] pour laisser tel que c'est sans vérifications \n[0 99] entrer le numero à droite du tag proposé:\n[Enter] - Si vous désirez par defaut (premiere encre trouver dans $lnknet)\nR:mon_encrea_ne_pas_verifier - Si vous entrez un substitut et que vous ne voulez pas qu'il soit vérifié\n";
  
print "$x\nregader la liste des encres proposés\n";
  
$ee++;
  
$cp = substr($lnknet, 0 , 1);
  
$num_sel = 0;
  
for $ve(values %h_fntag) {
    
($tmplnknet, $tmpencre) = split(/\#/, $ve);
    
if ($tmplnknet =~ /^$cp/) {
      
print "$tmplnknet\t$tmpencre\t\t$num_sel\n";
      
push @numf, $ve;
      
$num_sel++;
    
}
  
}
  
print "ou l'encre par defaut: $p_encre\t$num_sel\n";
  
print "\n\nNom de l encre désigné:";
  
$user_encre = <STDIN>;
  
chomp $user_encre;
  
if ($user_encre =~ /\d/) {
    
$encre = "$numf[$user_lnknet]";
    
print "$encre\n";
    
@numf = "";
    
$fr++;
    
goto LABELPARDEF;
  
}
  
else {
    
$encre = "$user_encre";
    
goto LABELPARDEF;
  
}
}

sub control_encre {
  
  
open FC, "$full_filename" or die "Ouverture de $lnknet impossible $!";
  
@cible = <FC>;
  
close FC || die "fremeture impossible $!";
  
#---------chercher une encre2secour | a voir dessous
  
$po = 0;
  
foreach $el(@cible) {
    
if ($po == 0) {
      
if ( $el=~ /<a\sname="$encre"/i ) {
   
$eb++;
   
print "cool $encre a été trouvé sur $full_filename ligne $cntl\n";
   
goto LABELPARDEF;
      
}
      
elsif ($el =~ /<a\sname="(.*?)"/i) {
   
$def_encre = $1;
   
$po++;
      
}
    
}
    
else {
      
if ($el =~ /<a\sname="$encre"/i) {
   
$eb++;
   
print "cool mon $encre a été trouvé sur $full_filename ligne $cntl\n";
   
goto LABELPARDEF;
      
}
    
}
  
}
  
if ($po == 0) {
    
# --- je ne sais pas si je dois imposer une encre?
    
$p_encre = "_top";
  
}
  
else {
    
$p_encre = $def_encre;
  
}
  
$err++;
  
$ee++;
  
&elencre;
}


sub recup_all_tags {
  
#--essai de formater dans un fichier pour eviter FAT
  
$vrl = "\.\/vrl.log";
  
$vrl = select(VRL);
     
$~ = "VRL";
     
$^ = "VRL_TOP";
     
select ($vrl);
  
open VRL, ">$vrl" or die "Ouverture de $vrl impossible $!";
  
  
foreach $file(@lsfile) {    # ici $file vaut ~ nom_de_fichier.html
    
if ($d =~ /\/$/) {
      
$ftagsrc = "$d" . "$file";
    
}
    
else {
      
$ftagsrc = "$d\/$file";
    
}
    
if ($file =~ /\.htm|html$/) {
      
open FT, "$ftagsrc" or die "Ouverture du fichier $file impossible $!";
      
@lines = <FT>;
      
close FT || die "Fermeture impossible $!";
      
foreach $line(@lines) {
   
   
if ($line=~ /<a\sname="(.*?)"/i) {
     
$avec_tag++;
     
$tag = $1;
     
$fz = "$file:$linetag:$tag:$z";
     
# --- encre seule pour lien pointant a l'interieur de son fichier
     
$h_tag{$z}= "#" . "$tag";
     
# --- liste composant un lien pointant sur un tag de ce meme fichier
     
$h_fntag{$z}= "$file" . "#" . "$tag";
     
write(VRL);
     
push @lsctag, $fz;
     
$z++;
     
   
}
   
$linetag++;
      
}
      
if ($avec_tag == 0) {
   
# --- fichier existant sans tag------------------
   
$h_fst{$z}= "$file";
   
$z++;
      
}
      
$avec_tag = 0;
      
push @reph, $file;
      
    
}
    
  
}
  
  
#--------surement a degager mais voir diff avec FAT
  
$fut = "\.\/vero.log";
  
open FUT, ">$fut" or die "Ouverture de $fut impossible $!";
  
$lsla = join("\n", @lsctag);
  
print FUT "fichier:n°ligne:encre:compteur\n$lsla";
  
#-------------------------------a degager quand pris en compte---voici les trois hachage
  
print FUT "$x\nvoici les trois hachage:\nh_fntag\n";
   
while (($zo, $hf) = each %h_fntag) {
    
print FUT "$hf\n";
  
}
  
print FUT "$x\nh_fst\n";
   
while (($zo, $ht) = each %h_fst) {
    
print FUT "$ht\n";
  
}
  
print FUT "$x\nh_tag\n";
  
while (($zo, $htag) = each %h_tag) {
    
print FUT "$htag\n";
  
}

  
#-----------------------------------
  
close FUT || die "Oups $fut ne peut pas ce fermer $!";
 
  
close VRL || die "double dremmer closure of $vrl not possibilé $!";
}

sub reparation {
  
$fcible = $newsite . "\/$file";
  
open FR, ">$fcible" or die "Ouverture de $fcible impossible $!";
  
print FR @nwlines;
  
close FR || die "Fermeture de $fcible impossible $!";
}

sub reecrirelaligne {
   
if ($lnknet == "") {
     
$lnkgood = "$encre";
   
}
   
elsif ($encre == "") {
    
$lnkgood = "$lnknet";
  
}
  
else {
    
$lnkgood = "$lnknet" . "#" . "$encre";
  
}
  
$line=~ s/"$lnkbrut"/"$lnkgood"/;
}


sub regarde($lnknet, $encre) {
  
my($lnknet, $encre)=@_;

  
$lnktmp = "$lnknet" . "#" . "$encre";
  
$lnktmpe = "#" . "$encre";$cp= substr($encre, 0 , 1);
  
(print FS "cool ca marche $v\n" and return 1) if (exists ${{reverse %h_fntag}} {$lnktmp});
  
(print FS "cool ca marche $v\n" and return 1) if (exists ${{reverse %h_fst}} {$lnknet});
  
(print FS "cool ca marche $v\n" and return 1) if (exists ${{reverse %h_tag}} {$lnktmpe});
  
if ($encre eq "") {
    
return 1;
  
}
  
else { 
    
return 0;
  
}
}

format VRL = 
@<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<< @<<<<
$file, $tag, $z




END;




#!perl -w
# Réparer les liens en local (avant de publier) en les testant.
# réparer quand c'est possible (erreur d'afféctation, path et (faute d'orthographe pas encore).
# Vérification des encres(flag) et (ré-attribut le premier flag ou à defaut créé un #top_)
# alain Adelmar a.adelmar@wanadoo.fr
# personel: accessoirement remplace aadelmar@free.fr par a.adelmar@wanadoo.fr

# initialisation des variables
$countlnk = $u = $i = $k = $cntlnkhttp = $cntlnknet = $cntlnkftp = $encre2secours = 0;

$x ="*-" x 25;
$w ="__-__*" x 15;
$al = "\t=== A_l_a_i_n -\/\/- A_d_e_l_m_a_r ===      |";
$lbl = "\n\tCe script va modifier les liens locaux de chaque page HTML en liens web\n\til copiera l integralite de vos pages dans un nouveau repertoire\n\tC:\\Windows\\Temp\\newsite\n";

#-----------------peut etre pas obligatoire
# $lnk_http[0] = ("liste_des_liens_http");
# $lnk_ftp[0] = ("liste_des_liens_ftp");
# $lnk_net[0] = ("liste_des_liens_local");
#----------------------

#création et ouverture d'un rep temporaire pour placer le nouveau site ainsi créé.
$stemp = "C:\\Windows\\Temp";
$newsite = "C:\\Windows\\Temp\\newsite";
$temp = "C:\\Temp";
$fs = "C:\\pub\\sorti_verylink.log";  # a degager quand ok---------------
open FS, ">$fs" or die "ouverture de $fs impossible $!";

#-------------------------------------choix du repertoire temporaire
while (!(-e $newsite)) {
   print FS "La copie réparer de votre site sera copié sur $newsite:[Oui-Non] ou [path dossier] ou Quitte\n";
   chomp($respond=<STDIN>);
   if ($respond=~ /^o|y|\n/i) {
      if (-e $stemp) {
         mkdir $newsite or die "ouverture de $newsite impossible $!";
         }
      else {
         mkdir $stemp or die "Création de $stemp impossible $!";
         }
      }
   else {
         if (-e $respond) {
            $newsite = $respond;
            }
         elsif ($respond =~ /^q/i) {
            die "Tchao !!! a la prochaine\n";
         }
      }
   }
#----------------------------------------------------

#--------------------------demander quel repertoire traiter et verifier si il existe
print FS "$x\n$al\n\n$x\n\n";
print FS "Indiquez le dossier a traiter:\n";
chomp($d = <STDIN>);

unless (-e $d) {
   print FS "Veuillez ré-entrer le chemin complet du dossier à traiter, expl:" . 'C:\Pub\mon_site' . "\n";
   chomp($d = <STDIN>);
   }
#-----------------------------------------------------

#--------------juste pour recapitulatif
if ($d =~/\\$/){
   $fout = "$d" . "rep.log";
   }
else {
   $fout = "$d" . "\\rep.log";
   }
#------------------------------

#----------------------------------------ouverture du repertoire, assign de la list de file, et traitement file/file
opendir R, "$d" or die "Ouverture repertoire impossible $!";
@lsfile = (sort readdir R);
print FS "$x\n$al\n$x\n";
foreach $file(@lsfile) {    # ici $file vaut ~ nom_de_fichier.html
 if ($file =~ /\.htm|\.dat|\.txt|\.log|html$/) {
  &controle_file;
  &reparation;
  &compte_rendu;
  push @rep, $file;
   }
 #-------------facultatif
 $file = "$file\n";
 print $file;

 #--------------
}
closedir R or die "Fermeture du repertoire R impossible $!";
#---------------------------------
 

#--------------------------------------------pour chaque fichiers voulu, ligne par ligne
sub controle_file {
   $filesrc = "$d\\$file";
   #--------------------------------------ok jusqu'ici
   # on ne modifi rien sur l'original on ouvre on lit on ferme
   open FI, "$filesrc" or die "Ouverture du fichier $file impossible $!";
   @lines = <FI>;
   close FI || die "Fermeture impossible $!";

   foreach $line(@lines) {
      # penser à essayer while au cas ou il y aurai plusieurs liens /ligne.
      if ($line=~ /<a\shref="(.*?)"/i) {
         $lnkbrut = $1;
   $countlnk++;
   #-------------------pour test
   print FS "Dans controle_file\:motif reconnu\: $file liens\: $lnkbrut numero\: $countlnk\n";
   #--------------------
   if ($lnkhttp=~ /^http:\/\//i) {
            ($lnkhttp, $encre) = split(/\#/, $lnkbrut);
    $cntlnkhttp++;
            $prlnkhttp = "to:$lnkhttp flag:$encre\n";
            push @lnk_http, $prlnkhttp;
            #-------------pareil pour test
            print FS "\n_Dans controle_file:motif reconnu http:$prlnkhttp\n";
    # ou en hashage
    $h_lnkhttp{"$lnkhttp_$cntlnkhttp"} = $encre;
     }
         elsif ($lnkbrut=~ /^ftp:\/\//i) {
            ($lnkftp, $encre) = split(/\#/, $lnkbrut);
    $cntlnkftp++;
            $prlnkftp = "to:$lnkftp flag:$encre\n";
            #-------------------test
            push @lnk_ftp, $prlnkftp;
            print FS "\n_Dans controle_file:motif reconnu ftp:$prlnkftp\n";
    #-------------- ou en hashage
    $h_lnkftp{"$lnkftp_$cntlnkftp"} = $encre;
    }
   else {
            ($lnknet, $encre) = split(/\#/, $lnkbrut);
    $cntlnknet++;
            $prlnknet = "to:$lnknet:flag:$encre\n";
            #-----------test
            print FS "$x\n_Dans controle_file:motif reconnu lnknet:$cntlnknet:$prlnknet\n";
            push @lnk_net, $prlnknet;      # pour avoir une liste de liens par pages
    # ou en hashage
    $h_lnknet{"$lnknet_$cntlnknet"} = $encre;
            &traquef($lnkbrut);
    # je ne suis pas sur de cette construction donc test
    print FS "$x\n\n_Dans controle_file:motif reconnu aprés traque - avant substitu:$line\n";
            $line=~ s/$lnkbrut/$lnknet$encre/;
            #---------suite du test av et ap
            print FS "$x\n_Dans controle_file:motif reconnu aprés traque - aprés substitu:$x\n$line\n";
    }
    # il faut que $line soit impeccable
   push @nwlines, $line;
         }
  elsif ($lnkbrut=~ /^mailto/) {
   ($kk, $email) =split(/:/, $lnkbrut);
   ($login, $fai) = split(/\@/, $email);
   $hEmail{"$login"}="$email";
   print FS "adresse email trouvées $login pour $email\n";
   }
      else {
       # pousser le reste dans le nouveau document
         push @nwlines, $line;
         }
      }
   push @LoL_http, [ @lnk_http ];
   push @LoL_ftp, [ @lnk_ftp ];
   push @LoL_net, [ @lnk_net ];
   }
 
 
 

sub traquef($lnkbrut) {
   my($lnkbrut)=@_;

   print FS "$y\n_Dans traquef:$lnknet\t$lnkbrut\n";      # facultatif (peut être formater avec write) pour test
   # ici traité les local (if ($lnknet eq "") { &traite_encre}
   $full_filename= "$d" . "\\$lnknet";
   if (-e $full_filename) {
      # bonne adresse pour les pages html
  print FS "$y\n_Dans traquef:nom du lien reconnu - avant control_encre:$full_name\n";
      &control_encre;
      }
   elsif (-e $lnknet) {
      ($root, $filename) = split(/\\$/, $linknet);
      $lnknet = $filename;
      $full_filename = "$d\\$lnknet";
  print FS "$y\n_Dans traquef:lien doubler puis spliter:$full_filename\n";
      &control_encre;
      }
   else {
      print FS "$y\nProbléme:dans traquef (page non reconnu):Aucune correspondance pour le lien:\n$lnknet\nchoisissez dans la liste puis\nentrer le nom du fichier vers qui il doit pointer:\n";
      print "regader la liste des fichiers\n";
  foreach $file(@lsfile) {
         if ($k <= 2) {
            print FS "$file" . "\t";
            $k++;
            }
         else {
            print FS "$file" . "\n";
            $k = 0;
            }
         }
      print FS "\n\nNom du fichier désigné:";
      $lnknet =<STDIN>;
      chomp $lnknet;
      &traquef($lnkbrut);
      }
   }

sub control_encre {

   open FC, "$full_filename" or die "Ouverture de $lnknet impossible $!";
   @cible = <FC>;
   close FC || die "fremeture impossible $!";
   print FS "traitement de encre\n";
 #---------chercher une encre2secour | a voir dessous
 &encre2secour;
 for (@cible) {
  if (/<a name="$encre"/i) {
   $eb++;
   print FS "cool mon $encre a été trouvé sur $full_filename ligne $i\n";
   }
  else {
   $eb++;
   $encre = $def_encre;
   # voir comment rendre vrai pour while
   }
  }
 }
 

sub reparation {
   $fcible = $newsite . "\\$file";
   open FR, ">$fcible" or die "Ouverture de $fcible impossible $!";
   print FR @nwlines;
   close FR || die "Fermeture de $fcible impossible $!";
   }

sub compte_rendu {
   $file_cr= "C:\\Windows\\Temp\\newsite\\rap" . "$ir.log";

   open FRAP, ">$file_cr" or die "Ouverture de $file_cr impossible $!";
   print FRAP "liens http de $file trouvé:\n";
 print FRAP "\n@lnk_http\n";
 print FRAP "\n$x\n";
 while ( ($key, $value) = each %h_lnkhttp) {
  print FRAP "$key = $value\n";
  }
   print FRAP "\n$x\n";
   print FRAP "liens ftp de $file trouvé:\n";
 print FRAP "@lnk_ftp";
 print FRAP "\n$x\n";
 while ( ($key, $value) = each %h_lnkftp) {
  print FRAP "$key = $value\n";
  }
   print FRAP "\n$x\n";
   print FRAP "liens de $file trouvé:\n";
 print FRAP "@lnk_net";
 print FRAP "\n$x\n";
 while ( ($key, $value) = each %h_lnknet) {
  print FRAP "$key = $value\n";
  }
 print FRAP "\n$x\n";
   print FRAP "Pour un total de $countlnk liens dans le fichier $file :\n";
   print FRAP "$cntlnkhttp liens http: " . "\n@lnk_http\n" . "\n$cntlnknet liens ftp: " . @lnk_net . "\n";
 print FRAP "les lnknet maintenant\n";
   print FRAP "$cntlnknet liens \/page: " .  "\n@lnk_net\n" . "\n";
   print FRAP "effectuer sur les fichiers:\n" . "\n@rep\n" . "\n";  #ca marche
   print FRAP "fait le 13-15 nov 2002\n";
   close FRAP || die "dreumer ca bloque $!";
   # --------------------------------remise a zero de nwlines et incremente index rapport
   @nwlines = "";
   $ir++;
   }

open FO, ">$fout" or die "Ouverture de $fout impossible $!";
print FO "Récapitulation\:\n" . $countlnk . " liens dans " . $#rep+1 . " fichiers\n";
print FO "\n" . "\n@rep\n" . "\n$x\n";
for $i (0 .. $#LoL_net) {
   $ref_tab= $LoL_net[$i];
   $n = @$ref_tab -1;
   for $j (0 .. $n) {
      print FO "l'element $i $j est $ref_tab->[$j]\n";
      }
   }
close FO || die "rimpossuble dhmfkjh fermer  le hsdkjhfj $!";
close FS || die "Fermeture de $fs impossible $!";

sub encre2secour {
 for (@cible) {
  if ($ligne=~ /<a name="(.*?)"/i) {
   $def_encre = $1;
   print FS "premier tag de cible trouver dans $full_filename comme encre2secours $def_encre pas allouer\n";
   }
  else {
   $def_encre= "#top_";
   }
  }
 }

END;

retour



#!/usr/bin/perl -w
# remd:  Réparer les liens en local (avant de publier) en les testant. vers:1.0
# réparer quand c'est possible (erreur d'afféctation, path et (faute d'orthographe pas encore).
# Vérification des encres(flag) et (ré-attribut le premier flag ou à defaut créé un #top_)
# alain Adelmar a.adelmar@wanadoo.fr vers: 1.0  du 22/11/02
# personel: accessoirement remplace aadelmar@free.fr par a.adelmar@wanadoo.fr (pour UNIX-Like)

format STDOUT_TOP =
Page @ <<
$%

 Fichier                Flags
=============          ============
.

# initialisation des variables
$e_mailp = 'a.adelmar@wanadoo.fr';
$countlnk = $u = $i = $k = $cnta = $cntlnkhttp = $cntl = $cntlnknet = $cntlnkftp = 0;
#-------------------------
$x = "*-" x 25;
$y = "__-__*" x 15;
$al = "\t=== A_l_a_i_n -\/\/- A_d_e_l_m_a_r ===      |";
$lbl = "\n\tCe script va modifier les liens locaux de chaque page HTML en liens web\n\tSans pour cela toucher à votre dossier de page-perso\n\til copiera l integralite de vos pages dans un nouveau repertoire\n\t:\/tmp\/newsite\n";

#création et ouverture d'un rep temporaire pour placer le nouveau site ainsi créé.
$stemp = "\/tmp";
$newsite = "\/tmp\/newsite";
$temp = "\/home";
$fs = "\/home\/alain\/sorti_verylink.log";

# a degager quand ok---------------
open FS, ">$fs" or die "ouverture de $fs impossible $!";

print "$x\n$al\n\n$x\n\n$lbl\n";
#------------------------------------- choix du repertoire temporaire
while (!(-e $newsite)) {
  print "La copie réparer de votre site sera copié sur $newsite:[Oui-Non] ou [path dossier] ou Quitte\n";
  $rcible =<STDIN>;
  chomp $rcible;
  if ($rcible =~ /^o|y|\n/i) {
    if (-e $stemp) {
      mkdir $newsite or die "ouverture de $newsite impossible $!";
    }
    else {
      mkdir $stemp or die "Création de $stemp impossible $!";
    }
  }
  elsif ($rcible =~ /^n/i) {
      print "ok le dossier cible se trouvera dans HOME ~\/newsite\n";
      if (-e $temp) {
 mkdir "\/home\/newsite" or die "Création du dossier newsite impossible $!";
 print "création du dossier newsite effectué\nil sera dans le repértoire: \/home\/newsite\n";
 $newsite = "\/home\/newsite";
      }
      else { die "Vous avez un gros problême vu que vous n'avez pas de répértoire home\nconseil le prochain coup repondez oui\nou donner un chemin correct\n $!" }
    }
  elsif ($rcible =~ /^q/i) {
    die "Tchao !!! a la prochaine\n";
  }
  else {
    $newsite = $rcible;
  }
}
 

#--------------------------demander quel repertoire traiter et verifier si il existe
print "$x$x\n";
print "Indiquez le dossier a traiter:\n";
chomp($d =<STDIN>);

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

#--------------juste pour recapitulatif
if ($d =~/\/$/){
  $fout = "$d" . "rep.log";
}
else {
  $fout = "$d\/rep.log";
}

#----------ouverture du repertoire, assign de la list de file, et traitement file/file
opendir R, "$d" or die "Ouverture repertoire impossible $!";
@lsfile = (sort readdir R);
print "$x$x\n";
&recup_all_tags;

foreach $file(@lsfile) {
  if ($file =~ /\.htm|\.dat|\.txt|\.log|html$/) {
    print "$x\n";
    &controle_file;
    &reparation;
    &compte_rendu;
    push @rep, $file;
  }
  #-------------facultatif
  $file = "$file\n";
  print $file;
 
  #--------------
}
closedir R or die "Fermeture du repertoire R impossible $!";
#---------------------------------recherche des flags

#--------------------------------------------pour chaque fichiers voulu, ligne par ligne
sub controle_file {
  $filesrc = "$d\/$file";
  open FI, "$filesrc" or die "Ouverture du fichier $file impossible $!";
  @lines = <FI>;
  close FI || die "Fermeture impossible $!";
 
  foreach $line(@lines) {
    $cnttl++;  #compteur de lignes traité (total)
    $cntl++;   #index de ligne, par document, pour recherche.
    if ($line=~ /<a\shref="(.*?)"/i) {
      $lnkbrut = $1;
      $countlnk++;
      if ($lnkbrut=~ /^mailto/) {
 ($kk, $email) =split(/:/, $lnkbrut);
 ($login, $fai) = split(/\@/, $email);
 $cnta++;
 #------------------------modification perso
 if ($email =~ /^aadelmar/) {
   s/$email/$e_mailp/;
   print "modification d'adresse mail effectué sur $file ligne $cntl\n";
 }
      }
      #--------------------http
      elsif ($lnkbrut=~ /^http:\/\//i) {
 ($lnkhttp, $encre) = split(/\#/, $lnkbrut);
 $cntlnkhttp++;
 $prlnkhttp = "$file ligne:$cntl\t$lnkhttp\t$encre\n";
 push @lnk_http, $prlnkhttp;
 # ou en hashage
 $h_lnkhttp{"$lnkhttp_$cntlnkhttp"} = $encre;
      }
      #------------------ftp
      elsif ($lnkbrut=~ /^ftp:\/\//i) {
 ($lnkftp, $encre) = split(/\#/, $lnkbrut);
 $cntlnkftp++;
 $prlnkftp = "$file ligne:$cntl\t$lnkftp\t$encre\n";
 push @lnk_ftp, $prlnkftp;
 
 #-------------- ou en hashage
 $h_lnkftp{"$lnkftp_$cntlnkftp"} = $encre;
      }
      else {
 # voir si l'absence de # ne ferai pas partir l'encre dans lnknet?
 ($lnknet, $encre) = split(/\#/, $lnkbrut);
 $cntlnknet++;
 $prlnknet = "$file ligne:$cntl\t$lnknet\t$encre\n";
 push @lnk_net, $prlnknet;      # pour avoir une liste de liens par pages
 #---controle les ceux qui fonctionne dessuite
 if ($htab{$linknet}=$encre) {
  LABELPARDEF:print "ok pour ce lien $v\n";
   $v++;
 }
 else {
   $h_lnknet{$lnknet . ":" . $cntlnknet} = $encre;
   &traquef;
   $line=~ s/$lnkbrut/$lnknet$encre/;
 }
      }
      # il faut que $line soit impeccable
      push @nwlines, $line;
    }
 
    else {
      # pousser le reste dans le nouveau document
      push @nwlines, $line;
      $cntl = 0;
    }
  }
  push @LoL_http, [ @lnk_http ];
  push @LoL_ftp, [ @lnk_ftp ];
  push @LoL_net, [ @lnk_net ];
}
 

sub traquef {
  # ici traité les local (if ($lnknet eq "") { &traite_encre}
  $full_filename= "$d\/$lnknet";
  if (-e $full_filename) {
    $gf++;
    &control_encre;
  }
  elsif (-e $lnknet) {
    ($root, $filename) = split(/\\$/, $linknet);
    $lnknet = $filename;
    $full_filename = "$d\/$lnknet";
    $ef++;
    $fr++;
    &control_encre;
  }
  else {
    # voir si il n'y a pas un PATH accroché (UNIX-like) autre que celui au dessus.
    if ($lnknet=~ /.*?\/.*?/) {
      ($kk, $filename)= split(/\//,$lnknet);
      $lnknet = $filename;
    }
    # idem mais pour MicroSoft (petit-Mou)
    elsif ($lnknet=~ /.*?\\.*?/) {
      ($kk, $filename)= split(/\\/,$lnknet);
      $lnknet = $filename;
    }
    elsif ($lnknet eq (values %htag)) {
      print "voilà un lnknet qui est une encre\n";
    }
    else {
      print "$y\nProbléme:dans traquef (page non reconnu):\nAucune correspondance pour le lien:\n$lnknet:$encre\nchoisissez dans la liste ci-dessous puis\nentrer le nom du fichier vers qui il doit pointer:\nSi vous désirez laisser en l'etat [Enter]\nSi vous entrez un substitut et que vous ne voulez pas qu'il soit vérifié, saisissez:\nR:monlien_a_ne_pas_verifier.dob\n";
      print "regader la liste des fichiers\n";
      $ef++;
      foreach $file(@rep) {
 # if ($file=~ /^(each keys %htag)/) {
 # write;
 # }
 for $i (0 .. $#lz) {
   write if exists $htag{$file};
 }
      }
 
      #while (("$file_\d",$tag) = each %hflag) {
      # write;
      # }
      print "\n\nNom du fichier désigné:";
      $user_lnknet =<STDIN>;
      chomp $user_lnknet;
      if ($user_lnknet=~ /^R:()/) {
 ($kk, $lnknet)=split(/:/, $user_lnknet);
 $fr++;
 goto LABELPARDEF;
      }
      elsif ($user_lnknet eq "") {
 $fr++;
 goto LABELPARDEF;
      }
      else {
 $lnknet = $user_lnknet;
 &traquef($lnkbrut);
      }
    }
  }
}

sub control_encre {
 
  open FC, "$full_filename" or die "Ouverture de $lnknet impossible $!";
  @cible = <FC>;
  close FC || die "fremeture impossible $!";
  #---------chercher une encre2secour | a voir dessous
  &encre2secour;
  for (@cible) {
    if (/<a\sname="$encre"/i) {
      $eb++;
      print "cool mon $encre a été trouvé sur $full_filename ligne $i\n";
    }
    else {
      $err++;
      $ee++;
      $encre = $def_encre;
      # voir comment rendre vrai pour while
    }
  }
}
 

sub reparation {
  $fcible = $newsite . "\/$file";
  open FR, ">$fcible" or die "Ouverture de $fcible impossible $!";
  print FR @nwlines;
  close FR || die "Fermeture de $fcible impossible $!";
}

sub compte_rendu {
  $file_cr= "$newsite" . "\/rap" . "$ir.log";
 
  open FRAP, ">$file_cr" or die "Ouverture de $file_cr impossible $!";
  print FRAP "liens http de $file trouvé avec liste:\n";
  foreach $lk(@lnk_http) {
    print FRAP "adresse Web: $lk\n";
  }
 
  print FRAP "\n$x\navec le hashage maintenant\n";
  while ( ($key, $value) = each %h_lnkhttp) {
    print FRAP "$key = $value\n";
  }
  print FRAP "\n$x\n";
  print FRAP "liens ftp de $file trouvé:\n";
  foreach $lk(@lnk_ftp) {
    print FRAP "adresse ftp: $lk\n";
  }
  print FRAP "\n$x\navec hashage now:\n";
  while ( ($key, $value) = each %h_lnkftp) {
    print FRAP "$key = $value\n";
  }
  print FRAP "\n$x\n";
  print FRAP "liens de $file trouvé:\n";
  foreach $lk(@lnk_net) {
    print FRAP "liens vers la page: $lk\n";
  }
  print FRAP "\n$x\navec le hashage now\n";
  while ( ($key, $value) = each %h_lnknet) {
    print FRAP "$key = $value\n";
  }
  print FRAP "\n$x\n";
  print FRAP "Pour 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 "$cntlnknetpp 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\n$ee erreur encre\n$err encre reparrer\n";
  print FRAP "effectuer sur les fichiers:\n" . "\n@rep\n" . "\n";  #ca marche
  print FRAP "fait le 13-20 nov 2002\n";
  close FRAP || die "dreumer ca bloque $!";
  # --------------------------------remise a zero de nwlines et incremente index rapport
  @nwlines = "";
  $ir++;
}

open FO, ">$fout" or die "Ouverture de $fout impossible $!";
print FO "Récapitulation\:\n" . $countlnk . " liens dans " . $#rep+1 . " fichiers\n";
print FO "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\n$ee erreur encre\n$err encre reparrer\n";
print FO "\n@rep\n";
for $i (0 .. $#LoL_net) {
  $ref_tab= $LoL_net[$i];
  $n = @$ref_tab -1;
  for $j (0 .. $n) {
    print FO "l'element $i $j est $ref_tab->[$j]\n";
  }
}
close FO || die "rimpossuble dhmfkjh fermer  le hsdkjhfj $!";
close FS || die "Fermeture de $fs impossible $!";
 

sub recup_all_tags {
  foreach $file(@lsfile) {    # ici $file vaut ~ nom_de_fichier.html
    if ($file =~ /\.htm|html$/) {
      $ftagsrc = "$d\/$file";
      open FT, "$ftagsrc" or die "Ouverture du fichier $file impossible $!";
      @lines = <FT>;
      close FT || die "Fermeture impossible $!";
      foreach $line(@lines) {
 if ($line=~ /<a\sname="(.*?)"/i) {
   $tag = $1;
   #$fz = "$file:$z";
   $htag{$ftagsrc}= $tag;
   write;
   #$z++;
 }
      }
     # push @lz, $z;
     # push @reph, $file;
     # $z = 0;
    }
  }
}

sub encre2secour {
  for (@cible) {
    if (/<a\sname="(.*?)"/i) {
      $def_encre = $1;
      print "premier tag de cible trouver dans $full_filename comme encre2secours $def_encre pas allouer\n";
    }
    else {
      $ee++;
      $def_encre= "#top_";
    }
  }
}

format STDOUT =
@<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<
$file, $tag
.

END;
 

retour


précédant | suivant | sommaire