File Coverage

blib/lib/Regexp/Ethiopic/Amharic.pm
Criterion Covered Total %
statement 59 74 79.7
branch 9 20 45.0
condition n/a
subroutine 8 9 88.8
pod 0 2 0.0
total 76 105 72.3


line stmt bran cond sub pod time code
1             package Regexp::Ethiopic::Amharic;
2 1     1   57071 use base qw(Regexp::Ethiopic); # this might be more useful later,
  1         3  
  1         668  
3             # we at least get "Exporter" for free.
4              
5 1     1   9 use utf8;
  1         1  
  1         6  
6             BEGIN
7             {
8 1     1   23 use strict;
  1         2  
  1         31  
9 1     1   5 use vars qw($VERSION @EXPORT_OK %AmharicEquivalence %AmharicClassEquivalence);
  1         1  
  1         771  
10              
11              
12 1     1   2 $VERSION = "0.05";
13            
14 1         3 @EXPORT_OK = qw(%AmharicEquivalence %AmharicClassEquivalence);
15              
16              
17             #
18             # Amharic Rules Orthography Equivalence
19             #
20 1         21 %AmharicEquivalence =(
21             ሀ => "ሀሃሐሓኀኃኻ",
22             ሁ => "ሁሑኁኹ",
23             ሂ => "ሂሒኂኺ",
24             ሄ => "ሄሔኄኼ",
25             ህ => "ህሕኅኽ",
26             ሆ => "ሆሖኆኈኾዀ",
27              
28             ኋ => "ሗኋዃ",
29              
30             ሰ => "ሰሠ",
31             ሱ => "ሱሡ",
32             ሲ => "ሲሢ",
33             ሳ => "ሳሣ",
34             ሴ => "ሴሤ",
35             ስ => "ስሥ",
36             ሶ => "ሶሦ",
37             ሷ => "ሷሧ",
38              
39             ቁ => "ቁቍ",
40             ቆ => "ቆቈ",
41              
42             አ => "አዓዐኣ",
43             ኡ => "ኡዑ",
44             ኢ => "ኢዒ",
45             ኤ => "ኤዔ",
46             እ => "እዕ",
47             ኦ => "ኦዖ",
48              
49             ኮ => "ኮኰ",
50             ጎ => "ጎጐ",
51              
52             ጸ => "ጸፀ",
53             ጹ => "ጹፁ",
54             ጺ => "ጺፂ",
55             ጻ => "ጻፃ",
56             ጼ => "ጼፄ",
57             ጽ => "ጽፅ",
58             ጾ => "ጾፆ",
59             );
60              
61 1         3 foreach (ord('ሀ')..ord('ሆ')) {
62 7         10 my $key = chr($_);
63             # print "KEY $key / $AmharicEquivalence{$key}\n";
64 7 100       17 next if ( $key eq 'ሃ' );
65 6         19 my @values = split (//, $AmharicEquivalence{$key});
66 6         10 foreach (@values) {
67             # print " VALUE: $_\n";
68 29         55 $AmharicEquivalence{$_}
69             = $AmharicEquivalence{$key}
70             ;
71             }
72             }
73 1         4 $AmharicEquivalence{'ሗ'}
74             = $AmharicEquivalence{'ዃ'}
75             = $AmharicEquivalence{'ኋ'}
76             ;
77 1         2 foreach (ord('ሰ')..ord('ሷ')) {
78 8         9 my $key = chr($_);
79 8         25 $AmharicEquivalence{$key} =~ /(\w)$/;
80 8         23 $AmharicEquivalence{$1}
81             = $AmharicEquivalence{$key}
82             ;
83             }
84 1         3 $AmharicEquivalence{'ቍ'}
85             = $AmharicEquivalence{'ቁ'}
86             ;
87 1         2 $AmharicEquivalence{'ቈ'}
88             = $AmharicEquivalence{'ቆ'}
89             ;
90 1         2 $AmharicEquivalence{'ኰ'}
91             = $AmharicEquivalence{'ኮ'}
92             ;
93 1         2 $AmharicEquivalence{'ጐ'}
94             = $AmharicEquivalence{'ጎ'}
95             ;
96 1         2 foreach (ord('አ')..ord('ኦ')) {
97 7         10 my $key = chr($_);
98 7 100       13 next if ( $key eq 'ኣ' );
99 6         12 my @values = split (//, $AmharicEquivalence{$key});
100 6         10 foreach (@values) {
101 14         25 $AmharicEquivalence{$_}
102             = $AmharicEquivalence{$key}
103             ;
104             }
105             }
106 1         2 foreach (ord('ጸ')..ord('ጾ')) {
107 7         8 my $key = chr($_);
108 7         21 $AmharicEquivalence{$key} =~ /(\w)$/;
109 7         20 $AmharicEquivalence{$1}
110             = $AmharicEquivalence{$key}
111             ;
112             }
113              
114              
115             #
116             # Family Eqivalence
117             #
118             %AmharicClassEquivalence =(
119 1         4 ሀ => "ሀ-ሆሐ-ሗኀ-ኆኈ-ኍኸ-ኾዀ-ዅ",
120             ሰ => "ሰ-ሷሠ-ሧ",
121             አ => "አ-ኧዐ-ዖ",
122             ጸ => "ጸ-ጿፀ-ፆ"
123             );
124 1         2 $AmharicClassEquivalence{'ሐ'}
125             = $AmharicClassEquivalence{'ኀ'}
126             = $AmharicClassEquivalence{'ኸ'}
127             = $AmharicClassEquivalence{'ሀ'}
128             ;
129 1         3 $AmharicClassEquivalence{'ሠ'}
130             = $AmharicClassEquivalence{'ሰ'}
131             ;
132 1         1 $AmharicClassEquivalence{'ዐ'}
133             = $AmharicClassEquivalence{'አ'}
134             ;
135 1         66 $AmharicClassEquivalence{'ፀ'}
136             = $AmharicClassEquivalence{'ጸ'}
137             ;
138             }
139              
140              
141             sub import
142             {
143              
144 1     1   7 my @args = ( shift ); # package
145 1         3 foreach (@_) {
146 1 50       12 if ( /overload/o ) {
    0          
147 1     1   7 use overload;
  1         1  
  1         10  
148 1         16 overload::constant 'qr' => \&getRe;
149             }
150             elsif ( /EthiopicClasses|(sub|[gs]et)Form|:forms|:utils/ ) {
151 0         0 Regexp::Ethiopic->export_to_level (1, "Regexp::Ethiopic", $_);
152             }
153             else {
154 0         0 push (@args, $_);
155             }
156             }
157 1 50       60 if ($#args) {
158 0         0 Regexp::Ethiopic::Amharic->export_to_level (1, @args);
159             }
160              
161             }
162              
163              
164             #
165             # move into Regexp::Ethiopic later...
166             #
167             sub getFamilyEquivalent
168             {
169 0     0 0 0 my ($chars) = @_;
170              
171              
172 0 0       0 return $chars if ( length($chars) == 1 );
173              
174 0         0 $chars =~ s/(\w)(?=\w)/$1,/og;
175 0         0 my @Chars = split ( /,/, $chars );
176 0         0 my $return;
177 0         0 foreach (@Chars) {
178 0         0 $char = $_;
179 0         0 foreach ( keys %AmharicClassEquivalence ) {
180 0 0       0 $return .= $_ if ( $AmharicClassEquivalence{$char} eq $AmharicClassEquivalence{$_} );
181             }
182             }
183              
184 0         0 $return;
185             }
186              
187              
188             sub getRe
189             {
190 7 100   7 0 5629 $_ = ($#_) ? $_[1] : $_[0];
191              
192              
193 7 50       24 s/\[=(\p{Ethiopic})=\]/($AmharicEquivalence{$1}) ? "[$AmharicEquivalence{$1}]" : $1/eog;
  9         163  
194 7 0       52 s/\[=#(\p{Ethiopic})#=\]/($AmharicClassEquivalence{$1}) ? "[$AmharicClassEquivalence{$1}]" : $1/eog;
  0         0  
195 7         22 s/\[=#([\p{Ethiopic}]+)#=\]/Regexp::Ethiopic::setRange(getFamilyEquivalent($1),"all")/eog;
  0         0  
196              
197 7         36 Regexp::Ethiopic::getRe ( $_ );
198             }
199              
200              
201              
202             #########################################################
203             # Do not change this, Do not put anything below this.
204             # File must return "true" value at termination
205             1;
206             ##########################################################
207              
208              
209             __END__