| 1 | package locale; |
| 2 | |
| 3 | our $VERSION = '1.01'; |
| 4 | |
| 5 | $Carp::Internal{ (__PACKAGE__) } = 1; |
| 6 | |
| 7 | =head1 NAME |
| 8 | |
| 9 | locale - Perl pragma to use or avoid POSIX locales for built-in operations |
| 10 | |
| 11 | =head1 SYNOPSIS |
| 12 | |
| 13 | @x = sort @y; # Unicode sorting order |
| 14 | { |
| 15 | use locale; |
| 16 | @x = sort @y; # Locale-defined sorting order |
| 17 | } |
| 18 | @x = sort @y; # Unicode sorting order again |
| 19 | |
| 20 | =head1 DESCRIPTION |
| 21 | |
| 22 | This pragma tells the compiler to enable (or disable) the use of POSIX |
| 23 | locales for built-in operations (for example, LC_CTYPE for regular |
| 24 | expressions, LC_COLLATE for string comparison, and LC_NUMERIC for number |
| 25 | formatting). Each "use locale" or "no locale" |
| 26 | affects statements to the end of the enclosing BLOCK. |
| 27 | |
| 28 | Starting in Perl 5.16, a hybrid mode for this pragma is available, |
| 29 | |
| 30 | use locale ':not_characters'; |
| 31 | |
| 32 | which enables only the portions of locales that don't affect the character |
| 33 | set (that is, all except LC_COLLATE and LC_CTYPE). This is useful when mixing |
| 34 | Unicode and locales, including UTF-8 locales. |
| 35 | |
| 36 | use locale ':not_characters'; |
| 37 | use open ":locale"; # Convert I/O to/from Unicode |
| 38 | use POSIX qw(locale_h); # Import the LC_ALL constant |
| 39 | setlocale(LC_ALL, ""); # Required for the next statement |
| 40 | # to take effect |
| 41 | printf "%.2f\n", 12345.67' # Locale-defined formatting |
| 42 | @x = sort @y; # Unicode-defined sorting order. |
| 43 | # (Note that you will get better |
| 44 | # results using Unicode::Collate.) |
| 45 | |
| 46 | See L<perllocale> for more detailed information on how Perl supports |
| 47 | locales. |
| 48 | |
| 49 | =cut |
| 50 | |
| 51 | # A separate bit is used for each of the two forms of the pragma, as they are |
| 52 | # mostly independent, and interact with each other and the unicode_strings |
| 53 | # feature. This allows for fast determination of which one(s) of the three |
| 54 | # are to be used at any given point, and no code has to be written to deal |
| 55 | # with coming in and out of scopes--it falls automatically out from the hint |
| 56 | # handling |
| 57 | |
| 58 | $locale::hint_bits = 0x4; |
| 59 | $locale::not_chars_hint_bits = 0x10; |
| 60 | |
| 61 | sub import { |
| 62 | shift; # should be 'locale'; not checked |
| 63 | my $found_not_chars = 0; |
| 64 | while (defined (my $arg = shift)) { |
| 65 | if ($arg eq ":not_characters") { |
| 66 | $^H |= $locale::not_chars_hint_bits; |
| 67 | |
| 68 | # This form of the pragma overrides the other |
| 69 | $^H &= ~$locale::hint_bits; |
| 70 | $found_not_chars = 1; |
| 71 | } |
| 72 | else { |
| 73 | require Carp; |
| 74 | Carp::croak("Unknown parameter '$arg' to 'use locale'"); |
| 75 | } |
| 76 | } |
| 77 | |
| 78 | # Use the plain form if not doing the :not_characters one. |
| 79 | $^H |= $locale::hint_bits unless $found_not_chars; |
| 80 | } |
| 81 | |
| 82 | sub unimport { |
| 83 | $^H &= ~($locale::hint_bits|$locale::not_chars_hint_bits); |
| 84 | } |
| 85 | |
| 86 | 1; |