imacat/Locale-Maketext-Gettext
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Various fixes to avoid JetBrains IDE problem detection.

Browse Source
This commit is contained in:
依瑪貓 2021-02-07 17:46:47 +08:00
parent bf58ad3861
commit 82cb71ac60
6 changed files with 142 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
Changes
View File

@ -13,7 +13,7 @@ Locale-Maketext-Gettext change log
1. Gettext.pm: Added support to purge the lexicon cache and 1. Gettext.pm: Added support to purge the lexicon cache and
reread the MO file on calling textdomain() when MO file is reread the MO file on calling textdomain() when MO file is
updated automatically. This enables MO file live update with updated automatically. This enables MO file live update with
persistant applications like Mojolicious or mod_perl. persistent applications like Mojolicious or mod_perl.
2. Source is now on Github. See: 2. Source is now on Github. See:
https://github.com/imacat/Locale-Maketext-Gettext https://github.com/imacat/Locale-Maketext-Gettext
@ -38,7 +38,7 @@ Locale-Maketext-Gettext change log
the test is skipped on the target test system. the test is skipped on the target test system.
2008-11-11 2008-11-11
1. INSTALL: Fixed the grammer, changed "none" to "None.". 1. INSTALL: Fixed the grammar, changed "none" to "None.".
2008-04-22 version 1.26 2008-04-22 version 1.26
Documentation fix. No code changes. Documentation fix. No code changes.
@ -69,7 +69,7 @@ Locale-Maketext-Gettext change log
test_native.po and test_native.mo. test_native.po and test_native.mo.
5. Build.PL: Added "build_requires". 5. Build.PL: Added "build_requires".
6. t/08-f-errors.t: Fixed so that it finds the newest MO file 6. t/08-f-errors.t: Fixed so that it finds the newest MO file
found on the system, in order to avoid lagacy MO files. found on the system, in order to avoid legacy MO files.
(gettext 0.10 in 1995?) (gettext 0.10 in 1995?)
7. t/08-f-errors.t: Fixed test 38 so that it skips in the eval() 7. t/08-f-errors.t: Fixed test 38 so that it skips in the eval()
block, and dumps the error on failure. block, and dumps the error on failure.
@ -153,7 +153,7 @@ Locale-Maketext-Gettext change log
preference. preference.
13. Gettext.pm and Functions.pm: In maketext(), check if the key is 13. Gettext.pm and Functions.pm: In maketext(), check if the key is
Perl utf8 text with Encode::is_utf8() first before decode() the Perl utf8 text with Encode::is_utf8() first before decode() the
key, so that user can safely run a multibyte-awared script. key, so that user can safely run a multibyte-aware script.
14. Gettext.pm and Functions.pm: In maketext(), check if the key is 14. Gettext.pm and Functions.pm: In maketext(), check if the key is
Perl utf8 text with Encode::is_utf8() first before encode(), for Perl utf8 text with Encode::is_utf8() first before encode(), for
empty/invalid lexicon with key_encoding() set but no output empty/invalid lexicon with key_encoding() set but no output
@ -164,7 +164,7 @@ Locale-Maketext-Gettext change log
15. Functions.pm: In __(), removed unused variables $encoding, 15. Functions.pm: In __(), removed unused variables $encoding,
$lh_encoding and $key_encoding. $lh_encoding and $key_encoding.
16. maketext: In parse_args(), check the return value of the eval { } 16. maketext: In parse_args(), check the return value of the eval { }
block instead of $@, and remove the extra new line when outputing block instead of $@, and remove the extra new line when writing
the error in $@. the error in $@.
17. maketext: Added an example at the DESCRIPTION chapter of the 17. maketext: Added an example at the DESCRIPTION chapter of the
POD documentation. POD documentation.
@ -179,7 +179,7 @@ Locale-Maketext-Gettext change log
the fail_with() method, instead of our own. the fail_with() method, instead of our own.
Clean up encoding mess. You may need to check if your application Clean up encoding mess. You may need to check if your application
was depending on the previous wrong, hard-to-handle behavior on look was depending on the previous wrong, hard-to-handle behavior on look
up failurs. The new behavior should be easier to deal with. up failures. The new behavior should be easier to deal with.
1. Gettext.pm: In the textdomain() function, make sure {"ENCODING"} 1. Gettext.pm: In the textdomain() function, make sure {"ENCODING"}
is not set to undef when MO file does not exists. is not set to undef when MO file does not exists.
2. Functions.pm: In the encoding() function, removed a piece of long 2. Functions.pm: In the encoding() function, removed a piece of long
@ -250,7 +250,7 @@ Locale-Maketext-Gettext change log
as its error message. Tests replying on $@ may fail for this. But as its error message. Tests replying on $@ may fail for this. But
I should check the return value of the eval{} block rather than $@ I should check the return value of the eval{} block rather than $@
anyway. anyway.
1. t/*.t: Adition of $r as the return value of the eval{} blocks. 1. t/*.t: Addition of $r as the return value of the eval{} blocks.
Addition of "return 1;" to the eval{} blocks to specify the return Addition of "return 1;" to the eval{} blocks to specify the return
values. Changing tests "ok($@, "");" to "ok($r, 1);". Changing values. Changing tests "ok($@, "");" to "ok($r, 1);". Changing
tests "ok($@, qr/maketext doesn't know how to say/);" and tests "ok($@, qr/maketext doesn't know how to say/);" and
@ -334,7 +334,7 @@ Locale-Maketext-Gettext change log
14. Functions.pm: Warning is added to the use of key_encoding(). 14. Functions.pm: Warning is added to the use of key_encoding().
2005-04-05 2005-04-05
1. Gettext.pm: Subroutine attribute "method" is taged on the 1. Gettext.pm: Subroutine attribute "method" is tagged on the
following methods: encoding(), key_encoding(), new(), following methods: encoding(), key_encoding(), new(),
subclass_init(), bindtextdomain(), textdomain(), maketext(), subclass_init(), bindtextdomain(), textdomain(), maketext(),
reload_text(), die_for_lookup_failures() and encode_failure(). reload_text(), die_for_lookup_failures() and encode_failure().
@ -413,7 +413,7 @@ Locale-Maketext-Gettext change log
1. Support for MO files without encoding specified was added. I 1. Support for MO files without encoding specified was added. I
don't know there are MO files born without its encoding. ^^; don't know there are MO files born without its encoding. ^^;
2. L::M::G::F: textdomain() now works for default system locale 2. L::M::G::F: textdomain() now works for default system locale
directories, too. For domains that are not binded with directories, too. For domains that are not bound with
bindtextdomain(), it searches the system locale directories to bindtextdomain(), it searches the system locale directories to
find the domain MO files. Unlike textdomain() in L::M::G, it find the domain MO files. Unlike textdomain() in L::M::G, it
remembers the search result in order to build the index key. remembers the search result in order to build the index key.
@ -421,7 +421,7 @@ Locale-Maketext-Gettext change log
may be skipped, though. may be skipped, though.
2003-05-02 version 1.03 2003-05-02 version 1.03
1. L::M::G: A algorism bug about key_encoding with auto-lexicon was 1. L::M::G: A algorithm bug about key_encoding with auto-lexicon was
fixed. fixed.
2. L::M::G::F: I decide to give up mod_perl safety for encoding, 2. L::M::G::F: I decide to give up mod_perl safety for encoding,
key_encoding, encode_failure and die_for_lookup_failures(). key_encoding, encode_failure and die_for_lookup_failures().
@ -505,13 +505,13 @@ Locale-Maketext-Gettext change log
2003-04-27 version 0.06 2003-04-27 version 0.06
Improvements. Improvements.
1. textdomain() works for default system locale directories now. For 1. textdomain() works for default system locale directories now. For
domains that are not binded with bindtextdomain(), it searches the domains that are not bound with bindtextdomain(), it searches the
system locale directories to find the MO file. No test suite is system locale directories to find the MO file. No test suite is
available for this functionality. I cannot predict what MO files available for this functionality. I cannot predict what MO files
are available in your system locale directories. ^^; Please are available in your system locale directories. ^^; Please
report bugs if it does not work. report bugs if it does not work.
2. Slave package Locale::Maketext::Gettext::_AUTO::L10N is added, in 2. Slave package Locale::Maketext::Gettext::_AUTO::L10N is added, in
order to process the _AUTO Lexicon seperately. This saves order to process the _AUTO Lexicon separately. This saves
resources when user change the die_for_lookup_failures() setting. resources when user change the die_for_lookup_failures() setting.
Changing die_for_lookup_failures() setting won't trigger copying Changing die_for_lookup_failures() setting won't trigger copying
and replacing your whole %Lexicon anymore. As an effect, the and replacing your whole %Lexicon anymore. As an effect, the
@ -520,7 +520,7 @@ Locale-Maketext-Gettext change log
3. read_mo() is added to retire the readmo(). Use of readmo() is 3. read_mo() is added to retire the readmo(). Use of readmo() is
deprecated. This idea is inspired by the implementation of deprecated. This idea is inspired by the implementation of
readmo() as "parse_mo" in Locale::Maketext::Lexicon by Autrijus. readmo() as "parse_mo" in Locale::Maketext::Lexicon by Autrijus.
There is far too much meta infomation to be returned other than There is far too much meta information to be returned other than
its encoding. It's not possible to change the API for each new its encoding. It's not possible to change the API for each new
requirement. To enable sharing of the algorithm used in read_mo() requirement. To enable sharing of the algorithm used in read_mo()
with whoever need it, it's necessary to limit its function to read with whoever need it, it's necessary to limit its function to read

75
lib/Locale/Maketext/Gettext.pm
View File

@ -1,16 +1,16 @@
# Locale::Maketext::Gettext - Joins the gettext and Maketext frameworks # Locale::Maketext::Gettext - Joins the gettext and Maketext frameworks
# Copyright (c) 2003-2019 imacat. All rights reserved. This program is free # Copyright (c) 2003-2021 imacat. All rights reserved. This program is free
# software; you can redistribute it and/or modify it under the same terms # software; you can redistribute it and/or modify it under the same terms
# as Perl itself. # as Perl itself.
# First written: 2003-04-23 # First written: 2003/4/23
package Locale::Maketext::Gettext; package Locale::Maketext::Gettext;
use 5.008; use 5.008;
use strict; use strict;
use warnings; use warnings;
use base qw(Locale::Maketext Exporter); use base qw(Locale::Maketext Exporter);
use vars qw($VERSION @ISA %Lexicon @EXPORT @EXPORT_OK); our ($VERSION, @EXPORT, @EXPORT_OK);
$VERSION = 1.30; $VERSION = 1.30;
@EXPORT = qw(read_mo); @EXPORT = qw(read_mo);
@EXPORT_OK = @EXPORT; @EXPORT_OK = @EXPORT;
@ -21,15 +21,15 @@ use Encode qw(encode decode FB_DEFAULT);
use File::Spec::Functions qw(catfile); use File::Spec::Functions qw(catfile);
no strict qw(refs); no strict qw(refs);
use vars qw(%CACHE $REREAD_MO $MO_FILE); our (%CACHE, $REREAD_MO, $MO_FILE);
%CACHE = qw(); %CACHE = qw();
$REREAD_MO = 0; $REREAD_MO = 0;
$MO_FILE = ""; $MO_FILE = "";
use vars qw(@SYSTEM_LOCALEDIRS); our (@SYSTEM_LOCALEDIRS);
@SYSTEM_LOCALEDIRS = qw(/usr/share/locale /usr/lib/locale @SYSTEM_LOCALEDIRS = qw(/usr/share/locale /usr/lib/locale
/usr/local/share/locale /usr/local/lib/locale); /usr/local/share/locale /usr/local/lib/locale);
# encoding: Set or retrieve the output encoding # Set or retrieve the output encoding
sub encoding : method { sub encoding : method {
local ($_, %_); local ($_, %_);
my $self; my $self;
@ -52,7 +52,7 @@ sub encoding : method {
return exists $self->{"ENCODING"}? $self->{"ENCODING"}: undef; return exists $self->{"ENCODING"}? $self->{"ENCODING"}: undef;
} }
# key_encoding: Specify the encoding used in the keys # Specify the encoding used in the keys
sub key_encoding : method { sub key_encoding : method {
local ($_, %_); local ($_, %_);
my $self; my $self;
@ -74,7 +74,7 @@ sub key_encoding : method {
return exists $self->{"KEY_ENCODING"}? $self->{"KEY_ENCODING"}: undef; return exists $self->{"KEY_ENCODING"}? $self->{"KEY_ENCODING"}: undef;
} }
# new: Initialize the language handler # Initialize the language handler
sub new : method { sub new : method {
local ($_, %_); local ($_, %_);
my ($self, $class); my ($self, $class);
@ -85,7 +85,7 @@ sub new : method {
return $self; return $self;
} }
# subclass_init: Initialize at the subclass level, so that it can be # Initialize at the subclass level, so that it can be
# inherited by calling $self->SUPER:subclass_init # inherited by calling $self->SUPER:subclass_init
sub subclass_init : method { sub subclass_init : method {
local ($_, %_); local ($_, %_);
@ -119,7 +119,7 @@ sub subclass_init : method {
return; return;
} }
# bindtextdomain: Bind a text domain to a locale directory # Bind a text domain to a locale directory
sub bindtextdomain : method { sub bindtextdomain : method {
local ($_, %_); local ($_, %_);
my ($self, $DOMAIN, $LOCALEDIR); my ($self, $DOMAIN, $LOCALEDIR);
@ -139,7 +139,7 @@ sub bindtextdomain : method {
return ${$self->{"LOCALEDIRS"}}{$DOMAIN}; return ${$self->{"LOCALEDIRS"}}{$DOMAIN};
} }
# textdomain: Set the current text domain # Set the current text domain
sub textdomain : method { sub textdomain : method {
local ($_, %_); local ($_, %_);
my ($self, $class, $DOMAIN, $LOCALEDIR, $mo_file); my ($self, $class, $DOMAIN, $LOCALEDIR, $mo_file);
@ -232,7 +232,7 @@ sub textdomain : method {
} else { } else {
delete $self->{"MO_ENCODING"}; delete $self->{"MO_ENCODING"};
} }
# Respect the MO file encoding unless there is a user preferrence # Respect the MO file encoding unless there is a user preference
if (!exists $self->{"USERSET_ENCODING"}) { if (!exists $self->{"USERSET_ENCODING"}) {
if (exists $self->{"MO_ENCODING"}) { if (exists $self->{"MO_ENCODING"}) {
$self->{"ENCODING"} = $self->{"MO_ENCODING"}; $self->{"ENCODING"} = $self->{"MO_ENCODING"};
@ -247,7 +247,7 @@ sub textdomain : method {
return $DOMAIN; return $DOMAIN;
} }
# _is_using_cache: Return whether we are using our cache. # Return whether we are using our cache.
sub _is_using_cache : method { sub _is_using_cache : method {
local ($_, %_); local ($_, %_);
my ($self, $mo_file, @stats, $mtime, $size); my ($self, $mo_file, @stats, $mtime, $size);
@ -272,7 +272,7 @@ sub _is_using_cache : method {
} }
} }
# maketext: Encode after maketext # Encode after maketext
sub maketext : method { sub maketext : method {
local ($_, %_); local ($_, %_);
my ($self, $key, @param, $class, $keyd); my ($self, $key, @param, $class, $keyd);
@ -320,25 +320,25 @@ sub maketext : method {
return $_; return $_;
} }
# pmaketext: Maketext with context # Maketext with context
sub pmaketext : method { sub pmaketext : method {
local ($_, %_); local ($_, %_);
my ($self, $ctxt, $key, @param); my ($self, $context, $key, @param);
($self, $ctxt, $key, @param) = @_; ($self, $context, $key, @param) = @_;
# This is not a static method - NOW # This is not a static method - NOW
return if ref($self) eq ""; return if ref($self) eq "";
# This is actually a wrapper to the maketext() method # This is actually a wrapper to the maketext() method
return $self->maketext("$ctxt\x04$key", @param); return $self->maketext("$context\x04$key", @param);
} }
# read_mo: Subroutine to read and parse the MO file # Subroutine to read and parse the MO file
# Refer to gettext documentation section 8.3 # Refer to gettext documentation section 8.3
sub read_mo($) { sub read_mo($) {
local ($_, %_); local ($_, %_);
my ($mo_file, $len, $FH, $content, $tmpl); my ($mo_file, $len, $FH, $content, $tmpl);
$mo_file = $_[0]; $mo_file = $_[0];
# Avild being stupid # Avoid being stupid
return unless -f $mo_file && -r $mo_file; return unless -f $mo_file && -r $mo_file;
# Read the MO file # Read the MO file
$len = (stat $mo_file)[7]; $len = (stat $mo_file)[7];
@ -397,7 +397,7 @@ sub read_mo($) {
return %_; return %_;
} }
# reload_text: Method to purge the lexicon cache # Method to purge the lexicon cache
sub reload_text : method { sub reload_text : method {
local ($_, %_); local ($_, %_);
@ -408,7 +408,7 @@ sub reload_text : method {
return; return;
} }
# fail_with: A wrapper to the fail_with() of Locale::Maketext, in order # A wrapper to the fail_with() of Locale::Maketext, in order
# to record the preferred failure handler of the user, so that # to record the preferred failure handler of the user, so that
# die_for_lookup_failures() knows where to return to. # die_for_lookup_failures() knows where to return to.
sub fail_with : method { sub fail_with : method {
@ -434,7 +434,7 @@ sub fail_with : method {
return exists $self->{"USERSET_FAIL"}? $self->{"USERSET_FAIL"}: undef; return exists $self->{"USERSET_FAIL"}? $self->{"USERSET_FAIL"}: undef;
} }
# die_for_lookup_failures: Whether we should die for lookup failure # Whether we should die for lookup failure
# The default is no. GNU gettext never fails. # The default is no. GNU gettext never fails.
sub die_for_lookup_failures : method { sub die_for_lookup_failures : method {
local ($_, %_); local ($_, %_);
@ -464,7 +464,7 @@ sub die_for_lookup_failures : method {
$self->{"DIE_FOR_LOOKUP_FAILURES"}: undef; $self->{"DIE_FOR_LOOKUP_FAILURES"}: undef;
} }
# encode_failure: What to do if the text is out of your output encoding # What to do if the text is out of your output encoding
# Refer to Encode on possible values of this check # Refer to Encode on possible values of this check
sub encode_failure : method { sub encode_failure : method {
local ($_, %_); local ($_, %_);
@ -482,9 +482,9 @@ sub encode_failure : method {
return undef; return undef;
} }
# failure_handler_auto: Our local version of failure_handler_auto(), # Our local version of failure_handler_auto(),
# Copied and rewritten from Locale::Maketext, with bug#33938 patch applied. # Copied and rewritten from Locale::Maketext, with bug#33938 patch applied.
# See http://rt.perl.org/rt3//Public/Bug/Display.html?id=33938 # See https://github.com/Perl/perl5/issues/7767
sub failure_handler_auto : method { sub failure_handler_auto : method {
local ($_, %_); local ($_, %_);
my ($self, $key, @param, $r); my ($self, $key, @param, $r);
@ -523,7 +523,6 @@ sub failure_handler_auto : method {
s<\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?> s<\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?>
<\n in bracket code [compiled line $1],>s; <\n in bracket code [compiled line $1],>s;
Carp::croak "Error in maketexting \"$key\":\n$_ as used"; Carp::croak "Error in maketexting \"$key\":\n$_ as used";
return;
} }
# OK # OK
@ -580,7 +579,7 @@ that follows the way GNU gettext works. It works seamlessly, I<both
in the sense of GNU gettext and Maketext>. As a result, you I<enjoy in the sense of GNU gettext and Maketext>. As a result, you I<enjoy
both their advantages, and get rid of both their problems, too.> both their advantages, and get rid of both their problems, too.>
You start as an usual GNU gettext localization project: Work on You start as a usual GNU gettext localization project: Work on
PO files with the help of translators, reviewers and Emacs. Turn PO files with the help of translators, reviewers and Emacs. Turn
them into MO files with F<msgfmt>. Copy them into the appropriate them into MO files with F<msgfmt>. Copy them into the appropriate
locale directory, such as locale directory, such as
@ -615,7 +614,7 @@ returns the text message C<encode>d according to the current
C<encoding>. Refer to L<Locale::Maketext(3)|Locale::Maketext/3> for C<encoding>. Refer to L<Locale::Maketext(3)|Locale::Maketext/3> for
the maketext plural notation. the maketext plural notation.
=item $text = $LH->pmaketext($ctxt, $key, @param...) =item $text = $LH->pmaketext($context, $key, @param...)
Lookup the $key in a particular context in the current lexicon and Lookup the $key in a particular context in the current lexicon and
return a translated message in the language of the user. Use return a translated message in the language of the user. Use
@ -651,7 +650,7 @@ be working.
=item $LH->encode_failure(CHECK) =item $LH->encode_failure(CHECK)
Set the action when encode fails. This happens when the output text Set the action when encode fails. This happens when the output text
is out of the scope of your output encoding. For exmaple, output is out of the scope of your output encoding. For example, output
Chinese into US-ASCII. Refer to L<Encode(3)|Encode/3> for the Chinese into US-ASCII. Refer to L<Encode(3)|Encode/3> for the
possible values of this C<CHECK>. The default is C<FB_DEFAULT>, possible values of this C<CHECK>. The default is C<FB_DEFAULT>,
which is a safe choice that never fails. But part of your text may which is a safe choice that never fails. But part of your text may
@ -677,8 +676,8 @@ Purge the MO text cache. It purges the MO text cache from the base
class Locale::Maketext::Gettext. The next time C<maketext> is class Locale::Maketext::Gettext. The next time C<maketext> is
called, the MO file will be read and parse from the disk again. This called, the MO file will be read and parse from the disk again. This
is used when your MO file is updated, but you cannot shutdown and is used when your MO file is updated, but you cannot shutdown and
restart the application. For example, when you are a co-hoster on a restart the application. For example, when you are a virtual host on
mod_perl-enabled Apache, or when your mod_perl-enabled Apache is too a mod_perl-enabled Apache, or when your mod_perl-enabled Apache is too
vital to be restarted for every update of your MO file, or if you vital to be restarted for every update of your MO file, or if you
are running a vital daemon, such as an X display server. are running a vital daemon, such as an X display server.
@ -693,7 +692,7 @@ are running a vital daemon, such as an X display server.
Read and parse the MO file. Returns the read %Lexicon. The returned Read and parse the MO file. Returns the read %Lexicon. The returned
lexicon is in its original encoding. lexicon is in its original encoding.
If you need the meta infomation of your MO file, parse the entry If you need the meta information of your MO file, parse the entry
C<$Lexicon{""}>. For example: C<$Lexicon{""}>. For example:
/^Content-Type: text\/plain; charset=(.*)$/im; /^Content-Type: text\/plain; charset=(.*)$/im;
@ -729,7 +728,7 @@ But, well, here comes Locale::Maketext::Gettext to rescue. With
Locale::Maketext::Gettext, you can sit back and relax now, leaving Locale::Maketext::Gettext, you can sit back and relax now, leaving
all this mess to the excellent GNU gettext framework. all this mess to the excellent GNU gettext framework.
The idea of Locale::Maketext::Getttext came from The idea of Locale::Maketext::Gettext came from
L<Locale::Maketext::Lexicon(3)|Locale::Maketext::Lexicon/3>, a great L<Locale::Maketext::Lexicon(3)|Locale::Maketext::Lexicon/3>, a great
work by Autrijus. But it has several problems at that time (version work by Autrijus. But it has several problems at that time (version
0.16). I was first trying to write a wrapper to fix it, but finally 0.16). I was first trying to write a wrapper to fix it, but finally
@ -760,7 +759,7 @@ text may be lost, as C<FB_DEFAULT> does. If you do not like this
C<FB_DEFAULT>, change the failure behavior with the method C<FB_DEFAULT>, change the failure behavior with the method
C<encode_failure>. C<encode_failure>.
If you need the behavior of auto Traditional Chinese/Simplfied If you need the behavior of auto Traditional Chinese/Simplified
Chinese conversion, as GNU gettext smartly does, do it yourself with Chinese conversion, as GNU gettext smartly does, do it yourself with
L<Encode::HanExtra(3)|Encode::HanExtra/3>, too. There may be a L<Encode::HanExtra(3)|Encode::HanExtra/3>, too. There may be a
solution for this in the future, but not now. solution for this in the future, but not now.
@ -802,7 +801,7 @@ this problem by saving a copy of the current lexicon as an instance
variable, and replacing the class lexicon with the current instance variable, and replacing the class lexicon with the current instance
lexicon whenever it is changed by another language handle instance. lexicon whenever it is changed by another language handle instance.
But this involves large scaled memory copy, which affects the But this involves large scaled memory copy, which affects the
proformance seriously. This is discouraged. You are adviced to use performance seriously. This is discouraged. You are advised to use
a single textdomain for a single localization class. a single textdomain for a single localization class.
The C<key_encoding> is a workaround, not a solution. There is no The C<key_encoding> is a workaround, not a solution. There is no
@ -834,7 +833,7 @@ L<Locale::Maketext::TPJ13(3)|Locale::Maketext::TPJ13/3>,
L<Locale::Maketext::Lexicon(3)|Locale::Maketext::Lexicon/3>, L<Locale::Maketext::Lexicon(3)|Locale::Maketext::Lexicon/3>,
L<Encode(3)|Encode/3>, L<bindtextdomain(3)|bindtextdomain/3>, L<Encode(3)|Encode/3>, L<bindtextdomain(3)|bindtextdomain/3>,
L<textdomain(3)|textdomain/3>. Also, please refer to the official GNU L<textdomain(3)|textdomain/3>. Also, please refer to the official GNU
gettext manual at L<http://www.gnu.org/software/gettext/manual/>. gettext manual at L<https://www.gnu.org/software/gettext/manual/>.
=head1 AUTHOR =head1 AUTHOR
@ -842,7 +841,7 @@ imacat <imacat@mail.imacat.idv.tw>
=head1 COPYRIGHT =head1 COPYRIGHT
Copyright (c) 2003-2019 imacat. All rights reserved. This program is free Copyright (c) 2003-2021 imacat. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms software; you can redistribute it and/or modify it under the same terms
as Perl itself. as Perl itself.

136
lib/Locale/Maketext/Gettext/Functions.pm
View File

@ -1,22 +1,22 @@
# Locale::Maketext::Gettext::Functions - Functional interface to Locale::Maketext::Gettext # Locale::Maketext::Gettext::Functions - Functional interface to Locale::Maketext::Gettext
# Copyright (c) 2003-2008 imacat. All rights reserved. This program is free # Copyright (c) 2003-2021 imacat. All rights reserved. This program is free
# software; you can redistribute it and/or modify it under the same terms # software; you can redistribute it and/or modify it under the same terms
# as Perl itself. # as Perl itself.
# First written: 2003-04-28 # First written: 2003/4/28
package Locale::Maketext::Gettext::Functions; package Locale::Maketext::Gettext::Functions;
use 5.008; use 5.008;
use strict; use strict;
use warnings; use warnings;
use base qw(Exporter); use base qw(Exporter);
use vars qw($VERSION @EXPORT @EXPORT_OK); our ($VERSION, @EXPORT, @EXPORT_OK);
$VERSION = 0.13; $VERSION = 0.13;
@EXPORT = qw(); @EXPORT = qw(
push @EXPORT, qw(bindtextdomain textdomain get_handle maketext __ N_); bindtextdomain textdomain get_handle maketext __ N_
push @EXPORT, qw(dmaketext pmaketext dpmaketext); dmaketext pmaketext dpmaketext
push @EXPORT, qw(reload_text read_mo encoding key_encoding encode_failure); reload_text read_mo encoding key_encoding encode_failure
push @EXPORT, qw(die_for_lookup_failures); die_for_lookup_failures);
@EXPORT_OK = @EXPORT; @EXPORT_OK = @EXPORT;
# Prototype declaration # Prototype declaration
sub bindtextdomain($;$); sub bindtextdomain($;$);
@ -34,7 +34,7 @@ sub key_encoding(;$);
sub encode_failure(;$); sub encode_failure(;$);
sub die_for_lookup_failures(;$); sub die_for_lookup_failures(;$);
sub _declare_class($); sub _declare_class($);
sub _catclass(@); sub _cat_class(@);
sub _init_textdomain($); sub _init_textdomain($);
sub _get_langs($$); sub _get_langs($$);
sub _get_handle(); sub _get_handle();
@ -47,13 +47,13 @@ sub _lang($);
use Encode qw(encode decode from_to FB_DEFAULT); use Encode qw(encode decode from_to FB_DEFAULT);
use File::Spec::Functions qw(catdir catfile); use File::Spec::Functions qw(catdir catfile);
use Locale::Maketext::Gettext qw(read_mo); use Locale::Maketext::Gettext qw(read_mo);
use vars qw(%LOCALEDIRS %RIDS %CLASSES %LANGS); our (%LOCALEDIRS, %RIDS, %CLASSES, %LANGS);
use vars qw(%LHS $_EMPTY $LH $DOMAIN $CATEGORY $CLASSBASE @LANGS %PARAMS); our (%LHS, $_EMPTY, $LH, $DOMAIN, $CATEGORY, $BASE_CLASS, @LANGS, %PARAMS);
use vars qw(@SYSTEM_LOCALEDIRS); our (@SYSTEM_LOCALEDIRS);
%LHS = qw(); %LHS = qw();
# The category is always LC_MESSAGES # The category is always LC_MESSAGES
$CATEGORY = "LC_MESSAGES"; $CATEGORY = "LC_MESSAGES";
$CLASSBASE = "Locale::Maketext::Gettext::_runtime"; $BASE_CLASS = "Locale::Maketext::Gettext::_runtime";
# Current language parameters # Current language parameters
@LANGS = qw(); @LANGS = qw();
@SYSTEM_LOCALEDIRS = @Locale::Maketext::Gettext::SYSTEM_LOCALEDIRS; @SYSTEM_LOCALEDIRS = @Locale::Maketext::Gettext::SYSTEM_LOCALEDIRS;
@ -62,12 +62,12 @@ $PARAMS{"KEY_ENCODING"} = "US-ASCII";
$PARAMS{"ENCODE_FAILURE"} = FB_DEFAULT; $PARAMS{"ENCODE_FAILURE"} = FB_DEFAULT;
$PARAMS{"DIE_FOR_LOOKUP_FAILURES"} = 0; $PARAMS{"DIE_FOR_LOOKUP_FAILURES"} = 0;
# Parameters for random class IDs # Parameters for random class IDs
use vars qw($RID_LEN @RID_CHARS); our ($RID_LEN, @RID_CHARS);
$RID_LEN = 8; $RID_LEN = 8;
@RID_CHARS = split //, @RID_CHARS = split //,
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
# bindtextdomain: Bind a text domain to a locale directory # Bind a text domain to a locale directory
sub bindtextdomain($;$) { sub bindtextdomain($;$) {
local ($_, %_); local ($_, %_);
my ($domain, $LOCALEDIR); my ($domain, $LOCALEDIR);
@ -85,7 +85,7 @@ sub bindtextdomain($;$) {
return $LOCALEDIR; return $LOCALEDIR;
} }
# textdomain: Set the current text domain # Set the current text domain
sub textdomain(;$) { sub textdomain(;$) {
local ($_, %_); local ($_, %_);
my ($new_domain); my ($new_domain);
@ -101,7 +101,7 @@ sub textdomain(;$) {
return $DOMAIN; return $DOMAIN;
} }
# get_handle: Get a language handle # Get a language handle
sub get_handle(@) { sub get_handle(@) {
local ($_, %_); local ($_, %_);
# Register the current get_handle arguments # Register the current get_handle arguments
@ -110,13 +110,13 @@ sub get_handle(@) {
return _get_handle(); return _get_handle();
} }
# maketext: Maketext, in its long name # Maketext, in its long name
# Use @ instead of $@ in prototype, so that we can pass @_ to it. # Use @ instead of $@ in prototype, so that we can pass @_ to it.
sub maketext(@) { sub maketext(@) {
return __($_[0], @_[1..$#_]); return __($_[0], @_[1..$#_]);
} }
# __: Maketext, in its shortcut name # Maketext, in its shortcut name
# Use @ instead of $@ in prototype, so that we can pass @_ to it. # Use @ instead of $@ in prototype, so that we can pass @_ to it.
sub __(@) { sub __(@) {
local ($_, %_); local ($_, %_);
@ -144,7 +144,7 @@ sub __(@) {
return $_; return $_;
} }
# N_: Return the original text untouched, so that it can be catched # Return the original text untouched, so that it can be cached
# with xgettext # with xgettext
# Use @ instead of $@ in prototype, so that we can pass @_ to it. # Use @ instead of $@ in prototype, so that we can pass @_ to it.
sub N_(@) { sub N_(@) {
@ -153,7 +153,7 @@ sub N_(@) {
return @_; return @_;
} }
# dmaketext: Maketext in another text domain temporarily, # Maketext in another text domain temporarily,
# an equivalent to dgettext(). # an equivalent to dgettext().
sub dmaketext($$@) { sub dmaketext($$@) {
local ($_, %_); local ($_, %_);
@ -171,33 +171,33 @@ sub dmaketext($$@) {
return $text; return $text;
} }
# pmaketext: Maketext with context, # Maketext with context,
# an equivalent to pgettext(). # an equivalent to pgettext().
sub pmaketext($$@) { sub pmaketext($$@) {
local ($_, %_); local ($_, %_);
my ($ctxt, $key, @param); my ($context, $key, @param);
($ctxt, $key, @param) = @_; ($context, $key, @param) = @_;
# This is actually a wrapper to the maketext() function # This is actually a wrapper to the maketext() function
return maketext("$ctxt\x04$key", @param); return maketext("$context\x04$key", @param);
} }
# dpmaketext: Maketext with context in another text domain temporarily, # Maketext with context in another text domain temporarily,
# an equivalent to dpgettext(). # an equivalent to dpgettext().
sub dpmaketext($$$@) { sub dpmaketext($$$@) {
local ($_, %_); local ($_, %_);
my ($domain, $ctxt, $key, @param); my ($domain, $context, $key, @param);
($domain, $ctxt, $key, @param) = @_; ($domain, $context, $key, @param) = @_;
# This is actually a wrapper to the dmaketext() function # This is actually a wrapper to the dmaketext() function
return dmaketext($domain, "$ctxt\x04$key", @param); return dmaketext($domain, "$context\x04$key", @param);
} }
# reload_text: Purge the lexicon cache # Purge the lexicon cache
sub reload_text() { sub reload_text() {
# reload_text is static. # reload_text is static.
Locale::Maketext::Gettext->reload_text; Locale::Maketext::Gettext->reload_text;
} }
# encoding: Set the output encoding # Set the output encoding
sub encoding(;$) { sub encoding(;$) {
local ($_, %_); local ($_, %_);
$_ = $_[0]; $_ = $_[0];
@ -216,7 +216,7 @@ sub encoding(;$) {
return exists $PARAMS{"ENCODING"}? $PARAMS{"ENCODING"}: undef; return exists $PARAMS{"ENCODING"}? $PARAMS{"ENCODING"}: undef;
} }
# key_encoding: Set the encoding of the original text # Set the encoding of the original text
sub key_encoding(;$) { sub key_encoding(;$) {
local ($_, %_); local ($_, %_);
$_ = $_[0]; $_ = $_[0];
@ -234,7 +234,7 @@ sub key_encoding(;$) {
return exists $PARAMS{"KEY_ENCODING"}? $PARAMS{"KEY_ENCODING"}: undef; return exists $PARAMS{"KEY_ENCODING"}? $PARAMS{"KEY_ENCODING"}: undef;
} }
# encode_failure: What to do if the text is out of your output encoding # What to do if the text is out of your output encoding
# Refer to Encode on possible values of this check # Refer to Encode on possible values of this check
sub encode_failure(;$) { sub encode_failure(;$) {
local ($_, %_); local ($_, %_);
@ -245,7 +245,7 @@ sub encode_failure(;$) {
return $PARAMS{"ENCODE_FAILURE"}; return $PARAMS{"ENCODE_FAILURE"};
} }
# die_for_lookup_failures: Whether we should die for lookup failure # Whether we should die for lookup failure
# The default is no. GNU gettext never fails. # The default is no. GNU gettext never fails.
sub die_for_lookup_failures(;$) { sub die_for_lookup_failures(;$) {
local ($_, %_); local ($_, %_);
@ -261,23 +261,23 @@ sub die_for_lookup_failures(;$) {
return $PARAMS{"DIE_FOR_LOOKUP_FAILURES"}; return $PARAMS{"DIE_FOR_LOOKUP_FAILURES"};
} }
# _declare_class: Declare a class # Declare a class
sub _declare_class($) { sub _declare_class($) {
local ($_, %_); local ($_, %_);
$_ = $_[0]; $_ = $_[0];
eval << "EOT"; eval << "EOT";
package $_[0]; package $_[0];
use base qw(Locale::Maketext::Gettext); use base qw(Locale::Maketext::Gettext);
use vars qw(\@ISA %Lexicon); our (\@ISA, %Lexicon);
EOT EOT
} }
# _catclass: Catenate the class name # Concatenate the class name
sub _catclass(@) { sub _cat_class(@) {
return join("::", @_);; return join("::", @_);;
} }
# _init_textdomain: Initialize a text domain # Initialize a text domain
sub _init_textdomain($) { sub _init_textdomain($) {
local ($_, %_); local ($_, %_);
my ($domain, $k, @langs, $langs); my ($domain, $k, @langs, $langs);
@ -287,10 +287,10 @@ sub _init_textdomain($) {
return if !defined $domain; return if !defined $domain;
# Obtain the available locales # Obtain the available locales
# A binded domain # A bound domain
if (exists $LOCALEDIRS{$domain}) { if (exists $LOCALEDIRS{$domain}) {
@langs = _get_langs($LOCALEDIRS{$domain}, $domain); @langs = _get_langs($LOCALEDIRS{$domain}, $domain);
# Not binded # Not bound
} else { } else {
@langs = qw(); @langs = qw();
# Search the system locale directories # Search the system locale directories
@ -322,22 +322,22 @@ sub _init_textdomain($) {
# Get a new class ID # Get a new class ID
$rid = _new_rid(); $rid = _new_rid();
# Obtain the class name # Obtain the class name
$class = _catclass($CLASSBASE, $rid); $class = _cat_class($BASE_CLASS, $rid);
# Register the domain with this class # Register the domain with this class
$CLASSES{$k} = $class; $CLASSES{$k} = $class;
# Declare this class # Declare this class
_declare_class($class); _declare_class($class);
# Declare its language subclasses # Declare its language subclasses
_declare_class(_catclass($class, $_)) _declare_class(_cat_class($class, $_))
foreach @langs; foreach @langs;
return; return;
} }
# _get_langs: Search a locale directory and return the available languages # Search a locale directory and return the available languages
sub _get_langs($$) { sub _get_langs($$) {
local ($_, %_); local ($_, %_);
my ($dir, $domain, $DH, $entry, $MOfile); my ($dir, $domain, $DH, $entry, $MO_file);
($dir, $domain) = @_; ($dir, $domain) = @_;
@_ = qw(); @_ = qw();
@ -351,9 +351,9 @@ sub _get_langs($$) {
# Skip locales with dot "." (trailing encoding) # Skip locales with dot "." (trailing encoding)
next if $entry =~ /\./; next if $entry =~ /\./;
# Get the MO file name # Get the MO file name
$MOfile = catfile($dir, $entry, $CATEGORY, "$domain.mo"); $MO_file = catfile($dir, $entry, $CATEGORY, "$domain.mo");
# Skip if MO file is not available for this locale # Skip if MO file is not available for this locale
next if ! -f $MOfile && ! -r $MOfile; next if ! -f $MO_file && ! -r $MO_file;
# Map C to i_default # Map C to i_default
$entry = "i_default" if $entry eq "C"; $entry = "i_default" if $entry eq "C";
# Add this language # Add this language
@ -364,12 +364,12 @@ sub _get_langs($$) {
return @_; return @_;
} }
# _get_handle: Set the language handle with the current DOMAIN and @LANGS # Set the language handle with the current DOMAIN and @LANGS
sub _get_handle() { sub _get_handle() {
local ($_, %_); local ($_, %_);
my ($k, $class, $subclass); my ($k, $class, $subclass);
# Lexicon empty if text domain not specified, or not binded yet # Lexicon empty if text domain not specified, or not bound yet
return _get_empty_handle if !defined $DOMAIN || !exists $LOCALEDIRS{$DOMAIN}; return _get_empty_handle if !defined $DOMAIN || !exists $LOCALEDIRS{$DOMAIN};
# Obtain the registry key # Obtain the registry key
$k = _k($DOMAIN); $k = _k($DOMAIN);
@ -402,7 +402,7 @@ sub _get_handle() {
# Initialize it # Initialize it
$LH->bindtextdomain($DOMAIN, $LOCALEDIRS{$DOMAIN}); $LH->bindtextdomain($DOMAIN, $LOCALEDIRS{$DOMAIN});
$LH->textdomain($DOMAIN); $LH->textdomain($DOMAIN);
# Respect the MO file encoding unless there is a user preferrence # Respect the MO file encoding unless there is a user preference
if (!exists $PARAMS{"USERSET_ENCODING"}) { if (!exists $PARAMS{"USERSET_ENCODING"}) {
if (exists $LH->{"MO_ENCODING"}) { if (exists $LH->{"MO_ENCODING"}) {
$PARAMS{"ENCODING"} = $LH->{"MO_ENCODING"}; $PARAMS{"ENCODING"} = $LH->{"MO_ENCODING"};
@ -419,7 +419,7 @@ sub _get_handle() {
return _lang($LH); return _lang($LH);
} }
# _get_empty_handle: Obtain the empty language handle # Obtain the empty language handle
sub _get_empty_handle() { sub _get_empty_handle() {
local ($_, %_); local ($_, %_);
if (!defined $_EMPTY) { if (!defined $_EMPTY) {
@ -432,7 +432,7 @@ sub _get_empty_handle() {
return _lang($LH); return _lang($LH);
} }
# _reset: Initialize everything # Initialize everything
sub _reset() { sub _reset() {
local ($_, %_); local ($_, %_);
@ -448,7 +448,7 @@ sub _reset() {
return; return;
} }
# _new_rid: Generate a new random ID # Generate a new random ID
sub _new_rid() { sub _new_rid() {
local ($_, %_); local ($_, %_);
my ($id); my ($id);
@ -463,12 +463,12 @@ sub _new_rid() {
return $id; return $id;
} }
# _k: Build the key for the domain registry # Build the key for the domain registry
sub _k($) { sub _k($) {
return join "\n", $LOCALEDIRS{$_[0]}, $CATEGORY, $_[0]; return join "\n", $LOCALEDIRS{$_[0]}, $CATEGORY, $_[0];
} }
# _lang: The langage from a language handle. language_tag is not quite sane. # The language from a language handle. language_tag is not quite sane.
sub _lang($) { sub _lang($) {
local ($_, %_); local ($_, %_);
$_ = $_[0]; $_ = $_[0];
@ -484,16 +484,14 @@ use 5.008;
use strict; use strict;
use warnings; use warnings;
use base qw(Locale::Maketext::Gettext); use base qw(Locale::Maketext::Gettext);
use vars qw($VERSION @ISA %Lexicon); our $VERSION = 0.01;
$VERSION = 0.01;
package Locale::Maketext::Gettext::Functions::_EMPTY::i_default; package Locale::Maketext::Gettext::Functions::_EMPTY::i_default;
use 5.008; use 5.008;
use strict; use strict;
use warnings; use warnings;
use base qw(Locale::Maketext::Gettext); use base qw(Locale::Maketext::Gettext);
use vars qw($VERSION @ISA %Lexicon); our $VERSION = 0.01;
$VERSION = 0.01;
return 1; return 1;
@ -557,7 +555,7 @@ C<get_handle>.
Attempts to translate a text message into the native language of the Attempts to translate a text message into the native language of the
user, by looking up the translation in an MO lexicon file. Refer to user, by looking up the translation in an MO lexicon file. Refer to
L<Locale::Maketext(3)|Locale::Maketext/3> for the C<maketext> plural L<Locale::Maketext(3)|Locale::Maketext/3> for the C<maketext> plural
grammer. grammar.
=item $message = __($key, @param...) =item $message = __($key, @param...)
@ -567,7 +565,7 @@ that it is cleaner when you employ maketext to your existing project.
=item ($key, @param...) = N_($key, @param...) =item ($key, @param...) = N_($key, @param...)
Returns the original text untouched. This is to enable the text be Returns the original text untouched. This is to enable the text be
catched with xgettext. caught with xgettext.
=item $message = dmaketext($domain, $key, @param...) =item $message = dmaketext($domain, $key, @param...)
@ -575,13 +573,13 @@ Temporarily switch to another text domain and attempts to translate
a text message into the native language of the user in that text a text message into the native language of the user in that text
domain. Use "--keyword=dmaketext:2" for the xgettext utility. domain. Use "--keyword=dmaketext:2" for the xgettext utility.
=item $message = pmaketext($ctxt, $key, @param...) =item $message = pmaketext($context, $key, @param...)
Attempts to translate a text message in a particular context into the Attempts to translate a text message in a particular context into the
native language of the user. Use "--keyword=pmaketext:1c,2" for native language of the user. Use "--keyword=pmaketext:1c,2" for
the xgettext utility. the xgettext utility.
=item $message = dpmaketext($domain, $ctxt, $key, @param...) =item $message = dpmaketext($domain, $context, $key, @param...)
Temporarily switch to another text domain and attempts to translate Temporarily switch to another text domain and attempts to translate
a text message in a particular context into the native language of a text message in a particular context into the native language of
@ -613,7 +611,7 @@ be working.
=item encode_failure(CHECK) =item encode_failure(CHECK)
Set the action when encode fails. This happens when the output text Set the action when encode fails. This happens when the output text
is out of the scope of your output encoding. For exmaple, output is out of the scope of your output encoding. For example, output
Chinese into US-ASCII. Refer to L<Encode(3)|Encode/3> for the Chinese into US-ASCII. Refer to L<Encode(3)|Encode/3> for the
possible values of this C<CHECK>. The default is C<FB_DEFAULT>, possible values of this C<CHECK>. The default is C<FB_DEFAULT>,
which is a safe choice that never fails. But part of your text may which is a safe choice that never fails. But part of your text may
@ -635,17 +633,17 @@ are read and parsed from the disk, to reduce I/O and parsing overhead
on busy sites. reload_text() purges this cache, so that updated MO on busy sites. reload_text() purges this cache, so that updated MO
files can take effect at run-time. This is used when your MO file is files can take effect at run-time. This is used when your MO file is
updated, but you cannot shutdown and restart the application. for updated, but you cannot shutdown and restart the application. for
example, when you are a co-hoster on a mod_perl-enabled Apache, or example, when you are a virtual host on a mod_perl-enabled Apache, or
when your mod_perl-enabled Apache is too vital to be restarted for when your mod_perl-enabled Apache is too vital to be restarted for
every update of your MO file, or if you are running a vital daemon, every update of your MO file, or if you are running a vital daemon,
such as an X display server. such as an X display server.
=item %Lexicon = read_mo($MOfile) =item %Lexicon = read_mo($MO_file)
Read and parse the MO file. Returns the read %Lexicon. The returned Read and parse the MO file. Returns the read %Lexicon. The returned
lexicon is in its original encoding. lexicon is in its original encoding.
If you need the meta infomation of your MO file, parse the entry If you need the meta information of your MO file, parse the entry
C<$Lexicon{""}>. For example: C<$Lexicon{""}>. For example:
/^Content-Type: text\/plain; charset=(.*)$/im; /^Content-Type: text\/plain; charset=(.*)$/im;
@ -766,7 +764,7 @@ L<Locale::Maketext::TPJ13(3)|Locale::Maketext::TPJ13/3>,
L<Locale::Maketext::Gettext(3)|Locale::Maketext::Gettext/3>, L<Locale::Maketext::Gettext(3)|Locale::Maketext::Gettext/3>,
L<bindtextdomain(3)|bindtextdomain/3>, L<textdomain(3)|textdomain/3>. L<bindtextdomain(3)|bindtextdomain/3>, L<textdomain(3)|textdomain/3>.
Also, please refer to the official GNU gettext manual at Also, please refer to the official GNU gettext manual at
L<http://www.gnu.org/software/gettext/manual/>. L<https://www.gnu.org/software/gettext/manual/>.
=head1 AUTHOR =head1 AUTHOR
@ -774,7 +772,7 @@ imacat <imacat@mail.imacat.idv.tw>
=head1 COPYRIGHT =head1 COPYRIGHT
Copyright (c) 2003-2008 imacat. All rights reserved. This program is free Copyright (c) 2003-2021 imacat. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms software; you can redistribute it and/or modify it under the same terms
as Perl itself. as Perl itself.

33
script/maketext Executable file → Normal file
View File

@ -1,31 +1,30 @@
#! /usr/bin/perl -w #! /usr/bin/perl -w
# Command-line interface to Locale::Maketext::Gettext (and Locale::Maketext) # Command-line interface to Locale::Maketext::Gettext (and Locale::Maketext)
# Copyright (c) 2003-2007 imacat. All rights reserved. This program is free # Copyright (c) 2003-2021 imacat. All rights reserved. This program is free
# software; you can redistribute it and/or modify it under the same terms # software; you can redistribute it and/or modify it under the same terms
# as Perl itself. # as Perl itself.
# First written: 2003-05-03 # First written: 2003/5/3
use 5.008; use 5.008;
use strict; use strict;
use warnings; use warnings;
use Getopt::Long qw(GetOptions); use Getopt::Long qw(GetOptions);
use Locale::Maketext::Gettext::Functions; use Locale::Maketext::Gettext::Functions;
use vars qw($VERSION); our $VERSION = 0.05;
$VERSION = 0.05;
# Prototype declaration # Prototype declaration
sub main(); sub main();
sub parse_args(); sub parse_args();
use vars qw($THIS_FILE $SHORTHELP $VERSTR $SEARCH $HELP); our ($THIS_FILE, $SHORT_HELP, $VER_STR, $SEARCH, $HELP);
$THIS_FILE = $0; $THIS_FILE = $0;
$THIS_FILE =~ s/^.*\///; $THIS_FILE =~ s/^.*\///;
$SHORTHELP = "Try `$THIS_FILE --help' for more information."; $SHORT_HELP = "Try `$THIS_FILE --help' for more information.";
$VERSTR = "$THIS_FILE v$VERSION by imacat <imacat\@mail.imacat.idv.tw>"; $VER_STR = "$THIS_FILE v$VERSION by imacat <imacat\@mail.imacat.idv.tw>";
$SEARCH = join " ", @Locale::Maketext::Gettext::Functions::SYSTEM_LOCALEDIRS; $SEARCH = join " ", @Locale::Maketext::Gettext::Functions::SYSTEM_LOCALEDIRS;
$HELP = << "EOT"; $HELP = << "EOT";
Usage: maketext [OPTION] [--domain=TEXTDOMAIN] MSGKEY [PARAM...] Usage: maketext [OPTION] [--domain=TEXTDOMAIN] MSGKEY [PARAM...]
or: maketext [OPTION] -s MSGID [PARAM...] or: maketext [OPTION] -s MSGKEY [PARAM...]
Maketext and display native language translation of a textual message. Maketext and display native language translation of a textual message.
@ -46,14 +45,14 @@ Standard search directories: $SEARCH
Report bugs to <imacat\@mail.imacat.idv.tw>. Report bugs to <imacat\@mail.imacat.idv.tw>.
EOT EOT
use vars qw($DOMAIN $LOCALEDIR $ECHO $KEY @PARAM); our ($DOMAIN, $LOCALEDIR, $ECHO, $KEY, @PARAM);
$ECHO = 0; $ECHO = 0;
# Main program # Main program
main(); main();
exit 0; exit 0;
# main: Main program # Main program
sub main() { sub main() {
local ($_, %_); local ($_, %_);
@ -69,18 +68,18 @@ sub main() {
return; return;
} }
# parse_args: Parse the arguments # Parse the arguments
sub parse_args() { sub parse_args() {
local ($_, %_); local ($_, %_);
# Get the arguments ¨ú±o°Ñ¼Æ # Get the arguments
$_ = eval { $_ = eval {
local $SIG{__WARN__} = sub { die $_[0]; }; local $SIG{__WARN__} = sub { die $_[0]; };
Getopt::Long::Configure("no_auto_abbrev"); Getopt::Long::Configure("no_auto_abbrev");
GetOptions( "domain|d=s"=>\$DOMAIN, GetOptions( "domain|d=s"=>\$DOMAIN,
"s"=>sub { $ECHO = 1; }, "s"=>sub { $ECHO = 1; },
"help|h"=>sub { print $HELP; exit 0; }, "help|h"=>sub { print $HELP; exit 0; },
"version|V"=>sub { print "$VERSTR\n"; exit 0; }); "version|V"=>sub { print "$VER_STR\n"; exit 0; });
return 1; return 1;
}; };
die "$THIS_FILE: $@" if !defined $_; die "$THIS_FILE: $@" if !defined $_;
@ -108,7 +107,7 @@ maketext - translate and make messages
=head1 SYNOPSIS =head1 SYNOPSIS
maketext [OPTION] [--domain=TEXTDOMAIN] MSGKEY [PARAM...] maketext [OPTION] [--domain=TEXTDOMAIN] MSGKEY [PARAM...]
maketext [OPTION] -s MSGID [PARAM...] maketext [OPTION] -s MSGKEY [PARAM...]
=head1 DESCRIPTION =head1 DESCRIPTION
@ -174,7 +173,7 @@ parameter is not given.
=item TEXTDOMAINDIR =item TEXTDOMAINDIR
TEXTDOMAINDIR is used to search the message catelog/MO file if it TEXTDOMAINDIR is used to search the message catalog/MO file if it
does not reside in the system locale directories. does not reside in the system locale directories.
=back =back
@ -200,7 +199,7 @@ L<Locale::Maketext::Gettext(3)|Locale::Maketext::Gettext/3>,
L<Locale::Maketext::Gettext::Functions(3)|Locale::Maketext::Gettext::Functions/3>, L<Locale::Maketext::Gettext::Functions(3)|Locale::Maketext::Gettext::Functions/3>,
L<bindtextdomain(3)|bindtextdomain/3>, L<textdomain(3)|textdomain/3>. L<bindtextdomain(3)|bindtextdomain/3>, L<textdomain(3)|textdomain/3>.
Also, please refer to the official GNU gettext manual at Also, please refer to the official GNU gettext manual at
L<http://www.gnu.org/software/gettext/manual/>. L<https://www.gnu.org/software/gettext/manual/>.
=head1 AUTHOR =head1 AUTHOR
@ -208,7 +207,7 @@ imacat <imacat@mail.imacat.idv.tw>
=head1 COPYRIGHT =head1 COPYRIGHT
Copyright (c) 2003-2007 imacat. All rights reserved. This program is free Copyright (c) 2003-2021 imacat. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms software; you can redistribute it and/or modify it under the same terms
as Perl itself. as Perl itself.

2
t/11-command-line.t
View File

@ -14,7 +14,7 @@ BEGIN { plan tests => 10 }
use FindBin; use FindBin;
use File::Spec::Functions qw(catdir catfile updir); use File::Spec::Functions qw(catdir catfile updir);
use lib $FindBin::Bin; use lib $FindBin::Bin;
use vars qw($LOCALEDIR $r $maketext); our ($LOCALEDIR, $r, $maketext);
$LOCALEDIR = catdir($FindBin::Bin, "locale"); $LOCALEDIR = catdir($FindBin::Bin, "locale");
$maketext = catdir($FindBin::Bin, updir, "blib", "script", "maketext"); $maketext = catdir($FindBin::Bin, updir, "blib", "script", "maketext");

5
t/12-cache.t
View File

@ -1,6 +1,6 @@
#! /usr/bin/perl -w #! /usr/bin/perl -w
# Basic test suite # Basic test suite
# Copyright (c) 2019 imacat. All rights reserved. This program is free # Copyright (c) 2019-2021 imacat. All rights reserved. This program is free
# software; you can redistribute it and/or modify it under the same terms # software; you can redistribute it and/or modify it under the same terms
# as Perl itself. # as Perl itself.
@ -14,7 +14,7 @@ BEGIN { plan tests => 4 }
use FindBin; use FindBin;
use File::Spec::Functions qw(catdir catfile); use File::Spec::Functions qw(catdir catfile);
use lib $FindBin::Bin; use lib $FindBin::Bin;
use vars qw($LOCALEDIR $r); our ($LOCALEDIR, $r);
$LOCALEDIR = catdir($FindBin::Bin, "locale"); $LOCALEDIR = catdir($FindBin::Bin, "locale");
# bindtextdomain # bindtextdomain
@ -42,7 +42,6 @@ $r = eval {
$_->bindtextdomain("test-cache", $LOCALEDIR); $_->bindtextdomain("test-cache", $LOCALEDIR);
$_->textdomain("test-cache"); $_->textdomain("test-cache");
$_[0] = $_->maketext("Hello, world!"); $_[0] = $_->maketext("Hello, world!");
my %Lexicon = %{$_->{"Lexicon"}};
# Update the file but keep the size and mtime # Update the file but keep the size and mtime
open $FH, "+<$mo_file1" or die "$mo_file1: $!"; open $FH, "+<$mo_file1" or die "$mo_file1: $!";