#! /usr/bin/perl

#  po2debiandoc   - create a translated DebianDoc SGML document
#  Copyright (C) 2001-2002  Denis Barbier <barbier@debian.org>
#
#  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.,
#  59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#   This script is part of po-debiandoc

use strict;
use Text::Wrap;
use IO::File;
use Getopt::Long;

my ($type, $name, $start, $end, $comment, $msgid, $text, $pos, $trans);
my ($extra, $replace, $output);

use vars(qw($opt_h $opt_v $opt_f $opt_P $opt_m $opt_W @subst));

sub usage {
        print STDERR <<"EOT";
Usage: $0 [OPTIONS] origfile pofile
Options:
  -h,  --help           display this help message
  -v,  --verbose        enable verbose mode
  -f,  --fragment=LEVEL use when input is a fragment file
                        (chapter or appendix)
  -P,  --prolog=FILE    replace original prolog by this file content
  -m,  --message=MODE   display messages, where MODE is (default is uptodate)
            uptodate: translated strings if up to date, English otherwise
            fuzzy   : translated strings even when fuzzy
            original: English strings
            both    : English and translated strings
  -W,  --width=NUM      wrap lines to at most NUM characters, and indent text
                        (default is 80, and indenting is disabled when set to 0)
  -s,  --substitute=s/FOO/BAR/  perform a Perl s/// command
EOT
        exit($_[0]);
}

$Getopt::Long::bundling = 1;
$Getopt::Long::getopt_compat = 0;
$opt_W = 80;
unless (Getopt::Long::GetOptions(
                        'h|help',
                        'v|verbose',
                        'f|fragment=s',
                        'P|prolog=s',
                        'm|message=s',
                        'W|width=i',
                        's|substitute=s' => \@subst)) {
        warn "Try `$0 --help' for more information.\n";
        exit(1);
}

usage(0) if $opt_h;
usage(1) unless $#ARGV == 1;

$Text::Wrap::columns = $opt_W;
$Text::Wrap::huge = 'overflow';

my $orig  = new IO::File;
die "Unable to read from $ARGV[0]"
        unless $orig->open("< $ARGV[0]");
#   First count prolog lines
my $lineno = 0;
my $prolog = '';
unless ($opt_f) {
        while (<$orig>) {
                $lineno++;
                $prolog .= $_;
                last if m/<debiandoc/i;
        }
}
$orig->close() or die "Unable to close $ARGV[0]";
#   Replace prolog if -P is in use
if ($opt_P) {
        $prolog = '';
        die "Unable to read from $opt_P"
                unless $orig->open("< $opt_P");
        while (<$orig>) {
                $prolog .= $_;
                last if m/<debiandoc/i;
        }
        $orig->close() or die "Unable to close $opt_P";
}

my $ddoc_po_lib = $ENV{DEBIANDOCPOLIB} || '/usr/share/po-debiandoc';
$opt_f = "-f $opt_f" if $opt_f;
die "Unable to read from $ARGV[0]"
         unless $orig->open("$ddoc_po_lib/po-debiandoc-fix $opt_f $ARGV[0] |");

my $po = new IO::File;
die "Unable to read from $ARGV[1]"
        unless $po->open("< $ARGV[1]");

sub verbose {
        print STDERR "Verbose: $_[0]\n" if $opt_v;
}

#   Read PO file in memory
verbose ("Reading PO file");
my ($po_msgs, $header);
{
        local ($/) = undef;
        $po_msgs = <$po>;
}
if ($po_msgs =~ m/(?:^|\n)msgid ""\nmsgstr "(.*?)"\n\n/s) {
        $header = unescape_text ($1);
        $header =~ s/^/    /mg;
}
$po_msgs .= "\n\n";

