code:
#! /bin/false
# vim: set autoindent shiftwidth=4 tabstop=4:
# $Id: VISCII.pm,v 1.1 2009-11-01 19:00:13 pertusus Exp $

# Conversion routines for VISCII.
# Copyright (C) 2002-2009 Guido Flohr <guido@imperia.net>, all
# rights reserved.
# This file is generated, do not edit!

# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU Library General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.

# You should have received a copy of the GNU Library General Public
# License along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.

package Locale::RecodeData::VISCII;

use strict;

require Locale::RecodeData;
use base qw(Locale::RecodeData);

my @to_ucs4 = (
    0x0000,
    0x0001,
    0x1eb2,
    0x0003,
    0x0004,
    0x1eb4,
    0x1eaa,
    0x0007,
    0x0008,
    0x0009,
    0x000a,
    0x000b,
    0x000c,
    0x000d,
    0x000e,
    0x000f,
    0x0010,
    0x0011,
    0x0012,
    0x0013,
    0x1ef6,
    0x0015,
    0x0016,
    0x0017,
    0x0018,
    0x1ef8,
    0x001a,
    0x001b,
    0x001c,
    0x001d,
    0x1ef4,
    0x001f,
    0x0020,
    0x0021,
    0x0022,
    0x0023,
    0x0024,
    0x0025,
    0x0026,
    0x0027,
    0x0028,
    0x0029,
    0x002a,
    0x002b,
    0x002c,
    0x002d,
    0x002e,
    0x002f,
    0x0030,
    0x0031,
    0x0032,
    0x0033,
    0x0034,
    0x0035,
    0x0036,
    0x0037,
    0x0038,
    0x0039,
    0x003a,
    0x003b,
    0x003c,
    0x003d,
    0x003e,
    0x003f,
    0x0040,
    0x0041,
    0x0042,
    0x0043,
    0x0044,
    0x0045,
    0x0046,
    0x0047,
    0x0048,
    0x0049,
    0x004a,
    0x004b,
    0x004c,
    0x004d,
    0x004e,
    0x004f,
    0x0050,
    0x0051,
    0x0052,
    0x0053,
    0x0054,
    0x0055,
    0x0056,
    0x0057,
    0x0058,
    0x0059,
    0x005a,
    0x005b,
    0x005c,
    0x005d,
    0x005e,
    0x005f,
    0x0060,
    0x0061,
    0x0062,
    0x0063,
    0x0064,
    0x0065,
    0x0066,
    0x0067,
    0x0068,
    0x0069,
    0x006a,
    0x006b,
    0x006c,
    0x006d,
    0x006e,
    0x006f,
    0x0070,
    0x0071,
    0x0072,
    0x0073,
    0x0074,
    0x0075,
    0x0076,
    0x0077,
    0x0078,
    0x0079,
    0x007a,
    0x007b,
    0x007c,
    0x007d,
    0x007e,
    0x007f,
    0x1ea0,
    0x1eae,
    0x1eb0,
    0x1eb6,
    0x1ea4,
    0x1ea6,
    0x1ea8,
    0x1eac,
    0x1ebc,
    0x1eb8,
    0x1ebe,
    0x1ec0,
    0x1ec2,
    0x1ec4,
    0x1ec6,
    0x1ed0,
    0x1ed2,
    0x1ed4,
    0x1ed6,
    0x1ed8,
    0x1ee2,
    0x1eda,
    0x1edc,
    0x1ede,
    0x1eca,
    0x1ece,
    0x1ecc,
    0x1ec8,
    0x1ee6,
    0x0168,
    0x1ee4,
    0x1ef2,
    0x00d5,
    0x1eaf,
    0x1eb1,
    0x1eb7,
    0x1ea5,
    0x1ea7,
    0x1ea9,
    0x1ead,
    0x1ebd,
    0x1eb9,
    0x1ebf,
    0x1ec1,
    0x1ec3,
    0x1ec5,
    0x1ec7,
    0x1ed1,
    0x1ed3,
    0x1ed5,
    0x1ed7,
    0x1ee0,
    0x01a0,
    0x1ed9,
    0x1edd,
    0x1edf,
    0x1ecb,
    0x1ef0,
    0x1ee8,
    0x1eea,
    0x1eec,
    0x01a1,
    0x1edb,
    0x01af,
    0x00c0,
    0x00c1,
    0x00c2,
    0x00c3,
    0x1ea2,
    0x0102,
    0x1eb3,
    0x1eb5,
    0x00c8,
    0x00c9,
    0x00ca,
    0x1eba,
    0x00cc,
    0x00cd,
    0x0128,
    0x1ef3,
    0x0110,
    0x1ee9,
    0x00d2,
    0x00d3,
    0x00d4,
    0x1ea1,
    0x1ef7,
    0x1eeb,
    0x1eed,
    0x00d9,
    0x00da,
    0x1ef9,
    0x1ef5,
    0x00dd,
    0x1ee1,
    0x01b0,
    0x00e0,
    0x00e1,
    0x00e2,
    0x00e3,
    0x1ea3,
    0x0103,
    0x1eef,
    0x1eab,
    0x00e8,
    0x00e9,
    0x00ea,
    0x1ebb,
    0x00ec,
    0x00ed,
    0x0129,
    0x1ec9,
    0x0111,
    0x1ef1,
    0x00f2,
    0x00f3,
    0x00f4,
    0x00f5,
    0x1ecf,
    0x1ecd,
    0x1ee5,
    0x00f9,
    0x00fa,
    0x0169,
    0x1ee7,
    0x00fd,
    0x1ee3,
    0x1eee,
);

my @to_utf8 = (
    "\x00",
    "\x01",
    "\xe1\xba\xb2",
    "\x03",
    "\x04",
    "\xe1\xba\xb4",
    "\xe1\xba\xaa",
    "\x07",
    "\x08",
    "\x09",
    "\x0a",
    "\x0b",
    "\x0c",
    "\x0d",
    "\x0e",
    "\x0f",
    "\x10",
    "\x11",
    "\x12",
    "\x13",
    "\xe1\xbb\xb6",
    "\x15",
    "\x16",
    "\x17",
    "\x18",
    "\xe1\xbb\xb8",
    "\x1a",
    "\x1b",
    "\x1c",
    "\x1d",
    "\xe1\xbb\xb4",
    "\x1f",
    "\x20",
    "\x21",
    "\x22",
    "\x23",
    "\x24",
    "\x25",
    "\x26",
    "\x27",
    "\x28",
    "\x29",
    "\x2a",
    "\x2b",
    "\x2c",
    "\x2d",
    "\x2e",
    "\x2f",
    "\x30",
    "\x31",
    "\x32",
    "\x33",
    "\x34",
    "\x35",
    "\x36",
    "\x37",
    "\x38",
    "\x39",
    "\x3a",
    "\x3b",
    "\x3c",
    "\x3d",
    "\x3e",
    "\x3f",
    "\x40",
    "\x41",
    "\x42",
    "\x43",
    "\x44",
    "\x45",
    "\x46",
    "\x47",
    "\x48",
    "\x49",
    "\x4a",
    "\x4b",
    "\x4c",
    "\x4d",
    "\x4e",
    "\x4f",
    "\x50",
    "\x51",
    "\x52",
    "\x53",
    "\x54",
    "\x55",
    "\x56",
    "\x57",
    "\x58",
    "\x59",
    "\x5a",
    "\x5b",
    "\x5c",
    "\x5d",
    "\x5e",
    "\x5f",
    "\x60",
    "\x61",
    "\x62",
    "\x63",
    "\x64",
    "\x65",
    "\x66",
    "\x67",
    "\x68",
    "\x69",
    "\x6a",
    "\x6b",
    "\x6c",
    "\x6d",
    "\x6e",
    "\x6f",
    "\x70",
    "\x71",
    "\x72",
    "\x73",
    "\x74",
    "\x75",
    "\x76",
    "\x77",
    "\x78",
    "\x79",
    "\x7a",
    "\x7b",
    "\x7c",
    "\x7d",
    "\x7e",
    "\x7f",
    "\xe1\xba\xa0",
    "\xe1\xba\xae",
    "\xe1\xba\xb0",
    "\xe1\xba\xb6",
    "\xe1\xba\xa4",
    "\xe1\xba\xa6",
    "\xe1\xba\xa8",
    "\xe1\xba\xac",
    "\xe1\xba\xbc",
    "\xe1\xba\xb8",
    "\xe1\xba\xbe",
    "\xe1\xbb\x80",
    "\xe1\xbb\x82",
    "\xe1\xbb\x84",
    "\xe1\xbb\x86",
    "\xe1\xbb\x90",
    "\xe1\xbb\x92",
    "\xe1\xbb\x94",
    "\xe1\xbb\x96",
    "\xe1\xbb\x98",
    "\xe1\xbb\xa2",
    "\xe1\xbb\x9a",
    "\xe1\xbb\x9c",
    "\xe1\xbb\x9e",
    "\xe1\xbb\x8a",
    "\xe1\xbb\x8e",
    "\xe1\xbb\x8c",
    "\xe1\xbb\x88",
    "\xe1\xbb\xa6",
    "\xc5\xa8",
    "\xe1\xbb\xa4",
    "\xe1\xbb\xb2",
    "\xc3\x95",
    "\xe1\xba\xaf",
    "\xe1\xba\xb1",
    "\xe1\xba\xb7",
    "\xe1\xba\xa5",
    "\xe1\xba\xa7",
    "\xe1\xba\xa9",
    "\xe1\xba\xad",
    "\xe1\xba\xbd",
    "\xe1\xba\xb9",
    "\xe1\xba\xbf",
    "\xe1\xbb\x81",
    "\xe1\xbb\x83",
    "\xe1\xbb\x85",
    "\xe1\xbb\x87",
    "\xe1\xbb\x91",
    "\xe1\xbb\x93",
    "\xe1\xbb\x95",
    "\xe1\xbb\x97",
    "\xe1\xbb\xa0",
    "\xc6\xa0",
    "\xe1\xbb\x99",
    "\xe1\xbb\x9d",
    "\xe1\xbb\x9f",
    "\xe1\xbb\x8b",
    "\xe1\xbb\xb0",
    "\xe1\xbb\xa8",
    "\xe1\xbb\xaa",
    "\xe1\xbb\xac",
    "\xc6\xa1",
    "\xe1\xbb\x9b",
    "\xc6\xaf",
    "\xc3\x80",
    "\xc3\x81",
    "\xc3\x82",
    "\xc3\x83",
    "\xe1\xba\xa2",
    "\xc4\x82",
    "\xe1\xba\xb3",
    "\xe1\xba\xb5",
    "\xc3\x88",
    "\xc3\x89",
    "\xc3\x8a",
    "\xe1\xba\xba",
    "\xc3\x8c",
    "\xc3\x8d",
    "\xc4\xa8",
    "\xe1\xbb\xb3",
    "\xc4\x90",
    "\xe1\xbb\xa9",
    "\xc3\x92",
    "\xc3\x93",
    "\xc3\x94",
    "\xe1\xba\xa1",
    "\xe1\xbb\xb7",
    "\xe1\xbb\xab",
    "\xe1\xbb\xad",
    "\xc3\x99",
    "\xc3\x9a",
    "\xe1\xbb\xb9",
    "\xe1\xbb\xb5",
    "\xc3\x9d",
    "\xe1\xbb\xa1",
    "\xc6\xb0",
    "\xc3\xa0",
    "\xc3\xa1",
    "\xc3\xa2",
    "\xc3\xa3",
    "\xe1\xba\xa3",
    "\xc4\x83",
    "\xe1\xbb\xaf",
    "\xe1\xba\xab",
    "\xc3\xa8",
    "\xc3\xa9",
    "\xc3\xaa",
    "\xe1\xba\xbb",
    "\xc3\xac",
    "\xc3\xad",
    "\xc4\xa9",
    "\xe1\xbb\x89",
    "\xc4\x91",
    "\xe1\xbb\xb1",
    "\xc3\xb2",
    "\xc3\xb3",
    "\xc3\xb4",
    "\xc3\xb5",
    "\xe1\xbb\x8f",
    "\xe1\xbb\x8d",
    "\xe1\xbb\xa5",
    "\xc3\xb9",
    "\xc3\xba",
    "\xc5\xa9",
    "\xe1\xbb\xa7",
    "\xc3\xbd",
    "\xe1\xbb\xa3",
    "\xe1\xbb\xae",
);

