Add charnames::vianame() in case people want to access

the codes in run-time (as opposed to the compile-timeness
of \N{...}).

p4raw-id: //depot/perl@13237

2 files changed, 62 insertions, 7 deletions

diff --git a/lib/charnames.pm b/lib/charnames.pm
index b93f723332..5554ae0368 100644
--- a/lib/charnames.pm
+++ b/lib/charnames.pm
@@ -126,7 +126,7 @@ sub import
 sub viacode
 {
     if (@_ != 1) {
-        carp "charnames::viacode() expects one numeric value";
+        carp "charnames::viacode() expects one numeric argument";
         return ()
     }
     my $arg = shift;
@@ -136,7 +136,7 @@ sub viacode
         $hex = sprintf "%04X", $arg;
     } else {
         carp("unexpected arg \"$arg\" to charnames::viacode()");
-        return ();
+        return;
     }
 
     $txt = do "unicore/Name.pl" unless $txt;
@@ -144,7 +144,25 @@ sub viacode
     if ($txt =~ m/^$hex\t\t(.+)/m) {
         return $1;
     } else {
-        return ();
+        return;
+    }
+}
+
+sub vianame
+{
+    if (@_ != 1) {
+        carp "charnames::vianame() expects one name argument";
+        return ()
+    }
+
+    my $arg = shift;
+
+    $txt = do "unicore/Name.pl" unless $txt;
+
+    if ($txt =~ m/^([0-9A-F]+)\t\t($arg)/m) {
+        return hex $1;
+    } else {
+        return;
     }
 }
 
@@ -168,6 +186,7 @@ charnames - define character names for C<\N{named}> string literal escapes.
   print "\N{sigma} is Greek sigma, and \N{be} is Cyrillic b.\n";
 
   print charname::viacode(0x1234); # prints "ETHIOPIC SYLLABLE SEE"
+  printf "%04X", charname::vianame("GOTHIC LETTER AHSA"); # prints "10330"
 
 =head1 DESCRIPTION
 
@@ -189,8 +208,13 @@ this pragma looks for the names
   SCRIPTNAME LETTER CHARNAME
 
 in the table of standard Unicode names.  If C<CHARNAME> is lowercase,
-then the C<CAPITAL> variant is ignored, otherwise the C<SMALL> variant is
-ignored.
+then the C<CAPITAL> variant is ignored, otherwise the C<SMALL> variant
+is ignored.
+
+Note that C<\N{...}> is compile-time, it's a special form of string
+constant used inside double-quoted strings: in other words, you cannot
+used variables inside the C<\N{...}>.  If you want similar run-time
+functionality, use charnames::vianame().
 
 =head1 CUSTOM TRANSLATORS
 
@@ -231,7 +255,21 @@ The example
 
 prints "FOUR TEARDROP-SPOKED ASTERISK".
 
-Returns nothing if no name is known for the code.
+Returns undef if no name is known for the code.
+
+This works only for the standard names, and does not yet aply 
+to custom translators.
+
+=head1 charnames::vianame(code)
+
+Returns the code point indicated by the name.
+The example
+
+    printf "%04X", charnames::vianame("FOUR TEARDROP-SPOKED ASTERISK");
+
+prints "2722".
+
+Returns undef if no name is known for the name.
 
 This works only for the standard names, and does not yet aply 
 to custom translators.
diff --git a/lib/charnames.t b/lib/charnames.t
index cc38221a65..ce712c36b0 100644
--- a/lib/charnames.t
+++ b/lib/charnames.t
@@ -8,7 +8,7 @@ BEGIN {
 }
 
 $| = 1;
-print "1..16\n";
+print "1..20\n";
 
 use charnames ':full';
 
@@ -129,3 +129,20 @@ sub to_bytes {
   }
 }
 
+{
+    print "not " unless charnames::viacode(0x1234) eq "ETHIOPIC SYLLABLE SEE";
+    print "ok 17\n";
+
+    print "not " if defined charnames::viacode(0x0590); # unused Hebrew
+    print "ok 18\n";
+}
+
+{
+    print "not " unless
+	sprintf "%04X\n", charnames::vianame("GOTHIC LETTER AHSA") eq "10330";
+    print "ok 19\n";
+
+    print "not " if
+	defined charnames::vianame("NONE SUCH");
+    print "ok 20\n";
+}