diff options
Diffstat (limited to 'perl-install/install/help/help_xml2pm.pl')
| -rwxr-xr-x | perl-install/install/help/help_xml2pm.pl | 326 |
1 files changed, 326 insertions, 0 deletions
diff --git a/perl-install/install/help/help_xml2pm.pl b/perl-install/install/help/help_xml2pm.pl new file mode 100755 index 000000000..742bd9b78 --- /dev/null +++ b/perl-install/install/help/help_xml2pm.pl @@ -0,0 +1,326 @@ +#!/usr/bin/perl -w + +use XML::Parser; +use MDK::Common; +use utf8; + +my $dir = "doc/manualB/modules"; +my $xsltproc = "/usr/bin/xsltproc"; + +if ( ! -x "$xsltproc" ){ + print "You need to have \"$xsltproc\" - "; + print "so type \"urpmi libxslt-proc\" please.\n"; + exit 1; +} + +my %helps = map { + my $lang = $_; + my @l = grep { !/drakx-MNF-chapter/ } map { /(drakx-.*).xml$/ } all("$dir/$lang"); + if (@l < 20) { () } else { + my $template_file = "$dir/$lang/drakx.xml"; + my $file = "$dir/$lang/drakx_full.xml"; + output($template_file, template($lang, @l)); + system("$xsltproc id.xsl $template_file > $file") == 0 or die "$xsltproc id.xsl $template_file failed\n"; + + warn "parsing $file\n"; + my $p = new XML::Parser(Style => 'Tree'); + my $tree = $p->parsefile($file); + + $lang => rewrite2(rewrite1(@$tree), $lang); + } +} all($dir); + +my $base = delete $helps{en} || die; +save_help($base); + +foreach my $lang (keys %helps) { + (my $rlang = $lang) =~ s/_(.*)/_\U$1/; + print "Now transforming: $lang\n"; + open(my $F, ">:encoding(utf8)", "po/$rlang.po"); + print $F <<EOF; +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\\n" + +EOF + foreach my $id (keys %{$helps{$lang}}) { +# warn "Writing id=$id in lang=$lang\n"; + $base->{$id} or warn "$lang:$id doesn't exist in english\n", next; + print $F qq(# DO NOT BOTHER TO MODIFY HERE, SEE:\n# cvs.mandriva.com:/cooker/$dir/$lang/drakx-chapter.xml\n); + print_in_PO($F, $base->{$id}[0], $helps{$lang}{$id}[0]); + } +} +unlink(".memdump"); + +sub print_in_PO { + my ($F, $msgid, $msgstr) = @_; + + print $F qq(msgid ""\n"); + print $F join(qq(\\n"\n"), split "\n", $msgid); + print $F qq("\nmsgstr ""\n"); + print $F join(qq(\\n"\n"), split "\n", $msgstr); + print $F qq("\n\n); +} + +sub save_help { + my ($help, $inside_strings) = @_; + + open(my $F, ">:encoding(utf8)", "help.pm"); + print $F <<'EOF'; +package install::help::help; +use common; +use utf8; + +push @::textdomains, 'DrakX-help'; + +1; + +# IMPORTANT: Do not edit this File - It is automatically generated +# from the manuals !!! +# Write a mail to <documentation@mandriva.com> if +# you want it changed. +EOF + foreach (sort keys %$help) { + my ($main, @inside) = map { qq("$_") } @{$help->{$_}}; + my $s = join(', ', $main, map { qq(N($_)) } @inside); + print STDERR "Writing id=$_\n"; + print $F <<EOF; +sub $_() { + N($s); +} +EOF + my @nb = $main =~ /\%s/g; @nb == @inside or die "help.pm error: bad \%s in sub $_\n"; + } +} + +# i don't like the default tree format given by XML::Parser, +# rewrite it in my own tree format +sub rewrite1 { + my ($tag, $tree) = @_; + my ($attr, @nodes) = @$tree; + my @l; + while (@nodes) { + my ($tag, $tree) = splice(@nodes, 0, 2); + if ($tag eq '0') { + foreach ($tree) { + s/\s+/ /gs; + s/"/\\"/g; + s/\x{ad}//g; + s/\x{2013}/-/g; + } + push @l, $tree + } elsif ($tag eq 'screen') { + $tree->[1] eq '0' or die "screen tag contains non CDATA\n"; + push @l, $tree->[2]; + } else { + push @l, rewrite1($tag, $tree); + } + } + { attr => $attr, tag => lc $tag, children => \@l }; +} + +# return the list of nodes named $tag +sub find_tag { + my ($tag, $tree) = @_; + if (!ref($tree)) { + (); + } elsif ($tree->{tag} eq $tag) { + $tree; + } else { + map { find_tag($tag, $_) } @{$tree->{children}}; + } +} + +my $help; +sub rewrite2 { + my ($tree, $lang) = @_; + our $i18ned_open_text_quote = $ {{ + fr => "« ", + de => "„", + es => "\\\"", + it => "\\\"", + zh_cn => "“" + }}{$lang}; + our $i18ned_close_text_quote = $ {{ + fr => " »", + de => "“", + es => "\\\"", + it => "\\\"", + zh_cn => "”" + }}{$lang}; + our $i18ned_open_label_quote = $ {{ fr => "« ", de => "„", zh_cn => "“"}}{$lang}; + our $i18ned_close_label_quote = $ {{ fr => " »", de => "“", zh_cn => "”"}}{$lang}; + our $i18ned_open_command_quote = $ {{ fr => "« ", de => "„", zh_cn => "“"}}{$lang}; + our $i18ned_close_command_quote = $ {{ fr => " »", de => "“", zh_cn => "”"}}{$lang}; + our $i18ned_open_input_quote = $ {{ fr => "« ", de => "»", zh_cn => "“"}}{$lang}; + our $i18ned_close_input_quote = $ {{ fr => " »", de => "«", zh_cn => "”"}}{$lang}; + our $i18ned_open_key_quote = $ {{ de => "["}}{$lang}; + our $i18ned_close_key_quote = $ {{ de => "]"}}{$lang}; + # rewrite2_ fills in $help + $help = {}; + rewrite2_($tree); + $help; +} + +sub rewrite2_ { + my ($tree, @parents) = @_; + ref($tree) or return $tree; + !$tree->{attr}{condition} || $tree->{attr}{condition} !~ /no-inline-help/ or return ''; + + my ($id) = $tree->{attr}{id} ? $tree->{attr}{id} =~ /drakxid-([^-]+)$/ : (); + + my @inside_strings; + my $text = do { + my @l = map { + my ($s, @l) = rewrite2_($_, $tree, @parents); + push @inside_strings, @l; + $s; + } @{$tree->{children}}; + my $text = ""; + foreach (@l) { + s/^ // if $text =~ /\s$/; + $text =~ s/ $// if /^\s/; + $text =~ s/\n+$// if /^\n/; + $text .= $_; + } + $text; + }; + + if ($id) { + my $t = $text; + $t =~ s/^\s+//; + + my @footnotes = map { + my ($s, @l) = rewrite2_({ %$_, tag => 'para' }); + push @inside_strings, @l; + $s =~ s/^\s+//; + "(*) $s"; + } find_tag('footnote', $tree); + $help->{$id} = [ aerate($t . join('', @footnotes)), @inside_strings ]; + return ''; + } + + my $text_ = do { + if (0) { + } elsif (member($tree->{tag}, 'formalpara', 'para', 'itemizedlist', 'orderedlist')) { + $text =~ s/^\s(?!\s)//; + $text =~ s/^( ?\n)+//; + $text =~ s/\s+$//; + qq(\n$text\n); + } elsif (member($tree->{tag}, 'quote', 'citetitle', 'foreignphrase')) { + $text =~ s/^\Q$i18ned_open_label_quote\E(.*)\Q$i18ned_close_label_quote\E$/$1/ if $i18ned_open_label_quote; + ($i18ned_open_text_quote || "``") . $text . ($i18ned_close_text_quote || "''"); + } elsif (member($tree->{tag}, 'literal', 'filename')) { + ($i18ned_open_label_quote || "\\\"") . $text . ($i18ned_close_label_quote || "\\\""); + } elsif (member($tree->{tag}, 'guilabel', 'guibutton', 'guimenu')) { + $text =~ s/\s+$//; + push @inside_strings, $text; + ($i18ned_open_label_quote || "\\\"") . "%s" . ($i18ned_close_label_quote || "\\\""); + } elsif ($tree->{tag} eq 'command') { + ($i18ned_open_command_quote || "\\\"") . $text . ($i18ned_close_command_quote || "\\\""); + } elsif ($tree->{tag} eq 'userinput') { + ($i18ned_open_input_quote || ">>") . $text . ($i18ned_close_input_quote || "<<"); + } elsif ($tree->{tag} eq 'keycap') { + ($i18ned_open_key_quote || "[") . $text . ($i18ned_close_key_quote || "]"); + } elsif (member($tree->{tag}, 'keysym')) { + qq($text); + } elsif (member($tree->{tag}, 'footnote')) { + '(*)' + } elsif ($tree->{tag} eq 'warning') { + $text =~ s/^(\s+)/$1!! /; + $text =~ s/(\s+)$/ !!$1/; + $text; + } elsif ($tree->{tag} eq 'listitem') { + my $cnt = (any { $_->{tag} eq 'variablelist' } @parents) ? 1 : 0; + $text =~ s/^\s+//; + $text =~ s/^/' ' . ($cnt++ ? ' ' : '* ')/emg; + "\n$text\n"; + } elsif (member($tree->{tag}, + 'acronym', 'application', 'emphasis', + 'keycombo', 'note', 'sect1', 'sect2', 'sect3', + 'superscript', 'systemitem', 'option', + 'tip', 'ulink', 'xref', 'varlistentry', 'variablelist', 'term', + 'phrase', 'hardware', 'procedure', 'step', 'bridgehead', + )) { + # ignored tags + $text; + } elsif (member($tree->{tag}, + qw(title article primary secondary indexterm revnumber + date authorinitials revision revhistory revremark chapterinfo + imagedata imageobject mediaobject figure + abstract book chapter) + )) { + # dropped tags + @inside_strings = (); + ''; + } elsif ($tree->{tag} eq 'screen') { + qq(\n$text\n); + } else { + warn "unknown tag $tree->{tag}\n"; + } + }; + $text_, @inside_strings; +} + +sub aerate { + my ($s) = @_; + #- the warp_text column is adjusted so that xgettext do not wrap text around + #- which cause msgmerge to add a lot of fuzzy + my $s2 = join("\n\n", map { join("\n", warp_text($_, 75)) } split "\n", $s); + $s2; +} + +sub template { + my ($lang, @l) = @_; + my $entities = join("\n", map { qq(<!ENTITY $_ SYSTEM '$_.xml'>) } @l); + my $body = join("\n", map { '&' . $_ . ';' } @l); + + <<EOF; +<?xml version='1.0' encoding='ISO-8859-1'?> + +<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.1.2//EN" +"/usr/share/sgml/docbook/xml-dtd-4.1.2/docbookx.dtd"[ + +$entities + +<!ENTITY % params.ent SYSTEM "../../manuals/Starter/$lang/params.ent"> +%params.ent; +<!ENTITY % strings.ent SYSTEM "../../manuals/Starter/$lang/strings.ent"> +%strings.ent; + +<!ENTITY step-only-for-expert ""> + +<!ENTITY % acronym-list SYSTEM "../../entities/$lang/acronym_list.ent" > +%acronym-list; +<!ENTITY % button-list SYSTEM "../../entities/$lang/button_list.ent" > +%button-list; +<!ENTITY % companies SYSTEM "../../entities/$lang/companies.ent" > +%companies; +<!ENTITY % menu-list SYSTEM "../../entities/$lang/menu_list.ent" > +%menu-list; +<!ENTITY % tech SYSTEM "../../entities/$lang/tech.ent" > +%tech; +<!ENTITY % titles SYSTEM "../../entities/$lang/titles.ent" > +%titles; +<!ENTITY % typo SYSTEM "../../entities/$lang/typo.ent" > +%typo; +<!ENTITY % common SYSTEM "../../entities/common.ent" > +%common; +<!ENTITY % common-acronyms SYSTEM "../../entities/common_acronyms.ent" > +%common-acronyms; +<!ENTITY % prog-list SYSTEM "../../entities/prog_list.ent" > +%prog-list; + +<!ENTITY lang '$lang'> + +]> + +<book> + <title>DrakX Documentation</title> + +$body + +</book> +EOF + +} |