File Coverage

blib/lib/FAQ/OMatic/I18N.pm
Criterion Covered Total %
statement 15 49 30.6
branch 0 12 0.0
condition 1 11 9.0
subroutine 6 12 50.0
pod 0 7 0.0
total 22 91 24.1


line stmt bran cond sub pod time code
1             ##############################################################################
2             # The Faq-O-Matic is Copyright 1997 by Jon Howell, all rights reserved. #
3             # #
4             # This program is free software; you can redistribute it and/or #
5             # modify it under the terms of the GNU General Public License #
6             # as published by the Free Software Foundation; either version 2 #
7             # of the License, or (at your option) any later version. #
8             # #
9             # This program is distributed in the hope that it will be useful, #
10             # but WITHOUT ANY WARRANTY; without even the implied warranty of #
11             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
12             # GNU General Public License for more details. #
13             # #
14             # You should have received a copy of the GNU General Public License #
15             # along with this program; if not, write to the Free Software #
16             # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.#
17             # #
18             # Jon Howell can be contacted at: #
19             # 6211 Sudikoff Lab, Dartmouth College #
20             # Hanover, NH 03755-3510 #
21             # jonh@cs.dartmouth.edu #
22             # #
23             # An electronic copy of the GPL is available at: #
24             # http://www.gnu.org/copyleft/gpl.html #
25             # #
26             ##############################################################################
27              
28 1     1   6 use strict;
  1         1  
  1         51  
29              
30             ###
31             ### I18N.pm
32             ###
33             ### Internationalization support routines
34             ###
35             # huge THANKS: to Dirk Hansen and Okke Timm, who did the first translation
36             # (to German), which involved weaving gettext() calls all over the code.
37              
38             package FAQ::OMatic::I18N;
39             #use Locale::PGetText;
40              
41 1     1   6 use FAQ::OMatic;
  1         1  
  1         26  
42              
43             BEGIN {
44 1     1   5 use Exporter ();
  1         2  
  1         28  
45 1     1   4 use vars qw(@ISA @EXPORT);
  1         2  
  1         80  
46 1     1   19 @ISA = qw(Exporter);
47              
48 1         574 @EXPORT = qw(&gettext &gettexta &gettext_noop);
49             }
50              
51             sub new {
52 0     0 0 0 my $class = shift;
53 0         0 my $force = shift;
54              
55 0         0 my $tx = FAQ::OMatic::getLocal('i18n');
56 0 0 0     0 if ($force or not defined $tx) {
57 0         0 $tx = {};
58 0         0 bless $tx;
59 0         0 $tx->load();
60 0         0 FAQ::OMatic::setLocal('i18n', $tx);
61             }
62 0         0 return $tx;
63             }
64              
65             sub reload {
66             # force next gettext() to reload
67 0     0 0 0 my $tx = new FAQ::OMatic::I18N('force');
68             }
69              
70             sub language {
71 2   50 2 0 16115 return $FAQ::OMatic::Config::language || 'en';
72             }
73              
74             sub load {
75 0     0 0   my $self = shift;
76 0 0         if ($self->language() ne 'en') {
77 0           my $kit = "FAQ/OMatic/Language_".$self->language().".pm";
78 0           eval {
79 0           require $kit;
80             };
81 0           translations($self);
82             }
83             }
84              
85             sub gettext {
86 0     0 0   my $text = shift;
87 0           my $tx = new FAQ::OMatic::I18N();
88 0   0       my $translated = $tx->{$text} || $text;
89 0 0 0       if (language() ne 'en'
90             and not exists $tx->{$text}) {
91 0           FAQ::OMatic::gripe('debug', "No \""
92             .$tx->language()."\" translation for \"$text\"");
93             }
94 0           return $translated;
95             }
96              
97             sub gettexta {
98             # a slower version that plugs in arguments.
99             # (if perl were partially evaluated, we'd only have this
100             # sub, and gettext would be the curried version. :v)
101              
102 0     0 0   my $text = shift;
103 0 0         if (not defined($text)) {$text = ''};
  0            
104 0           my $translated = gettext($text);
105 0 0         if (not defined($translated)) {$translated = ''};
  0            
106              
107 0           my $arg;
108 0           my $i=0;
109 0 0         $translated =~ s/\%(\d+)/defined($_[$1])?$_[$1]:('%'.$1)/sge;
  0            
110 0           return $translated;
111             }
112              
113             sub gettext_noop
114             {
115 0     0 0   return $_[0];
116             }
117              
118             1;