← Back to branch summary

~ubuntu-branches/debian/squeeze/sympa/squeeze

« back to all changes in this revision

Viewing changes to src/Language.pm

  • Committer: Bazaar Package Importer
  • Author(s): Christian Perrier
  • Date: 2007-01-20 18:09:28 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20070120180928-0e42mbwg87mlo44y
Tags: 5.2.3-1.2
* Non-maintainer upload to re-fix l10n issues
* As debconf-updatepo was not run in previous versions, the French
  translation was outdated. Hence fix it.
* Remove several duplicate spaces in the debconf templates

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/Language.pm
1
1
# Language.pm - This module does just the initial setup for the international messages
2
 
# RCS Identication ; $Revision: 1.10.2.1 $ ; $Date: 2004/05/03 13:00:06 $ 
 
2
# RCS Identication ; $Revision: 1.58.2.2 $ ; $Date: 2006/06/08 12:53:26 $ 
3
3
#
4
4
# Sympa - SYsteme de Multi-Postage Automatique
5
5
# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des Universites
24
24
require Exporter;
25
25
use Carp;
26
26
@ISA = qw(Exporter);
27
 
@EXPORT = qw(Msg);
 
27
@EXPORT = qw(&gettext);
28
28
 
29
29
use strict;
30
30
use Log;
31
31
use Version;
 
32
use POSIX qw (setlocale);
 
33
use Locale::Messages qw (:locale_h :libintl_h !gettext);
 
34
 
 
35
BEGIN {
 
36
    ## Using the Pure Perl implementation of gettext
 
37
    ## This is required on Solaris : native implementation of gettext does not map ll_CC with ll
 
38
    Locale::Messages->select_package ('gettext_pp');
 
39
}
32
40
 
33
41
my %msghash;     # Hash organization is like Messages file: File>>Sections>>Messages
34
42
my %set_comment; #sets-of-messages comment   
35
 
my $current_lang;
 
43
 
 
44
## The lang is the NLS catalogue name ; locale is the locale preference
 
45
## Ex: lang = fr ; locale = fr_FR
 
46
my ($current_lang, $current_locale, @previous_locale);
36
47
my $default_lang;
37
 
 
38
 
 
39
 
 
40
 
sub GetHash { return %msghash;}
41
 
 
42
 
sub LoadLang {
43
 
#############
44
 
#To Load all files in MsgHash
45
 
 
46
 
    my $msgdir = shift;
47
 
    &do_log('debug', "Language::LoadLang(%s)", $msgdir);
48
 
 
49
 
    unless (-d $msgdir && -r $msgdir){
50
 
        
51
 
        &do_log('err','Cannot read Locale directory %s', $msgdir);
52
 
        return undef;
53
 
    }
54
 
   
55
 
    unless (opendir MSGDIR, $msgdir) {
56
 
        &do_log('err','Unable to open directory %s', $msgdir);
57
 
        return undef;
58
 
    }
59
 
    
60
 
    foreach my $file (grep /\.msg$/, readdir(MSGDIR)) {    
61
 
 
62
 
        $file =~ /^([\w-]+)\.msg$/;
63
 
        
64
 
        my $lang_name = $1;
65
 
        
66
 
        unless (Msg_file_open($msgdir.'/'.$file,$lang_name)) {
67
 
            &do_log('err','Error while calling Msg_file_Open(%s, %s)', $msgdir.'/'.$file,$lang_name);
68
 
            return undef;
69
 
        }
70
 
    }
71
 
    closedir MSGDIR;
72
 
    
73
 
    return 1;
74
 
}#sub Load_Lang
75
 
 
76
 
 
77
 
