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