This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Increment $VERSION in lib/locale.pm.
[perl5.git] / lib / locale.pm
CommitLineData
bbce6d69 1package locale;
2
ba403c70 3our $VERSION = '1.07';
569f7fc5 4use Config;
b75c8c73 5
66cbab2c
KW
6$Carp::Internal{ (__PACKAGE__) } = 1;
7
bbce6d69 8=head1 NAME
9
f36a3959 10locale - Perl pragma to use or avoid POSIX locales for built-in operations
bbce6d69 11
12=head1 SYNOPSIS
13
465d77f9 14 @x = sort @y; # Native-platform/Unicode code point sort order
bbce6d69 15 {
16 use locale;
465d77f9 17 @x = sort @y; # Locale-defined sort order
bbce6d69 18 }
465d77f9
KW
19 @x = sort @y; # Native-platform/Unicode code point sort order
20 # again
bbce6d69 21
22=head1 DESCRIPTION
23
24This pragma tells the compiler to enable (or disable) the use of POSIX
f36a3959
KW
25locales for built-in operations (for example, LC_CTYPE for regular
26expressions, LC_COLLATE for string comparison, and LC_NUMERIC for number
27formatting). Each "use locale" or "no locale"
bbce6d69 28affects statements to the end of the enclosing BLOCK.
29
b8bc843f
A
30See L<perllocale> for more detailed information on how Perl supports
31locales.
32
a02ae656
KW
33On systems that don't have locales, this pragma will cause your operations
34to behave as if in the "C" locale; attempts to change the locale will fail.
569f7fc5 35
bbce6d69 36=cut
37
d6ded950
KW
38# A separate bit is used for each of the two forms of the pragma, to save
39# having to look at %^H for the normal case of a plain 'use locale' without an
40# argument.
66cbab2c 41
2de3dbcc 42$locale::hint_bits = 0x4;
d6ded950
KW
43$locale::partial_hint_bits = 0x10; # If pragma has an argument
44
45# The pseudo-category :characters consists of 2 real ones; but it also is
46# given its own number, -1, because in the complement form it also has the
47# side effect of "use feature 'unicode_strings'"
d5448623 48
bbce6d69 49sub import {
66cbab2c 50 shift; # should be 'locale'; not checked
569f7fc5 51
d6ded950
KW
52 $^H{locale} = 0 unless defined $^H{locale};
53 if (! @_) { # If no parameter, use the plain form that changes all categories
54 $^H |= $locale::hint_bits;
55
56 }
57 else {
58 my @categories = ( qw(:ctype :collate :messages
59 :numeric :monetary :time) );
60 for (my $i = 0; $i < @_; $i++) {
61 my $arg = $_[$i];
62 $complement = $arg =~ s/ : ( ! | not_ ) /:/x;
63 if (! grep { $arg eq $_ } @categories, ":characters") {
64 require Carp;
65 Carp::croak("Unknown parameter '$_[$i]' to 'use locale'");
66 }
67
68 if ($complement) {
69 if ($i != 0 || $i < @_ - 1) {
70 require Carp;
71 Carp::croak("Only one argument to 'use locale' allowed"
72 . "if is $complement");
73 }
74
75 if ($arg eq ':characters') {
76 push @_, grep { $_ ne ':ctype' && $_ ne ':collate' }
77 @categories;
78 # We add 1 to the category number; This category number
79 # is -1
80 $^H{locale} |= (1 << 0);
81 }
82 else {
83 push @_, grep { $_ ne $arg } @categories;
84 }
85 next;
86 }
87 elsif ($arg eq ':characters') {
88 push @_, ':ctype', ':collate';
89 next;
90 }
91
92 $^H |= $locale::partial_hint_bits;
66cbab2c
KW
93
94 # This form of the pragma overrides the other
95 $^H &= ~$locale::hint_bits;
d6ded950
KW
96
97 $arg =~ s/^://;
98
395e4985
JH
99 eval { require POSIX; import POSIX 'locale_h'; };
100 unless (defined &POSIX::LC_CTYPE) {
101 return;
102 }
103
d6ded950 104 # Map our names to the ones defined by POSIX
51cdbd7c 105 my $LC = "LC_" . uc($arg);
395e4985 106
51cdbd7c 107 my $bit = eval "&POSIX::$LC";
d6ded950 108 if (defined $bit) {
51cdbd7c
KW
109
110 # Verify our assumption.
111 if (! ($bit >= 0 && $bit < 31)) {
112 require Carp;
113 Carp::croak("Cannot have ':$arg' parameter to 'use locale'"
114 . " on this platform. Use the 'perlbug' utility"
115 . " to report this problem, or send email to"
116 . " 'perlbug\@perl.org'. $LC=$bit");
117 }
118
d6ded950
KW
119 # 1 is added so that the pseudo-category :characters, which is
120 # -1, comes out 0.
121 $^H{locale} |= 1 << ($bit + 1);
122 }
66cbab2c
KW
123 }
124 }
125
bbce6d69 126}
127
128sub unimport {
d6ded950
KW
129 $^H &= ~($locale::hint_bits|$locale::partial_hint_bits);
130 $^H{locale} = 0;
bbce6d69 131}
132
1331;