/usr/share/namazu/pl/gettext.pl is in namazu2-index-tools 2.0.21-9.
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 121 122 123 124 125 126 127 128 129 130 | # Toying at an interface between Perl and GNU gettext .mo format.
# Copyright (C) 1995 Free Software Foundation, Inc.
# Fran.ANgois Pinard <pinard@iro.umontreal.ca>, 1995.
#
# Modified by NOKUBI Takatsugu.
# Copyright (C) 1999, 2000 NOKUBI Takatsugu <knok@daionet.gr.jp>
## --------------------------------------------------------------- ##
## The `&textdomain (DOMAIN_NAME, LANG)' routine reads the given ##
## domain into an associative array %_, able to later translate ##
## strings. ##
## --------------------------------------------------------------- ##
sub textdomain
{
my ($language, $catalog, $domain, $buffer);
my ($reverse);
my ($magic, $revision, $nstrings, $orig_tab_offset, $trans_tab_offset);
my ($orig_length, $orig_pointer, $trans_length, $trans_pointer);
%_ = ();
$domain = $_[0];
$language = $_[1];
return if ! $language;
$catalog = choose_catalog($language, $domain);
return if ! $catalog;
open (CATALOG, $catalog) || return;
binmode (CATALOG);
sysread (CATALOG, $buffer, (stat CATALOG)[7]);
close CATALOG;
$magic = unpack ("I", $buffer);
if (sprintf ("%x", $magic) eq "de120495")
{
$reverse = 1;
}
elsif (sprintf ("%x", $magic) ne "950412de")
{
die "Not a catalog file\n";
}
$revision = &mo_format_value($reverse, $buffer,4);
$nstrings = &mo_format_value($reverse, $buffer,8);
$orig_tab_offset = &mo_format_value($reverse, $buffer,12);
$trans_tab_offset = &mo_format_value($reverse, $buffer,16);
while ($nstrings-- > 0)
{
$orig_length = &mo_format_value($reverse, $buffer,$orig_tab_offset);
$orig_pointer = &mo_format_value($reverse, $buffer,$orig_tab_offset + 4);
$orig_tab_offset += 8;
$trans_length = &mo_format_value($reverse, $buffer,$trans_tab_offset);
$trans_pointer = &mo_format_value($reverse, $buffer,$trans_tab_offset + 4);
$trans_tab_offset += 8;
$_{substr ($buffer, $orig_pointer, $orig_length)}
= substr ($buffer, $trans_pointer, $trans_length);
}
}
sub choose_catalog
{
my ($language, $domain) = @_;
while (1) {
#
# To support a binary package for Windows, we should
# allow to change LOCALEDIR with the environment variable
# `NAMAZULOCALEDIR' after installation is done.
#
# NOTE: Windows has a nasty "drive letter" convention.
#
my $base = "/usr/share/locale";
if (defined $ENV{NAMAZULOCALEDIR}) {
$base = $ENV{NAMAZULOCALEDIR};
}
my $catalog = "$base/$language/LC_MESSAGES/$domain.mo";
return $catalog if -f $catalog; # if the catalog file exists.
# Truncate $language by the following order:
# ja_JP.eucJP -> ja_JP -> ja
unless ($language =~ s/[\._][^\._]+$//) {
return undef;
}
}
}
## ----------------------------------------------------------------- ##
## The `&mo_format_value (ADDRESS)' routine returns the value at a ##
## given address in the .mo format catalog, once read into $buffer ##
## by `&textdomain'. This is a service routine of `&textdomain', ##
## which uses $buffer and $reverse variables local in that routine. ##
## ----------------------------------------------------------------- ##
sub mo_format_value
{
my ($reverse) = shift @_;
my ($buffer) = shift @_;
unpack ("i",
$reverse
? pack ("c4", reverse unpack ("c4", substr ($buffer, $_[0], 4)))
: substr ($buffer, $_[0], 4));
}
## ------------------------------------------------------------ ##
## The `&_(STRING)' routine translates STRING if there is some ##
## translation offered for it in the `%_' associative array, or ##
## return STRING itself, otherwize. ##
## ------------------------------------------------------------ ##
sub _
{
my $msg = $_[0];
$msg =~ s/\$/\\\$/g;
defined $_{$msg} ? $_{$msg} : $_[0];
}
## ------------------------------------------------------------ ##
## Dummy function. ##
## ------------------------------------------------------------ ##
sub N_
{
return $_[0];
}
1;
|