#!/usr/bin/perl use warnings; use strict; use utf8; # A few tests #print word("ДОКТОР")."\n"; #print word("ДО́КТОР")."\n"; #print word("Шоколат")."\n"; # Not a word, but it's just meant to be a test #print word("ШоШоШо")."\n"; sub word { $_ = shift; my $vowels = "АЕЁИЙОУЫЭЮЯаеёийоыэюя"; # Accented О s/([Оо])́/O/; # Erm... this is dumb and needs to be fixed. # (It's a dumb way of guessing syllables) if (tr/$vowels/$vowels/ == 1) { tr [Оо][Oo]; } # Dammit, I need to get this to repeat. # Шоколат works fine (AFAICT), ШоШоШо doesn't # if (/(.*[ЖЦЧШЩжцчшщ])([Оо])(.*)/) # { # $_ = $1 . ($2 eq "О" ? "O" : "o") . $3; # } # Doh! stick to lowercase. s/([ЖЦЧШЩжцчшщ])([Оо])/$1o/g; # Done with the accent, so strip it s/́//; tr [Оо][Aa]; tr [АБВГДЗЙКЛМНПРСТФЬЭ][ABVGDZYKLMNPRSTF'E]; tr [абвгдзйклмнпрстфьэ][abvgdzyklmnprstf'e]; s/Е/Ye/g; s/Ё/Yo/g; s/Ж/Zh/g; s/И/Ee/g; s/У/Oo/g; s/Х/Kh/g; s/Ц/Ts/g; s/Ч/Ch/g; s/Ш/Sh/g; s/Щ/Shsh/g; s/Ю/Yu/g; s/Я/Ya/g; s/е/ye/g; s/ё/yo/g; s/ж/zh/g; s/и/ee/g; s/у/oo/g; s/х/kh/g; s/ц/ts/g; s/ч/ch/g; s/ш/sh/g; s/щ/shsh/g; s/ю/yu/g; s/я/ya/g; return $_; };