[perl]字符串转拼音首字母(支持多音字)

while (<DATA>) {
chomp;
my ($head, $all) = /^(.{})(.*)$/;
$all =~ s/^\s+//; ### 只保留无音标号的首字母
sub toshorter {
my $str = $_[]; $str =~ s/ā|á|ǎ|à/a/g;
$str =~ s/ē|é|ě|è/e/g;
$str =~ s/ō|ó|ǒ|ò/o/g; $str =~ s/^([a-z]).*$/\/; return $str;
}; my @tmp; for (split ',', $all) {
push @tmp, toshorter($_);
} $all = join ',', @tmp; ### $pytable{$head} = $all;
}sub getheadstr {
@str = $_[] =~ /.{}/g;
@res = (); sub loop {
my ($no, $head) = @_; for (split ',', $pytable{$str[$no]}) {
if ($no == $#str) {
push @res, $head . $_;
} else {
loop($no + , $head . $_);
}
}
} loop(, ""); undef %count;
return join ' ', grep { ++$count{ $_ } < ; } @res;
}print "乐筠: " . getheadstr("乐筠") . "\n";
print "梁炜: " . getheadstr("梁炜") . "\n";__DATA__
数据太长,另附