Commit | Line | Data |
---|---|---|
bbce6d69 | 1 | package locale; |
2 | ||
d6ded950 | 3 | our $VERSION = '1.04'; |
569f7fc5 | 4 | use Config; |
b75c8c73 | 5 | |
66cbab2c KW |
6 | $Carp::Internal{ (__PACKAGE__) } = 1; |
7 | ||
bbce6d69 | 8 | =head1 NAME |
9 | ||
f36a3959 | 10 | locale - 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 | ||
24 | This pragma tells the compiler to enable (or disable) the use of POSIX | |
f36a3959 KW |
25 | locales for built-in operations (for example, LC_CTYPE for regular |
26 | expressions, LC_COLLATE for string comparison, and LC_NUMERIC for number | |
27 | formatting). Each "use locale" or "no locale" | |
bbce6d69 | 28 | affects statements to the end of the enclosing BLOCK. |
29 | ||
b8bc843f A |
30 | See L<perllocale> for more detailed information on how Perl supports |
31 | locales. | |
32 | ||
a02ae656 KW |
33 | On systems that don't have locales, this pragma will cause your operations |
34 | to 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 | 49 | sub 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 | ||
99 | # Map our names to the ones defined by POSIX | |
100 | $arg = "LC_" . uc($arg); | |
101 | use POSIX 'locale_h'; | |
102 | my $bit = eval "&POSIX::$arg"; | |
103 | if (defined $bit) { | |
104 | # 1 is added so that the pseudo-category :characters, which is | |
105 | # -1, comes out 0. | |
106 | $^H{locale} |= 1 << ($bit + 1); | |
107 | } | |
66cbab2c KW |
108 | } |
109 | } | |
110 | ||
bbce6d69 | 111 | } |
112 | ||
113 | sub unimport { | |
d6ded950 KW |
114 | $^H &= ~($locale::hint_bits|$locale::partial_hint_bits); |
115 | $^H{locale} = 0; | |
bbce6d69 | 116 | } |
117 | ||
118 | 1; |