Gettext.pm 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130
  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 FUNCTIONS
  43. =over 4
  44. =item my $trans = g_($msgid)
  45. Calls gettext() on the $msgid and returns its translation for the current
  46. locale. If gettext() is not available, simply returns $msgid.
  47. =item my $trans = P_($msgid, $msgid_plural, $n)
  48. Calls ngettext(), returning the correct translation for the plural form
  49. dependent on $n. If gettext() is not available, returns $msgid if $n is 1
  50. or $msgid_plural otherwise.
  51. =back
  52. =cut
  53. BEGIN {
  54. eval 'use Locale::gettext';
  55. if ($@) {
  56. eval q{
  57. sub g_ {
  58. return shift;
  59. }
  60. sub textdomain {
  61. }
  62. sub ngettext {
  63. my ($msgid, $msgid_plural, $n) = @_;
  64. if ($n == 1) {
  65. return $msgid;
  66. } else {
  67. return $msgid_plural;
  68. }
  69. }
  70. sub P_ {
  71. return ngettext(@_);
  72. }
  73. };
  74. } else {
  75. eval q{
  76. sub g_ {
  77. return gettext(shift);
  78. }
  79. sub P_ {
  80. return ngettext(@_);
  81. }
  82. };
  83. }
  84. }
  85. # XXX: Backwards compatibility, to be removed on VERSION 2.00.
  86. sub _g ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
  87. {
  88. my $msgid = shift;
  89. require Carp;
  90. Carp::carp('obsolete _g() function, please use g_() instead');
  91. return g_($msgid);
  92. }
  93. =head1 CHANGES
  94. =head2 Version 1.01
  95. New function: g_().
  96. Deprecated function: _g().
  97. =head2 Version 1.00
  98. Mark the module as public.
  99. =cut
  100. 1;