vms/gen_shrfls.pl more general config.sh parsing

[perl5.git] / lib / charnames.pm

diff --git a/lib/charnames.pm b/lib/charnames.pm
index 7c2209b..70d6d17 100644 (file)
--- a/lib/charnames.pm
+++ b/lib/charnames.pm
@@ -1,5 +1,9 @@
 package charnames;
+
+our $VERSION = '1.00';
+
 use bytes ();          # for $bytes::hint_bits
+use warnings();
 $charnames::hint_bits = 0x20000;
 
 my $txt;
@@ -7,7 +11,7 @@ my $txt;
 # This is not optimized in any way yet
 sub charnames {
   $name = shift;
-  $txt = do "unicode/Name.pl" unless $txt;
+  $txt = do "unicore/Name.pl" unless $txt;
   my @off;
   if ($^H{charnames_full} and $txt =~ /\t\t$name$/m) {
     @off = ($-[0], $+[0]);
@@ -29,8 +33,11 @@ sub charnames {
     }
   }
   die "Unknown charname '$name'" unless @off;
-  
-  my $ord = hex substr $txt, $off[0] - 4, 4;
+
+  my $hexlen = 4; # Unicode guarantees 4-, 5-, or 6-digit format
+  $hexlen++ while
+      $hexlen < 6 && substr($txt, $off[0] - $hexlen - 1, 1) =~ /[0-9a-f]/;
+  my $ord = hex substr $txt, $off[0] - $hexlen, $hexlen;
   if ($^H & $bytes::hint_bits) {       # "use bytes" in effect?
     use bytes;
     return chr $ord if $ord <= 255;
@@ -38,7 +45,7 @@ sub charnames {
     my $fname = substr $txt, $off[0] + 2, $off[1] - $off[0] - 2;
     die "Character 0x$hex with name '$fname' is above 0xFF";
   }
-  return chr $ord;
+  return pack "U", $ord;
 }
 
 sub import {
@@ -51,6 +58,13 @@ sub import {
   $^H{charnames_full} = delete $h{':full'};
   $^H{charnames_short} = delete $h{':short'};
   $^H{charnames_scripts} = [map uc, keys %h];
+  if (warnings::enabled('utf8') && @{$^H{charnames_scripts}}) {
+       $txt = do "unicore/Name.pl" unless $txt;
+    for (@{$^H{charnames_scripts}}) {
+        warnings::warn('utf8',  "No such script: '$_'") unless
+           $txt =~ m/\t\t$_ (?:CAPITAL |SMALL )?LETTER /;
+       }
+  }
 }