while ($po_msgs =~ m/(#\..*?)\n#: [^:]+:(\d+)(.*?)\nmsgid "(.*?)"\nmsgstr "(.*?)"\n\n/sg) {
        ($type, $pos, $comment, $msgid, $text) = ($1, $2, $3, $4, $5);
        if ($opt_m eq 'original') {
                $text = $msgid;
        } elsif ($opt_m eq 'fuzzy') {
                $text = $msgid if $text eq '';
        } elsif ($opt_m eq 'both') {
                $text = '(untranslated)' if $text eq '';
        } else {
                $text = $msgid if $text eq '' || $comment =~ m/fuzzy/;
        }
        $text  = unescape_text($text);
        $msgid = unescape_text($msgid);
        foreach (split(/\n/, $type)) {
                s/^#\. //;
                if (m/<extra:([^>]*)> (\d+)--(\d+)/) {
                        verbose ("New paragraph found line $2");
                        $extra->{$pos} = {
                                text    => $text,
                                orig    => $msgid,
                        };
                } elsif (m/<([^>]*)> (\d+)--(\d+)/) {
                        verbose ("Replacement text found l. $2--$3");
                        $replace->{$2} = {
                                end     => $3,
                                name    => $1,
                                text    => $text,
                                orig    => $msgid,
                        };
                }
        }
}

sub unescape_text {
        my $text = shift;
        $text =~ s/"\n"//sg;
        $text =~ s/\\"/"/g;
        $text =~ s/\\n/\n/g;
        $text =~ s/\\t/\t/g;
        $text =~ s/\\\\/\\/g;
        return $text;
}

sub indent {
        my $text = shift;
        return $text unless $opt_W > 0;
        my $out  = '';
        foreach (split(/\n/, $text)) {
                if (s/^(\s*)((.*?)<p>.*?)<example/<example/) {
                        $_ = Text::Wrap::wrap("", $1.(length($3) x ' '), $1.$2) . $_;
                } elsif (m/^(\s*)(.*?)<p>/) {
                        my $space = $1.$2;
                        $space =~ s/./ /g;
                        $_ = Text::Wrap::wrap("", $space, $_);
                }
                $out .= $_ . "\n";
        }
        return $out;
}

if (@subst) {
        my $s= '';
        foreach (@subst) {
                $s .= "$_; die \$@ if \$@;" ;
        }
        eval "sub replace_text { \$_ = shift; $s; return \$_}";
} else {
        sub replace_text { $_[0] };
}

#   Read original message and write translated text
verbose ("Reading original document");
verbose ("Found $lineno lines of prolog:\n$prolog\n") if $prolog;
$output = '';
unless ($opt_f) {
        while (<$orig>) {
                last if m/<debiandoc/i;
        }
}
while (<$orig>) {
        $lineno++;
        if (defined $extra->{$lineno}) {
                verbose ("Insert extra text l. $lineno");
                $output .= replace_text($extra->{$lineno}->{text})."\n";
        }
        if (defined $replace->{$lineno}) {
                verbose ("Replace text l. $lineno--$replace->{$lineno}->{end}");
                my $trans = '';
                $text = $_;
                for ($lineno .. ($replace->{$lineno}->{end} - 1)) {
                        $text .= <$orig>;
                }
                if ($text =~ m/^([^\n]+?)<$replace->{$lineno}->{name}\b/si) {
                        $trans = $1;
                }
                $trans .= "<".$replace->{$lineno}->{name}.">".
                      $replace->{$lineno}->{text};
                if ($opt_m eq 'both') {
                        if ($replace->{$lineno}->{name} =~ m/^(abstract|title|copyrightsummary|heading|p)$/) {
                                $trans .= ' [orig: '.$replace->{$lineno}->{orig}.' :orig] ';
                        }
                }
                $trans .= "</".$replace->{$lineno}->{name}.">\n";
                $output .= replace_text($trans);
                if ($replace->{$lineno}->{end} > $lineno) {
                        if ($text =~ s/\n([^\n]+)$//s) {
                                $_ = $1;
                        } else {
                                $_ = $text;
                        }
                        s|.*</$replace->{$lineno}->{name}>||si;
                        $lineno = $replace->{$lineno}->{end} - 1;
                        redo;
                } else {
                        $lineno = $replace->{$lineno}->{end};
                }
        } else {
                $output .= replace_text($_);
        }
}
if ($opt_f) {
        $output =~ s|</book>\s*</debiandoc>.*||s;
        $output =~ s|^.*?</titlepag>||s;
        $output =~ s|^.*?<chapt><heading></heading></chapt>||s
                if $opt_f eq '-f appendix';
}
$output =~ s/{po-ddf-amp}/\&/g;
$output =~ s/{po-ddf-lt}/</g;
$output =~ s/{po-ddf-gt}/>/g;

print replace_text($prolog);
print "<!--\n${header}-->\n" if $header;
print indent($output);

1;
