File Coverage

blib/lib/Encode/Arabic/ArabTeX/Verbatim.pm
Criterion Covered Total %
statement 48 200 24.0
branch 4 122 3.2
condition 4 17 23.5
subroutine 14 19 73.6
pod 2 5 40.0
total 72 363 19.8


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