summaryrefslogtreecommitdiff
path: root/perl/Locale/Po4a/Text.pm
blob: 0cc2cc82f93f17d6ba0090e0e6b8a0f7ea28d0a5 (plain)
  1. #!/usr/bin/perl -w
  2. # Po4a::Text.pm
  3. # extract and translate translatable strings from a text documents
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or
  8. # (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. # GNU General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc.,
  18. # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19. #
  20. ########################################################################
  21. =head1 NAME
  22. Locale::Po4a::Text - Convert text documents from/to PO files
  23. =head1 DESCRIPTION
  24. The po4a (po for anything) project goal is to ease translations (and more
  25. interestingly, the maintenance of translations) using gettext tools on
  26. areas where they were not expected like documentation.
  27. Locale::Po4a::Text is a module to help the translation of text documents into
  28. other [human] languages.
  29. Paragraphs are splitted on empty lines (or lines containing only spaces or
  30. tabulations).
  31. If a paragraph contains a line starting by a space (or tabulation), this
  32. paragraph won't be rewrapped.
  33. =cut
  34. package Locale::Po4a::Text;
  35. use 5.006;
  36. use strict;
  37. use warnings;
  38. require Exporter;
  39. use vars qw(@ISA @EXPORT);
  40. @ISA = qw(Locale::Po4a::TransTractor);
  41. @EXPORT qw();
  42. use Locale::Po4a::TransTractor;
  43. use Locale::Po4a::Common;
  44. =head1 OPTIONS ACCEPTED BY THIS MODULE
  45. These are this module's particular options:
  46. =over
  47. =item B<nobullet>
  48. Deactivate detection of bullets.
  49. By default, when a bullet is detected, the bullet paragraph is not considered
  50. as a verbatim paragraph (with the no-wrap flag in the PO file), but the module
  51. rewrap this paragraph in the generated PO file and in the translation.
  52. =cut
  53. my $bullets 1;
  54. =item B<debianchangelog>
  55. Handle the header and footer of
  56. released versions, which only contain non translatable informations.
  57. =cut
  58. my $debianchangelog 0;
  59. =item B<fortunes>
  60. Handle the fortunes format, which separate fortunes with a line which
  61. consists in '%' or '%%', and use '%%' as the beginning of a comment.
  62. =cut
  63. my $fortunes 0;
  64. =item B<markdown>
  65. Handle some special markup in Markdown-formatted texts.
  66. =cut
  67. my $markdown 0;
  68. sub initialize {
  69.     my $self shift;
  70.     my %options @_;
  71.     $self->{options}{'nobullets'}='';
  72.     if (defined $options{'nobullets'}) {
  73.         $bullets 0;
  74.     }
  75.     if (defined $options{'debianchangelog'}) {
  76.         $debianchangelog=1;
  77.     }
  78.     if (defined $options{'fortunes'}) {
  79.         $fortunes=1;
  80.     }
  81.     if (defined $options{'markdown'}) {
  82.         $markdown=1;
  83.     }
  84. }
  85. sub parse {
  86.     my $self shift;
  87.     my ($line,$ref);
  88.     my $paragraph="";
  89.     my $wrapped_mode 1;
  90.     my $expect_header 1;
  91.     my $end_of_paragraph 0;
  92.     ($line,$ref)=$self->shiftline();
  93.     my $file $ref;
  94.     $file =~ s/:[0-9]+$//;
  95.     while (defined($line)) {
  96.         $ref =~ m/^(.*):[0-9]+$/;
  97.         if ($1 ne $file) {
  98.             $file $1;
  99.             do_paragraph($self,$paragraph,$wrapped_mode);
  100.             $paragraph="";
  101.             $wrapped_mode 1;
  102.             $expect_header 1;
  103.         }
  104.         # TODO: preserve original line ends throughout the code instead
  105.         chomp($line);
  106.         $self->{ref}="$ref";
  107.         if ($debianchangelog and
  108.             $expect_header and
  109.             $line =~ /^(\w[-+0-9a-z.]*)\ \(([^\(\\t]+)\# src, version
  110.                        \s+([-+0-9a-z.]+);                 # distribution
  111.                        \s*urgency\s*\=\s*(.*\S)\s*$/ix) { #
  112.             do_paragraph($self,$paragraph,$wrapped_mode);
  113.             $paragraph="";
  114.             $self->pushline("$line\n");
  115.             $expect_header=0;
  116.         elsif ($debianchangelog and
  117.                  $line =~ m/^ \-\- (.*) <(.*)> ((\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)$/) {
  118.             # Found trailer
  119.             do_paragraph($self,$paragraph,$wrapped_mode);
  120.             $paragraph="";
  121.             $self->pushline("$line\n");
  122.             $expect_header=1;
  123.         elsif ($fortunes and
  124.                  $line =~ m/^%%?\s*$/) {
  125.             # Found end of fortune
  126.             do_paragraph($self,$paragraph,$wrapped_mode);
  127.             # FIXME: test if this is still needed when always adding
  128.             #        newline in do_paragraph()
  129.             $self->pushline("\n"unless (   $wrapped_mode == 0
  130.                                           or $paragraph eq "");
  131.             $paragraph="";
  132.             $wrapped_mode 1;
  133.             $self->pushline("$line\n");
  134.         elsif ($line =~ /^\s*$/) {
  135.             # Break paragraphs on lines containing only spaces
  136.             do_paragraph($self,$paragraph,$wrapped_mode);
  137.             $paragraph="";
  138.             $wrapped_mode 1;
  139.             $self->pushline($line."\n");
  140.         elsif ($line =~ /^-- $/) {
  141.             # Break paragraphs on email signature hint
  142.             do_paragraph($self,$paragraph,$wrapped_mode);
  143.             $paragraph="";
  144.             $wrapped_mode 1;
  145.             $self->pushline($line."\n");
  146.         elsif (   $line =~ /^=+$/
  147.                  or $line =~ /^_+$/
  148.                  or $line =~ /^-+$/) {
  149.             $wrapped_mode 0;
  150.             $paragraph .= $line."\n";
  151.             do_paragraph($self,$paragraph,$wrapped_mode);
  152.             $paragraph="";
  153.             $wrapped_mode 1;
  154.         elsif ($markdown and
  155.                  (   $line =~ /^\s*\[\[\!\S+\s*$/     # macro begin
  156.                  or $line =~ /^\s*"""\s*\]\]\s*$/)) { # """ textblock inside macro end
  157.             # Avoid translating Markdown lines containing only markup
  158.             do_paragraph($self,$paragraph,$wrapped_mode);
  159.             $paragraph="";
  160.             $wrapped_mode 1;
  161.             $self->pushline("$line\n");
  162.         elsif ($markdown and
  163.                  (   $line =~ /^#/            # headline
  164.                   or $line =~ /^\s*\[\[\!\S[^\]]*\]\]\s*$/)) { # sole macro
  165.             # Preserve some Markdown markup as a single line
  166.             do_paragraph($self,$paragraph,$wrapped_mode);
  167.             $paragraph="$line\n";
  168.             $wrapped_mode 0;
  169.             $end_of_paragraph 1;
  170.         elsif ($markdown and
  171.                  (   $line =~ /^"""/)) { # """ textblock inside macro end
  172.             # Markdown markup needing separation _before_ this line
  173.             do_paragraph($self,$paragraph,$wrapped_mode);
  174.             $paragraph="$line\n";
  175.             $wrapped_mode 1;
  176.         else {
  177.             if ($line =~ /^\s/) {
  178.                 # A line starting by a space indicates a non-wrap
  179.                 # paragraph
  180.                 $wrapped_mode 0;
  181.             elsif ($markdown and
  182.                      (   $line =~ /\S $/    # explicit newline
  183.                       or $line =~ /"""$/)) { # """ textblock inside macro begin
  184.                 # Markdown markup needing separation _after_ this line
  185.                 $end_of_paragraph 1;
  186.             }
  187.             if ($fortunes) {
  188.                 $line =~ s/%%(.*)$//;
  189.             }
  190. # TODO: comments
  191.             $paragraph .= $line."\n";
  192.         }
  193.         # paragraphs starting by a bullet, or numbered
  194.         # or paragraphs with a line containing many consecutive spaces
  195.         # (more than 3)
  196.         # are considered as verbatim paragraphs
  197.         $wrapped_mode if (   $paragraph =~ m/^(\*|[0-9]+[.)] )/s
  198.                           or $paragraph =~ m/[ \t][ \t][ \t]/s);
  199.         if ($markdown) {
  200.             # Some Markdown markup can (or might) not survive wrapping
  201.             $wrapped_mode if (
  202.                    $paragraph =~ /^>/ms                  # blockquote
  203.                 or $paragraph =~ /^( {8}|\t)/ms          # monospaced
  204.                 or $paragraph =~ /^\$(\S+[{}]\S*\s*)+/ms # Xapian macro
  205.                 or $paragraph =~ /[<>]/ms                # maybe html
  206.                 or $paragraph =~ /^\s*\[\[\!\S[^\]]+$/ms # macro begin
  207.             );
  208.         }
  209.         if ($end_of_paragraph) {
  210.             do_paragraph($self,$paragraph,$wrapped_mode);
  211.             $paragraph="";
  212.             $wrapped_mode 1;
  213.             $end_of_paragraph 0;
  214.         }
  215.         ($line,$ref)=$self->shiftline();
  216.     }
  217.     if (length $paragraph) {
  218.         do_paragraph($self,$paragraph,$wrapped_mode);
  219.     }
  220. }
  221. sub do_paragraph {
  222.     my ($self$paragraph$wrap) = (shiftshiftshift);
  223.     return if ($paragraph eq "");
  224.     if ($bullets) {
  225.         # Detect bullets
  226.         # |        * blah blah
  227.         # |<spaces>  blah
  228.         # |          ^-- aligned
  229.         # <empty line>
  230.         #
  231.         # Other bullets supported:
  232.         # - blah         o blah         + blah
  233.         # 1. blah       1) blah       (1) blah
  234. TEST_BULLET:
  235.         if ($paragraph =~ m/^(\s*)((?:[-*o+]|([0-9]+[.\)])|\([0-9]+\))\s+)([^\n]*\n)(.*)$/s) {
  236.             my $para $5;
  237.             my $bullet $2;
  238.             my $indent1 $1;
  239.             my $indent2 "$1".(' ' x length $bullet);
  240.             my $text $4;
  241.             while ($para !~ m/$indent2(?:[-*o+]|([0-9]+[.\)])|\([0-9]+\))\s+/
  242.                    and $para =~ s/^$indent2(\S[^\n]*\n)//s) {
  243.                 $text .= $1;
  244.             }
  245.             # TODO: detect if a line starts with the same bullet
  246.             if ($text !~ m/\S[ \t][ \t][ \t]+\S/s) {
  247.                 my $bullet_regex quotemeta($indent1.$bullet);
  248.                 $bullet_regex =~ s/[0-9]+/\\d\+/;
  249.                 if ($para eq '' or $para =~ m/^$bullet_regex\S/s) {
  250.                     my $trans $self->translate($text,
  251.                                                  $self->{