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;