Change 18254 by jhi@lyta on 2002/12/07 16:26:27
Add user-definable To-mappings. (So if you don't agree
with the Unicode mappings, you can make your own.)
Resolves [perl #3741].
Affected files ...
.... //depot/maint-5.8/perl/MANIFEST#12 edit
.... //depot/maint-5.8/perl/lib/utf8_heavy.pl#3 edit
.... //depot/maint-5.8/perl/pod/perldiag.pod#10 edit
.... //depot/maint-5.8/perl/pod/perlunicode.pod#4 edit
.... //depot/maint-5.8/perl/t/op/lc_user.t#1 add
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#12 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#11~18234~ Mon Dec 2 14:30:41 2002
+++ perl/MANIFEST Sat Dec 7 08:26:27 2002
@@ -2563,6 +2563,7 @@
t/op/int.t See if int works
t/op/join.t See if join works
t/op/lc.t See if lc, uc, lcfirst, ucfirst, quotemeta work
+t/op/lc_user.t See if user-defined lc et alia work
t/op/length.t See if length works
t/op/lex_assign.t See if ops involving lexicals or pad temps work
t/op/lfs.t See if large files work for perlio
==== //depot/maint-5.8/perl/lib/utf8_heavy.pl#3 (text) ====
Index: perl/lib/utf8_heavy.pl
--- perl/lib/utf8_heavy.pl#2~18080~ Sun Nov 3 21:23:04 2002
+++ perl/lib/utf8_heavy.pl Sat Dec 7 08:26:27 2002
@@ -11,7 +11,8 @@
sub croak { require Carp; Carp::croak(@_) }
##
-## "SWASH" == "SWATCH HASH". A "swatch" is a swatch of the Unicode landscape
+## "SWASH" == "SWATCH HASH". A "swatch" is a swatch of the Unicode landscape.
+## It's a data structure that encodes a set of Unicode characters.
##
sub SWASHNEW {
@@ -87,10 +88,10 @@
## It could be a user-defined property.
##
- my $caller = caller(1);
+ my $caller1 = caller(1);
- if (defined $caller && $type =~ /^(?:\w+)$/) {
- my $prop = $caller . "::" . ( $wasIs ? "Is" : "" ) . $type;
+ if (defined $caller1 && $type =~ /^(?:\w+)$/) {
+ my $prop = $caller1 . "::" . ( $wasIs ? "Is" : "" ) . $type;
if (exists &{$prop}) {
no strict 'refs';
@@ -99,10 +100,29 @@
}
}
+ ##
+ ## See if it's a user-level "To".
+ ##
+
+ my $caller0 = caller(0);
+
+ if (defined $caller0 && $type =~ /^To(?:\w+)$/) {
+ my $map = $caller0 . "::" . $type;
+ if (exists &{$map}) {
+ no strict 'refs';
+
+ $list = &{$map};
+ last GETFILE;
+ }
+ }
+
##
- ## Last attempt -- see if it's a "To" name (e.g. "ToLower")
+ ## Last attempt -- see if it's a standard "To" name
+ ## (e.g. "ToLower") ToTitle is used by ucfirst().
+ ## The user-level way to access ToDigit() and ToFold()
+ ## is to use Unicode::UCD.
##
- if ($type =~ /^To([A-Z][A-Za-z]+)$/)
+ if ($type =~ /^To(Digit|Fold|Lower|Title|Upper)$/)
{
$file = "unicore/To/$1.pl";
## would like to test to see if $file actually exists....
@@ -122,7 +142,7 @@
##
## If we reach here, it was due to a 'last GETFILE' above
- ## (exception: user-defined properties), so we
+ ## (exception: user-defined properties and mappings), so we
## have a filename, so now we load it if we haven't already.
## If we have, return the cached results. The cache key is the
## file to load.
@@ -162,10 +182,10 @@
if ($minbits < 32) {
my $top = 0;
- while ($list =~ /^([0-9a-fA-F]+)(?:\t([0-9a-fA-F]+)?)(?:\t([0-9a-fA-F]+))?/mg)
{
+ while ($list =~ /^([0-9a-fA-F]+)(?:[\t]([0-9a-fA-F]+)?)(?:[
+\t]([0-9a-fA-F]+))?/mg) {
my $min = hex $1;
- my $max = hex(defined $2 ? $2 : $1);
- my $val = hex(defined $3 ? $3 : "");
+ my $max = defined $2 ? hex $2 : $min;
+ my $val = defined $3 ? hex $3 : 0;
$val += $max - $min if defined $3;
$top = $val if $val > $top;
}
@@ -239,10 +259,15 @@
pos $_ = 0;
if ($bits > 1) {
LINE:
- while (/^([0-9a-fA-F]+)(?:\t([0-9a-fA-F]+)?)(?:\t([0-9a-fA-F]+))?/mg) {
- my $min = hex $1;
- my $max = (defined $2 ? hex $2 : $min);
- my $val = hex $3;
+ while (/^([0-9a-fA-F]+)(?:[ \t]([0-9a-fA-F]+)?)?(?:[
+\t]([0-9a-fA-F]+))?/mg) {
+ chomp;
+ my ($a, $b, $c) = ($1, $2, $3);
+ croak "$type: illegal mapping '$_'"
+ if $type =~ /^To/ &&
+ !(defined $a && defined $c);
+ my $min = hex $a;
+ my $max = defined $b ? hex $b : $min;
+ my $val = defined $c ? hex $c : 0;
next if $max < $start;
print "$min $max $val\n" if DEBUG;
if ($none) {
@@ -273,8 +298,9 @@
else {
LINE:
while (/^([0-9a-fA-F]+)(?:[ \t]+([0-9a-fA-F]+))?/mg) {
+ chomp;
my $min = hex $1;
- my $max = (defined $2 ? hex $2 : $min);
+ my $max = defined $2 ? hex $2 : $min;
next if $max < $start;
if ($min < $start) {
$min = $start;
==== //depot/maint-5.8/perl/pod/perldiag.pod#10 (text) ====
Index: perl/pod/perldiag.pod
--- perl/pod/perldiag.pod#9~18234~ Mon Dec 2 14:30:41 2002
+++ perl/pod/perldiag.pod Sat Dec 7 08:26:27 2002
@@ -3685,6 +3685,13 @@
(F) Your version of the C library apparently doesn't do times(). I
suspect you're not running on Unix.
+=item To%s: illegal mapping '%s'
+
+(F) You tried to define a customized To-mapping for lc(), lcfirst,
+uc(), or ucfirst() (or their string-inlined versions), but you
+specified an illegal mapping.
+See L<perlunicode/"User-Defined Character Properties">.
+
=item Too few args to syscall
(F) There has to be at least one argument to syscall() to specify the
==== //depot/maint-5.8/perl/pod/perlunicode.pod#4 (text) ====
Index: perl/pod/perlunicode.pod
--- perl/pod/perlunicode.pod#3~18242~ Tue Dec 3 07:04:07 2002
+++ perl/pod/perlunicode.pod Sat Dec 7 08:26:27 2002
@@ -616,10 +616,10 @@
=head2 User-Defined Character Properties
You can define your own character properties by defining subroutines
-whose names begin with "In" or "Is". The subroutines must be
-visible in the package that uses the properties. The user-defined
-properties can be used in the regular expression C<\p> and C<\P>
-constructs.
+whose names begin with "In" or "Is". The subroutines must be defined
+in the C<main> package. The user-defined properties can be used in the
+regular expression C<\p> and C<\P> constructs. Note that the effect
+is compile-time and immutable once defined.
The subroutines must return a specially-formatted string, with one
or more newline-separated lines. Each line must be one of the following:
@@ -697,6 +697,56 @@
+utf8::IsCn
END
}
+
+You can also define your own mappings to be used in the lc(),
+lcfirst(), uc(), and ucfirst() (or their string-inlined versions).
+The principle is the same: define subroutines in the C<main> package
+with names like C<ToLower> (for lc() and lcfirst()), C<ToTitle> (for
+the first character in ucfirst()), and C<ToUpper> (for uc(), and the
+rest of the characters in ucfirst()).
+
+The string returned by the subroutines needs now to be three
+hexadecimal numbers separated by tabulators: start of the source
+range, end of the source range, and start of the destination range.
+For example:
+
+ sub ToUpper {
+ return <<END;
+ 0061\t0063\t0041
+ END
+ }
+
+defines an uc() mapping that causes only the characters "a", "b", and
+"c" to be mapped to "A", "B", "C", all other characters will remain
+unchanged.
+
+If there is no source range to speak of, that is, the mapping is from
+a single character to another single character, leave the end of the
+source range empty, but the two tabulator characters are still needed.
+For example:
+
+ sub ToLower {
+ return <<END;
+ 0041\t\t0061
+ END
+ }
+
+defines a lc() mapping that causes only "A" to be mapped to "a", all
+other characters will remain unchanged.
+
+(For serious hackers only) If you want to introspect the default
+mappings, you can find the data in the directory
+C<$Config{privlib}>/F<unicore/To/>. The mapping data is returned as
+the here-document, and the C<utf8::ToSpecFoo> are special exception
+mappings derived from <$Config{privlib}>/F<unicore/SpecialCasing.txt>.
+The C<Digit> and C<Fold> mappings that one can see in the directory
+are not directly user-accessible, one can use either the
+C<Unicode::UCD> module, or just match case-insensitively (that's when
+the C<Fold> mapping is used).
+
+A final note on the user-defined property tests and mappings: they
+will be used only if the scalar has been marked as having Unicode
+characters. Old byte-style strings will not be affected.
=head2 Character Encodings for Input and Output
==== //depot/maint-5.8/perl/t/op/lc_user.t#1 (text) ====
Index: perl/t/op/lc_user.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/t/op/lc_user.t Sat Dec 7 08:26:27 2002
@@ -0,0 +1,26 @@
+BEGIN {
+ chdir 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+plan tests => 4;
+
+sub ToUpper {
+ return <<END;
+0061 0063 0041
+END
+}
+
+is("\Ufoo\x{101}", "foo\x{101}", "no changes on 'foo'");
+is("\Ubar\x{101}", "BAr\x{101}", "changing 'ab' on 'bar' ");
+
+sub ToLower {
+ return <<END;
+0041 0061
+END
+}
+
+is("\LFOO\x{100}", "FOO\x{100}", "no changes on 'FOO'");
+is("\LBAR\x{100}", "BaR\x{100}", "changing 'A' on 'BAR' ");
+
End of Patch.
