#!/usr/bin/perl # Převede čínské znaky z UTF-8 na pinyin. # (c) 2007 Dan Zeman # Licence: GNU GPL package han2pinyin; use utf8; BEGIN { my $tabulka = < chr(257), "a2" => "á", "a3" => chr(462), "a4" => chr(224), "e1" => chr(275), "e2" => "é", "e3" => "ě", "e4" => chr(232), "i1" => chr(299), "i2" => "í", "i3" => chr(464), "i4" => chr(236), "o1" => chr(333), "o2" => "ó", "o3" => chr(466), "o4" => chr(242), "u1" => chr(363), "u2" => "ú", "u3" => chr(468), "u4" => chr(249), "ü1" => chr(470), "ü2" => chr(472), "ü3" => chr(474), "ü4" => chr(476), ); #------------------------------------------------------------------------------ # Změní způsob zápisu tónu. Na vstupu je slabika, která má tón uvedený na konci # číslem 1 až 5, na výstupu má tatáž slabika tón vyznačený diakritikou. #------------------------------------------------------------------------------ sub num2dia { my $slabika = shift; # Převést slabiku na malá písmena, aby se nám snadněji rozebírala. $slabika = lc($slabika); # Uříznout číslo tónu. my $ton; if($slabika =~ s/(\d)$//) { $ton = $1; } # Uříznout souhlásky na začátku. my $zacatek; if($slabika =~ s/^([^aeiouü]+)//) { $zacatek = $1; } # Uříznout souhlásky na konci (n, ng, r). my $konec; if($slabika =~ s/([^aeiouü]+)$//) { $konec = $1; } # Skupiny: a ai ao e ei i ia iao ie io iu o ou u ua uai ue ui uo # Kam tón: A Ai Ao E Ei I iA iAo iE iO iU O Ou U uA uAi uE uI uO # Tón je vždy na první nebo druhé samohlásce. if(length($slabika)>=3) { $konec = substr($slabika, 2, length($slabika)-2).$konec; $slabika = substr($slabika, 0, 2); } # I a U jsou slabé samohlásky. Jestliže skupina začíná jimi, dostane přednost druhá samohláska (i kdyby to taky bylo I nebo U). if(length($slabika)==2) { if($slabika =~ s/^([iu])//) { $zacatek .= $1; } # Jinak vyhraje první samohláska. else { $slabika =~ s/(.)$//; $konec = $1.$konec; } } # Přidat k vítězné samohlásce diakritiku. my $stonem = $slabika.$ton; if(exists($tony{$stonem})) { $slabika = $tony{$stonem}; } # Opět poslepovat slabiku, teď už bez čísla tónu na konci. $slabika = $zacatek.$slabika.$konec; return $slabika; } #------------------------------------------------------------------------------ # Převede řetězec na pinyin s pomocí tabulky uložené v globálním hashi %py. #------------------------------------------------------------------------------ sub pinyin { my $retezec = shift; my @znaky = split(//, $retezec); foreach my $znak (@znaky) { if(exists($py{$znak}) && $py{$znak} ne "") { $znak = $py{$znak}; # Tón bude uveden číslem. if(0) { # Převést první znak na velké písmeno. Snad to zvýší čitelnost. $znak =~ s/^(.)/\u$1/; } # Tón bude uveden diakritikou. else { # Jestliže slabika začíná samohláskou, pro jistotu před ní dát apostrof. my $apostrof; if($znak =~ m/^[aeiouü]/i) { $apostrof = "'"; } $znak = $apostrof.num2dia($znak); } } } return join("", @znaky); } 1;