ver2l

Vérificateur Et Réparateur De Liens Locaux  ou  VERificateur De Liens   ou Véritable Énorme Repriseur 2 liens.


alain Adelmar

aadelmar@numericable.fr beuuh c est quoi ca

Ver2l.pl est un script Perl qui vérifie les liens de votre dossier de publication (votre site, blog, page-perso avant publication) et répare ce qu'il peut réparer.  Il vérifie donc et répare les paths absolues (c'est très souvent le cas), les erreurs d’extensions (c'est aussi très souvent le cas .htm au lieu de .html), non concordance du lien (soit à cause d'une erreur de fichier, soit carrément une faute d'orthographe), lien au fichiers ayant disparus ou renommer (et quand il ne sait pas il demande à l'utilisateur par l'intermédiaire d'une liste de possibilités (fichier et/ou ancre) vers ou pointer, qui sont numérotés.
Cette version permet que l'utilisateur fasse une pause, c'est à dire fermer le script et reprendre le lendemain ou il s'était arrêté... cool pour les gros scripts.

Exemple:
Liens obsolète =>  dans fichiers : config.html  | lien brut :  commun.htm#avantiges | rootfile: commun | extension : htm | ancre: aventiges
Possibilités : entrez le [Num] de votre choix ou directement le lien ou passez votre tour [Entrer] ou q pour quitter
[0] commandes_lx.html                                   [1] concombre_masqué#la_revanche
[2] commun.html#avantages                          [3] cri2joie.html#cetait_celui_avant
[4] LaCjusto.html#dessus
votre réponse:

Et bien sûr, vous deviez entrer 2 ou carrément commun.html#avantages ou Enter pour passer sans rien modifier soit q pour quitter, parce que vous vous souvenez qu'on vous attend pour la soupe... (no problème, il fait une sauvegarde du travail accompli et vous pourrez reprendre ou vous vous êtes arrêté)
Enfin voilà, je l'ai écris pour réparer les liens cassés de mon site, c'était pas du luxe plus de 300 pages et quelque chose comme 28000 liens à contrôler.
Il fonctionne bien et laisse le dossier original intact (il ne fait que le lire) stocke toutes les ancres et nom_de_fichier susceptible d’être des liens et les compares au copies de vos fichiers qu'il créé dans un répertoire ./newsite . Il fait aussi des comptes rendu de modifs dans des fichiers log.  Ça fait 3 ans que je travailler dessus...
Il est bien, spartiate mais il fonctionne.
Alain Adelmar

Pour pas avoir de surprises regarder sur ver2l (le script)


#!/usr/bin/perl
# remd: ver2l pour (Vérificateur Et Réparateur De Liens Locaux) *
# 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’affectation, de path (absolu ou relatif) *
# UNIX/M$/LX, les fautes d’extensions, doublons, orthographe, etc... *
# Vérification des encres et ré-attribution du 1ers flag ou création (-c) *
# d'une encre #_top (si page existe sans flag). Corrige les fautes *
# d'orthographes et les path erronés. *
# Vers:2.6| 08.2010 alain Adelmar Pessac aadelmar@free.fr *
# ------------------------------------------------------- *
# (v: Version Especiale Remaniée De Luxe (Lx - M$) Alain Adelmar ) *
# remd: autonome n'utilise que les modules standards (facultatif) *
#------------------------------------------------------------------*
# usage: ver2l [-cu] [rep_source] *
#----------------------------------- *
# options: *
# -c (complet) effectuera des tests, logs et pré-réparation style *
# marquer d'un tag "top" les pages html pas marquées *
# -g (gros site) prévoit une sauvegarde du travail pour le passer en*
# plusieurs fois *
# -u (update) insère la date de mise à jour, en gardant l'original *
# en commentaire, répare les liens. *
# -l (light) essai de réparer par lui même et tri avant de proposer*
# a l'utilisateur. (peu simplifier le travail) *
# -s (silencieux) répare les liens sans intervention de user, fait*
# un rapport pour ce qu'il n'a pas réparer. *
#------------------------------------------------------------------*
# (script Perl pour environnement M$ et UNIX-LIKE) *
# créé par alain Adelmar (2002-2010) à Pessac 6 rue de Tunis 33600 *
#*******************************************************************
#$Header: /home/commun/atelier/RCS/ver2l,v 2.5 2010/08/29 01:38:49 alain Exp alain $
#$Log: ver2l,v $
#Revision 2.5 2010/08/29 01:38:49 alain
#- pose des var propre à RCS
#- création d'une confirmation pour les fichiers aillant été réparer
# mais ne matche pas avec t_encre (c_a_d: ce qui n'existe pas encore)
#- init var et réécriture d'une partie des contrôles de controle_file.
#- création d'un garde fou pour dejavu => report_dejavu.log
#- adaptation de ce nouveau paramètre pour toutes les sorties, officielle
# ou non officielle, par appel à ouvre_file et l'ajout d'un booléen $reprise.
#testé ça fonctionne il manque encore quelques réglages et des tests
#dans toutes les possibilités.
#encore un tombereau de nouvelles fonctionnalité.
#Je vais rester sur cette version de façon à ce que tout soit
#top_top, avant d'avancer de nouvelles fonctionnalités.
#Déjà avec la mémoire des corrections on gagne 3/4 du temps
#elle sont chargés, et copiées sur le rec.
#Donc pas de nouvelles fonctionnalité tant que celle-ci
#ne sont pas coulées dans le bronze.
#Écris par alain Adelmar 6 rue de Tunis 33600.
#J'ai plus avancé chaque jours que pendant 10ans
#
#Révision 2.4 2010/08/27 19:34:56 alain
#- pose des var propre à RCS
#- création d'un contrôle intelligent c_a_d créant un hash aillant pour
# clé le lien brut initial faux pas encore réparer qui servira de modèle
# valeur le lien brut réparrer
# comme ça chaque $lnkbrut identique à keys sera reparer par values
#- Je tiens à ce que le lien corrigé soit verifier avant de le mettre en %hdejavu
# test de verification aprés SCONTROL: ligne 1150
#- mise en application: création, verification, chargement du % et controle
#- écriture de tt les sorties &ru /d et alpha pour mettre le procedé en place
#- gestion des sorties impromptues
#- testé %hdejavu fonctionne bien
# cette version fonctionne et les pages sont reparer automatiquement.
#Ecris par Alain Adelmar 6 rue de Tunis 33600 Pessac
#
#Revision 2.5 2010/08/28 15:52:02 alain
# - Excellent conçu pour les gros sites (>1000 pages) *
# version utf8- encore beaucoup de controle. Ca marcheeeeeee *
# -----------------------------------------------------------------*
use strict;
use File::Copy;
use warnings;

use Cwd;
our $dir = cwd;
print "dir vaut :$dir\n";

use locale;

our $script = "ver2l";
our $vers = "2.3";
#$Author: alain $:"Adelmar Alain";
our $moi = 'Adelmar Alain ||';
my $debutt = time;



# initialisation des variables utiles --------------------------------------------------------
# date et heure Fr pour maintenant et stat(file)---------------
my $fr_date_now = my $french_date_now = &maintenant; # utiliser par soucis de compatibilité
my $fr_dt_file = my $fr_date_file = "";
# print "date/heure: " . &maintenant . "\n";
print "date/heure: $french_date_now\n";
my @tmpstat = "";
my $datenum = 0;
my $mode = 8; # num representant date de dernier acces, 9 modif, 10 change
my $format_d = 0;
my $file = $0;
# a saquer quand ok
print "file vaut $file\n\n";
$fr_date_file = datefinefile($file, $mode, $format_d);
#---------------------------------------------------------------
# cartouche: var diverses presentation et autre
my $lx = "*-" x 25;
my $x_down = "|" . ("*-" x 24) . "||"; # fioritures qui soulignes
my $y = "__-__*" x 10; # idem pour différencier
my $al = "| === A_l_a_i_n -\/\/- A_d_e_l_m_a_r === ||"; # pub perso
my $head_lbl= "script $0\nécris by $moi\nle $fr_date_file\nexecuter le $french_date_now\n";
my $head_lbl_console = "$lx\nscript: $0\nle $fr_date_file\nécris par: $moi\n" .
"executer le: $french_date_now\n$lx\n";
my $lblo = "\n\tCe script $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";

print "$x_down\n$al\n$x_down\n$head_lbl$x_down$lblo\n";
my $argv = ""; # argument passer à la ligne de commande
our $rootd = ""; # nom du rep source sans path (pour rec)
my $rootfile_file = ""; # racine du nom de fichier à ouvrir
my $o_ext = ""; # extention du fichier à ouvrir
my @adressemail = ""; # liste d'adresses (login@fai)
my @contenu = ""; # contenu du fichier source lu
my @cop = ""; # contenu des lignes du fichier dans reconstruire_ligne
my @copim = ""; # var liste contenant le texte d'un fichier dans recup_all_tags
my @debuts = (); # liste comprenant tout les enreg jusqu'a hdejavu dans REC dans &sortie
my @decompture = ""; # liste des differants décomptes de temps pour tt les reprises
my @files = ""; # var liste contenant les nom de fichier de /newsite/tmp
my @h_fst = ""; # liste des fichier meta faite dans traite_d
my @ligne = ""; # bout de ligne éclater reconstruite dans reconstruction_ligne
my @lines = ""; # liste des lignes du fichier dans recup_all_tags pour reconstruction_ligne
our @lnk_ftp = ""; # liste des liens ftp
our @lnk_http = ""; # liste des liens http
our @ls_encre_pf = ""; # liste des encre précédé d'une diéze #
my @ls_ext = ""; # liste faite d'extention tmp dans CB4f
our @ls_h_fst = (); # liste du nom des fichiers
our @ls_file_meta = ""; # liste du nom des fichiers meta
my @ls_m = ""; # liste de (motif/liens) trouvé par ligne (dans controle_file)
my @ls_other_file = ""; # liste du nom des fichiers autre que meta
our @ls_tencre = ""; # liste des liens possible, file#encre, #encre, file (sans doublon)
my @lsfile = ""; # liste du nom des fichiers
my @lsfmeta = ""; # liste de fichier meta à traiter
my @lsr = ""; # liste de deux élément lnkbrut_initial et lnkbrut reparer
my @nieme = ("zorro", "premier", "deuxieme", "troisieme", "quatrieme"); # situer le lien/ligne dans log
my @nwcontenu = ""; # contenu du fichier reparer pret à être copier sur cible
my @nwlines = ""; # liste contenu de reconstruire_ligne qui est @nwcop (a vrai dire)
my @nwcop = ""; # liste du contenu des lignes passé a reconstruire_balise
my @nwl = ""; #
my @nwlsfile = ""; # liste des noms de fichier faite dans traite_d utiliser pour recup_all_tags
my @pathf = ""; #
my @pathl = ""; # liste éclaté du path dans degage_path
my @recv = ""; # liste des fichier d'enregistrement
my @rep = ""; # liste de fichier meta déjà traiter
my @sav = ""; # contenu du fichier de sauvegarde REC
my @tr_encre_pf = ""; # liste de choix a presenter a user dans CB4c
my @val = ""; # liste reprise dans boucle choix des valeurs d'un hashage contenant des liens
my %cache; # hashage mettant en cache clé/filename et val/temps modif-now pour trier @recv
my %hdejavu; # hashage d'exemple de $lnkbrut (pas_bon) aillant comme values $lnkbrut ok
my %h_fst; # hachage de nom de fichier seul
my %h_lnkftp; # hachage de liens ftp trouvés
my %h_lnkhttp; # hachage de liens http (exterieur)
my %h_rootf; # hachage de racine de nom de fichier trouvés
my %h_tag; # hachage d'encre trouvés
my %h_tencre; # hachage de nom de fichier plus encre (foo.txt#top) trouvés
my %tmpo; # hashage temporaire monter pour oter les doublons
my %pf; # hachage constitué avec la liste @tr_encre_pf pour choix CB4c
my $a = ""; # 1er colonne de choix (lien+ numero)
my $auto_r = 0; # compteur de lien auto reparrer
my $b = ""; # 2eme colonne de choix (lien+ numero)
my $body = ""; # compteur incrémente @copim avec $lpp
our $cf = 0; # compteur de fichiers golobal
my $ch_ext = ""; # var fabriquer avec le %h_rootf fait de $i:$ext
my $cj = ""; # pour court jours (representation du str jour en 2 lettres)
my $cntlnkftp = 0; # conteur de liens exterieur ftp
my $cntlnkhttp = 0; # conteur de liens exterieur http
my $cnttl = 0; # compteur de ligne totale controlées
my $confirme = ""; # reponse pour confirmer les liens vers les fichiers a creer
our $contenu = ""; # contenu du fichier dans reconstruire ligne
my $copie = ""; # nom complet de fichier dans /newsite/tmp/file
my $corrompu = 0; # booléen dans chklnk => control_file
my $countpfl = 0; # compteur lignes par fichier
my $countpl = 0; # compteur de lignes
our $d = ""; # premier argument qui doit être le path du repertoire source
my $decompte = 0; # decompte de temps de la session presente
my $decompte_total = 0; # accumulation de tous le temps passé, sayuvegarde comprise
my $e = ""; # caractere $_ dans reconstruire_ligne
my $ea = 0; # compteur d'adresse email
my $e_mailp = ""; # email de remplassement pour l'eventualité de vouloir changer
my $eb = 0; # compteur d'encre bonne
my $ef = 0; # compteur erreur adressage
my $el = ""; # element d'une liste @ls _tencre
my $element = ""; # element de plusieurs table de hashage
my $email = ""; # mon email
my $encre = ""; # represente l'encre trouvé par split dans plusieurs controle
my $encre_tmp = ""; # encre de $val ($h_tencre[$foo])
my $encre_vue = 0; # compteur d'encre vue
my $encru = ""; # reponse d'un utilisateur pour une recherche encre
my $ere = 0; # compteur d'erreur bidon
my $err = ""; # format pour comptabiliser ligne erreur
my $etlencre = 0; # booleen dans controle_file
my $expl2l = 0; # booléen de prise en compte de reparation
my $ext = ""; # var scalaire contenant l'extention d'un fichier
my $ext_tmp = ""; # var contenant une extention temporaire dans CB4f
my $fai = ""; # var fournisseur acces internet comme login
my $fcible = ""; # nom complet de fichier traité /newsite/file
my $fichiercible = ""; # nom complet de fichier a traité traite_d /newsite/tmp/file
my $fichiersource = ""; # nom complet de fichiersource a traité dans traite_d /$d/file
$file = ""; # nom du fichier avec path dans recup_all_tags et nom du fichier
my $file_cr = ""; # nom complet pour log FRAP /newsite/tmp/frap_12.log
my $filesrc = ""; # nom complet avec path des fichiers passant à control_file
my $filos = ""; # var scalaire contenant @rep avec des \n entre chaque enrg
#my $fl = "file: $file \|ligne:$countpl "; #ok preindication file origine ligne (pour RAP_a)
my $fl = ""; #ok preindication file origine ligne (pour RAP_a)
my $flplus = ""; # reprend $fl pour les logs
#my $flg = ""; # nom complet des fichier source $dir$slash$rootfile_file.$ext
my $fpointe = ""; # path avant le nom de fichier (racine de path)
my $fr = 0; # compteur d'adressage faux reparer
my $ftagsrc = ""; # nom complet du fichier à traiter dans recup_all_tags
my $fz = ""; # var contenant file#encre dans cherche_encre
my $gnus = 0; # var initialisant $slash par @gnup
my $hdl_file = ""; # var scalaire contenant handle de fichier pour &ouvre_file
my $handle = \$hdl_file;# reference a $hdl_file
my $ht = ""; # nom de fichier recup_all_tags
my $htag = ""; # var contenant l'encre de %h_tag
my $i = 0; # incrementation dans choix
my $i_h_fst = 0; # element d'incrementation pour création %h_fst dans recup_all_tags
my $i_h_tag = 0; # element d'incrementation pour création %h_tag dans recup_all_tags
my $i_h_tencre = 0; # element d'incrementation pour création %h_tencre dans recup_all_tags
my $ir = 0; # compteur pour incrementer fichier log (FRAP)
my $j = 0; # numéro unique du lien
my $k = 0; # compteur de liens tronqués
my $kefli = ""; # miroir de $likef dans recup_all_tags
my $key = ""; # key du hash %h_tencre et clé representant le lnkbrut pas encore reparer
my $kf = 0; # nombre de meta fichier traités
my $kk = ""; # var fourre tout pour disocier un lien
our $lastrec = ""; # nom du dernier enregistrement (alpha ou time)
my $likef = ""; # represente le fichier file au debut de recup_all_tags (sans path)
my $line = ""; # represente la ligne etudier controle_file, chklnk
my $lkbinit= ""; # lnkbrut (non modifié) partant en reparation
my $lnknet = ""; # represente le lien net cad le nom de fichier avec l'extention
my $lknet_tmp = ""; # racine de $val ($h_tencre[$foo])
my $lnkbrt = ""; # alias a lnkbrut et a oldlb lancer dans decortique et ailleur (mefiance)
my $lnkbrut = ""; # represente le lien brut trouvé au debut de controle_file
my $lnkftp = ""; # liebs ftp trouvé
my $lnkhttp = ""; # liebs http trouvé
my $login = ""; # login trouvé poussé dans @adressemail
my $lpp = 0; # compteur incrémente @copim
my $lu = ""; # element de @nwlines ou @nwcop dans recup_all_tags
my $ma_ligne = ""; # represente la ligne dans controle_file
my $max = 40; # max = 40
my $n = 0; # compteur servant a donner un numero a newsite
my $na = 0; # compteur dans choix affichant la selection a
my $nb = 0; # compteur dans choix affichant la selection b
my $newsite = ""; # path donner par faitmoitmp qui contiendra les feuilles corigées /newsite
my $nltt = 0; # nombre de ligne lu dans reconstruit ligne
my $nws = ""; # var contenant l'adresse du newsite
my $oldlb = ""; # var contenant le premier lnkbrut non souillé conrole_file
my $ouvert = 0; # booleen dans reconstruire_ligne
my $pa = 0; # pour datefinefile pa => petite année sur 3chiffre
my $pair = 0; # compteur de paire dans utilisateur_n
my $pass = 0; # booléen de passage dans les controle user
my $path_newsite = ""; # path donner par faitmoitmp qui contiendra les feuilles corigées /newsite/
my $path_tmp = ""; # path donner par faitmoitmp qui contiendra les log /newsite/tmp
my $point = ""; # reponse utilisateur (STDIN) a voulez vous traiter ./foo dans traite_d
my $prlnkftp = ""; # format d'adresse de liens ftp
my $prlnkhttp = ""; # format d'adresse de liens http
my $q = 0; # compteur dans une boucle de choix de liens
my $qls = 0; # num associé au 3 listes (recup_données_Rec) dans chargerec
my $reponse = ""; # confirmation d'acseptation de modele de reparation
my $reprise = 0; # booleen qui indique si reprise il y a(0 initial, 1 reprise)
my $repu = ""; # reponse utilisateur a &regarder
my $resp = ""; # STDIN pour un choix CB4f
my $rl = ""; # var representant un lien dans choix CB4c
my $round = 0; # passage dans choix court/1er lettre avant choix tt file
my $rootf = ""; # racine de nom de fichier sans ext de %h_fst
my $rootfile = ""; # partie racine du nom de fichier (sans path, sans extention)
my $sdecompte = 0; # sous decompte de temps lu sur REC
my $sous_rep = ""; # nom de rep reconnu dans liste de file dans traite_d
my $srep = ""; # nom d'un éventuel sous-repertoire dans $d (source)
my $tag = ""; # encre trouvé dans cherche_encre
my $target = ""; # parametre target (inutilisé dans controle_file
my $tmp = ""; # path du rep temporaire /newsite/tmp (sans slash)
my $tmpflg = ""; # fichier de la dernière sauvegarde copier en recap_ver2l_$rootd_$i.log
my $tout = ""; # contenu d'un fichier de @lines scalarisé en $tout pour reconstruire
my $troncfile = ""; # racine de nom de fichier dans onyva moins ext
my $tronquage = 0; # booleen dans reconstruire
my $tz = 0; # comptage d'encre trouvé
my $u = 0; # comptage dans indice choix
my $userx = ""; # attribut des lettre a un des controle user
my $v = 0; # comptage de controle effectué sur des liens bon ou mauvais
my $val = ""; # values de %h_tencre fin de recup_all_tags
my $value = ""; # vazr scalaire represente un choix, un lien possible
my $vingt = 0; # represente la limite fixer a 20 (nbr de ligne d'affichage user)
my $z = 0; # compteur de fichiers passé à &faitdcopies
my $zo = 0; # compteur de file dans %h_fst
my $zt = 0; # compteur de file dans %h_tag

our $firstline = "Editer par le script $script vers:$vers ce jour $fr_date_now :\n";
# adressage/UNIX, Linux, cygwin etc..(/) et M$ (\)--et nettoyage écran-----------
our @gnul = ( "\\", "\/"); #pas mal because $slash sera toujours bon, je suis trop fort
our @gne = ( "cls", "clear"); # nettoyage ecran sur MSDOS ou console bash, sh
if ($dir =~ /^\//) {
$gnus++;
}
our $slash = $gnul[$gnus];
our $clear = $gne[$gnus];
#---------------------------------------------------------------------------------------------

# -----------traitement arguments - 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 = "g") if ($ARGV[0]=~ /^g/); # pour gros site ou paquets de feuilles
($argv = "u") if ($ARGV[0]=~ /^u/); # pour update
($argv = "t") if ($ARGV[0]=~ /^t/); # pour temps (travail sur la sauvgarde la + recente)
($argv = "l") if ($ARGV[0]=~ /^l/); # pour light
($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: $script [-cou] [dossier_a_traiter] [sous-dossier_image]\n(made by $moi\n";
#---------demander quel repertoire traiter et verifier si il existe
print "$lx\n";
print "Indiquez le dossier a traiter:\n";
chomp($d =);
&verifd;
}
#---------------------------------------------------------------------------------------------- fin

#----------------- ouverture pour sortie formatée de l'affichage fichiers/tags ----------------- ok
format STDOUT_TOP =
Page @<<
$%

n lien n lien
=== =============================== === ==============================
.

#----------------------------------------------------------------------------------------------

#--------si rec existe que voulez vous faire-------------------------------------------
#--ouvre $dir et regarde les versions de recap_ver2l
opendir DC, "$dir" or die "Ouverture de $dir impossible $!";
my @herefiles = (sort readdir DC);
closedir DC || die "Fermeture de $dir impossible (putain de merde) $!";
foreach (@herefiles) {
next if /~$/;
(push @recv, $_) if /recap_ver2l_$rootd.+\d?\.list/;
}
@recv = sort(@recv);
# le tri est alphabetique mais avec argument -t pour dernière modif
if($argv eq "t") {
$cache{$_} = -M for @recv;
my @out = sort { "$cache{$a}" <=> "$cache{$b}" } @recv;
$lastrec = pop @out;
}
else {
$lastrec = pop @recv;
}
print "dernier enregistrement connu: $lastrec\n";
#my $flg = "recap_ver2l_" . "$rootd" . ".list";
my $flg = $lastrec;
$lastrec = "$dir$slash$lastrec";
if (-e $flg) {
$mode = 9;
print "voulez vous continuer le travail commencer le " .
datefinefile($lastrec, $mode, $format_d) . " sur $flg: [o,n] (o)\n";
chomp(my $reponse = );
if($reponse =~ /^n/i) {
$tmpflg = "recap_ver2l_$rootd.log";
#rename $flg,$tmpflg || die "impossible de détruire $flg, faite le à la main $!";
copy($flg, $tmpflg) || die "impossible de détruire $flg, faite le à la main $!";
print "le fichier de sauvegarde $flg en $tmpflg\n";
&openrec($flg);
&premier_passage;
}
elsif ($reponse =~ /^recap_ver2l/) {
$reprise++;
unless (-e $reponse) {
print "choisissez dans la liste ci-dessous:\n";
foreach (@recv) {
print "$_\n";
}
chomp(my $reponse = );
}

open REC, "$reponse" or die "ouverture de $flg impossible $!";
@sav = ;
close REC || die "Fermeture de $flg impossible $!";
# poursuite du chargement des variables
&chargerec(@sav);
}
else {
$reprise++;
#--- controle a saquer
print "Je passe ici et donc la reprise est active ++\n";
open REC, "$flg" or die "ouverture de $flg impossible $!";
@sav = ;
close REC || die "Fermeture de $flg impossible $!";
# poursuite du chargement des variables
&chargerec(@sav);
}
}
else {
&openrec($flg);
&premier_passage;
}
#-----------------------------------------------------------------------------------------

#-----ouverture de recap_ver2l (fichier sauvegarde de travail) si inexistant ------------------
sub openrec {
my ($flg)= @_;

$rootfile_file = "recap_ver2l_$rootd";
#print "dans openrec rootfile_file vaut $rootfile_file\n";
$hdl_file = "REC";
$o_ext = "list";
&ouvre_rec($rootfile_file, $hdl_file, $o_ext);
}
#----------------------------------------------------------------------------------------------

sub premier_passage {
#-----ouverture de vrl (fichier log)
$rootfile_file = "vrl";
$hdl_file = "VRL";
$o_ext = "log";
&ouvre_file($rootfile_file, $hdl_file, $o_ext);

#création et ouverture d'un rep temporaire pour placer le nouveau site -------------- debut
$newsite = "$dir$slash" . "newsite";
print "le newsite sera adresser comme : $newsite\n";
&faitmoitmp; #johnny, johnny
# $path_tmp = "$tmp" . "$slash"; # cette ligne existe deja dans &faitmoitmp
print "$lx$lx\n";
&traite_d;
&recup_all_tags;
}


# donne la date et l'heure en Fr---------------------------------------------------------------
sub maintenant {
#------date et temps en Français et numerique pour maintenant et pour dater les fichiers
(my $sec,my $min,my $heure,my $mjour,my $mois,my $annee,my $sjour,my $ajour,my $isdst) = localtime(time);
# mettre le format que vous désirez ici
our @lssjour = qw( Dim Lun Mar Mer Jeu Ven Sam);
our @lslsjour = qw( Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi);
our @lssmois = qw (Janvier Fevrier Mars Avril Mai Juin Juillet Aout Septembre Octobre Novembre Decembre);

$french_date_now = "$lslsjour[$sjour] $mjour $lssmois[$mois] " . ($annee+=1900) . " - $heure:$min:$sec";
return $french_date_now;
}
#---------------------------------------------------------------------------------------------------------

# donne la date et heure sous plusieurs format Français et numerique--------------------------------------
sub datefinefile {
my ($file, $mode, $format_d)= @_;

our @lssjour = qw( Dim Lun Mar Mer Jeu Ven Sam);
our @lslsjour = qw( Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi);
our @lssmois = qw(Janvier Fevrier Mars Avril Mai Juin Juillet Aout Septembre Octobre Novembre Decembre);
my $datenum = ((stat($file))[$mode]);
(my $sec,my $min,my $heure,my $mjour,my $mois,my $annee,my $sjour,my $ajour,my $isdst)=localtime($datenum);

my $pa = "";
my $num_mois = ($mois+1);
if ($mois <= 9) {
$num_mois = "0$num_mois";
}
if ($mjour <= 9) {
$mjour = "0" . "$mjour";
}
if ($heure <= 9) {
$heure = "0" . "$heure";
}
if ($min <= 9) {
$min = "0" . "$min";
}
if ($sec <= 9) {
$sec = "0" . "$sec";
}
$cj = $lssjour[$sjour];
my $pj = substr($cj, 0, 2);
my $pm = substr("$lssmois[$mois]", 0 , 3);
if ($annee < 100) {
my $pa = $annee;
}
elsif ($annee <=109) {
my $pa = "0" . ($annee-100);
}
else {
my $pa = ($annee-100);
}
if ($format_d == 1) {
# format differants 1: 20100131-203001
$fr_date_file = ($annee+=1900) . "$num_mois$mjour-$heure$min$sec";
}
elsif ($format_d == 2) {
# format differants 2: 31/01/2010-20:30
$fr_date_file = "$mjour\/$num_mois\/" . ($annee+=1900) . "-$heure:$min";
}
elsif ($format_d == 3) {
# format differants 2: Di-31/01/2010-20:30:02
$fr_date_file = "$pj-$mjour\/$num_mois\/" . ($annee+=1900) . "-$heure:$min:$sec";
}
elsif ($format_d == 4) {
# format differants: $fr_dt_file = 31Jan10-20h
$fr_date_file = "$mjour$pm" . "$pa" . "-$heure" . "h";
}
elsif ($format_d == 5) {
# format differants: $fr_dt_file = Di 31 Jan 10 - 20h30
$fr_date_file = "$pj $mjour $pm" . " $pa" . "- $heure" . "h$min";
}
else {
# format differants: $fr_date_file = Dim 31 Janvier 2010 - 20:30:02
$fr_date_file = "$lslsjour[$sjour] $mjour $lssmois[$mois] " . ($annee+=1900) . " - $heure:$min:$sec";
}
return $fr_date_file;
}
#--------------------------------------------------------------------------------------------------------

#--------------------verifd---ou----verification de l'exsitence du rep source-------------------------
sub verifd {

until (-e $d) {
print "Veuillez ré-entrer le chemin complet du dossier à traiter, expl:" .
'/home/pub/monsite ou //perl//pub//toto' . "\n";
chomp($d = );
}
if ($d =~ /^\./) {
$d =~ s/^\.//;
print "dmoins vaut: $d\n";
$d = "$dir$d";
print "d vaut: $d\n";
# recherche de rootd
my @pathl = split(/$slash/, $d);
my $fpointe = pop @pathl;
$rootd = $fpointe;
# a saquer quand ok
print "verifd:rootd = $rootd\n";
}
elsif($d =~ /^$slash/) {
my @pathl = split(/$slash/, $d);
my $fpointe = pop @pathl;
$rootd = $fpointe;
# a saquer quand ok
print "verifd:rootd = $rootd\n";
}
else {
$rootd = $d;
print "verifd:rootd = $rootd\n";
}
}
#-----------------------------------------------------------------------------------------------------

#-------------------------------------ouvre_rec ----------------------------------------
sub ouvre_rec {
my ($rootfile_file, $hdl_file, $ext)= @_;

my $i = 0;
#-----------creation d'un fichier d'enregistrement ----------
if ($rootfile_file =~ /^recap_ver2l_$rootd/) {
$flg = "$dir$slash$rootfile_file" . ".$ext";


while (-e $flg) {
$flg = "$dir$slash$rootfile_file" . "_$i" . ".$ext";
$i++;
}
}
#-------------------------------------------------------------
no strict 'refs';
my $handle = \$hdl_file;
open $$handle, ">$flg" or die "Ouverture de $flg impossible $!";
print REC '0) - fichier d\'enregistrement du travil du ' . "$fr_date_now sur $rootd\n";
print "script: $script (V: $vers) - date: $fr_date_now\n$lx\n";
}
#-------------------------------------------------------------------------------------------------------


#-------------------------------------ouvre_file ou log ---------------------------------------- géant
sub ouvre_file {
my ($rootfile_file, $hdl_file, $ext)= @_;

my $i = 0;

if ($path_tmp eq "") {
$path_tmp = $dir;
}
$flg = "$path_tmp$slash$rootfile_file.$ext";

while (-e $flg) {
$flg = "$path_tmp$slash$rootfile_file" . "_$i" . ".$ext";
$i++;
}
no strict 'refs';
$handle = \$hdl_file;
open ${$handle}, ">$flg" or die "Ouverture de $flg impossible $!";
print $hdl_file "script: $script (V: $vers) - date: $fr_date_now\n$lx\n";
}
#-----------------------------------------------------------------------------------------------------

#---------- choix et creation du repertoire temporaire------------------------------------------------\
sub faitmoitmp {
my $n = 0;
if (-e $newsite) {
while (-e $newsite) {
$n++;
$newsite = "$dir$slash" . "newsite" . "_$n";
}
mkdir $newsite or die "ouverture de $newsite impossible $!";
}
else {
mkdir $newsite or die "ouverture de $newsite impossible $!";
}
print REC "0) - adresse differants rep\n";
print REC "$newsite\n";
$tmp = "$newsite$slash" . "tmp";
print REC "$tmp\n";
mkdir $tmp or die "création de $tmp impossible $!";
$path_tmp = "$tmp$slash";
print REC "$path_tmp\n";
$path_newsite = "$newsite$slash";
print REC "$path_newsite\n";

# ca ne veut rien dire si $srep est du style /home/pub/image ca marchera pas
if (defined $srep) {
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 $slash" .
"newsite$slash" . "tmp contiendra les logs de synthése\n";
}
#-------------------------------------------------------------------------------------------------------

#---traite le repertoire source ($d)---------------------------------------------------------------------
sub traite_d {
#-----------ouverture lecture, assignation @lsfile, controle srep != sous_rep
opendir R, "$d" or die "Ouverture de $d impossible $!";
@lsfile = (sort readdir R);
closedir R or die "Fermeture du repertoire R impossible $!";
foreach $file(@lsfile) {

if ($file =~ /^\./) {
print "voulez vous traiter ce fichier [o,n](n): $file\n";
chomp ($point = );
if($point =~ /^o/i) {
push @ls_other_file, $fichiercible;
}
}
# vérifier si un rep est $srep (juste rep_rootname) et le traiter à la place de &faitmoitmp
if (-d "$d$slash$file") {
$sous_rep = $file;
# vérifier si un rep est $srep (comme /home/foo/bar) traiter à la place de &faitmoitmp
#demander a user si on traite $sous-rep
}
else {
my $fichiersource = "$d$slash$file";
#print "$lx\navant copy fichiersource vaut $fichiersource\n";
my $fichiercible = "$path_tmp$file";
#print "$lx\napres copy fichiercible vaut $fichiercible\n";
if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {
push @h_fst, $file;
push @ls_file_meta, $fichiercible;
copy($fichiersource, $fichiercible) or die "imposs de copier $fichiersource sur $fichiercible $!";
}
else {
push @h_fst, $file;
my $fichiercible = "$path_newsite$file";
push @ls_other_file, $fichiercible;
copy($fichiersource, $fichiercible) or die "imposs de copier $fichiersource sur $fichiercible $!";
}
#copy($fichiersource, $fichiercible) or die "copie imposs de $fichiersource sur $fichiercible $!";
push @nwlsfile, $file;
}
}
# rend compte sur VRL
print VRL "\n$lx\nliste des fichiers meta que recup_all recopiera dans $path_tmp\n";
foreach (@ls_file_meta) {
print VRL "$_\n";
}
print VRL "\n$lx\nliste des autre fichiers que recopier dans $path_newsite\n";
foreach (@ls_other_file) {
print VRL "$_\n";
}
print VRL "\n$lx\n";
}
#-------------------------------------------------------------------------------------------------------

#-----------------------------Recup_all_tags-------------------------------------- debut
sub recup_all_tags {
# --le handle est pour RAP

foreach $likef(@nwlsfile) {
$cf++; #compteur de fichiers
(next and print "fichier vide degager\n") if undef;
(next and print "fichier $likef degager\n") if ($likef=~ /^\./);
$kefli = $likef;
$file = "$d$slash$likef";
$encre_vue = 0;
# re-ajouter le path au nom de fichier
$ftagsrc = "$path_tmp$slash$likef";
# vérif mode (html, tml, htm, xml, etc..)
if ($likef =~ /\.{1}s?h?x?t?m{1}l?$/i) {
if($likef =~ /~$/) {
print "voulez vous traiter ce fichier $file qui est un fichier de sauvegarde ?[o,n](n)\n";
chomp(my $reponse = );
next if ($reponse =~ /^n/i);
}
$mode = 9;
$fr_date_file = datefinefile($file, $mode, $format_d);
#(push @lsfmeta, $likef and push @ls_h_fst, $likef) unless ( scalar(grep(/$likef/, @ls_h_fst)) );
#(push @ls_tencre, $likef) unless ( scalar(grep(/$likef/, @ls_tencre)) );
push @lsfmeta, $likef;
push @ls_h_fst, $likef;
push @ls_tencre, $likef;
@lines = @nwlines = "";
open FT, "$ftagsrc" or die "Ouverture du fichier $file impossible $!";
# binmode(FT);
$lpp = 0;
@lines = ;
close FT || die "Fermeture impossible $!";
# reconstruit les balises tronquées et sort sur @nwlines
@nwlines = &reconstruire_ligne(@lines);

foreach $lu(@nwlines) {
if ($lu =~ //i) {
$body = $lpp;
# discutable si &cherche_encre pas $tz++ et vice versa
&cherche_encre($lu);
$tz++;
push @copim, $lu;
$lpp++;
}
else {
&cherche_encre($lu);
push @copim, $lu;
$lpp++;
}
}
# tout ce qui suit est faut jusqu'a &faitdcopies, mais pas grave car ne peut etre utiliser - a saquer
if ($encre_vue == 0) {
# si argv = c
if ($argv eq "c") {
# $copim[$body].= "\n"; # je ne comprend pas cette ligne surement une erreur
$copim[$body] = "
\n";
print VRL "pour voir body trouvé\n$copim[$body]\n";
}
else {
# ce else est à degagez quand testé
print VRL "pour voir body trouvé\n$copim[$body]\n";
}
}
if ($argv eq "u") {
$mode = 8;
$copim[$body] .= "\n<-- mise à jour du document par $script le $fr_date_now \n" .
"initialement daté du " . datefinefile($file, $mode, $format_d) . "\n";
print VRL "pour voir body trouvé\n$copim[$body]\n";
}
print "\nfile $file et likef $likef \n";
&faitdcopies($kefli);
@copim = "";
@nwlines = "";
# detail des encres trouvées par fichiers
print VRL "\npour $likef $encre_vue encre trouvé\/s\nDétail:\n";

}
else {
# on ne sait jamais peut etre un lien fait reference à un script donc
# attention
#(push @ls_h_fst, $likef) unless ( scalar(grep(/$likef/, @ls_h_fst)) );
#(push @ls_tencre, $likef) unless ( scalar(grep(/$likef/, @ls_tencre)) );
push @ls_h_fst, $likef;
push @ls_tencre, $likef;
}
}

#---passage de la liste contenant tous les liens @ls_tencre au tableau de hashage %h_tencre
# ote les doublons
$i = 0;
print REC "1) - t_encre\n";
foreach (@ls_tencre) {
(next and print "$lx\nligne 738 un trou dans ls_tencre\n") if ($_ =~ /^$/);
print REC "$_\n";
$tmpo{$_} = $i;
$i++;
}
@ls_tencre = keys %tmpo;
undef %tmpo;
@ls_tencre = sort(@ls_tencre);
#--recopiage de @ls_tencre dans rec-------------
foreach (@ls_tencre) {
(next and print "$lx\nligne 738 un trou dans ls_tencre\n") if /^$/;
$h_tencre{$i_h_tencre} = $_;
$i_h_tencre++;
}

#--- idem pour les fichiers seul--------------------
#--recopiage de @ls_h_fst dans rec-------------
$i = 0;
print REC "2) - ls_h_fst\n";
foreach (@ls_h_fst) {
next if /^$/;
$tmpo{$_} = $i++;
}
@ls_h_fst = keys %tmpo;
undef %tmpo;
@ls_h_fst = sort(@ls_h_fst);

foreach (@ls_h_fst) {
next if /^$/;
print REC "$_\n";
$h_fst{$i_h_fst} = $_;
$i_h_fst++;
}
#-----------------------------------------------
@ls_h_fst = sort(@ls_h_fst);
#----------a degager quand pris en compte---voici les trois hachage
print VRL "\n$lx\nvoici les trois hachage:\n$lx\nh_tencre\n";

foreach $key (sort keys %h_tencre) {
$val = $h_tencre{$key};
print VRL "\t$val\n";
}
print VRL "\n$lx\nh_fst\n";
my $i= 0;
while ((my $zo, my $ht) = each %h_fst) {
if ($ht =~ /^\w/) {
($rootf, $ext)= split(/\./, $ht);
$h_rootf{$i, $ext}= $rootf;
$i++;
print VRL "\t$zo:$ht\n";
}
else {
print "faille ht vaut $ht\n";
}
}

#--- idem pour les encres seules------------------
@ls_encre_pf = sort(@ls_encre_pf);
#--recopiage de @ls_encre_pf dans rec-------------
$i = 0;
foreach (@ls_encre_pf) {
next if /^$/;
$tmpo{$_} = $i++;
}
@ls_encre_pf = keys %tmpo;
undef %tmpo;
@ls_encre_pf = sort(@ls_encre_pf);
print REC "3) - ls_encre_pf\n";
foreach (@ls_encre_pf) {
next if /^$/;
$h_tag{$i_h_tag} = $_;
$i_h_tag++;
print REC "$_\n";
}

#-----------------------------------------------

print VRL "\n$lx\nh_tag\n";
while (($zt, $htag) = each %h_tag) {
print VRL "\t$zt:$htag\n";
}
print VRL "nombre total de fichiers traité $cf\n";
print VRL "\n$lx\n$moi vous remercie d\'utiliser $script vers:$vers \n- $fr_date_now\n";
#-----------------------------------
close VRL || die "double dremmer closure of $flg not possibilé $!";

&onyva;
}
#---------------------------------------------------------------------------------------------

#--------------detronque les balises----------------------------------------------------------
sub reconstruire_ligne {
my ($lines) = @_;

# on split tout ca a plat
$tout = "@lines";
@cop = split(//, $tout);


# balise $ouvert = 1 ==> vrai; 0 ==> faux
$ouvert = $tronquage = $nltt = 0;
@ligne = @nwcop = "";
foreach $e(@cop) {
if ($ouvert == 0) {
$i++;
if($e eq "<") {
# signale qu'une balise est ouverte et pousse la ligne
$ouvert = 1;
push @ligne, $e;
}
elsif ($e eq "\n") {
# pousse \n dans @ligne puis @ligne dans @nwcop et réinitialise @ligne
push @ligne, $e;
my $ligne = join('', @ligne);
push @nwcop, $ligne;
@ligne ="";
$i = 0;
$nltt++;
}
else {
# pousse le caractère dans la ligne
push @ligne, $e;
}
}
# un balise à été ouverte donc passage en ouvert
else {
$i++;
if ($e eq "\n") {
# balise tronquées
$tronquage = 1;
$k++;
$nltt++;
}
elsif ($e eq ">") {
$ouvert = 0;
if ($tronquage == 1) {
# si tronqué pousser le caractère dans ligne et lui ajouter une fin de ligne
# puis remettre à zero $ligne, $tronquage et ouvert
push @ligne, "$e\n";
my $ligne = join('', @ligne);
push @nwcop, $ligne;
$i = 0;
@ligne = "";
$tronquage = 0;
}
elsif ($tronquage == 0) {
# si il n'y a pas eu de tronquage pousser dans ligne
push @ligne, $e;
}
}
else {
# print "je passe en ouvert quelconque $i:$e:\n";
# si c'est un caractere quelconque, le pousser dans ligne
push @ligne, $e;
}
}
}
# le texte reparer ce trouve dans @nwcopim
@nwlines = @nwcop;
}
#------------------------------------------------------------------------------

#---------recherche l'encre dans la ligne
sub cherche_encre {
my ($lu) = @_;

if ($lu=~ /$copie" or die "Ouverture de $copie impossible $!";
print FC "@nwlines";
#print FC "@copim";
#---
if ($argv eq "u") {
$mode = 8;
print FC '';
}
close FC || die "Fermeture de $copie impossible $!";

@copim = @nwcop = "";
@nwlines = @lines = "";

$z++;
}


sub onyva {

# 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);
closedir RC || die "Fermeture de $path_tmp impossible (putain de merde) $!";

$file = "";
print "Je suis dans onyva\n";
foreach $file(@files) {
next if ($file =~ /\.log$/);
$fr_date_file = datefinefile($file, $mode, $format_d);

#($troncfile, $ext)=split(/\./, $file);
#$rootfile_file = "rap_$troncfile";
#$hdl_file = "RAP";
#my $o_ext = "log";
#&ouvre_file($rootfile_file, hdl_file, $o_ext);
# print "$firstline$lx\n";
#----------------------------------------------a là

if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {
$kf++;
print "$lx\nCe fichier $file est le $kf eme que vous traité\n";
# faire ici le passage en pause

my $ftmp = $file;
($troncfile, $ext)=split(/\./, $ftmp);
$rootfile_file = "rap_$troncfile";
$hdl_file = "RAP";
my $o_ext = "log";
&ouvre_file($rootfile_file, $hdl_file, $o_ext);
# attention de pas confondre rootfile ext et encre avec celle des liens
$rootfile = $ext = $encre = "";
$countpfl = $countpl = 0;
print "$lx\n";
&controle_file($file);
&reparation($file);
&compte_rendu;
#close FSR || die "Fermeture de fsr impossible $!";
push @rep, $file;
#---degage le fichier traiter de $path_tmp
unlink "$path_tmp$file" || die "destruction de $path_tmp$file impossible $!";
# seq de pause - demande a user si il veut arreter là pour reprendre plus tard --
print "$lx\nRappel:\tmode d\'emploi du sélécteur de lien:\n" .
"[num] entrer le numéro du lien choisi\n[Enter] pour faire défiler la liste ou " .
"laisser le lien tel quel\n[Espace] séléctionner le premier ou le seul lien proposé\n" .
"[q] pour quitter\n$lx\n";
print "$lx\nCe script vous donne l'opportunité de faire une pause\n" .
"Vous pouvez arreter ici et reprendre demain là ou vous étes arrété\n" .
"Continuer [Enter] | Pause [P] | Quitter [q]:\n";
chomp(my $pause = );
if($pause =~ /^p|^q/i) {
&sortie($lastrec);
#if($reprise >= 1) {
#$rootfile_file = "report_dejavu";
#$hdl_file = "RPDV";
#my $o_ext = "log";
#&ouvre_file($rootfile_file, $hdl_file, $o_ext);
#print "ce travaill est une reprise, peut être devrez vous reporter\n" .
#"la liste report_dejavu.log sur votre $lastrec\n";
#print RPDV "4) - hdejavu\n";
#while ( ($key, $value) = each %hdejavu) {
#print RPDV "$key" . '|' . "$value\n";
#}
#close RPDV || die "fermeture du rapport dejavu impossible $!";
#print REC "4) - hdejavu\n";
#while ( ($key, $value) = each %hdejavu) {
#print REC "$key" . '|' . "$value\n";
#}
#}
#else {
#print REC "4) - hdejavu\n";
#while ( ($key, $value) = each %hdejavu) {
#print REC "$key" . '|' . "$value\n";
#}
#my $fint = time;
#$decompte = $fint - $debutt;
#print "ok, c\'est tout pour aujourd hui, vous avez travaillé\n " .
#&chrono($decompte) . "\nce decompte sera reporté sur l\'enregitrement\n";
#$decompte_total += $decompte;
#print "et en tout vous aurez travaillez " . &chrono($decompte_total) . "\n";
#print REC '5) ' . "$decompte\n";
#close REC || die "double dremmer closure of rec not possibilé $!";
#close RAP || die "far toi encouler granda connassa rap $!";
##close FRAP || die "fichier frap impossible a fermer $!";
#die "tchao, on s\'arrete la pour aujourd\'hui\n";
#}
}
}
}
my $fint = time;
my $decompte = $fint - $debutt;
print "fini msieu\nnombre total de fichiers traité $cf\nen " .
&chrono($decompte) . "\nBonne journée\n$lx\n";
close RAP || die "far toi encouler granda connassa rap $!";
print "comme vous avez fini $lastrec sera effacer\n";
close || die "fichier $_ impossible a fermer $!";

unlink "$lastrec" || die "destruction de $lastrec impossible $!";
#-------------------------------------------------------------------fin
}

#---------------------------------------------------------------------------------

#-------------------------------------controle_file------------------------------------
sub controle_file {
my ($file) = @_;

#initialisation des variables
my @contenu= "";
$filesrc = "$path_tmp" . "$file";
$fr_date_file = datefinefile($filesrc, $mode, $format_d);
print RAP "\t$lx\n$file du $fr_date_file\n";
#----------------------------------
open FI, "$filesrc" or die "Ouverture du fichier $file impossible $!";
@contenu = ;
close FI || die "Fermeture impossible $!";
$countpl = 0;
#--------------------------- voila regler ca et fermer les fichier ouverts

foreach $line(@contenu) {
$cnttl++;
$countpl++; #compteur de ligne par file

$countpfl = 0; # ok initialise compteur par lien de la ligne
$ma_ligne = $line;
#print "$countpl av-lsm line: $line\n";
@ls_m = ($line =~ /a\shref=\"(.*?)\"\>/ig);
#print "$countpl ap-lsm line: $line\n";
foreach (@ls_m) {
$j++; # #numero unique du lien
$corrompu = $etlencre = 0;
$encre = "";
$lnkbrt = $lnkbrut = $_;
# ok compteur par liens dans la ligne (3 max)
$countpfl++;
$oldlb = $lnkbrut;
# a degager quand tout tourne ca c'est du bla bla
$fl = &flog($file);
print RAP "$lx\n$fl lien brut: $lnkbrut c\'est le $nieme[$countpfl]\n";
$err = "err $fl lkb:$lnkbrut l: $countpl n: $countpfl\n";
print "lnkbrut $lnkbrut\tcountpl $countpl\n";
if ($lnkbrut=~ /^mailto/) {
($kk, $email) = split(/:/, $lnkbrut);
($login, $fai) = split(/\@/, $email);
$eb++;
$v++;
print RAP "login = $login et fai = $fai\n";
#------------------------modification perso
if ($email =~ /^a.?adelmar\@\w+\.fr/) {
$e_mailp = "aadelmar\@numericable\.fr";
print RAP "erreur adresse corrigé $email deviens $e_mailp\n";
$ea++;
print "$countpl av-email line: $line\n";
$line =~ s/()\Q$email\E()/$1$e_mailp$2/;
print "$countpl ap-email line: $line\n";
$v++;
# a saquer because c'est line qu'il faut modifier (faire un test)
print "mauvaise adresse reparé line: $line\n";
#$nwmot = s/()$email()/($1)$e_mailp($2)/;
print "modif d'adresse mail effectué sur $file fraction de ligne $e_mailp\n";
}
push @adressemail, "$login\@$fai";
&chklnk;
$v++;
}
#--------lien vers news-groupes trouvé
elsif ($lnkbrut=~ /^news/) {
($kk, $nws) =split(/:/, $lnkbrut);
print RAP "news-groupes trouvé $nws\n";
$eb++; #pas sur
&chklnk;
$v++;
}
#--------------------http
elsif ($lnkbrut=~ /^http:\/\//i) {
$encre = "";
($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
$encre= "";
&chklnk;
$v++;
}
#------------------ftp
elsif ($lnkbrut=~ /^ftp:\/\//i) {
$encre= "";
($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
$encre= "";
&chklnk;
$v++;
}
#-------------------local (ce qui nous interresse)
#-----------------------------------------------------------------ici
else {
SCONTROL:if (exists ${{reverse %h_tencre}} {$lnkbrut}) {
# *CB1 tout bon
print RAP " *CB1 good tb $lnkbrut n\:$j nc\:$v\n";
# controle d'un lien reparrer instruit les hashs
if($expl2l >= 1) {
unless(exists ${{reverse %hdejavu}} {$lsr[0]}) {
$hdejavu{$lsr[0]} = $lsr[1];
}
# réinitialisation
@lsr = "";
$expl2l = 0;
print "et un lien qui ce reparera tout seul\n";
}
$v++;
$eb++;
}
else {
if($expl2l >= 1) {
print "peut etre voulez vous conserver ce lien: $lnkbrut [o,n](o)?\n";
chomp($reponse = );
unless($confirme =~ /^n/i) {
unless(exists ${{reverse %hdejavu}} {$lsr[0]}) {
$hdejavu{$lsr[0]} = $lsr[1];
}
print "et un lien qui ce reparera tout seul\n";
}
print "ce lien ne sera donc pas ajouter a hdejavu\n";
# réinitialisation
@lsr = "";
$expl2l = 0;
}
# *CB2 peut etre a deja été réparer
elsif (exists $hdejavu{$lnkbrut}) {
$lnkbrut = $hdejavu{$lnkbrut};
print "et un lien deja reparer\n";
print RAP "*CB2 ce lien a deja été reparer $lnkbrut ca matche nlien\:$j nc\:$v\n";
$ef++;
$auto_r++;
&chklnk;
goto SCONTROL;
$v++;
$eb++;
}
# *CB3(2/2) peut etre le lien ne pointe que sur encre
elsif (exists ${{reverse %h_tag}} {$lnkbrut}) {
# *CB3(1) si le nom de la page + le lien colle----------------pass 3 ok--v
if(exists ${{reverse %h_tencre}} {"$file" . "$lnkbrut"}) {
print "et un target de trouvé en ajoutant file devant\n";
print RAP "*CB3(1) en mettant $file avant $lnkbrut ca matche nlien\:$j nc\:$v\n";
$lnkbrut = "$file$lnkbrut";
$ef++;
&chklnk;
goto SCONTROL;
$v++;
$eb++;
}
#------------------------------------------------------------------------------°
# sinon
else {
# *CB3(2)
print "ceci est fortement improbable mais votre lien $lnkbrut doit etre reparrer\n" .
"ufull:\n";
print RAP " *CB3(2) good sf $lnkbrut nlien\:$j nc\:$v\n";

&ufull($file);
}
}
elsif (exists ${{reverse %h_tencre}} {"$file$lnkbrut"}) {
print "et un target de trouvé en ajoutant file devant\n";
print RAP "*CB3(3) en mettant $file avant $lnkbrut ca matche nlien\:$j nc\:$v\n";
$lnkbrut = "$file$lnkbrut";
$v++;
$ef++;
&chklnk;
goto SCONTROL;
}
elsif ($lnkbrut =~ /\"/) {
print "et un target de trouvé\n";
print RAP "*CB4target avant $lnkbrut nlien\:$j nc\:$v\n";
($lnkbrut, $target)=split(/\"/, $lnkbrut);
$ef++;
$v++;
print RAP "*CB4target apres $lnkbrut nlien\:$j nc\:$v\n";
&chklnk;
goto SCONTROL;
}
# *CB4 --apres la moulinette a bon liens on entre dans le vif------
elsif ($lnkbrut =~ /[\/]|[\\]/) {
# if ($lnknet =~ /[\/]|[\\]/) {
$ef++;
$v++;
print RAP " *CB4a part a dp $lnkbrut nlien\:$j nc\:$v\n";
&degage_path;
}
else {
# assignation des valeurs lnknet et encre et stockage des parametres existants
$ere++;
&decortique_file($lnkbrut);
$flplus = &flog($file);
print RAP " *CB4 $flplus\n";
# *CB4b(2/2)------------------------------------------------------------| pass 2 ok --v
if ($lnkbrut=~ /^\#/) {
$lnkbrut = "$file" . "$lnkbrut";
print RAP "*CB4b $lnkbrut nlien\:$j nc\:$v\n";
#---------------------------------------------------------------------------°
# *CB4b1
if (exists ${{reverse %h_tencre}} {$lnkbrut}) {
$flplus = &flog($file);
print RAP "$flplus fff encre seule a reparrer $lnknet deviens $lnkbrut\n";
&ufull($file);
$v++;
print RAP "*CB4b1 $lnkbrut nlien\:$j nc\:$v\n";
goto SCONTROL;
}
else {
#---------------------------------------------------------------------|pass 2 ok --v
# *CB4b2
$flplus = &flog($file);
print RAP "*CB4b2 $flplus commence par dieze mais encre pas bonne $lnkbrut\n";
$etlencre= 1;
$lnknet = $file;
($rootfile, $ext)=split(/\./, $lnknet);
#&ufe($line, $lnkbrut);
&ufull($file);
$v++;
goto SCONTROL;
}
#--------------------------------------------------------------------------------------°
}
elsif ($encre =~ /top()/i) {
$encre = s/$1//;
}
# *CB4c ici on ce rend compte que file est bon mais y a autre chose qui pourri le lien
elsif (exists ${{reverse %h_fst}} {$lnknet}) {
my $q = 0;
&ufe($file);
print RAP " *CB4c2 $lnkbrut nlien\:$j nc\:$v\n";
$v++;
&chklnk;
goto SCONTROL;
print "ici la fin du buzz encre\n";
}
# *CB4d ici on se rend compte que c'est l'extention qui daille
elsif (exists ${{reverse %h_tencre}} {"$rootfile\.html\#$encre"}) {
print RAP "ok c'etait l'extention qui daillait, donc ext=html|lnkbrut: $lnkbrut nlien\:$j nc\:$v\n";
$lnkbrut = "$rootfile\.html\#$encre";
print RAP " *CB4d $lnkbrut nlien\:$j nc\:$v\n";
&chklnk;
$v++;
}
# *CB4e ici on se rend compte que c'est l'extention qui daille
elsif (exists ${{reverse %h_fst}} {"$rootfile\.html"}) {
$fl = &flog($file);
print RAP "*CB4e $fl : ici c'est rootfile qui est ok\n";
# *CB4e1-----------------------------------------------------| pass 5 ok ---v
if($encre == 0) {
$lnkbrut = "$rootfile\.html";
print RAP " *CB4e1 $lnkbrut nlien\:$j nc\:$v\n";
&chklnk;
$v++;
}
#---------------------------------------------------------------------------°
# *CB4e2
else {
# si cette construction est infructueuse faire lnknet=rootfile.html =>ufe
$lnkbrut = "$rootfile\.html\#$encre";
print RAP " *CB4e2 $lnkbrut nlien\:$j nc\:$v\n";
&chklnk;
$v++;
goto SCONTROLE;
}
}
# *CB4f ici il n'y a que rootfile qui matche
elsif (exists ${{reverse %h_rootf}} {$rootfile}) {
print "quel lien match, choisissez:\n";
my $q = 0;
&ufe($file);
print RAP " *CB4f $lnkbrut nlien\:$j nc\:$v\n";
&chklnk;
$v++;
goto SCONTROL;
}
# *CB4g
else {
# si il y a une encre (reparrer)et aussi un faux nom de fichier creer un if
# $p++;
# *CB4g1-------------------------------------------------------------Pass 4 ok --v
if ($encre eq "") {
# Dernier else | sans encre ce liens part a uf: code erreur "desauf"
$flplus = &flog($file);
print "$lx desauf\n$flplus\n";
print RAP " *CB4g1 (mais pas sorti) $lx desauf\n$flplus\n";
&uf($file);
}
#------------------------------------------------------------------------------°
# *CB4g2 --------------------------------------------------------------Pass 6 ok--v
else {
# choisir un fichier puis une encre
# Dernier else num: $p| avec encre ce liens part a ufull: code erreur deaafull
$flplus = &flog($file);
print "$lx deaafull\n$flplus\n";
print RAP "*CB4g2 $lx deaafull\n$flplus\n";
&ufull($file);
#--------------------------------------------------------------------------------°
}
}
}
}
}
}
# $j = 1; # $j est le compteur de liens total
AVOTER:
push @nwcontenu, $ma_ligne;
}
}
#------------------------------------fin de controle_file----------------------------------------

#---------------reparation------------------------------------------- debut
sub reparation {
my ($file)= @_;

$fcible = "$path_newsite$file";
open FR, ">$fcible" or die "Ouverture de $fcible impossible $!";
print FR @nwcontenu;
#réinitialisation des listes par fichiers
@nwcontenu = ""; # ou @nwcontenu = @nwl = "";
close FR || die "Fermeture de $fcible impossible $!";
}
#--------------------------------------------------------------------- fin

#----------------------------uti_f-----juste ce qui matche avec 1er lettre------------------
sub uti_f {
my ($file)= @_;

system "$clear";
$userx = "uf";
$fl = &flog($file);
print "$lx\n$fl lien brut a changer: $lnkbrut| c\'est le $nieme[$countpfl]|" .
"[num]|[Enter]|[Espace]|[q] quitter. (uti_f)\n";
print RAP "uf:Ce lien n a pas de corresp $lnkbrut il par a uti_f\n";
$i = $vingt = $pass = 0;
foreach (@ls_h_fst) {
if($vingt <= 19) {
print "$i\t$_\n";
$vingt++;
}
else {
print "$i\t$value\n";
$pass++; # si pass > 0 => \n ne veut rien dire sinon $[0]
#$i--;
&ru(@ls_h_fst);
}
$i++;
}

$pass = 0;
&ru(@ls_h_fst);
}
#-------------------------------------------------------------------------------------------

#----------------------------uf---------------------------------------------
sub uf {
my ($file)= @_;

system "clear";
$userx = "uf";
$fl = &flog($file);
print "$lx\n$fl lien brut a changer: $lnkbrut| c\'est le $nieme[$countpfl]|" .
"[num]|[Enter]|[Espace]|[q] quitter. (uf)\n";
print RAP "uf:Ce lien n a pas de corresp $lnkbrut il par a uf\n";
$i = $vingt = 0;
foreach (@ls_h_fst) {
$value = $_;
($lknet_tmp, $ext)= split(/\./, $value);
#print "uf cherche concordance lknet_tmp: $lknet_tmp" . substr($lknet_tmp,0,1) . "\text: $ext\n";

if(substr($lknet_tmp,0,1) eq substr($lnkbrut,0,1)) {
if($vingt <= 19) {
print "$i\t$value\n";
$vingt++;
}
else {
print "$i\t$value\n";
$pass++; # si pass > 0 => \n ne veut rien dire sinon $[0]
#$i--;
&ru(@ls_h_fst);
}
}
$i++;
}
$pass = 0;
&ru(@ls_h_fst);
}
#-------------------------------------------------------------------------------------------


#------------------------------------ru (reponse user) -------------------------------------
sub ru {
my (@ls_liens)= @_;

chomp($repu = );
# si l'user ne veux pas ce prononcer| ou n'est pas dans les 40 propositions pour uf et uef
if($repu eq "") {
if($pass >= 1) {
$vingt = 0;
}
else {
print "vous avez choisi de ne rien modifier voyons avec tout les fichiers $lnkbrut \n";
if ($round == 0) {
$round++;
if($userx eq "uf") {
&uti_f;
}
elsif($userx eq "fe") {
&uti_full;
}
else {
&uti_full;
}
}
else {
$round = 0;
&chklnk;
undef $repu;
goto AVOTER;
}
}
}
elsif($repu =~ /^\d/) {
$expl2l++;
$lsr[0] = $lnkbrut;
$lnkbrut = $ls_liens[$repu] || (print "erreur saisie, refaire\n");
$lsr[1] = $lnkbrut;
print RAP "\n $userx important\n$lnkbrut\n";
print "Votre choix valider:\t $lnkbrut\n";
print "lsr0 vaut " . $lsr[0] . " et lsr1 vaut " . $lsr[1] . "\n";
$userx = "";
$round = 0;
$v++;
&chklnk;
undef $repu;
goto SCONTROL;
}
elsif($repu =~ /\s/) {
(print "votre choix $lnkbrut\n" and $lnkbrut = $ls_liens[$i]) || (print "err à refaire\n");
$userx = "";
$round = 0;
$v++;
&chklnk;
undef $repu;
goto SCONTROL;
}
elsif($repu =~ /^q$/i) {
$userx = "";
$round = 0;
$v++;
print "Ce programme va se fermer, retrouver les log dans /newsite/tmp \n";
print RAP "Programme $script vers:$vers d\' $moi\nfermer par utilisateur à $fr_date_now,\n";
open REC, ">>$lastrec" or die "ouverture de $lastrec impossible $!";
@contenu = ;
unlink ();
print REC "@contenu";
print REC "4) - hdejavu\n";
while ( ($key, $value) = each %hdejavu) {
print REC "$key" . '|' . "$value\n";
}
my $fint = time;
$decompte = $fint - $debutt;
print "ok, c\'est tout pour aujourd hui, vous avez travaillé\n " .
&chrono($decompte) . "\nce decompte sera reporté sur l\'enregitrement\n";
$decompte_total += $decompte;
print "et en tout vous aurez travaillez " . &chrono($decompte_total) . "\nbonne journée\n";
print REC '5) ' . "$decompte\n";
close REC || die "double dremmer closure of rec not possibilé $!";

close RAP || die "far toi encouler granda connassa rap $!";
closedir RC || die "Fermeture de $path_tmp impossible (putain de merde) $!";
close || die "fermeture de tout le reste impossible $!";
}
else {
print "Vous avez entrer $repu ca remplacera $lnkbrut\n" .
"Souhaitez vous que je traite les autres erreurs similaire de la même façon?[o,n](o)";
chomp($reponse = );
if($reponse =~ /^n/i) {
print "Ok, juste ce lien sera remplacer et passer a la verification\n";
$lnkbrut = $repu;
$lnkbrt = $lnkbrut;
($lnknet, $encre)= split(/\#/, $lnkbrt);
&chklnk;
undef $repu;
$userx = "";
$round = 0;
$v++;
goto SCONTROL;
}
else {
$expl2l++;
$lsr[0] = $lnkbrut;
$lnkbrut = $repu;
$lsr[1] = $lnkbrut;
$lnkbrt = $lnkbrut;
($lnknet, $encre)= split(/\#/, $lnkbrt);
&chklnk;
undef $repu;
$userx = "";
$round = 0;
$v++;
goto SCONTROL;
}

}
}
#-----------------------------------------------------------------------------------------

#-------------------------------------ufe------------------------------------------------
sub ufe {
my ($file)= @_;

system "clear";
$userx = "fe";
$fl = &flog($file);
print "$lx\n$fl lien brut a changer: $lnkbrut| c\'est le $nieme[$countpfl]|" .
"[num]|[Enter]|[Espace]|[q] quitter. (ufe)\n";
print RAP "uf:Ce lien n a pas de corresp $lnkbrut il par a ufe\n";
$i = $vingt = 0;
foreach (@ls_tencre) {
$value = $_;
($lknet_tmp, $encre_tmp)= split(/\#/, $value);
if(substr($lknet_tmp,1) eq substr($lnknet,1)) {
if($vingt <= 19) {
print "$i\t$value\n";
$vingt++;
}
else {
print "$i\t$value\n";
$pass++; # si pass > 0 => \n ne veut rien dire sinon $[0]
#$i--;
&ru(@ls_tencre);
}
}
$i++;
}
$pass = 0;
&ru(@ls_tencre);
}
#----------------------------------------------------------------------------------------


#--------------------------------uti_full---------------------------------------------------
sub uti_full {
my ($file)= @_;

system "clear";
$userx = "full";
print "$lx\n$fl lien brut a changer: $lnkbrut| c\'est le $nieme[$countpfl]|" .
"[num]|[Enter]|[Espace]|[q] quitter. (uti_full)\n";
print RAP "uf:Ce lien n a pas de corresp $lnkbrut il par a uti_full\n";
$i = $vingt = 0;
foreach (@ls_tencre) {
next if /""/;
if($vingt <= 19) {
print "$i\t$_\n";
$vingt++;
}
else {
print "$i\t$_\n";
$pass++; # si pass > 0 => \n ne veut rien dire sinon $[0]
&ru(@ls_tencre);
#$i--;
}
$i++;
}
$pass = 0;
&ru(@ls_tencre);
}
#-------------------------------------------------------------------------------------

#--------------------------------ufull---------------------------------------------------
sub ufull {
my ($file)= @_;

system "clear";
$userx = "full";
$fl = &flog($file);
print "$lx\n$fl lien brut a changer: $lnkbrut| c\'est le $nieme[$countpfl]|" .
"[num]|[Enter]|[Espace]|[q] quitter. (ufull)\n";
print RAP "uf:Ce lien n a pas de corresp $lnkbrut il par a ufull\n";
$i = $vingt = 0;
foreach (@ls_tencre) {
$value = $_;
($lknet_tmp, $encre_tmp)= split(/\#/, $value);
if(substr($lknet_tmp,0,1) eq substr($lnkbrut,0,1)) {
if($vingt <= 19) {
print "$i\t$value\n";
$vingt++;
}
else {
print "$i\t$_\n";
$pass++; # si pass > 0 => \n ne veut rien dire sinon $[0]
#$i--;
&ru(@ls_tencre);
}
}
$i++;
}
$pass = 0;
&ru(@ls_tencre);
}
#-------------------------------------------------------------------------------------

#------------------------------decortique_file-----------------------------------------
sub decortique_file {
my ($lnkbrut) = @_;

# decortique le nom complet($lnkbrut) en lnknet, encre, rootfile et ext
# sans toucher a lnkbrut et lnknet
($lnknet, $encre) = split(/\#/, $lnkbrut);
($rootfile, $ext) = split(/\./, $lnknet);
}
#---------------------------------------------------------------------------------------

#--------------------------sous procedure qui modifie les portions de ligne-----------
sub chklnk {

if ($ma_ligne eq "") {
$line = $ma_ligne;
print "$lx\nCatastrophe y a plus de ligne $ma_ligne\n";
}

if($corrompu == 0) {
$ma_ligne =~ s/()\Q$oldlb\E()/$1$lnkbrut$2/;
print "chklnk oldlb: $oldlb\tlnkbrut: $lnkbrut\n";
print "donc line vaut $ma_ligne\n";
$oldlb = $lnkbrut;
$corrompu++;
}
else {
$ma_ligne =~ s/()\Q$oldlb\E()/$1$lnkbrut$2/;
$oldlb = $lnkbrut;
}
# $line =~ s/$oldlb/$lnkbrut/xmg;
# $line =~ s/()\Q$oldlb\E()/$1$lnkbrut$2/;

}
#-------------------------------------------------------------------------------------

#---------------------------------------------------------------degage_path
sub degage_path {
print RAP "DP: path trop long $err\n";
&decortique_file($lnkbrut);
while ($lnknet =~ /$slash/) {
@pathl = split(/$slash/, $lnknet);
$fpointe = pop @pathl;
# $presquesrep = pop @path1;
# ($fpointe = $presquesrep) if ($presquesrep=~ /$srep$/); #laisse srep dans le nom si exsiste
if ($encre =~ /^#|^\w/) {
$lnknet = $fpointe;
$lnkbrut = "$lnknet" . "\#$encre";
print RAP "Correction faite $lnkbrut par dp\n";
print "Correction faite $lnkbrut par dp et encre vaut $encre\n";
}
#
#------------------------------------------------pass 4 ok -------v
else {
$lnkbrut = $lnknet = $fpointe;
print RAP "Corriger: $lnkbrut par dp\n";
print "Correction faite $lnkbrut par dp (else)\n";
}
#-----------------------------------------------------------------°
}
$fr++;
$v++;
&chklnk;
goto SCONTROL;
}
#---------------------------------------------------------------------------

#----------------------------------------Compte rendu ---------------------------debut
sub compte_rendu {

if ($file =~ /\.{1}s?h?x?t?m{1}l?$/i) {
$file_cr= "$path_tmp" . "frap_" . "$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 (@lnk_http) {
print FRAP "adresse Web: $_\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 (@lnk_ftp) {
print FRAP "adresse ftp: $_\n";
}
print FRAP "\n$lx\navec hashage now:\n";
while ( ($key, $value) = each %h_lnkftp) {
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 $j liens controler :\n";
print FRAP "$cntlnkhttp liens http: " . "\nnon controler\n" . "\n$cntlnkftp liens ftp:\n" .
"non controler pour le moment\n";
print FRAP "Les lnknet maintenant\n";
print FRAP "$j liens controler sur $file\n";
print FRAP "$lx\nles liens auto reparer $auto_r$lx\n";
print FRAP "recap total de $j liens:\n$eb bon adressage\n$ef erreur adressage\n" .
"$fr erreur adressage fichier réparer\n$eb bonne encre\n$ere erreur encre\n" .
"erreur 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 $fr_date_now\n";
close FRAP || die "dreumer ca bloque $!";
}

# --------------------------------remise a zero de nwlines et incremente index rapport
@nwcontenu = "";
$ir++;
}
#------------------------------------------------------------------------------------- fin

sub flog {
my ($file) = @_;

($encre = "") if (!($encre));
($ext = "") if (!($ext));
$fl = "file: $file \|ligne:$countpl"; #ok preindication file origine ligne (pour RAP_a)
$flplus = "$fl \|lnknet:$lnknet encre:$encre rootfile:$rootfile ext:$ext\n"; # pas initialisé?
}
#---------------------------------------------------------------------------------------

#---------------------------chargerec------------------------------------------------------
sub chargerec {
my (@sav) = @_;

print shift(@sav) . "\n"; # pour savoir ce que l'on charge
print "\t" . shift(@sav) . "\n"; # les adresse sous rep
$newsite = shift(@sav);
# controle a saquer quand ok
print "en chargerec | \$newsite vaut $newsite\n";
chomp($newsite);
$tmp = shift(@sav);
# controle a saquer quand ok
print "en chargerec | \$tmp vaut $tmp";
chomp($tmp);
$path_tmp = shift(@sav);
# controle a saquer quand ok
print "en chargerec | \$path_tmp vaut $path_tmp";
chomp($path_tmp);
$path_newsite = shift(@sav);
print "en chargerec | \$path_newsite vaut $path_newsite";
chomp($path_newsite);

print "voici ce qui reste de sav:÷@sav\n";
$i = 0;
foreach (@sav) {
chomp;
if($_=~ /^\d\)\s-/) {
print "$_\n";
$qls++;
$i = 0;
}
elsif($qls == 1) {
#$ls_tencre[$i] = $_;
next if /^$/;
$ls_tencre[$i] = $_;
$i++;
}
elsif($qls == 2) {
#$ls_h_fst[$i] = $_;
next if /^$/;
$ls_h_fst[$i] = $_;
$i++;
}
elsif($qls == 3) {
#$ls_encre_pf[$i] = $_;
next if /^$/;
$ls_encre_pf[$i] = $_;
$i++;
}
elsif($qls == 4) {
next if /^$/;
($key, $value) = split(/\|/, $_);
$hdejavu{$key} = $value;
$i++;
}
else {
push @decompture, $_;
print "decompage : $_;\n";
}
}
# pour controle a degager quand ok
print "voyons ce qui est chargé\n";
for(keys %hdejavu) {
print "$_\n";
}

# accumulation de tout les decompte
foreach (@decompture) {
$decompte_total = ($decompte_total + $_);
}

# chargement hash h_tencre
foreach (@ls_tencre) {
next if /^$/;
$h_tencre{$i_h_tencre} = "$_";
$i_h_tencre++;
}

# chargement de h_fst
foreach (@ls_h_fst) {
next if /^$/;
$h_fst{$i_h_fst} = "$_";
$i_h_fst++;
}

my $i= 0;
while ((my $zo, my $ht) = each %h_fst) {
if ($ht =~ /^\w/) {
($rootf, $ext)= split(/\./, $ht);
$h_rootf{$i, $ext}= $rootf;
$i++;
}
else {
print "faille ht vaut $ht\n";
}
}

# chargement de h_tag
foreach (@ls_encre_pf) {
next if /^$/;
$h_tag{$i_h_tag} = "$_";
$i_h_tag++;
}

print "voila les variables sont charger\nallez on reprend ou on c\'etait arreter\n";


&onyva;
}

sub chrono {
my ($decompte)=@_;

my $secondes = $decompte % 60;
my $minutes = ($decompte / 60) % 60;
my $heures = ($decompte / (60 * 60));

printf("temps écoulé: %d secondes correspondent à %02d:%02d:%02d\n",
($decompte,
$heures,
$minutes,
$secondes));
}

sub sortie {
my ($lastrec)=@_;

close REC || print "gestion de la sortie\n";
if($reprise >= 1) {
$rootfile_file = "report_dejavu";
$hdl_file = "RPDV";
my $o_ext = "log";
&ouvre_file($rootfile_file, $hdl_file, $o_ext);
print "ce travaill est une reprise, peut être devrez vous reporter\n" .
"la liste report_dejavu.log sur votre $lastrec\n";
print RPDV "4) - hdejavu\n";
while ( ($key, $value) = each %hdejavu) {
print RPDV "$key" . '|' . "$value\n";
}
close RPDV || die "fermeture du rapport dejavu impossible $!";
#----------------------
open REC, ">>$lastrec" or die "ouverture de $lastrec impossible $!";
@contenu = ;
unlink ();
my $deb = 0;
foreach (@contenu) {
if($deb >= 1) {
if(/^5\)/) {
(my $kk, my $sdecompte)=split(/\s/, $_);
$decompte = $sdecompte + $decompte;
print 'Vous avez travaillez en tout - ' . &chrono($decompte) . "\n";
}
else {
(my $key, my $value)=split('|', $_);
$hdejavu{$key} = $value;
}
}
else {
if(/^4\)/) {
$deb++;
}
else {
push @debuts, $_;
}
}
}
print REC "@debuts";
print REC "4) - hdejavu\n";
while ( ($key, $value) = each %hdejavu) {
print REC "$key" . '|' . "$value\n";
}
print REC '5) ' . "$decompte\n";
close REC || die "fermeture de $lastrec impossible $!";
die "tchao, on s\'arrete la pour aujourd\'hui\n";
}
else {
open REC, ">>$lastrec" or die "ouverture de $lastrec impossible $!";
@contenu = ;
unlink ();
print REC "@contenu";
print REC "4) - hdejavu\n";
while ( ($key, $value) = each %hdejavu) {
print REC "$key" . '|' . "$value\n";
}
my $fint = time;
$decompte = $fint - $debutt;
print "ok, c\'est tout pour aujourd hui, vous avez travaillé\n " .
&chrono($decompte) . "\nce decompte sera reporté sur l\'enregitrement\n";
$decompte_total += $decompte;
print "et en tout vous aurez travaillez " . &chrono($decompte_total) . "\n";
print REC "$decompte\n";
close REC || die "double dremmer closure of rec not possibilé $!";
close RAP || die "far toi encouler granda connassa rap $!";
#close FRAP || die "fichier frap impossible a fermer $!";
die "tchao, on s\'arrete la pour aujourd\'hui\n";
}
}



format STDOUT =
@<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$na, $a, $nb, $b
.

# script Perl écrit par alain Adelmar
# ce script repare tout les liens, et peut meme le faire en plusieurs fois
# ça fonctionne même avec les gros site _ testé sur le mien >200 et >40 000 liens

END;

Ce script est le dernier que j'ai écris, c'est la version 2.5
Je vais essayer de tenir cette page à jour.
Alain Adelmar