1#! /bin/false
2
3# vim: set autoindent shiftwidth=4 tabstop=4:
4
5# High-level interface to Perl i18n.
6# Copyright (C) 2002-2017 Guido Flohr <guido.flohr@cantanea.com>,
7# all rights reserved.
8
9# This program is free software: you can redistribute it and/or modify
10# it under the terms of the GNU General Public License as published by
11# the Free Software Foundation; either version 3 of the License, or
12# (at your option) any later version.
13
14# This program is distributed in the hope that it will be useful,
15# but WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17# GNU General Public License for more details.
18
19# You should have received a copy of the GNU General Public License
20# along with this program.  If not, see <http://www.gnu.org/licenses/>.
21
22package __TiedTextDomain;
23
24use strict;
25
26sub TIEHASH
27{
28    my ($class, $function) = @_;
29    bless {
30        __function => $function,
31    }, $class;
32}
33
34sub FETCH
35{
36    my ($self, $msg) = @_;
37
38    &{$self->{__function}} ($msg);
39}
40
41sub FIRSTKEY
42{
43    my $self = shift;
44    my $reset_iterator = keys %$self;
45    return scalar each %$self;
46}
47
48sub NEXTKEY
49{
50    my $self = shift;
51    return scalar each %$self;
52}
53
54sub CLEAR {}
55sub STORE {}
56sub DELETE {}
57
581;
59
60package Locale::TextDomain;
61
62use strict;
63
64use Locale::Messages qw (textdomain bindtextdomain dgettext dngettext dpgettext dnpgettext);
65use Cwd qw (abs_path);
66
67use vars qw ($VERSION);
68
69$VERSION = '1.32';
70
71require Exporter;
72
73use vars qw (@ISA @EXPORT %__ $__);
74
75@ISA = ('Exporter');
76@EXPORT = qw (__ __x __n __nx __xn __p __px __np __npx $__ %__
77              N__ N__n N__p N__np);
78
79my %textdomains = ();
80my %bound_dirs = ();
81my @default_dirs = ();
82
83sub __ ($);
84
85sub __find_domain ($);
86sub __expand ($%);
87sub __tied_gettext ($$);
88
89BEGIN {
90    # Tie the hash to gettext().
91    tie %__, '__TiedTextDomain', \&__tied_gettext;
92    $__ = \%__;
93
94	# Add default search directories, but only if they exist.
95	for my $dir (qw (/usr/share/locale /usr/local/share/locale)) {
96        if (-d $dir) {
97            @default_dirs = ($dir);
98            last;
99        }
100    }
101}
102
103# Class methods.
104sub keywords {
105    join ' ', (
106        '--keyword=__',
107        '--keyword=%__',
108        '--keyword=$__',
109        '--keyword=__x',
110        '--keyword=__n:1,2',
111        '--keyword=__nx:1,2',
112        '--keyword=__xn:1,2',
113        '--keyword=__p:1c,2',
114        '--keyword=__px:1c,2',
115        '--keyword=__np:1c,2,3',
116        '--keyword=__npx:1c,2,3',
117        '--keyword=N__',
118        '--keyword=N__n:1,2',
119        '--keyword=N__p:1c,2',
120        '--keyword=N__np:1c,2,3',
121    );
122}
123
124sub flags {
125    join ' ', (
126        '--flag=__:1:pass-perl-format',
127        '--flag=%__:1:pass-perl-format',
128        '--flag=$__:1:pass-perl-format',
129        '--flag=__x:1:perl-brace-format',
130        '--flag=__x:1:pass-perl-format',
131        '--flag=__n:1:pass-perl-format',
132        '--flag=__n:2:pass-perl-format',
133        '--flag=__nx:1:perl-brace-format',
134        '--flag=__nx:1:pass-perl-format',
135        '--flag=__nx:2:perl-brace-format',
136        '--flag=__nx:2:pass-perl-format',
137        '--flag=__xn:1:perl-brace-format',
138        '--flag=__xn:1:pass-perl-format',
139        '--flag=__xn:2:perl-brace-format',
140        '--flag=__xn:2:pass-perl-format',
141        '--flag=__p:2:pass-perl-format',
142        '--flag=__px:2:perl-brace-format',
143        '--flag=__px:2:pass-perl-format',
144        '--flag=__np:2:pass-perl-format',
145        '--flag=__np:3:pass-perl-format',
146        '--flag=__npx:2:perl-brace-format',
147        '--flag=__npx:2:pass-perl-format',
148        '--flag=__npx:3:perl-brace-format',
149        '--flag=__npx:3:pass-perl-format',
150        '--flag=N__:1:pass-perl-format',
151        '--flag=N__n:1:pass-perl-format',
152        '--flag=N__n:2:pass-perl-format',
153        '--flag=N__p:2:pass-perl-format',
154        '--flag=N__np:2:pass-perl-format',
155        '--flag=N__np:3:pass-perl-format',
156    );
157}
158
159sub options {
160    my ($class) = @_;
161
162    join ' ', $class->keywords, $class->flags;
163}
164
165# Normal gettext.
166sub __ ($)
167{
168    my $msgid = shift;
169
170    my $package = caller;
171
172    my $textdomain = $textdomains{$package};
173
174    __find_domain $textdomain if
175		defined $textdomain && defined $bound_dirs{$textdomain};
176
177    return dgettext $textdomain => $msgid;
178}
179
180# Called from tied hash.
181sub __tied_gettext ($$)
182{
183    my ($msgid) = @_;
184
185    my ($package) = caller (1);
186
187    my $textdomain = $textdomains{$package};
188    unless (defined $textdomain) {
189		my ($maybe_package, $filename, $line) = caller (2);
190		if (exists $textdomains{$maybe_package}) {
191			warn <<EOF;
192Probable use of \$__ or \%__ where __() should be used at $filename:$line.
193EOF
194		}
195	}
196    __find_domain $textdomain if
197		defined $textdomain && defined $bound_dirs{$textdomain};
198
199    return dgettext $textdomain => $msgid;
200}
201
202# With interpolation.
203sub __x ($@)
204{
205    my ($msgid, %vars) = @_;
206
207    my $package = caller;
208
209    my $textdomain = $textdomains{$package};
210
211    __find_domain $textdomain if
212		defined $textdomain && defined $bound_dirs{$textdomain};
213
214    return __expand ((dgettext $textdomain => $msgid), %vars);
215}
216
217# Plural.
218sub __n ($$$)
219{
220    my ($msgid, $msgid_plural, $count) = @_;
221
222    my $package = caller;
223
224    my $textdomain = $textdomains{$package};
225
226    __find_domain $textdomain if
227		defined $textdomain && defined $bound_dirs{$textdomain};
228
229    return dngettext $textdomain, $msgid, $msgid_plural, $count;
230}
231
232# Plural with interpolation.
233sub __nx ($$$@)
234{
235    my ($msgid, $msgid_plural, $count, %args) = @_;
236
237    my $package = caller;
238
239    my $textdomain = $textdomains{$package};
240
241    __find_domain $textdomain if
242		defined $textdomain && defined $bound_dirs{$textdomain};
243
244    return __expand ((dngettext $textdomain, $msgid, $msgid_plural, $count),
245					 %args);
246}
247
248# Plural with interpolation.
249sub __xn ($$$@)
250{
251    my ($msgid, $msgid_plural, $count, %args) = @_;
252
253    my $package = caller;
254
255    my $textdomain = $textdomains{$package};
256
257    __find_domain $textdomain if
258		defined $textdomain && defined $bound_dirs{$textdomain};
259
260    return __expand ((dngettext $textdomain, $msgid, $msgid_plural, $count),
261					 %args);
262}
263
264# Context. (p is for particular or special)
265sub __p ($$)
266{
267    my $msgctxt = shift;
268    my $msgid = shift;
269
270    my $package = caller;
271
272    my $textdomain = $textdomains{$package};
273
274    __find_domain $textdomain if
275		defined $textdomain && defined $bound_dirs{$textdomain};
276
277    return dpgettext $textdomain => $msgctxt, $msgid;
278}
279
280# With interpolation.
281sub __px ($$@)
282{
283    my ($msgctxt, $msgid, %vars) = @_;
284
285    my $package = caller;
286
287    my $textdomain = $textdomains{$package};
288
289    __find_domain $textdomain if
290		defined $textdomain && defined $bound_dirs{$textdomain};
291
292    return __expand ((dpgettext $textdomain => $msgctxt, $msgid), %vars);
293}
294
295# Context + Plural.
296sub __np ($$$$)
297{
298    my ($msgctxt, $msgid, $msgid_plural, $count) = @_;
299
300    my $package = caller;
301
302    my $textdomain = $textdomains{$package};
303
304    __find_domain $textdomain if
305		defined $textdomain && defined $bound_dirs{$textdomain};
306
307    return dnpgettext $textdomain, $msgctxt, $msgid, $msgid_plural, $count;
308}
309
310# Plural with interpolation.
311sub __npx ($$$$@)
312{
313    my ($msgctxt, $msgid, $msgid_plural, $count, %args) = @_;
314
315    my $package = caller;
316
317    my $textdomain = $textdomains{$package};
318
319    __find_domain $textdomain if
320		defined $textdomain && defined $bound_dirs{$textdomain};
321
322    return __expand ((dnpgettext $textdomain, $msgctxt, $msgid, $msgid_plural, $count),
323					 %args);
324}
325
326# Dummy functions for string marking.
327sub N__($)
328{
329    return shift;
330}
331
332sub N__n($$$)
333{
334    return @_;
335}
336
337sub N__p($$) {
338    return @_;
339}
340
341sub N__np($$$$) {
342    return @_;
343}
344
345sub import
346{
347    my ($self, $textdomain, @search_dirs) = @_;
348
349    # Check our caller.
350    my $package = caller;
351    return if exists $textdomains{$package};
352
353    # Was a textdomain specified?
354	$textdomain = textdomain unless defined $textdomain && length $textdomain;
355
356    # Remember the textdomain of that package.
357    $textdomains{$package} = $textdomain;
358
359    # Remember that we still have to bind that textdomain to
360    # a directory.
361    unless (exists $bound_dirs{$textdomain}) {
362		unless (@search_dirs) {
363			@search_dirs = ((map $_ . '/LocaleData', @INC), @default_dirs)
364				unless @search_dirs;
365			if (my $share = eval {
366				require File::ShareDir;
367				File::ShareDir::dist_dir ($textdomain);
368			}) {
369				unshift @search_dirs,
370                        map { "$share/$_" }
371                        qw (locale LocaleData);
372            }
373		}
374		$bound_dirs{$textdomain} = [grep { -d $_ } @search_dirs];
375    }
376
377    Locale::TextDomain->export_to_level (1, $package, @EXPORT);
378
379    return;
380}
381
382# Private functions.
383sub __find_domain ($)
384{
385	my $domain = shift;
386
387	my $try_dirs = $bound_dirs{$domain};
388
389	if (defined $try_dirs) {
390		my $found_dir = '';
391
392		TRYDIR: foreach my $dir (grep { -d $_ } @$try_dirs) {
393			# Is there a message catalog?  We have to search recursively
394			# for it.  Since globbing is reported to be buggy under
395			# MS-DOS, we roll our own version.
396			local *DIR;
397			if (opendir DIR, $dir) {
398				my @files = map { "$dir/$_/LC_MESSAGES/$domain.mo" }
399					grep { ! /^\.\.?$/ } readdir DIR;
400
401				foreach my $file (@files) {
402					if (-f $file || -l $file) {
403						# If we find a non-readable file on our way,
404						# we access has been disabled on purpose.
405						# Therefore no -r check here.
406						$found_dir = $dir;
407						last TRYDIR;
408					}
409				}
410			}
411		}
412
413		# If there was no success, this will fall back to the default search
414		# directories.
415		bindtextdomain $domain => abs_path $found_dir;
416    }
417
418    # The search has completed.
419    undef $bound_dirs{$domain};
420
421    return 1;
422}
423
424sub __expand ($%)
425{
426    my ($translation, %args) = @_;
427
428    my $re = join '|', map { quotemeta $_ } keys %args;
429    $translation =~ s/\{($re)\}/defined $args{$1} ? $args{$1} : "{$1}"/ge;
430
431    return $translation;
432}
433
4341;
435
436__END__
437
438=head1 NAME
439
440Locale::TextDomain - Perl Interface to Uniforum Message Translation
441
442=head1 SYNOPSIS
443
444 use Locale::TextDomain ('my-package', @locale_dirs);
445
446 use Locale::TextDomain qw (my-package);
447
448 my $translated = __"Hello World!\n";
449
450 my $alt = $__{"Hello World!\n"};
451
452 my $alt2 = $__->{"Hello World!\n"};
453
454 my @list = (N__"Hello",
455             N__"World");
456
457 printf (__n ("one file read",
458              "%d files read",
459              $num_files),
460         $num_files);
461
462 print __nx ("one file read", "{num} files read", $num_files,
463             num => $num_files);
464
465 my $translated_context = __p ("Verb, to view", "View");
466
467 printf (__np ("Files read from filesystems",
468               "one file read",
469               "%d files read",
470               $num_files),
471         $num_files);
472
473 print __npx ("Files read from filesystems",
474              "one file read",
475              "{num} files read",
476              $num_files,
477              num => $num_files);
478
479
480=head1 DESCRIPTION
481
482The module Locale::TextDomain(3pm) provides a high-level interface
483to Perl message translation.
484
485=head2 Textdomains
486
487When you request a translation for a given string, the system used
488in libintl-perl follows a standard strategy to find a suitable message
489catalog containing the translation: Unless you explicitely define
490a name for the message catalog, libintl-perl will assume that your
491catalog is called 'messages' (unless you have changed the default
492value to something else via Locale::Messages(3pm), method textdomain()).
493
494You might think that his default strategy leaves room for optimization
495and you are right.  It would be a lot smarter if multiple software
496packages, all with their individual message catalogs, could be installed
497on one system, and it should also be possible that third-party
498components of your software (like Perl modules) can load their
499message catalogs, too, without interfering with yours.
500
501The solution is clear, you have to assign a unique name to your message
502database, and you have to specify that name at run-time.  That unique
503name is the so-called I<textdomain> of your software package.  The name is
504actually arbitrary but you should follow these best-practice guidelines
505to ensure maximum interoperability:
506
507=over 8
508
509=item File System Safety
510
511In practice, textdomains get mapped into file names, and you should
512therefore make sure that the textdomain you choose is a valid filename
513on every system that will run your software.
514
515=item Case-sensitivity
516
517Textdomains are always case-sensitive (i. e. 'Package' and 'PACKAGE'
518are not the same).  However, since the message catalogs will be stored
519on file systems, that may or may not distinguish case when looking
520up file names, you should avoid potential conflicts here.
521
522=item Textdomain Should Match CPAN Name
523
524If your software is listed as a module on CPAN, you should simply
525choose the name on CPAN as your textdomain.  The textdomain for
526libintl-perl is hence 'libintl-perl'.  But please replace all
527periods ('.') in your package name with an underscore because ...
528
529=item Internet Domain Names as a Fallback
530
531... if your software is I<not> a module listed on CPAN, as a last
532resort you should use the Java(tm) package scheme, i. e. choose
533an internet domain that you are owner of (or ask the owner of an
534internet domain) and concatenate your preferred textdomain with the
535reversed internet domain.  Example: Your company runs the web-site
536'www.foobar.org' and is the owner of the domain 'foobar.org'.  The
537textdomain for your company's software 'barfoos' should hence be
538'org.foobar.barfoos'.
539
540=back
541
542If your software is likely to be installed in different versions on
543the same system, it is probably a good idea to append some version
544information to your textdomain.
545
546Other systems are less strict with the naming scheme for textdomains
547but the phenomena known as Perl is actually a plethora of small,
548specialized modules and it is probably wisest to postulate some
549namespace model in order to avoid chaos.
550
551=head2 Binding textdomains to directories
552
553Once the system knows the I<textdomain> of the message that you
554want to get translated into the user's language, it still has to
555find the correct message catalog.  By default, libintl-perl will
556look up the string in the translation database found in the
557directories F</usr/share/locale> and F</usr/local/share/locale>
558(in that order).
559
560It is neither guaranteed that these directories exist on the target
561machine, nor can you be sure that the installation routine has write
562access to these locations.  You can therefore instruct libintl-perl
563to search other directories prior to the default directories.  Specifying
564a differnt search directory is called I<binding> a textdomain to a
565directory.
566
567Beginning with version 1.20, B<Locale::TextDomain> extends the default
568strategy by a Perl-specific approach.  If L<File::ShareDir> is installed, it
569will look in the subdirectories named F<locale> and F<LocaleData> (in that
570order) in the directory returned by C<File::ShareDir::dist_dir ($textdomain)>
571(if L<File::ShareDir> is installed),
572and check for a database containing the message for your textdomain there.
573This allows you to install your database in the Perl-specific shared directory
574using L<Module::Install>'s C<install_share> directive or the Dist::Zilla
575L<ShareDir plugin|Dist::Zilla::Plugin::ShareDir>.
576
577If L<File::ShareDir> is not availabe, or if Locale::TextDomain fails to find
578the translation files in the L<File::ShareDir> directory, it will next look in
579every directory found in the standard include path C<@INC>, and check for a
580database containing the message for your textdomain there. Example: If the
581path F</usr/lib/perl/5.8.0/site_perl> is in your C<@INC>, you can install your
582translation files in F</usr/lib/perl/5.8.0/site_perl/LocaleData>, and they
583will be found at run-time.
584
585=head1 USAGE
586
587It is crucial to remember that you use Locale::TextDomain(3) as
588specified in the section L</SYNOPSIS>, that means you have to
589B<use> it, not B<require> it.  The module behaves quite differently
590compared to other modules.
591
592The most significant difference is the meaning of the list passed
593as an argument to the use() function.  It actually works like this:
594
595    use Locale::TextDomain (TEXTDOMAIN, DIRECTORY, ...)
596
597The first argument (the first string passed to use()) is the textdomain
598of your package, optionally followed by a list of directories to search
599I<instead> of the Perl-specific directories (see above: F</LocaleData>
600appended to a F<File::ShareDir> directory and every path in C<@INC>).
601
602If you are the author of a package 'barfoos', you will probably put
603the line
604
605    use Locale::TextDomain 'barfoos';
606
607resp. for non-CPAN modules
608
609    use Locale::TextDomain 'org.foobar.barfoos';
610
611in every module of your package that contains translatable strings. If
612your module has been installed properly, including the message catalogs,
613it will then be able to retrieve these translations at run-time.
614
615If you have not installed the translation database in a directory
616F<LocaleData> in the L<File::ShareDir> directory or the standard include
617path C<@INC> (or in the system directories F</usr/share/locale> resp.
618F</usr/local/share/locale>), you have to explicitely specify a search
619path by giving the names of directories (as strings!) as additional
620arguments to use():
621
622    use Locale::TextDomain qw (barfoos ./dir1 ./dir2);
623
624Alternatively you can call the function bindtextdomain() with suitable
625arguments (see the entry for bindtextdomain() in
626L<Locale::Messages/FUNCTIONS>).  If you do so, you should pass
627C<undef> as an additional argument in order to avoid unnecessary
628lookups:
629
630    use Locale::TextDomain ('barfoos', undef);
631
632You see that the arguments given to use() have nothing to do with
633what is imported into your namespace, but they are rather arguments
634to textdomain(), resp. bindtextdomain().  Does that mean that
635B<Locale::TextDomain> exports nothing into your namespace? Umh, not
636exactly ... in fact it imports I<all> functions listed below into
637your namespace, and hence you should not define conflicting functions
638(and variables) yourself.
639
640So, why has Locale::TextDomain to be different from other modules?
641If you have ever written software in C and prepared it for
642internationalization (i18n), you will probably have defined some
643preprocessor macros like:
644
645    #define _(String) dgettext ("my-textdomain", String)
646    #define N_(String) String
647
648You only have to define that once in C, and the textdomain for your
649package is automatically inserted into all gettext functions.  In
650Perl there is no such mechanism (at least it is not portable,
651option -P) and using the gettext functions could become quite
652cumbersome without some extra fiddling:
653
654    print dgettext ("my-textdomain", "Hello world!\n");
655
656This is no fun.  In C it would merely be a
657
658    printf (_("Hello world!\n"));
659
660Perl has to be more concise and shorter than C ... see the next
661section for how you can use B<Locale::TextDomain> to end up in Perl
662with a mere
663
664    print __"Hello World!\n";
665
666=head1 EXPORTED FUNCTIONS
667
668All functions have quite funny names on purpose.  In fact the
669purpose for that is quite clear: They should be short, operator-like,
670and they should not yell for conflicts with existing functions in
671I<your> namespace.  You will understand it, when you internationalize
672your first Perl program or module.  Preparing it is more like marking
673strings as being translatable than inserting function calls.  Here
674we go:
675
676=over 4
677
678=item B<__ MSGID>
679
680B<NOTE:> This is a I<double> underscore!
681
682The basic and most-used function.  It is a short-cut for a call
683to gettext() resp. dgettext(), and simply returns the translation for
684B<MSGID>.  If your old code reads like this:
685
686    print "permission denied";
687
688You will now write:
689
690    print __"permission denied";
691
692That's all, the string will be output in the user's preferred language,
693provided that you have installed a translation for it.
694
695Of course you can also use parentheses:
696
697    print __("permission denied");
698
699Or even:
700
701    print (__("permission denied"));
702
703In my eyes, the first version without parentheses looks best.
704
705=item B<__x MSGID, ID1 =E<gt> VAL1, ID2 =E<gt> VAL2, ...>
706
707One of the nicest features in Perl is its capability to interpolate
708variables into strings:
709
710    print "This is the $color $thing.\n";
711
712This nice feature might con you into thinking that you could now
713write
714
715    print __"This is the $color $thing.\n";
716
717Alas, that would be nice, but it is not possible.  Remember that the
718function __() serves both as an operator for translating strings
719I<and> as a mark for translatable strings.  If the above string would
720get extracted from your Perl code, the un-interpolated form would
721end up in the message catalog because when parsing your code it
722is unpredictable what values the variables C<$thing> and C<$color>
723will have at run-time (this fact is most probably one of the reasons
724you have written your program for).
725
726However, at run-time, Perl will have interpolated the values already
727I<before> __() (resp. the underlying gettext() function) has seen the
728original string.  Consequently something like "This is the red car.\n"
729will be looked up in the message catalog, it will not be found (because
730only "This is the $color $thing.\n" is included in the database),
731and the original, untranslated string will be returned.
732Honestly, because this is almost always an error, the xgettext(1)
733program will bail out with a fatal error when it comes across that
734string in your code.
735
736There are two workarounds for that:
737
738    printf __"This is the %s %s.\n", $color, $thing;
739
740But that has several disadvantages: Your translator will only
741see the isolated string, and without the surrounding code it
742is almost impossible to interpret it correctly.  Of course, GNU
743emacs and other software capable of editing PO translation files
744will allow you to examine the context in the source code, but it
745is more likely that your translator will look for a less challenging
746translation project when she frequently comes across such messages.
747
748And even if she does understand the underlying programming, what
749if she has to reorder the color and the thing like in French:
750
751    msgid "This is the red car.\n";
752    msgstr "Cela est la voiture rouge.\n"
753
754Zut alors! While it is possible to reorder the arguments to printf()
755and friends, it requires a syntax that is is nothing that you want to
756learn.
757
758So what? The Perl backend to GNU gettext has defined an alternative
759format for interpolatable strings:
760
761    "This is the {color} {thing}.\n";
762
763Instead of Perl variables you use place-holders (legal Perl variables
764are also legal place-holders) in curly braces, and then you call
765
766    print __x ("This is the {color} {thing}.\n",
767               thing => $thang,
768               color => $color);
769
770The function __x() will take the additional hash and replace all
771occurencies of the hash keys in curly braces with the corresponding
772values.  Simple, readable, understandable to translators, what else
773would you want?  And if the translator forgets, misspells or otherwise
774messes up some "variables", the msgfmt(1) program, that is used to
775compile the textual translation file into its binary representation
776will even choke on these errors and refuse to compile the translation.
777
778=item B<__n MSGID, MSGID_PLURAL, COUNT>
779
780Whew! That looks complicated ... It is best explained with an example.
781We'll have another look at your vintage code:
782
783    if ($files_deleted > 1) {
784        print "All files have been deleted.\n";
785    } else {
786        print "One file has been deleted.\n";
787    }
788
789Your intent is clear, you wanted to avoid the cumbersome
790"1 files deleted".  This is okay for English, but other languages
791have more than one plural form.  For example in Russian it makes
792a difference whether you want to say 1 file, 3 files or 6 files.
793You will use three different forms of the noun 'file' in each
794case.  [Note: Yep, very smart you are, the Russian word for 'file'
795is in fact the English word, and it is an invariable noun, but if you
796know that, you will also understand the rest despite this little
797simplification ...].
798
799That is the reason for the existance of the function ngettext(),
800that __n() is a short-cut for:
801
802    print __n"One file has been deleted.\n",
803             "All files have been deleted.\n",
804             $files_deleted;
805
806Alternatively:
807
808    print __n ("One file has been deleted.\n",
809               "All files have been deleted.\n",
810               $files_deleted);
811
812The effect is always the same: libintl-perl will find out which
813plural form to pick for your user's language, and the output string
814will always look okay.
815
816=item B<__nx MSGID, MSGID_PLURAL, COUNT, VAR1 =E<gt> VAL1, VAR2 =E<gt> VAL2, ...>
817
818Bringing it all together:
819
820    print __nx ("One file has been deleted.\n",
821                "{count} files have been deleted.\n",
822                $num_files,
823                count => $num_files);
824
825The function __nx() picks the correct plural form (also for English!)
826I<and> it is capable of interpolating variables into strings.
827
828Have a close look at the order of arguments: The first argument is the
829string in the singular, the second one is the plural string. The third
830one is an integer indicating the number of items.  This third argument
831is I<only> used to pick the correct translation.  The optionally
832following arguments make up the hash used for interpolation.  In the
833beginning it is often a little confusing that the variable holding the
834number of items will usually be repeated somewhere in the interpolation
835hash.
836
837=item B<__xn MSGID, MSGID_PLURAL, COUNT, VAR1 =E<gt> VAL1, VAR2 =E<gt> VAL2, ...>
838
839Does exactly the same thing as __nx().  In fact it is a common typo
840promoted to a feature.
841
842=item B<__p MSGCTXT, MSGID>
843
844This is much like __. The "p" stands for "particular", and the MSGCTXT
845is used to provide context to the translator. This may be neccessary
846when your string is short, and could stand for multiple things. For example:
847
848    print __p"Verb, to view", "View";
849    print __p"Noun, a view", "View";
850
851The above may be "View" entries in a menu, where View->Source and File->View
852are different forms of "View", and likely need to be translated differently.
853
854A typical usage are GUI programs.  Imagine a program with a main
855menu and the notorious "Open" entry in the "File" menu.  Now imagine,
856there is another menu entry Preferences->Advanced->Policy where you have
857a choice between the alternatives "Open" and "Closed".  In English, "Open"
858is the adequate text at both places.  In other languages, it is very
859likely that you need two different translations.  Therefore, you would
860now write:
861
862    __p"File|", "Open";
863    __p"Preferences|Advanced|Policy", "Open";
864
865In English, or if no translation can be found, the second argument
866(MSGID) is returned.
867
868This function was introduced in libintl-perl 1.17.
869
870=item B<__px MSGCTXT, MSGID, VAR1 =E<gt> VAL1, VAR2 =E<gt> VAL2, ...>
871
872Like __p(), but supports variable substitution in the string, like __x().
873
874    print __px("Verb, to view", "View {file}", file => $filename);
875
876See __p() and __x() for more details.
877
878This function was introduced in libintl-perl 1.17.
879
880=item B<__np MSGCTXT, MSGID, MSGID_PLURAL, COUNT>
881
882This adds context to plural calls. It should not be needed very often,
883if at all, due to the __nx() function. The type of variable substitution
884used in other gettext libraries (using sprintf-like sybols, like %s or %1)
885sometimes required context. For a (bad) example of this:
886
887    printf (__np("[count] files have been deleted",
888                "One file has been deleted.\n",
889                "%s files have been deleted.\n",
890                $num_files),
891            $num_files);
892
893NOTE: The above usage is discouraged. Just use the __nx() call, which
894provides inline context via the key names.
895
896This function was introduced in libintl-perl 1.17.
897
898=item B<__npx MSGCTXT, MSGID, MSGID_PLURAL, COUNT, VAR1 =E<gt> VAL1, VAR2 =E<gt> VAL2, ...>
899
900This is provided for comleteness. It adds the variable interpolation
901into the string to the previous method, __np().
902
903It's usage would be like so:
904
905    print __npx ("Files being permenantly removed",
906                 "One file has been deleted.\n",
907                 "{count} files have been deleted.\n",
908                 $num_files,
909                 count => $num_files);
910
911I cannot think of any situations requiring this, but we can easily
912support it, so here it is.
913
914This function was introduced in libintl-perl 1.17.
915
916=item B<N__(ARG1)>
917
918A no-op function that simply echoes its arguments to the caller.  Take
919the following piece of Perl:
920
921    my @options = (
922        "Open",
923        "Save",
924        "Save As",
925    );
926
927    ...
928
929    my $option = $options[1];
930
931Now say that you want to have this translatable.  You could sometimes
932simply do:
933
934    my @options = (
935        __"Open",
936        __"Save",
937        __"Save As",
938    );
939
940    ...
941
942    my $option = $options[1];
943
944But often times this will not be what you want, for example when you
945also need the unmodified original string.  Sometimes it may not even
946work, for example, when the preferred user language is not yet
947determined at the time that the list is initialized.
948
949In these cases you would write:
950
951    my @options = (
952        N__"Open",
953        N__"Save",
954        N__"Save As",
955    );
956
957    ...
958
959    my $option = __($options[1]);
960    # or: my $option = dgettext ('my-domain', $options[1]);
961
962Now all the strings in C<@options> will be left alone, since N__()
963returns its arguments (one ore more) unmodified.  Nevertheless, the
964string extractor will be able to recognize the strings as being
965translatable.  And you can still get the translation later by passing
966the variable instead of the string to one of the above translation
967functions.
968
969=item B<N__n (MSGID, MSGID_PLURAL, COUNT)>
970
971Does exactly the same as N__().  You will use this form if you have
972to mark the strings as having plural forms.
973
974=item B<N__p (MSGCTXT, MSGID)>
975
976Marks B<MSGID> as N__() does, but in the context B<MSGCTXT>.
977
978=item B<N__np (MSGCTXT, MSGID, MSGID_PLURAL, COUNT)>
979
980Marks B<MSGID> as N__n() does, but in the context B<MSGCTXT>.
981=back
982
983=head1 EXPORTED VARIABLES
984
985The module exports several variables into your namespace:
986
987=over 4
988
989=item B<%__>
990
991A tied hash.  Its keys are your original messages, the values are
992their translations:
993
994    my $title = "<h1>$__{'My Homepage'}</h1>";
995
996This is much better for your translation team than
997
998    my $title = __"<h1>My Homepage</h1>";
999
1000In the second case the HTML code will make it into the translation
1001database and your translators have to be aware of HTML syntax when
1002translating strings.
1003
1004B<Warning:> Do I<not> use this hash outside of double-quoted strings!
1005The code in the tied hash object relies on the correct working of
1006the function caller() (see "perldoc -f caller"), and this function
1007will report incorrect results if the tied hash value is the argument
1008to a function from another package, for example:
1009
1010  my $result = Other::Package::do_it ($__{'Some string'});
1011
1012The tied hash code will see "Other::Package" as the calling package,
1013instead of your own package.  Consequently it will look up the message
1014in the wrong text domain.  There is no workaround for this bug.
1015Therefore:
1016
1017Never use the tied hash interpolated strings!
1018
1019=item B<$__>
1020
1021A reference to C<%__>, in case you prefer:
1022
1023     my $title = "<h1>$__->{'My Homepage'}</h1>";
1024
1025=back
1026
1027=head1 CLASS METHODS
1028
1029The following class methods are defined:
1030
1031=over 4
1032
1033=item B<options>
1034
1035Returns a space-separated list of all '--keyword' and all '--flag' options
1036for B<xgettext(1)>, when extracing strings from Perl source files localized
1037with B<Locale::TextDomain>.
1038
1039The option should rather be called B<xgettextDefaultOptions>.  With regard
1040to the typical use-case, a shorter name has been picked:
1041
1042    xgettext `perl -MLocale::TextDomain -e 'print Locale::TextDomain->options'`
1043
1044See L<https://www.gnu.org/software/gettext/manual/html_node/xgettext-Invocation.html>
1045for more information about the xgettext options '--keyword' and '--flag'.
1046
1047If you want to disable the use of the xgettext default keywords, you
1048should pass an option '--keyword=""' to xgettext before the options returned
1049by this method.
1050
1051If you doubt the usefulness of this method, check the output on the
1052command-line:
1053
1054    perl -MLocale::TextDomain -e 'print Locale::TextDomain->options'
1055
1056Nothing that you want to type yourself.
1057
1058This method was added in libintl-perl 1.28.
1059
1060=item B<keywords>
1061
1062Returns a space-separated list of all '--keyword' options for B<xgettext(1)>
1063so that all translatable strings are properly extracted.
1064
1065This method was added in libintl-perl 1.28.
1066
1067=item B<flags>
1068
1069Returns a space-separated list of all '--flag' options for B<xgettext(1)>
1070so that extracted strings are properly flagged.
1071
1072This method was added in libintl-perl 1.28.
1073
1074=back
1075
1076=head1 PERFORMANCE
1077
1078Message translation can be a time-consuming task.  Take this little
1079example:
1080
1081    1: use Locale::TextDomain ('my-domain');
1082    2: use POSIX (:locale_h);
1083    3:
1084    4: setlocale (LC_ALL, '');
1085    5: print __"Hello world!\n";
1086
1087This will usually be quite fast, but in pathological cases it may
1088run for several seconds.  A worst-case scenario would be a
1089Chinese user at a terminal that understands the codeset Big5-HKSCS.
1090Your translator for Chinese has however chosen to encode the translations
1091in the codeset EUC-TW.
1092
1093What will happen at run-time?  First, the library will search and load a
1094(maybe large) message catalog for your textdomain 'my-domain'.  Then
1095it will look up the translation for "Hello world!\n", it will find that
1096it is encoded in EUC-TW.  Since that differs from the output codeset
1097Big5-HKSCS, it will first load a conversion table containing several
1098ten-thousands of codepoints for EUC-TW, then it does the same with
1099the smaller, but still very large conversion table for Big5-HKSCS,
1100it will convert the translation on the fly from EUC-TW into Big5-HKSCS,
1101and finally it will return the converted translation.
1102
1103A worst-case scenario but realistic.  And for these five lines of codes,
1104there is not much you can do to make it any faster.  You should understand,
1105however, I<when> the different steps will take place, so that you can
1106arrange your code for it.
1107
1108You have learned in the section L</DESCRIPTION> that line 1 is
1109responsible for locating your message database.  However, the
1110use() will do nothing more than remembering your settings.  It will
1111not search any directories, it will not load any catalogs or
1112conversion tables.
1113
1114Somewhere in your code you will always have a call to
1115POSIX::setlocale(), and the performance of this call may be time-consuming,
1116depending on the architecture of your system.  On some systems, this
1117will consume very little time, on others it will only consume a
1118considerable amount of time for the first call, and on others it may
1119always be time-consuming.  Since you cannot know, how setlocale() is
1120implemented on the target system, you should reduce the calls to
1121setlocale() to a minimum.
1122
1123Line 5 requests the translation for your string.  Only now, the library
1124will actually load the message catalog, and only now will it load
1125eventually needed conversion tables.  And from now on, all this information
1126will be cached in memory.  This strategy is used throughout libintl-perl,
1127and you may describe it as 'load-on-first-access'.  Getting the next
1128translation will consume very little resources.
1129
1130However, although the translation retrieval is somewhat obfuscated
1131by an operator-like function call, it is still a function call, and in
1132fact it even involves a chain of function calls.  Consequently, the
1133following example is probably bad practice:
1134
1135    foreach (1 .. 100_000) {
1136        print __"Hello world!\n";
1137    }
1138
1139This example introduces a lot of overhead into your program.  Better
1140do this:
1141
1142    my $string = __"Hello world!\n";
1143    foreach (1 .. 100_000) {
1144        print $string;
1145    }
1146
1147The translation will never change, there is no need to retrieve it
1148over and over again.  Although libintl-perl will of course cache
1149the translation read from the file system, you can still avoid the
1150overhead for the function calls.
1151
1152=head1 AUTHOR
1153
1154Copyright (C) 2002-2017 L<Guido Flohr|http://www.guido-flohr.net/>
1155(L<mailto:guido.flohr@cantanea.com>), all rights reserved.  See the source
1156code for details!code for details!
1157
1158=head1 SEE ALSO
1159
1160Locale::Messages(3pm), Locale::gettext_pp(3pm), perl(1),
1161gettext(1), gettext(3)
1162
1163=cut
1164Local Variables:
1165mode: perl
1166perl-indent-level: 4
1167perl-continued-statement-offset: 4
1168perl-continued-brace-offset: 0
1169perl-brace-offset: -4
1170perl-brace-imaginary-offset: 0
1171perl-label-offset: -4
1172cperl-indent-level: 4
1173cperl-continued-statement-offset: 2
1174tab-width: 4
1175End:
1176=cut
1177