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