hgbook
view tools/po4a/lib/Locale/Po4a/Common.pm @ 623:082bb76417f1
Add Po4a 0.37-dev(2009-03-08)
| author | Dongsheng Song <dongsheng.song@gmail.com> |
|---|---|
| date | Thu Mar 12 15:43:56 2009 +0800 (2009-03-12) |
| parents | |
| children |
line source
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
11 =head1 NAME
13 Locale::Po4a::Common - Common parts of the po4a scripts and utils
15 =head1 DESCRIPTION
17 Locale::Po4a::Common contains common parts of the po4a scripts and some useful
18 functions used along the other modules.
20 In order to use Locale::Po4a programatically, one may want to disable
21 the use of Text::WrapI18N, by writing e.g.
23 use Locale::Po4a::Common qw(nowrapi18n);
24 use Locale::Po4a::Text;
26 instead of:
28 use Locale::Po4a::Text;
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.
34 =cut
36 package Locale::Po4a::Common;
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);
43 use 5.006;
44 use strict;
45 use warnings;
47 sub import {
48 my $class=shift;
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, @_);
57 return if defined &wrapi18n;
59 if ($wrapi18n && -t STDERR && -t STDOUT && eval { require Text::WrapI18N }) {
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);
72 eval ' use Text::WrapI18N qw($columns);
73 $columns = $col;
74 ';
76 eval ' sub wrapi18n($$$) { Text::WrapI18N::wrap($_[0],$_[1],$_[2]) } '
77 } else {
79 # If we cannot wrap, well, that's too bad. Survive anyway.
80 eval ' sub wrapi18n($$$) { $_[0].$_[2] } '
81 }
82 }
84 sub min($$) {
85 return $_[0] < $_[1] ? $_[0] : $_[1];
86 }
88 =head1 FUNCTIONS
90 =head2 Showing output messages
92 =over
94 =item
96 show_version($)
98 Shows the current version of the script, and a short copyright message. It
99 takes the name of the script as an argument.
101 =cut
103 sub show_version {
104 my $name = shift;
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 }
116 =item
118 wrap_msg($@)
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.
123 =cut
125 sub wrap_msg($@) {
126 my $msg = shift;
127 my @args = @_;
129 return wrapi18n("", "", sprintf($msg, @args))."\n";
130 }
132 =item
134 wrap_mod($$@)
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.
139 =cut
141 sub wrap_mod($$@) {
142 my ($mod, $msg) = (shift, shift);
143 my @args = @_;
145 $mod .= ": ";
146 my $spaces = " " x min(length($mod), 15);
147 return wrapi18n($mod, $spaces, sprintf($msg, @args))."\n";
148 }
150 =item
152 wrap_ref_mod($$$@)
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.
158 =back
160 =cut
162 sub wrap_ref_mod($$$@) {
163 my ($ref, $mod, $msg) = (shift, shift, shift);
164 my @args = @_;
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 }
177 =head2 Wrappers for other modules
179 =over
181 =item
183 Locale::Gettext
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.
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.
193 =over
195 =item
197 bindtextdomain($$)
199 =item
201 textdomain($)
203 =item
205 gettext($)
207 =item
209 dgettext($$)
211 =back
213 =back
215 =cut
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 }
232 1;
233 __END__
235 =head1 AUTHORS
237 Jordi Vilalta <jvprat@gmail.com>
239 =head1 COPYRIGHT AND LICENSE
241 Copyright 2005 by SPI, inc.
243 This program is free software; you may redistribute it and/or modify it
244 under the terms of GPL (see the COPYING file).
246 =cut