#!/usr/bin/perl -w

# Po4a::Sgml.pm
#
# extract and translate translatable strings from an sgml based document.
#
# This code is an adapted version of sgmlspl (SGML postprocessor for the
#   SGMLS and NSGMLS parsers) which was:
#
# Copyright (c) 1995 by David Megginson <dmeggins@aix1.uottawa.ca>
#
# The adaptation for po4a was done by Denis Barbier <barbier@linuxfr.org>,
# Martin Quinson (mquinson#debian.org) and others.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
#
########################################################################

=head1 NAME

Locale::Po4a::Sgml - Convert sgml documents from/to PO files

=head1 DESCRIPTION

The po4a (po for anything) project goal is to ease translations (and more
interestingly, the maintenance of translations) using gettext tools on
areas where they were not expected like documentation.

Locale::Po4a::Sgml is a module to help the translation of documentation in
the SGML format into other [human] languages.

This module uses B<nsgmls> to parse the SGML files. Make sure it is
installed.
Also make sure that the DTD of the SGML files are installed in the system.

=head1 OPTIONS ACCEPTED BY THIS MODULE

=over 4

=item debug

Space separated list of keywords indicating which part you want to debug. Possible values are: tag, generic, entities and refs.

=item verbose

Give more information about what's going on.

=item translate

Space separated list of extra tags (beside the dtd provided ones) whose
content should form an extra msgid.

=item section

Space separated list of extra tags (beside the dtd provided ones)
containing other tags, some of them being of category 'translate'.

=item indent

Space separated list of tags which increase the indentation level.

=item verbatim

The layout within those tags should not be changed. The paragraph won't get
wrapped, and no extra indentation space or new line will be added for
cosmetic purpose.

=item empty

Tags not needing to be closed.

=item ignore

Tags ignored and considered as plain char data by po4a. That is to say that
they can be part of an msgid. For example, E<lt>bE<gt> is a good candidate
for this category since putting it in the translate section would create
msgids not being whole sentences, which is bad.

=item attributes

A space separated list of attributes that need to be translated. You can
specify the attributes by their name (for example, "lang"), but you can also
prefix it with a tag hierarchy, to specify that this attribute will only be
translated when it is into the specified tag. For example:
E<lt>bbbE<gt>E<lt>aaaE<gt>lang specifies that the lang attribute will only be
translated if it is in an E<lt>aaaE<gt> tag, which is in a E<lt>bbbE<gt> tag.
The tag names are actually regular expressions so you can also write things
like E<lt>aaa|bbbbE<gt>lang to only translate lang attributes that are in
an E<lt>aaaE<gt> or a E<lt>bbbE<gt> tag.

=item qualify

A space separated list of attributes for which the translation must be
qualified by the attribute name. Note that this setting automatically adds the
given attribute into the 'attributes' list too.

=item force

Proceed even if the DTD is unknown or if nsgmls finds errors in the input
file.

=item include-all

By default, msgids containing only one entity (like '&version;') are skipped
for the translator comfort. Activating this option prevents this
optimisation. It can be useful if the document contains a construction like
"<title>&Aacute;</title>", even if I doubt such things to ever happen...

=item ignore-inclusion

Space separated list of entities that won't be inlined.
Use this option with caution: it may cause nsgmls (used internally) to add
tags and render the output document invalid.

=back

=head1 STATUS OF THIS MODULE

The result is perfect. I.e., the generated documents are exactly the
same. But there are still some problems:

=over 2

=item *

the error output of nsgmls is redirected to /dev/null, which is clearly
bad. I don't know how to avoid that.

The problem is that I have to "protect" the conditional inclusions (ie, the
C<E<lt>! [ %foo [> and C<]]E<gt>> stuff) from nsgmls. Otherwise
nsgmls eats them, and I don't know how to restore them in the final
document. To prevent that, I rewrite them to C<{PO4A-beg-foo}> and
C<{PO4A-end}>.

The problem with this is that the C<{PO4A-end}> and such I add are valid in
the document (not in a E<lt>pE<gt> tag or so).

Everything works well with nsgmls's output redirected that way, but it will
prevent us from detecting that the document is badly formatted.

=item *

It does work only with the debiandoc and docbook dtd. Adding support for a
new dtd should be very easy. The mechanism is the same for every dtd, you just
have to give a list of the existing tags and some of their characteristics.

I agree, this needs some more documentation, but it is still considered as
beta, and I hate to document stuff which may/will change.

=item *

Warning, support for dtds is quite experimental. I did not read any
reference manual to find the definition of every tag. I did add tag
definition to the module 'till it works for some documents I found on the
net. If your document use more tags than mine, it won't work. But as I said
above, fixing that should be quite easy.

I did test docbook against the SAG (System Administrator Guide) only, but
this document is quite big, and should use most of the docbook
specificities.

For debiandoc, I tested some of the manuals from the DDP, but not all yet.

=item *

