Gettext.pm 4.5 KB

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