#!/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 = '<!--- update pour migration de PUB' . "\nscript:      $0\n&eacute;cris par:  $moi\nle:          $fr_date_file\nexecuter le: $fr_date_now\n ---" . '>';
#----------------------------------------------------

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 = '<!DOCTYPE html PUBLIC "-//w3c//dtd html 4.0 transitional//en">';
my $cool_codage = '<meta http-equiv="Content-Type"  content="text/html; charset=iso-8859-1">';
my $cool_css = '<link rel="stylesheet" type="text/css" href="style.css">';
my $top_ancre = '_top';
my $good_generator = '<meta name="GENERATOR" content="Mozilla/4.75 [fr] (X11; U; Linux 2.2.16-22 i586) [Netscape]">';
my $good_charset = '<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">';

#----------------- 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 = <STDIN>);
      }
    }
    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 =<STDIN>);
}

# -------------  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 = <STDIN>;
  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 = "";
    
    $IsTitre= "";
    $IsCss = 0;
    $IsMenu_mu = 0;
    $IsAncre = 0;

   &controlf;
    # rapport log:
    printf LOG "%10s - %10s \n", $tab_titre[0], $IsTitre;
    printf LOG "%10s - %10s \n", $tab_cheban[0], $etat_cheban;
    printf LOG "%10s - %10s \n", $tab_html[0], $etat_Html;
    printf LOG "%10s - %10s \n", $tab_cheban[0], $etat_Head;
    printf LOG "%10s - %10s \n", $tab_encodage[0], $etat_Encodage;
    printf LOG "%10s - %10s \n", $tab_titre[0], $etat_Titre;
    printf LOG "%10s - %10s \n", $tab_css[0], $etat_Css;
    printf LOG "%10s - %10s \n", $tab_menu_mu[0], $etat_Menu_mu;
    printf LOG "%10s - %10s \n", $tab_ancre[0], $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 = <FIN>;
    close FIN || die "fermeture de $file impossible $!";

    @nwcontenu = "";
    $contenu = "";
    &defragmente_balise(@contenu);
    
    while (<@nwcontenu>) {
	my $baddoctype = '<!' . "doctype";
	if (/^$baddoctype/i) {
	    if (/^<!doctype/) {
		s/doctype/DOCTYPE/;
		push @nwcop, $_;
		$etat_cheban = $tab_cheban[3];
	    }
	    elsif (/^\Q<!DOCTYPE\E/) {
		push @nwcop, $_;
		$etat_cheban = $tab_cheban[1];
	    }
	    else {
		push @nwcop, $_;
		$etat_cheban = $tab_cheban[3];
	    }
	}
	elsif(/^\t?\s{0,2}<html\>/i) {
	    push @nwcop, $_;
	    $etat_Html = $tab_html[1];
	}
	elsif (/\t?\s{0,2}<\/html\>/i) {
	    $etat_Html = $tab_html[3];
	    push @nwcop, $_;
	}
	elsif(/^\t?\s{0,2}<head\>/i) {
	    $etat_Head = $tab_head[1];
	    push @nwcop, $_;
	}
	elsif(/^\t?\s{0,2}<\/head\>/i) {
	    $etat_Head = $tab_head[3];
	    push @nwcop, $_;
	}
	elsif(/^\t?\s{0,2}$good_charset/i) {
	    # bon charset
	    push @nwcop, $_;
	    $etat_Encodage = $tab_encodage[1];
	}
	elsif(/^<meta\shttp-equiv\=\"Content-Type\"\scontent\=\"text\/html\;\scharset\=utf-8\"\>/i) {
	    #s/$_/$good_charset/;
	    # a saquer quand ok
	    print "ici le charset vaut $_\tavant\net";
	    s/charset=utf8/charset=iso-8859-1/;
	    s/charset=utf-8/charset=iso-8859-1/;
	    # a saquer quand ok
	    print "$_\tapres\n";
	    push @nwcop, $_;
	    $etat_Encodage = $tab_encodage[3];
	}
	elsif(/[éèàôêîûçâäïë]/i) {
	    push @nwcop, $_;
	    $etat_Encodage = $tab_encodage[2];
	}
	elsif(/^\t?\s{0,2}<title>(.*)<\/title\>/i) {
	    $IsTitre = $1;
	    # a saquer quand ok
	    print "titre: $IsTitre\n";
	    push @nwcop, $_;
	    $etat_Titre = $tab_titre[1];
	}
	elsif(/^\t?\s{0,2}<link\srel/i) {
	    if(/^\t?\s{0,2}$cool_css/) {
		push @nwcop, $_;
		$etat_Css = $tab_css[1];
		$IsCss++;
	    }
	    else {
		tr/$_/$cool_css/;
		# a saquer quand Ok
		print "je remplasse " . $_ . " par $cool_css\n";
		push @nwcop, $_;
		$etat_Css = $tab_css[3];
		$IsCss++;
	    }
	}
	elsif(/^\t?\s{0,2}<li\><a\sclass/i) {
	    my $shortli = '<li><a class="neolink';
	    my $goodli = '<li class="mu"><a class="neolink"';
	    s/$shortli/$goodli/;
	    push @nwcop, $_;
	    $etat_Menu_mu = $tab_menu_mu[3];
	    $IsMenu_mu++;
	}
	elsif(/^\t?\s{0,2}<li\sclass/i) {
	    push @nwcop, $_;
	    $etat_Menu_mu = $tab_menu_mu[1];
	    $IsMenu_mu++;
	}
	elsif(/^\t?\s{0,2}<a\sname=\".?top.?\"\>/) {
	    if(/^\t?\s{0,2}<a\sname=\"top_\"\>/) {
		s/top_/_top/;
		push @nwcop, $_;
		$etat_Ancre = $tab_ancre[3];
		$IsAncre++;
	    }
	    elsif(/^\t?\s{0,2}<a\sname=\"_top\"\>/) { 
		push @nwcop, $_;
		$etat_Ancre = $tab_ancre[1];
		$IsAncre++;
	    }
	    else {
		push @nwcop, $_;
		$etat_Ancre = $tab_ancre[2];
		$IsAncre++;
	    }
	}
	else {
	    push @nwcop, $_;
	}
    }
    if($IsAncre == 0) {
	$etat_Ancre = $tab_ancre[2];
    }
    if($IsMenu_mu == 0) {
	$etat_Menu_mu = $tab_menu_mu[2];
    }
    if($IsCss == 0) {
	$etat_Css = $tab_css[3];
    }
    if($IsTitre eq "") {
	$etat_Titre = $tab_titre[3];
    }
}


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 $!";




format STDOUT =
@<<<  p/o: @<<<<<<<<  @<<<<<<<<<<<<<<<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$i, $taillef, $fr_date_file, $fichier
@<<<<<<<<<< @<<<<<<<<<<
$tab_titre[0], $IsTitre
@<<<<<<<<<< @<<<<<<<<<<
$tab_cheban[0], $etat_cheban
@<<<<<<<<<< @<<<<<<<<<<
$tab_encodage[0], $etat_Encodage
@<<<<<<<<<< @<<<<<<<<<<
$tab_titre[0], $etat_Titre
@<<<<<<<<<< @<<<<<<<<<<
$tab_css[0], $etat_Css
@<<<<<<<<<< @<<<<<<<<<<
$tab_menu_mu[0], $etat_Menu_mu
@<<<<<<<<<< @<<<<<<<<<<
$tab_ancre[0], $etat_Ancre
.

END;
