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 | # 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 in the 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␊ |
247 | |