← Back to branch summary

~ubuntu-branches/ubuntu/wily/libintl-perl/wily-proposed

« back to all changes in this revision

Viewing changes to lib/Locale/TextDomain.pm

  • Committer: Bazaar Package Importer
  • Author(s): Peter Eisentraut
  • Date: 2005-11-18 09:41:42 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 hoary)
  • Revision ID: james.westby@ubuntu.com-20051118094142-3gdzz3ljdxav8aha
Tags: 1.16-1
* New upstream release
* Added FAQ and THANKS to installation

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Locale/TextDomain.pm
1
1
#! /bin/false
2
2
 
3
 
# vim: tabstop=4
4
 
# $Id: TextDomain.pm,v 1.25 2004/01/12 12:03:42 guido Exp $
 
3
# vim: set autoindent shiftwidth=4 tabstop=4:
 
4
# $Id: TextDomain.pm,v 1.34 2005/09/27 23:29:38 guido Exp $
5
5
 
6
6
# High-level interface to Perl i18n.
7
7
# Copyright (C) 2002-2004 Guido Flohr <guido@imperia.net>,
64
64
 
65
65
use strict;
66
66
 
67
 
use Locale::Messages qw (bindtextdomain dgettext dngettext);
 
67
use Locale::Messages qw (textdomain bindtextdomain dgettext dngettext);
68
68
 
69
69
use vars qw ($VERSION);
70
70
 
71
 
$VERSION = '1.10';
 
71
$VERSION = '1.16';
72
72
 
73
73
require Exporter;
74
74
 
79
79
 
80
80
my %textdomains = ();
81
81
my %bound_dirs = ();
 
82
my @default_dirs = ();
82
83
 
83
84
sub __ ($);
84
85
        
90
91
    # Tie the hash to gettext().
91
92
    tie %__, '__TiedTextDomain', \&__tied_gettext;
92
93
    $__ = \%__;
 
94
 
 
95
        # Add default search directories, but only if they exist.
 
96
        for my $dir (qw (/usr/share/locale /usr/local/share/locale)) {
 
97
        if (-d $dir) {
 
98
            @default_dirs = ($dir);
 
99
            last;
 
100
        }
 
101
    }
93
102
}
94
103
 
95
104
# Normal gettext.
96
105
sub __ ($)
97
106
{
98
107
    my $msgid = shift;
99
 
 
 
108
        
100
109
    my $package = caller;
101
110
    
102
111
    my $textdomain = $textdomains{$package};
103
112
    
104
 
    __find_domain $textdomain if defined $bound_dirs{$textdomain};
 
113
    __find_domain $textdomain if 
 
114
                defined $textdomain && defined $bound_dirs{$textdomain};
105
115
    
106
116
    return dgettext $textdomain => $msgid;
107
117
}
115
125
    
116
126
    my $textdomain = $textdomains{$package};
117
127
    
118
 
    __find_domain $textdomain if defined $bound_dirs{$textdomain};
 
128
    __find_domain $textdomain if
 
129
                defined $textdomain && defined $bound_dirs{$textdomain};
119
130
    
120
131
    return dgettext $textdomain => $msgid;
121
132
}
129
140
    
130
141
    my $textdomain = $textdomains{$package};
131
142
    
132
 
    __find_domain $textdomain if defined $bound_dirs{$textdomain};
 
143
    __find_domain $textdomain if
 
144
                defined $textdomain && defined $bound_dirs{$textdomain};
133
145
    
134
146
    return __expand ((dgettext $textdomain => $msgid), %vars);
135
147
}
143
155
    
144
156
    my $textdomain = $textdomains{$package};
145
157
    
146
 
    __find_domain $textdomain if defined $bound_dirs{$textdomain};
 
158
    __find_domain $textdomain if
 
159
                defined $textdomain && defined $bound_dirs{$textdomain};
147
160
    
148
161
    return dngettext $textdomain, $msgid, $msgid_plural, $count;
149
162
}
157
170
    
158
171
    my $textdomain = $textdomains{$package};
159
172
    
160
 
    __find_domain $textdomain if defined $bound_dirs{$textdomain};
 
173
    __find_domain $textdomain if
 
174
                defined $textdomain && defined $bound_dirs{$textdomain};
161
175
    
162
176
    return __expand ((dngettext $textdomain, $msgid, $msgid_plural, $count),
163
 
                     %args);
 
177
                                         %args);
