package library; use strict; require Exporter; our(@ISA, @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(addName encode_entities); # symbols to export by default sub encode_entities { my(@a) = @_; foreach (@a) { s/&/&/gos; s//>/gos; s/"/"/gos; } local $" = ''; return "@a"; } sub addName($$$) { my($code, $result, $names) = @_; # XXX should support Hangul open(FILEA, 'NamesList.txt'); my $data; while (defined($data = ) and $data !~ m/^$code\t/s) { } if ($data) { $$result .= 'U+'; my $charname = $data; $charname =~ s/\t/ /gos; chomp $charname; my $charitself = hex($code) < 0x7F ? (hex($code) <= 0x20 or (hex($code) >= 0x61 and hex($code) <= 0x7A) or (hex($code) >= 0x41 and hex($code) <= 0x5A)) ? '' : ' (' . chr(hex($code)) . ')' : " (&#x$code;)"; $$names .= "U+$charname character$charitself\n"; do { $$result .= $data } while (defined($data = ) and $data =~ m/^\t/os); } else { open(FILEB, 'Unihan.txt'); while (defined($data = ) and $data !~ m/^U\+$code\t/s) { } if ($data) { $$names .= "U+$code CJK UNIFIED IDEOGRAPH character (&#x$code)\n"; $$result .= "U+$code\tCJK UNIFIED IDEOGRAPH\n"; do { $data =~ s/^U\+$code\t(k\S+)\t/\t$1: /gs; $$result .= $data; } while (defined($data = ) and $data =~ m/^U\+$code\t/s); } else { $$names .= "U+$code character\n"; $$result .= "U+$code\tUNKNOWN CHARACTER\n"; } close(FILEB); } close(FILEA); }