X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Futf8_heavy.pl;h=1839d2144f125697a486c0f01951a379475e8dff;hb=83272a45226e83bd136d713158e9b44ace2dbc8d;hp=70bd018f81c14aa978369e31221d607a29c491f6;hpb=48e3bbddf569369fe6921f305df6ab7290c91152;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index 70bd018..1839d21 100644
--- a/lib/utf8_heavy.pl
+++ b/lib/utf8_heavy.pl
@@ -6,10 +6,10 @@ sub DEBUG () { 0 }
 
 sub DESTROY {}
 
-sub croak { require Carp; Carp::croak(@_) }
-
 my %Cache;
 
+sub croak { require Carp; Carp::croak(@_) }
+
 ##
 ## "SWASH" == "SWATCH HASH". A "swatch" is a swatch of the Unicode landscape
 ##
@@ -81,6 +81,25 @@ sub SWASHNEW {
                 last GETFILE;
             }
 
+	    ##
+	    ## It could be a user-defined property.
+	    ##
+
+	    if ($type =~ /^I[ns](\w+)$/) {
+                my @caller = caller(1);
+
+                if (defined $caller[0]) {
+                    my $prop = $caller[0] . "::" . $type;
+
+                    if (exists &{$prop}) {
+                        no strict 'refs';
+
+                        $list = &{$prop};
+                        last GETFILE;
+                    }
+                }
+            }
+
             ##
             ## Last attempt -- see if it's a "To" name (e.g. "ToLower")
             ##
@@ -99,21 +118,25 @@ sub SWASHNEW {
             return $type;
         }
 
-        print "found it (file='$file')\n" if DEBUG;
+	if (defined $file) {
+	    print "found it (file='$file')\n" if DEBUG;
+
+	    ##
+	    ## If we reach here, it was due to a 'last GETFILE' above
+	    ## (exception: user-defined properties), 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.
+	    ##
+	    if ($Cache{$file} and ref($Cache{$file}) eq $class)
+	    {
+		print "Returning cached '$file' for \\p{$type}\n" if DEBUG;
+		return $Cache{$class, $file};
+	    }
 
-        ##
-        ## If we reach here, it was due to a 'last GETFILE' above, 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.
-        ##
-        if ($Cache{$file} and ref($Cache{$file}) eq $class)
-        {
-            print "Returning cached '$file' for \\p{$type}\n" if DEBUG;
-            return $Cache{$class, $file};
-        }
+	    $list = do $file;
+	}
 
-        $list = do $file;
         $ListSorted = 1; ## we know that these lists are sorted
     }
 
@@ -161,7 +184,13 @@ sub SWASHNEW {
 	    print STDERR "$1 => $2\n" if DEBUG;
 	    if ($char =~ /[-+!]/) {
 		my ($c,$t) = split(/::/, $name, 2);	# bogus use of ::, really
-		my $subobj = $c->SWASHNEW($t, "", 0, 0, 0);
+		my $subobj;
+		if ($c eq 'utf8') {
+		    $subobj = $c->SWASHNEW($t, "", 0, 0, 0);
+		}
+		elsif ($c =~ /^([0-9a-fA-F]+)/) {
+		    $subobj = utf8->SWASHNEW("", $c, 0, 0, 0);
+		}
 		return $subobj unless ref $subobj;
 		push @extras, $name => $subobj;
 		$bits = $subobj->{BITS} if $bits < $subobj->{BITS};
@@ -242,7 +271,7 @@ sub SWASHGET {
 	}
 	else {
 	  LINE:
-	    while (/^([0-9a-fA-F]+)(?:\t([0-9a-fA-F]+))?/mg) {
+	    while (/^([0-9a-fA-F]+)(?:[ \t]+([0-9a-fA-F]+))?/mg) {
 		my $min = hex $1;
 		my $max = (defined $2 ? hex $2 : $min);
 		next if $max < $start;