Avoid pack/unpack to produce the binary form of a utf8 string
[perl.git] / lib / locale.pm
1 package locale;
2
3 our $VERSION = '1.04';
4 use Config;
5
6 $Carp::Internal{ (__PACKAGE__) } = 1;
7
8 =head1 NAME
9
10 locale - Perl pragma to use or avoid POSIX locales for built-in operations
11
12 =head1 SYNOPSIS
13
14     @x = sort @y;      # Native-platform/Unicode code point sort order
15     {
16         use locale;
17         @x = sort @y;  # Locale-defined sort order
18     }
19     @x = sort @y;      # Native-platform/Unicode code point sort order
20                        # again
21
22 =head1 DESCRIPTION
23
24 This pragma tells the compiler to enable (or disable) the use of POSIX
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"
28 affects statements to the end of the enclosing BLOCK.
29
30 See L<perllocale> for more detailed information on how Perl supports
31 locales.
32
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.
35
36 =cut
37
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.
41
42 $locale::hint_bits = 0x4;
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'"
48
49 sub import {
50     shift;  # should be 'locale'; not checked
51
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;
93
94             # This form of the pragma overrides the other
95             $^H &= ~$locale::hint_bits;
96
97             $arg =~ s/^://;
98
99             eval { require POSIX; import POSIX 'locale_h'; };
100             unless (defined &POSIX::LC_CTYPE) {
101               return;
102             }
103
104             # Map our names to the ones defined by POSIX
105             $arg = "LC_" . uc($arg);
106
107             my $bit = eval "&POSIX::$arg";
108             if (defined $bit) {
109                 # 1 is added so that the pseudo-category :characters, which is
110                 # -1, comes out 0.
111                 $^H{locale} |= 1 << ($bit + 1);
112             }
113         }
114     }
115
116 }
117
118 sub unimport {
119     $^H &= ~($locale::hint_bits|$locale::partial_hint_bits);
120     $^H{locale} = 0;
121 }
122
123 1;