1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/tools/po4a/lib/Locale/Po4a/Common.pm	Fri Mar 20 16:59:07 2009 +0800
     1.3 @@ -0,0 +1,246 @@
     1.4 +# Locale::Po4a::Common -- Common parts of the po4a scripts and utils
     1.5 +# $Id: Common.pm,v 1.20 2009-02-13 23:16:44 nekral-guest Exp $
     1.6 +#
     1.7 +# Copyright 2005 by Jordi Vilalta <jvprat@gmail.com>
     1.8 +#
     1.9 +# This program is free software; you may redistribute it and/or modify it
    1.10 +# under the terms of GPL (see COPYING).
    1.11 +#
    1.12 +# This module has common utilities for the various scripts of po4a
    1.13 +
    1.14 +=head1 NAME
    1.15 +
    1.16 +Locale::Po4a::Common - Common parts of the po4a scripts and utils
    1.17 +
    1.18 +=head1 DESCRIPTION
    1.19 +
    1.20 +Locale::Po4a::Common contains common parts of the po4a scripts and some useful
    1.21 +functions used along the other modules.
    1.22 +
    1.23 +In order to use Locale::Po4a programatically, one may want to disable
    1.24 +the use of Text::WrapI18N, by writing e.g.
    1.25 +
    1.26 +    use Locale::Po4a::Common qw(nowrapi18n);
    1.27 +    use Locale::Po4a::Text;
    1.28 +
    1.29 +instead of:
    1.30 +
    1.31 +    use Locale::Po4a::Text;
    1.32 +
    1.33 +Ordering is important here: as most Locale::Po4a modules themselves
    1.34 +load Locale::Po4a::Common, the first time this module is loaded
    1.35 +determines whether Text::WrapI18N is used.
    1.36 +
    1.37 +=cut
    1.38 +
    1.39 +package Locale::Po4a::Common;
    1.40 +
    1.41 +require Exporter;
    1.42 +use vars qw(@ISA @EXPORT);
    1.43 +@ISA = qw(Exporter);
    1.44 +@EXPORT = qw(wrap_msg wrap_mod wrap_ref_mod textdomain gettext dgettext);
    1.45 +
    1.46 +use 5.006;
    1.47 +use strict;
    1.48 +use warnings;
    1.49 +
    1.50 +sub import {
    1.51 +    my $class=shift;
    1.52 +
    1.53 +    my $wrapi18n=1;
    1.54 +    if (exists $_[0] && defined $_[0] && $_[0] eq 'nowrapi18n') {
    1.55 +        shift;
    1.56 +        $wrapi18n=0;
    1.57 +    }
    1.58 +    $class->export_to_level(1, $class, @_);
    1.59 +
    1.60 +    return if defined &wrapi18n;
    1.61 +
    1.62 +    if ($wrapi18n && -t STDERR && -t STDOUT && eval { require Text::WrapI18N }) {
    1.63 +    
    1.64 +        # Don't bother determining the wrap column if we cannot wrap.
    1.65 +        my $col=$ENV{COLUMNS};
    1.66 +        if (!defined $col) {
    1.67 +            my @term=eval "use Term::ReadKey; Term::ReadKey::GetTerminalSize()";
    1.68 +            $col=$term[0] if (!$@);
    1.69 +            # If GetTerminalSize() failed we will fallback to a safe default.
    1.70 +            # This can happen if Term::ReadKey is not available
    1.71 +            # or this is a terminal-less build or such strange condition.
    1.72 +        }
    1.73 +        $col=76 if (!defined $col);
    1.74 +        
    1.75 +        eval ' use Text::WrapI18N qw($columns);
    1.76 +               $columns = $col;
    1.77 +             ';
    1.78 +       
    1.79 +        eval ' sub wrapi18n($$$) { Text::WrapI18N::wrap($_[0],$_[1],$_[2]) } '
    1.80 +    } else {
    1.81 +    
    1.82 +        # If we cannot wrap, well, that's too bad. Survive anyway.
    1.83 +        eval ' sub wrapi18n($$$) { $_[0].$_[2] } '
    1.84 +    }
    1.85 +}
    1.86 +
    1.87 +sub min($$) {
    1.88 +    return $_[0] < $_[1] ? $_[0] : $_[1];
    1.89 +}
    1.90 +
    1.91 +=head1 FUNCTIONS
    1.92 +
    1.93 +=head2 Showing output messages
    1.94 +
    1.95 +=over
    1.96 +
    1.97 +=item 
    1.98 +
    1.99 +show_version($)
   1.100 +
   1.101 +Shows the current version of the script, and a short copyright message. It
   1.102 +takes the name of the script as an argument.
   1.103 +
   1.104 +=cut
   1.105 +
   1.106 +sub show_version {
   1.107 +    my $name = shift;
   1.108 +
   1.109 +    print sprintf(gettext(
   1.110 +	"%s version %s.\n".
   1.111 +	"written by Martin Quinson and Denis Barbier.\n\n".
   1.112 +	"Copyright (C) 2002, 2003, 2004 Software of Public Interest, Inc.\n".
   1.113 +	"This is free software; see source code for copying\n".
   1.114 +	"conditions. There is NO warranty; not even for\n".
   1.115 +	"MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
   1.116 +	), $name, $Locale::Po4a::TransTractor::VERSION)."\n";
   1.117 +}
   1.118 +
   1.119 +=item 
   1.120 +
   1.121 +wrap_msg($@)
   1.122 +
   1.123 +This function displays a message the same way than sprintf() does, but wraps
   1.124 +the result so that they look nice on the terminal.
   1.125 +
   1.126 +=cut
   1.127 +
   1.128 +sub wrap_msg($@) {
   1.129 +    my $msg = shift;
   1.130 +    my @args = @_;
   1.131 +
   1.132 +    return wrapi18n("", "", sprintf($msg, @args))."\n";
   1.133 +}
   1.134 +
   1.135 +=item 
   1.136 +
   1.137 +wrap_mod($$@)
   1.138 +
   1.139 +This function works like wrap_msg(), but it takes a module name as the first
   1.140 +argument, and leaves a space at the left of the message.
   1.141 +
   1.142 +=cut
   1.143 +
   1.144 +sub wrap_mod($$@) {
   1.145 +    my ($mod, $msg) = (shift, shift);
   1.146 +    my @args = @_;
   1.147 +
   1.148 +    $mod .= ": ";
   1.149 +    my $spaces = " " x min(length($mod), 15);
   1.150 +    return wrapi18n($mod, $spaces, sprintf($msg, @args))."\n";
   1.151 +}
   1.152 +
   1.153 +=item 
   1.154 +
   1.155 +wrap_ref_mod($$$@)
   1.156 +
   1.157 +This function works like wrap_msg(), but it takes a file:line reference as the
   1.158 +first argument, a module name as the second one, and leaves a space at the left
   1.159 +of the message.
   1.160 +
   1.161 +=back
   1.162 +
   1.163 +=cut
   1.164 +
   1.165 +sub wrap_ref_mod($$$@) {
   1.166 +    my ($ref, $mod, $msg) = (shift, shift, shift);
   1.167 +    my @args = @_;
   1.168 +
   1.169 +    if (!$mod) {
   1.170 +	# If we don't get a module name, show the message like wrap_mod does
   1.171 +	return wrap_mod($ref, $msg, @args);
   1.172 +    } else {
   1.173 +	$ref .= ": ";
   1.174 +	my $spaces = " " x min(length($ref), 15);
   1.175 +	$msg = "$ref($mod)\n$msg";
   1.176 +	return wrapi18n("", $spaces, sprintf($msg, @args))."\n";
   1.177 +    }
   1.178 +}
   1.179 +
   1.180 +=head2 Wrappers for other modules
   1.181 +
   1.182 +=over 
   1.183 +
   1.184 +=item 
   1.185 +
   1.186 +Locale::Gettext
   1.187 +
   1.188 +When the Locale::Gettext module cannot be loaded, this module provide dummy
   1.189 +(empty) implementation of the following functions. In that case, po4a
   1.190 +messages won't get translated but the program will continue to work.
   1.191 +
   1.192 +If Locale::gettext is present, this wrapper also calls
   1.193 +setlocale(LC_MESSAGES, "") so callers don't depend on the POSIX module
   1.194 +either.
   1.195 +
   1.196 +=over
   1.197 +
   1.198 +=item 
   1.199 +
   1.200 +bindtextdomain($$)
   1.201 +
   1.202 +=item 
   1.203 +
   1.204 +textdomain($)
   1.205 +
   1.206 +=item 
   1.207 +
   1.208 +gettext($)
   1.209 +
   1.210 +=item 
   1.211 +
   1.212 +dgettext($$)
   1.213 +
   1.214 +=back
   1.215 +
   1.216 +=back
   1.217 +
   1.218 +=cut
   1.219 +
   1.220 +BEGIN {
   1.221 +    if (eval { require Locale::gettext }) {
   1.222 +       import Locale::gettext;
   1.223 +       require POSIX;
   1.224 +       POSIX::setlocale(&POSIX::LC_MESSAGES, '');
   1.225 +    } else {
   1.226 +       eval '
   1.227 +           sub bindtextdomain($$) { }
   1.228 +           sub textdomain($) { }
   1.229 +           sub gettext($) { shift }
   1.230 +           sub dgettext($$) { return $_[1] }
   1.231 +       '
   1.232 +    }
   1.233 +}
   1.234 +
   1.235 +1;
   1.236 +__END__
   1.237 +
   1.238 +=head1 AUTHORS
   1.239 +
   1.240 + Jordi Vilalta <jvprat@gmail.com>
   1.241 +
   1.242 +=head1 COPYRIGHT AND LICENSE
   1.243 +
   1.244 +Copyright 2005 by SPI, inc.
   1.245 +
   1.246 +This program is free software; you may redistribute it and/or modify it
   1.247 +under the terms of GPL (see the COPYING file).
   1.248 +
   1.249 +=cut