#!/usr/bin/perl -w
# remd: rebalise_html.pl est un script qui reparre les balises tronquées
# le nom du fichier peut etre entrer en argument et le nom de sorti aussi
# usage: reforme-html.pl [-os] [nom_de_source] [nom_de_cible]
# (voir doc pod en fin de script)   
# ou  rebalise_html.pl nom_de_source
# écrit par: Alain Adelmar le 16 sept 2009 à Pessac
# aadelmar@numericable.fr
# il fonctionne parfaitement et je lui ai ajouter un ctrl au 40éme caractère
# pour fermer la ligne avant d'ouvrir une autre balise. A ce regler comme on 
# veux ligne 155 -
# $ID:

use strict;
use warnings;
# 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";

use Cwd;
my $dir= cwd;

my $lx = "x" x 20;
my $argv = my $f = my $fout = my $resp = my $rootfile = my $e = my $tout = my $contenu = my $l = "";
my @contenu  = my @copim = my @pathf = my @ligne = my @nwcopim = my @nwcontenu = ();
my $u = my $ouvert = my $tronquage = my $resetline = 0;
my $moi = "alain Adelmar";
my $recap_lbl= "$0 écris par $moi \nle 21 Avril 2008\nexecuter $fr_date_now\n";


# 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];
	    $f = $ARGV[1];
	    &veriff;
	    print "f vaut $f (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 [-blo] [nom_de_la_source] ([nom_de_la_cible] pour option -o)\n";
            chomp($fout = <STDIN>);   
        }
    }
    if ($ARGV[1] ne "") {
      $f = $ARGV[1];
      &veriff;
    }
  }
  else {
    $f = $ARGV[0];
    &veriff;
  }
}
else {
  print "$lx\nusage: reforme_html.pl [fichier_a_traiter] \n$recap_lbl\n";
  #---------demander quel fichier traiter et verifier si il existe
  print "$lx\n";
  print "Indiquez le fichier a traiter:\n";
  chomp($f =<STDIN>);
  &veriff;
}


# création d'un fichier de sortie--------------
if ($argv =~ /o/) {
    ($fout= "$dir/$fout") if(!($fout =~ /\/|\\/));
    print "désirez vous avoir $fout comme fichier cible?";
    my $resp = <STDIN>;
    if($resp=~ /^n/i) {
        print "veuillez recommencer tout en indiquant le nom_du_fichier_cible ou path_et_le_nom_du_fichier_cible\n";
    }
}
else {
 $fout = "sortu_" . "$rootfile";
}


# ouverture du fichier en lecture seule
open F, "$f" or die "ouverture de $f impossible $!";
if ($argv =~ /b/) {
    binmode F;
}
@contenu = <F>;
close F || die "Fermeture de $f impossible $!";

#----------------------------ici c'est bien -------------------

&reconstruire_ligne;

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

# si le fichier de sortie est toujours vide, lui donner un nom
if($fout eq "") {
  $fout = "sorti_$rootfile.html";
}
&logout;
open FOUT, ">$fout" or die "Ouverture de $fout impossible $!";

# si le fichier source n'a pas de balises tronqué ne rien faire
if ($corompu >= 1) {
    print FOUT @nwcontenu;
}
else {
    print "$recap_lbl\nfichier sain pas de balises tronquees, rien a faire\n";
}
close FOUT || die "Fermeture de $fout impossible $!";

if ($argv=~ /l/) {
    # system("iconv -f latin1 -t utf8 $fout");
}


sub veriff {
  if ($f !~ /\/|\\/) {
    $rootfile = $f;
    $f = "$dir\/$f";
  }
  else {
    $rootfile = $f;
    @pathf = split("\/", $rootfile);
    $rootfile = pop @pathf;
  }
  while (!(-f $f)) {
    print "Veuillez entrer un nom de fichier, et son path si ailleur que dans le $dir:\n";
    chomp ($f = <STDIN>);
  }
}

