File Coverage

lib/Encode/JavaScript/Cyrillic.pm
Criterion Covered Total %
statement 42 43 97.6
branch 5 10 50.0
condition n/a
subroutine 9 9 100.0
pod n/a
total 56 62 90.3


line stmt bran cond sub pod time code
1             package Encode::JavaScript::Cyrillic;
2              
3 1     1   37413 use 5.008008;
  1         4  
  1         84  
4 1     1   6 use strict;
  1         1  
  1         35  
5 1     1   5 use warnings;
  1         7  
  1         63  
6              
7             our $VERSION = '0.01';
8              
9 1     1   5 use base 'Encode::Encoding';
  1         1  
  1         4194  
10 1     1   19298 use Encode;
  1         3  
  1         776  
11              
12             __PACKAGE__->Define('JavaScript-Cyrillic');
13              
14             # russian text escape code, for unescape: (bug : %u0410 -%u044f)
15              
16             my %codeMap = (
17             '%u0410' => 'А', '%u0411' => 'Б', '%u0412' => 'В', '%u0413' => 'Г',
18             '%u0414' => 'Д', '%u0415' => 'Е', '%u0401' => 'Ё', '%u0416' => 'Ж',
19             '%u0417' => 'З', '%u0418' => 'И', '%u0419' => 'Й', '%u041A' => 'К',
20             '%u041B' => 'Л', '%u041C' => 'М', '%u041D' => 'Н', '%u041E' => 'О',
21             '%u041F' => 'П', '%u0420' => 'Р', '%u0421' => 'С', '%u0422' => 'Т',
22             '%u0423' => 'У', '%u0424' => 'Ф', '%u0425' => 'Х', '%u0426' => 'Ц',
23             '%u0427' => 'Ч', '%u0428' => 'Ш', '%u0429' => 'Щ', '%u042A' => 'Ъ',
24             '%u042B' => 'Ы', '%u042C' => 'Ь', '%u042D' => 'Э', '%u042E' => 'Ю',
25             '%u042F' => 'Я',
26             '%u0430' => 'а', '%u0431' => 'б', '%u0432' => 'в', '%u0433' => 'г',
27             '%u0434' => 'д', '%u0435' => 'е', '%u0451' => 'ё', '%u0436' => 'ж',
28             '%u0437' => 'з', '%u0438' => 'и', '%u0439' => 'й', '%u043A' => 'к',
29             '%u043B' => 'л', '%u043C' => 'м', '%u043D' => 'н', '%u043E' => 'о',
30             '%u043F' => 'п', '%u0440' => 'р', '%u0441' => 'с', '%u0442' => 'т',
31             '%u0443' => 'у', '%u0444' => 'ф', '%u0445' => 'х', '%u0446' => 'ц',
32             '%u0447' => 'ч', '%u0448' => 'ш', '%u0449' => 'щ', '%u044A' => 'ъ',
33             '%u044B' => 'ы', '%u044C' => 'ь', '%u044D' => 'э', '%u044E' => 'ю',
34             '%u044F' => 'я'
35             );
36              
37             my %revMap = reverse %codeMap;
38              
39             sub decode($$;$){
40 1     1   38 my($obj,$buf,$chk) = @_;
41 1 50       4 $_[1] = '' if $chk;
42 1         1 my ($arr,$res);
43 1 50       6 if ( $buf =~/%u04/ ){
44 1         28 $arr = [split '%',$buf];
45            
46 1         5 shift @$arr;
47 1         3 map{$_ ='%'.$_} @$arr;
  66         90  
48 1         5 $arr = _replace($arr,\%codeMap);
49 1         6 $res = join '',@$arr;
50             }
51             else {
52 0         0 $res = $buf;
53             }
54            
55 1         6 return $res;
56             }
57              
58             sub encode($$;$){
59 1     1   446 my($obj,$buf,$chk) = @_;
60 1 50       4 $_[1] = '' if $chk;
61 1         13 my $values = join '|',values %codeMap;
62            
63 1         220 my $regexp = qr/$values/;
64            
65 1         263 $buf =~ s/($regexp)/_translateSymbols($1)/ge;
  66         140  
66            
67 1         25 return $buf;
68             }
69              
70             sub _replace($$) {
71 1     1   3 my($arrRef,$hashRef) = @_;
72 1         2 foreach (@$arrRef){
73 66 50       119 if( exists $hashRef->{$_}){
74 66         81 $_=$hashRef->{$_};
75             }
76             }
77 1         4 return $arrRef;
78             }
79              
80             sub _translateSymbols {
81 66     66   107 my $sym = shift;
82            
83 66 50       132 if( exists $revMap{$sym}){
84 66         91 $sym = $revMap{$sym};
85             }
86 66         231 return $sym;
87             }
88              
89             1;
90             __END__