vlnk
Premier script (l’ancêtre) pour réparer les liens en local
(avant de publier). Brouillon ou j'ai passé trop de temps
inutilement mais qui m'a amené à ver2l qui lui fonctionne
bien (dernière mouture ver2l version: 2.5 du 5 septembre
2010). Alain Adelmar
Totalement obsolète ne
fonctionne même pas correctement, voir la dernière mouture
ver2l
qui elle fonctionne même sur
les gros sites,
et qui peut effectuer des
pauses (vous permettant de reprendre le lendemain, ou vous vous
étiez arrêté).
La page à voir
ver2l.html
#!/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;