File Coverage

blib/lib/Encode/Arabic/ArabTeX/ZDMG.pm

Criterion	Covered	Total	%
statement	41	88	46.5
branch	3	8	37.5
condition	3	6	50.0
subroutine	12	14	85.7
pod	2	2	100.0
total	61	118	51.6

line	stmt	bran	cond	sub	pod	time	code
1							# ##################################################################### Otakar Smrz, 2003/08/05
2							#
3							# Encoding of Arabic: ArabTeX Notation by Klaus Lagally, ZDMG #################################
4
5							# $Id: ZDMG.pm 676 2008-08-14 11:25:26Z smrz $
6
7							package Encode::Arabic::ArabTeX::ZDMG;
8
9	2			2		27656	use 5.008;
	2					10
	2					107
10
11	2			2		15	use strict;
	2					4
	2					99
12	2			2		14	use warnings;
	2					5
	2					75
13
14	2			2		15	use Carp;
	2					5
	2					397
15
16							our $VERSION = do { q $Revision: 676 $ =~ /(\d+)/; sprintf "%4.2f", $1 / 100 };
17
18
19	2			2		1117	use Encode::Arabic::ArabTeX ();
	2					75
	2					77
20	2			2		17	use base 'Encode::Arabic::ArabTeX';
	2					4
	2					256
21
22
23	2			2		14	use Encode::Encoding;
	2					5
	2					60
24	2			2		12	use base 'Encode::Encoding';
	2					7
	2					119
