diff options
Diffstat (limited to 'man/po4a/Locale/Po4a/Manext.pm')
| -rw-r--r-- | man/po4a/Locale/Po4a/Manext.pm | 229 |
1 files changed, 229 insertions, 0 deletions
diff --git a/man/po4a/Locale/Po4a/Manext.pm b/man/po4a/Locale/Po4a/Manext.pm new file mode 100644 index 0000000..bc939cf --- /dev/null +++ b/man/po4a/Locale/Po4a/Manext.pm @@ -0,0 +1,229 @@ +#! /usr/bin/perl -w + +=encoding UTF-8 + +=head1 NAME + +Locale::Po4a::Manext - private extended version of Locale::Po4a::Man + +=head1 DESCRIPTION + +Extended version of Locale::Po4a::Man that copes with a few intricacies of +man-db's manual pages, until such time as these are incorporated into po4a +proper. + +=head1 SEE ALSO + +L<Locale::Po4a::Man(3pm)>. + +=head1 AUTHOR + + Colin Watson <cjwatson@debian.org> + +=head1 COPYRIGHT AND LICENCE + +Copyright 2011 Colin Watson. + +man-db 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. + +man-db 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 man-db; if not, write to the Free Software Foundation, +Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +=cut + +package Locale::Po4a::Manext; + +use 5.006; +use strict; +use warnings; + +use vars qw(@ISA); +@ISA = qw(Locale::Po4a::Man); + +use version; + +use Locale::Po4a::Man; +use Locale::Po4a::TransTractor; + +sub initialize { + my $self = shift; + $self->SUPER::initialize(@_); + + $self->{manext_shift_tbl_state} = 0; + $self->{manext_shift_tbl_lines} = []; + $self->{manext_push_tbl_state} = 0; + $self->{manext_push_tbl_line} = ''; +} + +sub _parse_version { + # Parse a po4a version string. Unfortunately these aren't always + # directly parseable using version->parse, because they may have more + # than two components without a leading "v". + my $version = shift; + $version = "v$version" unless $version =~ /^v/; + return version->parse($version); +} + +sub shiftline { + my $self = shift; + + if (_parse_version($Locale::Po4a::TransTractor::VERSION) >= 'v0.47') { + return $self->SUPER::shiftline(); + } + + my ($line, $ref); + + if (@{$self->{manext_shift_tbl_lines}}) { + ($line, $ref) = @{shift @{$self->{manext_shift_tbl_lines}}}; + return ($line, $ref); + } + +NEXT_LINE: + ($line, $ref) = $self->SUPER::shiftline(); + + if (!defined $line) { + # end of file + return ($line, $ref); + } + + if ($line =~ /^\.TS/) { + $self->{manext_shift_tbl_state} = 1; + } elsif ($line =~ /^\.TE/) { + $self->{manext_shift_tbl_state} = 0; + } elsif ($self->{manext_shift_tbl_state} == 1) { + if ($line =~ /\.$/) { + $self->{manext_shift_tbl_state} = 2; + } + } elsif ($self->{manext_shift_tbl_state} == 2) { + # Theoretically s/@/\t/g should be enough, but for some reason + # Locale::Po4a::Man splits on /\\t/ rather than on /\t/. + if ($line =~ /T\{$/) { + my ($l2, $r2) = $self->SUPER::shiftline(); + while (defined $l2) { + $line .= $l2; + last if $l2 =~ /^T\}/; + ($l2, $r2) = $self->SUPER::shiftline(); + } + } + if ($line =~ /@/) { + for my $column (split /@/, $line) { + next if $column =~ /^$/m; + push @{$self->{manext_shift_tbl_lines}}, [$column, $ref]; + } + ($line, $ref) = @{shift @{$self->{manext_shift_tbl_lines}}}; + return ($line, $ref); + } + } + + return ($line, $ref); +} + +sub pushline { + my ($self, $line) = (shift, shift); + + if (_parse_version($Locale::Po4a::TransTractor::VERSION) >= 'v0.47') { + $self->SUPER::pushline($line); + return; + } + + if ($line =~ /^\.TS/) { + $self->{manext_push_tbl_state} = 1; + } elsif ($line =~ /^\.TE/) { + $self->{manext_push_tbl_state} = 0; + } elsif ($self->{manext_push_tbl_state} == 1) { + if ($line =~ /\.$/) { + $self->{manext_push_tbl_state} = 2; + } + } elsif ($self->{manext_push_tbl_state} == 2) { + if (length $self->{manext_push_tbl_line}) { + $self->{manext_push_tbl_line} .= '@'; + } + $self->{manext_push_tbl_line} .= $line; + if ($self->{manext_push_tbl_line} =~ /\n$/) { + $self->SUPER::pushline($self->{manext_push_tbl_line}); + $self->{manext_push_tbl_line} = ''; + } + return; + } + + $self->SUPER::pushline($line); +} + +sub translate { + my ($self, $str, $ref, $type) = (shift, shift, shift, shift); + my %options = @_; + + if (defined $type and $type eq 'tbl table') { + if (_parse_version($Locale::Po4a::TransTractor::VERSION) < 'v0.47') { + if ($str =~ /^T\{\n?(.*)T\}(\n?)$/s) { + my $inner = $1; + chomp $inner; + return "T{\n" . + $self->SUPER::translate($inner, $ref, $type, %options) . + "\nT}$2"; + } + } else { + my $postline = ''; + if (chomp $str) { + $postline = "\n"; + } + if ($str =~ /@/) { + return join('@', map { + $self->translate($_, $ref, 'tbl table manext') + } split (/@/, $str, -1)) . $postline; + } else { + return $self->translate($str, $ref, 'tbl table manext') . + $postline; + } + } + } + + if (defined $type and $type =~ /^tbl table(?: manext)$/) { + # Do not translate horizontal rules. + return $str if $str =~ /^[-_=]$/; + + # Do not translate table entries that consist only of numbers (e.g. + # the sections table in man(1)). + return $str if $str =~ /^[0-9]+$/; + + # Do not translate table entries that consist only of a groff + # special character or escape (e.g. the --ascii translation table in + # man(1)). + if ($str =~ /^\\[^([]$/ or # e.g. \` + $str =~ /^\\\(..$/ or # e.g. \(bu + $str =~ /^\\\[.*?\]$/ or # e.g. \[bu] + $str =~ /^\\[^([][^([]$/ or # e.g. \fB + $str =~ /^\\[^([]\(..$/ or # e.g. \n(XX + $str =~ /^\\[^([]\[.*?\]$/) { # e.g. \*[softhyphen] + return $str; + } + + # Do not translate "latin1" and "ascii" (from the --ascii + # translation table in man(1)). + return $str if $str =~ /^(?:latin1|ascii)$/; + + # Do not translate symbols used in the --ascii translation table in + # man(1). + return $str if $str =~ /^[o'x]$/; + + $type =~ s/ manext$//; + } + + if (not defined $type and $self->{type} eq 'TH') { + # Do not translate page names and other similar headings. + return $str if $str =~ /^%.*%$/ or $str =~ /^[A-Z]+$/; + } + + return $self->SUPER::translate($str, $ref, $type, %options); +} + +1; |