| 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 | |
