File Coverage

blib/lib/Encode/Arabic/Franco.pm
Criterion Covered Total %
statement 74 74 100.0
branch 2 4 50.0
condition n/a
subroutine 10 10 100.0
pod 1 1 100.0
total 87 89 97.7


line stmt bran cond sub pod time code
1             package Encode::Arabic::Franco;
2 5     5   72825 use parent qw(Encode::Encoding);
  5         1207  
  5         21  
3 5     5   39440 use strict;
  5         8  
  5         92  
4 5     5   19 use warnings;
  5         6  
  5         96  
5 5     5   20 use utf8;
  5         4  
  5         25  
6 5     5   2025 use Lingua::AR::Tashkeel v0.004;
  5         1034862  
  5         282  
7 5     5   42 use Unicode::Normalize;
  5         8  
  5         275  
8 5     5   20 use charnames ':full';
  5         7  
  5         34  
9              
10 5     5   915 use Carp;
  5         7  
  5         835  
11              
12             __PACKAGE__->Define(qw(Franco-Arabic Arabizy));
13              
14             # ABSTRACT: Does transliteration from chat Arabic
15             our $VERSION = '0.007'; # VERSION
16              
17             sub import { # imports Encode
18 5     5   116 require Encode;
19 5 50       98 push @Encode::ISA, 'Exporter' unless Encode->can('export_to_level');
20 5         580 Encode->export_to_level(1, @_);
21             }
22              
23             sub decode($$;$){
24 44     44 1 16761 my ($obj, $orig, $chk) = @_;
25              
26 44         114 my $str = NFC $orig;
27              
28             # Alefs
29 44         4940 $str =~ s/\b[ae]l(?!e)(?=..)/ال\N{ARABIC SUKUN}/g;
30 44         97 $str =~ s/(2|\b)e(?!e)/إ\N{ARABIC KASRA}/g;
31 44         67 $str =~ s/e2a(?=h?\b)/\N{ARABIC KASRA}ئ\N{ARABIC FATHA}a/g;
32 44         48 $str =~ s/e2(?=.\b)/\N{ARABIC KASRA}ئ\N{ARABIC SUKUN}/g;
33 44         94 $str =~ s/\B2(?=e)\B/ئ\N{ARABIC KASRA}/g;
34 44         55 $str =~ s/a2a(?=.\b)/ائ\N{ARABIC FATHA}/g;
35 44         45 $str =~ s/a2e(?=.\b)/ائ\N{ARABIC KASRA}/g;
36 44         52 $str =~ s/a2[ou](?=.\b)/ائ\N{ARABIC DAMMA}/g;
37             #$str =~ s/a2\B/\N{ARABIC FATHA}أ/g;
38 44         46 $str =~ s/o2o/ؤ\N{ARABIC DAMMA}/g;
39 44         48 $str =~ s/o2/ؤ\N{ARABIC SUKUN}/g;
40 44         160 $str =~ s/\b2?[ou]/أ\N{ARABIC DAMMA}/g;
41 44         54 $str =~ s/\b2a/آ/g;
42 44         155 $str =~ s/\ba|2a|\b2/أ\N{ARABIC FATHA}/g;
43 44         78 $str =~ s/([^aoyei])2/$1ء/g;
44              
45             # Digraphs
46 44         37 $str =~ s/3'/غ/g;
47 44         50 $str =~ s/7'/خ/g;
48 44         46 $str =~ s/kh/خ/g;
49 44         42 $str =~ s/gh/غ/g;
50 44         40 $str =~ s/sh/ش/g;
51 44         53 $str =~ s/ah\b/ة/g;
52 44         42 $str =~ s/ss/ص/g;
53 44         45 $str =~ s/ee/\N{ARABIC KASRA}ي/g;
54 44         49 $str =~ s/th/ث/g;
55 44         42 $str =~ s/oo/\N{ARABIC DAMMA}و/g;
56 44         78 $str =~ s/zz|6'/ظ/g;
57              
58             # Vowelize
59             #$str =~ s/aأ|[aا]2/ائ\N{ARABIC FATHA}/g;
60 44         49 $str =~ s/2\b/ء/g;
61 44         163 $str =~ s/yأ/يئ/g;
62             #print $str if $orig =~ /
63 44         52 $str =~ s/(?=أ|)h\b/ة/g;
64 44         86 $str =~ s/ءo|2و|ء(?=\N{ARABIC DAMMA}و)/ؤ/g;
65 44         131 $str =~ s/aأ|[aا]2/\N{ARABIC FATHA}أ/g;
66 44         48 $str =~ s/(?<=ائ\N{ARABIC FATHA})a//g;
67 44         47 $str =~ s/e/\N{ARABIC KASRA}/g;
68 44         44 $str =~ s/aإ/ائ\N{ARABIC KASRA}/g;
69 44         43 $str =~ s/aإ/ائ\N{ARABIC KASRA}/g;
70             #return $str if $orig =~ /22emah/;
71 44         46 $str =~ s/(?<=أ\N{ARABIC FATHA})إ/ئ/g;
72              
73              
74             # Fix Alefs
75 44         38 $str =~ s/أإ/أئ\N{ARABIC KASRA}/g;
76             #$str =~ s/(?=.)ائ(..)/أ$1/g;
77             #$str =~ s/(?!a)ء/ئ/g;
78 44         45 $str =~ s/ئ(?=\N{ARABIC DAMMA})/ؤ/g;
79 44         38 $str =~ s/(?=ئَ)a//g;
80             #$str =~ s/\b(.)ئ(..)\b/$1أ$2/g;
81             #return $str if $orig =~ /ma2mn/;
82              
83              
84 44         38 $str =~ s/'//g;
85              
86 44         163 $str =~ tr
87             { 3 4 5 6 7 8 9 }
88             { ع ش خ ط ح غ ق };
89              
90 44         148 $str =~ tr
91             { a b c d e f g h i j k l m n o p q r s t u v w x y z }
92             { ا ب c د e ف ج ه ي ج ك ل م ن و پ ق ر س ت و ڤ و x ي ز };
93            
94 44         86 $str =~ tr
95             { , ; ? }
96             { ، ؛ ؟ };
97              
98             #$str =~ s/\w//ga; # strip untranslated characters
99              
100 44         112 $str = Lingua::AR::Tashkeel::prune($str);
101              
102 44 50       6206 $_[1] = '' if $chk;
103 44         86 return $str;
104             }
105             1;
106              
107             __END__