File Coverage

blib/lib/Encode/Arabic/ArabTeX/Verbatim.pm
Criterion Covered Total %
statement 131 201 65.1
branch 62 124 50.0
condition 4 17 23.5
subroutine 18 19 94.7
pod 2 5 40.0
total 217 366 59.2


line stmt bran cond sub pod time code
1             # ##################################################################### Otakar Smrz, 2005/07/16
2             #
3             # Encoding of Arabic: ArabTeX Notation by Klaus Lagally, Verbatim #############################
4              
5             package Encode::Arabic::ArabTeX::Verbatim;
6              
7             our $VERSION = '14.1';
8              
9 2     2   18244 use 5.008;
  2         7  
  2         98  
10              
11 2     2   15 use strict;
  2         3  
  2         93  
12 2     2   14 use warnings;
  2         3  
  2         112  
13              
14 2     2   14 use Carp;
  2         3  
  2         190  
15              
16 2     2   736 use Encode::Arabic::ArabTeX ();
  2         4  
  2         61  
17 2     2   15 use base 'Encode::Arabic::ArabTeX';
  2         3  
  2         233  
18              
19              
20 2     2   15 use Encode::Encoding;
  2         3  
  2         52  
21 2     2   11 use base 'Encode::Encoding';
  2         4  
  2         113  
22              
23             __PACKAGE__->Define('ArabTeX-Verbatim', 'ArabTeX-Verb');
24              
25              
26 2     2   22 use Encode::Mapper ':others', ':silent', ':join';
  2         3  
  2         18  
