diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/locale.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/locale.pm | 89 |
1 files changed, 69 insertions, 20 deletions
diff --git a/Master/tlpkg/tlperl/lib/locale.pm b/Master/tlpkg/tlperl/lib/locale.pm index f7575f5007b..9cc243f86c6 100644 --- a/Master/tlpkg/tlperl/lib/locale.pm +++ b/Master/tlpkg/tlperl/lib/locale.pm @@ -1,6 +1,6 @@ package locale; -our $VERSION = '1.03'; +our $VERSION = '1.06'; use Config; $Carp::Internal{ (__PACKAGE__) } = 1; @@ -35,40 +35,89 @@ to behave as if in the "C" locale; attempts to change the locale will fail. =cut -# A separate bit is used for each of the two forms of the pragma, as they are -# mostly independent, and interact with each other and the unicode_strings -# feature. This allows for fast determination of which one(s) of the three -# are to be used at any given point, and no code has to be written to deal -# with coming in and out of scopes--it falls automatically out from the hint -# handling +# A separate bit is used for each of the two forms of the pragma, to save +# having to look at %^H for the normal case of a plain 'use locale' without an +# argument. $locale::hint_bits = 0x4; -$locale::not_chars_hint_bits = 0x10; +$locale::partial_hint_bits = 0x10; # If pragma has an argument + +# The pseudo-category :characters consists of 2 real ones; but it also is +# given its own number, -1, because in the complement form it also has the +# side effect of "use feature 'unicode_strings'" sub import { shift; # should be 'locale'; not checked - my $found_not_chars = 0; - while (defined (my $arg = shift)) { - if ($arg eq ":not_characters") { - $^H |= $locale::not_chars_hint_bits; + $^H{locale} = 0 unless defined $^H{locale}; + if (! @_) { # If no parameter, use the plain form that changes all categories + $^H |= $locale::hint_bits; + + } + else { + my @categories = ( qw(:ctype :collate :messages + :numeric :monetary :time) ); + for (my $i = 0; $i < @_; $i++) { + my $arg = $_[$i]; + $complement = $arg =~ s/ : ( ! | not_ ) /:/x; + if (! grep { $arg eq $_ } @categories, ":characters") { + require Carp; + Carp::croak("Unknown parameter '$_[$i]' to 'use locale'"); + } + + if ($complement) { + if ($i != 0 || $i < @_ - 1) { + require Carp; + Carp::croak("Only one argument to 'use locale' allowed" + . "if is $complement"); + } + + if ($arg eq ':characters') { + push @_, grep { $_ ne ':ctype' && $_ ne ':collate' } + @categories; + # We add 1 to the category number; This category number + # is -1 + $^H{locale} |= (1 << 0); + } + else { + push @_, grep { $_ ne $arg } @categories; + } + next; + } + elsif ($arg eq ':characters') { + push @_, ':ctype', ':collate'; + next; + } + + $^H |= $locale::partial_hint_bits; # This form of the pragma overrides the other $^H &= ~$locale::hint_bits; - $found_not_chars = 1; - } - else { - require Carp; - Carp::croak("Unknown parameter '$arg' to 'use locale'"); + + $arg =~ s/^://; + + eval { require POSIX; import POSIX 'locale_h'; }; + unless (defined &POSIX::LC_CTYPE) { + return; + } + + # Map our names to the ones defined by POSIX + $arg = "LC_" . uc($arg); + + my $bit = eval "&POSIX::$arg"; + if (defined $bit) { + # 1 is added so that the pseudo-category :characters, which is + # -1, comes out 0. + $^H{locale} |= 1 << ($bit + 1); + } } } - # Use the plain form if not doing the :not_characters one. - $^H |= $locale::hint_bits unless $found_not_chars; } sub unimport { - $^H &= ~($locale::hint_bits|$locale::not_chars_hint_bits); + $^H &= ~($locale::hint_bits|$locale::partial_hint_bits); + $^H{locale} = 0; } 1; |