← Back to branch summary

~ubuntu-branches/ubuntu/precise/liblocale-gettext-perl/precise

« back to all changes in this revision

Viewing changes to gettext.pm

  • Committer: Bazaar Package Importer
  • Author(s): Raphael Hertzog
  • Date: 2005-06-22 14:29:20 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20050622142920-rksd3kezrzi5y6mn
Tags: 1.05-1
* New upstream release
* Conforms to policy 3.6.2.
* Move ${perl:Depends} to Pre-Depends instead of Depends to avoid duplicate
  dependency. Fixes a lintian warning.

Show diffs side-by-side

added added

removed removed

Lines of Context:
gettext.pm
1
1
package Locale::gettext;
2
2
 
 
3
=head1 NAME
 
4
 
 
5
Locale::gettext - message handling functions
 
6
 
 
7
=head1 SYNOPSIS
 
8
 
 
9
    use Locale::gettext;
 
10
    use POSIX;     # Needed for setlocale()
 
11
 
 
12
    setlocale(LC_MESSAGES, "");
 
13
 
 
14
    # OO interface
 
15
    my $d = Locale::gettext->domain("my_program");
 
16
 
 
17
    print $d->get("Welcome to my program"), "\n";
 
18
            # (printed in the local language)
 
19
 
 
20
    # Direct access to C functions
 
21
    textdomain("my_program");
 
22
 
 
23
    print gettext("Welcome to my program"), "\n";
 
24
            # (printed in the local language)
 
25
 
 
26
=head1 DESCRIPTION
 
27
 
 
28
The gettext module permits access from perl to the gettext() family of
 
29
functions for retrieving message strings from databases constructed
 
30
to internationalize software.
 
31
 
 
32
=cut
 
33
 
3
34
use Carp;
4
35
 
5
36
require Exporter;
6
37
require DynaLoader;
7
38
@ISA = qw(Exporter DynaLoader);
8
39
 
9
 
$VERSION = "1.01" ;
 
40
BEGIN {
 
41
        eval {
 
42
                require Encode;
 
43
                $encode_available = 1;
 
44
        };
 
45
        import Encode if ($encode_available);
 
46
}
 
47
 
 
48
$VERSION = "1.05" ;
10
49
 
11
50
%EXPORT_TAGS = (
12
51
 
13
52
    locale_h => [qw(LC_CTYPE LC_NUMERIC LC_TIME LC_COLLATE LC_MONETARY LC_MESSAGES LC_ALL)],
14
53
 
15
 
    libintl_h => [qw(gettext textdomain bindtextdomain dcgettext dgettext)],
 
54
    libintl_h => [qw(gettext textdomain bindtextdomain dcgettext dgettext ngettext dngettext dcngettext bind_textdomain_codeset)],
16
55
 
17
56
);
18
57
 
37
76
    goto &$AUTOLOAD;
38
77
}
39
78
 
40
 
1;
41
 
 
42
 
__END__
43
 
 
44
 
=head1 NAME
45
 
 
46
 
gettext - message handling functions
47
 
 
48
 
=head1 SYNOPSIS
49
 
 
50
 
    use Locale::gettext;
51
 
    use POSIX;     # Needed for setlocale()
52
 
 
53
 
    setlocale(LC_MESSAGES, "");
54
 
    textdomain("my_program");
55
 
 
56
 
    print gettext("Welcome to my program"), "\n";
57
 
            # (printed in the local language)
58
 
 
59
 
=head1 DESCRIPTION
60
 
 
61
 
The gettext module permits access from perl to the gettext() family of
62
 
functions for retrieving message strings from databases constructed
63
 
to internationalize software.
 
79
=over 2
 
80
 
 
81
=item $d = Locale::gettext->domain(DOMAIN)
 
82
 
 
83
=item $d = Locale::gettext->domain_raw(DOMAIN)
 
84
 
 
85
Creates a new object for retrieving strings in the domain B<DOMAIN>
 
86
and returns it. C<domain> requests that strings be returned as
 
87
Perl strings (possibly with wide characters) if possible while
 
88
C<domain_raw> requests that octet strings directly from functions
 
89
like C<dgettext()>.
 
90
 
 
91
=cut
 
92
 
 
93
sub domain_raw {
 
94
        my ($class, $domain) = @_;
 
95
        my $self = { domain => $domain, raw => 1 };
 
96
        bless $self, $class;
 
97
}
 
98
 
 
99
sub domain {
 
100
        my ($class, $domain) = @_;
 
101
        unless ($encode_available) {
 
102
                croak "Encode module not available, cannot use Locale::gettext->domain";
 
103
        }
 
104
        my $self = { domain => $domain, raw => 0 };
 
105
        bless $self, $class;
 
106
        eval { bind_textdomain_codeset($self->{domain}, "UTF-8"); };
 
107
        if ($@ =~ /not implemented/) {
 
108
                # emulate it
 
109
                $self->{emulate} = 1;
 
110
        } elsif ($@ ne '') {
 
111
                die;    # some other problem
 
112
        }
 
113
        $self;
 
114
}
 
115
 
 
116
=item $d->get(MSGID)
 
117
 
 
118
Calls C<dgettext()> to return the translated string for the given
 
119
B<MSGID>.
 
120
 
 
121
=cut
 
122
 
 
123
sub get {
 
124
        my ($self, $msgid) = @_;
 
125
        $self->_convert(dgettext($self->{domain}, $msgid));
 
126
}
 
127
 
 
128
=item $d->cget(MSGID, CATEGORY)
 
129
 
 
130
Calls C<dcgettext()> to return the translated string for the given
 
131
B<MSGID> in the given B<CATEGORY>.
 
132
 
 
133
=cut
 
