rev |
line source |
dongsheng@623
|
1 # Locale::Po4a::Po -- manipulation of po files
|
dongsheng@623
|
2 # $Id: Po.pm,v 1.95 2009-02-28 22:18:39 nekral-guest Exp $
|
dongsheng@623
|
3 #
|
dongsheng@623
|
4 # This program is free software; you may redistribute it and/or modify it
|
dongsheng@623
|
5 # under the terms of GPL (see COPYING).
|
dongsheng@623
|
6
|
dongsheng@623
|
7 ############################################################################
|
dongsheng@623
|
8 # Modules and declarations
|
dongsheng@623
|
9 ############################################################################
|
dongsheng@623
|
10
|
dongsheng@623
|
11 =head1 NAME
|
dongsheng@623
|
12
|
dongsheng@623
|
13 Locale::Po4a::Po - po file manipulation module
|
dongsheng@623
|
14
|
dongsheng@623
|
15 =head1 SYNOPSIS
|
dongsheng@623
|
16
|
dongsheng@623
|
17 use Locale::Po4a::Po;
|
dongsheng@623
|
18 my $pofile=Locale::Po4a::Po->new();
|
dongsheng@623
|
19
|
dongsheng@623
|
20 # Read po file
|
dongsheng@623
|
21 $pofile->read('file.po');
|
dongsheng@623
|
22
|
dongsheng@623
|
23 # Add an entry
|
dongsheng@623
|
24 $pofile->push('msgid' => 'Hello', 'msgstr' => 'bonjour',
|
dongsheng@623
|
25 'flags' => "wrap", 'reference'=>'file.c:46');
|
dongsheng@623
|
26
|
dongsheng@623
|
27 # Extract a translation
|
dongsheng@623
|
28 $pofile->gettext("Hello"); # returns 'bonjour'
|
dongsheng@623
|
29
|
dongsheng@623
|
30 # Write back to a file
|
dongsheng@623
|
31 $pofile->write('otherfile.po');
|
dongsheng@623
|
32
|
dongsheng@623
|
33 =head1 DESCRIPTION
|
dongsheng@623
|
34
|
dongsheng@623
|
35 Locale::Po4a::Po is a module that allows you to manipulate message
|
dongsheng@623
|
36 catalogs. You can load and write from/to a file (which extension is often
|
dongsheng@623
|
37 I<po>), you can build new entries on the fly or request for the translation
|
dongsheng@623
|
38 of a string.
|
dongsheng@623
|
39
|
dongsheng@623
|
40 For a more complete description of message catalogs in the po format and
|
dongsheng@623
|
41 their use, please refer to the documentation of the gettext program.
|
dongsheng@623
|
42
|
dongsheng@623
|
43 This module is part of the PO4A project, which objective is to use po files
|
dongsheng@623
|
44 (designed at origin to ease the translation of program messages) to
|
dongsheng@623
|
45 translate everything, including documentation (man page, info manual),
|
dongsheng@623
|
46 package description, debconf templates, and everything which may benefit
|
dongsheng@623
|
47 from this.
|
dongsheng@623
|
48
|
dongsheng@623
|
49 =head1 OPTIONS ACCEPTED BY THIS MODULE
|
dongsheng@623
|
50
|
dongsheng@623
|
51 =over 4
|
dongsheng@623
|
52
|
dongsheng@623
|
53 =item porefs
|
dongsheng@623
|
54
|
dongsheng@623
|
55 This specifies the reference format. It can be one of 'none' to not produce
|
dongsheng@623
|
56 any reference, 'noline' to not specify the line number, and 'full' to
|
dongsheng@623
|
57 include complete references.
|
dongsheng@623
|
58
|
dongsheng@623
|
59 =back
|
dongsheng@623
|
60
|
dongsheng@623
|
61 =cut
|
dongsheng@623
|
62
|
dongsheng@623
|
63 use IO::File;
|
dongsheng@623
|
64
|
dongsheng@623
|
65
|
dongsheng@623
|
66 require Exporter;
|
dongsheng@623
|
67
|
dongsheng@623
|
68 package Locale::Po4a::Po;
|
dongsheng@623
|
69 use DynaLoader;
|
dongsheng@623
|
70
|
dongsheng@623
|
71 use Locale::Po4a::Common qw(wrap_msg wrap_mod wrap_ref_mod dgettext);
|
dongsheng@623
|
72
|
dongsheng@623
|
73 use subs qw(makespace);
|
dongsheng@623
|
74 use vars qw(@ISA @EXPORT_OK);
|
dongsheng@623
|
75 @ISA = qw(Exporter DynaLoader);
|
dongsheng@623
|
76 @EXPORT = qw(%debug);
|
dongsheng@623
|
77 @EXPORT_OK = qw(&move_po_if_needed);
|
dongsheng@623
|
78
|
dongsheng@623
|
79 use Locale::Po4a::TransTractor;
|
dongsheng@623
|
80 # Try to use a C extension if present.
|
dongsheng@623
|
81 eval("bootstrap Locale::Po4a::Po $Locale::Po4a::TransTractor::VERSION");
|
dongsheng@623
|
82
|
dongsheng@623
|
83 use 5.006;
|
dongsheng@623
|
84 use strict;
|
dongsheng@623
|
85 use warnings;
|
dongsheng@623
|
86
|
dongsheng@623
|
87 use Carp qw(croak);
|
dongsheng@623
|
88 use File::Path; # mkdir before write
|
dongsheng@623
|
89 use File::Copy; # move
|
dongsheng@623
|
90 use POSIX qw(strftime floor);
|
dongsheng@623
|
91 use Time::Local;
|
dongsheng@623
|
92
|
dongsheng@623
|
93 use Encode;
|
dongsheng@623
|
94
|
dongsheng@623
|
95 my @known_flags=qw(wrap no-wrap c-format fuzzy);
|
dongsheng@623
|
96
|
dongsheng@623
|
97 our %debug=('canonize' => 0,
|
dongsheng@623
|
98 'quote' => 0,
|
dongsheng@623
|
99 'escape' => 0,
|
dongsheng@623
|
100 'encoding' => 0,
|
dongsheng@623
|
101 'filter' => 0);
|
dongsheng@623
|
102
|
dongsheng@623
|
103 =head1 Functions about whole message catalogs
|
dongsheng@623
|
104
|
dongsheng@623
|
105 =over 4
|
dongsheng@623
|
106
|
dongsheng@623
|
107 =item new()
|
dongsheng@623
|
108
|
dongsheng@623
|
109 Creates a new message catalog. If an argument is provided, it's the name of
|
dongsheng@623
|
110 a po file we should load.
|
dongsheng@623
|
111
|
dongsheng@623
|
112 =cut
|
dongsheng@623
|
113
|
dongsheng@623
|
114 sub new {
|
dongsheng@623
|
115 my ($this, $options) = (shift, shift);
|
dongsheng@623
|
116 my $class = ref($this) || $this;
|
dongsheng@623
|
117 my $self = {};
|
dongsheng@623
|
118 bless $self, $class;
|
dongsheng@623
|
119 $self->initialize($options);
|
dongsheng@623
|
120
|
dongsheng@623
|
121 my $filename = shift;
|
dongsheng@623
|
122 $self->read($filename) if defined($filename) && length($filename);
|
dongsheng@623
|
123 return $self;
|
dongsheng@623
|
124 }
|
dongsheng@623
|
125
|
dongsheng@623
|
126 # Return the numerical timezone (e.g. +0200)
|
dongsheng@623
|
127 # Neither the %z nor the %s formats of strftime are portable:
|
dongsheng@623
|
128 # '%s' is not supported on Solaris and '%z' indicates
|
dongsheng@623
|
129 # "2006-10-25 19:36E. Europe Standard Time" on MS Windows.
|
dongsheng@623
|
130 sub timezone {
|
dongsheng@623
|
131 my @g = gmtime();
|
dongsheng@623
|
132 my @l = localtime();
|
dongsheng@623
|
133
|
dongsheng@623
|
134 my $diff;
|
dongsheng@623
|
135 $diff = floor(timelocal(@l)/60 +0.5);
|
dongsheng@623
|
136 $diff -= floor(timelocal(@g)/60 +0.5);
|
dongsheng@623
|
137
|
dongsheng@623
|
138 my $h = floor($diff / 60) + $l[8]; # $l[8] indicates if we are currently
|
dongsheng@623
|
139 # in a daylight saving time zone
|
dongsheng@623
|
140 my $m = $diff%60;
|
dongsheng@623
|
141
|
dongsheng@623
|
142 return sprintf "%+03d%02d\n", $h, $m;
|
dongsheng@623
|
143 }
|
dongsheng@623
|
144
|
dongsheng@623
|
145 sub initialize {
|
dongsheng@623
|
146 my ($self, $options) = (shift, shift);
|
dongsheng@623
|
147 my $date = strftime("%Y-%m-%d %H:%M", localtime).timezone();
|
dongsheng@623
|
148 chomp $date;
|
dongsheng@623
|
149 # $options = ref($options) || $options;
|
dongsheng@623
|
150
|
dongsheng@623
|
151 $self->{options}{'porefs'}= 'full';
|
dongsheng@623
|
152 $self->{options}{'msgid-bugs-address'}= undef;
|
dongsheng@623
|
153 $self->{options}{'copyright-holder'}= "Free Software Foundation, Inc.";
|
dongsheng@623
|
154 $self->{options}{'package-name'}= "PACKAGE";
|
dongsheng@623
|
155 $self->{options}{'package-version'}= "VERSION";
|
dongsheng@623
|
156 foreach my $opt (keys %$options) {
|
dongsheng@623
|
157 if ($options->{$opt}) {
|
dongsheng@623
|
158 die wrap_mod("po4a::po",
|
dongsheng@623
|
159 dgettext ("po4a", "Unknown option: %s"), $opt)
|
dongsheng@623
|
160 unless exists $self->{options}{$opt};
|
dongsheng@623
|
161 $self->{options}{$opt} = $options->{$opt};
|
dongsheng@623
|
162 }
|
dongsheng@623
|
163 }
|
dongsheng@623
|
164 $self->{options}{'porefs'} =~ /^(full|noline|none)$/ ||
|
dongsheng@623
|
165 die wrap_mod("po4a::po",
|
dongsheng@623
|
166 dgettext ("po4a",
|
dongsheng@623
|
167 "Invalid value for option 'porefs' ('%s' is ".
|
dongsheng@623
|
168 "not one of 'full', 'noline' or 'none')"),
|
dongsheng@623
|
169 $self->{options}{'porefs'});
|
dongsheng@623
|
170
|
dongsheng@623
|
171 $self->{po}=();
|
dongsheng@623
|
172 $self->{count}=0; # number of msgids in the PO
|
dongsheng@623
|
173 # count_doc: number of strings in the document
|
dongsheng@623
|
174 # (duplicate strings counted multiple times)
|
dongsheng@623
|
175 $self->{count_doc}=0;
|
dongsheng@623
|
176 $self->{header_comment}=
|
dongsheng@623
|
177 " SOME DESCRIPTIVE TITLE\n"
|
dongsheng@623
|
178 ." Copyright (C) YEAR ".
|
dongsheng@623
|
179 $self->{options}{'copyright-holder'}."\n"
|
dongsheng@623
|
180 ." This file is distributed under the same license ".
|
dongsheng@623
|
181 "as the ".$self->{options}{'package-name'}." package.\n"
|
dongsheng@623
|
182 ." FIRST AUTHOR <EMAIL\@ADDRESS>, YEAR.\n"
|
dongsheng@623
|
183 ."\n"
|
dongsheng@623
|
184 .", fuzzy";
|
dongsheng@623
|
185 # $self->header_tag="fuzzy";
|
dongsheng@623
|
186 $self->{header}=escape_text("Project-Id-Version: ".
|
dongsheng@623
|
187 $self->{options}{'package-name'}." ".
|
dongsheng@623
|
188 $self->{options}{'package-version'}."\n".
|
dongsheng@623
|
189 ((defined $self->{options}{'msgid-bugs-address'})?
|
dongsheng@623
|
190 "Report-Msgid-Bugs-To: ".$self->{options}{'msgid-bugs-address'}."\n":
|
dongsheng@623
|
191 "").
|
dongsheng@623
|
192 "POT-Creation-Date: $date\n".
|
dongsheng@623
|
193 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n".
|
dongsheng@623
|
194 "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\n".
|
dongsheng@623
|
195 "Language-Team: LANGUAGE <LL\@li.org>\n".
|
dongsheng@623
|
196 "MIME-Version: 1.0\n".
|
dongsheng@623
|
197 "Content-Type: text/plain; charset=CHARSET\n".
|
dongsheng@623
|
198 "Content-Transfer-Encoding: ENCODING");
|
dongsheng@623
|
199
|
dongsheng@623
|
200 $self->{encoder}=find_encoding("ascii");
|
dongsheng@623
|
201
|
dongsheng@623
|
202 # To make stats about gettext hits
|
dongsheng@623
|
203 $self->stats_clear();
|
dongsheng@623
|
204 }
|
dongsheng@623
|
205
|
dongsheng@623
|
206 =item read($)
|
dongsheng@623
|
207
|
dongsheng@623
|
208 Reads a po file (which name is given as argument). Previously existing
|
dongsheng@623
|
209 entries in self are not removed, the new ones are added to the end of the
|
dongsheng@623
|
210 catalog.
|
dongsheng@623
|
211
|
dongsheng@623
|
212 =cut
|
dongsheng@623
|
213
|
dongsheng@623
|
214 sub read {
|
dongsheng@623
|
215 my $self=shift;
|
dongsheng@623
|
216 my $filename=shift
|
dongsheng@623
|
217 or croak wrap_mod("po4a::po",
|
dongsheng@623
|
218 dgettext("po4a",
|
dongsheng@623
|
219 "Please provide a non-null filename"));
|
dongsheng@623
|
220
|
dongsheng@623
|
221 my $fh;
|
dongsheng@623
|
222 if ($filename eq '-') {
|
dongsheng@623
|
223 $fh=*STDIN;
|
dongsheng@623
|
224 } else {
|
dongsheng@623
|
225 open $fh,"<$filename"
|
dongsheng@623
|
226 or croak wrap_mod("po4a::po",
|
dongsheng@623
|
227 dgettext("po4a", "Can't read from %s: %s"),
|
dongsheng@623
|
228 $filename, $!);
|
dongsheng@623
|
229 }
|
dongsheng@623
|
230
|
dongsheng@623
|
231 ## Read paragraphs line-by-line
|
dongsheng@623
|
232 my $pofile="";
|
dongsheng@623
|
233 my $textline;
|
dongsheng@623
|
234 while (defined ($textline = <$fh>)) {
|
dongsheng@623
|
235 $pofile .= $textline;
|
dongsheng@623
|
236 }
|
dongsheng@623
|
237 # close INPUT
|
dongsheng@623
|
238 # or croak (sprintf(dgettext("po4a",
|
dongsheng@623
|
239 # "Can't close %s after reading: %s"),
|
dongsheng@623
|
240 # $filename,$!)."\n");
|
dongsheng@623
|
241
|
dongsheng@623
|
242 my $linenum=0;
|
dongsheng@623
|
243
|
dongsheng@623
|
244 foreach my $msg (split (/\n\n/,$pofile)) {
|
dongsheng@623
|
245 my ($msgid,$msgstr,$comment,$automatic,$reference,$flags,$buffer);
|
dongsheng@623
|
246 my ($msgid_plural, $msgstr_plural);
|
dongsheng@623
|
247 foreach my $line (split (/\n/,$msg)) {
|
dongsheng@623
|
248 $linenum++;
|
dongsheng@623
|
249 if ($line =~ /^#\. ?(.*)$/) { # Automatic comment
|
dongsheng@623
|
250 $automatic .= (defined($automatic) ? "\n" : "").$1;
|
dongsheng@623
|
251
|
dongsheng@623
|
252 } elsif ($line =~ /^#: ?(.*)$/) { # reference
|
dongsheng@623
|
253 $reference .= (defined($reference) ? "\n" : "").$1;
|
dongsheng@623
|
254
|
dongsheng@623
|
255 } elsif ($line =~ /^#, ?(.*)$/) { # flags
|
dongsheng@623
|
256 $flags .= (defined($flags) ? "\n" : "").$1;
|
dongsheng@623
|
257
|
dongsheng@623
|
258 } elsif ($line =~ /^#(.*)$/) { # Translator comments
|
dongsheng@623
|
259 $comment .= (defined($comment) ? "\n" : "").($1||"");
|
dongsheng@623
|
260
|
dongsheng@623
|
261 } elsif ($line =~ /^msgid (".*")$/) { # begin of msgid
|
dongsheng@623
|
262 $buffer = $1;
|
dongsheng@623
|
263
|
dongsheng@623
|
264 } elsif ($line =~ /^msgid_plural (".*")$/) {
|
dongsheng@623
|
265 # begin of msgid_plural, end of msgid
|
dongsheng@623
|
266
|
dongsheng@623
|
267 $msgid = $buffer;
|
dongsheng@623
|
268 $buffer = $1;
|
dongsheng@623
|
269
|
dongsheng@623
|
270 } elsif ($line =~ /^msgstr (".*")$/) {
|
dongsheng@623
|
271 # begin of msgstr, end of msgid
|
dongsheng@623
|
272
|
dongsheng@623
|
273 $msgid = $buffer;
|
dongsheng@623
|
274 $buffer = "$1";
|
dongsheng@623
|
275
|
dongsheng@623
|
276 } elsif ($line =~ /^msgstr\[([0-9]+)\] (".*")$/) {
|
dongsheng@623
|
277 # begin of msgstr[x], end of msgid_plural or msgstr[x-1]
|
dongsheng@623
|
278
|
dongsheng@623
|
279 # Note: po4a cannot uses plural forms
|
dongsheng@623
|
280 # (no integer to use the plural form)
|
dongsheng@623
|
281 # * drop the msgstr[x] where x >= 2
|
dongsheng@623
|
282 # * use msgstr[0] as the translation of msgid
|
dongsheng@623
|
283 # * use msgstr[1] as the translation of msgid_plural
|
dongsheng@623
|
284
|
dongsheng@623
|
285 if ($1 eq "0") {
|
dongsheng@623
|
286 $msgid_plural = $buffer;
|
dongsheng@623
|
287 $buffer = "$2";
|
dongsheng@623
|
288 } elsif ($1 eq "1") {
|
dongsheng@623
|
289 $msgstr = $buffer;
|
dongsheng@623
|
290 $buffer = "$2";
|
dongsheng@623
|
291 } elsif ($1 eq "2") {
|
dongsheng@623
|
292 $msgstr_plural = $buffer;
|
dongsheng@623
|
293 warn wrap_ref_mod("$filename:$linenum",
|
dongsheng@623
|
294 "po4a::po",
|
dongsheng@623
|
295 dgettext("po4a", "Messages with more than 2 plural forms are not supported."));
|
dongsheng@623
|
296 }
|
dongsheng@623
|
297 } elsif ($line =~ /^(".*")$/) {
|
dongsheng@623
|
298 # continuation of a line
|
dongsheng@623
|
299 $buffer .= "\n$1";
|
dongsheng@623
|
300
|
dongsheng@623
|
301 } else {
|
dongsheng@623
|
302 warn wrap_ref_mod("$filename:$linenum",
|
dongsheng@623
|
303 "po4a::po",
|
dongsheng@623
|
304 dgettext("po4a", "Strange line: -->%s<--"),
|
dongsheng@623
|
305 $line);
|
dongsheng@623
|
306 }
|
dongsheng@623
|
307 }
|
dongsheng@623
|
308 $linenum++;
|
dongsheng@623
|
309 if (defined $msgid_plural) {
|
dongsheng@623
|
310 $msgstr_plural=$buffer;
|
dongsheng@623
|
311
|
dongsheng@623
|
312 $msgid = unquote_text($msgid) if (defined($msgid));
|
dongsheng@623
|
313 $msgstr = unquote_text($msgstr) if (defined($msgstr));
|
dongsheng@623
|
314
|
dongsheng@623
|
315 $self->push_raw ('msgid' => $msgid,
|
dongsheng@623
|
316 'msgstr' => $msgstr,
|
dongsheng@623
|
317 'reference' => $reference,
|
dongsheng@623
|
318 'flags' => $flags,
|
dongsheng@623
|
319 'comment' => $comment,
|
dongsheng@623
|
320 'automatic' => $automatic,
|
dongsheng@623
|
321 'plural' => 0);
|
dongsheng@623
|
322
|
dongsheng@623
|
323 $msgid_plural = unquote_text($msgid_plural)
|
dongsheng@623
|
324 if (defined($msgid_plural));
|
dongsheng@623
|
325 $msgstr_plural = unquote_text($msgstr_plural)
|
dongsheng@623
|
326 if (defined($msgstr_plural));
|
dongsheng@623
|
327
|
dongsheng@623
|
328 $self->push_raw ('msgid' => $msgid_plural,
|
dongsheng@623
|
329 'msgstr' => $msgstr_plural,
|
dongsheng@623
|
330 'reference' => $reference,
|
dongsheng@623
|
331 'flags' => $flags,
|
dongsheng@623
|
332 'comment' => $comment,
|
dongsheng@623
|
333 'automatic' => $automatic,
|
dongsheng@623
|
334 'plural' => 1);
|
dongsheng@623
|
335 } else {
|
dongsheng@623
|
336 $msgstr=$buffer;
|
dongsheng@623
|
337
|
dongsheng@623
|
338 $msgid = unquote_text($msgid) if (defined($msgid));
|
dongsheng@623
|
339 $msgstr = unquote_text($msgstr) if (defined($msgstr));
|
dongsheng@623
|
340
|
dongsheng@623
|
341 $self->push_raw ('msgid' => $msgid,
|
dongsheng@623
|
342 'msgstr' => $msgstr,
|
dongsheng@623
|
343 'reference' => $reference,
|
dongsheng@623
|
344 'flags' => $flags,
|
dongsheng@623
|
345 'comment' => $comment,
|
dongsheng@623
|
346 'automatic' => $automatic);
|
dongsheng@623
|
347 }
|
dongsheng@623
|
348 }
|
dongsheng@623
|
349 }
|
dongsheng@623
|
350
|
dongsheng@623
|
351 =item write($)
|
dongsheng@623
|
352
|
dongsheng@623
|
353 Writes the current catalog to the given file.
|
dongsheng@623
|
354
|
dongsheng@623
|
355 =cut
|
dongsheng@623
|
356
|
dongsheng@623
|
357 sub write{
|
dongsheng@623
|
358 my $self=shift;
|
dongsheng@623
|
359 my $filename=shift
|
dongsheng@623
|
360 or croak dgettext("po4a","Can't write to a file without filename")."\n";
|
dongsheng@623
|
361
|
dongsheng@623
|
362 my $fh;
|
dongsheng@623
|
363 if ($filename eq '-') {
|
dongsheng@623
|
364 $fh=\*STDOUT;
|
dongsheng@623
|
365 } else {
|
dongsheng@623
|
366 # make sure the directory in which we should write the localized
|
dongsheng@623
|
367 # file exists
|
dongsheng@623
|
368 my $dir = $filename;
|
dongsheng@623
|
369 if ($dir =~ m|/|) {
|
dongsheng@623
|
370 $dir =~ s|/[^/]*$||;
|
dongsheng@623
|
371
|
dongsheng@623
|
372 File::Path::mkpath($dir, 0, 0755) # Croaks on error
|
dongsheng@623
|
373 if (length ($dir) && ! -e $dir);
|
dongsheng@623
|
374 }
|
dongsheng@623
|
375 open $fh,">$filename"
|
dongsheng@623
|
376 or croak wrap_mod("po4a::po",
|
dongsheng@623
|
377 dgettext("po4a", "Can't write to %s: %s"),
|
dongsheng@623
|
378 $filename, $!);
|
dongsheng@623
|
379 }
|
dongsheng@623
|
380
|
dongsheng@623
|
381 print $fh "".format_comment($self->{header_comment},"")
|
dongsheng@623
|
382 if defined($self->{header_comment}) && length($self->{header_comment});
|
dongsheng@623
|
383
|
dongsheng@623
|
384 print $fh "msgid \"\"\n";
|
dongsheng@623
|
385 print $fh "msgstr ".quote_text($self->{header})."\n\n";
|
dongsheng@623
|
386
|
dongsheng@623
|
387
|
dongsheng@623
|
388 my $buf_msgstr_plural; # USed to keep the first msgstr of plural forms
|
dongsheng@623
|
389 my $first=1;
|
dongsheng@623
|
390 foreach my $msgid ( sort { ($self->{po}{"$a"}{'pos'}) <=>
|
dongsheng@623
|
391 ($self->{po}{"$b"}{'pos'})
|
dongsheng@623
|
392 } keys %{$self->{po}}) {
|
dongsheng@623
|
393 my $output="";
|
dongsheng@623
|
394
|
dongsheng@623
|
395 if ($first) {
|
dongsheng@623
|
396 $first=0;
|
dongsheng@623
|
397 } else {
|
dongsheng@623
|
398 $output .= "\n";
|
dongsheng@623
|
399 }
|
dongsheng@623
|
400
|
dongsheng@623
|
401 $output .= format_comment($self->{po}{$msgid}{'comment'},"")
|
dongsheng@623
|
402 if defined($self->{po}{$msgid}{'comment'})
|
dongsheng@623
|
403 && length ($self->{po}{$msgid}{'comment'});
|
dongsheng@623
|
404 if ( defined($self->{po}{$msgid}{'automatic'})
|
dongsheng@623
|
405 && length ($self->{po}{$msgid}{'automatic'})) {
|
dongsheng@623
|
406 foreach my $comment (split(/\\n/,$self->{po}{$msgid}{'automatic'}))
|
dongsheng@623
|
407 {
|
dongsheng@623
|
408 $output .= format_comment($comment, ". ")
|
dongsheng@623
|
409 }
|
dongsheng@623
|
410 }
|
dongsheng@623
|
411 $output .= format_comment($self->{po}{$msgid}{'type'},". type: ")
|
dongsheng@623
|
412 if defined($self->{po}{$msgid}{'type'})
|
dongsheng@623
|
413 && length ($self->{po}{$msgid}{'type'});
|
dongsheng@623
|
414 $output .= format_comment($self->{po}{$msgid}{'reference'},": ")
|
dongsheng@623
|
415 if defined($self->{po}{$msgid}{'reference'})
|
dongsheng@623
|
416 && length ($self->{po}{$msgid}{'reference'});
|
dongsheng@623
|
417 $output .= "#, ". join(", ", sort split(/\s+/,$self->{po}{$msgid}{'flags'}))."\n"
|
dongsheng@623
|
418 if defined($self->{po}{$msgid}{'flags'})
|
dongsheng@623
|
419 && length ($self->{po}{$msgid}{'flags'});
|
dongsheng@623
|
420
|
dongsheng@623
|
421 if (exists $self->{po}{$msgid}{'plural'}) {
|
dongsheng@623
|
422 if ($self->{po}{$msgid}{'plural'} == 0) {
|
dongsheng@623
|
423 if ($self->get_charset =~ /^utf-8$/i) {
|
dongsheng@623
|
424 my $msgstr = Encode::decode_utf8($self->{po}{$msgid}{'msgstr'});
|
dongsheng@623
|
425 $msgid = Encode::decode_utf8($msgid);
|
dongsheng@623
|
426 $output .= Encode::encode_utf8("msgid ".quote_text($msgid)."\n");
|
dongsheng@623
|
427 $buf_msgstr_plural = Encode::encode_utf8("msgstr[0] ".quote_text($msgstr)."\n");
|
dongsheng@623
|
428 } else {
|
dongsheng@623
|
429 $output = "msgid ".quote_text($msgid)."\n";
|
dongsheng@623
|
430 $buf_msgstr_plural = "msgstr[0] ".quote_text($self->{po}{$msgid}{'msgstr'})."\n";
|
dongsheng@623
|
431 }
|
dongsheng@623
|
432 } elsif ($self->{po}{$msgid}{'plural'} == 1) {
|
dongsheng@623
|
433 # TODO: there may be only one plural form
|
dongsheng@623
|
434 if ($self->get_charset =~ /^utf-8$/i) {
|
dongsheng@623
|
435 my $msgstr = Encode::decode_utf8($self->{po}{$msgid}{'msgstr'});
|
dongsheng@623
|
436 $msgid = Encode::decode_utf8($msgid);
|
dongsheng@623
|
437 $output = Encode::encode_utf8("msgid_plural ".quote_text($msgid)."\n");
|
dongsheng@623
|
438 $output .= $buf_msgstr_plural;
|
dongsheng@623
|
439 $output .= Encode::encode_utf8("msgstr[1] ".quote_text($msgstr)."\n");
|
dongsheng@623
|
440 $buf_msgstr_plural = "";
|
dongsheng@623
|
441 } else {
|
dongsheng@623
|
442 $output = "msgid_plural ".quote_text($msgid)."\n";
|
dongsheng@623
|
443 $output .= $buf_msgstr_plural;
|
dongsheng@623
|
444 $output .= "msgstr[1] ".quote_text($self->{po}{$msgid}{'msgstr'})."\n";
|
dongsheng@623
|
445 }
|
dongsheng@623
|
446 } else {
|
dongsheng@623
|
447 die wrap_msg(dgettext("po4a","Can't write PO files with more than two plural forms."));
|
dongsheng@623
|
448 }
|
dongsheng@623
|
449 } else {
|
dongsheng@623
|
450 if ($self->get_charset =~ /^utf-8$/i) {
|
dongsheng@623
|
451 my $msgstr = Encode::decode_utf8($self->{po}{$msgid}{'msgstr'});
|
dongsheng@623
|
452 $msgid = Encode::decode_utf8($msgid);
|
dongsheng@623
|
453 $output .= Encode::encode_utf8("msgid ".quote_text($msgid)."\n");
|
dongsheng@623
|
454 $output .= Encode::encode_utf8("msgstr ".quote_text($msgstr)."\n");
|
dongsheng@623
|
455 } else {
|
dongsheng@623
|
456 $output .= "msgid ".quote_text($msgid)."\n";
|
dongsheng@623
|
457 $output .= "msgstr ".quote_text($self->{po}{$msgid}{'msgstr'})."\n";
|
dongsheng@623
|
458 }
|
dongsheng@623
|
459 }
|
dongsheng@623
|
460
|
dongsheng@623
|
461 print $fh $output;
|
dongsheng@623
|
462 }
|
dongsheng@623
|
463 # print STDERR "$fh";
|
dongsheng@623
|
464 # if ($filename ne '-') {
|
dongsheng@623
|
465 # close $fh
|
dongsheng@623
|
466 # or croak (sprintf(dgettext("po4a",
|
dongsheng@623
|
467 # "Can't close %s after writing: %s\n"),
|
dongsheng@623
|
468 # $filename,$!));
|
dongsheng@623
|
469 # }
|
dongsheng@623
|
470 }
|
dongsheng@623
|
471
|
dongsheng@623
|
472 =item write_if_needed($$)
|
dongsheng@623
|
473
|
dongsheng@623
|
474 Like write, but if the PO or POT file already exists, the object will be
|
dongsheng@623
|
475 written in a temporary file which will be compared with the existing file
|
dongsheng@623
|
476 to check that the update is needed (this avoids to change a POT just to
|
dongsheng@623
|
477 update a line reference or the POT-Creation-Date field).
|
dongsheng@623
|
478
|
dongsheng@623
|
479 =cut
|
dongsheng@623
|
480
|
dongsheng@623
|
481 sub move_po_if_needed {
|
dongsheng@623
|
482 my ($new_po, $old_po, $backup) = (shift, shift, shift);
|
dongsheng@623
|
483 my $diff;
|
dongsheng@623
|
484
|
dongsheng@623
|
485 if (-e $old_po) {
|
dongsheng@623
|
486 my $diff_ignore = "-I'^#:' "
|
dongsheng@623
|
487 ."-I'^\"POT-Creation-Date:' "
|
dongsheng@623
|
488 ."-I'^\"PO-Revision-Date:'";
|
dongsheng@623
|
489 $diff = qx(diff -q $diff_ignore $old_po $new_po);
|
dongsheng@623
|
490 if ( $diff eq "" ) {
|
dongsheng@623
|
491 unlink $new_po
|
dongsheng@623
|
492 or die wrap_msg(dgettext("po4a","Can't unlink %s: %s."),
|
dongsheng@623
|
493 $new_po, $!);
|
dongsheng@623
|
494 # touch the old PO
|
dongsheng@623
|
495 my ($atime, $mtime) = (time,time);
|
dongsheng@623
|
496 utime $atime, $mtime, $old_po;
|
dongsheng@623
|
497 } else {
|
dongsheng@623
|
498 if ($backup) {
|
dongsheng@623
|
499 copy $old_po, $old_po."~"
|
dongsheng@623
|
500 or die wrap_msg(dgettext("po4a","Can't copy %s to %s: %s."),
|
dongsheng@623
|
501 $old_po, $old_po."~", $!);
|
dongsheng@623
|
502 } else {
|
dongsheng@623
|
503 }
|
dongsheng@623
|
504 move $new_po, $old_po
|
dongsheng@623
|
505 or die wrap_msg(dgettext("po4a","Can't move %s to %s: %s."),
|
dongsheng@623
|
506 $new_po, $old_po, $!);
|
dongsheng@623
|
507 }
|
dongsheng@623
|
508 } else {
|
dongsheng@623
|
509 move $new_po, $old_po
|
dongsheng@623
|
510 or die wrap_msg(dgettext("po4a","Can't move %s to %s: %s."),
|
dongsheng@623
|
511 $new_po, $old_po, $!);
|
dongsheng@623
|
512 }
|
dongsheng@623
|
513 }
|
dongsheng@623
|
514
|
dongsheng@623
|
515 sub write_if_needed {
|
dongsheng@623
|
516 my $self=shift;
|
dongsheng@623
|
517 my $filename=shift
|
dongsheng@623
|
518 or croak dgettext("po4a","Can't write to a file without filename")."\n";
|
dongsheng@623
|
519
|
dongsheng@623
|
520 if (-e $filename) {
|
dongsheng@623
|
521 my ($tmp_filename);
|
dongsheng@623
|
522 (undef,$tmp_filename)=File::Temp->tempfile($filename."XXXX",
|
dongsheng@623
|
523 DIR => "/tmp",
|
dongsheng@623
|
524 OPEN => 0,
|
dongsheng@623
|
525 UNLINK => 0);
|
dongsheng@623
|
526 $self->write($tmp_filename);
|
dongsheng@623
|
527 move_po_if_needed($tmp_filename, $filename);
|
dongsheng@623
|
528 } else {
|
dongsheng@623
|
529 $self->write($filename);
|
dongsheng@623
|
530 }
|
dongsheng@623
|
531 }
|
dongsheng@623
|
532
|
dongsheng@623
|
533 =item gettextize($$)
|
dongsheng@623
|
534
|
dongsheng@623
|
535 This function produces one translated message catalog from two catalogs, an
|
dongsheng@623
|
536 original and a translation. This process is described in L<po4a(7)|po4a.7>,
|
dongsheng@623
|
537 section I<Gettextization: how does it work?>.
|
dongsheng@623
|
538
|
dongsheng@623
|
539 =cut
|
dongsheng@623
|
540
|
dongsheng@623
|
541 sub gettextize {
|
dongsheng@623
|
542 my $this = shift;
|
dongsheng@623
|
543 my $class = ref($this) || $this;
|
dongsheng@623
|
544 my ($poorig,$potrans)=(shift,shift);
|
dongsheng@623
|
545
|
dongsheng@623
|
546 my $pores=Locale::Po4a::Po->new();
|
dongsheng@623
|
547
|
dongsheng@623
|
548 my $please_fail = 0;
|
dongsheng@623
|
549 my $toobad = dgettext("po4a",
|
dongsheng@623
|
550 "\nThe gettextization failed (once again). Don't give up, ".
|
dongsheng@623
|
551 "gettextizing is a subtle art, but this is only needed once ".
|
dongsheng@623
|
552 "to convert a project to the gorgeous luxus offered by po4a ".
|
dongsheng@623
|
553 "to translators.".
|
dongsheng@623
|
554 "\nPlease refer to the po4a(7) documentation, the section ".
|
dongsheng@623
|
555 "\"HOWTO convert a pre-existing translation to po4a?\" ".
|
dongsheng@623
|
556 "contains several hints to help you in your task");
|
dongsheng@623
|
557
|
dongsheng@623
|
558 # Don't fail right now when the entry count does not match. Instead, give
|
dongsheng@623
|
559 # it a try so that the user can see where we fail (which is probably where
|
dongsheng@623
|
560 # the problem is).
|
dongsheng@623
|
561 if ($poorig->count_entries_doc() > $potrans->count_entries_doc()) {
|
dongsheng@623
|
562 warn wrap_mod("po4a gettextize", dgettext("po4a",
|
dongsheng@623
|
563 "Original has more strings than the translation (%d>%d). ".
|
dongsheng@623
|
564 "Please fix it by editing the translated version to add ".
|
dongsheng@623
|
565 "some dummy entry."),
|
dongsheng@623
|
566 $poorig->count_entries_doc(),
|
dongsheng@623
|
567 $potrans->count_entries_doc());
|
dongsheng@623
|
568 $please_fail = 1;
|
dongsheng@623
|
569 } elsif ($poorig->count_entries_doc() < $potrans->count_entries_doc()) {
|
dongsheng@623
|
570 warn wrap_mod("po4a gettextize", dgettext("po4a",
|
dongsheng@623
|
571 "Original has less strings than the translation (%d<%d). ".
|
dongsheng@623
|
572 "Please fix it by removing the extra entry from the ".
|
dongsheng@623
|
573 "translated file. You may need an addendum (cf po4a(7)) ".
|
dongsheng@623
|
574 "to reput the chunk in place after gettextization. A ".
|
dongsheng@623
|
575 "possible cause is that a text duplicated in the original ".
|
dongsheng@623
|
576 "is not translated the same way each time. Remove one of ".
|
dongsheng@623
|
577 "the translations, and you're fine."),
|
dongsheng@623
|
578 $poorig->count_entries_doc(),
|
dongsheng@623
|
579 $potrans->count_entries_doc());
|
dongsheng@623
|
580 $please_fail = 1;
|
dongsheng@623
|
581 }
|
dongsheng@623
|
582
|
dongsheng@623
|
583 if ( $poorig->get_charset =~ /^utf-8$/i ) {
|
dongsheng@623
|
584 $potrans->to_utf8;
|
dongsheng@623
|
585 $pores->set_charset("utf-8");
|
dongsheng@623
|
586 } else {
|
dongsheng@623
|
587 if ($potrans->get_charset eq "CHARSET") {
|
dongsheng@623
|
588 $pores->set_charset("ascii");
|
dongsheng@623
|
589 } else {
|
dongsheng@623
|
590 $pores->set_charset($potrans->get_charset);
|
dongsheng@623
|
591 }
|
dongsheng@623
|
592 }
|
dongsheng@623
|
593 print "Po character sets:\n".
|
dongsheng@623
|
594 " original=".$poorig->get_charset."\n".
|
dongsheng@623
|
595 " translated=".$potrans->get_charset."\n".
|
dongsheng@623
|
596 " result=".$pores->get_charset."\n"
|
dongsheng@623
|
597 if $debug{'encoding'};
|
dongsheng@623
|
598
|
dongsheng@623
|
599 for (my ($o,$t)=(0,0) ;
|
dongsheng@623
|
600 $o<$poorig->count_entries_doc() && $t<$potrans->count_entries_doc();
|
dongsheng@623
|
601 $o++,$t++) {
|
dongsheng@623
|
602 #
|
dongsheng@623
|
603 # Extract some informations
|
dongsheng@623
|
604
|
dongsheng@623
|
605 my ($orig,$trans)=($poorig->msgid_doc($o),$potrans->msgid_doc($t));
|
dongsheng@623
|
606 # print STDERR "Matches [[$orig]]<<$trans>>\n";
|
dongsheng@623
|
607
|
dongsheng@623
|
608 my ($reforig,$reftrans)=($poorig->{po}{$orig}{'reference'},
|
dongsheng@623
|
609 $potrans->{po}{$trans}{'reference'});
|
dongsheng@623
|
610 my ($typeorig,$typetrans)=($poorig->{po}{$orig}{'type'},
|
dongsheng@623
|
611 $potrans->{po}{$trans}{'type'});
|
dongsheng@623
|
612
|
dongsheng@623
|
613 #
|
dongsheng@623
|
614 # Make sure the type of both string exist
|
dongsheng@623
|
615 #
|
dongsheng@623
|
616 die wrap_mod("po4a gettextize",
|
dongsheng@623
|
617 "Internal error: type of original string number %s ".
|
dongsheng@623
|
618 "isn't provided", $o)
|
dongsheng@623
|
619 if ($typeorig eq '');
|
dongsheng@623
|
620
|
dongsheng@623
|
621 die wrap_mod("po4a gettextize",
|
dongsheng@623
|
622 "Internal error: type of translated string number %s ".
|
dongsheng@623
|
623 "isn't provided", $o)
|
dongsheng@623
|
624 if ($typetrans eq '');
|
dongsheng@623
|
625
|
dongsheng@623
|
626 #
|
dongsheng@623
|
627 # Make sure both type are the same
|
dongsheng@623
|
628 #
|
dongsheng@623
|
629 if ($typeorig ne $typetrans){
|
dongsheng@623
|
630 $pores->write("gettextization.failed.po");
|
dongsheng@623
|
631 die wrap_msg(dgettext("po4a",
|
dongsheng@623
|
632 "po4a gettextization: Structure disparity between ".
|
dongsheng@623
|
633 "original and translated files:\n".
|
dongsheng@623
|
634 "msgid (at %s) is of type '%s' while\n".
|
dongsheng@623
|
635 "msgstr (at %s) is of type '%s'.\n".
|
dongsheng@623
|
636 "Original text: %s\n".
|
dongsheng@623
|
637 "Translated text: %s\n".
|
dongsheng@623
|
638 "(result so far dumped to gettextization.failed.po)").
|
dongsheng@623
|
639 "%s",
|
dongsheng@623
|
640 $reforig, $typeorig,
|
dongsheng@623
|
641 $reftrans, $typetrans,
|
dongsheng@623
|
642 $orig,
|
dongsheng@623
|
643 $trans,
|
dongsheng@623
|
644 $toobad);
|
dongsheng@623
|
645 }
|
dongsheng@623
|
646
|
dongsheng@623
|
647 #
|
dongsheng@623
|
648 # Push the entry
|
dongsheng@623
|
649 #
|
dongsheng@623
|
650 my $flags;
|
dongsheng@623
|
651 if (defined $poorig->{po}{$orig}{'flags'}) {
|
dongsheng@623
|
652 $flags = $poorig->{po}{$orig}{'flags'}." fuzzy";
|
dongsheng@623
|
653 } else {
|
dongsheng@623
|
654 $flags = "fuzzy";
|
dongsheng@623
|
655 }
|
dongsheng@623
|
656 $pores->push_raw('msgid' => $orig,
|
dongsheng@623
|
657 'msgstr' => $trans,
|
dongsheng@623
|
658 'flags' => $flags,
|
dongsheng@623
|
659 'type' => $typeorig,
|
dongsheng@623
|
660 'reference' => $reforig,
|
dongsheng@623
|
661 'conflict' => 1,
|
dongsheng@623
|
662 'transref' => $potrans->{po}{$trans}{'reference'})
|
dongsheng@623
|
663 unless (defined($pores->{po}{$orig})
|
dongsheng@623
|
664 and ($pores->{po}{$orig}{'msgstr'} eq $trans))
|
dongsheng@623
|
665 # FIXME: maybe we should be smarter about what reference should be
|
dongsheng@623
|
666 # sent to push_raw.
|
dongsheng@623
|
667 }
|
dongsheng@623
|
668
|
dongsheng@623
|
669 # make sure we return a useful error message when entry count differ
|
dongsheng@623
|
670 die "$toobad\n" if $please_fail;
|
dongsheng@623
|
671
|
dongsheng@623
|
672 return $pores;
|
dongsheng@623
|
673 }
|
dongsheng@623
|
674
|
dongsheng@623
|
675 =item filter($)
|
dongsheng@623
|
676
|
dongsheng@623
|
677 This function extracts a catalog from an existing one. Only the entries having
|
dongsheng@623
|
678 a reference in the given file will be placed in the resulting catalog.
|
dongsheng@623
|
679
|
dongsheng@623
|
680 This function parses its argument, converts it to a perl function definition,
|
dongsheng@623
|
681 eval this definition and filter the fields for which this function returns
|
dongsheng@623
|
682 true.
|
dongsheng@623
|
683
|
dongsheng@623
|
684 I love perl sometimes ;)
|
dongsheng@623
|
685
|
dongsheng@623
|
686 =cut
|
dongsheng@623
|
687
|
dongsheng@623
|
688 sub filter {
|
dongsheng@623
|
689 my $self=shift;
|
dongsheng@623
|
690 our $filter=shift;
|
dongsheng@623
|
691
|
dongsheng@623
|
692 my $res;
|
dongsheng@623
|
693 $res = Locale::Po4a::Po->new();
|
dongsheng@623
|
694
|
dongsheng@623
|
695 # Parse the filter
|
dongsheng@623
|
696 our $code="sub apply { return ";
|
dongsheng@623
|
697 our $pos=0;
|
dongsheng@623
|
698 our $length = length $filter;
|
dongsheng@623
|
699
|
dongsheng@623
|
700 # explode chars to parts. How to subscript a string in Perl?
|
dongsheng@623
|
701 our @filter = split(//,$filter);
|
dongsheng@623
|
702
|
dongsheng@623
|
703 sub gloups {
|
dongsheng@623
|
704 my $fmt=shift;
|
dongsheng@623
|
705 my $space = "";
|
dongsheng@623
|
706 for (1..$pos){
|
dongsheng@623
|
707 $space .= ' ';
|
dongsheng@623
|
708 }
|
dongsheng@623
|
709 die wrap_msg("$fmt\n$filter\n$space^ HERE");
|
dongsheng@623
|
710 }
|
dongsheng@623
|
711 sub showmethecode {
|
dongsheng@623
|
712 return unless $debug{'filter'};
|
dongsheng@623
|
713 my $fmt=shift;
|
dongsheng@623
|
714 my $space="";
|
dongsheng@623
|
715 for (1..$pos){
|
dongsheng@623
|
716 $space .= ' ';
|
dongsheng@623
|
717 }
|
dongsheng@623
|
718 print STDERR "$filter\n$space^ $fmt\n";#"$code\n";
|
dongsheng@623
|
719 }
|
dongsheng@623
|
720
|
dongsheng@623
|
721 # I dream of a lex in perl :-/
|
dongsheng@623
|
722 sub parse_expression {
|
dongsheng@623
|
723 showmethecode("Begin expression")
|
dongsheng@623
|
724 if $debug{'filter'};
|
dongsheng@623
|
725
|
dongsheng@623
|
726 gloups("Begin of expression expected, got '%s'",$filter[$pos])
|
dongsheng@623
|
727 unless ($filter[$pos] eq '(');
|
dongsheng@623
|
728 $pos ++; # pass the '('
|
dongsheng@623
|
729 if ($filter[$pos] eq '&') {
|
dongsheng@623
|
730 # AND
|
dongsheng@623
|
731 $pos++;
|
dongsheng@623
|
732 showmethecode("Begin of AND")
|
dongsheng@623
|
733 if $debug{'filter'};
|
dongsheng@623
|
734 $code .= "(";
|
dongsheng@623
|
735 while (1) {
|
dongsheng@623
|
736 gloups ("Unfinished AND statement.")
|
dongsheng@623
|
737 if ($pos == $length);
|
dongsheng@623
|
738 parse_expression();
|
dongsheng@623
|
739 if ($filter[$pos] eq '(') {
|
dongsheng@623
|
740 $code .= " && ";
|
dongsheng@623
|
741 } elsif ($filter[$pos] eq ')') {
|
dongsheng@623
|
742 last; # do not eat that char
|
dongsheng@623
|
743 } else {
|
dongsheng@623
|
744 gloups("End of AND or begin of sub-expression expected, got '%s'", $filter[$pos]);
|
dongsheng@623
|
745 }
|
dongsheng@623
|
746 }
|
dongsheng@623
|
747 $code .= ")";
|
dongsheng@623
|
748 } elsif ($filter[$pos] eq '|') {
|
dongsheng@623
|
749 # OR
|
dongsheng@623
|
750 $pos++;
|
dongsheng@623
|
751 $code .= "(";
|
dongsheng@623
|
752 while (1) {
|
dongsheng@623
|
753 gloups("Unfinished OR statement.")
|
dongsheng@623
|
754 if ($pos == $length);
|
dongsheng@623
|
755 parse_expression();
|
dongsheng@623
|
756 if ($filter[$pos] eq '(') {
|
dongsheng@623
|
757 $code .= " || ";
|
dongsheng@623
|
758 } elsif ($filter[$pos] eq ')') {
|
dongsheng@623
|
759 last; # do not eat that char
|
dongsheng@623
|
760 } else {
|
dongsheng@623
|
761 gloups("End of OR or begin of sub-expression expected, got '%s'",$filter[$pos]);
|
dongsheng@623
|
762 }
|
dongsheng@623
|
763 }
|
dongsheng@623
|
764 $code .= ")";
|
dongsheng@623
|
765 } elsif ($filter[$pos] eq '!') {
|
dongsheng@623
|
766 # NOT
|
dongsheng@623
|
767 $pos++;
|
dongsheng@623
|
768 $code .= "(!";
|
dongsheng@623
|
769 gloups("Missing sub-expression in NOT statement.")
|
dongsheng@623
|
770 if ($pos == $length);
|
dongsheng@623
|
771 parse_expression();
|
dongsheng@623
|
772 $code .= ")";
|
dongsheng@623
|
773 } else {
|
dongsheng@623
|
774 # must be an equal. Let's get field and argument
|
dongsheng@623
|
775 my ($field,$arg,$done);
|
dongsheng@623
|
776 $field = substr($filter,$pos);
|
dongsheng@623
|
777 gloups("EQ statement contains no '=' or invalid field name")
|
dongsheng@623
|
778 unless ($field =~ /([a-z]*)=/i);
|
dongsheng@623
|
779 $field = lc($1);
|
dongsheng@623
|
780 $pos += (length $field) + 1;
|
dongsheng@623
|
781
|
dongsheng@623
|
782 # check that we've got a valid field name,
|
dongsheng@623
|
783 # and the number it referes to
|
dongsheng@623
|
784 # DO NOT CHANGE THE ORDER
|
dongsheng@623
|
785 my @names=qw(msgid msgstr reference flags comment automatic);
|
dongsheng@623
|
786 my $fieldpos;
|
dongsheng@623
|
787 for ($fieldpos = 0;
|
dongsheng@623
|
788 $fieldpos < scalar @names && $field ne $names[$fieldpos];
|
dongsheng@623
|
789 $fieldpos++) {}
|
dongsheng@623
|
790 gloups("Invalid field name: %s",$field)
|
dongsheng@623
|
791 if $fieldpos == scalar @names; # not found
|
dongsheng@623
|
792
|
dongsheng@623
|
793 # Now, get the argument value. It has to be between quotes,
|
dongsheng@623
|
794 # which can be escaped
|
dongsheng@623
|
795 # We point right on the first char of the argument
|
dongsheng@623
|
796 # (first quote already eaten)
|
dongsheng@623
|
797 my $escaped = 0;
|
dongsheng@623
|
798 my $quoted = 0;
|
dongsheng@623
|
799 if ($filter[$pos] eq '"') {
|
dongsheng@623
|
800 $pos++;
|
dongsheng@623
|
801 $quoted = 1;
|
dongsheng@623
|
802 }
|
dongsheng@623
|
803 showmethecode(($quoted?"Quoted":"Unquoted")." argument of field '$field'")
|
dongsheng@623
|
804 if $debug{'filter'};
|
dongsheng@623
|
805
|
dongsheng@623
|
806 while (!$done) {
|
dongsheng@623
|
807 gloups("Unfinished EQ argument.")
|
dongsheng@623
|
808 if ($pos == $length);
|
dongsheng@623
|
809
|
dongsheng@623
|
810 if ($quoted) {
|
dongsheng@623
|
811 if ($filter[$pos] eq '\\') {
|
dongsheng@623
|
812 if ($escaped) {
|
dongsheng@623
|
813 $arg .= '\\';
|
dongsheng@623
|
814 $escaped = 0;
|
dongsheng@623
|
815 } else {
|
dongsheng@623
|
816 $escaped = 1;
|
dongsheng@623
|
817 }
|
dongsheng@623
|
818 } elsif ($escaped) {
|
dongsheng@623
|
819 if ($filter[$pos] eq '"') {
|
dongsheng@623
|
820 $arg .= '"';
|
dongsheng@623
|
821 $escaped = 0;
|
dongsheng@623
|
822 } else {
|
dongsheng@623
|
823 gloups("Invalid escape sequence in argument: '\\%s'",$filter[$pos]);
|
dongsheng@623
|
824 }
|
dongsheng@623
|
825 } else {
|
dongsheng@623
|
826 if ($filter[$pos] eq '"') {
|
dongsheng@623
|
827 $done = 1;
|
dongsheng@623
|
828 } else {
|
dongsheng@623
|
829 $arg .= $filter[$pos];
|
dongsheng@623
|
830 }
|
dongsheng@623
|
831 }
|
dongsheng@623
|
832 } else {
|
dongsheng@623
|
833 if ($filter[$pos] eq ')') {
|
dongsheng@623
|
834 # counter the next ++ since we don't want to eat
|
dongsheng@623
|
835 # this char
|
dongsheng@623
|
836 $pos--;
|
dongsheng@623
|
837 $done = 1;
|
dongsheng@623
|
838 } else {
|
dongsheng@623
|
839 $arg .= $filter[$pos];
|
dongsheng@623
|
840 }
|
dongsheng@623
|
841 }
|
dongsheng@623
|
842 $pos++;
|
dongsheng@623
|
843 }
|
dongsheng@623
|
844 # and now, add the code to check this equality
|
dongsheng@623
|
845 $code .= "(\$_[$fieldpos] =~ m/$arg/)";
|
dongsheng@623
|
846
|
dongsheng@623
|
847 }
|
dongsheng@623
|
848 showmethecode("End of expression")
|
dongsheng@623
|
849 if $debug{'filter'};
|
dongsheng@623
|
850 gloups("Unfinished statement.")
|
dongsheng@623
|
851 if ($pos == $length);
|
dongsheng@623
|
852 gloups("End of expression expected, got '%s'",$filter[$pos])
|
dongsheng@623
|
853 unless ($filter[$pos] eq ')');
|
dongsheng@623
|
854 $pos++;
|
dongsheng@623
|
855 }
|
dongsheng@623
|
856 # And now, launch the beast, finish the function and use eval
|
dongsheng@623
|
857 # to construct this function.
|
dongsheng@623
|
858 # Ok, the lack of lexer is a fair price for the eval ;)
|
dongsheng@623
|
859 parse_expression();
|
dongsheng@623
|
860 gloups("Garbage at the end of the expression")
|
dongsheng@623
|
861 if ($pos != $length);
|
dongsheng@623
|
862 $code .= "; }";
|
dongsheng@623
|
863 print STDERR "CODE = $code\n"
|
dongsheng@623
|
864 if $debug{'filter'};
|
dongsheng@623
|
865 eval $code;
|
dongsheng@623
|
866 die wrap_mod("po4a::po", dgettext("po4a", "Eval failure: %s"), $@)
|
dongsheng@623
|
867 if $@;
|
dongsheng@623
|
868
|
dongsheng@623
|
869 for (my $cpt=(0) ;
|
dongsheng@623
|
870 $cpt<$self->count_entries();
|
dongsheng@623
|
871 $cpt++) {
|
dongsheng@623
|
872
|
dongsheng@623
|
873 my ($msgid,$ref,$msgstr,$flags,$type,$comment,$automatic);
|
dongsheng@623
|
874
|
dongsheng@623
|
875 $msgid = $self->msgid($cpt);
|
dongsheng@623
|
876 $ref=$self->{po}{$msgid}{'reference'};
|
dongsheng@623
|
877
|
dongsheng@623
|
878 $msgstr= $self->{po}{$msgid}{'msgstr'};
|
dongsheng@623
|
879 $flags = $self->{po}{$msgid}{'flags'};
|
dongsheng@623
|
880 $type = $self->{po}{$msgid}{'type'};
|
dongsheng@623
|
881 $comment = $self->{po}{$msgid}{'comment'};
|
dongsheng@623
|
882 $automatic = $self->{po}{$msgid}{'automatic'};
|
dongsheng@623
|
883
|
dongsheng@623
|
884 # DO NOT CHANGE THE ORDER
|
dongsheng@623
|
885 $res->push_raw('msgid' => $msgid,
|
dongsheng@623
|
886 'msgstr' => $msgstr,
|
dongsheng@623
|
887 'flags' => $flags,
|
dongsheng@623
|
888 'type' => $type,
|
dongsheng@623
|
889 'reference' => $ref,
|
dongsheng@623
|
890 'comment' => $comment,
|
dongsheng@623
|
891 'automatic' => $automatic)
|
dongsheng@623
|
892 if (apply($msgid,$msgstr,$ref,$flags,$comment,$automatic));
|
dongsheng@623
|
893 }
|
dongsheng@623
|
894 # delete the apply subroutine
|
dongsheng@623
|
895 # otherwise it will be redefined.
|
dongsheng@623
|
896 undef &apply;
|
dongsheng@623
|
897 return $res;
|
dongsheng@623
|
898 }
|
dongsheng@623
|
899
|
dongsheng@623
|
900 =item to_utf8()
|
dongsheng@623
|
901
|
dongsheng@623
|
902 Recodes to utf-8 the po's msgstrs. Does nothing if the charset is not
|
dongsheng@623
|
903 specified in the po file ("CHARSET" value), or if it's already utf-8 or
|
dongsheng@623
|
904 ascii.
|
dongsheng@623
|
905
|
dongsheng@623
|
906 =cut
|
dongsheng@623
|
907
|
dongsheng@623
|
908 sub to_utf8 {
|
dongsheng@623
|
909 my $this = shift;
|
dongsheng@623
|
910 my $charset = $this->get_charset();
|
dongsheng@623
|
911
|
dongsheng@623
|
912 unless ($charset eq "CHARSET" or
|
dongsheng@623
|
913 $charset =~ /^ascii$/i or
|
dongsheng@623
|
914 $charset =~ /^utf-8$/i) {
|
dongsheng@623
|
915 foreach my $msgid ( keys %{$this->{po}} ) {
|
dongsheng@623
|
916 Encode::from_to($this->{po}{$msgid}{'msgstr'}, $charset, "utf-8");
|
dongsheng@623
|
917 }
|
dongsheng@623
|
918 $this->set_charset("utf-8");
|
dongsheng@623
|
919 }
|
dongsheng@623
|
920 }
|
dongsheng@623
|
921
|
dongsheng@623
|
922 =back
|
dongsheng@623
|
923
|
dongsheng@623
|
924 =head1 Functions to use a message catalog for translations
|
dongsheng@623
|
925
|
dongsheng@623
|
926 =over 4
|
dongsheng@623
|
927
|
dongsheng@623
|
928 =item gettext($%)
|
dongsheng@623
|
929
|
dongsheng@623
|
930 Request the translation of the string given as argument in the current catalog.
|
dongsheng@623
|
931 The function returns the original (untranslated) string if the string was not
|
dongsheng@623
|
932 found.
|
dongsheng@623
|
933
|
dongsheng@623
|
934 After the string to translate, you can pass a hash of extra
|
dongsheng@623
|
935 arguments. Here are the valid entries:
|
dongsheng@623
|
936
|
dongsheng@623
|
937 =over
|
dongsheng@623
|
938
|
dongsheng@623
|
939 =item wrap
|
dongsheng@623
|
940
|
dongsheng@623
|
941 boolean indicating whether we can consider that whitespaces in string are
|
dongsheng@623
|
942 not important. If yes, the function canonizes the string before looking for
|
dongsheng@623
|
943 a translation, and wraps the result.
|
dongsheng@623
|
944
|
dongsheng@623
|
945 =item wrapcol
|
dongsheng@623
|
946
|
dongsheng@623
|
947 The column at which we should wrap (default: 76).
|
dongsheng@623
|
948
|
dongsheng@623
|
949 =back
|
dongsheng@623
|
950
|
dongsheng@623
|
951 =cut
|
dongsheng@623
|
952
|
dongsheng@623
|
953 sub gettext {
|
dongsheng@623
|
954 my $self=shift;
|
dongsheng@623
|
955 my $text=shift;
|
dongsheng@623
|
956 my (%opt)=@_;
|
dongsheng@623
|
957 my $res;
|
dongsheng@623
|
958
|
dongsheng@623
|
959 return "" unless defined($text) && length($text); # Avoid returning the header.
|
dongsheng@623
|
960 my $validoption="reference wrap wrapcol";
|
dongsheng@623
|
961 my %validoption;
|
dongsheng@623
|
962
|
dongsheng@623
|
963 map { $validoption{$_}=1 } (split(/ /,$validoption));
|
dongsheng@623
|
964 foreach (keys %opt) {
|
dongsheng@623
|
965 Carp::confess "internal error: unknown arg $_.\n".
|
dongsheng@623
|
966 "Here are the valid options: $validoption.\n"
|
dongsheng@623
|
967 unless $validoption{$_};
|
dongsheng@623
|
968 }
|
dongsheng@623
|
969
|
dongsheng@623
|
970 $text=canonize($text)
|
dongsheng@623
|
971 if ($opt{'wrap'});
|
dongsheng@623
|
972
|
dongsheng@623
|
973 my $esc_text=escape_text($text);
|
dongsheng@623
|
974
|
dongsheng@623
|
975 $self->{gettextqueries}++;
|
dongsheng@623
|
976
|
dongsheng@623
|
977 if ( defined $self->{po}{$esc_text}
|
dongsheng@623
|
978 and defined $self->{po}{$esc_text}{'msgstr'}
|
dongsheng@623
|
979 and length $self->{po}{$esc_text}{'msgstr'}
|
dongsheng@623
|
980 and ( not defined $self->{po}{$esc_text}{'flags'}
|
dongsheng@623
|
981 or $self->{po}{$esc_text}{'flags'} !~ /fuzzy/)) {
|
dongsheng@623
|
982
|
dongsheng@623
|
983 $self->{gettexthits}++;
|
dongsheng@623
|
984 $res = unescape_text($self->{po}{$esc_text}{'msgstr'});
|
dongsheng@623
|
985 if (defined $self->{po}{$esc_text}{'plural'}) {
|
dongsheng@623
|
986 if ($self->{po}{$esc_text}{'plural'} eq "0") {
|
dongsheng@623
|
987 warn wrap_mod("po4a gettextize", dgettext("po4a",
|
dongsheng@623
|
988 "'%s' is the singular form of a message, ".
|
dongsheng@623
|
989 "po4a will use the msgstr[0] translation (%s)."),
|
dongsheng@623
|
990 $esc_text, $res);
|
dongsheng@623
|
991 } else {
|
dongsheng@623
|
992 warn wrap_mod("po4a gettextize", dgettext("po4a",
|
dongsheng@623
|
993 "'%s' is the plural form of a message, ".
|
dongsheng@623
|
994 "po4a will use the msgstr[1] translation (%s)."),
|
dongsheng@623
|
995 $esc_text, $res);
|
dongsheng@623
|
996 }
|
dongsheng@623
|
997 }
|
dongsheng@623
|
998 } else {
|
dongsheng@623
|
999 $res = $text;
|
dongsheng@623
|
1000 }
|
dongsheng@623
|
1001
|
dongsheng@623
|
1002 if ($opt{'wrap'}) {
|
dongsheng@623
|
1003 if ($self->get_charset =~ /^utf-8$/i) {
|
dongsheng@623
|
1004 $res=Encode::decode_utf8($res);
|
dongsheng@623
|
1005 $res=wrap ($res, $opt{'wrapcol'} || 76);
|
dongsheng@623
|
1006 $res=Encode::encode_utf8($res);
|
dongsheng@623
|
1007 } else {
|
dongsheng@623
|
1008 $res=wrap ($res, $opt{'wrapcol'} || 76);
|
dongsheng@623
|
1009 }
|
dongsheng@623
|
1010 }
|
dongsheng@623
|
1011 # print STDERR "Gettext >>>$text<<<(escaped=$esc_text)=[[[$res]]]\n\n";
|
dongsheng@623
|
1012 return $res;
|
dongsheng@623
|
1013 }
|
dongsheng@623
|
1014
|
dongsheng@623
|
1015 =item stats_get()
|
dongsheng@623
|
1016
|
dongsheng@623
|
1017 Returns statistics about the hit ratio of gettext since the last time that
|
dongsheng@623
|
1018 stats_clear() was called. Please note that it's not the same
|
dongsheng@623
|
1019 statistics than the one printed by msgfmt --statistic. Here, it's statistics
|
dongsheng@623
|
1020 about recent usage of the po file, while msgfmt reports the status of the
|
dongsheng@623
|
1021 file. Example of use:
|
dongsheng@623
|
1022
|
dongsheng@623
|
1023 [some use of the po file to translate stuff]
|
dongsheng@623
|
1024
|
dongsheng@623
|
1025 ($percent,$hit,$queries) = $pofile->stats_get();
|
dongsheng@623
|
1026 print "So far, we found translations for $percent\% ($hit of $queries) of strings.\n";
|
dongsheng@623
|
1027
|
dongsheng@623
|
1028 =cut
|
dongsheng@623
|
1029
|
dongsheng@623
|
1030 sub stats_get() {
|
dongsheng@623
|
1031 my $self=shift;
|
dongsheng@623
|
1032 my ($h,$q)=($self->{gettexthits},$self->{gettextqueries});
|
dongsheng@623
|
1033 my $p = ($q == 0 ? 100 : int($h/$q*10000)/100);
|
dongsheng@623
|
1034
|
dongsheng@623
|
1035 # $p =~ s/\.00//;
|
dongsheng@623
|
1036 # $p =~ s/(\..)0/$1/;
|
dongsheng@623
|
1037
|
dongsheng@623
|
1038 return ( $p,$h,$q );
|
dongsheng@623
|
1039 }
|
dongsheng@623
|
1040
|
dongsheng@623
|
1041 =item stats_clear()
|
dongsheng@623
|
1042
|
dongsheng@623
|
1043 Clears the statistics about gettext hits.
|
dongsheng@623
|
1044
|
dongsheng@623
|
1045 =cut
|
dongsheng@623
|
1046
|
dongsheng@623
|
1047 sub stats_clear {
|
dongsheng@623
|
1048 my $self = shift;
|
dongsheng@623
|
1049 $self->{gettextqueries} = 0;
|
dongsheng@623
|
1050 $self->{gettexthits} = 0;
|
dongsheng@623
|
1051 }
|
dongsheng@623
|
1052
|
dongsheng@623
|
1053 =back
|
dongsheng@623
|
1054
|
dongsheng@623
|
1055 =head1 Functions to build a message catalog
|
dongsheng@623
|
1056
|
dongsheng@623
|
1057 =over 4
|
dongsheng@623
|
1058
|
dongsheng@623
|
1059 =item push(%)
|
dongsheng@623
|
1060
|
dongsheng@623
|
1061 Push a new entry at the end of the current catalog. The arguments should
|
dongsheng@623
|
1062 form a hash table. The valid keys are:
|
dongsheng@623
|
1063
|
dongsheng@623
|
1064 =over 4
|
dongsheng@623
|
1065
|
dongsheng@623
|
1066 =item msgid
|
dongsheng@623
|
1067
|
dongsheng@623
|
1068 the string in original language.
|
dongsheng@623
|
1069
|
dongsheng@623
|
1070 =item msgstr
|
dongsheng@623
|
1071
|
dongsheng@623
|
1072 the translation.
|
dongsheng@623
|
1073
|
dongsheng@623
|
1074 =item reference
|
dongsheng@623
|
1075
|
dongsheng@623
|
1076 an indication of where this string was found. Example: file.c:46 (meaning
|
dongsheng@623
|
1077 in 'file.c' at line 46). It can be a space-separated list in case of
|
dongsheng@623
|
1078 multiple occurrences.
|
dongsheng@623
|
1079
|
dongsheng@623
|
1080 =item comment
|
dongsheng@623
|
1081
|
dongsheng@623
|
1082 a comment added here manually (by the translators). The format here is free.
|
dongsheng@623
|
1083
|
dongsheng@623
|
1084 =item automatic
|
dongsheng@623
|
1085
|
dongsheng@623
|
1086 a comment which was automatically added by the string extraction
|
dongsheng@623
|
1087 program. See the I<--add-comments> option of the B<xgettext> program for
|
dongsheng@623
|
1088 more information.
|
dongsheng@623
|
1089
|
dongsheng@623
|
1090 =item flags
|
dongsheng@623
|
1091
|
dongsheng@623
|
1092 space-separated list of all defined flags for this entry.
|
dongsheng@623
|
1093
|
dongsheng@623
|
1094 Valid flags are: c-text, python-text, lisp-text, elisp-text, librep-text,
|
dongsheng@623
|
1095 smalltalk-text, java-text, awk-text, object-pascal-text, ycp-text,
|
dongsheng@623
|
1096 tcl-text, wrap, no-wrap and fuzzy.
|
dongsheng@623
|
1097
|
dongsheng@623
|
1098 See the gettext documentation for their meaning.
|
dongsheng@623
|
1099
|
dongsheng@623
|
1100 =item type
|
dongsheng@623
|
1101
|
dongsheng@623
|
1102 This is mostly an internal argument: it is used while gettextizing
|
dongsheng@623
|
1103 documents. The idea here is to parse both the original and the translation
|
dongsheng@623
|
1104 into a po object, and merge them, using one's msgid as msgid and the
|
dongsheng@623
|
1105 other's msgid as msgstr. To make sure that things get ok, each msgid in po
|
dongsheng@623
|
1106 objects are given a type, based on their structure (like "chapt", "sect1",
|
dongsheng@623
|
1107 "p" and so on in docbook). If the types of strings are not the same, that
|
dongsheng@623
|
1108 means that both files do not share the same structure, and the process
|
dongsheng@623
|
1109 reports an error.
|
dongsheng@623
|
1110
|
dongsheng@623
|
1111 This information is written as automatic comment in the po file since this
|
dongsheng@623
|
1112 gives to translators some context about the strings to translate.
|
dongsheng@623
|
1113
|
dongsheng@623
|
1114 =item wrap
|
dongsheng@623
|
1115
|
dongsheng@623
|
1116 boolean indicating whether whitespaces can be mangled in cosmetic
|
dongsheng@623
|
1117 reformattings. If true, the string is canonized before use.
|
dongsheng@623
|
1118
|
dongsheng@623
|
1119 This information is written to the po file using the 'wrap' or 'no-wrap' flag.
|
dongsheng@623
|
1120
|
dongsheng@623
|
1121 =item wrapcol
|
dongsheng@623
|
1122
|
dongsheng@623
|
1123 The column at which we should wrap (default: 76).
|
dongsheng@623
|
1124
|
dongsheng@623
|
1125 This information is not written to the po file.
|
dongsheng@623
|
1126
|
dongsheng@623
|
1127 =back
|
dongsheng@623
|
1128
|
dongsheng@623
|
1129 =cut
|
dongsheng@623
|
1130
|
dongsheng@623
|
1131 sub push {
|
dongsheng@623
|
1132 my $self=shift;
|
dongsheng@623
|
1133 my %entry=@_;
|
dongsheng@623
|
1134
|
dongsheng@623
|
1135 my $validoption="wrap wrapcol type msgid msgstr automatic flags reference";
|
dongsheng@623
|
1136 my %validoption;
|
dongsheng@623
|
1137
|
dongsheng@623
|
1138 map { $validoption{$_}=1 } (split(/ /,$validoption));
|
dongsheng@623
|
1139 foreach (keys %entry) {
|
dongsheng@623
|
1140 Carp::confess "internal error: unknown arg $_.\n".
|
dongsheng@623
|
1141 "Here are the valid options: $validoption.\n"
|
dongsheng@623
|
1142 unless $validoption{$_};
|
dongsheng@623
|
1143 }
|
dongsheng@623
|
1144
|
dongsheng@623
|
1145 unless ($entry{'wrap'}) {
|
dongsheng@623
|
1146 $entry{'flags'} .= " no-wrap";
|
dongsheng@623
|
1147 }
|
dongsheng@623
|
1148 if (defined ($entry{'msgid'})) {
|
dongsheng@623
|
1149 $entry{'msgid'} = canonize($entry{'msgid'})
|
dongsheng@623
|
1150 if ($entry{'wrap'});
|
dongsheng@623
|
1151
|
dongsheng@623
|
1152 $entry{'msgid'} = escape_text($entry{'msgid'});
|
dongsheng@623
|
1153 }
|
dongsheng@623
|
1154 if (defined ($entry{'msgstr'})) {
|
dongsheng@623
|
1155 $entry{'msgstr'} = canonize($entry{'msgstr'})
|
dongsheng@623
|
1156 if ($entry{'wrap'});
|
dongsheng@623
|
1157
|
dongsheng@623
|
1158 $entry{'msgstr'} = escape_text($entry{'msgstr'});
|
dongsheng@623
|
1159 }
|
dongsheng@623
|
1160
|
dongsheng@623
|
1161 $self->push_raw(%entry);
|
dongsheng@623
|
1162 }
|
dongsheng@623
|
1163
|
dongsheng@623
|
1164 # The same as push(), but assuming that msgid and msgstr are already escaped
|
dongsheng@623
|
1165 sub push_raw {
|
dongsheng@623
|
1166 my $self=shift;
|
dongsheng@623
|
1167 my %entry=@_;
|
dongsheng@623
|
1168 my ($msgid,$msgstr,$reference,$comment,$automatic,$flags,$type,$transref)=
|
dongsheng@623
|
1169 ($entry{'msgid'},$entry{'msgstr'},
|
dongsheng@623
|
1170 $entry{'reference'},$entry{'comment'},$entry{'automatic'},
|
dongsheng@623
|
1171 $entry{'flags'},$entry{'type'},$entry{'transref'});
|
dongsheng@623
|
1172 my $keep_conflict = $entry{'conflict'};
|
dongsheng@623
|
1173
|
dongsheng@623
|
1174 # print STDERR "Push_raw\n";
|
dongsheng@623
|
1175 # print STDERR " msgid=>>>$msgid<<<\n" if $msgid;
|
dongsheng@623
|
1176 # print STDERR " msgstr=[[[$msgstr]]]\n" if $msgstr;
|
dongsheng@623
|
1177 # Carp::cluck " flags=$flags\n" if $flags;
|
dongsheng@623
|
1178
|
dongsheng@623
|
1179 return unless defined($entry{'msgid'});
|
dongsheng@623
|
1180
|
dongsheng@623
|
1181 #no msgid => header definition
|
dongsheng@623
|
1182 unless (length($entry{'msgid'})) {
|
dongsheng@623
|
1183 # if (defined($self->{header}) && $self->{header} =~ /\S/) {
|
dongsheng@623
|
1184 # warn dgettext("po4a","Redefinition of the header. ".
|
dongsheng@623
|
1185 # "The old one will be discarded\n");
|
dongsheng@623
|
1186 # } FIXME: do that iff the header isn't the default one.
|
dongsheng@623
|
1187 $self->{header}=$msgstr;
|
dongsheng@623
|
1188 $self->{header_comment}=$comment;
|
dongsheng@623
|
1189 my $charset = $self->get_charset;
|
dongsheng@623
|
1190 if ($charset ne "CHARSET") {
|
dongsheng@623
|
1191 $self->{encoder}=find_encoding($charset);
|
dongsheng@623
|
1192 } else {
|
dongsheng@623
|
1193 $self->{encoder}=find_encoding("ascii");
|
dongsheng@623
|
1194 }
|
dongsheng@623
|
1195 return;
|
dongsheng@623
|
1196 }
|
dongsheng@623
|
1197
|
dongsheng@623
|
1198 if ($self->{options}{'porefs'} eq "none") {
|
dongsheng@623
|
1199 $reference = "";
|
dongsheng@623
|
1200 } elsif ($self->{options}{'porefs'} eq "noline") {
|
dongsheng@623
|
1201 $reference =~ s/:[0-9]*/:1/g;
|
dongsheng@623
|
1202 }
|
dongsheng@623
|
1203
|
dongsheng@623
|
1204 if (defined($self->{po}{$msgid})) {
|
dongsheng@623
|
1205 warn wrap_mod("po4a::po",
|
dongsheng@623
|
1206 dgettext("po4a","msgid defined twice: %s"),
|
dongsheng@623
|
1207 $msgid)
|
dongsheng@623
|
1208 if (0); # FIXME: put a verbose stuff
|
dongsheng@623
|
1209 if ( defined $msgstr
|
dongsheng@623
|
1210 and defined $self->{po}{$msgid}{'msgstr'}
|
dongsheng@623
|
1211 and $self->{po}{$msgid}{'msgstr'} ne $msgstr) {
|
dongsheng@623
|
1212 my $txt=quote_text($msgid);
|
dongsheng@623
|
1213 my ($first,$second)=
|
dongsheng@623
|
1214 (format_comment(". ",$self->{po}{$msgid}{'reference'}).
|
dongsheng@623
|
1215 quote_text($self->{po}{$msgid}{'msgstr'}),
|
dongsheng@623
|
1216
|
dongsheng@623
|
1217 format_comment(". ",$reference).
|
dongsheng@623
|
1218 quote_text($msgstr));
|
dongsheng@623
|
1219
|
dongsheng@623
|
1220 if ($keep_conflict) {
|
dongsheng@623
|
1221 if ($self->{po}{$msgid}{'msgstr'} =~ m/^#-#-#-#-# .* #-#-#-#-#\\n/s) {
|
dongsheng@623
|
1222 $msgstr = $self->{po}{$msgid}{'msgstr'}.
|
dongsheng@623
|
1223 "\\n#-#-#-#-# $transref #-#-#-#-#\\n".
|
dongsheng@623
|
1224 $msgstr;
|
dongsheng@623
|
1225 } else {
|
dongsheng@623
|
1226 $msgstr = "#-#-#-#-# ".
|
dongsheng@623
|
1227 $self->{po}{$msgid}{'transref'}.
|
dongsheng@623
|
1228 " #-#-#-#-#\\n".
|
dongsheng@623
|
1229 $self->{po}{$msgid}{'msgstr'}."\\n".
|
dongsheng@623
|
1230 "#-#-#-#-# $transref #-#-#-#-#\\n".
|
dongsheng@623
|
1231 $msgstr;
|
dongsheng@623
|
1232 }
|
dongsheng@623
|
1233 # Every msgid will have the same list of references.
|
dongsheng@623
|
1234 # Only keep the last list.
|
dongsheng@623
|
1235 $self->{po}{$msgid}{'reference'} = "";
|
dongsheng@623
|
1236 } else {
|
dongsheng@623
|
1237 warn wrap_msg(dgettext("po4a",
|
dongsheng@623
|
1238 "Translations don't match for:\n".
|
dongsheng@623
|
1239 "%s\n".
|
dongsheng@623
|
1240 "-->First translation:\n".
|
dongsheng@623
|
1241 "%s\n".
|
dongsheng@623
|
1242 " Second translation:\n".
|
dongsheng@623
|
1243 "%s\n".
|
dongsheng@623
|
1244 " Old translation discarded."),
|
dongsheng@623
|
1245 $txt,$first,$second);
|
dongsheng@623
|
1246 }
|
dongsheng@623
|
1247 }
|
dongsheng@623
|
1248 }
|
dongsheng@623
|
1249 if (defined $transref) {
|
dongsheng@623
|
1250 $self->{po}{$msgid}{'transref'} = $transref;
|
dongsheng@623
|
1251 }
|
dongsheng@623
|
1252 if (defined $reference) {
|
dongsheng@623
|
1253 if (defined $self->{po}{$msgid}{'reference'}) {
|
dongsheng@623
|
1254 $self->{po}{$msgid}{'reference'} .= " ".$reference;
|
dongsheng@623
|
1255 } else {
|
dongsheng@623
|
1256 $self->{po}{$msgid}{'reference'} = $reference;
|
dongsheng@623
|
1257 }
|
dongsheng@623
|
1258 }
|
dongsheng@623
|
1259 $self->{po}{$msgid}{'msgstr'} = $msgstr;
|
dongsheng@623
|
1260 $self->{po}{$msgid}{'comment'} = $comment;
|
dongsheng@623
|
1261 $self->{po}{$msgid}{'automatic'} = $automatic;
|
dongsheng@623
|
1262 if (defined($self->{po}{$msgid}{'pos_doc'})) {
|
dongsheng@623
|
1263 $self->{po}{$msgid}{'pos_doc'} .= " ".$self->{count_doc}++;
|
dongsheng@623
|
1264 } else {
|
dongsheng@623
|
1265 $self->{po}{$msgid}{'pos_doc'} = $self->{count_doc}++;
|
dongsheng@623
|
1266 }
|
dongsheng@623
|
1267 unless (defined($self->{po}{$msgid}{'pos'})) {
|
dongsheng@623
|
1268 $self->{po}{$msgid}{'pos'} = $self->{count}++;
|
dongsheng@623
|
1269 }
|
dongsheng@623
|
1270 $self->{po}{$msgid}{'type'} = $type;
|
dongsheng@623
|
1271 $self->{po}{$msgid}{'plural'} = $entry{'plural'}
|
dongsheng@623
|
1272 if defined $entry{'plural'};
|
dongsheng@623
|
1273
|
dongsheng@623
|
1274 if (defined($flags)) {
|
dongsheng@623
|
1275 $flags = " $flags ";
|
dongsheng@623
|
1276 $flags =~ s/,/ /g;
|
dongsheng@623
|
1277 foreach my $flag (@known_flags) {
|
dongsheng@623
|
1278 if ($flags =~ /\s$flag\s/) { # if flag to be set
|
dongsheng@623
|
1279 unless ( defined($self->{po}{$msgid}{'flags'})
|
dongsheng@623
|
1280 && $self->{po}{$msgid}{'flags'} =~ /\b$flag\b/) {
|
dongsheng@623
|
1281 # flag not already set
|
dongsheng@623
|
1282 if (defined $self->{po}{$msgid}{'flags'}) {
|
dongsheng@623
|
1283 $self->{po}{$msgid}{'flags'} .= " ".$flag;
|
dongsheng@623
|
1284 } else {
|
dongsheng@623
|
1285 $self->{po}{$msgid}{'flags'} = $flag;
|
dongsheng@623
|
1286 }
|
dongsheng@623
|
1287 }
|
dongsheng@623
|
1288 }
|
dongsheng@623
|
1289 }
|
dongsheng@623
|
1290 }
|
dongsheng@623
|
1291 # print STDERR "stored ((($msgid)))=>(((".$self->{po}{$msgid}{'msgstr'}.")))\n\n";
|
dongsheng@623
|
1292
|
dongsheng@623
|
1293 }
|
dongsheng@623
|
1294
|
dongsheng@623
|
1295 =back
|
dongsheng@623
|
1296
|
dongsheng@623
|
1297 =head1 Miscellaneous functions
|
dongsheng@623
|
1298
|
dongsheng@623
|
1299 =over 4
|
dongsheng@623
|
1300
|
dongsheng@623
|
1301 =item count_entries()
|
dongsheng@623
|
1302
|
dongsheng@623
|
1303 Returns the number of entries in the catalog (without the header).
|
dongsheng@623
|
1304
|
dongsheng@623
|
1305 =cut
|
dongsheng@623
|
1306
|
dongsheng@623
|
1307 sub count_entries($) {
|
dongsheng@623
|
1308 my $self=shift;
|
dongsheng@623
|
1309 return $self->{count};
|
dongsheng@623
|
1310 }
|
dongsheng@623
|
1311
|
dongsheng@623
|
1312 =item count_entries_doc()
|
dongsheng@623
|
1313
|
dongsheng@623
|
1314 Returns the number of entries in document. If a string appears multiple times
|
dongsheng@623
|
1315 in the document, it will be counted multiple times
|
dongsheng@623
|
1316
|
dongsheng@623
|
1317 =cut
|
dongsheng@623
|
1318
|
dongsheng@623
|
1319 sub count_entries_doc($) {
|
dongsheng@623
|
1320 my $self=shift;
|
dongsheng@623
|
1321 return $self->{count_doc};
|
dongsheng@623
|
1322 }
|
dongsheng@623
|
1323
|
dongsheng@623
|
1324 =item msgid($)
|
dongsheng@623
|
1325
|
dongsheng@623
|
1326 Returns the msgid of the given number.
|
dongsheng@623
|
1327
|
dongsheng@623
|
1328 =cut
|
dongsheng@623
|
1329
|
dongsheng@623
|
1330 sub msgid($$) {
|
dongsheng@623
|
1331 my $self=shift;
|
dongsheng@623
|
1332 my $num=shift;
|
dongsheng@623
|
1333
|
dongsheng@623
|
1334 foreach my $msgid ( keys %{$self->{po}} ) {
|
dongsheng@623
|
1335 return $msgid if ($self->{po}{$msgid}{'pos'} eq $num);
|
dongsheng@623
|
1336 }
|
dongsheng@623
|
1337 return undef;
|
dongsheng@623
|
1338 }
|
dongsheng@623
|
1339
|
dongsheng@623
|
1340 =item msgid_doc($)
|
dongsheng@623
|
1341
|
dongsheng@623
|
1342 Returns the msgid with the given position in the document.
|
dongsheng@623
|
1343
|
dongsheng@623
|
1344 =cut
|
dongsheng@623
|
1345
|
dongsheng@623
|
1346 sub msgid_doc($$) {
|
dongsheng@623
|
1347 my $self=shift;
|
dongsheng@623
|
1348 my $num=shift;
|
dongsheng@623
|
1349
|
dongsheng@623
|
1350 foreach my $msgid ( keys %{$self->{po}} ) {
|
dongsheng@623
|
1351 foreach my $pos (split / /, $self->{po}{$msgid}{'pos_doc'}) {
|
dongsheng@623
|
1352 return $msgid if ($pos eq $num);
|
dongsheng@623
|
1353 }
|
dongsheng@623
|
1354 }
|
dongsheng@623
|
1355 return undef;
|
dongsheng@623
|
1356 }
|
dongsheng@623
|
1357
|
dongsheng@623
|
1358 =item get_charset()
|
dongsheng@623
|
1359
|
dongsheng@623
|
1360 Returns the character set specified in the po header. If it hasn't been
|
dongsheng@623
|
1361 set, it will return "CHARSET".
|
dongsheng@623
|
1362
|
dongsheng@623
|
1363 =cut
|
dongsheng@623
|
1364
|
dongsheng@623
|
1365 sub get_charset() {
|
dongsheng@623
|
1366 my $self=shift;
|
dongsheng@623
|
1367
|
dongsheng@623
|
1368 $self->{header} =~ /charset=(.*?)[\s\\]/;
|
dongsheng@623
|
1369
|
dongsheng@623
|
1370 if (defined $1) {
|
dongsheng@623
|
1371 return $1;
|
dongsheng@623
|
1372 } else {
|
dongsheng@623
|
1373 return "CHARSET";
|
dongsheng@623
|
1374 }
|
dongsheng@623
|
1375 }
|
dongsheng@623
|
1376
|
dongsheng@623
|
1377 =item set_charset($)
|
dongsheng@623
|
1378
|
dongsheng@623
|
1379 This sets the character set of the po header to the value specified in its
|
dongsheng@623
|
1380 first argument. If you never call this function (and no file with a specified
|
dongsheng@623
|
1381 character set is read), the default value is left to "CHARSET". This value
|
dongsheng@623
|
1382 doesn't change the behavior of this module, it's just used to fill that field
|
dongsheng@623
|
1383 in the header, and to return it in get_charset().
|
dongsheng@623
|
1384
|
dongsheng@623
|
1385 =cut
|
dongsheng@623
|
1386
|
dongsheng@623
|
1387 sub set_charset() {
|
dongsheng@623
|
1388 my $self=shift;
|
dongsheng@623
|
1389
|
dongsheng@623
|
1390 my ($newchar,$oldchar);
|
dongsheng@623
|
1391 $newchar = shift;
|
dongsheng@623
|
1392 $oldchar = $self->get_charset();
|
dongsheng@623
|
1393
|
dongsheng@623
|
1394 $self->{header} =~ s/$oldchar/$newchar/;
|
dongsheng@623
|
1395 $self->{encoder}=find_encoding($newchar);
|
dongsheng@623
|
1396 }
|
dongsheng@623
|
1397
|
dongsheng@623
|
1398 #----[ helper functions ]---------------------------------------------------
|
dongsheng@623
|
1399
|
dongsheng@623
|
1400 # transforme the string from its po file representation to the form which
|
dongsheng@623
|
1401 # should be used to print it
|
dongsheng@623
|
1402 sub unescape_text {
|
dongsheng@623
|
1403 my $text = shift;
|
dongsheng@623
|
1404
|
dongsheng@623
|
1405 print STDERR "\nunescape [$text]====" if $debug{'escape'};
|
dongsheng@623
|
1406 $text = join("",split(/\n/,$text));
|
dongsheng@623
|
1407 $text =~ s/\\"/"/g;
|
dongsheng@623
|
1408 # unescape newlines
|
dongsheng@623
|
1409 # NOTE on \G:
|
dongsheng@623
|
1410 # The following regular expression introduce newlines.
|
dongsheng@623
|
1411 # Thus, ^ doesn't match all beginnings of lines.
|
dongsheng@623
|
1412 # \G is a zero-width assertion that matches the position
|
dongsheng@623
|
1413 # of the previous substitution with s///g. As every
|
dongsheng@623
|
1414 # substitution ends by a newline, it always matches a
|
dongsheng@623
|
1415 # position just after a newline.
|
dongsheng@623
|
1416 $text =~ s/( # $1:
|
dongsheng@623
|
1417 (\G|[^\\]) # beginning of the line or any char
|
dongsheng@623
|
1418 # different from '\'
|
dongsheng@623
|
1419 (\\\\)* # followed by any even number of '\'
|
dongsheng@623
|
1420 )\\n # and followed by an escaped newline
|
dongsheng@623
|
1421 /$1\n/sgx; # single string, match globally, allow comments
|
dongsheng@623
|
1422 # unescape tabulations
|
dongsheng@623
|
1423 $text =~ s/( # $1:
|
dongsheng@623
|
1424 (\G|[^\\])# beginning of the line or any char
|
dongsheng@623
|
1425 # different from '\'
|
dongsheng@623
|
1426 (\\\\)* # followed by any even number of '\'
|
dongsheng@623
|
1427 )\\t # and followed by an escaped tabulation
|
dongsheng@623
|
1428 /$1\t/mgx; # multilines string, match globally, allow comments
|
dongsheng@623
|
1429 # and unescape the escape character
|
dongsheng@623
|
1430 $text =~ s/\\\\/\\/g;
|
dongsheng@623
|
1431 print STDERR ">$text<\n" if $debug{'escape'};
|
dongsheng@623
|
1432
|
dongsheng@623
|
1433 return $text;
|
dongsheng@623
|
1434 }
|
dongsheng@623
|
1435
|
dongsheng@623
|
1436 # transform the string to its representation as it should be written in po
|
dongsheng@623
|
1437 # files
|
dongsheng@623
|
1438 sub escape_text {
|
dongsheng@623
|
1439 my $text = shift;
|
dongsheng@623
|
1440
|
dongsheng@623
|
1441 print STDERR "\nescape [$text]====" if $debug{'escape'};
|
dongsheng@623
|
1442 $text =~ s/\\/\\\\/g;
|
dongsheng@623
|
1443 $text =~ s/"/\\"/g;
|
dongsheng@623
|
1444 $text =~ s/\n/\\n/g;
|
dongsheng@623
|
1445 $text =~ s/\t/\\t/g;
|
dongsheng@623
|
1446 print STDERR ">$text<\n" if $debug{'escape'};
|
dongsheng@623
|
1447
|
dongsheng@623
|
1448 return $text;
|
dongsheng@623
|
1449 }
|
dongsheng@623
|
1450
|
dongsheng@623
|
1451 # put quotes around the string on each lines (without escaping it)
|
dongsheng@623
|
1452 # It does also normalize the text (ie, make sure its representation is wraped
|
dongsheng@623
|
1453 # on the 80th char, but without changing the meaning of the string)
|
dongsheng@623
|
1454 sub quote_text {
|
dongsheng@623
|
1455 my $string = shift;
|
dongsheng@623
|
1456
|
dongsheng@623
|
1457 return '""' unless defined($string) && length($string);
|
dongsheng@623
|
1458
|
dongsheng@623
|
1459 print STDERR "\nquote [$string]====" if $debug{'quote'};
|
dongsheng@623
|
1460 # break lines on newlines, if any
|
dongsheng@623
|
1461 # see unescape_text for an explanation on \G
|
dongsheng@623
|
1462 $string =~ s/( # $1:
|
dongsheng@623
|
1463 (\G|[^\\]) # beginning of the line or any char
|
dongsheng@623
|
1464 # different from '\'
|
dongsheng@623
|
1465 (\\\\)* # followed by any even number of '\'
|
dongsheng@623
|
1466 \\n) # and followed by an escaped newline
|
dongsheng@623
|
1467 /$1\n/sgx; # single string, match globally, allow comments
|
dongsheng@623
|
1468 $string = wrap($string);
|
dongsheng@623
|
1469 my @string = split(/\n/,$string);
|
dongsheng@623
|
1470 $string = join ("\"\n\"",@string);
|
dongsheng@623
|
1471 $string = "\"$string\"";
|
dongsheng@623
|
1472 if (scalar @string > 1 && $string[0] ne '') {
|
dongsheng@623
|
1473 $string = "\"\"\n".$string;
|
dongsheng@623
|
1474 }
|
dongsheng@623
|
1475
|
dongsheng@623
|
1476 print STDERR ">$string<\n" if $debug{'quote'};
|
dongsheng@623
|
1477 return $string;
|
dongsheng@623
|
1478 }
|
dongsheng@623
|
1479
|
dongsheng@623
|
1480 # undo the work of the quote_text function
|
dongsheng@623
|
1481 sub unquote_text {
|
dongsheng@623
|
1482 my $string = shift;
|
dongsheng@623
|
1483 print STDERR "\nunquote [$string]====" if $debug{'quote'};
|
dongsheng@623
|
1484 $string =~ s/^""\\n//s;
|
dongsheng@623
|
1485 $string =~ s/^"(.*)"$/$1/s;
|
dongsheng@623
|
1486 $string =~ s/"\n"//gm;
|
dongsheng@623
|
1487 # Note: an even number of '\' could precede \\n, but I could not build a
|
dongsheng@623
|
1488 # document to test this
|
dongsheng@623
|
1489 $string =~ s/([^\\])\\n\n/$1!!DUMMYPOPM!!/gm;
|
dongsheng@623
|
1490 $string =~ s|!!DUMMYPOPM!!|\\n|gm;
|
dongsheng@623
|
1491 print STDERR ">$string<\n" if $debug{'quote'};
|
dongsheng@623
|
1492 return $string;
|
dongsheng@623
|
1493 }
|
dongsheng@623
|
1494
|
dongsheng@623
|
1495 # canonize the string: write it on only one line, changing consecutive
|
dongsheng@623
|
1496 # whitespace to only one space.
|
dongsheng@623
|
1497 # Warning, it changes the string and should only be called if the string is
|
dongsheng@623
|
1498 # plain text
|
dongsheng@623
|
1499 sub canonize {
|
dongsheng@623
|
1500 my $text=shift;
|
dongsheng@623
|
1501 print STDERR "\ncanonize [$text]====" if $debug{'canonize'};
|
dongsheng@623
|
1502 $text =~ s/^ *//s;
|
dongsheng@623
|
1503 $text =~ s/^[ \t]+/ /gm;
|
dongsheng@623
|
1504 # if ($text eq "\n"), it messed up the first string (header)
|
dongsheng@623
|
1505 $text =~ s/\n/ /gm if ($text ne "\n");
|
dongsheng@623
|
1506 $text =~ s/([.)]) +/$1 /gm;
|
dongsheng@623
|
1507 $text =~ s/([^.)]) */$1 /gm;
|
dongsheng@623
|
1508 $text =~ s/ *$//s;
|
dongsheng@623
|
1509 print STDERR ">$text<\n" if $debug{'canonize'};
|
dongsheng@623
|
1510 return $text;
|
dongsheng@623
|
1511 }
|
dongsheng@623
|
1512
|
dongsheng@623
|
1513 # wraps the string. We don't use Text::Wrap since it mangles whitespace at
|
dongsheng@623
|
1514 # the end of splited line
|
dongsheng@623
|
1515 sub wrap {
|
dongsheng@623
|
1516 my $text=shift;
|
dongsheng@623
|
1517 return "0" if ($text eq '0');
|
dongsheng@623
|
1518 my $col=shift || 76;
|
dongsheng@623
|
1519 my @lines=split(/\n/,"$text");
|
dongsheng@623
|
1520 my $res="";
|
dongsheng@623
|
1521 my $first=1;
|
dongsheng@623
|
1522 while (defined(my $line=shift @lines)) {
|
dongsheng@623
|
1523 if ($first && length($line) > $col - 10) {
|
dongsheng@623
|
1524 unshift @lines,$line;
|
dongsheng@623
|
1525 $first=0;
|
dongsheng@623
|
1526 next;
|
dongsheng@623
|
1527 }
|
dongsheng@623
|
1528 if (length($line) > $col) {
|
dongsheng@623
|
1529 my $pos=rindex($line," ",$col);
|
dongsheng@623
|
1530 while (substr($line,$pos-1,1) eq '.' && $pos != -1) {
|
dongsheng@623
|
1531 $pos=rindex($line," ",$pos-1);
|
dongsheng@623
|
1532 }
|
dongsheng@623
|
1533 if ($pos == -1) {
|
dongsheng@623
|
1534 # There are no spaces in the first $col chars, pick-up the
|
dongsheng@623
|
1535 # first space
|
dongsheng@623
|
1536 $pos = index($line," ");
|
dongsheng@623
|
1537 }
|
dongsheng@623
|
1538 if ($pos != -1) {
|
dongsheng@623
|
1539 my $end=substr($line,$pos+1);
|
dongsheng@623
|
1540 $line=substr($line,0,$pos+1);
|
dongsheng@623
|
1541 if ($end =~ s/^( +)//) {
|
dongsheng@623
|
1542 $line .= $1;
|
dongsheng@623
|
1543 }
|
dongsheng@623
|
1544 unshift @lines,$end;
|
dongsheng@623
|
1545 }
|
dongsheng@623
|
1546 }
|
dongsheng@623
|
1547 $first=0;
|
dongsheng@623
|
1548 $res.="$line\n";
|
dongsheng@623
|
1549 }
|
dongsheng@623
|
1550 # Restore the original trailing spaces
|
dongsheng@623
|
1551 $res =~ s/\s+$//s;
|
dongsheng@623
|
1552 if ($text =~ m/(\s+)$/s) {
|
dongsheng@623
|
1553 $res .= $1;
|
dongsheng@623
|
1554 }
|
dongsheng@623
|
1555 return $res;
|
dongsheng@623
|
1556 }
|
dongsheng@623
|
1557
|
dongsheng@623
|
1558 # outputs properly a '# ... ' line to be put in the po file
|
dongsheng@623
|
1559 sub format_comment {
|
dongsheng@623
|
1560 my $comment=shift;
|
dongsheng@623
|
1561 my $char=shift;
|
dongsheng@623
|
1562 my $result = "#". $char . $comment;
|
dongsheng@623
|
1563 $result =~ s/\n/\n#$char/gs;
|
dongsheng@623
|
1564 $result =~ s/^#$char$/#/gm;
|
dongsheng@623
|
1565 $result .= "\n";
|
dongsheng@623
|
1566 return $result;
|
dongsheng@623
|
1567 }
|
dongsheng@623
|
1568
|
dongsheng@623
|
1569
|
dongsheng@623
|
1570 1;
|
dongsheng@623
|
1571 __END__
|
dongsheng@623
|
1572
|
dongsheng@623
|
1573 =back
|
dongsheng@623
|
1574
|
dongsheng@623
|
1575 =head1 AUTHORS
|
dongsheng@623
|
1576
|
dongsheng@623
|
1577 Denis Barbier <barbier@linuxfr.org>
|
dongsheng@623
|
1578 Martin Quinson (mquinson#debian.org)
|
dongsheng@623
|
1579
|
dongsheng@623
|
1580 =cut
|