sub Msg_file_open {
78
 
#################
79
 
 
80
 
    my $msgfile = shift; #Messages File name
81
 
    my $lang = shift;    #Language
82
 
    my $set_num;           # Section Number
83
 
    my $msg_num;        # Message Number in Section
84
 
    my $msg_value;     # Message content
85
 
 
86
 
    #Opening   ##
87
 
    chomp($msgfile);
88
 
    &do_log('debug', 'Loading locale file %s version', $msgfile);       
89
 
    unless (-r $msgfile) { #check if file exists
90
 
        &do_log('err','Cannot read file %s', $msgfile);
91
 
        return undef;
92
 
    }
93
 
 
94
 
    unless (open(MSGFILE,$msgfile)) { 
95
 
        &do_log('err','Cannot open message File %s', $msgfile);
96
 
        return undef;
97
 
    }
98
 
 
99
 
    #Process  ##
100
 
    while (<MSGFILE>) {  
101
 
        my $current_line = $_;
102
 
        chomp($current_line);
103
 
 
104
 
        next if ($current_line =~ /^\s*$/) || ($current_line =~ /^\$(\s+|quote)/);         # for empty or comments Lines
105
 
 
106
 
        if ($current_line =~ /^\$set\s+(\d+)\s+(.+)$/i){                                   # When it's a Section-separation  Line
107
 
            $set_num = $1;
108
 
            $set_comment{$set_num} = $2;                                                         
109
 
        
110
 
        }elsif ($current_line =~ /^(\d+)\s+\"(.*)(\\|\")\s*$/i){                          # When it's a Begin of Message
111
 
            $msg_num = $1;  
112
 
            $msghash{$lang}{$set_num}{$msg_num} = $2;
113
 
 
114
 
        }elsif ($current_line =~ /^(.+)(\\|\")\s*$/i){                                   # When it's the follow or End of a message
115
 
            $msghash{$lang}{$set_num}{$msg_num} .= $1;
116
 
        }   
117
 
 
118
 
        $msghash{$lang}{$set_num}{$msg_num} =~ s/(\\n)/\n/g;                            #some sequences need to be substitute:
119
 
        $msghash{$lang}{$set_num}{$msg_num} =~ s/(\\t)/\t/g;                           # \n, \t
120
 
        $msghash{$lang}{$set_num}{$msg_num} =~ s/(\\\\)/\\/g;
121
 
 
122
 
        
123
 
    }# while
124
 
    #############
125
 
    close(MSGFILE);
126
 
    return 1;
127
 
}#sub Msg_file_open
 
48
## This was the old style locale naming, used for templates, nls, scenario
 
49
my %language_equiv = ( 'zh_CN' => 'cn',
 
50
                       'zh_TW' => 'tw',
 
51
                       'cs'    => 'cz',
 
52
                       'en_US' => 'us',
 
53
                       );
 
54
 
 
55
## Supported languages are defined by 'supported_lang' sympa.conf parameter
 
56
 
 
57
my %lang2locale = ('cz' => 'cs_CZ',
 
58
                   'de' => 'de_DE',
 
59
                   'us' => 'en_US',
 
60
                   'el' => 'el_GR',
 
61
                   'es' => 'es_ES',
 
62
                   'et' => 'et_EE',
 
63
                   'fi' => 'fi_FI',
 
64
                   'fr' => 'fr_FR',
 
65
                   'hu' => 'hu_HU',
 
66
                   'it' => 'it_IT',
 
67
                   'ja' => 'ja_JP',
 
68
                   'nb' => 'nb_NO',
 
69
                   'nl' => 'nl_NL',
 
70
                   'oc' => 'oc_FR',
 
71
                   'pl' => 'pl_PL',
 
72
                   'pt' => 'pt_PT',
 
73
                   'ro' => 'ro_RO',
 
74
                   'sv' => 'sv_SE',
 
75
                   'cn' => 'zh_CN',
 
76
                   'cs' => 'cs_CZ',
 
77
                   'tr' => 'tr_TR',
 
78
                   'tw' => 'zh_TW');
 
79
 
 
80
## Used to perform setlocale on FreeBSD / Solaris
 
81
my %locale2charset = ('cs_CZ' => 'utf-8',
 
82
                      'de_DE' => 'iso8859-1',
 
83
                      'el_GR' => 'utf-8',
 
84
                      'en_US' => 'utf-8',
 
85
                      'es_ES' => 'iso8859-1',
 
86
                      'et_EE' => 'iso8859-4',
 
87
                      'fi_FI' => 'iso8859-1',
 
88
                      'fr_FR' => 'iso8859-1',
 
89
                      'hu_HU' => 'iso8859-2',
 
90
                      'it_IT' => 'iso8859-1',
 
91
                      'ja_JP' => 'utf-8',
 
92
                      'nb_NO' => 'utf-8',
 
93
                      'nl_NL' => 'iso8859-1',
 
94
                      'oc_FR' => 'iso8859-1',                 
 
95
                      'pl_PL' => 'iso8859-2',
 
96
                      'pt_BR' => 'utf-8',
 
97
                      'pt_PT' => 'iso8859-1',
 
98
                      'ro_RO' => 'iso8859-2',
 
99
                      'sv_SE' => 'utf-8',
 
100
                      'tr_TR' => 'utf-8',
 
101
                      'zh_CN' => 'utf-8',
 
102
                      'zh_TW' => 'big5',
 
103
                      );
 
104
 
 
105
my $recode;
 
106
 
 
107
sub GetSupportedLanguages {
 
108
    my $robot = shift;
 
109
    my @lang_list;
 
110
    
 
111
    foreach my $l (split /,/,&Conf::get_robot_conf($robot, 'supported_lang')) {
 
112
        push @lang_list, $lang2locale{$l}||$l;
 
113
    }
 
114
    return \@lang_list;
 
115
}
 
116
 
 
117
## Keep the previous lang ; can be restored with PopLang
 
118
sub PushLang {
 
119
    my $locale = shift;
 
120
    &do_log('debug', 'Language::PushLang(%s)', $locale);
 
121
 
 
122
    push @previous_locale, $current_locale;
 
123
    &SetLang($locale);
 
124
 
 
125
    return 1;
 
126
}
 
127
 
 
128
sub PopLang {
 
129
    &do_log('debug', 'Language::PopLang(%s)');
 
130
 
 
131
    my $locale = pop @previous_locale;
 
132
    &SetLang($locale);
 
133
 
 
134
    return 1;
 
135
}
128
136
 
129
137
sub SetLang {
130
138
###########
131
 
    my $lang = shift;
132
 
    &do_log('debug3', 'Language::SetLang(%s)', $lang);
133
 
    
 
139
    my $locale = shift;
 
140
    &do_log('debug2', 'Language::SetLang(%s)', $locale);
 
141
 
 
142
    my $lang = $locale;
 
143
 
134
144
    unless ($lang) {
135
145
        &do_log('err','Language::SetLang(), missing locale parameter');
136
146
        return undef;
137
147
    }
138
148
 
139
 
    unless (defined ($msghash{$lang})) {
140
 
        &do_log('err','unknown Locale %s, maybe sub LoadLang not Loaded before', $lang);
141
 
        return undef;
142
 
    }
143
 
            
 
149
    if (length($lang) == 2) {
 
150
        $locale = $lang2locale{$lang};
 
151
    }else {
 
152
        ## uppercase the country part if needed
 
153
        my @items = split /_/, $locale;
 
154
        $items[1] = uc($items[1]);
 
155
        $locale = join '_', @items;
 
156
 
 
157
        ## Get the NLS equivalent for the lang
 
158
        $lang = &Locale2Lang($locale);
 
159
    }
 
160
   
 
161
    ## Set Locale::Messages context
 
162
    my $locale_dashless = $locale.'.'.$locale2charset{$locale}; 
 
163
    $locale_dashless =~ s/-//g;
 
164
    foreach my $type (&POSIX::LC_ALL, &POSIX::LC_TIME) {
 
165
        my $success;
 
166
        foreach my $try ($locale.'.'.$locale2charset{$locale},
 
167
                         $locale.'.'.uc($locale2charset{$locale}),  ## UpperCase required for FreeBSD
 
168
                         $locale_dashless, ## Required on HPUX
 
169
                         $locale,
 
170
                         $lang
 
171
                         ) {
 
172
            if (&setlocale($type, $try)) {
 
173
                $success = 1;
 
174
                last;
 
175
            }   
 
176
        }
 
177
        unless ($success) {
 
178
            &do_log('err','Failed to setlocale(%s) ; you either have a problem with the catalogue .mo files or you should extend available locales in  your /etc/locale.gen (or /etc/sysconfig/i18n) file', $locale);
 
179
            return undef;
 
180
        }
 
181
    }
 
182
    
 
183
    ## Define what catalog is used
 
184
    &Locale::Messages::textdomain("sympa");
 
185
    &Locale::Messages::bindtextdomain('sympa','--LOCALEDIR--');
 
186
    &Locale::Messages::bind_textdomain_codeset('sympa',$recode) if $recode;
 
187
    #bind_textdomain_codeset sympa => 'iso-8859-1';
 
188
 
144
189
    $current_lang = $lang;
145
 
 
146
 
    &POSIX::setlocale(&POSIX::LC_ALL, Msg(14, 1, 'en_US'));
147
 
 
148
 
    return 1;
 
190
    $current_locale = $locale;
 
191
 
 
192
    return $locale;
149
193
}#SetLang
150
194
 
151
 
sub Msg{
152
 
#######
153
 
 
154
 
    my $set = shift;
155
 
    my $msg = shift;
156
 
    my $msg_default = shift;
157
 
  
158
 
    unless (defined($msghash{$current_lang}{$set}{$msg})) {
159
 
        return $msg_default;
160
 
        &do_log('info','%s-Message %d of set %d not found, using user Message : %s ',$current_lang, $msg, $set, $msg_default);
161
 
    }
162
 
 
163
 
    return $msghash{$current_lang}{$set}{$msg};
164
 
 
165
 
}#sub Msg
 
195
sub set_recode {
 
196
    $recode = shift;
 
197
}
166
198
 
167
199
sub GetLang {
168
200
############
170
202
    return $current_lang;
171
203
}
172
204
 
 
205
sub Locale2Lang {
 
206
    my $locale = shift;
 
207
    my $lang;
 
208
 
 
209
    if (defined $language_equiv{$locale}) {
 
210
        $lang = $language_equiv{$locale};
 
211
    }else {
 
212
        ## remove the country part 
 
213
        $lang = $locale;
 
214
        $lang =~ s/_\w{2}$//;
 
215
    }
 
216
 
 
217
    return $lang;
 
218
}
 
219
 
 
220
sub Lang2Locale {
 
221
    my $lang = shift;
 
222
 
 
223
    return $lang2locale{$lang} || $lang;
 
224
}
 
225
 
 
226
sub maketext {
 
227
    my $msg = shift;
 
228
 
 
229
#    &do_log('notice','Maketext: %s', $msg);
 
230
 
 
231
    my $translation = &gettext ($msg);
 
232
 
 
233
    ## replace parameters in string
 
234
    $translation =~ s/\%\%/'_ESCAPED_'.'%_'/eg; ## First escape '%%'
 
235
    $translation =~ s/\%(\d+)/$_[$1-1]/eg;
 
236
    $translation =~ s/_ESCAPED_%\_/'%'/eg; ## Unescape '%%'
 
237
 
 
238
    return $translation;
 
239
}
 
240
 
 
241
sub gettext {
 
242
    &do_log('debug3', 'Language::gettext(%s)', $_[0]);
 
243
 
 
244
    ## This prevents meta information to be returned if the string to translate is empty
 
245
    if ($_[0] eq '') {
 
246
        return '';
 
247
        
 
248
        ## return meta information on the catalogue (language, charset, encoding,...)
 
249
    }elsif ($_[0] =~ '^_(\w+)_$') {
 
250
        my $var = $1;
 
251
        foreach (split /\n/,&Locale::Messages::gettext('')) {
 
252
            if ($var eq 'language') {
 
253
                if (/^Language-Team:\s*(.+)$/i) {
 
254
                    my $language = $1;
 
255
                    $language =~ s/\<\S+\>//;
 
256
                    return $language;
 
257
                }
 
258
            }elsif ($var eq 'charset') {
 
259
                if ($recode) {
 
260
                    return $recode;
 
261
                } elsif (/^Content-Type:\s*.*charset=(\S+)$/i) {
 
262
                    return $1;
 
263
                }
 
264
            }elsif ($var eq 'encoding') {
 
265
                if (/^Content-Transfer-Encoding:\s*(.+)$/i) {
 
266
                    return $1;
 
267
                }
 
268
            }
 
269
        }
 
270
        return '';
 
271
    }
 
272
 
 
273
    &Locale::Messages::gettext(@_);
 
274
}
 
275
 
173
276
1;
174
277