candidate for TR18 compliance

Date: Thu, 22 Apr 2004 14:31:30 -0400 (EDT)
Message-ID: <Pine.LNX.4.44.0404221429040.10466-101000@perlmonk.org>

Date: Mon, 26 Apr 2004 12:37:21 -0400 (EDT)
Message-ID: <Pine.LNX.4.44.0404261222320.7154-400000@perlmonk.org>

p4raw-id: //depot/perl@22744

1 files changed, 54 insertions, 28 deletions

diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index 668a176e4e..96910354cc 100644
--- a/lib/utf8_heavy.pl
+++ b/lib/utf8_heavy.pl
@@ -1,6 +1,7 @@
 package utf8;
 use strict;
 use warnings;
+require "utf8_pva.pl";
 
 sub DEBUG () { 0 }
 
@@ -8,6 +9,8 @@ sub DESTROY {}
 
 my %Cache;
 
+our (%PropertyAlias, %PA_reverse, %PropValueAlias, %PVA_reverse, %PVA_abbr_map);
+
 sub croak { require Carp; Carp::croak(@_) }
 
 ##
@@ -45,28 +48,67 @@ sub SWASHNEW {
 
       GETFILE:
         {
-            ##
-            ## 'Is' is always optional, so if it's there, remove it.
-            ## Same with 'Category=' and 'Script='.
-            ##
-            ## 'Block=' is replaced by 'In'.
-            ##
+	    ##
+	    ## It could be a user-defined property.
+	    ##
+
+	    my $caller1 = $type =~ s/(.+)::// ? $1 : caller(1);
+
+	    if (defined $caller1 && $type =~ /^(?:\w+)$/) {
+		my $prop = "${caller1}::$type";
+		if (exists &{$prop}) {
+		    no strict 'refs';
+		    
+		    $list = &{$prop};
+		    last GETFILE;
+		}
+	    }
+
             my $wasIs;
 
             ($wasIs = $type =~ s/^Is(?:\s+|[-_])?//i)
               or
-            $type =~ s/^Category\s*=\s*//i
+            $type =~ s/^(?:(?:General(?:\s+|_)?)?Category|gc)\s*[:=]\s*//i
               or
-            $type =~ s/^Script\s*=\s*//i
+            $type =~ s/^(?:Script|sc)\s*[:=]\s*//i
               or
-            $type =~ s/^Block\s*=\s*/In/i;
+            $type =~ s/^Block\s*[:=]\s*/In/i;
+
+
+	    ##
+	    ## See if it's in some enumeration.
+	    ##
+	    if ($type =~ /^([\w\s]+)[:=]\s*(.*)/) {
+		require "utf8_pva.pl";
+		my ($enum, $val) = (lc $1, lc $2);
+		$enum =~ tr/ _-//d;
+		$val =~ tr/ _-//d;
+
+		my $pa = $PropertyAlias{$enum} ? $enum : $PA_reverse{$enum};
+		my $f = $PropValueAlias{$pa}{$val} ? $val : $PVA_reverse{$pa}{lc $val};
+
+		if ($pa and $f) {
+		    $pa = "gc_sc" if $pa eq "gc" or $pa eq "sc";
+		    $file = "unicore/lib/$pa/$PVA_abbr_map{$pa}{lc $f}.pl";
+		    last GETFILE;
+		}
+	    }
+	    else {
+		my $t = lc $type;
+		$t =~ tr/ _-//d;
+
+		if ($PropValueAlias{gc}{$t} or $PropValueAlias{sc}{$t}) {
+		    $file = "unicore/lib/gc_sc/$PVA_abbr_map{gc_sc}{$t}.pl";
+		    last GETFILE;
+		}
+	    }
 
             ##
             ## See if it's in the direct mapping table.
             ##
             require "unicore/Exact.pl";
             if (my $base = $utf8::Exact{$type}) {
-                $file = "unicore/lib/$base.pl";
+                $file = "unicore/lib/gc_sc/$base.pl";
                 last GETFILE;
             }
 
@@ -79,28 +121,12 @@ sub SWASHNEW {
             print "canonical = $canonical\n" if DEBUG;
 
             require "unicore/Canonical.pl";
-            if (my $base = $utf8::Canonical{$canonical}) {
-                $file = "unicore/lib/$base.pl";
+            if (my $base = ($utf8::Canonical{$canonical} || $utf8::Canonical{ lc $utf8::PropertyAlias{$canonical} })) {
+                $file = "unicore/lib/gc_sc/$base.pl";
                 last GETFILE;
             }
 
 	    ##
-	    ## It could be a user-defined property.
-	    ##
-
-	    my $caller1 = $type =~ s/(.+)::// ? $1 : caller(1);
-
-	    if (defined $caller1 && $type =~ /^(?:\w+)$/) {
-		my $prop = $caller1 . "::" . ( $wasIs ? "Is" : "" ) . $type;
-		if (exists &{$prop}) {
-		    no strict 'refs';
-		    
-		    $list = &{$prop};
-		    last GETFILE;
-		}
-	    }
-
-	    ##
 	    ## See if it's a user-level "To".
 	    ##