In case of file inclusion, string reference of messages in po files (ie,
lines like C<#: en/titletoc.sgml:9460>) will be wrong.

This is because I preprocess the file to protect the conditional inclusion
(ie, the C<E<lt>! [ %foo [> and C<]]E<gt>> stuff) and some entities (like
&version;) from nsgmls because I want them verbatim to the generated
document. For that, I make a temp copy of the input file and do all the
changes I want to this before passing it to nsgmls for parsing.

So that it works, I replace the entities asking for a file inclusion by the
content of the given file (so that I can protect what needs to in subfile
also). But nothing is done so far to correct the references (i.e., filename
and line number) afterward. I'm not sure what the best thing to do is.

=back

=cut

package Locale::Po4a::Sgml;

use 5.006;
use strict;
use warnings;


require Exporter;
use vars qw(@ISA @EXPORT);
@ISA = qw(Locale::Po4a::TransTractor);
@EXPORT = qw();

use Locale::Po4a::TransTractor;
use Locale::Po4a::Common;

eval qq{use SGMLS};
if ($@) {
  die wrap_mod("po4a::sgml", dgettext("po4a","The needed module SGMLS.pm was not found and needs to be installed. It can be found on the CPAN, in package libsgmls-perl on debian, etc."));
}

use File::Temp;

my %debug=('tag'      => 0,
	   'generic'  => 0,
	   'entities' => 0,
	   'refs'     => 0,
	   'nsgmls'   => 0);

my $xmlprolog = undef; # the '<?xml ... ?>' line if existing

sub initialize {
    my $self = shift;
    my %options = @_;

    $self->{options}{'translate'}='';
    $self->{options}{'section'}='';
    $self->{options}{'indent'}='';
    $self->{options}{'empty'}='';
    $self->{options}{'verbatim'}='';
    $self->{options}{'ignore'}='';
    $self->{options}{'ignore-inclusion'}='';

    $self->{options}{'include-all'}='';

    $self->{options}{'force'}='';

    $self->{options}{'verbose'}='';
    $self->{options}{'debug'}='';

    foreach my $opt (keys %options) {
	if ($options{$opt}) {
	    die wrap_mod("po4a::sgml", dgettext ("po4a", "Unknown option: %s"), $opt) unless exists $self->{options}{$opt};
	    $self->{options}{$opt} = $options{$opt};
	}
    }
    if ($options{'debug'}) {
	foreach (split /\s+/, $options{'debug'}) {
	    $debug{$_} = 1;
	}
    }
}

sub read {
    my ($self,$filename)=@_;

    push @{$self->{DOCPOD}{infile}}, $filename;
    $self->Locale::Po4a::TransTractor::read($filename);
}

sub parse {
    my $self=shift;
    map {$self->parse_file($_)} @{$self->{DOCPOD}{infile}};
}

#
# Filter out some uninteresting strings for translation
#
sub translate {
    my ($self)=(shift);
    my ($string,$ref,$type)=(shift,shift,shift);
    my (%options)=@_;

    # don't translate entries composed of one entity
    if ( (($string =~ /^&[^;]*;$/) || ($options{'wrap'} && $string =~ /^\s*&[^;]*;\s*$/))
	 && !($self->{options}{'include-all'}) ){
	warn wrap_mod("po4a::sgml", dgettext("po4a", "msgid skipped to help translators (contains only an entity)"), $string)
	    unless $self->verbose() <= 0;
	return $string.($options{'wrap'}?"\n":"");
    }
    # don't translate entries composed of tags only
    if ( $string =~ /^(((<[^>]*>)|\s)*)$/
	 && !($self->{options}{'include-all'}) ) {
	warn wrap_mod("po4a::sgml", dgettext("po4a", "msgid skipped to help translators (contains only tags)"), $string)
	       unless $self->verbose() <= 0;
	return $string.($options{'wrap'}?"\n":"");
    }

    # don't translate entries composed of marked section tags only
    if (   ($string =~ /^(?:<!\s*\[\s*[^\[]+\s*\[|\]\s*]\s*>|\s)*$/)
        && !($self->{options}{'include-all'})) {
        warn wrap_mod("po4a::sgml", dgettext("po4a", "msgid skipped to ".
                      "help translators (contains only opening or closing ".
                      "tags of marked sections)"), $string)
               unless $self->verbose() <= 0;
        return $string.($options{'wrap'}?"\n":"");
    }

    $string = $self->SUPER::translate($string,$ref,$type,%options);

    $string = $self->post_trans($string,$ref,$type);

    return $string;
}

sub post_trans {
    my ($self,$str,$ref,$type)=@_;

    # Change ascii non-breaking space to an &nbsp;
    my $nbs_out = "\xA0";
    my $enc_length = Encode::from_to($nbs_out, "latin1",
                                               $self->get_out_charset);
    $str =~ s/\Q$nbs_out/&nbsp;/g if defined $enc_length;

    return $str;
}

#
# Make sure our cruft is removed from the file
#
sub pushline {
    my ($self,$line)=@_;
    $line =~ s/{PO4A-amp}/&/g;
    $self->SUPER::pushline($line);
}

sub set_tags_kind {
    my $self=shift;
    my (%kinds)=@_;

    foreach (qw(translate empty section verbatim ignore attributes qualify)) {
	$self->{SGML}->{k}{$_} = $self->{options}{$_} ? $self->{options}{$_}.' ' : '';
        # Remove the default behavior for the tags defined with the
        # options.
        foreach my $k (keys %kinds) {
            foreach my $t (split(" ", $self->{SGML}->{k}{$_})) {
                $kinds{$k} =~ s/\b$t\b//;
            }
        }
    }

    foreach (keys %kinds) {
	die "po4a::sgml: internal error: set_tags_kind called with unrecognized arg $_"
	    if ($_ !~ /^(translate|empty|verbatim|ignore|indent|attributes|qualify)$/);

	$self->{SGML}->{k}{$_} .= $kinds{$_};
    }
}

#
# Do the actual work, using the SGMLS package and settings done elsewhere.
#
sub parse_file {
    my ($self,$mastername)=@_;
    my ($prolog);

    # Rewrite the file to:
    #   - protect optional inclusion marker (ie, "<![ %str [" and "]]>")
    #   - protect entities from expansion (ie "&release;")
    my $origfile="";
    my $i=0;
    while ($i < @{$self->{TT}{doc_in}}) {
        $origfile .= ${$self->{TT}{doc_in}}[$i];
        $i+=2;
    }
    unless ($self->{options}{'force'}) {
    # Detect if we can find the DTD
    open (VALID, "| nsgmls -p")
        or die wrap_mod("po4a::sgml",
                        dgettext("po4a", "Can't run nsgmls -p: %s"), $!);
    print VALID $origfile;
    close VALID
        or die wrap_mod("po4a::sgml",
                        dgettext("po4a", "Error while running nsgmls -p.  ".
                                         "Please check if nsgmls and the ".
                                         "DTD are installed."));
    }
    # Detect the XML pre-prolog
    if ($origfile =~ s/^(\s*<\?xml[^?]*\?>)//) {
	warn wrap_mod("po4a::sgml", dgettext("po4a",
		"Trying to handle a XML document as a SGML one. ".
		"Feel lucky if it works, help us implementing a proper XML backend if it does not."), $mastername)
	  unless $self->verbose() <= 0;
	$xmlprolog=$1;
    }
    # Get the prolog
    {
	$prolog=$origfile;
	my $lvl;    # number of '<' seen without matching '>'
	my $pos = 0;  # where in the document (in chars) while detecting prolog boundaries

	unless ($prolog =~ s/^(.*<!DOCTYPE).*$/$1/is) {
	    die wrap_mod("po4a::sgml", dgettext("po4a",
		"This file is not a master SGML document (no DOCTYPE). ".
		"It may be a file to be included by another one, in which case it should not be passed to po4a directly. Text from included files is extracted/translated when handling the master file including them."));
	}
	$pos += length($prolog);
	$lvl=1;
	while ($lvl != 0) {
	    # Eat comments in the prolog, since there may be some '>' or '<' in them.
	    if ($origfile =~ m/^.{$pos}?(<!--.*?-->)/s) {
		print "Found a comment in the prolog: $1\n" if ($debug{'generic'});
		$pos += length($1);
		# take care of the line numbers
		my @a = split(/\n/,$1);
		shift @a; # nb line - 1
		while (defined(shift @a)) {
		    $prolog .= "\n";
		}
		next;
	    }
	    # Search the closing '>'
	    my ($c)=substr($origfile,$pos,1);
	    $lvl++ if ($c eq '<');
	    $lvl-- if ($c eq '>');
	    $prolog = "$prolog$c";
	    $pos++;
	}
    }

    # Add the definition of new tags that will be used for the
    # conditionnal inclusions
    if ($origfile =~ /^.*<!DOCTYPE[^[>]*\[/is) {
        $origfile =~ s/^(.*<!DOCTYPE[^[>]*\[)/$1 <!ELEMENT PO4ABEG - o empty> <!ATTLIST PO4ABEG name CDATA #REQUIRED> <!ELEMENT PO4AEND - o empty>/is;
    }

    print STDERR "PROLOG=$prolog\n------------\n" if ($debug{'generic'});

    # Configure the tags for this dtd
    if ($prolog =~ /debiandoc/i) {
	$self->set_tags_kind("translate" => "author version abstract title".
			                    "date copyrightsummary heading p ".
			                    "example tag title",
			     "empty"     => "date ref manref url toc",
			     "verbatim"  => "example",
			     "ignore"    => "package prgn file tt em var ".
					    "name email footnote po4aend po4abeg ".
			                    "strong ftpsite ftppath qref",
			     "indent"    => "appendix ".
	                                    "book ".
	                                    "chapt copyright ".
			                    "debiandoc ".
			                    "enumlist ".
			                    "item ".
			                    "list ".
	                                    "sect sect1 sect2 sect3 sect4 ".
			                    "tag taglist titlepag toc");

    } elsif ($prolog =~ /docbook/i) {
	$self->set_tags_kind("translate" => "abbrev acronym artheader attribution ".
	                                    "date ".
	                                    "edition editor entry ".
	                                    "figure ".
	                                    "glosssee glossseealso glossterm ".
	                                    "holder ".
	                                    "member msgaud msglevel msgorig ".
	                                    "orgname othername ".
	                                    "para phrase pubdate publishername primary ".
	                                    "refclass refdescriptor refentrytitle refmiscinfo refname refpurpose releaseinfo remark revnumber revremark ".
	                                    "screeninfo seg secondary segtitle simpara subtitle synopfragmentref synopsis ".
	                                    "term tertiary title titleabbrev ".
	                                    "contrib epigraph",
	                     "empty"     => "audiodata colspec graphic imagedata textdata sbr videodata xref",
	                     "indent"    => "abstract answer appendix article articleinfo audioobject author authorgroup ".
	                                    "bibliodiv bibliography blockquote blockinfo book bookinfo bridgehead ".
	                                    "callout calloutlist caption caution chapter copyright ".
	                                    "dedication docinfo ".
	                                    "entry ".
	                                    "formalpara ".
	                                    "glossary glossdef glossdiv glossentry glosslist group ".
	                                    "imageobject important index indexterm informaltable itemizedlist ".
	                                    "keyword keywordset ".
	                                    "legalnotice listitem lot ".
	                                    "mediaobject msg msgentry msginfo msgexplan msgmain msgrel msgsub msgtext ".
	                                    "note ".
	                                    "objectinfo orderedlist ".
	                                    "part partintro preface procedure publisher ".
	                                    "qandadiv qandaentry qandaset question ".
	                                    "reference refentry refentryinfo refmeta refnamediv refsect1 refsect1info refsect2 refsect2info refsect3 refsect3info refsection refsectioninfo refsynopsisdiv refsynopsisdivinfo revision revdescription row ".
	                                    "screenshot sect1 sect1info sect2 sect2info sect3 sect3info sect4 sect4info sect5 sect5info section sectioninfo seglistitem segmentedlist set setindex setinfo shortcut simplelist simplemsgentry simplesect step synopfragment ".
	                                    "table tbody textobject tgroup thead tip toc ".
	                                    "variablelist varlistentry videoobject ".
	                                    "warning",
	                     "verbatim"  => "address cmdsynopsis holder literallayout programlisting ".
	                                    "refentrytitle refname refpurpose screen term title",
	                     "ignore"    => "action affiliation anchor application arg author authorinitials ".
	                                    "command citation citerefentry citetitle classname co computeroutput constant corpauthor ".
	                                    "database po4abeg po4aend ".
	                                    "email emphasis envar errorcode errorname errortext errortype exceptionname ".
	                                    "filename firstname firstterm footnote footnoteref foreignphrase function ".
	                                    "glossterm guibutton guiicon guilabel guimenu guimenuitem guisubmenu ".
	                                    "hardware ".
	                                    "indexterm informalexample inlineequation inlinegraphic inlinemediaobject interface interfacename ".
	                                    "keycap keycode keycombo keysym ".
	                                    "link literal ".
	                                    "manvolnum markup medialabel menuchoice methodname modespec mousebutton ".
	                                    "nonterminal ".
	                                    "olink ooclass ooexception oointerface option optional othercredit ".
	                                    "parameter personname phrase productname productnumber prompt property ".
	                                    "quote ".
	                                    "remark replaceable returnvalue revhistory ".
	                                    "sgmltag sidebar structfield structname subscript superscript surname symbol systemitem ".
	                                    "token trademark type ".
	                                    "ulink userinput ".
	                                    "varname ".
	                                    "wordasword ".
	                                    "xref ".
	                                    "year",
	                     "attributes" =>"<(article|book)>lang");

    } else {
	if ($self->{options}{'force'}) {
	    warn wrap_mod("po4a::sgml", dgettext("po4a", "DTD of this file is unknown, but proceeding as requested."));
	    $self->set_tags_kind();
	} else {
	    die wrap_mod("po4a::sgml", dgettext("po4a",
		"DTD of this file is unknown. (supported: debiandoc, docbook). The prolog follows:")."\n$prolog");
	}
    }

    # Hash of the file entities that won't be included
    my %ignored_inclusion = ();
    foreach (split / /,$self->{options}{'ignore-inclusion'}) {
        $ignored_inclusion{$_} = 1;
    }

    # Prepare the reference indirection stuff
    my @refs;
    my $length = ($origfile =~ tr/\n/\n/);
    print "XX Prepare reference indirection stuff\n" if $debug{'refs'};
    for (my $i=1; $i<=$length; $i++) {
	push @refs,"$mastername:$i";
	print "$mastername:$i\n" if $debug{'refs'};
    }

    # protect the conditional inclusions in the file
    $origfile =~ s/<!\[\s*IGNORE\s*\[/{PO4A-beg-IGNORE}/g; # cond. incl. starts
    $origfile =~ s/<!\[\s*CDATA\s*\[/{PO4A-beg-CDATA}/g; # cond. incl. starts
    $origfile =~ s/<!\[\s*RCDATA\s*\[/{PO4A-beg-RCDATA}/g; # cond. incl. starts
    $origfile =~ s/<!\[\s*([^\[\s]+)\s*\[/<po4abeg name="$1">/g; # cond. incl. starts
    $origfile =~ s/\]\]>/<po4aend>/g;                # cond. incl. end

    # Remove <![ IGNORE [ sections
    # FIXME: we don't support included PO4A-beg-
    my $tmp1 = $origfile;
    while ($tmp1 =~ m/^(.*?)({PO4A-beg-\s*IGNORE\s*}(?:.+?)<po4aend>)(.*)$/s)
    {
        my ($begin,$ignored,$end) = ($1, $2, $3);
        my @begin   = split(/\n/, $begin);
        my @ignored = split(/\n/, $ignored);
        my $pre = scalar @begin;
        my $len = (scalar @ignored) -1;
        $pre++ if ($begin =~ /\n$/s);
        $len++ if ($end   =~ /^\n/s);
        # remove the references of the ignored lines
        splice @refs, $pre+1, $len-1;
        # remove the lines
        $tmp1 = $begin.$end;
    }
    $origfile = $tmp1;
    # The <, >, and & in a CDATA must be escaped because they do not
    # correspond to tags or entities delimiters.
    $tmp1 = $origfile;
    $origfile = "";
    while ($tmp1 =~ m/^(.*?{PO4A-beg-\s*(?:CDATA|RCDATA)\s*})(.+?)(<po4aend>.*)$/s) {
        my ($begin, $tmp) = ($1, $2);
        $tmp1 = $3;
        $tmp =~ s/</{PO4A-lt}/gs;
        $tmp =~ s/>/{PO4A-gt}/gs;
        $tmp =~ s/&/{PO4A-amp}/gs;
        $origfile .= $begin.$tmp;
    }
    $origfile .= $tmp1;

    # Deal with the %entities; in the prolog. God damn it, this code is gross!
    # Try hard not to change the number of lines to not fuck up the references
    my %prologentincl;
    my $moretodo=1;
    PROLOGENTITY: while ($moretodo) { # non trivial loop to deal with recursive inclusion
	$moretodo = 0;
	# Unprotect not yet defined inclusions
	$prolog =~ s/{PO4A-percent}/%/sg;
        print STDERR "prolog=>>>>$prolog<<<<\n"
	      if ($debug{'entities'});
	while ($prolog =~ /(.*?)<!ENTITY\s*%\s*(\S*)\s+SYSTEM\s*"([^>"]*)"\s*>(.*)$/is) {  #})"{ (Stupid editor)
	    print STDERR "Seen the definition entity of prolog inclusion '$2' (=$3)\n"
	      if ($debug{'entities'});
	    # Preload the content of the entity.
	    my $key = $2;
	    my $filename=$3;
	    my $origfilename = $filename;
	    my ($begin, $end) = ($1, $4);
	    if ($filename !~ m%^/% && $mastername =~ m%/%) {
	        my $dir=$mastername;
	        $dir =~ s%/[^/]*$%%;
	        $filename="$dir/$filename";
	        # origfile also needs to be fixed otherwise nsgmls won't
	        # find the file.
	        $origfile =~ s/(<!ENTITY\s*%\s*\Q$key\E\s+SYSTEM\s*")\Q$origfilename\E("\s*>)/$1$filename$2/gsi;
	    }
	    if (defined $ignored_inclusion{$key} or !-e $filename) {
		# We won't expand this entity.
		# And we avoid nsgmls to do so.
		$prolog = "$begin<!--{PO4A-ent-beg-$key}$filename".
		          "{PO4A-ent-end}-->$end";
	    } else {
	    $prolog = $begin.$end;
	    (-e $filename && open IN,"<$filename")  ||
	      die wrap_mod("po4a::sgml",
	                   dgettext("po4a",
	                       "Can't open %s (content of entity %s%s;): %s"),
	                   $filename, '%', $key, $!);
	    local $/ = undef;
	    $prologentincl{$key} = <IN>;
	    close IN;
	    print STDERR "Content of \%$key; is $filename (".
	                 ($prologentincl{$key} =~ tr/\n/\n/).
	                 " lines long)\n"
	      if ($debug{'entities'});
	    print STDERR "content: ".$prologentincl{$key}."\n"
	      if ($debug{'entities'});
	    $moretodo = 1;
	    next PROLOGENTITY;
	    }
	}
	while ($prolog =~ /(.*?)<!ENTITY\s*%\s*(\S*)\s*"([^>"]*)"\s>(.*)$/is) {  #})"{ (Stupid editor)
	    print STDERR "Seen the definition entity of prolog definition '$2' (=$3)\n"
	      if ($debug{'entities'});
	    # Preload the content of the entity.
	    my $key = $2;
	    $prolog = $1.$4;
	    $prologentincl{$key} = $3;
	    print STDERR "content: ".$prologentincl{$key}."\n"
	      if ($debug{'entities'});
	    $moretodo = 1;
	    next PROLOGENTITY;
	}
        while ($prolog =~ /^(.*?)%([^;\s]*);(.*)$/s) {
	    my ($pre,$ent,$post) = ($1,$2,$3);
	    # Yeah, right, the content of the entity can be defined in a not yet loaded entity
	    # It's easy to build a weird case where all that shit collapses poorly. But why the
	    # hell are you using those strange constructs in your document, damn it?
	    print STDERR "Seen prolog inclusion $ent\n" if ($debug{'entities'});
	    if (defined ($prologentincl{$ent})) {
		$prolog = $pre.$prologentincl{$ent}.$post;
		print STDERR "Change \%$ent; to its content in the prolog\n"
		  if $debug{'entities'};
		$moretodo = 1;
	    } else {
		# AAAARGH stupid document using %bla; and having then defined in another inclusion!
		# Protect it for this pass, and unprotect it on next one
		print STDERR "entity $ent not defined yet ?!\n"
		  if $debug{'entities'};
		$prolog = "$pre".'{PO4A-percent}'."$ent;$post";
	    }
	}
    }
    $prolog =~ s/<!--{PO4A-ent-beg-(.*?)}(.*?){PO4A-ent-end}-->/<!ENTITY % $1 SYSTEM "$2">/g;
    # Unprotect undefined inclusions, and die of them
    $prolog =~ s/{PO4A-percent}/%/sg;
    if ($prolog =~ /%([^;\s]*);/) {
        die wrap_mod("po4a::sgml",
                     dgettext("po4a",
                              "unrecognized prolog inclusion entity: %%%s;"),
                     $1)
           unless ($ignored_inclusion{$1});
    }
    # Protect &entities; (all but the ones asking for a file inclusion)
    #   search the file inclusion entities
    my %entincl;
    my $searchprolog=$prolog;
    while ($searchprolog =~ /(.*?)<!ENTITY\s+(\S*)\s+SYSTEM\s*"([^>"]*)"\s*>(.*)$/is) {  #})"{
	print STDERR "Seen the entity of inclusion $2 (=$3)\n"
	  if ($debug{'entities'});
	my $key = $2;
	my $filename = $3;
	my $origfilename = $filename;
	$searchprolog = $4;
	if ($filename !~ m%^/% && $mastername =~ m%/%) {
	    my $dir=$mastername;
	    $dir =~ s%/[^/]*$%%;
	    $filename="$dir/$filename";
	    # origfile also needs to be fixed otherwise nsgmls won't find
	    # the file.
	    $origfile =~ s/(<!ENTITY\s+$key\s+SYSTEM\s*")\Q$origfilename\E("\s*>)/$1$filename$2/gsi;
	}
	if ((not defined $ignored_inclusion{$2}) and (-e $filename)) {
	    $entincl{$key}{'filename'}=$filename;
	    # Preload the content of the entity
	    (-e $filename && open IN,"<$filename")  ||
		die wrap_mod("po4a::sgml",
		       dgettext("po4a",
		                "Can't open %s (content of entity %s%s;): %s"),
		                $filename, '&', $key, $!);
	    local $/ = undef;
	    $entincl{$key}{'content'} = <IN>;
	    close IN;
	    $entincl{$key}{'length'} = ($entincl{$key}{'content'} =~ tr/\n/\n/);
	    print STDERR "read $filename (content of \&$key;, $entincl{$key}{'length'} lines long)\n"
		if ($debug{'entities'});
	}
    }

    #   Change the entities including files in the document
    foreach my $key (keys %entincl) {
        # The external entity can be referenced as &key; or &key
        # In the second case, we must differentiate &key and &key2
        while ($origfile =~/^(.*?)&$key(;.*$|[^-_:.A-Za-z0-9].*$|$)/s) {
	    my ($begin,$end)=($1,$2);
	    $end = "" unless (defined $end);
	    $end =~ s/^;//s;

	    if ($begin =~ m/.*<!--(.*?)$/s and $1 !~ m/-->/s) {
		# This entity is commented. Just remove it.
		$origfile = $begin.$end;
		next;
	    }

	    # add the refs
	    my $len  = $entincl{$key}{'length'}; # number added by the inclusion
	    my $pre  = ($begin =~ tr/\n/\n/); # number of \n
	    my $post = ($end =~ tr/\n/\n/);
	    print "XX Add a ref. pre=$pre; len=$len; post=$post\n" if $debug{'refs'};
	    # Keep a reference of inclusion position in main file
	    my $main = $refs[$pre];

	    # Remove the references for the lines after the inclusion
	    # point.
	    my @endrefs = splice @refs, $pre+1;

	    # Add the references of the added lines
	    my $i;
	    for ($i=0; $i<$len; $i++) {
		$refs[$i+$pre] = "$main $entincl{$key}{'filename'}:".($i+1);
	    }

	    if ($begin !~ m/\n[ \t]*$/s) {
		if ($entincl{$key}{'content'} =~ m/^[ \t]*\n/s) {
		    # There is nothing in the first line of the included
		    # file, and something on the line before the inclusion
		    # The line reference will be more informative like
		    # this:
		    $refs[$pre] = $main;
		}
	    }
	    if ($end !~ s/^[ \t]*\n//s) {
		if ($entincl{$key}{'content'} =~ m/\n[ \t]*$/s) {
		    # There is something on the line after the inclusion,
		    # and there is an end of line at the end of the
		    # included file. We must add the line reference of the
		    # remainder on the line:
		    push @refs, $main;
		}
	    }
	    # Append the references removed earlier (lines after the
	    # inclusion point).
	    push @refs, @endrefs;

	    # Do the substitution
	    $origfile = "$begin".$entincl{$key}{'content'}."$end";
	    print STDERR "substitute $2\n" if ($debug{'entities'});
        }
    }
    $origfile=~s/\G(.*?)&([A-Za-z_:][-_:.A-Za-z0-9]*|#[0-9]+|#x[0-9a-fA-F]+)\b/$1\{PO4A-amp\}$2/gs;
    if (defined($xmlprolog) && length($xmlprolog)) {
        $origfile=~s/\/>/\{PO4A-close\}>/gs;
    }

    if ($debug{'refs'}) {
	print "XX Resulting shifts\n";
	for (my $i=0; $i<scalar @refs; $i++) {
	    print "$mastername:".($i+1)." -> $refs[$i]\n";
	}
    }

    my ($tmpfh,$tmpfile)=File::Temp::tempfile("po4a-XXXX",
                                              SUFFIX => ".sgml",
                                              DIR    => "/tmp",
                                              UNLINK => 0);
    print $tmpfh $origfile;
    close $tmpfh or die wrap_mod("po4a::sgml", dgettext("po4a", "Can't close tempfile: %s"), $!);

    my $cmd="nsgmls -l -E 0 -wno-valid < $tmpfile".
            ($debug{'nsgmls'}?"":" 2>/dev/null")." |";
    print STDERR "CMD=$cmd\n" if ($debug{'generic'} or $debug{'nsgmls'});

    open (IN,$cmd) || die wrap_mod("po4a::sgml", dgettext("po4a", "Can't run nsgmls: %s"), $!);

    # The kind of tags
    my (%translate,%empty,%verbatim,%indent,%exist,%attribute,%qualify);
    foreach (split(/ /, ($self->{SGML}->{k}{'translate'}||'') )) {
	$translate{uc $_} = 1;
	$indent{uc $_} = 1;
	$exist{uc $_} = 1;
    }
    foreach (split(/ /, ($self->{SGML}->{k}{'empty'}||'') )) {
	$empty{uc $_} = 1;
	$exist{uc $_} = 1;
    }
    foreach (split(/ /, ($self->{SGML}->{k}{'verbatim'}||'') )) {
	$translate{uc $_} = 1;
	$verbatim{uc $_} = 1;
	$exist{uc $_} = 1;
    }
    foreach (split(/ /, ($self->{SGML}->{k}{'indent'}||'') )) {
	$translate{uc $_} = 1;
	$indent{uc $_} = 1;
	$exist{uc $_} = 1;
    }
    foreach (split(/ /, ($self->{SGML}->{k}{'ignore'}) || '')) {
	$exist{uc $_} = 1;
    }
    foreach (split(/ /, ($self->{SGML}->{k}{'attributes'} || ''))) {
        my ($attr, $tags);
        if (m/(^.*>)(\w+)/) {
            $attr=uc $2;
            $tags=$1;
        } else {
            $attr=uc $_;
            $tags=".*";
        }
        if (exists $attribute{$attr}) {
            $attribute{$attr}.="|$tags";
        } else {
            $attribute{$attr} = $tags;
        }
    }
    foreach (split(/ /, ($self->{SGML}->{k}{'qualify'}) || '')) {
        $qualify{uc $_} = 1;
        $attribute{uc $_} = '.*' unless exists $attribute{uc $_};
    }


    # What to do before parsing

    # push the XML prolog if existing
    $self->pushline($xmlprolog."\n") if (defined($xmlprolog) && length($xmlprolog));

    # Put the prolog into the file, allowing for entity definition translation
    #  <!ENTITY myentity "definition_of_my_entity">
    # and push("<!ENTITY myentity \"".$self->translate("definition_of_my_entity")
    if ($prolog =~ m/(.*?\[)(.*)(\]>)/s) {
	warn "Pre=~~$1~~;Post=~~$3~~\n" if ($debug{'entities'});
	$self->pushline($1."\n") if (length($1));
	$prolog=$2;
	my ($post) = $3;
	while ($prolog =~ m/^(.*?)<!ENTITY\s+(\S*)\s+"([^"]*)"\s*>(.*)$/is) { #" ){
	   $self->pushline($1) if length($1);
	   $self->pushline("<!ENTITY $2 \"".$self->translate($3,"","definition of entity \&$2;")."\">");
	   warn "Seen text entity $2\n" if ($debug{'entities'});
	   $prolog = $4;
	}
	$prolog .= $post;
	$self->pushline($prolog."\n") if (length($prolog));
    } else {
	warn "No entity declaration detected in ~~$prolog~~...\n" if ($debug{'entities'});
	$self->pushline($prolog) if length($prolog);
    }

    # The parse object.
    # Damn SGMLS. It makes me do crude things.
    no strict "subs";
    my $parse= new SGMLS(IN);
    use strict;

    # Some values for the parsing
    my @open=(); # opened translation container tags
    my $verb=0;  # can we wrap or not
    my $verb_last_ref;
    my $seenfootnote=0;
    my $indent=0; # indent level
    my $lastchar = ''; #
    my $buffer= ""; # what we will soon handle

    # Keep a reference to the last line indicated by nsgmls
    my $line=0;
    # Unfortunately, nsgmls do not mention all the line changes.  We have
    # to keep track of the number of lines seen in the "record ends".
    my $adds=0;
    # If the last line received contains only spaces, do not take it into
    # account for the line reference of the paragraph.
    my $empty_last_cdata=0;
    # run the appropriate handler for each event
    EVENT: while (my $event = $parse->next_event) {
	# get the line reference to build po entries
	if ($line != $parse->line) {
	    # nsgmls informs us of that the line changed. Reset $adds and
	    # $empty_last_cdata
	    $adds = 0;
	    $empty_last_cdata = 0;
	    $line = $parse->line;
	}
	my $ref=$refs[$parse->line-1 + $adds - $empty_last_cdata];
	# In verbatim mode, keep the current line reference.
	if ($verb) {
	    $ref=$refs[$parse->line-1];
	}
	my $type;

	if ($event->type eq 'start_element') {
	    die wrap_ref_mod($ref, "po4a::sgml",
	                     dgettext("po4a", "Unknown tag %s"),
	                     $event->data->name)
		unless $exist{$event->data->name};

	    $lastchar = ">";

	    # Which tag did we see?
	    my $tag='';
	    $tag .= '<'.lc($event->data->name());
	    while (my ($attr, $val) = each %{$event->data->attributes()}) {
		my $value = $val->value();
#		if ($val->type() eq 'IMPLIED') {
#		    $tag .= ' '.lc($attr).'="'.lc($attr).'"';
#		} els
                if ($val->type() eq 'CDATA' ||
		    $val->type() eq 'IMPLIED') {
		    if (defined $value && length($value)) {
                        my $lattr=lc $attr;
                        my $uattr=uc $attr;
                        if (exists $attribute{$uattr}) {
                            my $context="";
                            foreach my $o (@open) {
                                next if (!defined $o or $o =~ m%^</%);
                                $o =~ s/ .*/>/;
                                $context.=$o;
                            }
                            $context=join("", $context,
                                          "<", lc($event->data->name()), ">");
                            if ($context =~ /^($attribute{$uattr})$/) {
                                if ($qualify{$uattr}) {
                                    my $translated = $self->translate("$lattr=$value", $ref, "attribute $context$lattr");
                                    if ($translated =~ s/^$lattr=//) {
                                        $value=$translated;
                                    } else {
                                        die wrap_mod("po4a::sgml", dgettext("po4a", "bad translation '%s' for '%s' in '%s'"), $translated, $context.$lattr, $ref);
                                    }
                                } else {
                                    $value = $self->translate($value, $ref, "attribute $context$lattr");
                                }
                            }
                        }
			if ($value =~ m/\"/) {
			    $value = "'".$value."'";
			} else {
			    $value = '"'.$value.'"';
			}
			$tag .= " $lattr=$value";
		    }
		} elsif ($val->type() eq 'NOTATION') {
		} else {
		    $tag .= ' '.lc($attr).'="'.lc($value).'"'
			if (defined $value && length($value));
		}
	    }
	    $tag .= '>';


	    # debug
	    print STDERR "Seen $tag, open level=".(scalar @open).", verb=$verb\n"
		if ($debug{'tag'});

	    if ($event->data->name() eq 'FOOTNOTE') {
		# we want to put the <para> inside the <footnote> in the same msgid
		$seenfootnote = 1;
	    }

	    if ($seenfootnote) {
		$buffer .= $tag;
		next EVENT;
	    }
	    if ($translate{$event->data->name()}) {
		# Build the type
		if (scalar @open > 0) {
		    $type=$open[$#open] . $tag;
		} else {
		    $type=$tag;
		}

		# do the job
		if (@open > 0) {
		    $self->end_paragraph($buffer,$ref,$type,$verb,$indent,
					 @open);
		} else {
		    $self->pushline($buffer) if $buffer;
		}
		$buffer="";
		push @open,$tag;
	    } elsif ($indent{$event->data->name()}) {
		die wrap_ref_mod($ref, "po4a::sgml", dgettext("po4a",
		    "Closing tag for a translation container missing before %s"),$tag)
		    if (scalar @open);
	    }

	    if ($verbatim{$event->data->name()}) {
		$verb++;
		# Keep a reference to the line that openned the verbatim
		# section. This is needed to check if its data starts on
		# the same line.
		$verb_last_ref = $ref;
	    }
	    if ($verb) {
		# Tag in a verbatim section. Check if it appeared at
		# the same line than the previous data. If not, it
		# means that an end of line must be added to the
		# buffer.
		if ($ref ne $verb_last_ref) {
		    # FIXME: Does it work if $verb > 1
		    $buffer .= "\n";
		    $verb_last_ref = $ref;
		}
	    }

	    if ($indent{$event->data->name()}) {
		# push the indenting space only if not in verb before that tag
		# push trailing "\n" only if not in verbose afterward
		$self->pushline( ($verb>1?"": (" " x $indent)).$tag.($verb?"":"\n"));
		$indent ++ unless $empty{$event->data->name()} ;
	    }  else {
		$tag =~ s/<po4abeg name="([^"]+)">/<![ $1 [/; #"; Stupid emacs
		$tag =~ s/<po4aend>/]]>/;
		$buffer .= $tag;
	    }
	} # end of type eq 'start_element'

	elsif ($event->type eq 'end_element') {
	    my $tag = ($empty{$event->data->name()}
		           ?
		       ''
		           :
		       '</'.lc($event->data->name()).'>');

	    if ($verb) {
		# Tag in a verbatim section. Check if it appeared at
		# the same line than the previous data. If not, it
		# means that an end of line must be added to the
		# buffer.
		if ($ref ne $verb_last_ref) {
		    # FIXME: Does it work if $verb > 1
		    $buffer .= "\n";
		    $verb_last_ref = $ref;
		}
	    }
	    print STDERR "Seen $tag, level=".(scalar @open).", verb=$verb\n"
		if ($debug{'tag'});

	    $lastchar = ">";

	    if ($event->data->name() eq 'FOOTNOTE') {
		# we want to put the <para> inside the <footnote> in the same msgid
		$seenfootnote = 0;
	    }

	    if ($seenfootnote) {
		$buffer .= $tag;
		next EVENT;
	    }
	    if ($translate{$event->data->name()}) {
		$type = $open[$#open] . $tag;
		$self->end_paragraph($buffer,$ref,$type,$verb,$indent,@open);
		$buffer = "";
		pop @open;
		if (@open > 0) {
		    pop @open;
		    push @open,$tag;
		}
	    } elsif ($indent{$event->data->name()}) {
		die wrap_ref_mod($ref, "po4a::sgml", dgettext("po4a",
           "Closing tag for a translation container missing before %s"), $tag)
		    if (scalar @open);
	    }

	    unless ($event->data->name() =~ m/^(PO4ABEG|PO4AEND)$/si) {
		if ($indent{$event->data->name()}) {
		    $indent -- ;
		    # add indenting space only when not in verbatim
		    # add the tailing \n only if out of verbatim after that tag
		    $self->pushline(($verb?"":(" " x $indent)).$tag.($verb>1?"":"\n"));
		}  else {
		    $buffer .= $tag;
		}
		$verb-- if $verbatim{$event->data->name()};
	    }
	} # end of type eq 'end_element'

	elsif ($event->type eq 'cdata') {
	    my $cdata = $event->data;
	    $empty_last_cdata=($cdata =~ m/^\s*$/);
	    $cdata =~ s/{PO4A-lt}/</g;
	    $cdata =~ s/{PO4A-gt}/>/g;
	    $cdata =~ s/{PO4A-amp}/&/g;
            $cdata =~ s/{PO4A-end}/\]\]>/g;
            $cdata =~ s/{PO4A-beg-([^\}]+)}/<!\[$1\[/g;
	    if ($verb) {
		# Check if this line of data appear on the same line
		# than the previous tag. If not, append an end of line
		# to the buffer.
		if ($ref ne $verb_last_ref) {
		    $buffer .= "\n";
		    $verb_last_ref = $ref;
		}
	    } else {
		$cdata =~ s/\\t/ /g;
		$cdata =~ s/\s+/ /g;
		$cdata =~ s/^\s//s if $lastchar eq ' ';
	    }
	    $lastchar = substr($cdata, -1, 1);
	    $buffer .= $cdata;
	    if (defined($xmlprolog) && length($xmlprolog)) {
		$buffer =~ s/>PO4A-close\}>/\/>/sg;
		$buffer =~ s/PO4A-close\}>//sg; # This should not be necessary
	    }
	} # end of type eq 'cdata'

	elsif ($event->type eq 'sdata') {
	    my $sdata = $event->data;
	    $sdata =~ s/^\[//;
	    $sdata =~ s/\s*\]$//;
	    $lastchar = substr($sdata, -1, 1);
	    $buffer .= '&'.$sdata.';';
	} # end of type eq 'sdata'

	elsif ($event->type eq 're') {
	    # End of record, the line reference shall be incremented.
	    $adds +=1;
	    if ($verb) {
		# Check if this line of data appear on the same line
		# than the previous tag. If not, append an end of line
		# to the buffer.
		if ($ref ne $verb_last_ref) {
		    $buffer .= "\n";
		    $verb_last_ref = $ref;
		}
		$buffer .= "\n";
	    } elsif ($lastchar ne ' ') {
		$buffer .= " ";
	    }
	    $lastchar = ' ';
	} #end of type eq 're'

	elsif ($event->type eq 'conforming') {

	}

	elsif ($event->type eq 'pi') {
	    my $pi = $event->data;
	    $buffer .= "<?$pi>";
	}

	else {
	    die wrap_ref_mod($refs[$parse->line], "po4a::sgml",
	                     dgettext("po4a","Unknown SGML event type: %s"),
	                     $event->type);
	}
    }

    # What to do after parsing
    $self->pushline($buffer);
    close(IN);
    warn wrap_mod("po4a::sgml",
                  dgettext("po4a","Warning: nsgmls produced some errors.  ".
                  "This is usually caused by po4a, which modifies the input ".
                  "and restores it afterwards, causing the input of nsgmls ".
                  "to be invalid.  This is usually safe, but you may wish ".
                  "to verify the generated document with nsgmls -wno-valid.  ".
                  "Continuing..."))
        if ($? != 0 and $self->verbose() > 0);
    unlink ($tmpfile) unless ($debug{'refs'} or $debug{'nsgmls'});
}

sub end_paragraph {
    my ($self, $para,$ref, $type,$verb,$indent)=
	(shift,shift,shift,shift,shift,shift);
    my (@open)=@_;
    die "Internal error: no paragraph to end here!!"
	unless scalar @open;

    return unless defined($para) && length($para);

    if (($para =~ m/^\s*$/s) and (not $verb)) {
	# In non-verbatim environments, a paragraph with only spaces is
	# like an empty paragraph
	return;
    }

    # unprotect &entities;
    $para =~ s/{PO4A-amp}/&/g;
    # remove the name"\|\|" nsgmls added as attributes
    $para =~ s/ name=\"\\\|\\\|\"//g;
    $para =~ s/ moreinfo=\"none\"//g;

    # Extract the leading and trailing spaces. They will be restored only
    # in verbatim environments.
    my ($leading_spaces, $trailing_spaces) = ("", "");
    if ($verb) {
	# In the verbatim mode, we can ignore empty lines, but not the
	# leading spaces or tabulations. Otherwise, the PO will look
	# weird.
	if ($para =~ m/^(\s*\n)(.*?)(\s*)$/s) {
	    $leading_spaces = $1;
	    $para = $2;
	    $trailing_spaces = $3;
	}
    } else {
	if ($para =~ m/^(\s*)(.*?)(\s*)$/s) {
	    $leading_spaces = $1;
	    $para = $2;
	    $trailing_spaces = $3;
	}
    }

    $para = $self->translate($para,$ref,$type,
                             'wrap' => ! $verb,
                             'wrapcol' => (75 - $indent));

    if ($verb) {
	$para = $leading_spaces.$para.$trailing_spaces;
    } else {
	$para =~ s/^\s+//s;
	my $toadd=" " x ($indent+1);
	$para =~ s/^/$toadd/mg;
	$para .= "\n";
    }

    $self->pushline( $para );
}

1;

=head1 AUTHORS

This module is an adapted version of sgmlspl (SGML postprocessor for the
SGMLS and NSGMLS parsers) which was:

 Copyright (c) 1995 by David Megginson <dmeggins@aix1.uottawa.ca>

The adaptation for po4a was done by:

 Denis Barbier <barbier@linuxfr.org>
 Martin Quinson (mquinson#debian.org)

=head1 COPYRIGHT AND LICENSE

 Copyright (c) 1995 by David Megginson <dmeggins@aix1.uottawa.ca>
 Copyright 2002, 2003, 2004, 2005 by SPI, inc.

This program is free software; you may redistribute it and/or modify it
under the terms of GPL (see the COPYING file).
