namazu2-index-tools 2.0.21-21 / usr / share / namazu / pl / gettext.pl

This file is indexed.

/usr/share/namazu/pl/gettext.pl is in namazu2-index-tools 2.0.21-21.

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;

APT Browse - Built by Thomas Orozco.