<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Locale::gettext;

=head1 NAME

Locale::gettext - message handling functions

=head1 SYNOPSIS

    use Locale::gettext;
    use POSIX;     # Needed for setlocale()

    setlocale(LC_MESSAGES, "");

    # OO interface
    my $d = Locale::gettext-&gt;domain("my_program");

    print $d-&gt;get("Welcome to my program"), "\n";
            # (printed in the local language)

    # Direct access to C functions
    textdomain("my_program");

    print gettext("Welcome to my program"), "\n";
            # (printed in the local language)

=head1 DESCRIPTION

The gettext module permits access from perl to the gettext() family of
functions for retrieving message strings from databases constructed
to internationalize software.

=cut

use Carp;
use POSIX qw(:locale_h);

require Exporter;
require DynaLoader;
@ISA = qw(Exporter DynaLoader);

BEGIN {
	eval {
		require Encode;
		$encode_available = 1;
	};
	import Encode if ($encode_available);
}

$VERSION = "1.07" ;

%EXPORT_TAGS = (

    locale_h =&gt;	[qw(LC_CTYPE LC_NUMERIC LC_TIME LC_COLLATE LC_MONETARY LC_MESSAGES LC_ALL)],

    libintl_h =&gt; [qw(gettext textdomain bindtextdomain dcgettext dgettext ngettext dngettext dcngettext bind_textdomain_codeset)],

);

Exporter::export_tags();

@EXPORT_OK = qw(
);

bootstrap Locale::gettext $VERSION;

sub AUTOLOAD {
    local $! = 0;
    my $constname = $AUTOLOAD;
    $constname =~ s/.*:://;
    my $val = constant($constname, (@_ ? $_[0] : 0));
    if ($! == 0) {
	*$AUTOLOAD = sub { $val };
    }
    else {
	croak "Missing constant $constname";
    }
    goto &amp;$AUTOLOAD;
}

=over 2

=item $d = Locale::gettext-&gt;domain(DOMAIN)

=item $d = Locale::gettext-&gt;domain_raw(DOMAIN)

Creates a new object for retrieving strings in the domain B&lt;DOMAIN&gt;
and returns it. C&lt;domain&gt; requests that strings be returned as
Perl strings (possibly with wide characters) if possible while
C&lt;domain_raw&gt; requests that octet strings directly from functions
like C&lt;dgettext()&gt;.

=cut

sub domain_raw {
	my ($class, $domain) = @_;
	my $self = { domain =&gt; $domain, raw =&gt; 1 };
	bless $self, $class;
}

sub domain {
	my ($class, $domain) = @_;
	unless ($encode_available) {
		croak "Encode module not available, cannot use Locale::gettext-&gt;domain";
	}
	my $self = { domain =&gt; $domain, raw =&gt; 0 };
	bless $self, $class;
	eval { bind_textdomain_codeset($self-&gt;{domain}, "UTF-8"); };
	if ($@ =~ /not implemented/) {
		# emulate it
		$self-&gt;{emulate} = 1;
	} elsif ($@ ne '') {
		die;	# some other problem
	}
	$self;
}

=item $d-&gt;get(MSGID)

Calls C&lt;dgettext()&gt; to return the translated string for the given
B&lt;MSGID&gt;.

=cut

sub get {
	my ($self, $msgid) = @_;
	$self-&gt;_convert(dgettext($self-&gt;{domain}, $msgid));
}

=item $d-&gt;cget(MSGID, CATEGORY)

Calls C&lt;dcgettext()&gt; to return the translated string for the given
B&lt;MSGID&gt; in the given B&lt;CATEGORY&gt;.

=cut

sub cget {
	my ($self, $msgid, $category) = @_;
	$self-&gt;_convert(dcgettext($self-&gt;{domain}, $msgid, $category));
}

=item $d-&gt;nget(MSGID, MSGID_PLURAL, N)

Calls C&lt;dngettext()&gt; to return the translated string for the given
B&lt;MSGID&gt; or B&lt;MSGID_PLURAL&gt; depending on B&lt;N&gt;.

=cut

sub nget {
	my ($self, $msgid, $msgid_plural, $n) = @_;
	$self-&gt;_convert(dngettext($self-&gt;{domain}, $msgid, $msgid_plural, $n));
}

=item $d-&gt;ncget(MSGID, MSGID_PLURAL, N, CATEGORY)

