Gettext.pm 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124
  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(g_ P_ textdomain ngettext _g);
  28. use Exporter qw(import);
  29. =encoding utf8
  30. =head1 NAME
  31. Dpkg::Gettext - convenience wrapper around Locale::gettext
  32. =head1 DESCRIPTION
  33. The Dpkg::Gettext module is a convenience wrapper over the Locale::gettext
  34. module, to guarantee we always have working gettext functions, and to add
  35. some commonly used aliases.
  36. =head1 FUNCTIONS
  37. =over 4
  38. =item my $trans = g_($msgid)
  39. Calls gettext() on the $msgid and returns its translation for the current
  40. locale. If gettext() is not available, simply returns $msgid.
  41. =item my $trans = P_($msgid, $msgid_plural, $n)
  42. Calls ngettext(), returning the correct translation for the plural form
  43. dependent on $n. If gettext() is not available, returns $msgid if $n is 1
  44. or $msgid_plural otherwise.
  45. =back
  46. =cut
  47. BEGIN {
  48. eval 'use Locale::gettext';
  49. if ($@) {
  50. eval q{
  51. sub g_ {
  52. return shift;
  53. }
  54. sub textdomain {
  55. }
  56. sub ngettext {
  57. my ($msgid, $msgid_plural, $n) = @_;
  58. if ($n == 1) {
  59. return $msgid;
  60. } else {
  61. return $msgid_plural;
  62. }
  63. }
  64. sub P_ {
  65. return ngettext(@_);
  66. }
  67. };
  68. } else {
  69. eval q{
  70. sub g_ {
  71. return gettext(shift);
  72. }
  73. sub P_ {
  74. return ngettext(@_);
  75. }
  76. };
  77. }
  78. }
  79. # XXX: Backwards compatibility, to be removed on VERSION 2.00.
  80. sub _g ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
  81. {
  82. my $msgid = shift;
  83. require Carp;
  84. Carp::carp 'obsolete _g() function, please use g_() instead';
  85. return g_($msgid);
  86. }
  87. =head1 CHANGES
  88. =head2 Version 1.01
  89. New function: g_().
  90. Deprecated function: _g().
  91. =head2 Version 1.00
  92. Mark the module as public.
  93. =cut
  94. 1;