my %from_ucs4 = (
    0x00000000 => "\x00",
    0x00000001 => "\x01",
    0x00000003 => "\x03",
    0x00000004 => "\x04",
    0x00000007 => "\x07",
    0x00000008 => "\x08",
    0x00000009 => "\x09",
    0x0000000a => "\x0a",
    0x0000000b => "\x0b",
    0x0000000c => "\x0c",
    0x0000000d => "\x0d",
    0x0000000e => "\x0e",
    0x0000000f => "\x0f",
    0x00000010 => "\x10",
    0x00000011 => "\x11",
    0x00000012 => "\x12",
    0x00000013 => "\x13",
    0x00000015 => "\x15",
    0x00000016 => "\x16",
    0x00000017 => "\x17",
    0x00000018 => "\x18",
    0x0000001a => "\x1a",
    0x0000001b => "\x1b",
    0x0000001c => "\x1c",
    0x0000001d => "\x1d",
    0x0000001f => "\x1f",
    0x00000020 => "\x20",
    0x00000021 => "\x21",
    0x00000022 => "\x22",
    0x00000023 => "\x23",
    0x00000024 => "\x24",
    0x00000025 => "\x25",
    0x00000026 => "\x26",
    0x00000027 => "\x27",
    0x00000028 => "\x28",
    0x00000029 => "\x29",
    0x0000002a => "\x2a",
    0x0000002b => "\x2b",
    0x0000002c => "\x2c",
    0x0000002d => "\x2d",
    0x0000002e => "\x2e",
    0x0000002f => "\x2f",
    0x00000030 => "\x30",
    0x00000031 => "\x31",
    0x00000032 => "\x32",
    0x00000033 => "\x33",
    0x00000034 => "\x34",
    0x00000035 => "\x35",
    0x00000036 => "\x36",
    0x00000037 => "\x37",
    0x00000038 => "\x38",
    0x00000039 => "\x39",
    0x0000003a => "\x3a",
    0x0000003b => "\x3b",
    0x0000003c => "\x3c",
    0x0000003d => "\x3d",
    0x0000003e => "\x3e",
    0x0000003f => "\x3f",
    0x00000040 => "\x40",
    0x00000041 => "\x41",
    0x00000042 => "\x42",
    0x00000043 => "\x43",
    0x00000044 => "\x44",
    0x00000045 => "\x45",
    0x00000046 => "\x46",
    0x00000047 => "\x47",
    0x00000048 => "\x48",
    0x00000049 => "\x49",
    0x0000004a => "\x4a",
    0x0000004b => "\x4b",
    0x0000004c => "\x4c",
    0x0000004d => "\x4d",
    0x0000004e => "\x4e",
    0x0000004f => "\x4f",
    0x00000050 => "\x50",
    0x00000051 => "\x51",
    0x00000052 => "\x52",
    0x00000053 => "\x53",
    0x00000054 => "\x54",
    0x00000055 => "\x55",
    0x00000056 => "\x56",
    0x00000057 => "\x57",
    0x00000058 => "\x58",
    0x00000059 => "\x59",
    0x0000005a => "\x5a",
    0x0000005b => "\x5b",
    0x0000005c => "\x5c",
    0x0000005d => "\x5d",
    0x0000005e => "\x5e",
    0x0000005f => "\x5f",
    0x00000060 => "\x60",
    0x00000061 => "\x61",
    0x00000062 => "\x62",
    0x00000063 => "\x63",
    0x00000064 => "\x64",
    0x00000065 => "\x65",
    0x00000066 => "\x66",
    0x00000067 => "\x67",
    0x00000068 => "\x68",
    0x00000069 => "\x69",
    0x0000006a => "\x6a",
    0x0000006b => "\x6b",
    0x0000006c => "\x6c",
    0x0000006d => "\x6d",
    0x0000006e => "\x6e",
    0x0000006f => "\x6f",
    0x00000070 => "\x70",
    0x00000071 => "\x71",
    0x00000072 => "\x72",
    0x00000073 => "\x73",
    0x00000074 => "\x74",
    0x00000075 => "\x75",
    0x00000076 => "\x76",
    0x00000077 => "\x77",
    0x00000078 => "\x78",
    0x00000079 => "\x79",
    0x0000007a => "\x7a",
    0x0000007b => "\x7b",
    0x0000007c => "\x7c",
    0x0000007d => "\x7d",
    0x0000007e => "\x7e",
    0x0000007f => "\x7f",
    0x000000c0 => "\xc0",
    0x000000c1 => "\xc1",
    0x000000c2 => "\xc2",
    0x000000c3 => "\xc3",
    0x000000c8 => "\xc8",
    0x000000c9 => "\xc9",
    0x000000ca => "\xca",
    0x000000cc => "\xcc",
    0x000000cd => "\xcd",
    0x000000d2 => "\xd2",
    0x000000d3 => "\xd3",
    0x000000d4 => "\xd4",
    0x000000d5 => "\xa0",
    0x000000d9 => "\xd9",
    0x000000da => "\xda",
    0x000000dd => "\xdd",
    0x000000e0 => "\xe0",
    0x000000e1 => "\xe1",
    0x000000e2 => "\xe2",
    0x000000e3 => "\xe3",
    0x000000e8 => "\xe8",
    0x000000e9 => "\xe9",
    0x000000ea => "\xea",
    0x000000ec => "\xec",
    0x000000ed => "\xed",
    0x000000f2 => "\xf2",
    0x000000f3 => "\xf3",
    0x000000f4 => "\xf4",
    0x000000f5 => "\xf5",
    0x000000f9 => "\xf9",
    0x000000fa => "\xfa",
    0x000000fd => "\xfd",
    0x00000102 => "\xc5",
    0x00000103 => "\xe5",
    0x00000110 => "\xd0",
    0x00000111 => "\xf0",
    0x00000128 => "\xce",
    0x00000129 => "\xee",
    0x00000168 => "\x9d",
    0x00000169 => "\xfb",
    0x000001a0 => "\xb4",
    0x000001a1 => "\xbd",
    0x000001af => "\xbf",
    0x000001b0 => "\xdf",
    0x00001ea0 => "\x80",
    0x00001ea1 => "\xd5",
    0x00001ea2 => "\xc4",
    0x00001ea3 => "\xe4",
    0x00001ea4 => "\x84",
    0x00001ea5 => "\xa4",
    0x00001ea6 => "\x85",
    0x00001ea7 => "\xa5",
    0x00001ea8 => "\x86",
    0x00001ea9 => "\xa6",
    0x00001eaa => "\x06",
    0x00001eab => "\xe7",
    0x00001eac => "\x87",
    0x00001ead => "\xa7",
    0x00001eae => "\x81",
    0x00001eaf => "\xa1",
    0x00001eb0 => "\x82",
    0x00001eb1 => "\xa2",
    0x00001eb2 => "\x02",
    0x00001eb3 => "\xc6",
    0x00001eb4 => "\x05",
    0x00001eb5 => "\xc7",
    0x00001eb6 => "\x83",
    0x00001eb7 => "\xa3",
    0x00001eb8 => "\x89",
    0x00001eb9 => "\xa9",
    0x00001eba => "\xcb",
    0x00001ebb => "\xeb",
    0x00001ebc => "\x88",
    0x00001ebd => "\xa8",
    0x00001ebe => "\x8a",
    0x00001ebf => "\xaa",
    0x00001ec0 => "\x8b",
    0x00001ec1 => "\xab",
    0x00001ec2 => "\x8c",
    0x00001ec3 => "\xac",
    0x00001ec4 => "\x8d",
    0x00001ec5 => "\xad",
    0x00001ec6 => "\x8e",
    0x00001ec7 => "\xae",
    0x00001ec8 => "\x9b",
    0x00001ec9 => "\xef",
    0x00001eca => "\x98",
    0x00001ecb => "\xb8",
    0x00001ecc => "\x9a",
    0x00001ecd => "\xf7",
    0x00001ece => "\x99",
    0x00001ecf => "\xf6",
    0x00001ed0 => "\x8f",
    0x00001ed1 => "\xaf",
    0x00001ed2 => "\x90",
    0x00001ed3 => "\xb0",
    0x00001ed4 => "\x91",
    0x00001ed5 => "\xb1",
    0x00001ed6 => "\x92",
    0x00001ed7 => "\xb2",
    0x00001ed8 => "\x93",
    0x00001ed9 => "\xb5",
    0x00001eda => "\x95",
    0x00001edb => "\xbe",
    0x00001edc => "\x96",
    0x00001edd => "\xb6",
    0x00001ede => "\x97",
    0x00001edf => "\xb7",
    0x00001ee0 => "\xb3",
    0x00001ee1 => "\xde",
    0x00001ee2 => "\x94",
    0x00001ee3 => "\xfe",
    0x00001ee4 => "\x9e",
    0x00001ee5 => "\xf8",
    0x00001ee6 => "\x9c",
    0x00001ee7 => "\xfc",
    0x00001ee8 => "\xba",
    0x00001ee9 => "\xd1",
    0x00001eea => "\xbb",
    0x00001eeb => "\xd7",
    0x00001eec => "\xbc",
    0x00001eed => "\xd8",
    0x00001eee => "\xff",
    0x00001eef => "\xe6",
    0x00001ef0 => "\xb9",
    0x00001ef1 => "\xf1",
    0x00001ef2 => "\x9f",
    0x00001ef3 => "\xcf",
    0x00001ef4 => "\x1e",
    0x00001ef5 => "\xdc",
    0x00001ef6 => "\x14",
    0x00001ef7 => "\xd6",
    0x00001ef8 => "\x19",
    0x00001ef9 => "\xdb",
);

sub _recode
{
    if ($_[0]->{_from} eq 'INTERNAL') {
		$_[1] = join '',
	        map $from_ucs4{$_}
                || (defined $from_ucs4{$_} ? $from_ucs4{$_} : "\x3f"),
		    @{$_[1]};
    } elsif ($_[0]->{_to} eq 'UTF-8',) {
		$_[1] = join '', map $to_utf8[$_], unpack 'C*', $_[1];
    } else {
		$_[1] = [ map
				  $to_ucs4[$_],
				  unpack 'C*', $_[1]
				  ];
    }

    return 1;
}

1;

__END__

=head1 NAME

Locale::RecodeData::VISCII - Conversion routines for VISCII

=head1 SYNOPSIS

This module is internal to libintl.  Do not use directly!

=head1 DESCRIPTION

This module is generated and contains the conversion tables and
routines for VISCII.
=head1 CHARACTER TABLE

The following table is sorted in the same order as the original charmap.
All character codes are in hexadecimal.  Please read 'ISO-10646' as
'ISO-10646-UCS4'.

 Local | ISO-10646 | Description
