#!/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;