#!/usr/bin/perl -w $VERSION = '1.00'; use strict; package Encode::transliterate_win1251; my $debug; # Assume that FROM are 1-char, and have no REx charclass special characters my $uc = "ß ÂÅÐÒÛÓÈÎÏØ Ù ÀÑÄÔÃÕÉÊËÇÜ ÖÆ ÁÍÌÝÞ × ¨Ú"; my $ul = "YAVERTYUIOPSHSCHASDFGHJKLZ''CZHBNMEYUCHE'"; # titlecase and random alternative translations my $tc = "ß Ø Ù Æ Þ Þ Þ þ × × × ÷ ß ß ÿ ß ß ÿ Ù Ù ù ¨ ¨ ¸ "; my $tl = "YaShSchZhYuIUIuiuChTchTCHtchIAIaiaJAJajaTCHTchtchJOJojo"; # Assume that 1-char parts of TO have no REx charclass special characters my $lc = "ÿ âåðòûóèîïø ù àñäôãõéêëçüöæ áíìýþ ÷ ¸ú¹"; my $ll = "yavertyuiopshschasdfghjklz'czhbnmeyuche'N"; sub prepare_translation { my ($from, $to) = @_; die "Mismatch of length:\nfrom: '$from'\nto: '$to'\n" unless length($from) == length $to; my @from = ($from =~ /(\S\s*)/g); my (%hash_from, %hash_to); for my $chunk (@from) { my $chunk_to = substr($to, 0, length $chunk); substr($to, 0, length $chunk) = ""; $chunk =~ s/\s+$//; $hash_from{$chunk} = $chunk_to; # Prefer earlier definition for reverse translation $hash_to{$chunk_to} = $chunk unless exists $hash_to{$chunk_to}; } (\%hash_from, \%hash_to) } sub make_translator { my ($hash) = @_; die unless keys %$hash; my @keys2 = grep length > 1, keys %$hash; my $keys1 = join '', grep length == 1, keys %$hash; my $rex = ''; $rex .= (join('|', sort {length $b <=> length $a} @keys2) . '|') if @keys2; $rex .= "[\Q$keys1\E]" if length $keys1; warn "rex = '$rex'\n" if $debug; eval "sub {s/($rex)/\$hash->{\$1}/g}" or die; } sub cyr_table {"$uc$lc$tc"} sub lat_table {"$ul$ll$tl"} #my $to = make_translator( (prepare_translation("$uc$lc$tc", "$ul$ll$tl"))[0] ); 1;