|
|
|
|
|
# Toying at an interface between Perl and GNU gettext .mo format.
|
|
|
|
|
|
# Copyright (C) 1995 Free Software Foundation, Inc.
|
|
|
|
|
|
# Fran<61>ois Pinard <pinard@iro.umontreal.ca>, 1995.
|
|
|
|
|
|
|
|
|
|
|
|
textdomain ("tar");
|
|
|
|
|
|
print &_("Try \`%s --help\' for more information.\n");
|
|
|
|
|
|
exit 0;
|
|
|
|
|
|
|
|
|
|
|
|
## --------------------------------------------------------------- ##
|
|
|
|
|
|
## The `&textdomain (DOMAIN_NAME)' routine reads the given domain ##
|
|
|
|
|
|
## into an associative array %_, able to later translate strings. ##
|
|
|
|
|
|
## --------------------------------------------------------------- ##
|
|
|
|
|
|
|
|
|
|
|
|
sub textdomain
|
|
|
|
|
|
{
|
|
|
|
|
|
local ($language, $catalog, $domain, $buffer);
|
|
|
|
|
|
local ($reverse);
|
|
|
|
|
|
local ($magic, $revision, $nstrings, $orig_tab_offset, $trans_tab_offset);
|
|
|
|
|
|
local ($orig_length, $orig_pointer, $trans_length, $trans_pointer);
|
|
|
|
|
|
|
|
|
|
|
|
%_ = ();
|
|
|
|
|
|
|
|
|
|
|
|
$language = $ENV{"LANG"};
|
|
|
|
|
|
return if ! $language;
|
|
|
|
|
|
$domain = $_[0];
|
|
|
|
|
|
$catalog = "/usr/local/share/locale/$language/LC_MESSAGES/$domain.mo";
|
|
|
|
|
|
|
|
|
|
|
|
open (CATALOG, $catalog) || return;
|
|
|
|
|
|
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 (4);
|
|
|
|
|
|
$nstrings = &mo_format_value (8);
|
|
|
|
|
|
$orig_tab_offset = &mo_format_value (12);
|
|
|
|
|
|
$trans_tab_offset = &mo_format_value (16);
|
|
|
|
|
|
|
|
|
|
|
|
while ($nstrings-- > 0)
|
|
|
|
|
|
{
|
|
|
|
|
|
$orig_length = &mo_format_value ($orig_tab_offset);
|
|
|
|
|
|
$orig_pointer = &mo_format_value ($orig_tab_offset + 4);
|
|
|
|
|
|
$orig_tab_offset += 8;
|
|
|
|
|
|
|
|
|
|
|
|
$trans_length = &mo_format_value ($trans_tab_offset);
|
|
|
|
|
|
$trans_pointer = &mo_format_value ($trans_tab_offset + 4);
|
|
|
|
|
|
$trans_tab_offset += 8;
|
|
|
|
|
|
|
|
|
|
|
|
$_{substr ($buffer, $orig_pointer, $orig_length)}
|
|
|
|
|
|
= substr ($buffer, $trans_pointer, $trans_length);
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
## ----------------------------------------------------------------- ##
|
|
|
|
|
|
## 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
|
|
|
|
|
|
{
|
|
|
|
|
|
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 _
|
|
|
|
|
|
{
|
|
|
|
|
|
defined $_{$_[0]} ? $_{$_[0]} : $_[0];
|
|
|
|
|
|
}
|
