Mercurial > hgbook
comparison tools/po4a/lib/Locale/Po4a/Common.pm @ 722:082bb76417f1
Add Po4a 0.37-dev(2009-03-08)
author | Dongsheng Song <dongsheng.song@gmail.com> |
---|---|
date | Thu, 12 Mar 2009 15:43:56 +0800 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
721:2180358c32c4 | 722:082bb76417f1 |
---|---|
1 # Locale::Po4a::Common -- Common parts of the po4a scripts and utils | |
2 # $Id: Common.pm,v 1.20 2009-02-13 23:16:44 nekral-guest Exp $ | |
3 # | |
4 # Copyright 2005 by Jordi Vilalta <jvprat@gmail.com> | |
5 # | |
6 # This program is free software; you may redistribute it and/or modify it | |
7 # under the terms of GPL (see COPYING). | |
8 # | |
9 # This module has common utilities for the various scripts of po4a | |
10 | |
11 =head1 NAME | |
12 | |
13 Locale::Po4a::Common - Common parts of the po4a scripts and utils | |
14 | |
15 =head1 DESCRIPTION | |
16 | |
17 Locale::Po4a::Common contains common parts of the po4a scripts and some useful | |
18 functions used along the other modules. | |
19 | |
20 In order to use Locale::Po4a programatically, one may want to disable | |
21 the use of Text::WrapI18N, by writing e.g. | |
22 | |
23 use Locale::Po4a::Common qw(nowrapi18n); | |
24 use Locale::Po4a::Text; | |
25 | |
26 instead of: | |
27 | |
28 use Locale::Po4a::Text; | |
29 | |
30 Ordering is important here: as most Locale::Po4a modules themselves | |
31 load Locale::Po4a::Common, the first time this module is loaded | |
32 determines whether Text::WrapI18N is used. | |
33 | |
34 =cut | |
35 | |
36 package Locale::Po4a::Common; | |
37 | |
38 require Exporter; | |
39 use vars qw(@ISA @EXPORT); | |
40 @ISA = qw(Exporter); | |
41 @EXPORT = qw(wrap_msg wrap_mod wrap_ref_mod textdomain gettext dgettext); | |
42 | |
43 use 5.006; | |
44 use strict; | |
45 use warnings; | |
46 | |
47 sub import { | |
48 my $class=shift; | |
49 | |
50 my $wrapi18n=1; | |
51 if (exists $_[0] && defined $_[0] && $_[0] eq 'nowrapi18n') { | |
52 shift; | |
53 $wrapi18n=0; | |
54 } | |
55 $class->export_to_level(1, $class, @_); | |
56 | |
57 return if defined &wrapi18n; | |
58 | |
59 if ($wrapi18n && -t STDERR && -t STDOUT && eval { require Text::WrapI18N }) { | |
60 | |
61 # Don't bother determining the wrap column if we cannot wrap. | |
62 my $col=$ENV{COLUMNS}; | |
63 if (!defined $col) { | |
64 my @term=eval "use Term::ReadKey; Term::ReadKey::GetTerminalSize()"; | |
65 $col=$term[0] if (!$@); | |
66 # If GetTerminalSize() failed we will fallback to a safe default. | |
67 # This can happen if Term::ReadKey is not available | |
68 # or this is a terminal-less build or such strange condition. | |
69 } | |
70 $col=76 if (!defined $col); | |
71 | |
72 eval ' use Text::WrapI18N qw($columns); | |
73 $columns = $col; | |
74 '; | |
75 | |
76 eval ' sub wrapi18n($$$) { Text::WrapI18N::wrap($_[0],$_[1],$_[2]) } ' | |
77 } else { | |
78 | |
79 # If we cannot wrap, well, that's too bad. Survive anyway. | |
80 eval ' sub wrapi18n($$$) { $_[0].$_[2] } ' | |
81 } | |
82 } | |
83 | |
84 sub min($$) { | |
85 return $_[0] < $_[1] ? $_[0] : $_[1]; | |
86 } | |
87 | |
88 =head1 FUNCTIONS | |
89 | |
90 =head2 Showing output messages | |
91 | |
92 =over | |
93 | |
94 =item | |
95 | |
96 show_version($) | |
97 | |
98 Shows the current version of the script, and a short copyright message. It | |
99 takes the name of the script as an argument. | |
100 | |
101 =cut | |
102 | |
103 sub show_version { | |
104 my $name = shift; | |
105 | |
106 print sprintf(gettext( | |
107 "%s version %s.\n". | |
108 "written by Martin Quinson and Denis Barbier.\n\n". | |
109 "Copyright (C) 2002, 2003, 2004 Software of Public Interest, Inc.\n". | |
110 "This is free software; see source code for copying\n". | |
111 "conditions. There is NO warranty; not even for\n". | |
112 "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." | |
113 ), $name, $Locale::Po4a::TransTractor::VERSION)."\n"; | |
114 } | |
115 | |
116 =item | |
117 | |
118 wrap_msg($@) | |
119 | |
120 This function displays a message the same way than sprintf() does, but wraps | |
121 the result so that they look nice on the terminal. | |
122 | |
123 =cut | |
124 | |
125 sub wrap_msg($@) { | |
126 my $msg = shift; | |
127 my @args = @_; | |
128 | |
129 return wrapi18n("", "", sprintf($msg, @args))."\n"; | |
130 } | |
131 | |
132 =item | |
133 | |
134 wrap_mod($$@) | |
135 | |
136 This function works like wrap_msg(), but it takes a module name as the first | |
137 argument, and leaves a space at the left of the message. | |
138 | |
139 =cut | |
140 | |
141 sub wrap_mod($$@) { | |
142 my ($mod, $msg) = (shift, shift); | |
143 my @args = @_; | |
144 | |
145 $mod .= ": "; | |
146 my $spaces = " " x min(length($mod), 15); | |
147 return wrapi18n($mod, $spaces, sprintf($msg, @args))."\n"; | |
148 } | |
149 | |
150 =item | |
151 | |
152 wrap_ref_mod($$$@) | |
153 | |
154 This function works like wrap_msg(), but it takes a file:line reference as the | |
155 first argument, a module name as the second one, and leaves a space at the left | |
156 of the message. | |
157 | |
158 =back | |
159 | |
160 =cut | |
161 | |
162 sub wrap_ref_mod($$$@) { | |
163 my ($ref, $mod, $msg) = (shift, shift, shift); | |
164 my @args = @_; | |
165 | |
166 if (!$mod) { | |
167 # If we don't get a module name, show the message like wrap_mod does | |
168 return wrap_mod($ref, $msg, @args); | |
169 } else { | |
170 $ref .= ": "; | |
171 my $spaces = " " x min(length($ref), 15); | |
172 $msg = "$ref($mod)\n$msg"; | |
173 return wrapi18n("", $spaces, sprintf($msg, @args))."\n"; | |
174 } | |
175 } | |
176 | |
177 =head2 Wrappers for other modules | |
178 | |
179 =over | |
180 | |
181 =item | |
182 | |
183 Locale::Gettext | |
184 | |
185 When the Locale::Gettext module cannot be loaded, this module provide dummy | |
186 (empty) implementation of the following functions. In that case, po4a | |
187 messages won't get translated but the program will continue to work. | |
188 | |
189 If Locale::gettext is present, this wrapper also calls | |
190 setlocale(LC_MESSAGES, "") so callers don't depend on the POSIX module | |
191 either. | |
192 | |
193 =over | |
194 | |
195 =item | |
196 | |
197 bindtextdomain($$) | |
198 | |
199 =item | |
200 | |
201 textdomain($) | |
202 | |
203 =item | |
204 | |
205 gettext($) | |
206 | |
207 =item | |
208 | |
209 dgettext($$) | |
210 | |
211 =back | |
212 | |
213 =back | |
214 | |
215 =cut | |
216 | |
217 BEGIN { | |
218 if (eval { require Locale::gettext }) { | |
219 import Locale::gettext; | |
220 require POSIX; | |
221 POSIX::setlocale(&POSIX::LC_MESSAGES, ''); | |
222 } else { | |
223 eval ' | |
224 sub bindtextdomain($$) { } | |
225 sub textdomain($) { } | |
226 sub gettext($) { shift } | |
227 sub dgettext($$) { return $_[1] } | |
228 ' | |
229 } | |
230 } | |
231 | |
232 1; | |
233 __END__ | |
234 | |
235 =head1 AUTHORS | |
236 | |
237 Jordi Vilalta <jvprat@gmail.com> | |
238 | |
239 =head1 COPYRIGHT AND LICENSE | |
240 | |
241 Copyright 2005 by SPI, inc. | |
242 | |
243 This program is free software; you may redistribute it and/or modify it | |
244 under the terms of GPL (see the COPYING file). | |
245 | |
246 =cut |