view release on metacpan or  search on metacpan

lib/Lingua/RU/Detect.pm  view on Meta::CPAN

	'UTF-7.CP866',							'(?:^|\s)\+JWg[a-zA-Z]+',
	'UTF-8.ISO-8859-1,UTF-7.ISO-8859-1',	'(?:^|\s)\+AN[a-zA-Z]+',

	'UTF-8.CP1251,KOI8-R.CP866',			'є.¶|¶.¶',
	'UTF-8.CP1252,KOI8-R.CP866',			'º.º|¶.º',
	'UTF-8.CP1251,UTF-8.CP866',				'в•Ё|•›в•',
	'UTF-8.KOI8-R,UTF-8.CP866',				'Б∙╗|Б∙.Б∙.',
	'UTF-8.ISO-8859-1',						'к|пÐ',
	'UTF-8.CP1251,UTF-8.ISO-8859-1',		'ГђВ|°Г‘',
	'UTF-8.KOI8-R,UTF-8.ISO-8859-1',		'ц░б',
	'UTF-8.CP1251,UTF-8.UTF-16',			'н‚.н‚|н†.н†',
	'UTF-8.KOI8-R,UTF-8.UTF-16',			'╬М|╪М|╣М|╫М',
	'UTF-8.CP1251,CP866.UTF-8',				'®.+Ґ|«Ё|®¤­®|«Ґ',
	'UTF-8.CP1251,UTF-8.KOI8-R',			'Рїв|СЏ',

	'UTF-8.ISO-8859-1,ISO-8859-5.UTF-8',	'[ýëåêòðèôèêàöèÿãóáåðíèé]+[ÝËÅÊÒÐÈÔÈÊÀÖÈŸÃÓÁÅÐÍÈÉ]+[ýëåêòðèôèêàöèÿãóáåðíèé]+|[ÝËÅÊÒÐÈÔÈÊÀÖÈŸÃÓÁÅÐÍÈÉ]+[ýëåêòðèôèêÃ...
	'UTF-8.CP1252,CP1251.UTF-8',			'[ýëåêòðèôèêàöèÿãóáåðíèé]{3,}',
	'UTF-8.CP1252,KOI8-R.UTF-8',			'[ÀÏÎËÜÇÎÂÀÍÈÅÑ]{2,}',

	'UTF-8.CP866,KOI8-R.UTF-8',				'[╟╧╫╣║╔╙═╔╥╧╦┴╤╠┼╦╘╥╔╞╔╦┴├╔╤└╓╬┘╚ ╟╒┬┼╥╬╔╩]{4,}',
	'UTF-8.KOI8-R,CP866.UTF-8',				'[╟╧╫╣║╔╙═╔╥╧╦┴╤╠┼╦╘╥╔╞╔╦┴├╔╤└╓╬┘╚ ╟╒┬┼╥╬╔╩]+[А-Я]+[╟╧╫╣║╔╙═╔╥╧╦┴╤╠┼╦╘╥╔╞╔╦┴├╔╤└...
	'UTF-8.CP866,ISO-8859-5.UTF-8',			'[а-ор-я]+[╟╧╫╣║╔╙═╔╥╧╦┴╤╠┼╦╘╥╔╞╔╦┴├╔╤└╓╬┘╚ ╟╒┬┼╥╬╔╩]+[а-ор-я]+[╟╧╫╣║╔╙═╔╥╧╦┴╤╠┼╦╘╥╔╞...
	'UTF-8.KOI8-R',							'[пя][╟╧╫╣║╔╙═╔╥╧╦┴╤╠┼╦╘╥╔╞╔╦┴├╔╤└╓╬┘╚ ╟╒┬┼╥╬╔╩][пя]|п.я',
	'UTF-8.CP866',							'[▒▓╟╧╫╣║╔╙═╔╥╧╦┴╤╠┼╦╘╥╔╞╔╦┴├╔╤└╓╬┘╚ ╟╒┬┼╥╬╔╩]+[А-Я][▒▓╟╧╫╣║╔╙═╔╥╧╦┴╤╠┼╦╘╥╔╞╔╦┴├╔╤â”...
);

