#! /usr/bin/perl -w

# La redistribution du code source, modifié ou non, est soumise aux
# conditions suivantes :

# Le copyright ci-dessus, la présente liste de conditions et
# l'avertissement qui la suit doivent figurer dans le code source.

# CE PROGRAMME EST FOURNI « TEL QUEL » ET IL N'EST DONNÉ AUCUNE
# GARANTIE, IMPLICITE OU EXPLICITE, QUANT À SON UTILISATION
# COMMERCIALE, PROFESSIONNELLE OU AUTRE. L'AUTEUR NE PEUT EN AUCUN CAS
# ÊTRE TENU POUR RESPONSABLE DE QUELQUE DOMMAGE OU PRÉJUDICE DIRECT,
# INDIRECT, SECONDAIRE OU ACCESSOIRE (Y COMPRIS LES PERTES FINANCIÈRES
# DUES AU MANQUE À GAGNER, À L'INTERRUPTION D'ACTIVITÉS, OU LA PERTE
# D'INFORMATIONS ET AUTRES) DÉCOULANT DE L'UTILISATION DE PROGRAMME OU
# DE L'IMPOSSIBILITÉ D'UTILISER CELUI-CI, ET DONT L'UTILISATEUR
# ACCEPTE L'ENTIÈRE RESPONSABILITÉ.

use strict;
use XML::Parser;

my $p = new XML::Parser(Style=>'Subs', Pkg=>'SubHandlers', ErrorContext=>2);
$p->setHandlers(Char => \&char);

$p->parsefile(shift);

exit 0;

### Handler pour tout ce qui n'est pas une balise.
sub char {
  my ($p, $donnees) = @_;
 
  if ($donnees eq '<') {
      $donnees = '&lt;';
  } elsif ($donnees eq '>') {
      $donnees = '&gt;'; 
  } 
   
    print "$donnees";
}

### Handlers pour les balises.
package SubHandlers;

my (@types_listes, $titre, $section, $ssection);

sub article {
     my ($p, $balise, %attribs) = @_;
     
     $titre = $attribs{'titre'};
     print "<!DOCTYPE article PUBLIC \"-//OASIS//DTD DocBook V3.1//EN\" []>\n";
     print "<article lang=\"fr\">\n"
}

sub article_ {
    print "</article>";
}

sub tete {
    print "<artheader>\n";
    print "<title>$titre</title>";
}

sub tete_ {
    print "</artheader>\n";
}

sub resume {
    print "<abstract><para>";
}

sub resume_ {
    print "</para></abstract>\n";
}

sub corps {
    $section = 0;
}

sub corps_ {
    print "";
}

sub version {
  print "<releaseinfo>"; 
}

sub version_ {
  print "</releaseinfo>";
}

sub date {
  print "<date>"; 
}

sub date_ {
  print "</date>";
}

sub auteur {
  print "<author><surname>"; 
}

sub auteur_ {
  print "</surname></author>";
}

sub para {
    print "<para>";
}

sub para_ {
    print "</para>";
}

sub section { 
  print "<sect1><title>". $_[3]."</title>"; 
}

sub section_ {
  print "</sect1>";
}

sub subsection { 
  print "<sect2><title>". $_[3]."</title>\n"; 
}

sub subsection_ {
  print "</sect2>";
}
sub tt {
  print "<command>"; 
}

sub tt_ {
  print "</command>";
}

sub em {
    print "<emphasis>";
}

sub em_ {
    print "</emphasis>";
}

sub liste {
    my ($p, $balise, %attribs) = @_;
    my $type_liste = pop @types_listes;
    $attribs{'type'} = 'simple' if (!defined($attribs{'type'}));
    push(@types_listes, $attribs{'type'});
    if ($attribs{'type'} eq 'simple') {
        print "<itemizedlist>";
    } elsif ($attribs{'type'} eq 'enum') {
        print "<orderedlist>";
    }
}


sub liste_ {
    my $type_liste = pop @types_listes;
    print "</itemizedlist>" if ($type_liste eq 'simple');
    print "</orderedlist>" if ($type_liste eq 'enum');
}

sub item {
    print "<listitem><para>";
}

sub item_ {
    print "</para></listitem>";
}

sub verbatim {
    print "<screen><userinput>";
}

sub verbatim_ {
    print "</userinput></screen>";
}

sub url {
    my ($p, $balise, %attribs) = @_;
    print "<ulink url=\"$attribs{'lien'}\">$attribs{'nom'}"; 
}

sub url_ {
    print "</ulink>";
}