/usr/lib/kubuntu-l10n/libexec/createdesktopcontext.pl is in pkg-kde-tools 0.15.28ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 | #! /usr/bin/env perl
# Version for KDE4
use strict;
use warnings;
use v5.8.0; # We really want decent Unicode support
use Getopt::Long;
sub printdate
{
printf ( "%04i", ( $_[5] + 1900 ) );
print "-";
printf ( "%02i", $_[4] + 1);
print "-";
printf ( "%02i", $_[3] );
print " ";
printf ( "%02i", $_[2] );
print ":";
printf ( "%02i", $_[1] );
print "+0000";
}
sub prepare
{
binmode( STDOUT, ":utf8" );
my @now = gmtime();
print "#, fuzzy\n";
print "msgid \"\"\n";
print "msgstr \"\"\n";
print "\"Project-Id-Version: desktop files\\n\"\n";
print "\"Report-Msgid-Bugs-To: http://bugs.kde.org\\n\"\n";
print "\"POT-Creation-Date: "; printdate( @now ); print "\\n\"\n";
print "\"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\\n\"\n";
print "\"Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n\"\n";
print "\"Language-Team: LANGUAGE <kde-i18n-doc\@kde.org>\\n\"\n";
print "\"MIME-Version: 1.0\\n\"\n";
print "\"Content-Type: text/plain; charset=UTF-8\\n\"\n";
print "\"Content-Transfer-Encoding: 8bit\\n\"\n";
print "\n\n";
}
sub processfiles
{
my ( $files, $basedir) = ( @_ );
for my $filename ( @$files )
{
chomp( $filename );
next if -d $filename;
open( FH, "<:utf8", $filename ) or warn "Cannot open file $filename";
# print STDERR "Processing $filename...\n"; ### DEBUG
my $regexp = qr{^(Name|Comment|Language|Keywords|X-KDE-Keywords|About|Description|GenericName|Query|ExtraNames|X-KDE-Submenu)=(.+)};
# Context is given by preceeding the entry with # ctxt:... comment.
# For example, this:
# # ctxt: Blah blah
# Name=...
# ends up as "Name|Blah blah" context in the PO file.
my $regexp_ctxt = qr{^\s*#\s*ctxt\s*:\s*(.*?)\s*$};
my $context_free = "";
while( <FH> )
{
if ( m/$regexp/o )
{
my $context = $1;
my $msgid = $2;
if ($context_free) {
$context = "$context|$context_free";
$context =~ s/\\/\\\\/g;
$context =~ s/\"/\\\"/g;
}
chomp( $msgid );
$msgid =~ s/$regexp//;
$msgid =~ s/\\/\\\\/g;
$msgid =~ s/\"/\\\"/g;
if ($msgid =~ m/ +$/) {
$msgid =~ s/ +$//; # remove trailing spaces
print STDERR "ERROR: white space at the end of $msgid in $filename\n";
}
if ($msgid =~ m/\r$/) {
$msgid =~ s/[ \r]+$//; # remove trailing space or CR characters
print STDERR "ERROR: CR at the end of $msgid in $filename\n";
}
$filename =~ s,^$basedir/,,;
print "#: $filename:$.\n";
print "msgctxt \"$context\"\n";
print "msgid \"$msgid\"\n";
print "msgstr \"\"\n";
print "\n";
}
# Free context refers only to the immediate next line.
# Thus, if next line is not extracted, current context is gone.
if ( m/$regexp_ctxt/o ) {
$context_free = $1;
} else {
$context_free = "";
}
}
close( FH );
}
}
my $onefilelist;
my $basedir;
GetOptions ( "file-list=s" => \$onefilelist,
"base-dir=s" => \$basedir
);
prepare;
open( FILELIST, $onefilelist ) or warn ( "Cannot open file list: $onefilelist" );
my @thislist = <FILELIST>;
processfiles( \@thislist, $basedir );
close( FILELIST );
|