Gettext.pm 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194
  1. # Copied from /usr/share/perl5/Debconf/Gettext.pm
  2. #
  3. # Copyright © 2000 Joey Hess <joeyh@debian.org>
  4. # Copyright © 2007, 2009-2010, 2012-2015 Guillem Jover <guillem@debian.org>
  5. #
  6. # Redistribution and use in source and binary forms, with or without
  7. # modification, are permitted provided that the following conditions
  8. # are met:
  9. # 1. Redistributions of source code must retain the above copyright
  10. # notice, this list of conditions and the following disclaimer.
  11. # 2. Redistributions in binary form must reproduce the above copyright
  12. # notice, this list of conditions and the following disclaimer in the
  13. # documentation and/or other materials provided with the distribution.
  14. #
  15. # THIS SOFTWARE IS PROVIDED BY AUTHORS AND CONTRIBUTORS ``AS IS'' AND
  16. # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  17. # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  18. # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
  19. # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  20. # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  21. # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  22. # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  23. # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  24. # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  25. # SUCH DAMAGE.
  26. package Dpkg::Gettext;
  27. use strict;
  28. use warnings;
  29. our $VERSION = '1.02';
  30. our @EXPORT = qw(
  31. textdomain
  32. ngettext
  33. g_
  34. P_
  35. N_
  36. _g
  37. );
  38. use Exporter qw(import);
  39. =encoding utf8
  40. =head1 NAME
  41. Dpkg::Gettext - convenience wrapper around Locale::gettext
  42. =head1 DESCRIPTION
  43. The Dpkg::Gettext module is a convenience wrapper over the Locale::gettext
  44. module, to guarantee we always have working gettext functions, and to add
  45. some commonly used aliases.
  46. =head1 VARIABLES
  47. =over 4
  48. =item $Dpkg::Gettext::DEFAULT_TEXT_DOMAIN
  49. Specifies the default text domain name to be used with the short function
  50. aliases. This is intended to be used by the Dpkg modules, so that they
  51. can produce localized messages even when the calling program has set the
  52. current domain with textdomain(). If you would like to use the aliases
  53. for your own modules, you might want to set this variable to undef, or
  54. to another domain, but then the Dpkg modules will not produce localized
  55. messages.
  56. =back
  57. =cut
  58. our $DEFAULT_TEXT_DOMAIN = 'dpkg-dev';
  59. =head1 FUNCTIONS
  60. =over 4
  61. =item $trans = g_($msgid)
  62. Calls dgettext() on the $msgid and returns its translation for the current
  63. locale. If dgettext() is not available, simply returns $msgid.
  64. =item $trans = C_($msgctxt, $msgid)
  65. Calls dgettext() on the $msgid and returns its translation for the specific
  66. $msgctxt supplied. If dgettext() is not available, simply returns $msgid.
  67. =item $trans = P_($msgid, $msgid_plural, $n)
  68. Calls dngettext(), returning the correct translation for the plural form
  69. dependent on $n. If dngettext() is not available, returns $msgid if $n is 1
  70. or $msgid_plural otherwise.
  71. =cut
  72. use constant GETTEXT_CONTEXT_GLUE => "\004";
  73. BEGIN {
  74. eval q{
  75. pop @INC if $INC[-1] eq '.';
  76. use Locale::gettext;
  77. };
  78. if ($@) {
  79. eval q{
  80. sub g_ {
  81. return shift;
  82. }
  83. sub textdomain {
  84. }
  85. sub ngettext {
  86. my ($msgid, $msgid_plural, $n) = @_;
  87. if ($n == 1) {
  88. return $msgid;
  89. } else {
  90. return $msgid_plural;
  91. }
  92. }
  93. sub C_ {
  94. my ($msgctxt, $msgid) = @_;
  95. return $msgid;
  96. }
  97. sub P_ {
  98. return ngettext(@_);
  99. }
  100. };
  101. } else {
  102. eval q{
  103. sub g_ {
  104. return dgettext($DEFAULT_TEXT_DOMAIN, shift);
  105. }
  106. sub C_ {
  107. my ($msgctxt, $msgid) = @_;
  108. return dgettext($DEFAULT_TEXT_DOMAIN,
  109. $msgctxt . GETTEXT_CONTEXT_GLUE . $msgid);
  110. }
  111. sub P_ {
  112. return dngettext($DEFAULT_TEXT_DOMAIN, @_);
  113. }
  114. };
  115. }
  116. }
  117. =item $msgid = N_($msgid)
  118. A pseudo function that servers as a marked for automated extraction of
  119. messages, but does not call gettext(). The run-time translation is done
  120. at a different place in the code.
  121. =back
  122. =cut
  123. sub N_
  124. {
  125. my $msgid = shift;
  126. return $msgid;
  127. }
  128. # XXX: Backwards compatibility, to be removed on VERSION 2.00.
  129. sub _g ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
  130. {
  131. my $msgid = shift;
  132. warnings::warnif('deprecated',
  133. 'obsolete _g() function, please use g_() instead');
  134. return g_($msgid);
  135. }
  136. =head1 CHANGES
  137. =head2 Version 1.02 (dpkg 1.18.3)
  138. New function: N_().
  139. =head2 Version 1.01 (dpkg 1.18.0)
  140. Now the short aliases (g_ and P_) will call domain aware functions with
  141. $DEFAULT_TEXT_DOMAIN.
  142. New functions: g_(), C_().
  143. Deprecated function: _g().
  144. =head2 Version 1.00 (dpkg 1.15.6)
  145. Mark the module as public.
  146. =cut
  147. 1;