27              
28              
29             our %options; # records of options per package .. global register
30             our %option; # options of the caller package .. used with local
31              
32             our $enmode;
33             our $demode;
34              
35             our $enlevel = 2;
36             our $delevel = 3;
37              
38             our %modemap = (
39              
40             'default' => 3,
41             'undef' => 0,
42              
43             'fullvocalize' => 4,
44             'full' => 4,
45              
46             'vocalize' => 3,
47             'nosukuun' => 3,
48              
49             'novocalize' => 2,
50             'novowels' => 2,
51             'none' => 2,
52              
53             'noshadda' => 1,
54             'noneplus' => 1,
55             );
56              
57              
58             sub import { # perform import as if Encode were used one level before this module
59              
60 2 100 66 2   27 if (defined $_[1] and $_[1] eq ':xml') { # interfere little with possible Encode's options
61              
62 254         277 Encode::Mapper->options (
63              
64             'override' => [ # override rules of these LHS .. no other tricks ^^
65              
66             ( # combinations of '<' and '>' with the other bytes
67             map {
68              
69 1         8 my $x = chr $_;
70              
71 254         1344 "<" . $x, [ "<" . $x, ">" ], # propagate the '>' sign implying ..
72             ">" . $x, [ $x, ">" ], # .. preservation of the bytes
73              
74             } 0x00 .. 0x3B, 0x3D, 0x3F .. 0xFF
75             ),
76              
77             ">>", ">", # stop the whole process ..
78             "<>", "<>", # .. do not even start it
79              
80             "><", [ "<", ">" ], # rather than nested '<' and '>', ..
81             "<<", [ "<<", ">" ],
82              
83             ">\\<", [ "<", ">" ], # .. prefer these escape sequences
84             ">\\\\", [ "\\", ">" ],
85             ">\\>", [ ">", ">" ],
86              
87             ">", ">", # singular symbols may migrate right ..
88             "<", "<", # .. or preserve the rest of the data
89             ]
90              
91             );
92              
93 1         100 splice @_, 1, 1;
94             }
95              
96 2 50 33     17 if (defined $_[1] and $_[1] eq ':complex') {
97              
98 0         0 __PACKAGE__->options($_[1]);
99 0         0 splice @_, 1, 1;
100             }
101              
102 2 50 33     11 if (defined $_[1] and $_[1] eq ':describe') {
103              
104 0         0 __PACKAGE__->options($_[1]);
105 0         0 splice @_, 1, 1;
106             }
107              
108 2         20 require Encode;
109              
110 2 100       48 push @Encode::ISA, 'Exporter' unless Encode->can('export_to_level');
111              
112 2         362 Encode->export_to_level(1, @_);
113             }
114              
115              
116             sub options ($%) {
117 0     0 0 0 my $cls = shift @_;
118 0         0 my ($i, $opt, %opt);
119              
120 0         0 my @returns = %option;
121              
122 0 0       0 $opt{'non-quoting'} = 0 unless defined $option{'non-quoting'};
123 0 0       0 $opt{'non-refined'} = 1 unless defined $option{'non-refined'};
124              
125 0         0 while (@_) {
126              
127 0         0 $opt = lc shift @_;
128              
129 0 0       0 if ($opt =~ /^\:/) {
130              
131 0 0 0     0 $opt eq ':complex' and $opt{'non-quoting'} = 0, 1 and $opt{'non-refined'} = 0, 1 and next;
      0        
132 0 0 0     0 $opt eq ':describe' and $opt{'describe'} = 1 and next;
133             }
134             else {
135              
136 0         0 $opt =~ /^\-*(.*)$/;
137 0         0 $opt{$1} = shift @_;
138             }
139             }
140              
141 0 0       0 return %opt unless defined $cls;
142              
143 0         0 $option{$_} = $opt{$_} foreach keys %opt;
144              
145 0         0 return @returns;
146             }
147              
148              
149             sub encoder ($;%) {
150 1     1 1 1310 my ($cls, %opt) = @_;
151              
152 1         2 my $encoder = [];
153              
154              
155 10         36 $encoder->[0] = Encode::Mapper->compile (
156              
157             [
158             'silent' => 0,
159             ],
160              
161             (
162             map {
163              
164 1         4 chr 0x0660 + $_, "" . $_,
165              
166             } 0 .. 9
167             ),
168              
169             "\x{064B}", "aN", # 240 "\xF0", # "\xD9\x8B"
170             "\x{064C}", "uN", # 241 "\xF1", # "\xD9\x8C"
171             "\x{064D}", "iN", # 242 "\xF2", # "\xD9\x8D"
172             "\x{064E}", "a", # 243 "\xF3", # "\xD9\x8E"
173             "\x{064F}", "u", # 245 "\xF5", # "\xD9\x8F"
174             "\x{0650}", "i", # 246 "\xF6", # "\xD9\x90"
175             "\x{0670}", "_a",
176             "\x{0657}", "_u",
177             "\x{0656}", "_i",
178              
179             "\x{060C}", ",", # 161 "\xA1", # "\xD8\x8C" right-to-left-comma
180             "\x{061B}", ";", # 186 "\xBA", # "\xD8\x9B" right-to-left-semicolon
181             "\x{061F}", "?", # 191 "\xBF", # "\xD8\x9F" right-to-left-question-mark
182             "\x{0621}", "'|", # 193 "\xC1", # "\xD8\xA1" hamza-on-the-line
183             "\x{0622}", "'A", # 194 "\xC2", # "\xD8\xA2" madda-over-'alif
184             "\x{0623}", "'a", # 195 "\xC3", # "\xD8\xA3" hamza-over-'alif
185             "\x{0624}", "'w", # 196 "\xC4", # "\xD8\xA4" hamza-over-waaw
186             "\x{0625}", "'i", # 197 "\xC5", # "\xD8\xA5" hamza-under-'alif
187             "\x{0626}", "'y", # 198 "\xC6", # "\xD8\xA6" hamza-over-yaa'
188             "\x{0627}", "A", # 199 "\xC7", # "\xD8\xA7" bare 'alif
189             "\x{0628}", "b", # 200 "\xC8", # "\xD8\xA8"
190             "\x{0629}", "T", # 201 "\xC9", # "\xD8\xA9"
191             "\x{062A}", "t", # 202 "\xCA", # "\xD8\xAA"
192             "\x{062B}", "_t", # 203 "\xCB", # "\xD8\xAB" <_t>
193             "\x{062C}", "^g", # 204 "\xCC", # "\xD8\xAC" <^g>
194             "\x{062D}", ".h", # 205 "\xCD", # "\xD8\xAD" <.h>
195             "\x{062E}", "_h", # 206 "\xCE", # "\xD8\xAE" <_h>
196             "\x{062F}", "d", # 207 "\xCF", # "\xD8\xAF"
197             "\x{0630}", "_d", # 208 "\xD0", # "\xD8\xB0" <_d>
198             "\x{0631}", "r", # 209 "\xD1", # "\xD8\xB1"
199             "\x{0632}", "z", # 210 "\xD2", # "\xD8\xB2"
200             "\x{0633}", "s", # 211 "\xD3", # "\xD8\xB3"
201             "\x{0634}", "^s", # 212 "\xD4", # "\xD8\xB4" <^s>
202             "\x{0635}", ".s", # 213 "\xD5", # "\xD8\xB5" <.s>
203             "\x{0636}", ".d", # 214 "\xD6", # "\xD8\xB6" <.d>
204             "\x{0637}", ".t", # 216 "\xD8", # "\xD8\xB7" <.t>
205             "\x{0638}", ".z", # 217 "\xD9", # "\xD8\xB8" <.z>
206             "\x{0639}", "`", # 218 "\xDA", # "\xD8\xB9" <`>
207             "\x{063A}", ".g", # 219 "\xDB", # "\xD8\xBA" <.g>
208             "\x{0640}", "--", # 220 "\xDC", # "\xD9\x80" ta.twiil
209             "\x{0641}", "f", # 221 "\xDD", # "\xD9\x81"
210             "\x{0642}", "q", # 222 "\xDE", # "\xD9\x82"
211             "\x{0643}", "k", # 223 "\xDF", # "\xD9\x83"
212             "\x{0644}", "l", # 225 "\xE1", # "\xD9\x84"
213             "\x{0645}", "m", # 227 "\xE3", # "\xD9\x85"
214             "\x{0646}", "n", # 228 "\xE4", # "\xD9\x86"
215             "\x{0647}", "h", # 229 "\xE5", # "\xD9\x87"
216             "\x{0648}", "w", # 230 "\xE6", # "\xD9\x88"
217             "\x{0649}", "Y", # 236 "\xEC", # "\xD9\x89" 'alif maq.suura
218             "\x{064A}", "y", # 237 "\xED", # "\xD9\x8A"
219             "\x{0651}", "||", # 248 "\xF8", # "\xD9\x91" ^sadda
220             "\x{0652}", "\"", # 250 "\xFA", # "\xD9\x92" sukuun
221             "\x{0671}", "A", # 199 "\xC7", # "\xD9\xB1" wa.sla-on-'alif
222              
223             "\x{067E}", "p",
224             "\x{06A4}", "v",
225             "\x{06AF}", "g",
226              
227             "\x{0681}", "c",
228             "\x{0686}", "^c",
229             "\x{0685}", ",c",
230             "\x{0698}", "^z",
231             "\x{06AD}", "^n",
232             "\x{06B5}", "^l",
233             "\x{0695}", ".r",
234              
235             "\x{0640}\x{0651}", "|BB",
236              
237             );
238              
239              
240 2     2   18 no strict 'refs';
  2         3  
  2         20391  
241              
242 1         5 ${ $cls . '::encoder' } = $encoder;
  1         7  
243              
244 1 50       3 if ($option{'describe'}) {
245              
246 0         0 $_->describe('') foreach @{${ $cls . '::encoder' }};
  0         0  
  0         0  
247             }
248              
249 1 50       1 $cls->enmode(defined ${ $cls . '::enmode' } ? ${ $cls . '::enmode' } : 'default');
  1         14  
  0         0  
250              
251 1         1 return ${ $cls . '::encoder' };
  1         5  
252             }
253              
254              
255             sub decoder ($;$$) {
256 1     1 1 6 my ($cls, undef, undef) = @_;
257              
258 1         2 my $decoder = [];
259              
260              
261 1         12 my @sunny = (
262             [ "t", "\x{062A}" ], # "\xD8\xAA"
263             [ "_t", "\x{062B}" ], # "\xD8\xAB" <_t>
264             [ "d", "\x{062F}" ], # "\xD8\xAF"
265             [ "_d", "\x{0630}" ], # "\xD8\xB0" <_d>
266             [ "r", "\x{0631}" ], # "\xD8\xB1"
267             [ "z", "\x{0632}" ], # "\xD8\xB2"
268             [ "s", "\x{0633}" ], # "\xD8\xB3"
269             [ "^s", "\x{0634}" ], # "\xD8\xB4" <^s>
270             [ ".s", "\x{0635}" ], # "\xD8\xB5" <.s>
271             [ ".d", "\x{0636}" ], # "\xD8\xB6" <.d>
272             [ ".t", "\x{0637}" ], # "\xD8\xB7" <.t>
273             [ ".z", "\x{0638}" ], # "\xD8\xB8" <.z>
274             [ "l", "\x{0644}" ], # "\xD9\x84"
275             [ "n", "\x{0646}" ], # "\xD9\x86"
276             );
277              
278              
279 1         3 my @empty = (
280             [ "|", "" ], # ArabTeX's "invisible consonant"
281             [ "", "\x{0627}" ], # "\xD8\xA7" bare 'alif
282             );
283              
284              
285 1         4 my @taaaa = (
286             [ "T", "\x{0629}" ], # "\xD8\xA9"
287             [ "H", "\x{0629}" ], # "\xD8\xA9"
288             );
289              
290              
291 1         20 my @moony = (
292             [ "'A", "\x{0622}" ], # "\xD8\xA2" madda-over-'alif
293             [ "'a", "\x{0623}" ], # "\xD8\xA3" hamza-over-'alif
294             [ "'i", "\x{0625}" ], # "\xD8\xA5" hamza-under-'alif
295             [ "'w", "\x{0624}" ], # "\xD8\xA4" hamza-over-waaw
296             [ "'y", "\x{0626}" ], # "\xD8\xA6" hamza-over-yaa'
297             [ "'|", "\x{0621}" ], # "\xD8\xA1" hamza-on-the-line
298             [ "b", "\x{0628}" ], # "\xD8\xA8"
299             [ "^g", "\x{062C}" ], # "\xD8\xAC" <^g>
300             [ ".h", "\x{062D}" ], # "\xD8\xAD" <.h>
301             [ "_h", "\x{062E}" ], # "\xD8\xAE" <_h>
302             [ "`", "\x{0639}" ], # "\xD8\xB9" <`>
303             [ ".g", "\x{063A}" ], # "\xD8\xBA" <.g>
304             [ "f", "\x{0641}" ], # "\xD9\x81"
305             [ "q", "\x{0642}" ], # "\xD9\x82"
306             [ "k", "\x{0643}" ], # "\xD9\x83"
307             [ "m", "\x{0645}" ], # "\xD9\x85"
308             [ "h", "\x{0647}" ], # "\xD9\x87"
309             [ "w", "\x{0648}" ], # "\xD9\x88"
310             [ "y", "\x{064A}" ], # "\xD9\x8A"
311              
312             [ "B", "\x{0640}" ], # ArabTeX's "consonantal ta.twiil"
313              
314             [ "p", "\x{067E}" ],
315             [ "v", "\x{06A4}" ],
316             [ "g", "\x{06AF}" ],
317              
318             [ "c", "\x{0681}" ], # .ha with hamza
319             [ "^c", "\x{0686}" ], # gim with three
320             [ ",c", "\x{0685}" ], # _ha with three
321             [ "^z", "\x{0698}" ], # zay with three
322             [ "^n", "\x{06AD}" ], # kaf with three
323             [ "^l", "\x{06B5}" ], # lam with a bow above
324             [ ".r", "\x{0695}" ], # ra' with a bow below
325             );
326              
327              
328 1         9 my @scope = (
329             "b", "t", "_t", "^g", ".h", "_h", "d", "_d", "r", "z", "s", "^s", ".s",
330             ".d", ".t", ".z", "`", ".g", "f", "q", "k", "l", "m", "n", "h", "w",
331             "p", "v", "g", "c", "^c", ",c", "^z", "^n", "^l", ".r", "|", "B",
332             # "'", "y" treated specifically in some cases -- "T", "H" must as well
333             );
334              
335              
336 40 50       251 $decoder->[0] = Encode::Mapper->compile (
337              
338             [
339             'silent' => 0,
340             ],
341              
342             "_A", [ "", "Y" ],
343             "_U", [ "", "U" ],
344             "WA", [ "", "W" ],
345              
346             # word-internal occurrence
347              
348             "TA", [ "t", "A" ],
349             "TU", [ "t", "U" ],
350             "TI", [ "t", "I" ],
351             "TY", [ "t", "Y" ],
352              
353             "T_A", [ "t", "_A" ],
354             "T_U", [ "t", "_U" ],
355              
356             (
357             map {
358              
359 63         108 "T" . $_, [ "t", $_ ],
360              
361             "Ta" . $_, [ "t", "a" . $_ ],
362             "Tu" . $_, [ "t", "u" . $_ ],
363             "Ti" . $_, [ "t", "i" . $_ ],
364              
365             ( $option{'non-quoting'} ? () : (
366              
367             "T\"" . $_, [ "t", "\"" . $_ ],
368              
369             "T\"a" . $_, [ "t", "\"a" . $_ ],
370             "T\"u" . $_, [ "t", "\"u" . $_ ],
371             "T\"i" . $_, [ "t", "\"i" . $_ ],
372              
373             ) ),
374              
375             } "'", @scope, "y" # "T", "H"
376             ),
377              
378             # vowel-quoted sequences
379              
380             ( $option{'non-quoting'} ? (
381              
382             "\"", "", # use non-quoting quotes only on no purpose ^^
383              
384             ) : (
385              
386             "\"", "\"",
387              
388             ) ),
389              
390             # general non-protection of \TeX directives
391             (
392             map {
393              
394 4         39 "\\cap" . $_, [ "\\", "cap" . $_ ],
395              
396             } 'A' .. 'Z', 'a' .. 'z', '_', '0' .. '9'
397             ),
398              
399             "\\", "\\",
400              
401             # strict \cap removal and white-space collapsing
402             (
403             map {
404              
405 1 50       11 "\\cap" . $_ . "\x09", [ "", "\\cap " ],
406             "\\cap" . $_ . "\x0A", [ "", "\\cap " ],
407             "\\cap" . $_ . "\x0D", [ "", "\\cap " ],
408             "\\cap" . $_ . "\x20", [ "", "\\cap " ],
409              
410             "\\cap" . $_, "",
411              
412             } "\x09", "\x0A", "\x0D", "\x20"
413             ),
414              
415             "\\cap", "",
416              
417             # interfering rarely with the notation, or erroneous
418              
419             "^A", [ "^A", "|" ],
420             "^I", [ "^I", "|" ],
421             "^U", [ "^U", "|" ],
422              
423             "_a", [ "_a", "|" ],
424             "_i", [ "_i", "|" ],
425             "_u", [ "_u", "|" ],
426              
427             "_aA", [ "_aA", "|" ],
428             "_aY", [ "_aY", "|" ],
429             "_aU", [ "_aU", "|" ],
430             "_aI", [ "_aI", "|" ],
431              
432             );
433              
434              
435 10         20 $decoder->[1] = Encode::Mapper->compile (
436              
437             [
438             'others' => undef,
439             'silent' => 0,
440             ],
441              
442             # non-exciting entities
443              
444             "\x09", "\x09",
445             "\x0A", "\x0A",
446             "\x0D", "\x0D",
447              
448             " ", " ",
449             ".", ".",
450             ":", ":",
451             "!", "!",
452              
453             "/", "/",
454             "\\", "\\",
455              
456             ",", "\x{060C}", # "\xD8\x8C" right-to-left-comma
457             ";", "\x{061B}", # "\xD8\x9B" right-to-left-semicolon
458             "?", "\x{061F}", # "\xD8\x9F" right-to-left-question-mark
459              
460             "--", "\x{0640}", # "\xD9\x80" ta.twiil
461              
462             (
463             map {
464              
465 1         2 "" . $_, chr 0x0660 + $_,
466              
467             } 0 .. 9
468             ),
469              
470             # improper auxiliary vowels
471              
472             "-a", "",
473             "-u", "",
474             "-i", "",
475              
476             # explicit notations for ^sadda
477              
478             "||", [ "\x{0651}", "|" ],
479             "|BB", [ "\x{0640}\x{0651}", "|" ],
480              
481             # non-voweled/sukuuned sunnies and moonies
482             (
483             map {
484              
485 1         7 my $x = 1 + $_;
486 1         3 my $y = "\x{0651}" x $_; # "\xD9\x91" ^sadda
487              
488 44         56 map {
489              
490 1         5 my $fix = $_;
491              
492 2068 50       45586 $_->[0] x $x, $_->[1] . $y . "\x{0652}", # "\xD9\x92" sukuun
    50          
493              
494             ( $option{'non-refined'} ? () : (
495              
496             $_->[0] x $x . "-a", $_->[1] . $y . "\x{064E}",
497             $_->[0] x $x . "-u", $_->[1] . $y . "\x{064F}",
498             $_->[0] x $x . "-i", $_->[1] . $y . "\x{0650}",
499              
500             $_->[0] x $x . "-A", $_->[1] . $y . "\x{064E}\x{0627}",
501             $_->[0] x $x . "-Y", $_->[1] . $y . "\x{064E}\x{0649}",
502              
503             $_->[0] x $x . "-U", $_->[1] . $y . "\x{064F}\x{0648}",
504             $_->[0] x $x . "-I", $_->[1] . $y . "\x{0650}\x{064A}",
505              
506             $_->[0] x $x . "-aN", $_->[1] . $y . "\x{064B}" . ( $_->[0] eq "'a" ? "" : "\x{0627}" ),
507             $_->[0] x $x . "-uN", $_->[1] . $y . "\x{064C}",
508             $_->[0] x $x . "-iN", $_->[1] . $y . "\x{064D}",
509              
510             $_->[0] x $x . "-aNA", $_->[1] . $y . "\x{064B}\x{0627}",
511             $_->[0] x $x . "-uNA", $_->[1] . $y . "\x{064C}\x{0627}",
512             $_->[0] x $x . "-iNA", $_->[1] . $y . "\x{064D}\x{0627}",
513              
514             $_->[0] x $x . "-aNY", $_->[1] . $y . "\x{064B}\x{0649}",
515             $_->[0] x $x . "-uNY", $_->[1] . $y . "\x{064C}\x{0649}",
516             $_->[0] x $x . "-iNY", $_->[1] . $y . "\x{064D}\x{0649}",
517              
518             $_->[0] x $x . "-aNU", $_->[1] . $y . "\x{064B}\x{0648}",
519             $_->[0] x $x . "-uNU", $_->[1] . $y . "\x{064C}\x{0648}",
520             $_->[0] x $x . "-iNU", $_->[1] . $y . "\x{064D}\x{0648}",
521              
522             ) ),
523              
524             ( $option{'non-quoting'} ? () : (
525              
526             $_->[0] x $x . "\"", $_->[1] . $y . "\"\x{0652}", # "\xD9\x92" sukuun
527              
528             ( $option{'non-refined'} ? () : (
529              
530             $_->[0] x $x . "-\"a", $_->[1] . $y . "\"\x{064E}",
531             $_->[0] x $x . "-\"u", $_->[1] . $y . "\"\x{064F}",
532             $_->[0] x $x . "-\"i", $_->[1] . $y . "\"\x{0650}",
533              
534             $_->[0] x $x . "-\"A", $_->[1] . $y . "\"\x{064E}\x{0627}",
535             $_->[0] x $x . "-\"Y", $_->[1] . $y . "\"\x{064E}\x{0649}",
536              
537             $_->[0] x $x . "-\"U", $_->[1] . $y . "\"\x{064F}\x{0648}",
538             $_->[0] x $x . "-\"I", $_->[1] . $y . "\"\x{0650}\x{064A}",
539              
540             $_->[0] x $x . "-\"aN", $_->[1] . $y . "\"\x{064B}" . ( $_->[0] eq "'a" ? "" : "\x{0627}" ),
541             $_->[0] x $x . "-\"uN", $_->[1] . $y . "\"\x{064C}",
542             $_->[0] x $x . "-\"iN", $_->[1] . $y . "\"\x{064D}",
543              
544             $_->[0] x $x . "-\"aNA", $_->[1] . $y . "\"\x{064B}\x{0627}",
545             $_->[0] x $x . "-\"uNA", $_->[1] . $y . "\"\x{064C}\x{0627}",
546             $_->[0] x $x . "-\"iNA", $_->[1] . $y . "\"\x{064D}\x{0627}",
547              
548             $_->[0] x $x . "-\"aNY", $_->[1] . $y . "\"\x{064B}\x{0649}",
549             $_->[0] x $x . "-\"uNY", $_->[1] . $y . "\"\x{064C}\x{0649}",
550             $_->[0] x $x . "-\"iNY", $_->[1] . $y . "\"\x{064D}\x{0649}",
551              
552             $_->[0] x $x . "-\"aNU", $_->[1] . $y . "\"\x{064B}\x{0648}",
553             $_->[0] x $x . "-\"uNU", $_->[1] . $y . "\"\x{064C}\x{0648}",
554             $_->[0] x $x . "-\"iNU", $_->[1] . $y . "\"\x{064D}\x{0648}",
555              
556             ) ),
557              
558             ) ),
559              
560             map {
561              
562 44 100       1064 ( $option{'non-refined'} ? () : (
    50          
    100          
    50          
    50          
563              
564             $fix->[0] x $x . "-a" . $_->[0], [ $fix->[1] . $y . "\x{0652}", "a" . $_->[0] ],
565             $fix->[0] x $x . "-u" . $_->[0], [ $fix->[1] . $y . "\x{0652}", "u" . $_->[0] ],
566             $fix->[0] x $x . "-i" . $_->[0], [ $fix->[1] . $y . "\x{0652}", "i" . $_->[0] ],
567              
568             $fix->[0] x $x . "-A" . $_->[0], [ $fix->[1] . $y . "\x{0652}", "A" . $_->[0] ],
569             $fix->[0] x $x . "-Y" . $_->[0], [ $fix->[1] . $y . "\x{0652}", "Y" . $_->[0] ],
570              
571             $fix->[0] x $x . "-U" . $_->[0], [ $fix->[1] . $y . "\x{0652}", "U" . $_->[0] ],
572             $fix->[0] x $x . "-I" . $_->[0], [ $fix->[1] . $y . "\x{0652}", "I" . $_->[0] ],
573              
574             ( $option{'non-quoting'} ? () : (
575              
576             $fix->[0] x $x . "-\"a" . $_->[0], [ $fix->[1] . $y . "\x{0652}\"", "a" . $_->[0] ],
577             $fix->[0] x $x . "-\"u" . $_->[0], [ $fix->[1] . $y . "\x{0652}\"", "u" . $_->[0] ],
578             $fix->[0] x $x . "-\"i" . $_->[0], [ $fix->[1] . $y . "\x{0652}\"", "i" . $_->[0] ],
579              
580             $fix->[0] x $x . "-\"A" . $_->[0], [ $fix->[1] . $y . "\x{0652}\"", "A" . $_->[0] ],
581             $fix->[0] x $x . "-\"Y" . $_->[0], [ $fix->[1] . $y . "\x{0652}\"", "Y" . $_->[0] ],
582              
583             $fix->[0] x $x . "-\"U" . $_->[0], [ $fix->[1] . $y . "\x{0652}\"", "U" . $_->[0] ],
584             $fix->[0] x $x . "-\"I" . $_->[0], [ $fix->[1] . $y . "\x{0652}\"", "I" . $_->[0] ],
585              
586             ) ),
587              
588             ) ),
589              
590             } @sunny, @moony, @taaaa, $empty[0]
591              
592             } @sunny, @moony[1 .. $#moony], $empty[0] # $moony[0] excluded as long as is unclear ^^
593              
594             } 0 # 1
595             ),
596              
597             $moony[0]->[0], $moony[0]->[1], # now necessary of course ^^
598              
599             # voweled/non-sukuuned sunnies and moonies
600             (
601             map {
602              
603 1         4 my $x = 1 + $_;
604 1         4 my $y = "\x{0651}" x $_; # "\xD9\x91" ^sadda
605              
606 45         46 map {
607              
608 1         4 my $fix = $_;
609              
610 630 50       5405 $_->[0] x $x . "a", $_->[1] . $y . "\x{064E}",
611             $_->[0] x $x . "u", $_->[1] . $y . "\x{064F}",
612             $_->[0] x $x . "i", $_->[1] . $y . "\x{0650}",
613              
614             $_->[0] x $x . "_a", $_->[1] . $y . "\x{0670}",
615              
616             ( $option{'non-refined'} ? () : (
617              
618             $_->[0] x $x . "_u", $_->[1] . $y . "\x{0657}",
619             $_->[0] x $x . "_i", $_->[1] . $y . "\x{0656}",
620              
621             $_->[0] x $x . "_aA", $_->[1] . $y . "\x{0670}\x{0627}",
622             $_->[0] x $x . "_aY", $_->[1] . $y . "\x{0670}\x{0649}",
623             $_->[0] x $x . "_aU", $_->[1] . $y . "\x{0670}\x{0648}",
624             $_->[0] x $x . "_aI", $_->[1] . $y . "\x{0670}\x{064A}",
625              
626             ) ),
627              
628             $_->[0] x $x . "A", $_->[1] . $y . "\x{064E}\x{0627}",
629             $_->[0] x $x . "Y", $_->[1] . $y . "\x{064E}\x{0649}",
630              
631             $_->[0] x $x . "U", $_->[1] . $y . "\x{064F}\x{0648}",
632             $_->[0] x $x . "I", $_->[1] . $y . "\x{0650}\x{064A}",
633              
634             $_->[0] x $x . "Uw", [ $_->[1] . $y . "\x{064F}", "ww" ],
635             $_->[0] x $x . "Iy", [ $_->[1] . $y . "\x{0650}", "yy" ],
636              
637             ( $option{'non-refined'} ? () : (
638              
639             $_->[0] x $x . "^A", $_->[1] . $y . "\x{064F}\x{0627}\x{0653}",
640             $_->[0] x $x . "^U", $_->[1] . $y . "\x{064F}\x{0648}\x{0653}",
641             $_->[0] x $x . "^I", $_->[1] . $y . "\x{0650}\x{064A}\x{0653}",
642              
643             $_->[0] x $x . "^Uw", [ $_->[1] . $y . "\x{064F}\x{0648}\x{0655}", "|" ], # roughly
644             $_->[0] x $x . "^Iy", [ $_->[1] . $y . "\x{0650}\x{0649}\x{0655}", "|" ], # roughly
645              
646             ) ),
647              
648             $_->[0] x $x . "aa", [ "", $_->[0] x $x . "A" ],
649             $_->[0] x $x . "uw", [ "", $_->[0] x $x . "U" ],
650             $_->[0] x $x . "iy", [ "", $_->[0] x $x . "I" ],
651              
652             ( $option{'non-quoting'} ? () : (
653              
654             $_->[0] x $x . "\"a", $_->[1] . $y . "\"\x{064E}",
655             $_->[0] x $x . "\"u", $_->[1] . $y . "\"\x{064F}",
656             $_->[0] x $x . "\"i", $_->[1] . $y . "\"\x{0650}",
657              
658             $_->[0] x $x . "\"_a", $_->[1] . $y . "\"\x{0670}",
659              
660             ( $option{'non-refined'} ? () : (
661              
662             $_->[0] x $x . "\"_u", $_->[1] . $y . "\"\x{0657}",
663             $_->[0] x $x . "\"_i", $_->[1] . $y . "\"\x{0656}",
664              
665             $_->[0] x $x . "\"_aA", $_->[1] . $y . "\"\x{0670}\x{0627}",
666             $_->[0] x $x . "\"_aY", $_->[1] . $y . "\"\x{0670}\x{0649}",
667             $_->[0] x $x . "\"_aU", $_->[1] . $y . "\"\x{0670}\x{0648}",
668             $_->[0] x $x . "\"_aI", $_->[1] . $y . "\"\x{0670}\x{064A}",
669              
670             ) ),
671              
672             $_->[0] x $x . "\"A", $_->[1] . $y . "\"\x{064E}\x{0627}",
673             $_->[0] x $x . "\"Y", $_->[1] . $y . "\"\x{064E}\x{0649}",
674              
675             $_->[0] x $x . "\"A\"", $_->[1] . $y . "\"\x{064E}\x{0627}\"\x{0652}",
676             $_->[0] x $x . "\"Y\"", $_->[1] . $y . "\"\x{064E}\x{0649}\"\x{0652}",
677              
678             $_->[0] x $x . "A\"", $_->[1] . $y . "\x{064E}\x{0627}\"\x{0652}",
679             $_->[0] x $x . "Y\"", $_->[1] . $y . "\x{064E}\x{0649}\"\x{0652}",
680              
681             $_->[0] x $x . "\"U", $_->[1] . $y . "\"\x{064F}\x{0648}",
682             $_->[0] x $x . "\"I", $_->[1] . $y . "\"\x{0650}\x{064A}",
683              
684             $_->[0] x $x . "\"U\"", $_->[1] . $y . "\"\x{064F}\x{0648}\"\x{0652}",
685             $_->[0] x $x . "\"I\"", $_->[1] . $y . "\"\x{0650}\x{064A}\"\x{0652}",
686              
687             $_->[0] x $x . "U\"", $_->[1] . $y . "\x{064F}\x{0648}\"\x{0652}",
688             $_->[0] x $x . "I\"", $_->[1] . $y . "\x{0650}\x{064A}\"\x{0652}",
689              
690             $_->[0] x $x . "\"Uw", [ $_->[1] . $y . "\"\x{064F}", "ww" ],
691             $_->[0] x $x . "\"Iy", [ $_->[1] . $y . "\"\x{0650}", "yy" ],
692              
693             ( $option{'non-refined'} ? () : (
694              
695             $_->[0] x $x . "\"^A", $_->[1] . $y . "\"\x{064F}\x{0627}\x{0653}",
696             $_->[0] x $x . "\"^U", $_->[1] . $y . "\"\x{064F}\x{0648}\x{0653}",
697             $_->[0] x $x . "\"^I", $_->[1] . $y . "\"\x{0650}\x{064A}\x{0653}",
698              
699             $_->[0] x $x . "\"^Uw", [ $_->[1] . $y . "\"\x{064F}\x{0648}\x{0655}", "|" ], # roughly
700             $_->[0] x $x . "\"^Iy", [ $_->[1] . $y . "\"\x{0650}\x{0649}\x{0655}", "|" ], # roughly
701              
702             ) ),
703              
704             $_->[0] x $x . "\"aa", [ "", $_->[0] x $x . "\"A" ],
705             $_->[0] x $x . "\"uw", [ "", $_->[0] x $x . "\"U" ],
706             $_->[0] x $x . "\"iy", [ "", $_->[0] x $x . "\"I" ],
707              
708             ) ),
709              
710             (
711             map {
712              
713 45 50       1573 $fix->[0] x $x . "uw" . $_, [ $fix->[1] . $y . "\x{064F}", "w" . $_ ],
    50          
    50          
    50          
    50          
    50          
    100          
    100          
    50          
714             $fix->[0] x $x . "iy" . $_, [ $fix->[1] . $y . "\x{0650}", "y" . $_ ],
715              
716             ( $option{'non-quoting'} ? () : (
717              
718             $fix->[0] x $x . "\"uw" . $_, [ $fix->[1] . $y . "\"\x{064F}", "w" . $_ ],
719             $fix->[0] x $x . "\"iy" . $_, [ $fix->[1] . $y . "\"\x{0650}", "y" . $_ ],
720              
721             ) ),
722              
723             } "\"", qw "a u i A Y U I", $option{'non-refined'} ? () : qw "_a _u _i ^A ^U ^I"
724             ),
725              
726             $_->[0] x $x . "_aA'|aN", $_->[1] . $y . "\x{0670}\x{0627}\x{0621}\x{064B}",
727             $_->[0] x $x . "A'|aN", $_->[1] . $y . "\x{064E}\x{0627}\x{0621}\x{064B}",
728              
729             $_->[0] x $x . "aN", $_->[1] . $y . "\x{064B}" . ( $_->[0] eq "'a" ? "" : "\x{0627}" ),
730             $_->[0] x $x . "uN", $_->[1] . $y . "\x{064C}",
731             $_->[0] x $x . "iN", $_->[1] . $y . "\x{064D}",
732              
733             ( $option{'non-quoting'} ? () : (
734              
735             $_->[0] x $x . "\"_aA'|aN", $_->[1] . $y . "\"\x{0670}\x{0627}\x{0621}\x{064B}",
736             $_->[0] x $x . "\"A'|aN", $_->[1] . $y . "\"\x{064E}\x{0627}\x{0621}\x{064B}",
737              
738             $_->[0] x $x . "\"_aA'|\"aN", $_->[1] . $y . "\"\x{0670}\x{0627}\x{0621}\"\x{064B}",
739             $_->[0] x $x . "\"A'|\"aN", $_->[1] . $y . "\"\x{064E}\x{0627}\x{0621}\"\x{064B}",
740              
741             $_->[0] x $x . "_aA'|\"aN", $_->[1] . $y . "\x{0670}\x{0627}\x{0621}\"\x{064B}",
742             $_->[0] x $x . "A'|\"aN", $_->[1] . $y . "\x{064E}\x{0627}\x{0621}\"\x{064B}",
743              
744             $_->[0] x $x . "\"A\"'|aN", $_->[1] . $y . "\"\x{064E}\x{0627}\"\x{0652}\x{0621}\x{064B}",
745             $_->[0] x $x . "\"A\"'|\"aN", $_->[1] . $y . "\"\x{064E}\x{0627}\"\x{0652}\x{0621}\"\x{064B}",
746             $_->[0] x $x . "A\"'|\"aN", $_->[1] . $y . "\x{064E}\x{0627}\"\x{0652}\x{0621}\"\x{064B}",
747              
748             $_->[0] x $x . "\"aN", $_->[1] . $y . "\"\x{064B}" . ( $_->[0] eq "'a" ? "" : "\x{0627}" ),
749             $_->[0] x $x . "\"uN", $_->[1] . $y . "\"\x{064C}",
750             $_->[0] x $x . "\"iN", $_->[1] . $y . "\"\x{064D}",
751              
752             ) ),
753              
754             } @sunny, @moony, $empty[0]
755              
756             } 0 # 1
757             ),
758              
759             # 'alif protected endings
760             (
761             map {
762              
763 2 50       12 my $x = 1 + $_;
764 1         2 my $y = "\x{0651}" x $_; # "\xD9\x91" ^sadda
765              
766 45 50       1172 map {
    50          
    50          
767              
768 1         3 $_->[0] x $x . "_aA'|aNA", $_->[1] . $y . "\x{0670}\x{0627}\x{0621}\x{064B}\x{0627}",
769             $_->[0] x $x . "A'|aNA", $_->[1] . $y . "\x{064E}\x{0627}\x{0621}\x{064B}\x{0627}",
770              
771             $_->[0] x $x . "aNA", $_->[1] . $y . "\x{064B}\x{0627}",
772             $_->[0] x $x . "aNY", $_->[1] . $y . "\x{064B}\x{0649}",
773              
774             ( $option{'non-refined'} ? () : (
775              
776             $_->[0] x $x . "uNA", $_->[1] . $y . "\x{064C}\x{0627}",
777             $_->[0] x $x . "iNA", $_->[1] . $y . "\x{064D}\x{0627}",
778              
779             $_->[0] x $x . "uNY", $_->[1] . $y . "\x{064C}\x{0649}",
780             $_->[0] x $x . "iNY", $_->[1] . $y . "\x{064D}\x{0649}",
781              
782             $_->[0] x $x . "aNU", $_->[1] . $y . "\x{064B}\x{0648}",
783             $_->[0] x $x . "uNU", $_->[1] . $y . "\x{064C}\x{0648}",
784             $_->[0] x $x . "iNU", $_->[1] . $y . "\x{064D}\x{0648}",
785              
786             ) ),
787              
788             $_->[0] x $x . "aW", $_->[1] . $y . "\x{064E}\x{0648}\x{0652}\x{0627}",
789             $_->[0] x $x . "UA", $_->[1] . $y . "\x{064F}\x{0648}\x{0627}",
790              
791             ( $option{'non-quoting'} ? () : (
792              
793             $_->[0] x $x . "\"_aA'|aNA", $_->[1] . $y . "\"\x{0670}\x{0627}\x{0621}\x{064B}\x{0627}",
794             $_->[0] x $x . "\"A'|aNA", $_->[1] . $y . "\"\x{064E}\x{0627}\x{0621}\x{064B}\x{0627}",
795              
796             $_->[0] x $x . "\"_aA'|\"aNA", $_->[1] . $y . "\"\x{0670}\x{0627}\x{0621}\"\x{064B}\x{0627}",
797             $_->[0] x $x . "\"A'|\"aNA", $_->[1] . $y . "\"\x{064E}\x{0627}\x{0621}\"\x{064B}\x{0627}",
798              
799             $_->[0] x $x . "_aA'|\"aNA", $_->[1] . $y . "\x{0670}\x{0627}\x{0621}\"\x{064B}\x{0627}",
800             $_->[0] x $x . "A'|\"aNA", $_->[1] . $y . "\x{064E}\x{0627}\x{0621}\"\x{064B}\x{0627}",
801              
802             $_->[0] x $x . "\"A\"'|aNA", $_->[1] . $y . "\"\x{064E}\x{0627}\"\x{0652}\x{0621}\x{064B}\x{0627}",
803             $_->[0] x $x . "\"A\"'|\"aNA", $_->[1] . $y . "\"\x{064E}\x{0627}\"\x{0652}\x{0621}\"\x{064B}\x{0627}",
804             $_->[0] x $x . "A\"'|\"aNA", $_->[1] . $y . "\x{064E}\x{0627}\"\x{0652}\x{0621}\"\x{064B}\x{0627}",
805              
806             $_->[0] x $x . "\"aNA", $_->[1] . $y . "\"\x{064B}\x{0627}",
807             $_->[0] x $x . "\"aNY", $_->[1] . $y . "\"\x{064B}\x{0649}",
808              
809             ( $option{'non-refined'} ? () : (
810              
811             $_->[0] x $x . "\"uNA", $_->[1] . $y . "\"\x{064C}\x{0627}",
812             $_->[0] x $x . "\"iNA", $_->[1] . $y . "\"\x{064D}\x{0627}",
813              
814             $_->[0] x $x . "\"uNY", $_->[1] . $y . "\"\x{064C}\x{0649}",
815             $_->[0] x $x . "\"iNY", $_->[1] . $y . "\"\x{064D}\x{0649}",
816              
817             $_->[0] x $x . "\"aNU", $_->[1] . $y . "\"\x{064B}\x{0648}",
818             $_->[0] x $x . "\"uNU", $_->[1] . $y . "\"\x{064C}\x{0648}",
819             $_->[0] x $x . "\"iNU", $_->[1] . $y . "\"\x{064D}\x{0648}",
820              
821             ) ),
822              
823             $_->[0] x $x . "\"aW", $_->[1] . $y . "\"\x{064E}\x{0648}\"\x{0652}\x{0627}", # coupled?
824             $_->[0] x $x . "\"UA", $_->[1] . $y . "\"\x{064F}\x{0648}\x{0627}",
825              
826             ) ),
827              
828             } @sunny, @moony, $empty[0]
829              
830             } 0 # 1
831             ),
832              
833             # taa' marbuu.ta endings
834             (
835             map {
836              
837 1         2 $_->[0], $_->[1] . "\x{0652}", # "\xD9\x92" sukuun
838              
839             ( $option{'non-quoting'} ? () : (
840              
841             $_->[0] . "\"", $_->[1] . "\"\x{0652}", # "\xD9\x92" sukuun
842              
843             ) ),
844              
845             } @taaaa
846             ),
847              
848             (
849             map {
850              
851 1         3 my $fix = $_;
852              
853 45 50       412 $_->[0] . "a", $_->[1] . "\x{064E}",
    50          
854             $_->[0] . "u", $_->[1] . "\x{064F}",
855             $_->[0] . "i", $_->[1] . "\x{0650}",
856              
857             $_->[0] . "aN", $_->[1] . "\x{064B}",
858             $_->[0] . "uN", $_->[1] . "\x{064C}",
859             $_->[0] . "iN", $_->[1] . "\x{064D}",
860              
861             ( $option{'non-quoting'} ? () : (
862              
863             $_->[0] . "\"a", $_->[1] . "\"\x{064E}",
864             $_->[0] . "\"u", $_->[1] . "\"\x{064F}",
865             $_->[0] . "\"i", $_->[1] . "\"\x{0650}",
866              
867             $_->[0] . "\"aN", $_->[1] . "\"\x{064B}",
868             $_->[0] . "\"uN", $_->[1] . "\"\x{064C}",
869             $_->[0] . "\"iN", $_->[1] . "\"\x{064D}",
870              
871             ) ),
872              
873             # non-voweled/sukuuned
874              
875             ( $option{'non-refined'} ? () : (
876              
877             $_->[0] . "-a", $_->[1] . "\x{064E}",
878             $_->[0] . "-u", $_->[1] . "\x{064F}",
879             $_->[0] . "-i", $_->[1] . "\x{0650}",
880              
881             $_->[0] . "-aN", $_->[1] . "\x{064B}",
882             $_->[0] . "-uN", $_->[1] . "\x{064C}",
883             $_->[0] . "-iN", $_->[1] . "\x{064D}",
884              
885             ( $option{'non-quoting'} ? () : (
886              
887             $_->[0] . "-\"a", $_->[1] . "\"\x{064E}",
888             $_->[0] . "-\"u", $_->[1] . "\"\x{064F}",
889             $_->[0] . "-\"i", $_->[1] . "\"\x{0650}",
890              
891             $_->[0] . "-\"aN", $_->[1] . "\"\x{064B}",
892             $_->[0] . "-\"uN", $_->[1] . "\"\x{064C}",
893             $_->[0] . "-\"iN", $_->[1] . "\"\x{064D}",
894              
895             ) ),
896              
897             ) ),
898              
899             map {
900              
901 1 50       34 ( $option{'non-refined'} ? () : (
    50          
    50          
902              
903             $fix->[0] . "-a" . $_->[0], [ $fix->[1] . "\x{0652}", "a" . $_->[0] ],
904             $fix->[0] . "-u" . $_->[0], [ $fix->[1] . "\x{0652}", "u" . $_->[0] ],
905             $fix->[0] . "-i" . $_->[0], [ $fix->[1] . "\x{0652}", "i" . $_->[0] ],
906              
907             ( $option{'non-quoting'} ? () : (
908              
909             $fix->[0] . "-\"a" . $_->[0], [ $fix->[1] . "\x{0652}\"", "a" . $_->[0] ],
910             $fix->[0] . "-\"u" . $_->[0], [ $fix->[1] . "\x{0652}\"", "u" . $_->[0] ],
911             $fix->[0] . "-\"i" . $_->[0], [ $fix->[1] . "\x{0652}\"", "i" . $_->[0] ],
912              
913             ) ),
914              
915             ) ),
916              
917             } @sunny, @moony, $empty[0] # @taaaa
918              
919             } $taaaa[0]
920             ),
921              
922             # initial vowels
923              
924             ( $option{'non-quoting'} ? () : (
925              
926             "\"", "\x{0671}", # this grapheme is mode-dependent in the next level
927              
928             ) ),
929              
930             (
931             map {
932              
933 1 50       227 my $fix = $_;
934              
935 14 50       1475 $_->[0] . "a", $_->[1] . "\x{064E}",
936             $_->[0] . "u", $_->[1] . "\x{064F}",
937             $_->[0] . "i", $_->[1] . "\x{0650}",
938              
939             ( $option{'non-refined'} ? () : (
940              
941             $_->[0] . "_a", $_->[1] . "\x{0670}",
942             $_->[0] . "_u", $_->[1] . "\x{0657}",
943             $_->[0] . "_i", $_->[1] . "\x{0656}",
944              
945             $_->[0] . "_aA", $_->[1] . "\x{0670}\x{0627}",
946             $_->[0] . "_aY", $_->[1] . "\x{0670}\x{0649}",
947             $_->[0] . "_aU", $_->[1] . "\x{0670}\x{0648}",
948             $_->[0] . "_aI", $_->[1] . "\x{0670}\x{064A}",
949              
950             ) ),
951              
952             $_->[0] . "A", "\x{0627}",
953             $_->[0] . "Y", "\x{0649}",
954              
955             $_->[0] . "U", $_->[1] . "\x{064F}\x{0648}",
956             $_->[0] . "I", $_->[1] . "\x{0650}\x{064A}",
957              
958             $_->[0] . "Uw", [ $_->[1] . "\x{064F}\x{0648}\x{0651}", "|" ],
959             $_->[0] . "Iy", [ $_->[1] . "\x{0650}\x{064A}\x{0651}", "|" ],
960              
961             ( $option{'non-refined'} ? () : (
962              
963             $_->[0] . "^A", "\x{0622}", # use no equivs
964             $_->[0] . "^U", "\x{0623}\x{064F}\x{0648}", # use no equivs
965             $_->[0] . "^I", "\x{0625}\x{0650}\x{064A}", # use no equivs
966              
967             ) ),
968              
969             $_->[0] . "aa", [ "", $_->[0] . "A" ],
970             $_->[0] . "uw", [ "", $_->[0] . "U" ],
971             $_->[0] . "iy", [ "", $_->[0] . "I" ],
972              
973             ( $option{'non-quoting'} ? () : (
974              
975             $_->[0] . "\"a", $_->[1] . "\"\x{064E}",
976             $_->[0] . "\"u", $_->[1] . "\"\x{064F}",
977             $_->[0] . "\"i", $_->[1] . "\"\x{0650}",
978              
979             ( $option{'non-refined'} ? () : (
980              
981             $_->[0] . "\"_a", $_->[1] . "\"\x{0670}",
982             $_->[0] . "\"_u", $_->[1] . "\"\x{0657}",
983             $_->[0] . "\"_i", $_->[1] . "\"\x{0656}",
984              
985             $_->[0] . "\"_aA", $_->[1] . "\"\x{0670}\x{0627}",
986             $_->[0] . "\"_aY", $_->[1] . "\"\x{0670}\x{0649}",
987             $_->[0] . "\"_aU", $_->[1] . "\"\x{0670}\x{0648}",
988             $_->[0] . "\"_aI", $_->[1] . "\"\x{0670}\x{064A}",
989              
990             ) ),
991              
992             $_->[0] . "\"A", $_->[1] . "\"\x{064E}\x{0627}",
993             $_->[0] . "\"Y", $_->[1] . "\"\x{064E}\x{0649}",
994              
995             $_->[0] . "\"A\"", $_->[1] . "\"\x{064E}\x{0627}\"\x{0652}",
996             $_->[0] . "\"Y\"", $_->[1] . "\"\x{064E}\x{0649}\"\x{0652}",
997              
998             $_->[0] . "A\"", "\x{0627}\"\x{0652}",
999             $_->[0] . "Y\"", "\x{0649}\"\x{0652}",
1000              
1001             $_->[0] . "\"U", $_->[1] . "\"\x{064F}\x{0648}",
1002             $_->[0] . "\"I", $_->[1] . "\"\x{0650}\x{064A}",
1003              
1004             $_->[0] . "\"U\"", $_->[1] . "\"\x{064F}\x{0648}\"\x{0652}",
1005             $_->[0] . "\"I\"", $_->[1] . "\"\x{0650}\x{064A}\"\x{0652}",
1006              
1007             $_->[0] . "U\"", $_->[1] . "\x{064F}\x{0648}\"\x{0652}",
1008             $_->[0] . "I\"", $_->[1] . "\x{0650}\x{064A}\"\x{0652}",
1009              
1010             $_->[0] . "\"Uw", [ $_->[1] . "\"\x{064F}\x{0648}\x{0651}", "|" ],
1011             $_->[0] . "\"Iy", [ $_->[1] . "\"\x{0650}\x{064A}\x{0651}", "|" ],
1012              
1013             ( $option{'non-refined'} ? () : (
1014              
1015             $_->[0] . "\"^A", "\"\x{0622}", # use no equivs
1016             $_->[0] . "\"^U", "\"\x{0623}\x{064F}\x{0648}", # use no equivs
1017             $_->[0] . "\"^I", "\"\x{0625}\x{0650}\x{064A}", # use no equivs
1018              
1019             ) ),
1020              
1021             $_->[0] . "\"aa", [ "", $_->[0] . "\"A" ],
1022             $_->[0] . "\"uw", [ "", $_->[0] . "\"U" ],
1023             $_->[0] . "\"iy", [ "", $_->[0] . "\"I" ],
1024              
1025             ) ),
1026              
1027             (
1028             map {
1029              
1030 1 50       66 $fix->[0] . "uw" . $_, [ $fix->[1] . "\x{064F}", "w" . $_ ],
    50          
    50          
    50          
    50          
    50          
    50          
1031             $fix->[0] . "iy" . $_, [ $fix->[1] . "\x{0650}", "y" . $_ ],
1032              
1033             ( $option{'non-quoting'} ? () : (
1034              
1035             $fix->[0] . "\"uw" . $_, [ $fix->[1] . "\"\x{064F}", "w" . $_ ],
1036             $fix->[0] . "\"iy" . $_, [ $fix->[1] . "\"\x{0650}", "y" . $_ ],
1037              
1038             ) ),
1039              
1040             } "\"", qw "a u i A Y U I", $option{'non-refined'} ? () : qw "_a _u _i ^A ^U ^I"
1041             ),
1042              
1043             $_->[0] . "_aA'|aN", $_->[1] . "\x{0670}\x{0627}\x{0621}\x{064B}",
1044             $_->[0] . "A'|aN", $_->[1] . "\x{064E}\x{0627}\x{0621}\x{064B}",
1045              
1046             $_->[0] . "aN", $_->[1] . "\x{064B}",
1047             $_->[0] . "uN", $_->[1] . "\x{064C}",
1048             $_->[0] . "iN", $_->[1] . "\x{064D}",
1049              
1050             ( $option{'non-quoting'} ? () : (
1051              
1052             $_->[0] . "\"_aA'|aN", $_->[1] . "\"\x{0670}\x{0627}\x{0621}\x{064B}",
1053             $_->[0] . "\"A'|aN", $_->[1] . "\"\x{064E}\x{0627}\x{0621}\x{064B}",
1054              
1055             $_->[0] . "\"_aA'|\"aN", $_->[1] . "\"\x{0670}\x{0627}\x{0621}\"\x{064B}",
1056             $_->[0] . "\"A'|\"aN", $_->[1] . "\"\x{064E}\x{0627}\x{0621}\"\x{064B}",
1057              
1058             $_->[0] . "_aA'|\"aN", $_->[1] . "\x{0670}\x{0627}\x{0621}\"\x{064B}",
1059             $_->[0] . "A'|\"aN", $_->[1] . "\x{064E}\x{0627}\x{0621}\"\x{064B}",
1060              
1061             $_->[0] . "\"A\"'|aN", $_->[1] . "\"\x{064E}\x{0627}\"\x{0652}\x{0621}\x{064B}",
1062             $_->[0] . "\"A\"'|\"aN", $_->[1] . "\"\x{064E}\x{0627}\"\x{0652}\x{0621}\"\x{064B}",
1063             $_->[0] . "A\"'|\"aN", $_->[1] . "\x{064E}\x{0627}\"\x{0652}\x{0621}\"\x{064B}",
1064              
1065             $_->[0] . "\"aN", $_->[1] . "\"\x{064B}",
1066             $_->[0] . "\"uN", $_->[1] . "\"\x{064C}",
1067             $_->[0] . "\"iN", $_->[1] . "\"\x{064D}",
1068              
1069             ) ),
1070              
1071             } $empty[1]
1072             ),
1073              
1074             # non-notation insertion escapes provided through ':xml'
1075              
1076             );
1077              
1078              
1079 2     2   28 no strict 'refs';
  2         5  
  2         1408  
1080              
1081 1         12292 ${ $cls . '::decoder' } = $decoder;
  1         15  
1082              
1083 1 50       8 if ($option{'describe'}) {
1084              
1085 0         0 $_->describe('') foreach @{${ $cls . '::decoder' }};
  0         0  
  0         0  
1086             }
1087              
1088 1 50       3 $cls->demode(defined ${ $cls . '::demode' } ? ${ $cls . '::demode' } : 'default');
  1         17  
  0         0  
1089              
1090 1         1 return ${ $cls . '::decoder' };
  1         49  
1091             }
1092              
1093              
1094             sub enmoder ($$@) {
1095 1     1 0 2 my ($cls, $mode) = @_;
1096              
1097 2     2   16 no strict 'refs';
  2         3  
  2         10595  
1098              
1099 1         1 return ${ $cls . '::encoder' }->[$mode + $enlevel] = undef;
  1         5  
1100             }
1101              
1102              
1103             sub demoder ($$@) {
1104 1     1 0 3 my ($cls, $mode) = @_;
1105              
1106 1         2 my $demoder = [];
1107              
1108              
1109             # rules for the fullvocalize mode
1110              
1111 0         0 $demoder->[4] = [
1112              
1113             [
1114             'silent' => 0,
1115             ],
1116              
1117             "\x{0671}", "\x{0627}",
1118              
1119             "\"\x{0652}", "",
1120             "\"\x{064E}", "",
1121             "\"\x{064F}", "",
1122             "\"\x{0650}", "",
1123             "\"\x{064B}", "",
1124             "\"\x{064C}", "",
1125             "\"\x{064D}", "",
1126             "\"\x{0670}", "",
1127             "\"\x{0657}", "",
1128             "\"\x{0656}", "",
1129              
1130             "\"", "",
1131              
1132             "\x{064E}\x{0627}\"\x{0652}", "\x{064E}\x{0627}\x{0652}",
1133             "\"\x{064E}\x{0627}\"\x{0652}", "\x{0627}\x{0652}",
1134              
1135             (
1136             ( $option{'font-fixing'} ? (
1137              
1138             map {
1139              
1140 3         5 "\x{0644}" . $_ . "\x{064E}\x{0627}\"\x{0652}", "\x{0644}\x{0627}" . $_ . "\x{064E}\x{0652}",
1141             "\x{0644}" . $_ . "\"\x{064E}\x{0627}\"\x{0652}", "\x{0644}\x{0627}" . $_ . "\x{0652}",
1142              
1143             } "", "\x{0651}"
1144              
1145             ) : () ),
1146             ),
1147              
1148             "\x{064E}\x{0649}\"\x{0652}", "\x{064E}\x{0649}\x{0652}",
1149             "\"\x{064E}\x{0649}\"\x{0652}", "\x{0649}\x{0652}",
1150              
1151             "\x{064F}\x{0648}\"\x{0652}", "\x{064F}\x{0648}\x{0652}",
1152             "\"\x{064F}\x{0648}\"\x{0652}", "\x{0648}\x{0652}",
1153              
1154             "\x{0650}\x{064A}\"\x{0652}", "\x{0650}\x{064A}\x{0652}",
1155             "\"\x{0650}\x{064A}\"\x{0652}", "\x{064A}\x{0652}",
1156              
1157             # modern external/internal substitution with wa.sla
1158             (
1159             map {
1160              
1161 0         0 my $vowel = $_;
1162              
1163 27         12447 map {
1164              
1165 3         7 "\x{064E}" . $_ . "\x{0627}" . $vowel, [ "\x{064E}" . $_ . "\x{0671}", "\"" . $vowel ],
1166             "\x{064F}" . $_ . "\x{0627}" . $vowel, [ "\x{064F}" . $_ . "\x{0671}", "\"" . $vowel ],
1167             "\x{0650}" . $_ . "\x{0627}" . $vowel, [ "\x{0650}" . $_ . "\x{0671}", "\"" . $vowel ],
1168              
1169             "\x{064E}\x{0627}" . $_ . "\x{0627}" . $vowel, [ "\x{064E}\x{0627}" . $_ . "\x{0671}", "\"" . $vowel ],
1170             "\x{064E}\x{0649}" . $_ . "\x{0627}" . $vowel, [ "\x{064E}\x{0649}" . $_ . "\x{0671}", "\"" . $vowel ],
1171             "\x{064F}\x{0648}" . $_ . "\x{0627}" . $vowel, [ "\x{064F}\x{0648}" . $_ . "\x{0671}", "\"" . $vowel ],
1172             "\x{0650}\x{064A}" . $_ . "\x{0627}" . $vowel, [ "\x{0650}\x{064A}" . $_ . "\x{0671}", "\"" . $vowel ],
1173              
1174             # quoted
1175              
1176             "\"\x{064E}" . $_ . "\x{0627}" . $vowel, [ $_ . "\x{0671}", "\"" . $vowel ],
1177             "\"\x{064F}" . $_ . "\x{0627}" . $vowel, [ $_ . "\x{0671}", "\"" . $vowel ],
1178             "\"\x{0650}" . $_ . "\x{0627}" . $vowel, [ $_ . "\x{0671}", "\"" . $vowel ],
1179              
1180             "\"\x{064E}\x{0627}" . $_ . "\x{0627}" . $vowel, [ "\x{0627}" . $_ . "\x{0671}", "\"" . $vowel ],
1181             "\"\x{064E}\x{0649}" . $_ . "\x{0627}" . $vowel, [ "\x{0649}" . $_ . "\x{0671}", "\"" . $vowel ],
1182             "\"\x{064F}\x{0648}" . $_ . "\x{0627}" . $vowel, [ "\x{0648}" . $_ . "\x{0671}", "\"" . $vowel ],
1183             "\"\x{0650}\x{064A}" . $_ . "\x{0627}" . $vowel, [ "\x{064A}" . $_ . "\x{0671}", "\"" . $vowel ],
1184              
1185             "\"\x{064E}" . $_ . "\x{0627}\"" . $vowel, [ $_ . "\x{0627}", $vowel ],
1186             "\"\x{064F}" . $_ . "\x{0627}\"" . $vowel, [ $_ . "\x{0627}", $vowel ],
1187             "\"\x{0650}" . $_ . "\x{0627}\"" . $vowel, [ $_ . "\x{0627}", $vowel ],
1188              
1189             "\"\x{064E}\x{0627}" . $_ . "\x{0627}\"" . $vowel, [ "\x{0627}" . $_ . "\x{0627}", $vowel ],
1190             "\"\x{064E}\x{0649}" . $_ . "\x{0627}\"" . $vowel, [ "\x{0649}" . $_ . "\x{0627}", $vowel ],
1191             "\"\x{064F}\x{0648}" . $_ . "\x{0627}\"" . $vowel, [ "\x{0648}" . $_ . "\x{0627}", $vowel ],
1192             "\"\x{0650}\x{064A}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064A}" . $_ . "\x{0627}", $vowel ],
1193              
1194             "\x{064E}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064E}" . $_ . "\x{0627}", $vowel ],
1195             "\x{064F}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064F}" . $_ . "\x{0627}", $vowel ],
1196             "\x{0650}" . $_ . "\x{0627}\"" . $vowel, [ "\x{0650}" . $_ . "\x{0627}", $vowel ],
1197              
1198             "\x{064E}\x{0627}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064E}\x{0627}" . $_ . "\x{0627}", $vowel ],
1199             "\x{064E}\x{0649}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064E}\x{0649}" . $_ . "\x{0627}", $vowel ],
1200             "\x{064F}\x{0648}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064F}\x{0648}" . $_ . "\x{0627}", $vowel ],
1201             "\x{0650}\x{064A}" . $_ . "\x{0627}\"" . $vowel, [ "\x{0650}\x{064A}" . $_ . "\x{0627}", $vowel ],
1202              
1203             } "", "\x09", "\x0A", "\x0D", "\x20", "\x0D\x0A", "\x20\x20", "\x20\x20\x20", "\x20\x20\x20\x20"
1204              
1205             } "\x{064E}", "\x{064F}", "\x{0650}"
1206             ),
1207              
1208             # laam + 'alif .. either enforce ligatures, or shuffle the diacritics
1209             (
1210             ( $option{'font-fixing'} ? (
1211              
1212             map {
1213              
1214 0         0 my $alif = $_;
1215              
1216 0         0 map {
1217              
1218 0         0 my $vowel = $_;
1219              
1220 0         0 map {
1221              
1222 0         0 "\x{0644}" . $_ . $vowel . $alif, "\x{0644}" . $alif . $_ . $vowel,
1223             "\x{0644}" . $_ . "\"" . $vowel . $alif, "\x{0644}" . $alif . $_,
1224              
1225             } "", "\x{0651}"
1226              
1227             } "\x{064E}", "\x{064F}", "\x{0650}",
1228             "\x{064B}", "\x{064C}", "\x{064D}",
1229             "\x{0652}"
1230              
1231             } "\x{0622}", "\x{0623}", "\x{0625}", "\x{0627}" #, "\x{0671}"
1232              
1233             ) : () ),
1234             ),
1235              
1236             (
1237             ( $option{'font-fixing'} ? (
1238              
1239             map {
1240              
1241 0         0 my $vowel = $_;
1242              
1243 0         0 map {
1244              
1245 0         0 "\x{0644}" . $_ . $vowel . "\x{0671}", "\x{0644}\x{0627}" . $_ . $vowel,
1246             "\x{0644}" . $_ . "\"" . $vowel . "\x{0671}", "\x{0644}\x{0627}" . $_,
1247              
1248             } "", "\x{0651}"
1249              
1250             } "\x{064E}", "\x{064F}", "\x{0650}",
1251             "\x{064B}", "\x{064C}", "\x{064D}",
1252             "\x{0652}"
1253              
1254             ) : () ),
1255             ),
1256              
1257             # laam + vowel + 'alif + vowel .. internal substitution with wa.sla
1258             (
1259             ( $option{'font-fixing'} ? (
1260              
1261             map {
1262              
1263 1 50       9 my $double = $_;
    50          
    50          
    50          
1264              
1265 0         0 map {
1266              
1267 0         0 my $vowel = $_;
1268              
1269 0         0 map {
1270              
1271 0         0 "\x{0644}" . $double . $vowel . "\x{0627}" . $_, [ "\x{0644}\x{0671}" . $double . $vowel, "\"" . $_ ],
1272              
1273             # quoted
1274              
1275             "\x{0644}" . $double . "\"" . $vowel . "\x{0627}" . $_, [ "\x{0644}\x{0671}" . $double, "\"" . $_ ],
1276             "\x{0644}" . $double . "\"" . $vowel . "\x{0627}\"" . $_, [ "\x{0644}\x{0627}" . $double, $_ ],
1277             "\x{0644}" . $double . $vowel . "\x{0627}\"" . $_, [ "\x{0644}\x{0627}" . $double . $vowel, $_ ],
1278              
1279             } "\x{064E}", "\x{064F}", "\x{0650}"
1280              
1281             } "\x{064E}", "\x{064F}", "\x{0650}"
1282              
1283             } "", "\x{0651}"
1284              
1285             ) : () ),
1286             ),
1287              
1288             # optional ligatures to enforce here
1289              
1290             ];
1291              
1292              
1293             # rules for the vocalize mode
1294              
1295 3         6 $demoder->[3] = [
1296              
1297             [
1298             'silent' => 0,
1299             ],
1300              
1301             "\"\x{0652}", "\x{0652}",
1302             "\"\x{064E}", "",
1303             "\"\x{064F}", "",
1304             "\"\x{0650}", "",
1305             "\"\x{064B}", "",
1306             "\"\x{064C}", "",
1307             "\"\x{064D}", "",
1308             "\"\x{0670}", "",
1309             "\"\x{0657}", "",
1310             "\"\x{0656}", "",
1311              
1312             "\x{0652}", "",
1313              
1314             "\"", "",
1315              
1316             # modern external/internal substitution with wa.sla
1317             (
1318             map {
1319              
1320 0         0 my $vowel = $_;
1321              
1322 27         3495 map {
1323              
1324 3         7 "\x{064E}" . $_ . "\x{0627}" . $vowel, [ "\x{064E}" . $_ . "\x{0627}", "\"" . $vowel ],
1325             "\x{064F}" . $_ . "\x{0627}" . $vowel, [ "\x{064F}" . $_ . "\x{0627}", "\"" . $vowel ],
1326             "\x{0650}" . $_ . "\x{0627}" . $vowel, [ "\x{0650}" . $_ . "\x{0627}", "\"" . $vowel ],
1327              
1328             "\x{064E}\x{0627}" . $_ . "\x{0627}" . $vowel, [ "\x{064E}\x{0627}" . $_ . "\x{0627}", "\"" . $vowel ],
1329             "\x{064E}\x{0649}" . $_ . "\x{0627}" . $vowel, [ "\x{064E}\x{0649}" . $_ . "\x{0627}", "\"" . $vowel ],
1330             "\x{064F}\x{0648}" . $_ . "\x{0627}" . $vowel, [ "\x{064F}\x{0648}" . $_ . "\x{0627}", "\"" . $vowel ],
1331             "\x{0650}\x{064A}" . $_ . "\x{0627}" . $vowel, [ "\x{0650}\x{064A}" . $_ . "\x{0627}", "\"" . $vowel ],
1332              
1333             # quoted
1334              
1335             "\"\x{064E}" . $_ . "\x{0627}" . $vowel, [ $_ . "\x{0627}", "\"" . $vowel ],
1336             "\"\x{064F}" . $_ . "\x{0627}" . $vowel, [ $_ . "\x{0627}", "\"" . $vowel ],
1337             "\"\x{0650}" . $_ . "\x{0627}" . $vowel, [ $_ . "\x{0627}", "\"" . $vowel ],
1338              
1339             "\"\x{064E}\x{0627}" . $_ . "\x{0627}" . $vowel, [ "\x{0627}" . $_ . "\x{0627}", "\"" . $vowel ],
1340             "\"\x{064E}\x{0649}" . $_ . "\x{0627}" . $vowel, [ "\x{0649}" . $_ . "\x{0627}", "\"" . $vowel ],
1341             "\"\x{064F}\x{0648}" . $_ . "\x{0627}" . $vowel, [ "\x{0648}" . $_ . "\x{0627}", "\"" . $vowel ],
1342             "\"\x{0650}\x{064A}" . $_ . "\x{0627}" . $vowel, [ "\x{064A}" . $_ . "\x{0627}", "\"" . $vowel ],
1343              
1344             "\"\x{064E}" . $_ . "\x{0627}\"" . $vowel, [ $_ . "\x{0627}", $vowel ],
1345             "\"\x{064F}" . $_ . "\x{0627}\"" . $vowel, [ $_ . "\x{0627}", $vowel ],
1346             "\"\x{0650}" . $_ . "\x{0627}\"" . $vowel, [ $_ . "\x{0627}", $vowel ],
1347              
1348             "\"\x{064E}\x{0627}" . $_ . "\x{0627}\"" . $vowel, [ "\x{0627}" . $_ . "\x{0627}", $vowel ],
1349             "\"\x{064E}\x{0649}" . $_ . "\x{0627}\"" . $vowel, [ "\x{0649}" . $_ . "\x{0627}", $vowel ],
1350             "\"\x{064F}\x{0648}" . $_ . "\x{0627}\"" . $vowel, [ "\x{0648}" . $_ . "\x{0627}", $vowel ],
1351             "\"\x{0650}\x{064A}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064A}" . $_ . "\x{0627}", $vowel ],
1352              
1353             "\x{064E}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064E}" . $_ . "\x{0627}", $vowel ],
1354             "\x{064F}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064F}" . $_ . "\x{0627}", $vowel ],
1355             "\x{0650}" . $_ . "\x{0627}\"" . $vowel, [ "\x{0650}" . $_ . "\x{0627}", $vowel ],
1356              
1357             "\x{064E}\x{0627}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064E}\x{0627}" . $_ . "\x{0627}", $vowel ],
1358             "\x{064E}\x{0649}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064E}\x{0649}" . $_ . "\x{0627}", $vowel ],
1359             "\x{064F}\x{0648}" . $_ . "\x{0627}\"" . $vowel, [ "\x{064F}\x{0648}" . $_ . "\x{0627}", $vowel ],
1360             "\x{0650}\x{064A}" . $_ . "\x{0627}\"" . $vowel, [ "\x{0650}\x{064A}" . $_ . "\x{0627}", $vowel ],
1361              
1362             } "", "\x09", "\x0A", "\x0D", "\x20", "\x0D\x0A", "\x20\x20", "\x20\x20\x20", "\x20\x20\x20\x20"
1363              
1364             } "\x{064E}", "\x{064F}", "\x{0650}"
1365             ),
1366              
1367             # laam + 'alif .. either enforce ligatures, or shuffle the diacritics
1368             (
1369             ( $option{'font-fixing'} ? (
1370              
1371             map {
1372              
1373 0         0 my $alif = $_;
1374              
1375 0         0 map {
1376              
1377 0         0 my $vowel = $_;
1378              
1379 0         0 map {
1380              
1381 0         0 "\x{0644}" . $_ . $vowel . $alif, "\x{0644}" . $alif . $_ . $vowel,
1382             "\x{0644}" . $_ . "\"" . $vowel . $alif, "\x{0644}" . $alif . $_,
1383              
1384             } "", "\x{0651}"
1385              
1386             } "\x{064E}", "\x{064F}", "\x{0650}",
1387             "\x{064B}", "\x{064C}", "\x{064D}",
1388             # "\x{0652}"
1389              
1390             } "\x{0622}", "\x{0623}", "\x{0625}", "\x{0627}", "\x{0671}"
1391              
1392             ) : () ),
1393             ),
1394              
1395             (
1396             ( $option{'font-fixing'} ? (
1397              
1398             map {
1399              
1400 0         0 my $alif = $_;
1401              
1402 0         0 map {
1403              
1404 0         0 "\x{0644}" . $_ . "\x{0652}" . $alif, "\x{0644}" . $alif . $_,
1405             "\x{0644}" . $_ . "\"\x{0652}" . $alif, "\x{0644}" . $alif . $_ . "\x{0652}",
1406              
1407             } "", "\x{0651}"
1408              
1409             } "\x{0622}", "\x{0623}", "\x{0625}", "\x{0627}", "\x{0671}"
1410              
1411             ) : () ),
1412             ),
1413              
1414             # laam + vowel + 'alif + vowel .. internal substitution with wa.sla
1415             (
1416             ( $option{'font-fixing'} ? (
1417              
1418             map {
1419              
1420 1 50       69 my $double = $_;
    50          
    50          
1421              
1422 0         0 map {
1423              
1424 0         0 my $vowel = $_;
1425              
1426 0         0 map {
1427              
1428 0         0 "\x{0644}" . $double . $vowel . "\x{0627}" . $_, [ "\x{0644}\x{0627}" . $double . $vowel, "\"" . $_ ],
1429              
1430             # quoted
1431              
1432             "\x{0644}" . $double . "\"" . $vowel . "\x{0627}" . $_, [ "\x{0644}\x{0627}" . $double, "\"" . $_ ],
1433             "\x{0644}" . $double . "\"" . $vowel . "\x{0627}\"" . $_, [ "\x{0644}\x{0627}" . $double, $_ ],
1434             "\x{0644}" . $double . $vowel . "\x{0627}\"" . $_, [ "\x{0644}\x{0627}" . $double . $vowel, $_ ],
1435              
1436             } "\x{064E}", "\x{064F}", "\x{0650}"
1437              
1438             } "\x{064E}", "\x{064F}", "\x{0650}"
1439              
1440             } "", "\x{0651}"
1441              
1442             ) : () ),
1443             ),
1444              
1445             # optional ligatures to enforce here
1446              
1447             ];
1448              
1449              
1450             # rules for the novocalize mode
1451              
1452 0         0 $demoder->[2] = [
1453              
1454             [
1455             'silent' => 0,
1456             ],
1457              
1458             "\"\x{0652}", "\x{0652}",
1459             "\"\x{064E}", "\x{064E}",
1460             "\"\x{064F}", "\x{064F}",
1461             "\"\x{0650}", "\x{0650}",
1462             "\"\x{064B}", "\x{064B}",
1463             "\"\x{064C}", "\x{064C}",
1464             "\"\x{064D}", "\x{064D}",
1465             "\"\x{0670}", "\x{0670}",
1466             "\"\x{0657}", "\x{0657}",
1467             "\"\x{0656}", "\x{0656}",
1468              
1469             "\x{0652}", "",
1470             "\x{064E}", "",
1471             "\x{064F}", "",
1472             "\x{0650}", "",
1473             "\x{064B}", "",
1474             "\x{064C}", "",
1475             "\x{064D}", "",
1476             "\x{0670}", "",
1477             "\x{0657}", "",
1478             "\x{0656}", "",
1479              
1480             "\"", "",
1481              
1482             # modern internal substitution with "fictitious" wa.sla .. lam + vowel + 'alif + vowel below
1483              
1484             # modern external substitution with "fictitious" wa.sla
1485              
1486             # laam + 'alif .. either enforce ligatures, or shuffle the diacritics
1487             (
1488             ( $option{'font-fixing'} ? (
1489              
1490             map {
1491              
1492 1 50       90 my $alif = $_;
1493              
1494 0         0 map {
1495              
1496 0         0 my $vowel = $_;
1497              
1498 0         0 map {
1499              
1500 0         0 "\x{0644}" . $_ . $vowel . $alif, "\x{0644}" . $alif . $_,
1501             "\x{0644}" . $_ . "\"" . $vowel . $alif, "\x{0644}" . $alif . $_ . $vowel,
1502              
1503             } "", "\x{0651}"
1504              
1505             } "\x{064E}", "\x{064F}", "\x{0650}",
1506             "\x{064B}", "\x{064C}", "\x{064D}",
1507             "\x{0652}"
1508              
1509             } "\x{0622}", "\x{0623}", "\x{0625}", "\x{0627}", "\x{0671}"
1510              
1511             ) : () ),
1512             ),
1513              
1514             # laam + vowel + 'alif + vowel .. internal substitution with wa.sla
1515              
1516             # optional ligatures to enforce here
1517              
1518             ];
1519              
1520              
1521             # rules for the noshadda mode
1522              
1523 1         6 $demoder->[1] = [
1524              
1525             [
1526             'silent' => 0,
1527             ],
1528              
1529             ];
1530              
1531              
1532             # original no-quotes rules
1533              
1534 3         5 $demoder->[0] = [
1535              
1536             [
1537             'silent' => 0,
1538             ],
1539              
1540             # modern internal substitution with wa.sla .. lam + vowel + 'alif + vowel below
1541             (
1542             map {
1543              
1544 3         5 my $vowel = $_;
1545              
1546 9         28 map {
1547              
1548 3         6 $vowel . "\x{0627}" . $_, $vowel . "\x{0671}",
1549              
1550             } "\x{064E}", "\x{064F}", "\x{0650}"
1551              
1552             } "\x{064E}", "\x{064F}", "\x{0650}"
1553             ),
1554              
1555             # modern external substitution with wa.sla
1556             (
1557             map {
1558              
1559 0         0 my $vowel = $_;
1560              
1561 24         1874 map {
1562              
1563 3         9 "\x{064E}" . $_ . "\x{0627}" . $vowel, [ "\x{064E}" . $_, "\x{0671}" ],
1564             "\x{064F}" . $_ . "\x{0627}" . $vowel, [ "\x{064F}" . $_, "\x{0671}" ],
1565             "\x{0650}" . $_ . "\x{0627}" . $vowel, [ "\x{0650}" . $_, "\x{0671}" ],
1566              
1567             "\x{064E}\x{0627}" . $_ . "\x{0627}" . $vowel, [ "\x{064E}\x{0627}" . $_, "\x{0671}" ],
1568             "\x{064E}\x{0649}" . $_ . "\x{0627}" . $vowel, [ "\x{064E}\x{0649}" . $_, "\x{0671}" ],
1569             "\x{064F}\x{0648}" . $_ . "\x{0627}" . $vowel, [ "\x{064F}\x{0648}" . $_, "\x{0671}" ],
1570             "\x{0650}\x{064A}" . $_ . "\x{0627}" . $vowel, [ "\x{0650}\x{064A}" . $_, "\x{0671}" ],
1571              
1572             } "\x09", "\x0A", "\x0D", "\x20", "\x0D\x0A", "\x20\x20", "\x20\x20\x20", "\x20\x20\x20\x20"
1573              
1574             } "\x{064E}", "\x{064F}", "\x{0650}"
1575             ),
1576              
1577             # laam + 'alif .. either enforce ligatures, or shuffle the diacritics
1578             (
1579             ( $option{'font-fixing'} ? (
1580              
1581             map {
1582              
1583 0         0 my $alif = $_;
1584              
1585 0         0 map {
1586              
1587 0         0 my $vowel = $_;
1588              
1589 0         0 map {
1590              
1591 0         0 "\x{0644}" . $_ . $vowel . $alif,
1592             "\x{0644}" . $alif . $_ . $vowel,
1593              
1594             } "", "\x{0651}"
1595              
1596             } "\x{064E}", "\x{064F}", "\x{0650}",
1597             "\x{064B}", "\x{064C}", "\x{064D}",
1598             "\x{0652}"
1599              
1600             } "\x{0622}", "\x{0623}", "\x{0625}", "\x{0627}", "\x{0671}"
1601              
1602             ) : () ),
1603             ),
1604              
1605             # laam + vowel + 'alif + vowel .. internal substitution with wa.sla
1606             (
1607             ( $option{'font-fixing'} ? (
1608              
1609             map {
1610              
1611 1 50       6 my $double = $_;
    50          
1612              
1613 0         0 map {
1614              
1615 0         0 my $vowel = $_;
1616              
1617 0         0 map {
1618              
1619 0         0 "\x{0644}" . $double . $vowel . "\x{0627}" . $_,
1620             "\x{0644}" . "\x{0671}" . $double . $vowel,
1621              
1622             } "\x{064E}", "\x{064F}", "\x{0650}"
1623              
1624             } "\x{064E}", "\x{064F}", "\x{0650}"
1625              
1626             } "", "\x{0651}"
1627              
1628             ) : () ),
1629             ),
1630              
1631             # optional ligatures to enforce here
1632              
1633             ];
1634              
1635              
1636 2     2   21 no strict 'refs';
  2         5  
  2         734  
1637              
1638 1         20 ${ $cls . '::decoder' }->[$mode + $delevel] = Encode::Mapper->compile(@{$demoder->[$mode]});
  1         11  
  1         34  
1639              
1640 1 50       5 ${ $cls . '::decoder' }->[$mode + $delevel]->describe('') if $option{'describe'};
  0         0  
1641              
1642 1         2 return ${ $cls . '::decoder' }->[$mode + $delevel];
  1         1104  
1643             }
1644              
1645              
1646             1;
1647              
1648             __END__