-------+-----------+-------------------------------------------------
    00 |  00000000 | NULL (NUL)
    01 |  00000001 | START OF HEADING (SOH)
    02 |  00001EB2 | LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE
    03 |  00000003 | END OF TEXT (ETX)
    04 |  00000004 | END OF TRANSMISSION (EOT)
    05 |  00001EB4 | LATIN CAPITAL LETTER A WITH BREVE AND TILDE
    06 |  00001EAA | LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE
    07 |  00000007 | BELL (BEL)
    08 |  00000008 | BACKSPACE (BS)
    09 |  00000009 | CHARACTER TABULATION (HT)
    0A |  0000000A | LINE FEED (LF)
    0B |  0000000B | LINE TABULATION (VT)
    0C |  0000000C | FORM FEED (FF)
    0D |  0000000D | CARRIAGE RETURN (CR)
    0E |  0000000E | SHIFT OUT (SO)
    0F |  0000000F | SHIFT IN (SI)
    10 |  00000010 | DATALINK ESCAPE (DLE)
    11 |  00000011 | DEVICE CONTROL ONE (DC1)
    12 |  00000012 | DEVICE CONTROL TWO (DC2)
    13 |  00000013 | DEVICE CONTROL THREE (DC3)
    14 |  00001EF6 | LATIN CAPITAL LETTER Y WITH HOOK ABOVE
    15 |  00000015 | NEGATIVE ACKNOWLEDGE (NAK)
    16 |  00000016 | SYNCHRONOUS IDLE (SYN)
    17 |  00000017 | END OF TRANSMISSION BLOCK (ETB)
    18 |  00000018 | CANCEL (CAN)
    19 |  00001EF8 | LATIN CAPITAL LETTER Y WITH TILDE
    1A |  0000001A | SUBSTITUTE (SUB)
    1B |  0000001B | ESCAPE (ESC)
    1C |  0000001C | FILE SEPARATOR (IS4)
    1D |  0000001D | GROUP SEPARATOR (IS3)
    1E |  00001EF4 | LATIN CAPITAL LETTER Y WITH DOT BELOW
    1F |  0000001F | UNIT SEPARATOR (IS1)
    20 |  00000020 | SPACE
    21 |  00000021 | EXCLAMATION MARK
    22 |  00000022 | QUOTATION MARK
    23 |  00000023 | NUMBER SIGN
    24 |  00000024 | DOLLAR SIGN
    25 |  00000025 | PERCENT SIGN
    26 |  00000026 | AMPERSAND
    27 |  00000027 | APOSTROPHE
    28 |  00000028 | LEFT PARENTHESIS
    29 |  00000029 | RIGHT PARENTHESIS
    2A |  0000002A | ASTERISK
    2B |  0000002B | PLUS SIGN
    2C |  0000002C | COMMA
    2D |  0000002D | HYPHEN-MINUS
    2E |  0000002E | FULL STOP
    2F |  0000002F | SOLIDUS
    30 |  00000030 | DIGIT ZERO
    31 |  00000031 | DIGIT ONE
    32 |  00000032 | DIGIT TWO
    33 |  00000033 | DIGIT THREE
    34 |  00000034 | DIGIT FOUR
    35 |  00000035 | DIGIT FIVE
    36 |  00000036 | DIGIT SIX
    37 |  00000037 | DIGIT SEVEN
    38 |  00000038 | DIGIT EIGHT
    39 |  00000039 | DIGIT NINE
    3A |  0000003A | COLON
    3B |  0000003B | SEMICOLON
    3C |  0000003C | LESS-THAN SIGN
    3D |  0000003D | EQUALS SIGN
    3E |  0000003E | GREATER-THAN SIGN
    3F |  0000003F | QUESTION MARK
    40 |  00000040 | COMMERCIAL AT
    41 |  00000041 | LATIN CAPITAL LETTER A
    42 |  00000042 | LATIN CAPITAL LETTER B
    43 |  00000043 | LATIN CAPITAL LETTER C
    44 |  00000044 | LATIN CAPITAL LETTER D
    45 |  00000045 | LATIN CAPITAL LETTER E
    46 |  00000046 | LATIN CAPITAL LETTER F
    47 |  00000047 | LATIN CAPITAL LETTER G
    48 |  00000048 | LATIN CAPITAL LETTER H
    49 |  00000049 | LATIN CAPITAL LETTER I
    4A |  0000004A | LATIN CAPITAL LETTER J
    4B |  0000004B | LATIN CAPITAL LETTER K
    4C |  0000004C | LATIN CAPITAL LETTER L
    4D |  0000004D | LATIN CAPITAL LETTER M
    4E |  0000004E | LATIN CAPITAL LETTER N
    4F |  0000004F | LATIN CAPITAL LETTER O
    50 |  00000050 | LATIN CAPITAL LETTER P
    51 |  00000051 | LATIN CAPITAL LETTER Q
    52 |  00000052 | LATIN CAPITAL LETTER R
    53 |  00000053 | LATIN CAPITAL LETTER S
    54 |  00000054 | LATIN CAPITAL LETTER T
    55 |  00000055 | LATIN CAPITAL LETTER U
    56 |  00000056 | LATIN CAPITAL LETTER V
    57 |  00000057 | LATIN CAPITAL LETTER W
    58 |  00000058 | LATIN CAPITAL LETTER X
    59 |  00000059 | LATIN CAPITAL LETTER Y
    5A |  0000005A | LATIN CAPITAL LETTER Z
    5B |  0000005B | LEFT SQUARE BRACKET
    5C |  0000005C | REVERSE SOLIDUS
    5D |  0000005D | RIGHT SQUARE BRACKET
    5E |  0000005E | CIRCUMFLEX ACCENT
    5F |  0000005F | LOW LINE
    60 |  00000060 | GRAVE ACCENT
    61 |  00000061 | LATIN SMALL LETTER A
    62 |  00000062 | LATIN SMALL LETTER B
    63 |  00000063 | LATIN SMALL LETTER C
    64 |  00000064 | LATIN SMALL LETTER D
    65 |  00000065 | LATIN SMALL LETTER E
    66 |  00000066 | LATIN SMALL LETTER F
    67 |  00000067 | LATIN SMALL LETTER G
    68 |  00000068 | LATIN SMALL LETTER H
    69 |  00000069 | LATIN SMALL LETTER I
    6A |  0000006A | LATIN SMALL LETTER J
    6B |  0000006B | LATIN SMALL LETTER K
    6C |  0000006C | LATIN SMALL LETTER L
    6D |  0000006D | LATIN SMALL LETTER M
    6E |  0000006E | LATIN SMALL LETTER N
    6F |  0000006F | LATIN SMALL LETTER O
    70 |  00000070 | LATIN SMALL LETTER P
    71 |  00000071 | LATIN SMALL LETTER Q
    72 |  00000072 | LATIN SMALL LETTER R
    73 |  00000073 | LATIN SMALL LETTER S
    74 |  00000074 | LATIN SMALL LETTER T
    75 |  00000075 | LATIN SMALL LETTER U
    76 |  00000076 | LATIN SMALL LETTER V
    77 |  00000077 | LATIN SMALL LETTER W
    78 |  00000078 | LATIN SMALL LETTER X
    79 |  00000079 | LATIN SMALL LETTER Y
    7A |  0000007A | LATIN SMALL LETTER Z
    7B |  0000007B | LEFT CURLY BRACKET
    7C |  0000007C | VERTICAL LINE
    7D |  0000007D | RIGHT CURLY BRACKET
    7E |  0000007E | TILDE
    7F |  0000007F | DELETE (DEL)
    80 |  00001EA0 | LATIN CAPITAL LETTER A WITH DOT BELOW
    81 |  00001EAE | LATIN CAPITAL LETTER A WITH BREVE AND ACUTE
    82 |  00001EB0 | LATIN CAPITAL LETTER A WITH BREVE AND GRAVE
    83 |  00001EB6 | LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW
    84 |  00001EA4 | LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE
    85 |  00001EA6 | LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE
    86 |  00001EA8 | LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
    87 |  00001EAC | LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW
    88 |  00001EBC | LATIN CAPITAL LETTER E WITH TILDE
    89 |  00001EB8 | LATIN CAPITAL LETTER E WITH DOT BELOW
    8A |  00001EBE | LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE
    8B |  00001EC0 | LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE
    8C |  00001EC2 | LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
    8D |  00001EC4 | LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE
    8E |  00001EC6 | LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW
    8F |  00001ED0 | LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE
    90 |  00001ED2 | LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE
    91 |  00001ED4 | LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
    92 |  00001ED6 | LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE
    93 |  00001ED8 | LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW
    94 |  00001EE2 | LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW
    95 |  00001EDA | LATIN CAPITAL LETTER O WITH HORN AND ACUTE
    96 |  00001EDC | LATIN CAPITAL LETTER O WITH HORN AND GRAVE
    97 |  00001EDE | LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE
    98 |  00001ECA | LATIN CAPITAL LETTER I WITH DOT BELOW
    99 |  00001ECE | LATIN CAPITAL LETTER O WITH HOOK ABOVE
    9A |  00001ECC | LATIN CAPITAL LETTER O WITH DOT BELOW
    9B |  00001EC8 | LATIN CAPITAL LETTER I WITH HOOK ABOVE
    9C |  00001EE6 | LATIN CAPITAL LETTER U WITH HOOK ABOVE
    9D |  00000168 | LATIN CAPITAL LETTER U WITH TILDE
    9E |  00001EE4 | LATIN CAPITAL LETTER U WITH DOT BELOW
    9F |  00001EF2 | LATIN CAPITAL LETTER Y WITH GRAVE
    A0 |  000000D5 | LATIN CAPITAL LETTER O WITH TILDE
    A1 |  00001EAF | LATIN SMALL LETTER A WITH BREVE AND ACUTE
    A2 |  00001EB1 | LATIN SMALL LETTER A WITH BREVE AND GRAVE
    A3 |  00001EB7 | LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
    A4 |  00001EA5 | LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE
    A5 |  00001EA7 | LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
    A6 |  00001EA9 | LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
    A7 |  00001EAD | LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
    A8 |  00001EBD | LATIN SMALL LETTER E WITH TILDE
    A9 |  00001EB9 | LATIN SMALL LETTER E WITH DOT BELOW
    AA |  00001EBF | LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
    AB |  00001EC1 | LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
    AC |  00001EC3 | LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
    AD |  00001EC5 | LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
    AE |  00001EC7 | LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
    AF |  00001ED1 | LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
    B0 |  00001ED3 | LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
    B1 |  00001ED5 | LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
    B2 |  00001ED7 | LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
    B3 |  00001EE0 | LATIN CAPITAL LETTER O WITH HORN AND TILDE
    B4 |  000001A0 | LATIN CAPITAL LETTER O WITH HORN
    B5 |  00001ED9 | LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW
    B6 |  00001EDD | LATIN SMALL LETTER O WITH HORN AND GRAVE
    B7 |  00001EDF | LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE
    B8 |  00001ECB | LATIN SMALL LETTER I WITH DOT BELOW
    B9 |  00001EF0 | LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW
    BA |  00001EE8 | LATIN CAPITAL LETTER U WITH HORN AND ACUTE
    BB |  00001EEA | LATIN CAPITAL LETTER U WITH HORN AND GRAVE
    BC |  00001EEC | LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE
    BD |  000001A1 | LATIN SMALL LETTER O WITH HORN
    BE |  00001EDB | LATIN SMALL LETTER O WITH HORN AND ACUTE
    BF |  000001AF | LATIN CAPITAL LETTER U WITH HORN
    C0 |  000000C0 | LATIN CAPITAL LETTER A WITH GRAVE
    C1 |  000000C1 | LATIN CAPITAL LETTER A WITH ACUTE
    C2 |  000000C2 | LATIN CAPITAL LETTER A WITH CIRCUMFLEX
    C3 |  000000C3 | LATIN CAPITAL LETTER A WITH TILDE
    C4 |  00001EA2 | LATIN CAPITAL LETTER A WITH HOOK ABOVE
    C5 |  00000102 | LATIN CAPITAL LETTER A WITH BREVE
    C6 |  00001EB3 | LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE
    C7 |  00001EB5 | LATIN SMALL LETTER A WITH BREVE AND TILDE
    C8 |  000000C8 | LATIN CAPITAL LETTER E WITH GRAVE
    C9 |  000000C9 | LATIN CAPITAL LETTER E WITH ACUTE
    CA |  000000CA | LATIN CAPITAL LETTER E WITH CIRCUMFLEX
    CB |  00001EBA | LATIN CAPITAL LETTER E WITH HOOK ABOVE
    CC |  000000CC | LATIN CAPITAL LETTER I WITH GRAVE
    CD |  000000CD | LATIN CAPITAL LETTER I WITH ACUTE
    CE |  00000128 | LATIN CAPITAL LETTER I WITH TILDE
    CF |  00001EF3 | LATIN SMALL LETTER Y WITH GRAVE
    D0 |  00000110 | LATIN CAPITAL LETTER D WITH STROKE
    D1 |  00001EE9 | LATIN SMALL LETTER U WITH HORN AND ACUTE
    D2 |  000000D2 | LATIN CAPITAL LETTER O WITH GRAVE
    D3 |  000000D3 | LATIN CAPITAL LETTER O WITH ACUTE
    D4 |  000000D4 | LATIN CAPITAL LETTER O WITH CIRCUMFLEX
    D5 |  00001EA1 | LATIN SMALL LETTER A WITH DOT BELOW
    D6 |  00001EF7 | LATIN SMALL LETTER Y WITH HOOK ABOVE
    D7 |  00001EEB | LATIN SMALL LETTER U WITH HORN AND GRAVE
    D8 |  00001EED | LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE
    D9 |  000000D9 | LATIN CAPITAL LETTER U WITH GRAVE
    DA |  000000DA | LATIN CAPITAL LETTER U WITH ACUTE
    DB |  00001EF9 | LATIN SMALL LETTER Y WITH TILDE
    DC |  00001EF5 | LATIN SMALL LETTER Y WITH DOT BELOW
    DD |  000000DD | LATIN CAPITAL LETTER Y WITH ACUTE
    DE |  00001EE1 | LATIN SMALL LETTER O WITH HORN AND TILDE
    DF |  000001B0 | LATIN SMALL LETTER U WITH HORN
    E0 |  000000E0 | LATIN SMALL LETTER A WITH GRAVE
    E1 |  000000E1 | LATIN SMALL LETTER A WITH ACUTE
    E2 |  000000E2 | LATIN SMALL LETTER A WITH CIRCUMFLEX
    E3 |  000000E3 | LATIN SMALL LETTER A WITH TILDE
    E4 |  00001EA3 | LATIN SMALL LETTER A WITH HOOK ABOVE
    E5 |  00000103 | LATIN SMALL LETTER A WITH BREVE
    E6 |  00001EEF | LATIN SMALL LETTER U WITH HORN AND TILDE
    E7 |  00001EAB | LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
    E8 |  000000E8 | LATIN SMALL LETTER E WITH GRAVE
    E9 |  000000E9 | LATIN SMALL LETTER E WITH ACUTE
    EA |  000000EA | LATIN SMALL LETTER E WITH CIRCUMFLEX
    EB |  00001EBB | LATIN SMALL LETTER E WITH HOOK ABOVE
    EC |  000000EC | LATIN SMALL LETTER I WITH GRAVE
    ED |  000000ED | LATIN SMALL LETTER I WITH ACUTE
    EE |  00000129 | LATIN SMALL LETTER I WITH TILDE
    EF |  00001EC9 | LATIN SMALL LETTER I WITH HOOK ABOVE
    F0 |  00000111 | LATIN SMALL LETTER D WITH STROKE
    F1 |  00001EF1 | LATIN SMALL LETTER U WITH HORN AND DOT BELOW
    F2 |  000000F2 | LATIN SMALL LETTER O WITH GRAVE
    F3 |  000000F3 | LATIN SMALL LETTER O WITH ACUTE
    F4 |  000000F4 | LATIN SMALL LETTER O WITH CIRCUMFLEX
    F5 |  000000F5 | LATIN SMALL LETTER O WITH TILDE
    F6 |  00001ECF | LATIN SMALL LETTER O WITH HOOK ABOVE
    F7 |  00001ECD | LATIN SMALL LETTER O WITH DOT BELOW
    F8 |  00001EE5 | LATIN SMALL LETTER U WITH DOT BELOW
    F9 |  000000F9 | LATIN SMALL LETTER U WITH GRAVE
    FA |  000000FA | LATIN SMALL LETTER U WITH ACUTE
    FB |  00000169 | LATIN SMALL LETTER U WITH TILDE
    FC |  00001EE7 | LATIN SMALL LETTER U WITH HOOK ABOVE
    FD |  000000FD | LATIN SMALL LETTER Y WITH ACUTE
    FE |  00001EE3 | LATIN SMALL LETTER O WITH HORN AND DOT BELOW
    FF |  00001EEE | LATIN CAPITAL LETTER U WITH HORN AND TILDE

=head1 AUTHOR

Copyright (C) 2002-2009, Guido Flohr E<lt>guido@imperia.netE<gt>, all
rights reserved.  See the source code for details.

