#!/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 © 1995 David Megginson # # The adaptation for po4a was done by Denis Barbier , # 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 # ######################################################################## =encoding UTF-8 =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(1) 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 B Space-separated list of keywords indicating which category of extra debug messages should be shown. Possible values are: C, C, C, C and C. =item B Give more information about what's going on. =item B Space-separated list of extra tags (beside the DTD provided ones) whose content should form an extra msgid, i.e that should be translated. =item B
Space-separated list of extra tags (beside the DTD provided ones) containing other tags, some of them being of category B. =item B Space-separated list of tags which increase the indentation level. This will affect the identation in the resulting document. =item B 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 B Tags not needing to be closed. =item B Tags ignored and considered as plain char data by po4a. That is to say that they can be part of an msgid. For example, EbE is a good candidate for this category since putting it in the B section would create a msgids with only its content, (and it's ususally not a whole sentence), which is bad. =item B A space-separated list of attributes that need to be translated. You can specify the attributes by their name (for example, C), 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: C<< lang >> specifies that the lang attribute will only be translated if it is in an C<< >> tag, which is in a C<< >> tag. The tag names are actually regular expressions so you can also write things like C<< lang >> to only translate C attributes that are in an C<< >> or a C<< >> tag. =item B A space-separated list of attributes for which the translation must be qualified by the attribute name, i.e. the text extracted for the transalation will include both the attributes name and it's value. e.g. for a tag like C<< >> translators will be presented with the string C. Note that this also automatically adds the given attribute into the B list too. =item B Proceed even if the DTD is unknown or if B finds errors in the input file. =item B By default, msgids containing only one entity (like C<&version;>) are skipped for the translators' comfort. Activating this option prevents this optimisation. It can be useful if the document contains a construction like C<< Á >>, even if I doubt such things to ever happen... =item B Space-separated list of entities that won't be inlined. Use this option with caution: it may cause B (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 as the originals. But there are still some problems: =over 2 =item * The error output of B is redirected to /dev/null by default, which is clearly bad. I don't know how to avoid that. The problem is that I have to "protect" the conditional inclusions (i.e. the C! [ %foo [> and C<]]E> stuff) from B. Otherwise B 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 invalid in the document (not in a EpE tag or so). If you want to view the B output, just add the following to your command line (or po4a configuration line): -o debug=onsgmls =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 (i.e. lines like C<#: en/titletoc.sgml:9460>) will be wrong. This is because I preprocess the file to protect the conditional inclusion (i.e. the C! [ %foo [> and C<]]E> stuff) and some entities (like C<&version;>) from B 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 B 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 be in a 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.16.0; 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, 'onsgmls' => 0 ); my $xmlprolog = undef; # the '' 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'} ) { die wrap_mod( "po4a::sgml", dgettext( "po4a", "Unknown debug category: %s. Known categories:\n%s" ), $_, join( " ", keys %debug ) ) unless exists $debug{$_}; $debug{$_} = 1; } } } sub read { my ( $self, $filename, $refname, $charset ) = @_; push @{ $self->{DOCPOD}{infile} }, $filename; $self->Locale::Po4a::TransTractor::read( $filename, $refname, $charset ); } 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)" ) ) 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)" ) ) unless $self->verbose() <= 0; return $string . ( $options{'wrap'} ? "\n" : "" ); } # don't translate entries composed of marked section tags only if ( ( $string =~ /^(?:|\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   my $nbs_out = "\xA0"; my $enc_length = Encode::from_to( $nbs_out, "latin1", $self->get_out_charset ); $str =~ s/\Q$nbs_out/ /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 (i.e. "") # - 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 my ( $tmpfh, $tmpfile ) = File::Temp::tempfile( "po4a-XXXX", SUFFIX => ".sgml", DIR => File::Spec->tmpdir(), UNLINK => 0 ); print $tmpfh $origfile; close $tmpfh or die wrap_mod( "po4a::sgml", dgettext( "po4a", "Cannot close tempfile: %s" ), $! ); if ( system("onsgmls -p $tmpfile") ) { unlink($tmpfile); die wrap_mod( "po4a::sgml", dgettext( "po4a", "Error while running onsgmls -p. Please check if onsgmls and the DTD are installed." ) ); } unlink($tmpfile); } # 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/^(.*' 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 =~ /^.*]*\[/is ) { $origfile =~ s/^(.*]*\[)/$1 /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 appendixinfo artheader attribution " . "biblioentry biblioset " . "chapterinfo collab collabname confdates confgroup conftitle " . "date " . "edition editor entry example " . "figure " . "glosssee glossseealso glossterm " . "holder " . "member msgaud msglevel msgorig " . "orgdiv orgname othername " . "pagenums para phrase pubdate publishername primary " . "refclass refdescriptor refentrytitle refmiscinfo refname refpurpose releaseinfo remark revnumber revremark " . "screeninfo seg secondary see seealso segtitle simpara substeps subtitle synopfragmentref synopsis " . "term tertiary title titleabbrev " . "contrib epigraph", "empty" => "audiodata colspec graphic imagedata textdata sbr spanspec 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" => "acronym action affiliation anchor application arg author authorinitials " . "city citation citerefentry citetitle classname co command computeroutput constant corpauthor country " . "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 isbn " . "keycap keycode keycombo keysym " . "link lineannotation literal " . "manvolnum markup medialabel menuchoice methodname modespec mousebutton " . "nonterminal " . "olink ooclass ooexception oointerface option optional othercredit " . "parameter personname phrase productname productnumber prompt property pubsnumber " . "quote " . "remark replaceable returnvalue revhistory " . "sgmltag sidebar structfield structname subscript superscript surname symbol systemitem " . "token trademark type " . "ulink userinput " . "varname volumenum " . "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//g; # cond. incl. starts $origfile =~ s/\]\]>//g; # cond. incl. end # Remove )(.*)$/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*})(.+?)(.*)$/s ) { my ( $begin, $tmp ) = ( $1, $2 ); $tmp1 = $3; $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 =~ /(.*?)"]*)"\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 onsgmls won't # find the file. $origfile =~ s/()/$1$filename$2/gsi; } if ( defined $ignored_inclusion{$key} or !-e $filename ) { # We won't expand this entity. # And we avoid onsgmls to do so. $prolog = "$begin$end"; } else { $prolog = $begin . $end; ( -e $filename && open IN, "<$filename" ) || die wrap_mod( "po4a::sgml", dgettext( "po4a", "Cannot open %s (content of entity %s%s;): %s" ), $filename, '%', $key, $! ); local $/ = undef; $prologentincl{$key} = ; 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 =~ /(.*?)"]*)"\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///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 =~ /(.*?)"]*)"\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 onsgmls won't find # the file. $origfile =~ 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", "Cannot open %s (content of entity %s%s;): %s" ), $filename, '&', $key, $! ); local $/ = undef; $entincl{$key}{'content'} = ; 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 my $dosubstitution = 1; while ($dosubstitution) { $dosubstitution = 0; 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 ) { # Since we will include a new file, we # must do a new round of substitutions. $dosubstitution = 1; my ( $begin, $end ) = ( $1, $2 ); $end = "" unless ( defined $end ); $end =~ s/^;//s; if ( $begin =~ 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 $key\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 => File::Spec->tmpdir(), UNLINK => 0 ); print $tmpfh $origfile; close $tmpfh or die wrap_mod( "po4a::sgml", dgettext( "po4a", "Cannot close tempfile: %s" ), $! ); my $cmd = "onsgmls -l -E 0 -wno-valid $tmpfile" . ( $debug{'onsgmls'} ? "" : " 2>/dev/null" ) . " |"; print STDERR "CMD=$cmd\n" if ( $debug{'generic'} or $debug{'onsgmls'} ); open( IN, $cmd ) || die wrap_mod( "po4a::sgml", dgettext( "po4a", "Cannot run onsgmls: %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 # # and push("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/^(.*?)(.*)$/is ) { #" ){ $self->pushline($1) if length($1); $self->pushline( "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 onsgmls my $line = 0; # Unfortunately, onsgmls 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 ) { # onsgmls 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() ); foreach my $attr ( sort $event->data->attribute_names() ) { my $val = ${ $event->data->attributes() }{$attr}; 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%^/; $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 inside the 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///]]>/; $buffer .= $tag; } } # end of type eq 'start_element' elsif ( $event->type eq 'end_element' ) { my $tag = ( $empty{ $event->data->name() } ? '' : '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 inside the 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-amp}/&/g; $cdata =~ s/{PO4A-end}/\]\]>/g; $cdata =~ s/{PO4A-beg-([^\}]+)}/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 .= ""; } 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); if ( $? != 0 and $self->verbose() > 0 ) { warn wrap_mod( "po4a::sgml", dgettext( "po4a", "Warning: onsgmls produced some errors. " . "This is usually caused by po4a, which modifies the input " . "and restores it afterwards, causing the input of onsgmls " . "to be invalid. This is usually safe, but you may wish " . "to verify the generated document with onsgmls -wno-valid." ) ); unless ( $debug{'onsgmls'} ) { warn wrap_mod( "po4a::sgml", dgettext( "po4a", "To see the error message, " . "rerun po4a with this additional argument:\n" . " -o debug=onsgmls" ) ); } } unlink($tmpfile) unless ( $debug{'refs'} or $debug{'onsgmls'} ); } 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"\|\|" onsgmls 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 ONSGMLS parser) which was: Copyright © 1995 David Megginson The adaptation for po4a was done by: Denis Barbier Martin Quinson (mquinson#debian.org) =head1 COPYRIGHT AND LICENSE Copyright © 1995 David Megginson . Copyright © 2002-2005 SPI, Inc. This program is free software; you may redistribute it and/or modify it under the terms of GPL v2.0 or later (see the COPYING file).