X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fcharnames.pm;h=54f5179acd8a5b8ac643469dfc22bfe837fff0de;hb=34ba6322b644154d55680c95808981776852ae24;hp=f0a4446b4dceaf1d1640e2e4966e8766e390922d;hpb=e5c3f8982a1650ad4c25a05c41a9038ce21a512c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/charnames.pm b/lib/charnames.pm index f0a4446..54f5179 100644 --- a/lib/charnames.pm +++ b/lib/charnames.pm @@ -1,9 +1,8 @@ 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 @@ -44,6 +43,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; @@ -238,42 +247,31 @@ 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) { + # checking the length first is slightly faster + if (length($hex) > 5 && hex($hex) > 0x10FFFF) { carp sprintf "Unicode characters only allocated up to U+10FFFF (you asked for U+%X)", $hex; return; } @@ -282,11 +280,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;