25
26							__PACKAGE__->Define('ZDMG', 'ArabTeX-ZDMG');
27
28
29	2			2		14	use Encode::Mapper ':others', ':silent', ':join';
	2					4
	2					30
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
36							sub import { # perform import as if Encode were used one level before this module
37
38	2	100	66	2		39	if (defined $_[1] and $_[1] eq ':xml') { # interfere little with possible Encode's options
39
40	254					367	Encode::Mapper->options (
41
42							'override' => [ # override rules of these LHS .. no other tricks ^^
43
44							( # combinations of '<' and '>' with the other bytes
45							map {
46
47	1					6	my $x = chr $_;
48
49	254					1215	"<" . $x, [ "<" . $x, ">" ], # propagate the '>' sign implying ..
50							">" . $x, [ $x, ">" ], # .. preservation of the bytes
51
52							} 0x00 .. 0x3B, 0x3D, 0x3F .. 0xFF
53							),
54
55							">>", ">", # stop the whole process ..
56							"<>", "<>", # .. do not even start it
57
58							"><", [ "<", ">" ], # rather than nested '<' and '>', ..
59							"<<", [ "<<", ">" ],
60
61							">\\<", [ "<", ">" ], # .. prefer these escape sequences
62							">\\\\", [ "\\", ">" ],
63							">\\>", [ ">", ">" ],
64
65							">", ">", # singular symbols may migrate right ..
66							"<", "<", # .. or preserve the rest of the data
67							]
68
69							);
70
71	1					62	splice @_, 1, 1;
72							}
73
74	2	50	33			15	if (defined $_[1] and $_[1] eq ':describe') {
75
76	0					0	__PACKAGE__->options($_[1]);
77	0					0	splice @_, 1, 1;
78							}
79
80	2					23	require Encode;
81
82	2					85	Encode->export_to_level(1, @_); # here comes the only trick ^^
83							}
84
85
86							sub encoder ($;%) {
87	0			0	1		my ($cls, %opt) = @_;
88
89	0						my $encoder = [];
90
91
92	0						$encoder->[0] = Encode::Mapper->compile (
93
94							[
95							'silent' => 0,
96							],
97
98							"\x{0054}", "\\cap t", "\x{0074}", "t",
99
100							"\x{1E6E}", "\\cap _t", "\x{1E6F}", "_t",
101							"\x{0054}\x{0331}", "\\cap _t", "\x{0074}\x{0331}", "_t",
102
103							"\x{0044}", "\\cap d", "\x{0064}", "d",
104
105							"\x{1E0E}", "\\cap _d", "\x{1E0F}", "_d",
106							"\x{0044}\x{0331}", "\\cap _d", "\x{0064}\x{0331}", "_d",
107
108							"\x{0052}", "\\cap r", "\x{0072}", "r",
109
110							"\x{005A}", "\\cap z", "\x{007A}", "z",
111
112							"\x{0053}", "\\cap s", "\x{0073}", "s",
113
114							"\x{0160}", "\\cap ^s", "\x{0161}", "^s",
115							"\x{0053}\x{030C}", "\\cap ^s", "\x{0073}\x{030C}", "^s",
116
117							"\x{1E62}", "\\cap .s", "\x{1E63}", ".s",
118							"\x{0053}\x{0323}", "\\cap .s", "\x{0073}\x{0323}", ".s",
119
120							"\x{1E0C}", "\\cap .d", "\x{1E0D}", ".d",
121							"\x{0044}\x{0323}", "\\cap .d", "\x{0064}\x{0323}", ".d",
122
123							"\x{1E6C}", "\\cap .t", "\x{1E6D}", ".t",
124							"\x{0054}\x{0323}", "\\cap .t", "\x{0074}\x{0323}", ".t",
125
126							"\x{1E92}", "\\cap .z", "\x{1E93}", ".z",
127							"\x{005A}\x{0323}", "\\cap .z", "\x{007A}\x{0323}", ".z",
128
129							"\x{004C}", "\\cap l", "\x{006C}", "l",
130
131							"\x{004E}", "\\cap n", "\x{006E}", "n",
132
133							# "\x{0054}", "\\cap T", "\x{0074}", "T",
134							# "\x{004E}", "\\cap N", "\x{006E}", "N",
135							# "\x{0057}", "\\cap W", "\x{0077}", "W",
136
137							"\x{0041}", "\\cap a", "\x{0061}", "a",
138
139							"\x{0045}", "\\cap e", "\x{0065}", "e",
140
141							"\x{0049}", "\\cap i", "\x{0069}", "i",
142
143							"\x{004F}", "\\cap o", "\x{006F}", "o",
144
145							"\x{0055}", "\\cap u", "\x{0075}", "u",
146
147							"\x{0100}", "\\cap A", "\x{0101}", "A",
148							"\x{0041}\x{0304}", "\\cap A", "\x{0061}\x{0304}", "A",
149
150							"\x{0112}", "\\cap E", "\x{0113}", "E",
151							"\x{0045}\x{0304}", "\\cap E", "\x{0065}\x{0304}", "E",
152
153							"\x{012A}", "\\cap I", "\x{012B}", "I",
154							"\x{0049}\x{0304}", "\\cap I", "\x{0069}\x{0304}", "I",
155
156							"\x{014C}", "\\cap O", "\x{014D}", "O",
157							"\x{004F}\x{0304}", "\\cap O", "\x{006F}\x{0304}", "O",
158
159							"\x{016A}", "\\cap U", "\x{016B}", "U",
160							"\x{0055}\x{0304}", "\\cap U", "\x{0075}\x{0304}", "U",
161
162							"\x{02BC}", "\"",
163							"\x{02BE}", "'",
164							"\x{02BF}", "`",
165
166							"\x{0042}", "\\cap b", "\x{0062}", "b",
167
168							"\x{01E6}", "\\cap ^g", "\x{01E7}", "^g",
169							"\x{0047}\x{030C}", "\\cap ^g", "\x{0067}\x{030C}", "^g",
170
171							"\x{1E24}", "\\cap .h", "\x{1E25}", ".h",
172							"\x{0048}\x{0323}", "\\cap .h", "\x{0068}\x{0323}", ".h",
173
174							"\x{1E2A}", "\\cap _h", "\x{1E2B}", "_h",
175							"\x{0048}\x{032E}", "\\cap _h", "\x{0068}\x{032E}", "_h",
176
177							"\x{0120}", "\\cap .g", "\x{0121}", ".g",
178							"\x{0047}\x{0307}", "\\cap .g", "\x{0067}\x{0307}", ".g",
179
180							"\x{0046}", "\\cap f", "\x{0066}", "f",
181
182							"\x{0051}", "\\cap q", "\x{0071}", "q",
183
184							"\x{004B}", "\\cap k", "\x{006B}", "k",
185
186							"\x{004D}", "\\cap m", "\x{006D}", "m",
187
188							"\x{0048}", "\\cap h", "\x{0068}", "h",
189
190							"\x{0057}", "\\cap w", "\x{0077}", "w",
191
192							"\x{0059}", "\\cap y", "\x{0079}", "y",
193
194
195							"\x{0050}", "\\cap p", "\x{0070}", "p",
196
197							"\x{0056}", "\\cap v", "\x{0076}", "v",
198
199							"\x{0047}", "\\cap g", "\x{0067}", "g",
200
201
202							"\x{0043}", "\\cap c", "\x{0063}", "c",
203
204							"\x{010C}", "\\cap ^c", "\x{010D}", "^c",
205							"\x{0043}\x{030C}", "\\cap ^c", "\x{0063}\x{030C}", "^c",
206
207							"\x{0106}", "\\cap ,c", "\x{0107}", ",c",
208							"\x{0043}\x{0301}", "\\cap ,c", "\x{0063}\x{0301}", ",c",
209
210							"\x{017D}", "\\cap ^z", "\x{017E}", "^z",
211							"\x{005A}\x{030C}", "\\cap ^z", "\x{007A}\x{030C}", "^z",
212
213							"\x{00D1}", "\\cap ^n", "\x{00F1}", "^n",
214							"\x{004E}\x{0303}", "\\cap ^n", "\x{006E}\x{0303}", "^n",
215
216							"\x{004C}\x{0303}", "\\cap ^l", "\x{006C}\x{0303}", "^l",
217
218							"\x{0052}\x{0307}", "\\cap .r", "\x{0072}\x{0307}", ".r",
219
220							);
221
222
223	2			2		17	no strict 'refs';
	2					6
	2					9115
224
225	0						${ $cls . '::encoder' } = $encoder;
	0
226
227	0	0					if ($option{'describe'}) {
228
229	0						$_->describe('') foreach @{${ $cls . '::encoder' }};
	0
	0
230							}
231
232	0						return ${ $cls . '::encoder' };
	0
233							}
234
235
236							sub decoder ($;$$) {
237	0			0	1		my ($cls, undef, undef) = @_;
238
239	0						my $decoder = [];
240
241
242	0						my @sunny = (
243							[ "t", "\x{0074}" ],
244							[ "_t", "\x{0074}\x{0331}" ], # "\x{1E6F}"
245							[ "d", "\x{0064}" ],
246							[ "_d", "\x{0064}\x{0331}" ], # "\x{1E0F}"
247							[ "r", "\x{0072}" ],
248							[ "z", "\x{007A}" ],
249							[ "s", "\x{0073}" ],
250							[ "^s", "\x{0073}\x{030C}" ], # "\x{0161}"
251							[ ".s", "\x{0073}\x{0323}" ], # "\x{1E63}"
252							[ ".d", "\x{0064}\x{0323}" ], # "\x{1E0D}"
253							[ ".t", "\x{0074}\x{0323}" ], # "\x{1E6D}"
254							[ ".z", "\x{007A}\x{0323}" ], # "\x{1E93}"
255							[ "l", "\x{006C}" ],
256							[ "n", "\x{006E}" ],
257							);
258
259
260	0						my @extra = (
261							[ "T", "\x{0074}" ],
262							[ "H", "\x{0068}" ], # ""
263							[ "N", "\x{006E}" ],
264							[ "W", "\x{0077}" ], # ""
265							);
266
267
268	0						my @vowel = (
269							[ "a", "\x{0061}" ],
270							[ "_a", "\x{0061}\x{0304}" ], # "\x{0101}"
271							[ "_aA", "\x{0061}\x{0304}" ], # "\x{0101}"
272							[ "_aY", "\x{0061}\x{0304}" ], # "\x{0101}"
273							[ "_aU", "\x{0061}\x{0304}" ], # "\x{0101}"
274							[ "_aI", "\x{0061}\x{0304}" ], # "\x{0101}"
275							[ "A", "\x{0061}\x{0304}" ], # "\x{0101}"
276							[ "^A", "\x{0061}\x{0304}" ], # "\x{0101}"
277							[ "e", "\x{0065}" ],
278							[ "E", "\x{0065}\x{0304}" ], # "\x{0113}"
279							[ "i", "\x{0069}" ],
280							[ "_i", "\x{0069}\x{0304}" ], # "\x{012B}"
281							[ "I", "\x{0069}\x{0304}" ], # "\x{012B}"
282							[ "^I", "\x{0069}\x{0304}" ], # "\x{012B}"
283							[ "_I", "\x{0069}" ],
284							[ "o", "\x{006F}" ],
285							[ "O", "\x{006F}\x{0304}" ], # "\x{014D}"
286							[ "u", "\x{0075}" ],
287							[ "_u", "\x{0075}\x{0304}" ], # "\x{016B}"
288							[ "U", "\x{0075}\x{0304}" ], # "\x{016B}"
289							[ "^U", "\x{0075}\x{0304}" ], # "\x{016B}"
290							[ "_U", "\x{0075}" ],
291							[ "Y", "\x{0061}\x{0304}" ], # "\x{0101}"
292							);
293
294
295	0						my @minor = (
296							[ "'", "\x{02BE}" ], # "\x{02BC}"
297							[ "`", "\x{02BF}" ], # "\x{02BB}"
298							);
299
300
301	0						my @empty = (
302							[ "\"", "", ], # "\x{02BC}"
303							[ "\|", "", ],
304							[ "B", "", ],
305							);
306
307
308	0						my @moony = (
309							[ "b", "\x{0062}" ],
310							[ "^g", "\x{0067}\x{030C}" ], # "\x{01E7}"
311							[ ".h", "\x{0068}\x{0323}" ], # "\x{1E25}"
312							[ "_h", "\x{0068}\x{032E}" ], # "\x{1E2B}"
313							[ ".g", "\x{0067}\x{0307}" ], # "\x{0121}"
314							[ "f", "\x{0066}" ],
315							[ "q", "\x{0071}" ],
316							[ "k", "\x{006B}" ],
317							[ "m", "\x{006D}" ],
318							[ "h", "\x{0068}" ],
319							[ "w", "\x{0077}" ],
320							[ "y", "\x{0079}" ],
321
322							[ "p", "\x{0070}" ],
323							[ "v", "\x{0076}" ],
324							[ "g", "\x{0067}" ],
325
326							[ "c", "\x{0063}" ],
327							[ "^c", "\x{0063}\x{030C}" ], # "\x{010D}"
328							[ ",c", "\x{0063}\x{0301}" ], # "\x{0107}"
329							[ "^z", "\x{007A}\x{030C}" ], # "\x{017E}"
330							[ "^n", "\x{006E}\x{0303}" ], # "\x{00F1}"
331							[ "^l", "\x{006C}\x{0303}" ],
332							[ ".r", "\x{0072}\x{0307}" ],
333							);
334
335
336	0						$decoder->[0] = Encode::Mapper->compile (
337
338							[
339							'silent' => 0,
340							],
341
342							# definite article assimilation .. non-linguistic
343							(
344							map {
345
346	0						"l-" . $_->[0] x 2, [ '', $_->[0] . "-" . $_->[0] ],
347
348							} @sunny, @moony
349							),
350
351							# initial vowel tying
352							(
353							map {
354
355	0						my $x = $_;
356
357	0						map {
358
359	0						my $y = $_;
360
361	0						map {
362
363	0						$x->[0] . $_ . $y, $x->[1] . $_ . "\x{02BC}", # "\x{02C8}"
364
365							"\\cap\x09" . $x->[0] . $_ . $y, ucfirst $x->[1] . $_ . "\x{02BC}", # "\x{02C8}"
366							"\\cap\x0A" . $x->[0] . $_ . $y, ucfirst $x->[1] . $_ . "\x{02BC}", # "\x{02C8}"
367							"\\cap\x0D" . $x->[0] . $_ . $y, ucfirst $x->[1] . $_ . "\x{02BC}", # "\x{02C8}"
368							"\\cap\x20" . $x->[0] . $_ . $y, ucfirst $x->[1] . $_ . "\x{02BC}", # "\x{02C8}"
369
370							} "-", "\x09", "\x0A", "\x0D", "\x20", "\x0D\x0A",
371							"\x20\x20", "\x20\x20\x20", "\x20\x20\x20\x20"
372
373							} "a", "e", "i", "o", "u"
374
375							} @vowel
376							),
377
378							# silence the silent
379
380							"WA", [ "", "W" ],
381
382							"UW", [ "", "U" ],
383							"UA", [ "", "U" ],
384
385							"NA", [ "", "N" ],
386							"NY", [ "", "N" ],
387							"NU", [ "", "N" ],
388							"N_A", [ "", "N" ],
389
390							# regular capitalization
391							(
392							map {
393
394	0						$_->[0], $_->[1],
395
396							"\\cap\x09" . $_->[0], ucfirst $_->[1],
397							"\\cap\x0A" . $_->[0], ucfirst $_->[1],
398							"\\cap\x0D" . $_->[0], ucfirst $_->[1],
399							"\\cap\x20" . $_->[0], ucfirst $_->[1],
400
401							} @sunny, @moony, @empty, @vowel, @extra
402							),
403
404							(
405							map {
406
407	0						$_->[0] . "i", $_->[1] . "i",
408							$_->[0] . "u", $_->[1] . "u",
409
410							"\\cap\x09" . $_->[0] . "i", ucfirst $_->[1] . "i",
411							"\\cap\x0A" . $_->[0] . "i", ucfirst $_->[1] . "i",
412							"\\cap\x0D" . $_->[0] . "i", ucfirst $_->[1] . "i",
413							"\\cap\x20" . $_->[0] . "i", ucfirst $_->[1] . "i",
414
415							"\\cap\x09" . $_->[0] . "u", ucfirst $_->[1] . "u",
416							"\\cap\x0A" . $_->[0] . "u", ucfirst $_->[1] . "u",
417							"\\cap\x0D" . $_->[0] . "u", ucfirst $_->[1] . "u",
418							"\\cap\x20" . $_->[0] . "u", ucfirst $_->[1] . "u",
419
420							} @sunny, @moony, @empty
421							),
422
423							(
424							map {
425
426	0						my $x = $_;
427
428	0						map {
429
430	0						$x->[0] . "i" . $_, [ $x->[1], "i" . $_ ],
431							$x->[0] . "u" . $_, [ $x->[1], "u" . $_ ],
432
433							"\\cap\x09" . $x->[0] . "i" . $_, [ ucfirst $x->[1], "i" . $_ ],
434							"\\cap\x0A" . $x->[0] . "i" . $_, [ ucfirst $x->[1], "i" . $_ ],
435							"\\cap\x0D" . $x->[0] . "i" . $_, [ ucfirst $x->[1], "i" . $_ ],
436							"\\cap\x20" . $x->[0] . "i" . $_, [ ucfirst $x->[1], "i" . $_ ],
437
438							"\\cap\x09" . $x->[0] . "u" . $_, [ ucfirst $x->[1], "u" . $_ ],
439							"\\cap\x0A" . $x->[0] . "u" . $_, [ ucfirst $x->[1], "u" . $_ ],
440							"\\cap\x0D" . $x->[0] . "u" . $_, [ ucfirst $x->[1], "u" . $_ ],
441							"\\cap\x20" . $x->[0] . "u" . $_, [ ucfirst $x->[1], "u" . $_ ],
442
443							} "-", "\x09", "\x0A", "\x0D", "\x20"
444
445							} @sunny, @moony, @empty
446							),
447
448							# initial vowel assimilation
449							(
450							map {
451
452	0						"i" . $_, [ '', "I" ],
453							"u" . $_, [ '', "U" ],
454
455							"\\cap\x09" . "i" . $_, [ '', "\\cap\x09" . "I" ],
456							"\\cap\x0A" . "i" . $_, [ '', "\\cap\x0A" . "I" ],
457							"\\cap\x0D" . "i" . $_, [ '', "\\cap\x0D" . "I" ],
458							"\\cap\x20" . "i" . $_, [ '', "\\cap\x20" . "I" ],
459
460							"\\cap\x09" . "u" . $_, [ '', "\\cap\x09" . "U" ],
461							"\\cap\x0A" . "u" . $_, [ '', "\\cap\x0A" . "U" ],
462							"\\cap\x0D" . "u" . $_, [ '', "\\cap\x0D" . "U" ],
463							"\\cap\x20" . "u" . $_, [ '', "\\cap\x20" . "U" ],
464
465							} "y", "w" # "'"
466							),
467
468							# capitalization of minors
469							(
470							map {
471
472	0						$_->[0], $_->[1],
473
474							$_->[0] . "i", $_->[1] . "i",
475							$_->[0] . "u", $_->[1] . "u",
476
477							"\\cap\x09" . $_->[0], [ $_->[1], "\\cap " ],
478							"\\cap\x0A" . $_->[0], [ $_->[1], "\\cap " ],
479							"\\cap\x0D" . $_->[0], [ $_->[1], "\\cap " ],
480							"\\cap\x20" . $_->[0], [ $_->[1], "\\cap " ],
481
482							"\\cap\x09" . $_->[0] . "i", $_->[1] . ucfirst "i",
483							"\\cap\x0A" . $_->[0] . "i", $_->[1] . ucfirst "i",
484							"\\cap\x0D" . $_->[0] . "i", $_->[1] . ucfirst "i",
485							"\\cap\x20" . $_->[0] . "i", $_->[1] . ucfirst "i",
486
487							"\\cap\x09" . $_->[0] . "u", $_->[1] . ucfirst "u",
488							"\\cap\x0A" . $_->[0] . "u", $_->[1] . ucfirst "u",
489							"\\cap\x0D" . $_->[0] . "u", $_->[1] . ucfirst "u",
490							"\\cap\x20" . $_->[0] . "u", $_->[1] . ucfirst "u",
491
492							} @minor
493							),
494
495							(
496							map {
497
498	0						my $x = $_;
499
500	0						map {
501
502	0						$x->[0] . "i" . $_, [ $x->[1], "i" . $_ ],
503							$x->[0] . "u" . $_, [ $x->[1], "u" . $_ ],
504
505							"\\cap\x09" . $x->[0] . "i" . $_, [ $x->[1], "\\cap i" . $_ ],
506							"\\cap\x0A" . $x->[0] . "i" . $_, [ $x->[1], "\\cap i" . $_ ],
507							"\\cap\x0D" . $x->[0] . "i" . $_, [ $x->[1], "\\cap i" . $_ ],
508							"\\cap\x20" . $x->[0] . "i" . $_, [ $x->[1], "\\cap i" . $_ ],
509
510							"\\cap\x09" . $x->[0] . "u" . $_, [ $x->[1], "\\cap u" . $_ ],
511							"\\cap\x0A" . $x->[0] . "u" . $_, [ $x->[1], "\\cap u" . $_ ],
512							"\\cap\x0D" . $x->[0] . "u" . $_, [ $x->[1], "\\cap u" . $_ ],
513							"\\cap\x20" . $x->[0] . "u" . $_, [ $x->[1], "\\cap u" . $_ ],
514
515							} "-", "\x09", "\x0A", "\x0D", "\x20"
516
517							} @minor
518							),
519
520							# white-space collapsing
521							(
522							map {
523
524	0						"\\cap\x09" . $_, [ '', "\\cap " ],
525							"\\cap\x0A" . $_, [ '', "\\cap " ],
526							"\\cap\x0D" . $_, [ '', "\\cap " ],
527							"\\cap\x20" . $_, [ '', "\\cap " ],
528
529							} "\x09", "\x0A", "\x0D", "\x20"
530							),
531
532							);
533
534
535	2			2		24	no strict 'refs';
	2					4
	2					723
536
537	0						${ $cls . '::decoder' } = $decoder;
	0
538
539	0	0					if ($option{'describe'}) {
540
541	0						$_->describe('') foreach @{${ $cls . '::decoder' }};
	0
	0
542							}
543
544	0						return ${ $cls . '::decoder' };
	0
545							}
546
547
548							1;
549
550							__END__