164
178
}
165
179
 
166
180
# Plural with interpolation.
172
186
    
173
187
    my $textdomain = $textdomains{$package};
174
188
    
175
 
    __find_domain $textdomain if defined $bound_dirs{$textdomain};
 
189
    __find_domain $textdomain if
 
190
                defined $textdomain && defined $bound_dirs{$textdomain};
176
191
    
177
192
    return __expand ((dngettext $textdomain, $msgid, $msgid_plural, $count),
178
 
                     %args);
 
193
                                         %args);
179
194
}
180
195
 
181
196
# Dummy functions for string marking.
198
213
    return if exists $textdomains{$package};
199
214
    
200
215
    # Was a textdomain specified?
201
 
    $textdomain = '' unless defined $textdomain && length $textdomain;
 
216
        $textdomain = textdomain unless defined $textdomain && length $textdomain;
202
217
    
203
218
    # Remember the textdomain of that package.
204
219
    $textdomains{$package} = $textdomain;
206
221
    # Remember that we still have to bind that textdomain to
207
222
    # a directory.
208
223
    unless (exists $bound_dirs{$textdomain}) {
209
 
        @search_dirs = map $_ . '/LocaleData', @INC
210
 
            unless @search_dirs;
211
 
        $bound_dirs{$textdomain} = \@search_dirs;
 
224
                @search_dirs = map $_ . '/LocaleData', @INC, @default_dirs
 
225
                        unless @search_dirs;
 
226
                $bound_dirs{$textdomain} = \@search_dirs;
212
227
    }
213
228
        
214
229
    Locale::TextDomain->export_to_level (1, $package, @EXPORT);
219
234
# Private functions.
220
235
sub __find_domain ($)
221
236
{
222
 
    my $domain = shift;
223
 
    
224
 
    my $try_dirs = $bound_dirs{$domain};
225
 
    
226
 
    if (defined $try_dirs) {
227
 
        my $empty = '';
228
 
        my $msgstr = '';
229
 
        foreach my $dir (@$try_dirs) {
230
 
            bindtextdomain $domain => $dir;
231
 
            
232
 
            # Try to read the PO-header as a check.  If you can think
233
 
            # of something less dirty, let me know ...
234
 
            $msgstr = dgettext $domain => $empty;
235
 
            
236
 
            last if length $msgstr;
237
 
        }
238
 
        
239
 
        # If there was no success, fall back to the default search
240
 
        # directories.
241
 
        bindtextdomain $domain => '' unless length $msgstr;
 
237
        my $domain = shift;
 
238
        
 
239
        my $try_dirs = $bound_dirs{$domain};
 
240
        
 
241
        if (defined $try_dirs) {
 
242
                my $found_dir = '';
 
243
                
 
244
                TRYDIR: foreach my $dir (@$try_dirs) {
 
245
                        # Is there a message catalog?  We have to search recursively
 
246
                        # for it.  Since globbing is reported to be buggy under
 
247
                        # MS-DOS, we roll our own version.
 
248
                        local *DIR;
 
249
                        if (opendir DIR, $dir) {
 
250
                                my @files = map { "$dir/$_/LC_MESSAGES/$domain.mo" } 
 
251
                                        grep { ! /^\.\.?$/ } readdir DIR;
 
252
 
 
253
                                foreach my $file (@files) {
 
254
                                        if (-f $file || -l $file) {
 
255
                                                # If we find a non-readable file on our way,
 
256
                                                # we access has been disabled on purpose.
 
257
                                                # Therefore no -r check here.
 
258
                                                $found_dir = $dir;
 
259
                                                last TRYDIR;
 
260
                                        }
 
261
                                }
 
262
                        }
 
263
                }
 
264
                
 
265
                # If there was no success, this will fall back to the default search
 
266
                # directories.
 
267
                bindtextdomain $domain => $found_dir;
242
268
    }
243
269
    
244
270
    # The search has completed.
304
330
in libintl-perl follows a standard strategy to find a suitable message
305
331
catalog containing the translation: Unless you explicitely define
306
332
a name for the message catalog, libintl-perl will assume that your
307
 
catalog is called 'messages'.
 
333
catalog is called 'messages' (unless you have changed the default
 
334
value to something else via Locale::Messages(3pm), method textdomain()).
308
335
 
309
336
You might think that his default strategy leaves room for optimization
310
337
and you are right.  It would be a lot smarter if multiple software