head 1.1; access; symbols; locks alain:1.1; strict; comment @# @; 1.1 date 2010.08.25.03.09.35; author alain; state Exp; branches; next ; desc @- ajustement n° version - purge d'element vide dans uf l1329 - ajustement date dernier enreg $lastrec = $dir$slash$lastrec - changement de l'intitulé des choix utilisateur 6 lignes - fixage du bug mois dans datefinefile $num_mois = ($mois+1) - fixer l'affichage avec la prise en compte de mois et $num_mois et $pmois - fix bug $file sur $fl pour les logs et sorties écran - changement $kefli pour $file qui donne rien dans print écran 6 instances - changement de strategie sur u_full et uf controle ce fait /lnkbrut pas /lnknet - changement de nom uti_full par utilisateur_full et vise-versa - changement dans uf et u_full lnkbrt au lieu de lnkbrut Ecris par Alain Adelmar blabla je fonce au lit il est tard. @ 1.1 log @Initial revision @ text @#!/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:1.0| 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é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-2010) à Pessac 6 rue de Tunis 33600 * #******************************************************************* # $ID$: # - Excellent conçu pour les gros site (>1000 pages) * # version utf8- encore beaucoup de controle. # AAAA-pour Alain Adelmar Alias Asynchrone et Alright- AhAhAhAh! my $script = "ver2l.pl"; my $vers = "1.0"; #$Author: alain $:"Adelmar Alain"; my $moi = 'Adelmar Alain ||'; use strict; use File::Copy; use warnings; use Cwd; my $dir = cwd; print "dir vaut :$dir\n"; use locale; # 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 @@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 my @@lnk_ftp = ""; # liste des liens ftp my @@lnk_http = ""; # liste des liens http my @@ls_encre_pf = ""; # liste des encre précédé d'une diéze # my @@ls_ext = ""; # liste faite d'extention tmp dans CB4f my @@ls_h_fst = ""; # liste du nom des fichiers my @@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 my @@ls_tencre = ""; # liste des liens possible, file#encre, #encre, file (sans doublon) my @@lsfile = ""; # liste du nom des fichiers my @@nwcontenu = ""; # 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 @@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 %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 $b = ""; # 2eme colonne de choix (lien+ numero) my $body = ""; # compteur incrémente @@copim avec $lpp my $cf = 0; # compteur de fichiers golobal my $ch_ext = ""; # var fabriquer avec le %h_rootf fait de $i:$ext my $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 my $d = ""; # premier argument qui doit être le path du repertoire source my $e = ""; # caractere $_ dans reconstruire_ligne my $ef = 0; # compteur erreur adressage my $el = ""; # element d'une liste @@ls _tencre my $email = ""; # mon email 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 $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 $fpointe = ""; # path avant le nom de fichier (racine de path) 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 $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 $key = ""; # key du hash %h_tencre my $kf = 0; # nombre de meta fichier traités my $kk = ""; # var fourre tout pour disocier un lien my $lastrec = ""; # nom du dernier enregistrement my $likef = ""; # represente le fichier file au debut de recup_all_tags (sans path) my $line = ""; # represente la ligne etudier controle_file, chklnk my $linu = ""; # element de @@nwlines ou @@nwcop dans recup_all_tags my $lknet_tmp = ""; # racine de $val ($h_tencre[$foo]) 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 = ""; # represente surement une ligne 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 $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 $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 $repu = ""; # reponse utilisateur a ®arder my $resp = ""; # STDIN pour un choix CB4f my $rl = ""; # var representant un lien dans choix CB4c 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 $sav = ""; # contenu du fichier de sauvegarde 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 $tmp = ""; # path du rep temporaire /newsite/tmp (sans slash) 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 $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 $z = 0; # compteur de fichiers passé à &faitdcopies my $zo = 0; # compteur de file dans %h_fst # pour l'adressage/les systeme UNIX, Linux, cygwin ou autre (/) et ceux de M$ (\)------------- my @@gnul = ( "\\", "\/"); #pas mal because $slash sera toujours bon, je suis trop fort if ($dir =~ /^\//) { $gnus++; } our $slash = $gnul[$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 = "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_.*\d?\.pl/; } @@recv = sort(@@recv); $lastrec = pop @@recv; print "dernier enregistrement connu: $lastrec\n"; #my $flg = "recap_ver2l_" . "$rootd" . ".pl"; my $flg = $lastrec; if (-e $flg) { $mode = 9; print "voulez vous continuer le travail commencer le " . datefinefile($flg, $mode, $format_d) . ": [o,n] (o)\n"; chomp(my $reponse = ); if($reponse =~ /^n/i) { my $tmpflg = "recap_ver2l_$rootd.log"; rename $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; } else { open REC, "$flg" or die "ouverture de $flg impossible $!"; $sav = ; close REC || die "Fermeture de $flg impossible $!"; # poursuite du chargement des variables } } else { &openrec($flg); &premier_passage; } #----------------------------------------------------------------------------------------- #-----ouverture de recap_ver2l (fichier sauvegarde de travail) si inexistant ----------------------- sub openrec { my ($flg)= @@_; $rootfile_file = "recap_ver2l_$rootd"; $hdl_file = "REC"; $o_ext = "pl"; &ouvre_file($rootfile_file, $hdl_file, $o_ext); print REC '#!/usr/bin/perl' . "\n"; print REC "\n" . 'use strict;' . "\n" . 'use warnings;' . "\n"; print REC "\n" . 'our $slash = "' . "$slash" . '";' . "\n"; #close REC || die "fermeture de REC impossible $!"; } #--------------------------------------------------------------------------------------------------- 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; } # 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) $!"; # 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); my @@lssjour = qw( Dim Lun Mar Mer Jeu Ven Sam); my @@lssmois = qw ( Janvier Fevrier Mars Avril Mai Juin Juillet Aout Septembre Octobre Novembre Decembre ); # mettre le format que vous désirez ici my $french_date_now = "$lssjour[$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)= @@_; print "file = $file\nmode = $mode\nformat_d = $format_d\n"; # my (@@tmpdate) = stat($file); # my $datenum = $tmpdate[$mode]; my $datenum = ((stat($file))[$mode]); print "datenum = $datenum\n"; (my $sec,my $min,my $heure,my $mjour,my $mois,my $annee,my $sjour,my $ajour,my $isdst) = localtime($datenum); my @@lssjour = qw( Dim Lun Mar Mer Jeu Ven Sam); my @@lssmois = qw ( Janvier Fevrier Mars Avril Mai Juin Juillet Aout Septembre Octobre Novembre Decembre ); my $pa = ""; if ($mois <= 9) { $mois= "0" . ($mois+1); } if ($mjour <= 9) { $mjour = "0" . "$mjour"; } if ($heure <= 9) { $heure = "0" . "$heure"; } if ($min <= 9) { $min = "0" . "$min"; } if ($sec <= 9) { $sec = "0" . "$sec"; } my $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) . "$mois$mjour-$heure$min$sec"; } elsif ($format_d == 2) { # format differants 2: 31/01/2010-20:30 $fr_date_file = "$mjour\/$mois\/" . ($annee+=1900) . "-$heure:$min"; } elsif ($format_d == 3) { # format differants 2: Di-31/01/2010-20:30:02 $fr_date_file = "$pj-$mjour\/$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 = "$lssjour[$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"; } elsif($d =~ /^$slash/) { my @@pathl = split(/$slash/, $d); my $fpointe = pop @@pathl; $rootd = $fpointe; # a saquer quand ok print "rootd = $rootd\n"; } } #----------------------------------------------------------------------------------------------------- #-------------------------------------ouvre_file ou log ---------------------------------------- géant sub ouvre_file { my ($rootfile_file, $hdl_file, $ext)= @@_; print "dans ouvre_file mon rootfile_file vaut $rootfile_file\n"; my $i = 0; #-----------creation d'un fichier d'enregistrement ---------- if ($rootfile_file =~ /^recap_ver2l_/) { $flg = "$dir$slash$rootfile_file" . "_$rootd.$ext"; while (-e $flg) { $flg = "$dir$slash$rootfile_file" . "_$rootf" . "_$i" . ".$ext"; $i++; } } #------------------------------------------------------------- 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'; my $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 $!"; # initialiser les variables pour la sauvegarde dans rec print REC 'my $newsite = "' . "$newsite" . '";' . "\n"; } else { mkdir $newsite or die "ouverture de $newsite impossible $!"; } $tmp = "$newsite$slash" . "tmp"; mkdir $tmp or die "création de $tmp impossible $!"; $path_tmp = "$tmp$slash"; $path_newsite = "$newsite$slash"; # 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 $!"; } } # initialiser les variables pour la sauvegarde dans rec # print REC 'my $newsite = "$dir$slash" . "newsite_$n";' . "\n"; print REC 'my $tmp = "$newsite$slash" . "tmp";' . "\n"; print REC 'my $path_tmp = "$tmp$slash";' . "\n"; print REC 'my $path_newsite = "$newsite$slash";' . "\n"; # je laisse la place pour s-rep mais ... 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"; $point = ; chomp $point; if($point =~ /^o/i) { push @@ls_other_file, $fichiercible; } } # vérifier si un rep est $srep (donc juste rep_rootname ou plus bas) et le traiter à la place de &faitmoitmp if (-d "$d$slash$file") { $sous_rep = $file; # vérifier si un rep est $srep (donc sous la forme /home/pub/foo/bar)et le 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 "impossibilité 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 "impossibilité de copier $fichiersource sur $fichiercible $!"; } #copy($fichiersource, $fichiercible) or die "impossibilité de copier $fichiersource sur $fichiercible $!"; # exec dos2unix "$d$slash$file"; # voir si ca marche 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 if ($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 @@ls_h_fst, $file) unless ( scalar(grep(/$file/, @@ls_h_fst)) ); (push @@ls_tencre, $file) unless ( scalar(grep(/$file/, @@ls_tencre)) ); @@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 $linu(@@nwlines) { if ($linu =~ //i) { $body = $lpp; # discutable si &cherche_encre pas $tz++ et vice versa &cherche_encre; $tz++; push @@copim, $linu; $lpp++; } else { &cherche_encre; push @@copim, $linu; $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 \ninitialement 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($likef); @@copim = ""; @@nwlines = ""; # detail des encres trouvées par fichiers print VRL "\npour $file $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, $file) unless ( scalar(grep(/$file/, @@ls_h_fst)) ); (push @@ls_tencre, $file) unless ( scalar(grep(/$file/, @@ls_tencre)) ); } } #---passage de la liste contenant tous les liens @@ls_tencre au tableau de hashage %h_tencre # ote les doublons $i = 0; foreach $el (@@ls_tencre) { $tmpo{$el} = $i++; } @@ls_tencre = keys %tmpo; @@ls_tencre = sort(@@ls_tencre); #--recopiage de @@ls_tencre dans rec------------- print REC "\n" . 'our @@ls_tencre = qw(' . "\n"; foreach (@@ls_tencre) { print REC "\t$_\n"; } print REC '};' . "\n\n"; print REC 'foreach (@@ls_tencre) {' . "\n\t" . '$h_tencre{$i_h_tencre} = $_;' . "\n\t" . '$i_h_tencre++;' . "\n\t" . '}' . "\n"; #----------------------------------------------- foreach (@@ls_tencre) { $h_tencre{$i_h_tencre} = $_; $i_h_tencre++; } #--- idem pour les encres seules------------------ @@ls_encre_pf = sort(@@ls_encre_pf); #--recopiage de @@ls_tencre dans rec------------- print REC "\n" . 'our @@ls_encre_pf = qw(' . "\n"; foreach (@@ls_encre_pf) { print REC "\t$_\n"; } print REC '};' . "\n\n"; print REC 'foreach (@@ls_encre_pf) {' . "\n\t" . '$h_tag{$i_h_tag} = $_;' . "\n\t" . '$i_h_tag++;' . "\n\t" . '}' . "\n"; #----------------------------------------------- foreach (@@ls_encre_pf) { $h_tag{$i_h_tag} = $_; $i_h_tag++; } #--- idem pour les fichiers seul-------------------- #--recopiage de @@ls_tencre dans rec------------- print REC "\n" . 'our @@ls_h_fst = qw(' . "\n"; foreach (@@ls_tencre) { print REC "\t$_\n"; } print REC "};\n\n"; print REC 'foreach (@@ls_h_fst) {' . "\n\t" . '$h_fst{$i_h_fst} = $_;' . "\n\t" . '$i_h_fst++;' . "\n\t" . '}' . "\n"; #----------------------------------------------- @@ls_h_fst = sort(@@ls_h_fst); foreach (@@ls_h_fst) { $h_fst{$i_h_fst} = $_; $i_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 (($zo, $ht) = each %h_fst) { ($rootf, $ext)= split(/\./, $ht); print "ooooo ext $ext\n"; $h_rootf{$i,$ext}= $rootf; $i++; print VRL "\t$zo:$ht\n"; } print REC 'while (($zo, $ht) = each %h_fst) {' . "\n\t" . '($rootf, $ext)= split(/\./, $ht);' . "\n\t" . '$h_rootf{"$i:$ext"}= $rootf;' . "\n\t" . '$i++;' . "\n" . '}' . "\n"; print VRL "\n$lx\nh_tag\n"; while (($zo, $htag) = each %h_tag) { print VRL "\t$zo:$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é $!"; close REC || die "double dremmer closure of rec not possibilé $!"; } #--------------------------------------------------------------------------------------------- #--------------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 = 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; } 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++; } 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 { 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++; } #--------------------------------------------------------------------------------- @