my %ambiguities = (
	'-'		=> 'на|ст|ни|но|ан|ов|ко|то|ен|ле|ел|ра|ре|ис|по|ом|ро|ет|ва|та|ос|те|де|ль|ер|он|ть|за|ск|от|ли|ат|ол|об|ар|од|ие|го|пр|ри|мо|ам|сл|тр|не|ор|ла|ал|...
	'UTF-8.KOI8-R,CP1251.KOI8-R,CP1251.UTF-8'		=> 'лч|ъп|лу|лм|чл|ма|им|пм|ел|йе|ей|оч|ое|уъ|нм|мк|ом|еп|ач|пч|мъ|пе|де|йщ|ео|мл|пщ|цч|ъи|мп|йу|чп|мй|мю|чо|мд|уе|жм|но|оу|к...
	
	'UTF-8.CP1251,KOI8-R.UTF-8'		=> 'ОБ|УФ|ОЙ|ОП|БО|ПЧ|ЛП|ФП|ЕО|МЕ|ЕМ|ТБ|ТЕ|ЙУ|РП|ПН|ТП|ЕФ|ЧБ|ФБ|ПУ|ФЕ|ДЕ|МШ|ЕТ|ПО|ФШ|ЪБ|УЛ|ПФ|МЙ|БФ|ПМ|ПВ|БТ|ПД|ЙЕ|ЗП|РТ|ТЙ|НП|БН|УМ|Ð...
	'UTF-8.KOI8-R,CP1251.UTF-8'		=> 'МЮ|ЯР|МХ|МН|ЮМ|НБ|ЙН|РН|ЕМ|КЕ|ЕК|ПЮ|ПЕ|ХЯ|ОН|НЛ|ПН|ЕР|БЮ|РЮ|НЯ|РЕ|ДЕ|КЭ|ЕП|НМ|РЭ|ГЮ|ЯЙ|НР|КХ|ЮР|НК|НА|ЮП|НД|ХЕ|ЦН|ОП|ПХ|ЛН|ЮЛ|ЯК|Ð...
	
	'UTF-8.ISO-8859-5,KOI8-R.UTF-8' => 'ЮС|гд|ЮЩ|ЮЯ|СЮ|Яз|ЫЯ|дЯ|ХЮ|ЬХ|ХЬ|вС|вХ|Щг|аЯ|ЯЭ|вЯ|Хд|зС|дС|Яг|дХ|ФХ|Ьи|Хв|ЯЮ|ди|кС|гЫ|Яд|ЬЩ|Сд|ЯЬ|ЯТ|Св|ЯФ|ЩХ|ЧЯ|ав|вЩ|ЭЯ|СЭ|гÐ...
	'UTF-8.KOI8-R,ISO-8859-5.UTF-8' => 'щп|АБ|щь|щч|пщ|чр|зч|Бч|ущ|шу|уш|Юп|Юу|ьА|ъч|чэ|Юч|уБ|рп|Бп|чА|Бу|ту|шЛ|уЮ|чщ|БЛ|вп|Аз|чБ|шь|пБ|чш|чя|пЮ|чт|ьу|сч|ъЮ|Юь|эч|пэ|АÑ...
	'UTF-8.CP1251,ISO-8859-5.UTF-8' => 'ЭР|бв|ЭШ|ЭЮ|РЭ|ЮТ|ЪЮ|вЮ|ХЭ|ЫХ|ХЫ|аР|аХ|Шб|ЯЮ|ЮЬ|аЮ|Хв|ТР|вР|Юб|вХ|ФХ|Ым|Ха|ЮЭ|вм|ЧР|бЪ|Юв|ЫШ|Рв|ЮЫ|ЮС|Ра|ЮФ|ШХ|УЮ|Яа|аШ|ЬЮ|РЬ|бÐ...

	'UTF-8.ISO-8859-5,CP1251.UTF-8' => 'эр|Ñ‘Ñ’|эш|эю|рэ|ÑŽÑ‚|ÑŠÑŽ|Ñ’ÑŽ|хэ|Ñ‹Ñ…|Ñ…Ñ‹|â„–Ñ€|â„–Ñ…|шё|яю|ÑŽÑŒ|â„–ÑŽ|Ñ…Ñ’|Ñ‚Ñ€|Ñ’Ñ€|ÑŽÑ‘|Ñ’Ñ…|Ñ„Ñ…|Ñ‹Ñœ|Ñ…â„–|юэ|Ñ’Ñœ|чр|Ñ‘ÑŠ|ÑŽÑ’|ыш|рђ|ÑŽÑ‹|юс|р№|ÑŽÑ„|шх|ую|я№|№ш|ью|Ñ...
	'UTF-8.CP866,CP1251.UTF-8'		=> 'эр|ёЄ|эш|эю|рэ|ют|ъю|Єю|хэ|ых|хы|Ёр|Ёх|шё|яю|юь|Ёю|хЄ|тр|Єр|юё|Єх|фх|ы№|хЁ|юэ|Є№|чр|ёъ|юЄ|ыш|рЄ|юы|юс|рЁ|юф|шх|ую|яЁ|Ёш|ью|рь|ёы|...
);

sub detect_enc {
	my $string = shift;

	my %variants = ();
	for my $path (sort keys %patterns) {
		$variants{$path} = () = $string =~ /$patterns{$path}/g;
	}

	my $path = scalar keys %variants ? (sort {$variants{$a} <=> $variants{$b}} keys %variants)[-1] : '';

	$path = remove_ambiguity($path, $string) if $path =~ m{\|};
	
	return make_list($path);
}

sub remove_ambiguity {
	my $paths = shift;
	my $text = shift;

	my @paths = split m{\|}, $paths;
	my %stats = ();
	for my $path (@paths) {
		$stats{$path} = () = $text =~ /$ambiguities{$path}/g;
	}

	return scalar keys %stats ? (sort {$stats{$a} <=> $stats{$b}} keys %stats)[-1] : $paths[0];
}

sub make_list {
	my $path = shift;

	my @ret;

	for my $pair (split /,/, $path) {
		my ($from, $to) = split /\./, $pair;
		push @ret, [$from, $to] unless $from eq '-';
	}

	return @ret;
}

1;

__END__

=encoding utf-8

=head1 NAME

Lingua::RU::Detect - Heuristics for guessing encoding sequence

=head1 SYNOPSIS

	use Lingua::RU::Detect "detect_enc";
	say Dumper(detect_enc("бНОПНЯ")); 
	say Dumper(detect_enc("бОДТЕК"));


=head1 ABSTRACT

Lingua::RU::Detect make a guess of how the original text was reconverted with a sequence of different encodings.

=head1 DESCRIPTION

This module is a heart of http://decodr.ru/ website which provides a tool for automatic recovering Russian texts which were damaged by multiple transcodings. Two and three item chains are now available to detect, and the speed is much higher than tha...

The result of calling C<detect_enc> subroutine is a list of encoding pairs. To get original UTF-8 string you need to make all these transcodings in the order specified in the array returned. For example:

	$VAR1 = [
		[
			'UTF-8',
			'ISO-8859-5'
		],
		[
			'KOI8-R',
			'UTF-8'
		]
	];

If no reencoding is needed, result is an empty array.