develooper Front page | perl.perl5.porters | Postings from May 2002

[Patch perl@16861] charnames::vianame tweak

Thread Next
From:
SADAHIRO Tomoyuki
Date:
May 30, 2002 08:00
Subject:
[Patch perl@16861] charnames::vianame tweak
Message ID:
20020530235541.D722.BQW10602@nifty.com
Hello, all.

This patch will make charnames::vianame() tolerable on speed,
even if the name to be searched is at the end of $txt,
like "TAG LATIN CAPITAL LETTER A" for U+E0041.

Try this if you please :-)

#!perl
use strict;
use warnings;
use charnames qw(:full);
printf "%04X\n", charnames::vianame("LATIN CAPITAL LETTER P");
printf "%04X\n", charnames::vianame("LATIN CAPITAL LETTER E");
printf "%04X\n", charnames::vianame("LATIN CAPITAL LETTER R");
printf "%04X\n", charnames::vianame("LATIN CAPITAL LETTER L");
printf "%04X\n", charnames::vianame("TAG LATIN CAPITAL LETTER P");
printf "%04X\n", charnames::vianame("TAG LATIN CAPITAL LETTER E");
printf "%04X\n", charnames::vianame("TAG LATIN CAPITAL LETTER R");
printf "%04X\n", charnames::vianame("TAG LATIN CAPITAL LETTER L");
__END__

--- charnames.pm~	Wed May 29 00:07:00 2002
+++ charnames.pm	Thu May 30 23:30:26 2002
@@ -235,8 +235,19 @@
 
     $txt = do "unicore/Name.pl" unless $txt;
 
-    if ($txt =~ m/^([0-9A-F]+)\t\t($arg)$/m) {
-        return $vianame{$arg} = hex $1;
+    my $pos = index $txt, "\t\t$arg\n";
+    if ($[ <= $pos) {
+	my $posLF = rindex $txt, "\n", $pos;
+	(my $code = substr $txt, $posLF + 1, 6) =~ tr/\t//d;
+	return $vianame{$arg} = hex $code;
+
+	# If $pos is at the 1st line, $posLF must be $[ - 1 (not found);
+	# then $posLF + 1 equals to $[ (at the beginning of $txt).
+	# Otherwise $posLF is the position of "\n";
+	# then $posLF + 1 must be the position of the next to "\n"
+	# (the beginning of the line).
+	# substr($txt, $posLF + 1, 6) may be "0000\t\t", "00A1\t\t",
+	# "10300\t", "100000", etc. So we can get the code via removing TAB.
     } else {
         return;
     }
End of patch

Regards,
SADAHIRO Tomoyuki


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About