X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fcharnames.pm;h=ef1472c31d98356408ca87905adfeb3db6629177;hb=004caa160f94253de79aa75f9b412f94823dcb96;hp=4f7fdeb6ed1812d8affd935dfc941afdce903809;hpb=b8effcb5f9b63a03069dd25d50d5af552626f11a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/charnames.pm b/lib/charnames.pm
index 4f7fdeb..ef1472c 100644
--- a/lib/charnames.pm
+++ b/lib/charnames.pm
@@ -1,12 +1,10 @@
 package charnames;
 use strict;
 use warnings;
-use Carp;
 use File::Spec;
-our $VERSION = '1.03';
+our $VERSION = '1.05';
 
 use bytes ();		# for $bytes::hint_bits
-$charnames::hint_bits = 0x20000; # HINT_LOCALIZE_HH
 
 my %alias1 = (
 		# Icky 3.2 names with parentheses.
@@ -44,6 +42,16 @@ my %alias3 = (
 	    );
 my $txt;
 
+sub croak
+{
+  require Carp; goto &Carp::croak;
+} # croak
+
+sub carp
+{
+  require Carp; goto &Carp::carp;
+} # carp
+
 sub alias (@)
 {
   @_ or return %alias3;
@@ -183,15 +191,14 @@ sub import
   if (not @_) {
     carp("`use charnames' needs explicit imports list");
   }
-  $^H |= $charnames::hint_bits;
   $^H{charnames} = \&charnames ;
 
   ##
   ## fill %h keys with our @_ args.
   ##
   my ($promote, %h, @args) = (0);
-  while (@_ and $_ = shift) {
-    if ($_ eq ":alias") {
+  while (my $arg = shift) {
+    if ($arg eq ":alias") {
       @_ or
 	croak ":alias needs an argument in charnames";
       my $alias = shift;
@@ -210,11 +217,11 @@ sub import
       alias_file ($alias);
       next;
     }
-    if (m/^:/ and ! ($_ eq ":full" || $_ eq ":short")) {
-      warn "unsupported special '$_' in charnames";
+    if (substr($arg, 0, 1) eq ':' and ! ($arg eq ":full" || $arg eq ":short")) {
+      warn "unsupported special '$arg' in charnames";
       next;
     }
-    push @args, $_;
+    push @args, $arg;
   }
   @args == 0 && $promote and @args = (":full");
   @h{@args} = (1) x @args;
@@ -238,43 +245,32 @@ sub import
   }
 } # import
 
-# this comes actually from Unicode::UCD, but it avoids the
-# overhead of loading it
-sub _getcode {
-    my $arg = shift;
-
-    if ($arg =~ /^[1-9]\d*$/) {
-	return $arg;
-    } elsif ($arg =~ /^(?:[Uu]\+|0[xX])?([[:xdigit:]]+)$/) {
-	return hex($1);
-    }
-
-    return;
-}
-
 my %viacode;
 
 sub viacode
 {
   if (@_ != 1) {
     carp "charnames::viacode() expects one argument";
-    return ()
+    return;
   }
 
   my $arg = shift;
-  my $code = _getcode($arg);
 
+  # this comes actually from Unicode::UCD, where it is the named
+  # function _getcode (), but it avoids the overhead of loading it
   my $hex;
-
-  if (defined $code) {
+  if ($arg =~ /^[1-9]\d*$/) {
     $hex = sprintf "%04X", $arg;
+  } elsif ($arg =~ /^(?:[Uu]\+|0[xX])?([[:xdigit:]]+)$/) {
+    $hex = $1;
   } else {
     carp("unexpected arg \"$arg\" to charnames::viacode()");
     return;
   }
 
-  if ($code > 0x10FFFF) {
-    carp sprintf "Unicode characters only allocated up to U+10FFFF (you asked for U+%X)", $hex;
+  # checking the length first is slightly faster
+  if (length($hex) > 5 && hex($hex) > 0x10FFFF) {
+    carp "Unicode characters only allocated up to U+10FFFF (you asked for U+$hex)";
     return;
   }
 
@@ -282,11 +278,9 @@ sub viacode
 
   $txt = do "unicore/Name.pl" unless $txt;
 
-  if ($txt =~ m/^$hex\t\t(.+)/m) {
-    return $viacode{$hex} = $1;
-  } else {
-    return;
-  }
+  return unless $txt =~ m/^$hex\t\t(.+)/m;
+
+  $viacode{$hex} = $1;
 } # viacode
 
 my %vianame;
@@ -397,10 +391,8 @@ hardwired into F<charnames.pm>.  A module can install custom
 translations (inside the scope which C<use>s the module) with the
 following magic incantation:
 
-    use charnames ();		# for $charnames::hint_bits
     sub import {
 	shift;
-	$^H |= $charnames::hint_bits;
 	$^H{charnames} = \&translator;
     }