Ce script ne fonctionne pas encore
mais il ne va pas tarder. Il sert à passer en revue chaque
feuille HTML d'un site et de rectifier les fautes de code.
Il servira aussi à donner un style au page par un script
style.css et controlera la cronologie du head en rectifiant les
erreurs, en donnant un menu du même genre a toutes les feuilles.
Il remplacera le cas échéant les caractères
accentués par des séquences ascii, il détronquera
aussi les balises tronqué, etc...
En gros il reparrera vos feuille.
Une fois terminé je l'incluerer dans mon ver2l (verificateur de
liens) et il s'activera suivant une ou pluisieurs options, faisant de
mon script ver2l un super
logiciel pouvant reparrer les liens mes aussi le code et le style des
page que vous vous apprété à publier... Enorme
n'est il pas?
Script (il
ne fonctionne pas bien encore)
#!/usr/bin/perl -w # remd: migr_pub.pl est un script pour faire migrer mes fichiers de publication # vers une nouvelle présentation et surtout avec de nouvelle régles de pub. # En gros ce script effectue des controle puis des actions au niveau de chaque # ligne de chaque fichier d'un répertoire entrer en premier argument. # le log des modif est a entrer en 2eme argument. # usage: migr_pub.pl /home/commun/net/miroir log2pub.log # il créera un repertoire ./newpub avec les fichiers modifiés # # Il devrai y avoir un autre fichier cible prenant en compte # le détronquage qui fonctionne parfaitement. # usage: migr_la_pub.pl [repertoire] [log2pub] # V:1.0 vendredi 10 sept 2009 Pessac 33600 # - Alain Adelmar alias asynchrone - # $ID:
use strict; use warnings;
# initialisation tableau rapport constant my @retourne = qw (Glop Pasglop Fixed); my @tab_cheban = qw(Cheban Ok Incorrect Fixed); my @tab_html = qw(Html Ok Incorrect In-Out-ok); my @tab_head = qw(Head Ok Incorrect In-Out-ok); my @tab_encodage = qw(Encodage Latin1 a-encoder A_convertir); my @tab_titre = qw(Titre Ok Incorrect Absent); my @tab_css = qw(Css Ok Incorrect Absent); my @tab_menu_mu = qw(Menu_mu Ok Incorrect Absent); my @tab_ancre = qw(Ancre_top Ok Incorrect Absent);
my $IsCheban = 0; my $IsHtml = 0; my $IsHead = 0; my $IsCodage= 0; my $IsTitre= ""; my $IsCss = 0; my $IsMenu_mu = 0; my $IsAncre = 0; my $adresse = 'aadelmar@numericable.fr';
my $etat_cheban = my $etat_Encodage = my $etat_Titre = my $etat_Html = ""; my $etat_Head = my $etat_Css = my $etat_Menu_mu = my $etat_Ancre = ""; sub controlf;
# utilisation de la date/heure pour maitenant et pour file X use DateFrench; our $format_affichage = 2; our $opt_date_file = 2; our $fr_date_now = maintenant("$format_affichage"); print "$fr_date_now\n";
#------------------------------cartouche -------------- my $lx = ("*" x 25) x 2; my $file = $0; our $fr_date_file = datefichier($format_affichage, $opt_date_file, $file); my $moi = " Adelmar alain (aadelmar\@numericable.fr)"; my $head_lbl= "script $0\nécris par $moi\nle $fr_date_file\nexecuter le $fr_date_now\n"; my $head_lbl_console = "$lx\nscript: $0\nécris par: $moi\nle: $fr_date_file\nexecuter le: $fr_date_now\n$lx\n"; my $head_lbl_comment = ''; #----------------------------------------------------
use Cwd; my $dir= cwd;
#initialisation des var pour que strict passe my $argv = my $o = my $foc = my $fout = my $resp = my $fichier = my $ligne = my $taillef = my $reg = my $rep = ""; my $l = my $k = my $j = my $contenu = my $tout = ""; my $rootfile = "log2pub.log"; my @ligne = my @contenu = my @nwcontenu = my @tmpstat = my @files = my @nwcopim = my @copim = my @lsrepw = my @nl = my @nwcop = ""; my $u = my $i = my $e = my $ouvert = my $tronquage = 0;
#initialisation des var de traitement my $cool_sheban = ''; my $cool_codage = ''; my $cool_css = ''; my $top_ancre = '_top'; my $good_generator = ''; my $good_charset = '';
#----------------- sortie formatée pour l'affichage fichiers/sorti --------- format STDOUT_TOP = Page @<< $%
n taille date fichier === ========= ===================== ================================================================ .
# traitement argument - fichier a traiter et verif validité if (@ARGV) { if ($ARGV[0] =~ /^-/) { $ARGV[0] =~ s/-()/($1)/; ($argv = $ARGV[0]); # assigne $argv # ($argv = "b") if ($ARGV[0]=~ /^b/); # pour b pour binaire # ($argv = "u") if ($ARGV[0]=~ /^u/); # pour u # ($argv = "l") if ($ARGV[0]=~ /^l/); # pour latin1 => utf8 # ($argv = "o") if ($ARGV[0]=~ /^o/); # pour output (c.a.d: fichier differant) if($argv=~ /o/) { if ($ARGV[2] ne "") { $fout = $ARGV[2]; my $rep = $ARGV[1]; print "rep vaut $rep (source)\nfout vaut $fout (cible)\net est considerer comme argv2\n"; } else { print "si vous prennez l option -o il faut indiquer le fichier cible\npar defaut sorti_" . $ARGV[1] . "\n"; print "usage: $0 [-opt] [rep_source] ([log] pour option -o)\n"; chomp($fout = ); } } if ($ARGV[1] ne "") { $rep = $ARGV[1]; } } else { $rep = $ARGV[0]; } } else { print "$lx\nusage: migr_la_pub.pl [-opt] [rep_a_traiter] [log2_sortie]\n(made by $moi)\n"; #---------demander quel fichier traiter et verifier si il existe print "$lx\n"; print "Indiquez le fichier a traiter:\n"; chomp($rep =); }
# ------------- machine, system et path my $gnus = 0; my @gnul = ("\\", "\/"); if ($ENV{"PATH"}=~ /^\//) { $gnus++; print "this is a real gnu OS, congratulation\n"; } my $gnup = $gnul["$gnus"];
# création d'un repertoire cible my $newdir = "$dir$gnup" . "newpub"; &valid_newdir($newdir);
# création d'un fichier de sortie-------------- if ($argv =~ /o/) { unless ($fout =~ /\/|\\/) { print "pas de path relatif, soit complet soit juste nom_de_fichier.ext\n"; ($fout= "$dir$gnup". "$fout"); print "votre fichier de sortie sera: $fout\n"; (&logout) if (-f $fout); } print "désirez vous avoir $fout comme fichier cible?"; my $resp = ; if($resp=~ /^n/i) { $fout = "$rootfile"; } } else { $fout = "$dir$gnup" . "sortie_" . "$rootfile"; &logout; }
open LOG, ">$fout" or die "Ouverture de $fout impossible $!"; print LOG "$head_lbl_console\n";
#-------------------------ici on traite le rep ---
if (-d $rep) { opendir REP, "$rep" or die "Ouverture de $rep impossible $!"; @files = (sort readdir REP); closedir REP || die "Fermeture de $rep impossible $!";
foreach $fichier(@files) { chomp $fichier; $i++; next unless ($fichier =~ /\.{1}s?h?x?t?m{1}l?$/i); $file = "$rep$gnup" . $fichier; $foc = "$newdir$gnup" . "$fichier"; # FC est le fichier source ($foc) open FC, ">$foc" or die "Ouverture de $foc impossible $!"; print FC "$head_lbl_comment\n"; @tmpstat = stat($file); $taillef= $tmpstat[7]; $format_affichage = 22; $fr_date_file = datefichier($format_affichage, $opt_date_file, $file); printf LOG "%7doctets - %15s - %-40s\n", $taillef, $fr_date_file, $file;
#remise à zero des variable de rapport de fichier $etat_cheban = ""; $etat_Html = ""; $etat_Head = ""; $etat_Encodage = ""; $etat_Titre = ""; $etat_Css = ""; $etat_Menu_mu = ""; $etat_Ancre = "";
write; print FC "@nwcop"; print FC " $head_lbl_comment\n"; #delete @nwcontenu[0 .. $#nwcontenu]; @nwcontenu = (); @nwcop = ""; # push @nwcontenu, $reg; close FC || die "Impossible de fermer ce con de fichier $foc $!"; } }
#print LOG @nwcontenu; close LOG || die "Fermeture de $fout impossible $!";
sub logout { while (-f $fout) { $u++; $fout = "$dir$gnup" . "sortie_" . $u . "_$rootfile"; } }
sub controlf() {
open FIN, "$file" or die "ouverture de $file impossible $!"; # print "newdir vaut $newdir et foc vaut $foc\n"; @contenu = ; close FIN || die "fermeture de $file impossible $!";
sub valid_newdir { # création d'un rep de sortie ./newdir $u = 0; $newdir = "$dir" . "$gnup" . "newpub"; while (-d $newdir) { $u++; $newdir = "$dir$gnup" . "newpub_$u"; } mkdir $newdir || die "impossible de creer $newdir $!"; }
#-------------------------------------------
sub defragmente_balise(@) {
# on split tout ca a plat $tout = "@contenu"; @copim = split(//, $tout);
# balise $ouvert = 1 ==> vrai; 0 ==> faux $ouvert = 0; foreach $e(@copim) { 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 @nwcopim et réinitialise @ligne push @ligne, $e; push @nwcopim, @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; } 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 $_, $tronquage et ouvert push @ligne, "$e\n"; push @nwcopim, @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; } } } # donc soit $contenu soit @nwcontenu fonctionne à merveille $contenu = join('', @nwcopim); @nwcontenu = $contenu; }
#print FO @nwcontenu; #close FO || die "fermeture merdeuse $!";
