#!/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'afféctation, de path (absolu ou relatif) * # UNIX/M$/LX, les fautes d'extentions, doublons, ortografe, etc... * # Vérif des encres et ré-attribution du 1er 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.9| 06.2011 alain Adelmar Pessac aadelmar@numericable.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 non marquées et* # crée une base de données alphabétique (voir option b).* # -d (db alphabétique) créera un regroupement alphabétique des noms* # de fichier en (liste_a.html, liste_b.html, etc...) il * # créera également un cartouche permetant d'y accéder, * # (une ossature d'index) dans menu.html. * # -g (gros site) prévoi une sauvegarde du travail pour le passer en* # plusieurs fois * # -u (update) insére la date de mise à jour, en gardant l'original * # en commantaire, répare les liens. * # -l (light) essai de reparer par lui meme et tri avant de proposer* # a l'utilisateur. (peu simplifier le travail) * # -s (silencieux) reparre les liens sans intervention de user, fait* # un rapport pour ce qu'il n'a pas réparrer. * #------------------------------------------------------------------* # (script Perl pour environement M$ et UNIX-LIKE) * # créé par alain Adelmar (2002-2011) à Pessac 6 rue de Tunis 33600 * #******************************************************************* #$Header: /home/commun/atelier/RCS/ver2l,v 2.8 2011/05/25 22:27:58 alain Exp alain $ #$Log: ver2l,v $ #Revision 2.8 2011/05/25 22:27:58 alain #-verification que l'ajout est effectif et adhequat #-ajout de $i pour compter les enreg dans chaque fichiers temoin de charge #-supression de l'ajout file/file de czs fichier temoins #-modification de top_ en _top dans cherche_encre dans recup_all_tag #-l'ajout est bien pris en compte dans ru #-regarder pourquoi uti-f taxe la derniere données des 20 en la remplassant #par X-Windows-Userxxx #écrit par alain Adelmar 6 rue de Tunis 33600 Pessac _ tchao j'y vois plus rien, ça craint # #Revision 2.7 2011/05/25 11:39:53 alain #* beaucoup de modifications sur cette version. #-ajout d'un contrôle sur tous les contrôle utilisateur: # la touche $ qui signifiera que le fichier vers lequel # le lien pointe est inexistant et donc changera ce lien # pour qu'il pointe sur une page qui avertira le lecteur. #-ajout de cette possibilité dans: uf ufull utif ufe uti_full. #-modification des labels pour une plus grande lisibilité. # - ajout de la page err_lien.html dans la publication. #- prise en charge dans %h_tencre des liens entrés par l'utilisateur # et ce dans la session courante (ne nessécitant pas de relance). # Ces prise en charge sont intégrés au niveau de la sub ru # (après l'entrée sous forme de String et acceptation user). # Ainsi que dans le premier contrôle ne reconnaissant pas l' # éxistance de $lnkbrut dans le reverse %h_tencre et ayant # déjà était reparrer et aprés acceptation. #Plusieurs réctifications mineures faites. #Alain Adelmar aadelmar@numericable.fr 6 rue de Tunis Pessac # #Revision 2.6 2011/05/18 14:02:43 alain #Ceci est la dernière moture de ver2l appelé aussi ver2l_m #quasiement tout les bugs on étés suprimer par mes soins. #La seule imperfection viens du fichier de sauvegarde qui #écris souvent les choix corrigé en plusieurs sous-classes. #Faux que je fasse plus simple ou carrement sur un autre fichier #Ce qui permettrai de faire des priorités dans les choix... #J'ai laisser tomber la programmation de ver2l depuis 6mois #donc il est impossible de noter les modifs apporter depuis. #Enfin il fonctionne bien quand même. #Alain Adelmar 6 rue de Tunis 33600 #-------------------- #Beaucoup de choses sont arrivées ces derniers mois. #a+ # #Revision 2.5 2010/08/29 01:38:49 alain #- pose des var propre à RCS #- creation d'une confirmation pour les fichiers aillant été reparer # 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 controle 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 booleen $reprise. #testé ca fonctionne il manque encore quelques réglages et des tests #dans toutes les possibilitées. #encore un tomberau 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 corections 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. #Ecris par alain Adelmar 6 rue de Tunis 33600. #J'ai plus avancé chaque jours que pendant 10ans # #Revision 2.4 2010/08/27 19:34:56 alain #- pose des var propre à RCS #- création d'un controle intelligent c_a_d créant un hash aillant pour # clé le lien brut initial faux pas encore reparer qui servira de modele # 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 sortie impromptues #- testé %hdejavu fonctionne bien #cette version fonctionne et les pages sont reparrer 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 site (>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 my $boucle = 0; # booléen pour traiter les fichier déja réparer 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 my $cmpt = 0; # recuperation de chiffre venant de @decompte 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 ®arder 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 = "d") if ($ARGV[0]=~ /^d/); # pour db alphabétique ($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; #(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"; # ici on ne peut pas recopier les fichiers initiaux et perdre le benefice des # lignes reconstruites donc créé des nouveau fichiers &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 @nwcop @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 aprés avoir traité $file " . "\nvous 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]; } # ajouter aussi a h_tencre et verifier si c'est bien enregistré my $tailleh_tencre = keys(%h_tencre); $h_tencre{$tailleh_tencre++}= $lnkbrut; print "zzz ajout de $lnkbrut dans h_tencre effectué A\n"; #----------------------------------------------------------- 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}) { $boucle++; $lnkbrut = $hdejavu{$lnkbrut}; (next and print "boucle reparer\n" and $boucle = 0)if($boucle >=1); 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"; °age_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]|\n" . "\t[num] pour numero corespondant au lien|\n\t[Enter] pour continuer la recherche|" . "\n\t[Espace] pour garder le lien tel qu\'il est|\n\t[q] pour quitter|\n\t[\$] " . "pour prendre en compte l'erreur \t\t(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]|\n" . "\t[num] pour numero corespondant au lien|\n\t[Enter] pour continuer la recherche|" . "\n\t[Espace] pour garder le lien tel qu\'il est|\n\t[q] pour quitter|\n\t[\$] " . "pour prendre en compte l'erreur \t\t(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 eq "\x24") { print "votre prevenez l'utilisateur que ce lien n'est plus valide\n"; $lnkbrut = 'err_lien.html'; $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"); print "votre choix $lnkbrut il ne sera pas verifier\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; #ajout a %h_tencre et verif-------- my $tailleh_tencre = keys(%h_tencre); $tailleh_tencre++; $h_tencre{$tailleh_tencre}= $repu; print "ajout de $lnkbrut dans h_tencre effectué (dans ru)\n"; #----------------------------------- ($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]|\n" . "\t[num] pour numero corespondant au lien|\n\t[Enter] pour continuer la recherche|" . "\n\t[Espace] pour garder le lien tel qu\'il est|\n\t[q] pour quitter|\n\t[\$] " . "pour prendre en compte l'erreur \t\t(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]|\n" . "\t[num] pour numero correspondant au lien|\n\t[Enter] pour continuer la recherche|" . "\n\t[Espace] pour garder le lien tel qu\'il est|\n\t[q] pour quitter|\n\t[\$] " . "pour prendre en compte l'erreur \t\t(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; # controle de chargement dans des fichiers tencre.log, h_fst.log, encre_pf.log ---| # a effacer quand correct my $f_tencre = "tencre.log"; open FTE, ">$f_tencre" or die "Ouverture impossible de $f_tencre $!"; my $f_h_fst = "h_fst.log"; open FST, ">$f_h_fst" or die "Ouverture impossible de $f_h_fst $!"; my $f_encre_pf = "encre_pf.log"; open FEP, ">$f_encre_pf" or die "Ouverture impossible de $f_encre_pf $!"; my $f_dejavu = "deja_vu.log"; open FDJV, ">$f_dejavu" or die "Ouverture impossible de $f_dejavu $!"; #---------------------------------------------------------------------------ainsi que les lignes #-* foreach (@sav) { chomp; if($_=~ /^\d\)\s-/) { print "$_\n"; $qls++; $i = 0; } elsif($qls == 1) { #$ls_tencre[$i] = $_; next if /^$/; $ls_tencre[$i] = $_; #-*---a saquer quand controle ok print FTE "$i:$_\n"; #-*----------------------------- $i++; } elsif($qls == 2) { #$ls_h_fst[$i] = $_; next if /^$/; $ls_h_fst[$i] = $_; #-*---a saquer quand controle ok print FST "$i:$_\n"; #-*----------------------------- $i++; } elsif($qls == 3) { #$ls_encre_pf[$i] = $_; next if /^$/; $ls_encre_pf[$i] = $_; #-*---a saquer quand controle ok print FEP "$i:$_\n"; #-*----------------------------- $i++; } elsif($qls == 4) { next if /^$/; ($key, $value) = split(/\|/, $_); #-*---a saquer quand controle ok print FDJV "$i:$key _ $value\n"; #-*----------------------------- $hdejavu{$key} = $value; $i++; } else { push @decompture, $_; print "decompage : $_;\n"; } } #-*- a saquer quand controle de chargement éprouvé et correct close FTE || die "Fermeture de tencre.log impossible $!"; close FST || die "Fermeture de tencre.log impossible $!"; close FEP || die "Fermeture de tencre.log impossible $!"; close FDJV || die "Fermeture de tencre.log impossible $!"; #-*-------------------------------------------------------- # 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) { $cmpt = $_; $decompte_total = ($decompte_total + $cmpt); } # 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); ($ext = "") if(undef $ext); $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 = ; # vidage de @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 # trouver le moyen qu'un lien déja passer soit considéré comme bon du moment # qu'il pointe vers le bon fichier, ça raccourciera les reparation utilisateurs # trouver un truc pour les foo#top_ (ça aussi ça use) alain END;