134
 
 
135
sub cget {
 
136
        my ($self, $msgid, $category) = @_;
 
137
        $self->_convert(dcgettext($self->{domain}, $msgid, $category));
 
138
}
 
139
 
 
140
=item $d->nget(MSGID, MSGID_PLURAL, N)
 
141
 
 
142
Calls C<dngettext()> to return the translated string for the given
 
143
B<MSGID> or B<MSGID_PLURAL> depending on B<N>.
 
144
 
 
145
=cut
 
146
 
 
147
sub nget {
 
148
        my ($self, $msgid, $msgid_plural, $n) = @_;
 
149
        $self->_convert(dngettext($self->{domain}, $msgid, $msgid_plural, $n));
 
150
}
 
151
 
 
152
=item $d->ncget(MSGID, MSGID_PLURAL, N, CATEGORY)
 
153
 
 
154
Calls C<dngettext()> to return the translated string for the given
 
155
B<MSGID> or B<MSGID_PLURAL> depending on B<N> in the given
 
156
B<CATEGORY>.
 
157
 
 
158
=cut
 
159
 
 
160
sub ncget {
 
161
        my ($self, $msgid, $msgid_plural, $n, $category) = @_;
 
162
        $self->_convert(dcngettext($self->{domain}, $msgid, $msgid_plural, $n, $category));
 
163
}
 
164
 
 
165
=item $d->dir([NEWDIR])
 
166
 
 
167
If B<NEWDIR> is given, calls C<bindtextdomain> to set the
 
168
name of the directory where messages for the domain
 
169
represented by C<$d> are found. Returns the (possibly changed)
 
170
current directory name.
 
171
 
 
172
=cut
 
173
 
 
174
sub dir {
 
175
        my ($self, $newdir) = @_;
 
176
        if (defined($newdir)) {
 
177
                bindtextdomain($self->{domain}, $newdir);
 
178
        } else {
 
179
                bindtextdomain($self->{domain});
 
180
        }
 
181
}
 
182
 
 
183
=item $d->codeset([NEWCODE])
 
184
 
 
185
For instances created with C<Locale::gettext-E<gt>domain_raw>, manuiplates
 
186
the character set of the returned strings.
 
187
If B<NEWCODE> is given, calls C<bind_textdomain_codeset> to set the
 
188
character encoding in which messages for the domain
 
189
represented by C<$d> are returned. Returns the (possibly changed)
 
190
current encoding name.
 
191
 
 
192
=cut
 
193
 
 
194
sub codeset {
 
195
        my ($self, $codeset) = @_;
 
196
        if ($self->{raw} < 1) {
 
197
                warn "Locale::gettext->codeset: meaningful only for instances created with domain_raw";
 
198
                return;
 
199
        }
 
200
        if (defined($codeset)) {
 
201
                bind_textdomain_codeset($self->{domain}, $codeset);
 
202
        } else {
 
203
                bind_textdomain_codeset($self->{domain});
 
204
        }
 
205
}
 
206
 
 
207
sub _convert {
 
208
        my ($self, $str) = @_;
 
209
        return $str if ($self->{raw});
 
210
        # thanks to the use of UTF-8 in bind_textdomain_codeset, the
 
211
        # result should always be valid UTF-8 when raw mode is not used.
 
212
        if ($self->{emulate}) {
 
213
                delete $self->{emulate};
 
214
                $self->{raw} = 1;
 
215
                my $null = $self->get("");
 
216
                if ($null =~ /charset=(\S+)/) {
 
217
                        $self->{decode_from} = $1;
 
218
                        $self->{raw} = 0;
 
219
                } #else matches the behaviour of glibc - no null entry
 
220
                  # means no conversion is done
 
221
        }
 
222
        if ($self->{decode_from}) {
 
223
                return decode($self->{decode_from}, $str);
 
224
        } else {
 
225
                return decode_utf8($str);
 
226
        }
 
227
}
 
228
 
 
229
sub DESTROY {
 
230
        my ($self) = @_;
 
231
}
 
232
 
 
233
=back
64
234
 
65
235
gettext(), dgettext(), and dcgettext() attempt to retrieve a string
66
236
matching their C<msgid> parameter within the context of the current
69
239
and gettext() defaults to LC_MESSAGES and uses the current text domain.
70
240
If the string is not found in the database, then C<msgid> is returned.
71
241
 
 
242
ngettext(), dngettext(), and dcngettext() function similarily but
 
243
implement differentiation of messages between singular and plural.
 
244
See the documentation for the corresponding C functions for details.
 
245
 
72
246
textdomain() sets the current text domain and returns the previously
73
247
active domain.
74
248
 
76
250
for the databases belonging to domain C<domain> in the directory
77
251
C<dirname>
78
252
 
 
253
I<bind_textdomain_codeset(domain, codeset)> instructs the retrieval
 
254
functions to translate the returned messages to the character encoding
 
255
given by B<codeset> if the encoding of the message catalog is known.
 
256
 
 
257
=head1 NOTES
 
258
 
 
259
Not all platforms provide all of the functions. Functions that are
 
260
not available in the underlying C library will not be available in
 
261
Perl either.
 
262
 
 
263
Perl programs should use the object interface. In addition to being
 
264
able to return native Perl wide character strings,
 
265
C<bind_textdomain_codeset> will be emulated if the C library does
 
266
not provide it.
 
267
 
79
268
=head1 VERSION
80
269
 
81
 
1.01.
82
 
 
83
 
1.00 was not under the Locale/ directory.
 
270
1.05.
84
271
 
85
272
=head1 SEE ALSO
86
273
 
88
275
 
89
276
=head1 AUTHOR
90
277
 
91
 
Phillip Vandry <vandry@Mlink.NET>
 
278
Phillip Vandry <vandry@TZoNE.ORG>
 
279
 
 
280
=cut
 
281
 
 
282
1;