This software is contributed to the Perl community by Imperia
(L<http://www.imperia.net/>).

=head1 SEE ALSO

Locale::RecodeData(3), Locale::Recode(3), perl(1)

=cut
Local Variables:
mode: perl
perl-indent-level: 4
perl-continued-statement-offset: 4
perl-continued-brace-offset: 0
perl-brace-offset: -4
perl-brace-imaginary-offset: 0
perl-label-offset: -4
cperl-indent-level: 4
cperl-continued-statement-offset: 2
tab-width: 4
End:
=cut


code:
#! /bin/false
# vim: set autoindent shiftwidth=4 tabstop=4:
# $Id: _Encode.pm,v 1.1 2009-11-01 19:00:13 pertusus Exp $

# Interface to Encode.
# Copyright (C) 2002-2009 Guido Flohr <guido@imperia.net>,
# all rights reserved.

# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU Library General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.

# You should have received a copy of the GNU Library General Public
# License along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.

package Locale::RecodeData::_Encode;

use strict;
use integer;

use Encode;

require Locale::RecodeData;
use base qw (Locale::RecodeData);

sub _recode
{
	use bytes;

	my $retval;

	if ($_[0]->{_from} eq 'INTERNAL') {
		$_[1] = pack "N*", @{$_[1]};
		$retval = Encode::from_to ($_[1], 'UTF-32BE', $_[0]->{_to});
	} elsif ($_[0]->{_to} eq 'INTERNAL') {
		$retval = Encode::from_to ($_[1], $_[0]->{_from}, 'UTF-32BE');
		return unless defined $retval;
		$_[1] = [ unpack "N*", $_[1] ];
	} else {
		$retval = Encode::from_to ($_[1], $_[0]->{_from}, $_[0]->{_to});
	}

	return unless defined $retval;
	return 1;
}

1;

__END__

=head1 NAME

Locale::RecodeData::_Encode - Internal wrapper around Encode

=head1 SYNOPSIS

use Locale::RecodeData::_Encode;

This module is internal to libintl.  Do not use directly!

=head1 DESCRIPTION

This module converts text with the help of Encode(3).  It is
tried first for conversions if libintl-perl detects the presence
of Encode.

=head1 AUTHOR

Copyright (C) 2002-2009, Guido Flohr E<lt>guido@imperia.netE<gt>, all
rights reserved.  See the source code for details.

This software is contributed to the Perl community by Imperia
(L<http://www.imperia.net/>).

=head1 SEE ALSO

Locale::Recode(3), Encode(3), perl(1)

=cut
Local Variables:
mode: perl
perl-indent-level: 4
perl-continued-statement-offset: 4
perl-continued-brace-offset: 0
perl-brace-offset: -4
perl-brace-imaginary-offset: 0
perl-label-offset: -4
cperl-indent-level: 4
cperl-continued-statement-offset: 2
tab-width: 4
End:
=cut

repo_name: mthl/texinfo

license: mit


code:
#! /bin/false

# vim: set autoindent shiftwidth=4 tabstop=4:
# $Id: TextDomain.pm,v 1.1 2009-11-01 19:00:00 pertusus Exp $

# High-level interface to Perl i18n.
# Copyright (C) 2002-2009 Guido Flohr <guido@imperia.net>,
# all rights reserved.

# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU Library General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.

# You should have received a copy of the GNU Library General Public
# License along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.

package __TiedTextDomain;

use strict;

sub TIEHASH
{
    my ($class, $function) = @_;
    bless {
        __function => $function,
    }, $class;
}

sub FETCH
{
    my ($self, $msg) = @_;

    &{$self->{__function}} ($msg);
}

sub FIRSTKEY
{
    my $self = shift;
    my $reset_iterator = keys %$self;
    return scalar each %$self;
}

sub NEXTKEY
{
    my $self = shift;
    return scalar each %$self;
}

sub CLEAR {}
sub STORE {}
sub DELETE {}

1;

package Locale::TextDomain;

use strict;

use Locale::Messages qw (textdomain bindtextdomain dgettext dngettext dpgettext dnpgettext);
use Cwd qw (abs_path);

use vars qw ($VERSION);

$VERSION = '1.20';

require Exporter;

use vars qw (@ISA @EXPORT %__ $__);

@ISA = ('Exporter');
@EXPORT = qw (__ __x __n __nx __xn __p __px __np __npx $__ %__
              N__ N__n N__p N__np);

my %textdomains = ();
my %bound_dirs = ();
my @default_dirs = ();

sub __ ($);

sub __find_domain ($);
sub __expand ($%);
sub __tied_gettext ($$);

BEGIN {
    # Tie the hash to gettext().
    tie %__, '__TiedTextDomain', \&__tied_gettext;
    $__ = \%__;

	# Add default search directories, but only if they exist.
	for my $dir (qw (/usr/share/locale /usr/local/share/locale)) {
        if (-d $dir) {
            @default_dirs = ($dir);
            last;
        }
    }
}

# Normal gettext.
sub __ ($)
{
    my $msgid = shift;

    my $package = caller;

    my $textdomain = $textdomains{$package};

    __find_domain $textdomain if
		defined $textdomain && defined $bound_dirs{$textdomain};

    return dgettext $textdomain => $msgid;
}

# Called from tied hash.
sub __tied_gettext ($$)
{
    my ($msgid) = @_;

    my ($package) = caller (1);

    my $textdomain = $textdomains{$package};
    unless (defined $textdomain) {
		my ($maybe_package, $filename, $line) = caller (2);
		if (exists $textdomains{$maybe_package}) {
			warn <<EOF;
Probable use of \$__ or \%__ where __() should be used at $filename:$line.
EOF
		}
	}
    __find_domain $textdomain if
		defined $textdomain && defined $bound_dirs{$textdomain};

    return dgettext $textdomain => $msgid;
}

# With interpolation.
sub __x ($@)
{
    my ($msgid, %vars) = @_;

    my $package = caller;

    my $textdomain = $textdomains{$package};

    __find_domain $textdomain if
		defined $textdomain && defined $bound_dirs{$textdomain};

    return __expand ((dgettext $textdomain => $msgid), %vars);
}

# Plural.
sub __n ($$$)
{
    my ($msgid, $msgid_plural, $count) = @_;

    my $package = caller;

    my $textdomain = $textdomains{$package};

    __find_domain $textdomain if
		defined $textdomain && defined $bound_dirs{$textdomain};

    return dngettext $textdomain, $msgid, $msgid_plural, $count;
}

# Plural with interpolation.
sub __nx ($$$@)
{
    my ($msgid, $msgid_plural, $count, %args) = @_;

    my $package = caller;

    my $textdomain = $textdomains{$package};

    __find_domain $textdomain if
		defined $textdomain && defined $bound_dirs{$textdomain};

    return __expand ((dngettext $textdomain, $msgid, $msgid_plural, $count),
					 %args);
}

# Plural with interpolation.
sub __xn ($$$@)
{
    my ($msgid, $msgid_plural, $count, %args) = @_;

    my $package = caller;

    my $textdomain = $textdomains{$package};

    __find_domain $textdomain if
		defined $textdomain && defined $bound_dirs{$textdomain};

    return __expand ((dngettext $textdomain, $msgid, $msgid_plural, $count),
					 %args);
}

# Context. (p is for particular or special)
sub __p ($$)
{
    my $msgctxt = shift;
    my $msgid = shift;

    my $package = caller;

    my $textdomain = $textdomains{$package};

    __find_domain $textdomain if
		defined $textdomain && defined $bound_dirs{$textdomain};

    return dpgettext $textdomain => $msgctxt, $msgid;
}

# With interpolation.
sub __px ($$@)
{
    my ($msgctxt, $msgid, %vars) = @_;

    my $package = caller;

    my $textdomain = $textdomains{$package};

    __find_domain $textdomain if
		defined $textdomain && defined $bound_dirs{$textdomain};

    return __expand ((dpgettext $textdomain => $msgctxt, $msgid), %vars);
}

# Context + Plural.
sub __np ($$$$)
{
    my ($msgctxt, $msgid, $msgid_plural, $count) = @_;

    my $package = caller;

    my $textdomain = $textdomains{$package};

    __find_domain $textdomain if
		defined $textdomain && defined $bound_dirs{$textdomain};

    return dnpgettext $textdomain, $msgctxt, $msgid, $msgid_plural, $count;
}

# Plural with interpolation.
sub __npx ($$$$@)
{
    my ($msgctxt, $msgid, $msgid_plural, $count, %args) = @_;

    my $package = caller;

    my $textdomain = $textdomains{$package};

    __find_domain $textdomain if
		defined $textdomain && defined $bound_dirs{$textdomain};

    return __expand ((dnpgettext $textdomain, $msgctxt, $msgid, $msgid_plural, $count),
					 %args);
}

# Dummy functions for string marking.
sub N__($)
{
    return shift;
}

sub N__n($$$)
{
    return @_;
}

sub N__p($$) {
    return @_;
}

sub N__np($$$$) {
    return @_;
}

sub import
{
    my ($self, $textdomain, @search_dirs) = @_;

    # Check our caller.
    my $package = caller;
    return if exists $textdomains{$package};

    # Was a textdomain specified?
	$textdomain = textdomain unless defined $textdomain && length $textdomain;

    # Remember the textdomain of that package.
    $textdomains{$package} = $textdomain;

    # Remember that we still have to bind that textdomain to
    # a directory.
    unless (exists $bound_dirs{$textdomain}) {
		@search_dirs = map $_ . '/LocaleData', @INC, @default_dirs
			unless @search_dirs;
		$bound_dirs{$textdomain} = [@search_dirs];
    }

    Locale::TextDomain->export_to_level (1, $package, @EXPORT);

    return;
}

# Private functions.
sub __find_domain ($)
{
	my $domain = shift;

	my $try_dirs = $bound_dirs{$domain};

	if (defined $try_dirs) {
		my $found_dir = '';

		TRYDIR: foreach my $dir (map { abs_path $_ } grep { -d $_ } @$try_dirs) {
			# Is there a message catalog?  We have to search recursively
			# for it.  Since globbing is reported to be buggy under
			# MS-DOS, we roll our own version.
			local *DIR;
			if (opendir DIR, $dir) {
				my @files = map { "$dir/$_/LC_MESSAGES/$domain.mo" }
					grep { ! /^\.\.?$/ } readdir DIR;

				foreach my $file (@files) {
					if (-f $file || -l $file) {
						# If we find a non-readable file on our way,
						# we access has been disabled on purpose.
						# Therefore no -r check here.
						$found_dir = $dir;
						last TRYDIR;
					}
				}
			}
		}

		# If there was no success, this will fall back to the default search
		# directories.
		bindtextdomain $domain => $found_dir;
    }

    # The search has completed.
    undef $bound_dirs{$domain};

    return 1;
}

sub __expand ($%)
{
    my ($translation, %args) = @_;

    my $re = join '|', map { quotemeta $_ } keys %args;
    $translation =~ s/\{($re)\}/defined $args{$1} ? $args{$1} : "{$1}"/ge;

    return $translation;
}

1;

__END__

=head1 NAME

Locale::TextDomain - Perl Interface to Uniforum Message Translation

=head1 SYNOPSIS

 use Locale::TextDomain ('my-package', @locale_dirs);

 use Locale::TextDomain qw (my-package);

 my $translated = __"Hello World!\n";

 my $alt = $__{"Hello World!\n"};

 my $alt2 = $__->{"Hello World!\n"};

 my @list = (N__"Hello",
             N__"World");

 printf (__n ("one file read",
              "%d files read",
              $num_files),
         $num_files);

 print __nx ("one file read", "{num} files read", $num_files,
             num => $num_files);

 my $translated_context = __p ("Verb, to view", "View");

 printf (__np ("Files read from filesystems",
               "one file read",
               "%d files read",
               $num_files),
         $num_files);

 print __npx ("Files read from filesystems",
              "one file read",
              "{num} files read",
              $num_files,
              num => $num_files);

=head1 DESCRIPTION

The module Locale::TextDomain(3pm) provides a high-level interface
to Perl message translation.

=head2 Textdomains

When you request a translation for a given string, the system used
in libintl-perl follows a standard strategy to find a suitable message
catalog containing the translation: Unless you explicitely define
a name for the message catalog, libintl-perl will assume that your
catalog is called 'messages' (unless you have changed the default
value to something else via Locale::Messages(3pm), method textdomain()).

You might think that his default strategy leaves room for optimization
and you are right.  It would be a lot smarter if multiple software
packages, all with their individual message catalogs, could be installed
on one system, and it should also be possible that third-party
components of your software (like Perl modules) can load their
message catalogs, too, without interfering with yours.

The solution is clear, you have to assign a unique name to your message
database, and you have to specify that name at run-time.  That unique
name is the so-called I<textdomain> of your software package.  The name is
actually arbitrary but you should follow these best-practice guidelines
to ensure maximum interoperability:

=over 8

=item File System Safety

In practice, textdomains get mapped into file names, and you should
therefore make sure that the textdomain you choose is a valid filename
on every system that will run your software.

=item Case-sensitivity

Textdomains are always case-sensitive (i. e. 'Package' and 'PACKAGE'
are not the same).  However, since the message catalogs will be stored
on file systems, that may or may not distinguish case when looking
up file names, you should avoid potential conflicts here.

=item Textdomain Should Match CPAN Name

If your software is listed as a module on CPAN, you should simply
choose the name on CPAN as your textdomain.  The textdomain for
libintl-perl is hence 'libintl-perl'.  But please replace all
periods ('.') in your package name with an underscore because ...

=item Internet Domain Names as a Fallback

... if your software is I<not> a module listed on CPAN, as a last
resort you should use the Java(tm) package scheme, i. e. choose
an internet domain that you are owner of (or ask the owner of an
internet domain) and concatenate your preferred textdomain with the
reversed internet domain.  Example: Your company runs the web-site
'www.foobar.org' and is the owner of the domain 'foobar.org'.  The
textdomain for your company's software 'barfoos' should hence be
'org.foobar.barfoos'.

=back

If your software is likely to be installed in different versions on
the same system, it is probably a good idea to append some version
information to your textdomain.

Other systems are less strict with the naming scheme for textdomains
but the phenomena known as Perl is actually a plethora of small,
specialized modules and it is probably wisest to postulate some
namespace model in order to avoid chaos.

=head2 Binding textdomains to directories

Once the system knows the I<textdomain> of the message that you
want to get translated into the user's language, it still has to
find the correct message catalog.  By default, libintl-perl will
look up the string in the translation database found in the
directories F</usr/share/locale> and F</usr/local/share/locale>
(in that order).

It is neither guaranteed that these directories exist on the target
machine, nor can you be sure that the installation routine has write
access to these locations.  You can therefore instruct libintl-perl
to search other directories prior to the default directories.  Specifying
a differnt search directory is called I<binding> a textdomain to a
directory.

B<Locale::TextDomain> extends the default strategy by a Perl
specific approach.  Unless told otherwise, it will look for a
directory F<LocaleData> in every component found in the standard
include path C<@INC> and check for a database containing the message
for your textdomain there.  Example: If the path
F</usr/lib/perl/5.8.0/site_perl> is in your C<@INC>, you can
install your translation files in F</usr/lib/perl/5.8.0/site_perl/LocaleData>,
and they will be found at run-time.

=head1 USAGE

It is crucial to remember that you use Locale::TextDoamin(3) as
specified in the section L</SYNOPSIS>, that means you have to
B<use> it, not B<require> it.  The module behaves quite differently
compared to other modules.

The most significant difference is the meaning of the list passed
as an argument to the use() function.  It actually works like this:

    use Locale::TextDomain (TEXTDOMAIN, DIRECTORY, ...)

The first argument (the first string passed to use()) is the textdomain
of your package, optionally followed by a list of directories to search
I<instead> of the Perl-specific directories (see above: F</LocaleData>
appended to every part of C<@INC>).

If you are the author of a package 'barfoos', you will probably put
the line

    use Locale::TextDomain 'barfoos';

resp. for non-CPAN modules

    use Locale::TextDomain 'org.foobar.barfoos';

in every module of your package that contains translatable strings. If
your module has been installed properly, including the message catalogs,
it will then be able to retrieve these translations at run-time.

If you have not installed the translation database in a directory
F<LocaleData> in the standard include path C<@INC> (or in the system
directories F</usr/share/locale> resp. F</usr/local/share/locale>), you
have to explicitely specify a search path by giving the names of
directories (as strings!) as additional arguments to use():

    use Locale::TextDomain qw (barfoos ./dir1 ./dir2);

Alternatively you can call the function bindtextdomain() with suitable
arguments (see the entry for bindtextdomain() in
L<Locale::Messages/FUNCTIONS>).  If you do so, you should pass
C<undef> as an additional argument in order to avoid unnecessary
lookups:

    use Locale::TextDomain ('barfoos', undef);

You see that the arguments given to use() have nothing to do with
what is imported into your namespace, but they are rather arguments
to textdomain(), resp. bindtextdomain().  Does that mean that
B<Locale::TextDomain> exports nothing into your namespace? Umh, not
exactly ... in fact it imports I<all> functions listed below into
your namespace, and hence you should not define conflicting functions
(and variables) yourself.

So, why has Locale::TextDomain to be different from other modules?
If you have ever written software in C and prepared it for
internationalization (i18n), you will probably have defined some
preprocessor macros like:

    #define _(String) dgettext ("my-textdomain", String)
    #define N_(String) String

You only have to define that once in C, and the textdomain for your
package is automatically inserted into all gettext functions.  In
Perl there is no such mechanism (at least it is not portable,
option -P) and using the gettext functions could become quite
cumbersome without some extra fiddling:

    print dgettext ("my-textdomain", "Hello world!\n");

This is no fun.  In C it would merely be a

    printf (_("Hello world!\n"));

Perl has to be more concise and shorter than C ... see the next
section for how you can use B<Locale::TextDomain> to end up in Perl
with a mere

    print __"Hello World!\n";

=head1 EXPORTED FUNCTIONS

All functions have quite funny names on purpose.  In fact the
purpose for that is quite clear: They should be short, operator-like,
and they should not yell for conflicts with existing functions in
I<your> namespace.  You will understand it, when you internationalize
your first Perl program or module.  Preparing it is more like marking
strings as being translatable than inserting function calls.  Here
we go:

=over 4

=item B<__ MSGID>

B<NOTE:> This is a I<double> underscore!

The basic and most-used function.  It is a short-cut for a call
to gettext() resp. dgettext(), and simply returns the translation for
B<MSGID>.  If your old code reads like this:

    print "permission denied";

You will now write:

    print __"permission denied";

That's all, the string will be output in the user's preferred language,
provided that you have installed a translation for it.

Of course you can also use parentheses:

    print __("permission denied");

Or even:

    print (__("permission denied"));

In my eyes, the first version without parentheses looks best.

=item B<__x MSGID, ID1 =E<gt> VAL1, ID2 =E<gt> VAL2, ...>

One of the nicest features in Perl is its capability to interpolate
variables into strings:

    print "This is the $color $thing.\n";

This nice feature might con you into thinking that you could now
write

    print __"This is the $color $thing.\n";

Alas, that would be nice, but it is not possible.  Remember that the
function __() serves both as an operator for translating strings
I<and> as a mark for translatable strings.  If the above string would
get extracted from your Perl code, the un-interpolated form would
end up in the message catalog because when parsing your code it
is unpredictable what values the variables C<$thing> and C<$color>
will have at run-time (this fact is most probably one of the reasons
you have written your program for).

However, at run-time, Perl will have interpolated the values already
I<before> __() (resp. the underlying gettext() function) has seen the
original string.  Consequently something like "This is the red car.\n"
will be looked up in the message catalog, it will not be found (because
only "This is the $color $thing.\n" is included in the database),
and the original, untranslated string will be returned.
Honestly, because this is almost always an error, the xgettext(1)
program will bail out with a fatal error when it comes across that
string in your code.

There are two workarounds for that:

    printf __"This is the %s %s.\n", $color, $thing;

But that has several disadvantages: Your translator will only
see the isolated string, and without the surrounding code it
is almost impossible to interpret it correctly.  Of course, GNU
emacs and other software capable of editing PO translation files
will allow you to examine the context in the source code, but it
is more likely that your translator will look for a less challenging
translation project when she frequently comes across such messages.

And even if she does understand the underlying programming, what
if she has to reorder the color and the thing like in French:

    msgid "This is the red car.\n";
    msgstr "Cela est la voiture rouge.\n"

Zut alors! No way! You cannot portably reorder the arguments to
printf() and friends in Perl (it is possible in C, but at the
time of this writing not supported in Perl, and it would lead to
other problems anyway).

So what? The Perl backend to GNU gettext has defined an alternative
format for interpolatable strings:

    "This is the {color} {thing}.\n";

Instead of Perl variables you use place-holders (legal Perl variables
are also legal place-holders) in curly braces, and then you call

    print __x ("This is the {color} {thing}.\n",
               thing => $thang,
               color => $color);

The function __x() will take the additional hash and replace all
occurencies of the hash keys in curly braces with the corresponding
values.  Simple, readable, understandable to translators, what else
would you want?  And if the translator forgets, misspells or otherwise
messes up some "variables", the msgfmt(1) program, that is used to
compile the textual translation file into its binary representation
will even choke on these errors and refuse to compile the translation.

=item B<__n MSGID, MSGID_PLURAL, COUNT>

Whew! That looks complicated ... It is best explained with an example.
We'll have another look at your vintage code:

    if ($files_deleted > 1) {
        print "All files have been deleted.\n";
    } else {
        print "One file has been deleted.\n";
    }

Your intent is clear, you wanted to avoid the cumbersome
"1 files deleted".  This is okay for English, but other languages
have more than one plural form.  For example in Russian it makes
a difference whether you want to say 1 file, 3 files or 6 files.
You will use three different forms of the noun 'file' in each
case.  [Note: Yep, very smart you are, the Russian word for 'file'
is in fact the English word, and it is an invariable noun, but if you
know that, you will also understand the rest despite this little
simplification ...].

That is the reason for the existance of the function ngettext(),
that __n() is a short-cut for:

    print __n"One file has been deleted.\n",
             "All files have been deleted.\n",
             $files_deleted;

Alternatively:

    print __n ("One file has been deleted.\n",
               "All files have been deleted.\n",
               $files_deleted);

The effect is always the same: libintl-perl will find out which
plural form to pick for your user's language, and the output string
will always look okay.

=item B<__nx MSGID, MSGID_PLURAL, COUNT, VAR1 =E<gt> VAL1, VAR2 =E<gt> VAL2, ...>

Bringing it all together:

    print __nx ("One file has been deleted.\n",
                "{count} files have been deleted.\n",
                $num_files,
                count => $num_files);

The function __nx() picks the correct plural form (also for English!)
I<and> it is capable of interpolating variables into strings.

Have a close look at the order of arguments: The first argument is the
string in the singular, the second one is the plural string. The third
one is an integer indicating the number of items.  This third argument
is I<only> used to pick the correct translation.  The optionally
following arguments make up the hash used for interpolation.  In the
beginning it is often a little confusing that the variable holding the
number of items will usually be repeated somewhere in the interpolation
hash.

=item B<__xn MSGID, MSGID_PLURAL, COUNT, VAR1 =E<gt> VAL1, VAR2 =E<gt> VAL2, ...>

Does exactly the same thing as __nx().  In fact it is a common typo
promoted to a feature.

=item B<__p MSGCTXT, MSGID>

This is much like __. The "p" stands for "particular", and the MSGCTXT
is used to provide context to the translator. This may be neccessary
when your string is short, and could stand for multiple things. For example:

    print __p"Verb, to view", "View";
    print __p"Noun, a view", "View";

The above may be "View" entries in a menu, where View->Source and File->View
are different forms of "View", and likely need to be translated differently.

A typical usage are GUI programs.  Imagine a program with a main
menu and the notorious "Open" entry in the "File" menu.  Now imagine,
there is another menu entry Preferences->Advanced->Policy where you have
a choice between the alternatives "Open" and "Closed".  In English, "Open"
is the adequate text at both places.  In other languages, it is very
likely that you need two different translations.  Therefore, you would
now write:

    __p"File|", "Open";
    __p"Preferences|Advanced|Policy", "Open";

In English, or if no translation can be found, the second argument
(MSGID) is returned.

This function was introduced in libintl-perl 1.17.

=item B<__px MSGCTXT, MSGID, VAR1 =E<gt> VAL1, VAR2 =E<gt> VAL2, ...>

Like __p(), but supports variable substitution in the string, like __x().

    print __px("Verb, to view", "View {file}", file => $filename);

See __p() and __x() for more details.

This function was introduced in libintl-perl 1.17.

=item B<__np MSGCTXT, MSGID, MSGID_PLURAL, COUNT>

This adds context to plural calls. It should not be needed very often,
if at all, due to the __nx() function. The type of variable substitution
used in other gettext libraries (using sprintf-like sybols, like %s or %1)
sometimes required context. For a (bad) example of this:

    printf (__np("[count] files have been deleted",
                "One file has been deleted.\n",
                "%s files have been deleted.\n",
                $num_files),
            $num_files);

NOTE: The above usage is discouraged. Just use the __nx() call, which
provides inline context via the key names.

This function was introduced in libintl-perl 1.17.

=item B<__npx MSGCTXT, MSGID, MSGID_PLURAL, COUNT, VAR1 =E<gt> VAL1, VAR2 =E<gt> VAL2, ...>

This is provided for comleteness. It adds the variable interpolation
into the string to the previous method, __np().

It's usage would be like so:

    print __nx ("Files being permenantly removed",
                "One file has been deleted.\n",
                "{count} files have been deleted.\n",
                $num_files,
                count => $num_files);

I cannot think of any situations requiring this, but we can easily
support it, so here it is.

This function was introduced in libintl-perl 1.17.

=item B<N__ (ARG1, ARG2, ...)>

A no-op function that simply echoes its arguments to the caller.  Take
the following piece of Perl:

    my @options = (
        "Open",
        "Save",
        "Save As",
    );

    ...

    my $option = $options[1];

Now say that you want to have this translatable.  You could sometimes
simply do:

    my @options = (
        __"Open",
        __"Save",
        __"Save As",
    );

    ...

    my $option = $options[1];

But often times this will not be what you want, for example when you
also need the unmodified original string.  Sometimes it may not even
work, for example, when the preferred user language is not yet
determined at the time that the list is initialized.

In these cases you would write:

    my @options = (
        N__"Open",
        N__"Save",
        N__"Save As",
    );

    ...

    my $option = __($options[1]);
    # or: my $option = dgettext ('my-domain', $options[1]);

Now all the strings in C<@options> will be left alone, since N__()
returns its arguments (one ore more) unmodified.  Nevertheless, the
string extractor will be able to recognize the strings as being
translatable.  And you can still get the translation later by passing
the variable instead of the string to one of the above translation
functions.

=item B<N__n (MSGID, MSGID_PLURAL, COUNT)>

Does exactly the same as N__().  You will use this form if you have
to mark the strings as having plural forms.

=item B<N__p (MSGCTXT, MSGID)>

Marks B<MSGID> as N__() does, but in the context B<MSGCTXT>.

=item B<N__np (MSGCTXT, MSGID, MSGID_PLURAL, COUNT)>

Marks B<MSGID> as N__n() does, but in the context B<MSGCTXT>.
=back

=head1 EXPORTED VARIABLES

The module exports several variables into your namespace:

=over 4

=item B<%__>

A tied hash.  Its keys are your original messages, the values are
their translations:

    my $title = "<h1>$__{'My Homepage'}</h1>";

This is much better for your translation team than

    my $title = __"<h1>My Homepage</h1>";

In the second case the HTML code will make it into the translation
database and your translators have to be aware of HTML syntax when
translating strings.

B<Warning:> Do I<not> use this hash outside of double-quoted strings!
The code in the tied hash object relies on the correct working of
the function caller() (see "perldoc -f caller"), and this function
will report incorrect results if the tied hash value is the argument
to a function from another package, for example:

  my $result = Other::Package::do_it ($__{'Some string'});

The tied hash code will see "Other::Package" as the calling package,
instead of your own package.  Consequently it will look up the message
in the wrong text domain.  There is no workaround for this bug.
Therefore:

Never use the tied hash interpolated strings!

=item B<$__>

A reference to C<%__>, in case you prefer:

     my $title = "<h1>$__->{'My Homepage'}</h1>";

=back

=head1 PERFORMANCE

Message translation can be a time-consuming task.  Take this little
example:

    1: use Locale::TextDomain ('my-domain');
    2: use POSIX (:locale_h);
    3:
    4: setlocale (LC_ALL, '');
    5: print __"Hello world!\n";

This will usually be quite fast, but in pathological cases it may
run for several seconds.  A worst-case scenario would be a
Chinese user at a terminal that understands the codeset Big5-HKSCS.
Your translator for Chinese has however chosen to encode the translations
in the codeset EUC-TW.

What will happen at run-time?  First, the library will search and load a
(maybe large) message catalog for your textdomain 'my-domain'.  Then
it will look up the translation for "Hello world!\n", it will find that
it is encoded in EUC-TW.  Since that differs from the output codeset
Big5-HKSCS, it will first load a conversion table containing several
ten-thousands of codepoints for EUC-TW, then it does the same with
the smaller, but still very large conversion table for Big5-HKSCS,
it will convert the translation on the fly from EUC-TW into Big5-HKSCS,
and finally it will return the converted translation.

A worst-case scenario but realistic.  And for these five lines of codes,
there is not much you can do to make it any faster.  You should understand,
however, I<when> the different steps will take place, so that you can
arrange your code for it.

You have learned in the section L</DESCRIPTION> that line 1 is
responsible for locating your message database.  However, the
use() will do nothing more than remembering your settings.  It will
not search any directories, it will not load any catalogs or
conversion tables.

Somewhere in your code you will always have a call to
POSIX::setlocale(), and the performance of this call may be time-consuming,
depending on the architecture of your system.  On some systems, this
will consume very little time, on others it will only consume a
considerable amount of time for the first call, and on others it may
always be time-consuming.  Since you cannot know, how setlocale() is
implemented on the target system, you should reduce the calls to
setlocale() to a minimum.

Line 5 requests the translation for your string.  Only now, the library
will actually load the message catalog, and only now will it load
eventually needed conversion tables.  And from now on, all this information
will be cached in memory.  This strategy is used throughout libintl-perl,
and you may describe it as 'load-on-first-access'.  Getting the next
translation will consume very little resources.

However, although the translation retrieval is somewhat obfuscated
by an operator-like function call, it is still a function call, and in
fact it even involves a chain of function calls.  Consequently, the
following example is probably bad practice:

    foreach (1 .. 100_000) {
        print __"Hello world!\n";
    }

This example introduces a lot of overhead into your program.  Better
do this:

    my $string = __"Hello world!\n";
    foreach (1 .. 100_000) {
        print $string;
    }

The translation will never change, there is no need to retrieve it
over and over again.  Although libintl-perl will of course cache
the translation read from the file system, you can still avoid the
overhead for the function calls.

=head1 AUTHOR

Copyright (C) 2002-2009, Guido Flohr E<lt>guido@imperia.netE<gt>, all
rights reserved.  See the source code for details.

This software is contributed to the Perl community by Imperia
(L<http://www.imperia.net/>).

=head1 SEE ALSO

Locale::Messages(3pm), Locale::gettext_pp(3pm), perl(1),
gettext(1), gettext(3)

=cut
Local Variables:
mode: perl
perl-indent-level: 4
perl-continued-statement-offset: 4
perl-continued-brace-offset: 0
perl-brace-offset: -4
perl-brace-imaginary-offset: 0
perl-label-offset: -4
cperl-indent-level: 4
cperl-continued-statement-offset: 2
tab-width: 4
End:
=cut


code:
#! /bin/false

# vim: set autoindent shiftwidth=4 tabstop=4:
# $Id: Util.pm,v 1.1 2009-11-01 19:00:00 pertusus Exp $

# Portable methods for locale handling.
# Copyright (C) 2002-2009 Guido Flohr <guido@imperia.net>,
# all rights reserved.

# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU Library General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.

# You should have received a copy of the GNU Library General Public
# License along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.

package Locale::Util;

use strict;

use constant DEBUG => 0;

use base qw (Exporter);

use vars qw (@EXPORT_OK);

@EXPORT_OK = qw (parse_http_accept_language
				 parse_http_accept_charset
				 set_locale set_locale_cache get_locale_cache
				 web_set_locale);

# The following list maps languages to a rough guess of the country that
# is most likely to be meant if no locale info for the country alone is
# found.  I have assembled the list to the best of my knowledge, preferring
# the country that has the language as its official language, and in doubt
# listing the country that has the most speakers of that language.  Corrections
# are welcome.
use constant LANG2COUNTRY => {
    aa => 'ET', # Afar => Ethiopia
    ab => 'AB', # Abkhazian => Georgia
    # ae => '??', # Avestan => ??, Iran?
    af => 'za',  # Afrikaans => South Africa
    am => 'ET', # Amharic => Ethiopia
    ar => 'EG', # Arabic => Egypt
    as => 'IN', # Assamese => India
    ay => 'BO', # Aymara => Bolivia
    az => 'AZ', # Azerbaijani => Azerbaijan
    ba => 'RU', # Bashkir => Russia
    be => 'BY', # Belarusian => Belarus
    bg => 'BG', # Bulgarian => Bulgaria
    bh => 'IN', # Bihari => India
    bi => 'VU', # Bislama => Vanuatu
    bn => 'BD', # Bengali => Bangladesh
    bo => 'CN', # Tibetan => China
    br => 'FR', # Breton => France
    bs => 'BA', # Bosnian => Bosnia and Herzegovina
    ca => 'ES', # Catalan => Spain
    ce => 'RU', # Chechen => Russia
    ch => '??', # Chamorro => Guam (or mp?)
    co => 'FR', # Corsican => France
    cs => 'CZ', # Czech => Czech Republic
    cu => 'BG', # Church Slavic => Bulgaria
    cv => 'RU', # Chuvash => Russia
    cy => 'GB', # Welsh => United Kingdom
    da => 'DK', # Danish => Denmark
    de => 'DE', # German => Germany
    dz => 'BT', # Dzongkha => Bhutan
    en => 'US', # English => United States
    fa => 'IR', # Iran, Islamic Republic of
    fi => 'FI', # Finnish => Finland
    fj => 'FJ', # Fijian => Fiji
    fo => 'FO', # Faeroese => Faroe Islands
    fr => 'FR', # French => France
    fy => 'FY', # Frisian => Netherlands
    ga => 'IE', # Irish => Ireland
    gd => 'GB', # Gaelic (Scots) => United Kingdom
    gl => 'ES', # Gallegan => Spain
    gn => 'PY', # Guarani => Paraguay
    gu => 'IN', # Gujarati => IN
    gv => 'GB', # Manx => United Kingdom
    ha => 'NE', # Hausa => Niger (ng?)
    he => 'IL', # Hebrew => Israel
    hi => 'IN', # Hindi => India
    ho => 'PG', # Hiri Motu => Papua New Guinea
    hr => 'HR', # Croatian
    hu => 'HU', # Hungarian => Hungary
    hy => 'AM', # Armenian => Armenia
    hz => 'NA', # Herero => Namibia
    # ia => '??', # Interlingua (aka "latino sine flexione") => ??
    id => 'ID', # Indonesian => Indonesia
    # ie => '??', # Interlingue => ???
    ik => 'US', # Inupiaq => United States
    is => 'IS', # Icelandic => Iceland
    it => 'IT', # Italian => Italy
    iu => 'CA', # Inuktitut => Canada
    iw => 'IL', # Hebrew => Israel
    ja => 'JP', # Japanese => Japan
    jw => 'ID', # Javanese => Indonesia
    ka => 'GE', # Georgian => Georgia
    ki => 'KE', # Kikuyu => Kenya
    kj => 'AO', # Kuanyama => Angola (na?)
    kk => 'KZ', # Kazakh => Kazakhstan
    kl => 'GL', # Kalaallisut => Greenland
    km => 'KH', # Khmer => Cambodia
    kn => 'IN', # Kannada => India
    ko => 'KR', # Korean => Korea, Republic of (more speakers than North Korea)
    ks => 'IN', # Kashmiri => India
    ku => 'TR', # Kurdish => Turkey
    kv => 'RU', # Komi => Russia
    kw => 'GB', # Cornish => United Kingdom
    ky => 'KG', # Kirghyz => Kyrgyzstan
    la => 'VA', # Latin => Holy See (Vatican City State)
    lb => 'LU', # Letzeburgesch => Luxembourg
    ln => 'CG', # Lingala => Republic of the Congo (cd?)
    lo => 'LA', # Lao => Lao People's Democratic Republic
    lt => 'LT', # Lithuanian => Lithuania
    lv => 'LV', # Latvian => Latvia
    mg => 'MG', # Malagasy => Madagascar
    mh => 'MH', # Marshall => Marshall Islands
    mi => 'NZ', # Maori => New Zealand
    mk => 'MK', # Macedonian => Macedonia, the Former Yugoslav Republic of
    ml => 'IN', # Malayalam => India
    mn => 'MN', # Mongolian => Mongolia
    mr => 'IN', # Marathi => India
    ms => 'MY', # Malay => Malaysia (FIXME: not really sure ...)
    mt => 'MT', # Maltese => Malta
    my => 'MM', # Burmese => Myanmar
    na => 'NR', # Nauru => Nauru
    nb => 'NO', # Norwegian Bokmål => Norway
    nd => 'ZA', # Ndebele, North => South Africa
    ne => 'NP', # Nepali => Nepal
    ng => 'NA', # Ndonga => Namibia
    nl => 'NL', # Dutch => Netherlands
    nn => 'NO', # Norwegian Nynorsk => Norway
    no => 'NO', # Norwegian => Norway
    nr => 'ZA', # Ndebele, South => South Africa
    nv => 'US', # Navajo => United States
    ny => 'MW', # Chichewa; Nyanja => Malawi
    oc => 'FR', # Occitan (post 1500) => France
    om => 'ET', # Oromo => Ethiopia
    or => 'IN', # Oriya => India
    os => 'RU', # Ossetian; Ossetic => Russia (FIXME: Or Georgia?)
    pa => 'IN', # Panjabi => India
    pi => 'IN', # Pali => India (FIXME: Or Thailand, Sri Lanka, Myanmar,
                # Cambodia)
    pl => 'PL', # Polish => Poland
    ps => 'PK', # Pushto => Pakistan
    pt => 'PT', # Portuguese => Portugal (following our rules this should
                # actually be Brazil but that would be to unrealistic,
                # people from Brazil set their locale to pt_BR).
    qu => 'PE', # Quechua => Peru
    rm => 'CH', # Rhaeto-Romance => Switzerland
    rn => 'RW', # Rundi => Rwanda
    ro => 'RO', # Romanian => Romania
    ru => 'RU', # Russian => Russia
    rw => 'RW', # Kinyarwanda => Rwanda
    sa => 'IN', # Sanskrit => India
    sc => 'IT', # Sardinian => Italy
    sd => 'IN', # Sindhi => India
    se => 'SE', # Sami => Sweden (Totally unsure here.  The Sami languages
	            # are also spoken in Norway, Finland and Russia, but the
                # largest part of the area seems to be in Sweden.
    sg => '??', # Sango => Central African Republic
    si => 'LK', # Sinhalese => Sri Lanka
    sk => 'SK', # Slovakian => Slovakia
    sl => 'SL', # Slovenian => Slovenia
    sm => 'WS', # Samoan => Samoa
    sh => 'ZW', # Shona => Zimbabwe (FIXME: Rather Mozambique?)
    so => 'SO', # Somali => Somalia
    sq => 'AL', # Albanian => Albania
    sr => 'YU', # Serbian => Yugoslavia
    ss => '??', # Swati => Swaziland (za?)
    st => 'LS', # Sotho => Lesotho
    su => 'IN', # Sundanese => Indonesia
    sv => 'SE', # Swedish => Sweden
    sw => 'TZ', # Suaheli => Tanzania, United Republic of
    ta => 'LK', # Tamil => Sri Lanka
    te => 'IN', # Telugu => India
    tg => 'TJ', # Tajik => Tajikistan
    th => 'TH', # Thai => Thailand
    ti => 'ER', # Tigrinya => Eritrea
    tk => 'TM', # Turkmen => Turkmenistan
    tl => 'PH', # Tagalog => Philippines
    tn => 'BW', # Tswana => Botswana
    to => 'TO', # Tonga => Tonga
    tr => 'TR', # Turkish => Turkish
    tt => 'RU', # Tatar => Russia
    tw => 'GH', # Twi => Ghana
    ug => 'CN', # Uighur => China
    uk => 'UA', # Ukrainian => Ukraine
    ur => 'PK', # Urdu => Pakistan
    uz => 'UZ', # Uzbek => Uzbekistan
    vi => 'VN', # Vietnamese => Vietnam
    # vo => '??', # Volapuk => Nowhere
    wo => 'SN', # Wolof => Senegal
    xh => 'ZA', # Xhosa => South Africa
    yi => 'IL', # Yiddish => Israel (FIXME: Rather United States?)
    yo => 'NG', # Yoruba => Nigeria
    za => 'CN', # Zhuang => China
    zh => 'CN', # Chinese => China
    zu => 'ZA', # Zulu => South Africa
};

use constant WIN32LANGUAGE => {
    aa => "Afar",
    ab => "Abkhazian",
    ae => "Avestan",
    af => "Afrikaans",
    am => "Amharic",
    ar => "Arabic",
    as => "Assamese",
    ay => "Aymara",
    az => "Azerbaijani",
    ba => "Bashkir",
    be => "Belarusian",
    bg => "Bulgarian",
    bh => "Bihari",
    bi => "Bislama",
    bn => "Bengali",
    bo => "Tibetan",
    br => "Breton",
    bs => "Bosnian",
    ca => "Catalan",
    ce => "Chechen",
    ch => "Chamorro",
    co => "Corsican",
    cs => "Czech",
    cu => "Church Slavic",
    cv => "Chuvash",
    cy => "Welsh",
    da => "Danish",
    de => "German",
    dz => "Dzongkha",
    el => "Greek",
    en => "English",
    eo => "Esperanto",
    es => "Spanish",
    et => "Estonian",
    eu => "Basque",
    fa => "Persian",
    fi => "Finnish",
    fj => "Fijian",
    fo => "Faeroese",
    fr => "French",
    fy => "Frisian",
    ga => "Irish",
    gd => "Gaelic (Scots)",
    gl => "Gallegan",
    gn => "Guarani",
    gu => "Gujarati",
    gv => "Manx",
    ha => "Hausa",
    he => "Hebrew",
    hi => "Hindi",
    ho => "Hiri Motu",
    hr => "Croatian",
    hu => "Hungarian",
    hy => "Armenian",
    hz => "Herero",
    ia => "Interlingua",
    id => "Indonesian",
    ie => "Interlingue",
    ik => "Inupiaq",
    is => "Icelandic",
    it => "Italian",
    iu => "Inuktitut",
    ja => "Japanese",
    jw => "Javanese",
    ka => "Georgian",
    ki => "Kikuyu",
    kj => "Kuanyama",
    kk => "Kazakh",
    kl => "Kalaallisut",
    km => "Khmer",
    kn => "Kannada",
    ko => "Korean",
    ks => "Kashmiri",
    ku => "Kurdish",
    kv => "Komi",
    kw => "Cornish",
    ky => "Kirghiz",
    la => "Latin",
    lb => "Letzeburgesch",
    ln => "Lingala",
    lo => "Lao",
    lt => "Lithuanian",
    lv => "Latvian",
    mg => "Malagasy",
    mh => "Marshall",
    mi => "Maori",
    # Sorry, lads, but that is what M$ calls your language ...
    mk => "FYRO Macedonian",
    ml => "Malayalam",
    mn => "Mongolian",
    mo => "Moldavian",
    mr => "Marathi",
    ms => "Malay",
    mt => "Maltese",
    my => "Burmese",
    na => "Nauru",
    nb => "Norwegian (Bokmål)",
    nd => "Ndebele, North",
    ne => "Nepali",
    ng => "Ndonga",
    nl => "Dutch",
    nn => "Norwegian-Nynorsk",
    no => "Norwegian-Nynorsk",
    nr => "Ndebele, South",
    nv => "Navajo",
    ny => "Chichewa",
    oc => "Occitan (post 1500)",
    om => "Oromo",
    or => "Oriya",
    os => "Ossetian",
    pa => "Panjabi",
    pi => "Pali",
    pl => "Polish",
    ps => "Pushto",
    pt => "Portuguese",
    qu => "Quechua",
    rm => "Rhaeto-Romance",
    rn => "Rundi",
    ro => "Romanian",
    ru => "Russian",
    rw => "Kinyarwanda",
    sa => "Sanskrit",
    sc => "Sardinian",
    sd => "Sindhi",
    se => "Sami",
    sg => "Sango",
    si => "Sinhalese",
    sk => "Slovak",
    sl => "Slovenian",
    sm => "Samoan",
    sn => "Shona",
    so => "Somali",
    sq => "Albanian",
    sr => "Serbian",
    ss => "Swati",
    st => "Sotho",
    su => "Sundanese",
    sv => "Swedish",
    sw => "Swahili",
    ta => "Tamil",
    te => "Telugu",
    tg => "Tajik",
    th => "Thai",
    ti => "Tigrinya",
    tk => "Turkmen",
    tl => "Tagalog",
    tn => "Tswana",
    to => "Tonga",
    tr => "Turkish",
    ts => "Tsonga",
    tt => "Tatar",
    tw => "Twi",
    ug => "Uighur",
    uk => "Ukrainian",
    ur => "Urdu",
    uz => "Uzbek",
    vi => "Vietnamese",
    vo => "Volapuk",
    wo => "Wolof",
    xh => "Xhosa",
    yi => "Yiddish",
    yo => "Yoruba",
    za => "Zhuang",
    zh => "Chinese",
    zu => "Zulu",
};

use constant WIN32COUNTRY => {
    ad => "Andorra",
    ae => "United Arab Emirates",
    af => "Afghanistan",
    ag => "Antigua and Barbuda",
    ai => "Anguilla",
    al => "Albania",
    am => "Armenia",
    an => "Netherlands Antilles",
    ao => "Angola",
    aq => "Antarctica",
    ar => "Argentina",
    as => "American Samoa",
    at => "Austria",
    au => "Australia",
    aw => "Aruba",
    ax => "Aland Islands",
    az => "Azerbaijan",
    ba => "Bosnia and Herzegovina",
    bb => "Barbados",
    bd => "Bangladesh",
    be => "Belgium",
    bf => "Burkina Faso",
    bg => "Bulgaria",
    bh => "Bahrain",
    bi => "Burundi",
    bj => "Benin",
    bm => "Bermuda",
    bn => "Brunei Darussalam",
    bo => "Bolivia",
    br => "Brazil",
    bs => "Bahamas",
    bt => "Bhutan",
    bv => "Bouvet Island",
    bw => "Botswana",
    by => "Belarus",
    bz => "Belize",
    ca => "Canada",
    cc => "Cocos (Keeling) Islands",
    cd => "Congo, The Democratic Republic of the",
    cf => "Central African Republic",
    cg => "Congo",
    ch => "Switzerland",
    ci => "Cote D'Ivoire",
    ck => "Cook Islands",
    cl => "Chile",
    cm => "Cameroon",
    cn => "China",
    co => "Colombia",
    cr => "Costa Rica",
    cs => "Serbia and Montenegro",
    cu => "Cuba",
    cv => "Cape Verde",
    cx => "Christmas Island",
    cy => "Cyprus",
    cz => "Czech Republic",
    de => "Germany",
    dj => "Djibouti",
    dk => "Denmark",
    dm => "Dominica",
    do => "Dominican Republic",
    dz => "Algeria",
    ec => "Ecuador",
    ee => "Estonia",
    eg => "Egypt",
    eh => "Western Sahara",
    er => "Eritrea",
    es => "Spain",
    et => "Ethiopia",
    fi => "Finland",
    fj => "Fiji",
    fk => "Falkland Islands (Malvinas)",
    fm => "Micronesia, Federated States of",
    fo => "Faroe Islands",
    fr => "France",
    fx => "France, Metropolitan",
    ga => "Gabon",
    gb => "United Kingdom",
    gd => "Grenada",
    ge => "Georgia",
    gf => "French Guiana",
    gh => "Ghana",
    gi => "Gibraltar",
    gl => "Greenland",
    gm => "Gambia",
    gn => "Guinea",
    gp => "Guadeloupe",
    gq => "Equatorial Guinea",
    gr => "Greece",
    gs => "South Georgia and the South Sandwich Islands",
    gt => "Guatemala",
    gu => "Guam",
    gw => "Guinea-Bissau",
    gy => "Guyana",
    hk => "Hong Kong",
    hm => "Heard Island and McDonald Islands",
    hn => "Honduras",
    hr => "Croatia",
    ht => "Haiti",
    hu => "Hungary",
    id => "Indonesia",
    ie => "Ireland",
    il => "Israel",
    in => "India",
    io => "British Indian Ocean Territory",
    iq => "Iraq",
    ir => "Iran",
    is => "Iceland",
    it => "Italy",
    jm => "Jamaica",
    jo => "Jordan",
    jp => "Japan",
    ke => "Kenya",
    kg => "Kyrgyzstan",
    kh => "Cambodia",
    ki => "Kiribati",
    km => "Comoros",
    kn => "Saint Kitts and Nevis",
    kp => "North-Korea",
    kr => "Korea",
    kw => "Kuwait",
    ky => "Cayman Islands",
    kz => "Kazakhstan",
    la => "Laos",
    lb => "Lebanon",
    lc => "Saint Lucia",
    li => "Liechtenstein",
    lk => "Sri Lanka",
    lr => "Liberia",
    ls => "Lesotho",
    lt => "Lithuania",
    lu => "Luxembourg",
    lv => "Latvia",
    ly => "Libyan",
    ma => "Morocco",
    mc => "Monaco",
    md => "Moldova",
    mg => "Madagascar",
    mh => "Marshall Islands",
    mk => "Former Yugoslav Republic of Macedonia",
    ml => "Mali",
    mm => "Myanmar",
    mn => "Mongolia",
    mo => "Macao",
    mp => "Northern Mariana Islands",
    mq => "Martinique",
    mr => "Mauritania",
    ms => "Montserrat",
    mt => "Malta",
    mu => "Mauritius",
    mv => "Maldives",
    mw => "Malawi",
    mx => "Mexico",
    my => "Malaysia",
    mz => "Mozambique",
    na => "Namibia",
    nc => "New Caledonia",
    ne => "Niger",
    nf => "Norfolk Island",
    ng => "Nigeria",
    ni => "Nicaragua",
    nl => "Netherlands",
    no => "Norway",
    np => "Nepal",
    nr => "Nauru",
    nu => "Niue",
    nz => "New Zealand",
    om => "Oman",
    pa => "Panama",
    pe => "Peru",
    pf => "French Polynesia",
    pg => "Papua New Guinea",
    ph => "Philippines",
    pk => "Pakistan",
    pl => "Poland",
    pm => "Saint Pierre and Miquelon",
    pn => "Pitcairn",
    pr => "Puerto Rico",
    ps => "Palestinian Territory, Occupied",
    pt => "Portugal",
    pw => "Palau",
    py => "Paraguay",
    qa => "Qatar",
    re => "Reunion",
    ro => "Romania",
    ru => "Russian Federation",
    rw => "Rwanda",
    sa => "Saudi Arabia",
    sb => "Solomon Islands",
    sc => "Seychelles",
    sd => "Sudan",
    se => "Sweden",
    sg => "Singapore",
    sh => "Saint Helena",
    si => "Slovenia",
    sj => "Svalbard and Jan Mayen",
    sk => "Slovakia",
    sl => "Sierra Leone",
    sm => "San Marino",
    sn => "Senegal",
    so => "Somalia",
    sr => "Suriname",
    st => "Sao Tome and Principe",
    sv => "El Salvador",
    sy => "Syrian Arab Republic",
    sz => "Swaziland",
    tc => "Turks and Caicos Islands",
    td => "Chad",
    tf => "French Southern Territories",
    tg => "Togo",
    th => "Thailand",
    tj => "Tajikistan",
    tk => "Tokelau",
    tl => "Timor-Leste",
    tm => "Turkmenistan",
    tn => "Tunisia",
    to => "Tonga",
    tr => "Turkey",
    tt => "Trinidad and Tobago",
    tv => "Tuvalu",
    tw => "Taiwan, Province of China",
    tz => "Tanzania, United Republic of",
    ua => "Ukraine",
    ug => "Uganda",
    um => "United States Minor Outlying Islands",
    us => "United States",
    uy => "Uruguay",
    uz => "Uzbekistan",
    va => "Holy See (Vatican City State)",
    vc => "Saint Vincent and the Grenadines",
    ve => "Venezuela",
    vg => "Virgin Islands, British",
    vi => "Virgin Islands, U.S.",
    vn => "Vietnam",
    vu => "Vanuatu",
    wf => "Wallis and Futuna",
    ws => "Samoa",
    ye => "Yemen",
    yt => "Mayotte",
    za => "South Africa",
    zm => "Zambia",
    zw => "Zimbabwe",
};

my $locale_cache;

sub parse_http_accept_language {
	my ($string) = @_;

	my @tokens = split / *, */, $string;

	my %retval;
	foreach my $token (@tokens) {
		my $quality = 1;
		# This RE is more forgiving than the standard.  It accepts
		# values greater than 1.0 and with more fractional digits
		# than 3.
		if ($token =~ s/ *; *q *= *([0-9]+(?:\.([0-9]+))?)$//) {
			$quality = $1;
		}
		$retval{$token} = $quality;
	}

	# RFC 2616 only allows 1-8 characters for language and country
	# but we are more forgiving.
	return grep {
		/^[A-Za-z]+(?:-[A-Za-z]+)?$/
		} map {
			$_ = 'C' if $_ eq '*'; $_
		}	sort {
			$retval{$b} <=> $retval{$a}
		} keys %retval;
}

sub parse_http_accept_charset {
	my ($string) = @_;

	my @tokens = split / *, */, $string;

	my %retval;
	foreach my $token (@tokens) {
		my $quality = 1;
		# This RE is more forgiving than the standard.  It accepts
		# values greater than 1.0 and with more fractional digits
		# than 3.
		if ($token =~ s/ *; *q *= *([0-9]+(?:\.([0-9]+))?)$//) {
			$quality = $1;
		}
		$retval{$token} = $quality;
	}

	return grep {
		# This is really allowed in character set names ...
		/^[-!\#\$\%\&\'\+\.0-9A-Z_\`a-z\|\~]+$/
		} map {
			$_ = undef if $_ eq '*'; $_
		}	sort {
			$retval{$b} <=> $retval{$a}
		} keys %retval;
}

sub set_locale {
	my ($category, $language, $country, $charset) = @_;

	require POSIX;

    $country = '' unless defined $country;
    $charset = '' unless defined $charset;

	my $set_locale;
	# Look up the cache first.
    if (my $retval = $locale_cache->{$language}->{$country}->{$charset}) {
    	my ($locale, $country) = @$retval;
	POSIX::setlocale ($category, $locale);
        return @$retval;
    }

	# Initialize the cache with the undefined value so that we can do
	# error returns without setting it.
	$locale_cache->{$language}->{$country}->{$charset} = undef;

	my $windows = ($^O !~ /darwin/i && $^O =~ /win/i) ? 1 : 0;
	if ($windows) {
		return &__set_locale_windows;
	}

	my $set_language;
	my $set_country;

	# First we try to only use the language.
	my @languages = ($language);
	my @lc_languages = map { lc $_ } @languages;
	my @uc_languages = map { uc $_ } @languages;
	my %seen = ();

	foreach my $language (@languages, @lc_languages, @uc_languages) {
		next if $seen{$language}++;
		warn "Trying lingua only setlocale '$language'.\n" if DEBUG;
		my $result = POSIX::setlocale ($category, $language);
		if ($result) {
			$set_locale = $set_language = $result if $result;
			last;
		}
	}

	# Now try it with the country appended.
	my @countries = length $country ? ($country) : ();
	my @uc_countries = map { uc $_ } @countries;
	my @lc_countries = map { uc $_ } @countries;
	push @countries, @uc_countries, @lc_countries;

 LINGUA: foreach my $language (@languages, @lc_languages, @uc_languages) {
		my $count = 0;
		my @guessed_countries = (LANG2COUNTRY->{lc $language},
								 lc LANG2COUNTRY->{lc $language},
								 uc LANG2COUNTRY->{lc $language});
		foreach my $c (@countries, @guessed_countries) {
			++$count;
			next unless defined $c && length $c;
			my $try = $language . '_' . $c;
			next if $seen{$try}++;
			warn "Trying setlocale '$try'.\n" if DEBUG;
			my $result = POSIX::setlocale ($category, $try);
			if ($result) {
				$set_locale = $result;
				if ($count >= @countries) {
					$set_country = $c;
				} else {
					$set_country = $country;
				}

				last LINGUA;
			}
		}
	}

	unless (length $charset) {
		return unless defined $set_locale && length $set_locale;

		$locale_cache->{$language}->{$country}->{$charset} =
			[$set_locale, $set_country];
		return wantarray ? ($set_locale, $set_country) : $set_locale;
	}

	my @charsets = ($charset);
	my $cleaned = $charset;
	push @charsets, $cleaned if $cleaned =~ s/-//g;
	my @lc_charsets = map { lc $charset } @charsets;
	my @uc_charsets = map { uc $charset } @charsets;
	push @charsets, @lc_charsets, @uc_charsets;

	%seen = ();
 LINGUA2: foreach my $language (@languages,
								@lc_languages, @uc_languages) {
	     my @guessed_countries = (LANG2COUNTRY->{lc $language},
								 lc LANG2COUNTRY->{lc $language},
								 uc LANG2COUNTRY->{lc $language});
	     my $count = 0;
		 foreach my $c (@countries, @guessed_countries) {
			 ++$count;
			 $c = '' unless defined $c && length $c;
			 my $country_try = $language;
			 $country_try .= (length $c) ? "_$c" : '';

			 foreach my $ch (@charsets, @lc_charsets, @uc_charsets) {
				 my $try = $country_try . '.' . $ch;
				 next if $seen{$try}++;
				 warn "Trying setlocale '$try'.\n" if DEBUG;

				 my $result = POSIX::setlocale ($category, $try);
				 if ($result) {
					 $set_locale = $result;
					 if ($count >= @countries) {
						 $set_country = $c;
					 } else {
						 $set_country = $country;
					 }

					 last LINGUA2;
				 }
			 }
		 }
	 }

	return unless defined $set_locale && length $set_locale;

	$locale_cache->{$language}->{$country}->{$charset} =
		[$set_locale, $set_country];

	return wantarray ? ($set_locale, $set_country) : $set_locale;
}

sub __set_locale_windows {
	my ($category, $language, $country, $charset) = @_;

    my $set_locale;

    $country = '' unless defined $country;
    $charset = '' unless defined $charset;

	# First we try to only use the language.
	my $long_language = WIN32LANGUAGE->{lc $language};
	my @languages = ($long_language, $language);
	my %seen = ();
	foreach my $language (@languages) {
		next if $seen{$language}++;
		warn "Trying lingua only setlocale '$language'.\n" if DEBUG;
		my $result = POSIX::setlocale ($category, $language);
		if ($result) {
			$set_locale = $result if $result;
			last;
		}
	}

	# Now try it with the country appended.
	my $set_country;
	if (length $country) {
        COMBI: foreach my $language (@languages) {
            # We do not need a fallback country here, because the "system" already
            # provides the information.
	        my @short_countries = ($country);
		    my @countries = map {
			    WIN32COUNTRY->{lc $_}
			    } grep { length $_ } @short_countries;
		    foreach my $c (@countries) {
			    next unless defined $c && length $c;
			    my $try = $language . '_' . $c;
			    next if $seen{$try}++;
			    warn "Trying setlocale '$try'.\n" if DEBUG;
			    my $result = POSIX::setlocale ($category, $try);
			    if ($result) {
				    $set_locale = $result;
					$set_country = $c;
				    last COMBI;
			    }
		    }
	    }
	}

	return unless defined $set_locale && length $set_locale;

    # Apparently, there is no point in setting a charset.  Even the new
    # MS-DOS versions like 2000 or XP still have the concept of more or
    # less fixed codepages.  Switching to UTF-8 does not work.
	$locale_cache->{$language}->{$country}->{$charset} =
		[$set_locale, $set_country];
	return wantarray ? ($set_locale, $set_country) : $set_locale;
}

sub get_locale_cache {
	$locale_cache;
}

sub set_locale_cache {
	if (ref $_[0] && 'HASH' eq ref $_[0]) {
		$locale_cache = $_[0];
    } else {
		my %locale_cache = @_;
		$locale_cache = \%locale_cache;
	}
}

sub web_set_locale {
	my ($accept_language, $accept_charset, $category, $available) = @_;

	my %available;
	if ($available) {
		foreach (@$available) {
			my $locale = $_;
			$locale =~ s/[_\@\.].*//;
			$available{lc $locale} = 1;
		}
	}

	my @languages;
	if (ref $accept_language && 'ARRAY' eq ref $accept_language) {
		@languages = @$accept_language;
	} else {
		@languages = parse_http_accept_language $accept_language;
	}

	if ($available) {
		my @all = @languages;
		@languages = ();
		foreach my $locale (@all) {
			my $language = lc $locale;
			$language =~ s/[_\@\.].*//;
			push @languages, $locale if $available{$language};
		}
	}

	my @charsets;
	if (defined $accept_charset) {
		if (ref $accept_charset && 'ARRAY' eq ref $accept_charset) {
			@charsets = @$accept_charset;
		} else {
			@charsets = parse_http_accept_charset $accept_charset;
		}
	}

	unless (defined $category) {
		require POSIX;
		$category = POSIX::LC_ALL();
	}

	my ($set_locale, $set_language, $set_country, $set_charset);
	foreach my $lang (@languages) {
		my ($language, $country) = split /-/, $lang, 2;

		my ($locale, $country_used) =
			set_locale ($category, $language, $country, $charsets[0]);

		if (defined $locale) {
			# If a country was specified, we have to check whether it
			# was actually selected.
			if (defined $country) {
				if (!defined $country
					|| ($country ne $country_used)) {
					$set_language = $language;
					$set_locale = $locale;
					$set_country = $country_used;
					$set_charset = $charsets[0];
				}
			}

			if (wantarray) {
				return $locale, $lang, $country_used, $charsets[0];
			} else {
				return $locale;
			}
		}
	}

	if (defined $set_locale) {
		if (wantarray) {
			return $set_locale, $set_language, $set_country, $set_charset;
		} else {
			return $set_locale;
		}
	}

	return;
}

1;

__END__

=head1 NAME

Locale::Util - Portable l10n and i10n functions

=head1 SYNOPSIS

  use Locale::Util;

  my @linguas = parse_http_accept_language $ENV{HTTP_ACCEPT_LANGUAGE};

  my @charsets = parse_http_accept_charset $ENV{HTTP_ACCEPT_CHARSET};

  # Trie to set the locale to Brasilian Portuguese in UTF-8.
  my $set_locale = set_locale LC_ALL, 'pt', 'BR', 'utf-8';

  set_locale_cache $last_cache;

  my $cache = get_locale_cache;

  web_set_locale ($ENV{HTTP_ACCEPT_LANGUAGE}, $ENV_ACCEPT_CHARSET);

  web_set_locale (['fr-BE', 'fr', 'it'], ['cp1252', 'utf-8']);

=head1 DESCRIPTION

This module provides portable functions dealing with localization
(l10n) and internationalization(i10n).  It doesn't export anything
by default, you have to specify each function you need in the import
list, or use the fully qualified name.

The functions here have a focus on web development, although they
are general enough to have them in the Locale:: namespace.

This module is considered alpha code.  The interface is not stable.
Please contact the author if you want to use it in production code.

This module was introduced in libintl-perl 1.17.

=head1 FUNCTIONS

=over 4

=item B<parse_http_accept_language STRING>

Parses a string as passed in the HTTP header "Accept-Language".
It returns a list of tokens sorted by the quality value, see RFC 2616
for details.

Example:

  parse_http_accept ("fr-fr, fr; q=0.7, de; q=0.3");

This means: Give me French for France with a quality value of 1.0
(the maximum).  Otherwise I will take any other French version
(quality 0.7), German has a quality of 0.3 for me.

The function will return a list of tokens in the order of their quality
values, in this case "fr-fr", "fr" and "de".

The function is more forgiving than RFC 2616.  It accepts quality
values greater than 1.0 and with more than 3 decimal places.  It
also accepts languages and country names with more than 8 characters.
The language "*" is translated into "C".

=item B<parse_http_accept_charset STRING>

Parses a string as passed in the HTTP header "Accept-Charset".
It returns a list of tokens sorted by the quality value, see RFC 2616
for details.

The special character set "*" (means all character sets) will be
translated to the undefined value.

=item B<set_locale CATEGORY, LANGUAGE[, COUNTRY, CHARSET]>

Tries to set the user locale by means of POSIX::setlocale().  The latter
function has the disadvantage, that its second argument (the locale
description string) is completely non-standard and system-dependent.
This function tries its best at guessing the system's notion of a locale
dientifier, with the arguments supplied:

=over 8

=item B<CATEGORY>

An integer argument for a valid locale category.  These are the
LC_* constants (LC_ALL, LC_CTIME, LC_COLLATE, ...) defined in both
Locale::Messages(3pm) and POSIX(3pm).

=item B<LANGUAGE>

A 2-letter language identifier as per ISO 639.  Case doesn't matter,
but an unchanged version (ie. not lower-cased) of the language you
provided will always be tried to.

=item B<COUNTRY>

A 2-letter language identifier as per ISO 639.  Case doesn't matter,
but an unchanged version (ie. not lower-cased) of the language you
provided will always be tried to.

This parameter is optional.  If it is not defined, the function will
try to guess an appropriate country, otherwise leave it to the
operating system.

=item B<CHARSET>

A valid charset name.  Valid means valid!  The charset "utf8" is not
valid (it is "utf-8").  Charset names that are accepted by the
guessing algorithms in Encode(3pm) are also not necessarily valid.

If the parameter is undefined, it is ignored.  It is always ignored
under Windows.

=back

The function tries to approach the desired locale in loops, refining
it on every success.  It will first try to set the language (for
any country), then try to select the correct language, and finally
try to select the correct charset.

The return value is false in case of failure, or the return value
of the underlying POSIX::setlocale() call in case of success.

In array context, the function returns the country name
that was passed in the successful
call to POSIX::setlocale().  If this string is equal to the country
name you passed as an argument, you can be reasonably sure that
the settings for this country are really used.  If it is not
equal, the function has taken a guess at the country (it has a list
of "default" countries for each language).  It seems that under
Windows, POSIX::setlocale() also succeeds, if you pass a country
name that is actually not supported.  Therefore, the information
is not completely reliable.

Please note that this function is intended for server processes
(especially web applications) that need to switch in a portable
way to a certain locale.  It is B<not> the recommended way to set
the program locale for a regular application.  In a regular application
you should do the following:

    use POSIX qw (setlocale LC_ALL);
    setlocale LC_ALL, '';

The empty string as the second argument means, that the system
should switch to the user's default locale.

=item B<get_locale_cache>

The function set_locale() is potentially expansive, especially when
it fails, because it can try a lot of different combinations, and
the system may have to load a lot of locale definitions from its
internal database.

In order to speed up things, results are internally cached in a
hash, keys are the languages, subkeys countries, subsubkeys the
charsets.  You can get a reference to this hash with get_locale_cache().

The function cannot fail.

=item B<set_locale_cache HASH>

Sets the internal cache.  You can either pass a hash or a hash reference.
The function will use this as its cache, discarding its old cache.
This allows you to keep the hash persistent.

The function cannot fail.

=item B<web_set_locale (ACCEPT_LANGUAGE, ACCEPT_CHARSET, CATEGORY,
                        AVAILABLE)>

Try to change the locale to the settings described by ACCEPT_LANGUAGE
and ACCEPT_CHARSET.  For each argument you can either pass a string
as in the corresponding http header, or a reference to an array
of language resp. charset identifiers.

Currently only the first charset passed is used as an argument.
You are strongly encouraged to pass a hard-coded value here, so
that you have control about your output.

The argument B<CATEGORY> specifies the category (one of the LC_*
constants as defined in Locale::Messages(3pm) or in POSIX(3pm)).
The category defaults to LC_ALL.

You can pass an optional reference to a list of locales in
XPG4 format that are available in your application.  This is
useful if you know which languages are supported by your application.
In fact, only the language part of the values in the list are
considered (for example for "en_US", only "en" is used).  The
country or other parts are ignored.

The function returns the return value of the underlying set_locale()
call, or false on failure.

The function returns false on failure.  On success it returns the
return value of the underlying set_locale() call.  This value can
be used directly in subsequent calls to POSIX::setlocale().  In
array context, it additionally returns the identifiers for the language,
the country, and the charset actually used.

=back

=head1 BUGS

The function set_locale() probably fails to guess the correct locale
identifier on a lot of systems.  If you have found such a case,
please submit it as a bug report.

The bug tracking system for this packags is at
http://rt.cpan.org/NoAuth/Bugs.html?libintl-perl

Please note that this module is considered alpha code, and the interface
is not stable.  Please contact the author, if you want to use it in
production code.

=head1 AUTHOR

Copyright (C) 2002-2009, Guido Flohr E<lt>guido@imperia.netE<gt>, all
rights reserved.  See the source code for details.

This software is contributed to the Perl community by Imperia
(L<http://www.imperia.net/>).

=head1 SEE ALSO

POSIX(3pm), perl(1)

=cut
Local Variables:
mode: perl
perl-indent-level: 4
perl-continued-statement-offset: 4
perl-continued-brace-offset: 0
perl-brace-offset: -4
perl-brace-imaginary-offset: 0
perl-label-offset: -4
cperl-indent-level: 4
cperl-continued-statement-offset: 2
tab-width: 4
End:
=cut