Calls C&lt;dngettext()&gt; to return the translated string for the given
B&lt;MSGID&gt; or B&lt;MSGID_PLURAL&gt; depending on B&lt;N&gt; in the given
B&lt;CATEGORY&gt;.

=cut

sub ncget {
	my ($self, $msgid, $msgid_plural, $n, $category) = @_;
	$self-&gt;_convert(dcngettext($self-&gt;{domain}, $msgid, $msgid_plural, $n, $category));
}

=item $d-&gt;dir([NEWDIR])

If B&lt;NEWDIR&gt; is given, calls C&lt;bindtextdomain&gt; to set the
name of the directory where messages for the domain
represented by C&lt;$d&gt; are found. Returns the (possibly changed)
current directory name.

=cut

sub dir {
	my ($self, $newdir) = @_;
	if (defined($newdir)) {
		bindtextdomain($self-&gt;{domain}, $newdir);
	} else {
		bindtextdomain($self-&gt;{domain});
	}
}

=item $d-&gt;codeset([NEWCODE])

For instances created with C&lt;Locale::gettext-E&lt;gt&gt;domain_raw&gt;, manuiplates
the character set of the returned strings.
If B&lt;NEWCODE&gt; is given, calls C&lt;bind_textdomain_codeset&gt; to set the
character encoding in which messages for the domain
represented by C&lt;$d&gt; are returned. Returns the (possibly changed)
current encoding name.

=cut

sub codeset {
	my ($self, $codeset) = @_;
	if ($self-&gt;{raw} &lt; 1) {
		warn "Locale::gettext-&gt;codeset: meaningful only for instances created with domain_raw";
		return;
	}
	if (defined($codeset)) {
		bind_textdomain_codeset($self-&gt;{domain}, $codeset);
	} else {
		bind_textdomain_codeset($self-&gt;{domain});
	}
}

sub _convert {
	my ($self, $str) = @_;
	return $str if ($self-&gt;{raw});
	# thanks to the use of UTF-8 in bind_textdomain_codeset, the
	# result should always be valid UTF-8 when raw mode is not used.
	if ($self-&gt;{emulate}) {
		delete $self-&gt;{emulate};
		$self-&gt;{raw} = 1;
		my $null = $self-&gt;get("");
		if ($null =~ /charset=(\S+)/) {
			$self-&gt;{decode_from} = $1;
			$self-&gt;{raw} = 0;
		} #else matches the behaviour of glibc - no null entry
		  # means no conversion is done
	}
	if ($self-&gt;{decode_from}) {
		return decode($self-&gt;{decode_from}, $str);
	} else {
		return decode_utf8($str);
	}
}

sub DESTROY {
	my ($self) = @_;
}

=back

gettext(), dgettext(), and dcgettext() attempt to retrieve a string
matching their C&lt;msgid&gt; parameter within the context of the current
locale. dcgettext() takes the message's category and the text domain
as parameters while dgettext() defaults to the LC_MESSAGES category
and gettext() defaults to LC_MESSAGES and uses the current text domain.
If the string is not found in the database, then C&lt;msgid&gt; is returned.

ngettext(), dngettext(), and dcngettext() function similarily but
implement differentiation of messages between singular and plural.
See the documentation for the corresponding C functions for details.

textdomain() sets the current text domain and returns the previously
active domain.

I&lt;bindtextdomain(domain, dirname)&gt; instructs the retrieval functions to look
for the databases belonging to domain C&lt;domain&gt; in the directory
C&lt;dirname&gt;

I&lt;bind_textdomain_codeset(domain, codeset)&gt; instructs the retrieval
functions to translate the returned messages to the character encoding
given by B&lt;codeset&gt; if the encoding of the message catalog is known.

=head1 NOTES

Not all platforms provide all of the functions. Functions that are
not available in the underlying C library will not be available in
Perl either.

Perl programs should use the object interface. In addition to being
able to return native Perl wide character strings,
C&lt;bind_textdomain_codeset&gt; will be emulated if the C library does
not provide it.

=head1 VERSION

1.07.

=head1 SEE ALSO

gettext(3i), gettext(1), msgfmt(1)

=head1 AUTHOR

Kim Vandry &lt;vandry@TZoNE.ORG&gt;

=cut

1;
</pre></body></html>