1#!/usr/bin/perl
2
3# msgitm - gettext po file parsing library
4# Copyright (C) 2010 Free Software Foundation, Inc.
5# 2010  Martin von Gagern
6#
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program.  If not, see <http://www.gnu.org/licenses/>.
19
20=pod
21
22=head1 NAME
23
24msgitm - gettext po file parsing library
25
26=head1 SYNOPSIS
27
28    use msgitm;
29
30=head1 DESCRIPTION
31
32Provides functionality to parse and handle translation message files
33in GNU gettext po format.
34
35=head1 API
36
37=cut
38
39use strict;
40use warnings;
41
42package msgitm;
43
44sub new() {
45  my $this = { head => [], msgid => [], msgstr => [] };
46  return bless $this;
47}
48
49sub accessor($$$@) {
50  my ($this, $wantarray, $field, @newval) = @_;
51  @{$this->{$field}} = @newval if (@newval);
52  return $wantarray ? @{$this->{$field}} : join('', @{$this->{$field}});
53}
54
55=head2 $msgitm->head([@newhead])
56
57Set or retrieve the whitespace and comments leading up to a
58message. If a list is passed, it should consist of lines of text,
59including terminating newlines. All lines should be whitespace only or
60starting in a C<#>. The return value is such a list, if called in list
61context, or the concatenation of these lines, if called in scalar
62context.
63
64=cut
65
66sub head($@) {
67  my ($this, @newval) = @_;
68  return accessor($this, wantarray, 'head', @newval);
69}
70
71=head2 $msgitm->msgid([@newid]), $msgitm->msgstr([@newstr])
72
73Set or retrieve the untranslated or translated message. Both these
74messages are represented as lists of strings, where each string
75corresponds to the part inside the quotes of a single line in the po
76file. In other words, the logical value of a message is the
77concatenation of these strings, and the strings should not contain
78unescaped quotation marks or newlines, but instead should use C escape
79sequences for these. Giving an array allows setting these values. When
80called in list context, the list of lines is returned. In scalar
81context they are concatenated to represent the logical value of the
82message.
83
84=cut
85
86sub msgid($@) {
87  my ($this, @newval) = @_;
88  return accessor($this, wantarray, 'msgid', @newval);
89}
90
91sub msgstr($@) {
92  my ($this, @newval) = @_;
93  return accessor($this, wantarray, 'msgstr', @newval);
94}
95
96=head2 $msgitm->block
97
98Returns the block corresponding to a given message, including
99comments, msgid and msgstr, in a format suitable for generation of a
100modified po file.
101
102=cut
103
104sub block($) {
105  my ($this) = @_;
106  my $res = $this->head;
107  if (@{$this->{msgid}}) {
108    $res .= qq{msgid "} . join(qq{"\n"}, $this->msgid) . qq{"\n};
109    $res .= qq{msgstr "} . join(qq{"\n"}, $this->msgstr) . qq{"\n};
110  }
111  return $res;
112}
113
114=head2 $msgitm->srcrefs
115
116Retrieve a list of source references. This is the content of all lines
117starting with C<#:>, split at whitespace.
118
119=cut
120
121sub srcrefs($) {
122  my ($this) = @_;
123  my @res = ();
124  for my $h ($this->head) {
125    if ($h =~ s/^#: //) {
126      chomp($h);
127      push @res, split(/\s+/, $h);
128    }
129  }
130  return @res;
131}
132
133=head2 $msgitm->srcfiles
134
135This is like the source references returned from I<srcrefs> but
136without the line number part usually contained in these comments.
137
138=cut
139
140sub srcfiles($) {
141  my ($this) = @_;
142  my @res = ();
143  for my $r ($this->srcrefs) {
144    $r =~ s/:\d+$//;
145    push @res, $r;
146  }
147  return @res;
148}
149
150=head2 $msgitm->set_flag($flag)
151
152Sets a given flag. Ensures the flag is present in a comment starting
153with C<#,>. If it already is, nothing will be changed. If a flags
154comment already exists, the value will be added to its head. Otherwise
155a new comment line will be inserted.
156
157=cut
158
159sub set_flag($$) {
160  my ($this, $flag) = @_;
161  for (my $i = $#{$this->{head}}; $i >= 0; --$i) {
162    my $h = $this->{head}[$i];
163    chomp($h);
164    if ($h =~ s/^#,\s*//) {
165      my @flags = split(/,\s*/, $h);
166      return if grep { $_ eq $flag } @flags;
167      $this->{head}[$i] = qq{#, } . join(', ', $flag, @flags) . qq{\n};
168      return;
169    }
170  }
171  push @{$this->{head}}, "#, $flag\n";
172}
173
174=head2 $msgitm->add_comments(@comments)
175
176Adds translator comments starting with C<# > to the list of comments
177leading to this message.
178
179=cut
180
181sub add_comments($@) {
182  my ($this, @comments) = @_;
183  my $i;
184  for ($i = $#{$this->{head}}; $i >= 0; --$i) {
185    last unless $this->{head}[$i] =~ /^#\S/;
186  }
187  splice(@{$this->{head}}, $i + 1, 0, map { "# $_\n" } @comments);
188}
189
190=head2 msgitm->parse($file)
191
192Parses the named po file. Returns a list of msgitm objects.
193
194=cut
195
196sub parse($) {
197  my ($cls, $file) = @_;
198  my $itm = new;
199  my @res = ( $itm );
200  my $mode = "head";
201  open IN, "<", $file or die "Error opening $file";
202  while (<IN>) {
203    $mode = $1 if (s/^(msgid|msgstr)\s+"/"/);
204    if (/^"(.*)"\n$/) {
205      $_ = $1;
206    } elsif ($mode ne "head") {
207      $itm = new;
208      push @res, $itm;
209      $mode = "head";
210    }
211    push @{$itm->{$mode}}, $_;
212  }
213  close IN or die "Error closing $file";
214  return @res;
215}
216
217=head1 HISTORY
218
219This script was originally written for GNU wdiff.
220There it's been used for F<print-po.pl> as well as for one-time
221migration of usage help messages when these were split into individual
222lines.
223
224=head1 AUTHOR
225
226Written 2010 by Martin von Gagern
227
228=head1 COPYRIGHT
229
230Copyright (C) 2010 Free Software Foundation, Inc.
231
232Licensed under the GNU General Public License version 3 or later.
233
234=cut
235
2361;
237