sub logout { 
  $u= 0;
  while (-f $fout) {
    $u++;
    $fout = "$dir\/sorti_" . $u . "_$rootfile";
  }
}

sub reconstruire_ligne {
  
# 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) {
      if($e eq "<") {
	# signale qu'une balise est ouverte si elle ce trouve au dela du 40eme caractere
	# ferme la @ligne et réinitialise puis pousse dans @ligne
	if($resetline >= 40) {
	  push @ligne, "\n";
	  push @nwcopim, @ligne;
	  @ligne = "";
	  push @ligne, $e;
	  # remise à zero + 1
	  $resetline = 1;
	  }
	else {
	  # signale qu'une balise est ouverte et pousse la ligne
	  push @ligne, $e;
	  $resetline++;
	  }
	$ouvert = 1;
      }
      elsif ($e eq "\n") {
	# pousse \n dans @ligne puis @ligne dans @nwcopim et réinitialise @ligne
	push @ligne, $e;
	push @nwcopim, @ligne;
	@ligne ="";
	$resetline = 0;
      }
      else {
	# pousse le caractère dans la ligne
	push @ligne, $e;
	$resetline++;
      }
    }
    # un balise à été ouverte donc passage en ouvert
    else {
      $resetline++;
      if ($e eq "\n") {
	# balise tronquées 
	$tronquage = 1;
	# marque de l'utilité de ce script
	$corompu++;
      }
      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";
	  push @nwcopim, @ligne;
	  $resetline = 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;
}

END;

=pod

    =encoding utf8
    
    =head1 NOM

    reforme-html.pl - Reconstruit les balises HTML tronquees.

    =head1 SYNOPSIS

    C<reforme-html.pl [fichier]>
    
    C<reforme-html.pl [-mos] [fichier_source] [fichier_cible]>
    # ou pour un repertoire entier
    C<reforme-html.pl [-mos] [repertoire] [fichier_cible]>

    =head1 DESCRIPTION
    
    Ce script detronque les balises B<html> dans un meta fichier ou dans tout les
    meta fichier d'un repertoire. Il ne modifiera pas le codage de cette page,
    il completera la balise tronquee  sur la  meme ligne si celle si n'est pas 
    trop longue. J'ai fixe a 40 la limite max pour completer une balise sur la
    même ligne, ce chiffre est modifiable ligne     sinon il deplacera la dite
    balise sur la ligne suivante.

    =head2 FICHIER DE SORTIE

    Le script genere par defaut un fichier de sortie appele du même nom que le
    fichier a modifier seulement il sera precede du prefixe sortie_ ,  c'est a
    dire "monfichier" sortira dans le repertoire courant  balise  correctement 
    sous le nom de "sorti_monfichier".  Avec l'option -o vous pouvez vous même
    definir le nom du fichier_cible. Avec l'option -m (move) le fichier traite
    gardera le même nom et remplacera le fichier source.

    =head2 FICHIER OU REPERTOIRE
    
    Si vous entrez un nom de repertoire a la place d'un nom de fichier, le rep
    sera traite et tout les meta-fichiers seront traites (xml,html,htm,sgml).
    
    Il ne modifie en rien les fichiers ne contenant pas de balises tronque.

    =head1 OPTIONS
    
         -B<m> (I<move>) remplace le fichier traite par le fichier repare.

         -B<o> (I<output>) laisse l'utilisateur definir le nom de la sortie.

         -B<s> (I<silencieux>) aucun print. Retourne 0 si tout est ok, ceci pour
            pouvoir être lancer depuis un script.

    =head1 VALEUR RETOURNÉE

    Retourne 0 si tout est ok

    =head AUTEUR
    
    Adelmar Alain 
    6 rue de Tunis, 33600 Pessac
    email: L<aadelmar@numericable.fr>
    pages: L<http://perso.numericable.fr/aadelmar>

    =cut
    
