line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# ###################################################################### Otakar Smrz, 2003/01/23 |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Encoding of Arabic: Dil Parkinson's Notation ###################################### 2006/02/03 |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Encode::Arabic::Parkinson; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '14.1'; |
8
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
13455
|
use 5.008; |
|
2
|
|
|
|
|
5
|
|
10
|
|
|
|
|
|
|
|
11
|
2
|
|
|
2
|
|
9
|
use strict; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
44
|
|
12
|
2
|
|
|
2
|
|
5
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
41
|
|
13
|
|
|
|
|
|
|
|
14
|
2
|
|
|
2
|
|
5
|
use Scalar::Util 'blessed'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
113
|
|
15
|
|
|
|
|
|
|
|
16
|
2
|
|
|
2
|
|
380
|
use Encode::Encoding; |
|
2
|
|
|
|
|
7035
|
|
|
2
|
|
|
|
|
43
|
|
17
|
2
|
|
|
2
|
|
6
|
use base 'Encode::Encoding'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
695
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
__PACKAGE__->Define('Parkinson', 'Dil'); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
our $enmode; |
23
|
|
|
|
|
|
|
our $demode; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our $optxml; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
our %modemap = ( |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
'default' => 0, |
30
|
|
|
|
|
|
|
'undef' => 0, |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
'fullvocalize' => 0, |
33
|
|
|
|
|
|
|
'full' => 0, |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
'nowasla' => 4, |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
'vocalize' => 3, |
38
|
|
|
|
|
|
|
'nosukuun' => 3, |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
'novocalize' => 2, |
41
|
|
|
|
|
|
|
'novowels' => 2, |
42
|
|
|
|
|
|
|
'none' => 2, |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
'noshadda' => 1, |
45
|
|
|
|
|
|
|
'noneplus' => 1, |
46
|
|
|
|
|
|
|
); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# use subs 'encoder', 'decoder'; # ignores later prototypes |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub encoder ($); # respect prototypes |
52
|
|
|
|
|
|
|
sub decoder ($); # respect prototypes |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub import { # perform import as if Encode were used one level before this module |
56
|
|
|
|
|
|
|
|
57
|
2
|
50
|
33
|
2
|
|
14
|
$optxml = defined $_[1] && $_[1] eq ':xml' ? 1 : 0; |
58
|
|
|
|
|
|
|
|
59
|
2
|
|
|
|
|
3
|
__PACKAGE__->enmode('full'); |
60
|
2
|
|
|
|
|
7
|
__PACKAGE__->demode('full'); |
61
|
|
|
|
|
|
|
|
62
|
2
|
|
|
|
|
3
|
splice @_, 1, 1; |
63
|
|
|
|
|
|
|
|
64
|
2
|
|
|
|
|
8
|
require Encode; |
65
|
|
|
|
|
|
|
|
66
|
2
|
100
|
|
|
|
23
|
push @Encode::ISA, 'Exporter' unless Encode->can('export_to_level'); |
67
|
|
|
|
|
|
|
|
68
|
2
|
|
|
|
|
175
|
Encode->export_to_level(1, @_); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub encode ($$;$) { |
73
|
2
|
|
|
2
|
1
|
1043
|
my (undef, $text, $check) = @_; |
74
|
|
|
|
|
|
|
|
75
|
2
|
50
|
|
|
|
5
|
$_[1] = '' if $check; # needed by in-place edit |
76
|
|
|
|
|
|
|
|
77
|
2
|
|
|
|
|
53
|
$text = encoder $text; |
78
|
|
|
|
|
|
|
|
79
|
2
|
50
|
|
|
|
17
|
$text = Encode::encode "utf8", $text if Encode::is_utf8($text); |
80
|
|
|
|
|
|
|
|
81
|
2
|
|
|
|
|
36
|
return $text; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub decode ($$;$) { |
86
|
2
|
|
|
2
|
1
|
377
|
my (undef, $text, $check) = @_; |
87
|
|
|
|
|
|
|
|
88
|
2
|
50
|
|
|
|
4
|
$_[1] = '' if $check; # needed by in-place edit |
89
|
|
|
|
|
|
|
|
90
|
2
|
50
|
|
|
|
8
|
$text = Encode::decode "utf8", $text unless Encode::is_utf8($text); |
91
|
|
|
|
|
|
|
|
92
|
2
|
|
|
|
|
81
|
$text = decoder $text; |
93
|
|
|
|
|
|
|
|
94
|
2
|
|
|
|
|
4
|
return $text; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub enmode ($$;$$) { |
99
|
2
|
|
|
2
|
0
|
4
|
my ($cls, $mode, $xml, $kshd) = @_; |
100
|
|
|
|
|
|
|
|
101
|
2
|
50
|
|
|
|
4
|
$cls = blessed $cls if ref $cls; |
102
|
2
|
50
|
|
|
|
5
|
$xml = $optxml unless defined $xml; |
103
|
|
|
|
|
|
|
|
104
|
2
|
50
|
|
|
|
3
|
$mode = 'undef' unless defined $mode; |
105
|
2
|
50
|
|
|
|
5
|
$mode = $modemap{$mode} if exists $modemap{$mode}; |
106
|
|
|
|
|
|
|
|
107
|
2
|
|
|
2
|
|
7
|
no strict 'refs'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
347
|
|
108
|
|
|
|
|
|
|
|
109
|
2
|
|
|
|
|
2
|
my $return = ${ $cls . '::enmode' }; |
|
2
|
|
|
|
|
6
|
|
110
|
|
|
|
|
|
|
|
111
|
2
|
50
|
|
|
|
4
|
if (defined $mode) { |
112
|
|
|
|
|
|
|
|
113
|
2
|
|
|
|
|
2
|
${ $cls . '::enmode' } = $mode; |
|
2
|
|
|
|
|
4
|
|
114
|
|
|
|
|
|
|
|
115
|
2
|
50
|
|
|
|
658
|
my @set = ( |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
( $kshd |
118
|
|
|
|
|
|
|
? '' |
119
|
|
|
|
|
|
|
: q [\x{0640}] ) . |
120
|
|
|
|
|
|
|
q [\x{0623}\x{0624}\x{0625}] . |
121
|
|
|
|
|
|
|
q [\x{060C}\x{061B}\x{061F}] . |
122
|
|
|
|
|
|
|
q [\x{0621}\x{0622}\x{0626}-\x{063A}\x{0641}-\x{064A}] . |
123
|
|
|
|
|
|
|
q [\x{0660}-\x{0669}] . |
124
|
|
|
|
|
|
|
q [\x{0671}] . |
125
|
|
|
|
|
|
|
q [\x{0651}] . |
126
|
|
|
|
|
|
|
q [\x{064B}-\x{0650}\x{0670}] . |
127
|
|
|
|
|
|
|
q [\x{0652}] . |
128
|
|
|
|
|
|
|
( $kshd |
129
|
|
|
|
|
|
|
? q [\x{0640}] |
130
|
|
|
|
|
|
|
: '' ) |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
, |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
( $kshd |
135
|
|
|
|
|
|
|
? '' |
136
|
|
|
|
|
|
|
: q [_] ) . |
137
|
|
|
|
|
|
|
q [LWE] . |
138
|
|
|
|
|
|
|
q [,;?] . |
139
|
|
|
|
|
|
|
q [CMYAbQtVjHxdvrzspSDTZcgfqklmnhwey] . |
140
|
|
|
|
|
|
|
q [0-9] . |
141
|
|
|
|
|
|
|
( $mode == 0 |
142
|
|
|
|
|
|
|
? q [O] |
143
|
|
|
|
|
|
|
: q [A] ) . |
144
|
|
|
|
|
|
|
( $mode == 1 |
145
|
|
|
|
|
|
|
? '' |
146
|
|
|
|
|
|
|
: q [~] . ( $mode == 2 |
147
|
|
|
|
|
|
|
? '' |
148
|
|
|
|
|
|
|
: q [NUIauiR] . ( $mode == 3 |
149
|
|
|
|
|
|
|
? '' |
150
|
|
|
|
|
|
|
: q [o] ) ) ) |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
); |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
|
155
|
2
|
|
|
|
|
3
|
undef &encoder; |
156
|
|
|
|
|
|
|
|
157
|
1
|
|
|
1
|
0
|
469
|
eval q / |
|
1
|
|
|
2
|
|
27
|
|
|
1
|
|
|
|
|
11
|
|
|
2
|
|
|
|
|
170
|
|
|
2
|
|
|
|
|
33
|
|
|
2
|
|
|
|
|
5
|
|
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub encoder ($) { |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
$_[0] =~ tr[/ . $set[0] . q /] |
162
|
|
|
|
|
|
|
[/ . $set[1] . q /]d; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
return $_[0]; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
/; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
2
|
|
|
|
|
4477
|
return $return; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub demode ($$;$$) { |
174
|
2
|
|
|
2
|
0
|
3
|
my ($cls, $mode, $xml, $kshd) = @_; |
175
|
|
|
|
|
|
|
|
176
|
2
|
50
|
|
|
|
6
|
$cls = blessed $cls if ref $cls; |
177
|
2
|
50
|
|
|
|
6
|
$xml = $optxml unless defined $xml; |
178
|
|
|
|
|
|
|
|
179
|
2
|
50
|
|
|
|
4
|
$mode = 'undef' unless defined $mode; |
180
|
2
|
50
|
|
|
|
9
|
$mode = $modemap{$mode} if exists $modemap{$mode}; |
181
|
|
|
|
|
|
|
|
182
|
2
|
|
|
2
|
|
7
|
no strict 'refs'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
329
|
|
183
|
|
|
|
|
|
|
|
184
|
2
|
|
|
|
|
1
|
my $return = ${ $cls . '::demode' }; |
|
2
|
|
|
|
|
5
|
|
185
|
|
|
|
|
|
|
|
186
|
2
|
50
|
|
|
|
6
|
if (defined $mode) { |
187
|
|
|
|
|
|
|
|
188
|
2
|
|
|
|
|
2
|
${ $cls . '::demode' } = $mode; |
|
2
|
|
|
|
|
4
|
|
189
|
|
|
|
|
|
|
|
190
|
2
|
50
|
|
|
|
43
|
my @set = ( |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
( $kshd |
193
|
|
|
|
|
|
|
? '' |
194
|
|
|
|
|
|
|
: q [_] ) . |
195
|
|
|
|
|
|
|
q [LWE] . |
196
|
|
|
|
|
|
|
q [,;?] . |
197
|
|
|
|
|
|
|
q [CMYAbQtVjHxdvrzspSDTZcgfqklmnhwey] . |
198
|
|
|
|
|
|
|
q [0-9] . |
199
|
|
|
|
|
|
|
q [O] . |
200
|
|
|
|
|
|
|
q [~] . |
201
|
|
|
|
|
|
|
q [NUIauiR] . |
202
|
|
|
|
|
|
|
q [o] . |
203
|
|
|
|
|
|
|
( $kshd |
204
|
|
|
|
|
|
|
? q [_] |
205
|
|
|
|
|
|
|
: '' ) |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
, |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
( $kshd |
210
|
|
|
|
|
|
|
? '' |
211
|
|
|
|
|
|
|
: q [\x{0640}] ) . |
212
|
|
|
|
|
|
|
q [\x{0623}\x{0624}\x{0625}] . |
213
|
|
|
|
|
|
|
q [\x{060C}\x{061B}\x{061F}] . |
214
|
|
|
|
|
|
|
q [\x{0621}\x{0622}\x{0626}\x{0627}\x{0628}\x{0629}\x{062A}\x{062B}\x{062C}\x{062D}\x{062E}] . |
215
|
|
|
|
|
|
|
q [\x{062F}\x{0630}\x{0631}\x{0632}\x{0633}\x{0634}\x{0635}\x{0636}\x{0637}\x{0638}\x{0639}] . |
216
|
|
|
|
|
|
|
q [\x{063A}\x{0641}\x{0642}\x{0643}\x{0644}\x{0645}\x{0646}\x{0647}\x{0648}\x{0649}\x{064A}] . |
217
|
|
|
|
|
|
|
q [\x{0660}\x{0661}\x{0662}\x{0663}\x{0664}\x{0665}\x{0666}\x{0667}\x{0668}\x{0669}] . |
218
|
|
|
|
|
|
|
( $mode == 0 |
219
|
|
|
|
|
|
|
? q [\x{0671}] |
220
|
|
|
|
|
|
|
: q [\x{0627}] ) . |
221
|
|
|
|
|
|
|
( $mode == 1 |
222
|
|
|
|
|
|
|
? '' |
223
|
|
|
|
|
|
|
: q [\x{0651}] . ( $mode == 2 |
224
|
|
|
|
|
|
|
? '' |
225
|
|
|
|
|
|
|
: q [\x{064B}\x{064C}\x{064D}\x{064E}\x{064F}\x{0650}\x{0670}] . ( $mode == 3 |
226
|
|
|
|
|
|
|
? '' |
227
|
|
|
|
|
|
|
: q [\x{0652}] ) ) ) |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
); |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
232
|
2
|
|
|
|
|
4
|
undef &decoder; |
233
|
|
|
|
|
|
|
|
234
|
2
|
50
|
33
|
2
|
0
|
175
|
eval q / |
|
2
|
|
|
|
|
18
|
|
|
2
|
|
|
|
|
3
|
|
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub decoder ($) { |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
$_[0] =~ tr[/ . $set[0] . q /] |
239
|
|
|
|
|
|
|
[/ . $set[1] . q /]/ . (($kshd or $mode > 0) ? 'd' : '') . q /; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
return $_[0]; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
/; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
2
|
|
|
|
|
1201
|
return $return; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
1; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
__END__ |