diff options
Diffstat (limited to 'beagle/debian-rfs/usr/lib/perl5/Locale/gettext.pm')
| -rw-r--r-- | beagle/debian-rfs/usr/lib/perl5/Locale/gettext.pm | 283 |
1 files changed, 0 insertions, 283 deletions
diff --git a/beagle/debian-rfs/usr/lib/perl5/Locale/gettext.pm b/beagle/debian-rfs/usr/lib/perl5/Locale/gettext.pm deleted file mode 100644 index 4b024eb..0000000 --- a/beagle/debian-rfs/usr/lib/perl5/Locale/gettext.pm +++ /dev/null @@ -1,283 +0,0 @@ -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->domain("my_program"); - - print $d->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.05" ; - -%EXPORT_TAGS = ( - - locale_h => [qw(LC_CTYPE LC_NUMERIC LC_TIME LC_COLLATE LC_MONETARY LC_MESSAGES LC_ALL)], - - libintl_h => [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 &$AUTOLOAD; -} - -=over 2 - -=item $d = Locale::gettext->domain(DOMAIN) - -=item $d = Locale::gettext->domain_raw(DOMAIN) - -Creates a new object for retrieving strings in the domain B<DOMAIN> -and returns it. C<domain> requests that strings be returned as -Perl strings (possibly with wide characters) if possible while -C<domain_raw> requests that octet strings directly from functions -like C<dgettext()>. - -=cut - -sub domain_raw { - my ($class, $domain) = @_; - my $self = { domain => $domain, raw => 1 }; - bless $self, $class; -} - -sub domain { - my ($class, $domain) = @_; - unless ($encode_available) { - croak "Encode module not available, cannot use Locale::gettext->domain"; - } - my $self = { domain => $domain, raw => 0 }; - bless $self, $class; - eval { bind_textdomain_codeset($self->{domain}, "UTF-8"); }; - if ($@ =~ /not implemented/) { - # emulate it - $self->{emulate} = 1; - } elsif ($@ ne '') { - die; # some other problem - } - $self; -} - -=item $d->get(MSGID) - -Calls C<dgettext()> to return the translated string for the given -B<MSGID>. - -=cut - -sub get { - my ($self, $msgid) = @_; - $self->_convert(dgettext($self->{domain}, $msgid)); -} - -=item $d->cget(MSGID, CATEGORY) - -Calls C<dcgettext()> to return the translated string for the given -B<MSGID> in the given B<CATEGORY>. - -=cut - -sub cget { - my ($self, $msgid, $category) = @_; - $self->_convert(dcgettext($self->{domain}, $msgid, $category)); -} - -=item $d->nget(MSGID, MSGID_PLURAL, N) - -Calls C<dngettext()> to return the translated string for the given -B<MSGID> or B<MSGID_PLURAL> depending on B<N>. - -=cut - -sub nget { - my ($self, $msgid, $msgid_plural, $n) = @_; - $self->_convert(dngettext($self->{domain}, $msgid, $msgid_plural, $n)); -} - -=item $d->ncget(MSGID, MSGID_PLURAL, N, CATEGORY) - -Calls C<dngettext()> to return the translated string for the given -B<MSGID> or B<MSGID_PLURAL> depending on B<N> in the given -B<CATEGORY>. - -=cut - -sub ncget { - my ($self, $msgid, $msgid_plural, $n, $category) = @_; - $self->_convert(dcngettext($self->{domain}, $msgid, $msgid_plural, $n, $category)); -} - -=item $d->dir([NEWDIR]) - -If B<NEWDIR> is given, calls C<bindtextdomain> to set the -name of the directory where messages for the domain -represented by C<$d> are found. Returns the (possibly changed) -current directory name. - -=cut - -sub dir { - my ($self, $newdir) = @_; - if (defined($newdir)) { - bindtextdomain($self->{domain}, $newdir); - } else { - bindtextdomain($self->{domain}); - } -} - -=item $d->codeset([NEWCODE]) - -For instances created with C<Locale::gettext-E<gt>domain_raw>, manuiplates -the character set of the returned strings. -If B<NEWCODE> is given, calls C<bind_textdomain_codeset> to set the -character encoding in which messages for the domain -represented by C<$d> are returned. Returns the (possibly changed) -current encoding name. - -=cut - -sub codeset { - my ($self, $codeset) = @_; - if ($self->{raw} < 1) { - warn "Locale::gettext->codeset: meaningful only for instances created with domain_raw"; - return; - } - if (defined($codeset)) { - bind_textdomain_codeset($self->{domain}, $codeset); - } else { - bind_textdomain_codeset($self->{domain}); - } -} - -sub _convert { - my ($self, $str) = @_; - return $str if ($self->{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->{emulate}) { - delete $self->{emulate}; - $self->{raw} = 1; - my $null = $self->get(""); - if ($null =~ /charset=(\S+)/) { - $self->{decode_from} = $1; - $self->{raw} = 0; - } #else matches the behaviour of glibc - no null entry - # means no conversion is done - } - if ($self->{decode_from}) { - return decode($self->{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<msgid> 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<msgid> 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<bindtextdomain(domain, dirname)> instructs the retrieval functions to look -for the databases belonging to domain C<domain> in the directory -C<dirname> - -I<bind_textdomain_codeset(domain, codeset)> instructs the retrieval -functions to translate the returned messages to the character encoding -given by B<codeset> 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<bind_textdomain_codeset> will be emulated if the C library does -not provide it. - -=head1 VERSION - -1.05. - -=head1 SEE ALSO - -gettext(3i), gettext(1), msgfmt(1) - -=head1 AUTHOR - -Phillip Vandry <vandry@TZoNE.ORG> - -=cut - -1; |