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