File Coverage

blib/lib/Encode/Arabic/ArabTeX/RE.pm
Criterion Covered Total %
statement 35 174 20.1
branch 0 32 0.0
condition 0 9 0.0
subroutine 12 18 66.6
pod 2 6 33.3
total 49 239 20.5


line stmt bran cond sub pod time code
1             # ################################################################### Otakar Smrz, 2003/01/23
2             #
3             # Encoding of Arabic: ArabTeX Notation by Klaus Lagally #####################################
4              
5             # $Id: RE.pm 162 2006-12-16 00:16:10Z smrz $
6              
7             package Encode::Arabic::ArabTeX::RE;
8              
9 2     2   28670 use 5.008;
  2         7  
  2         90  
10              
11 2     2   10 use strict;
  2         4  
  2         64  
12 2     2   10 use warnings;
  2         3  
  2         71  
13              
14 2     2   11 use Scalar::Util 'blessed';
  2         3  
  2         288  
15              
16             our $VERSION = do { q $Revision: 162 $ =~ /(\d+)/; sprintf "%4.2f", $1 / 100 };
17              
18              
19 2     2   1025 use Encode::Encoding;
  2         14535  
  2         71  
20 2     2   14 use base 'Encode::Encoding';
  2         4  
  2         2987  
21              
22             __PACKAGE__->Define('ArabTeX-RE');
23              
24              
25             our (%encode_used, %decode_used, @shams, @qamar);
26              
27             our $enmode;
28             our $demode;
29              
30             our %modemap = (
31              
32             'default' => 3,
33             'undef' => 0,
34              
35             'fullvocalize' => 4,
36             'full' => 4,
37              
38             'vocalize' => 3,
39             'nosukuun' => 3,
40              
41             'novocalize' => 2,
42             'novowels' => 2,
43             'none' => 2,
44              
45             'noshadda' => 1,
46             'noneplus' => 1,
47             );
48              
49              
50             sub import { # perform import as if Encode were used one level before this module
51 2     2   23 require Encode;
52 2         64 Encode->export_to_level(1, @_);
53             }
54              
55              
56             sub encode ($$;$) {
57 0     0 1   my ($cls, $text, $check) = @_;
58              
59 0 0         $_[1] = '' if $check; # this is what in-place edit needs
60              
61 0 0         $cls->initialize_encode() unless %encode_used;
62              
63 0 0         $text = join '', map { exists $encode_used{$_} ? $encode_used{$_} : $_ } split '', $text;
  0            
64              
65 0           $text =~ s/([\_\.\^]?\w)\\shadda{}/$1$1/g;
66 0           $text =~ s/(\\ham{.})\\shadda{}/$1$1/g;
67              
68 0           $text =~ s/([\=\s\-\%])\\alif{}\\vow{a}l/$1"al-/g;
69 0           $text =~ s/([\=\s\-\%])\\alif{}l/$1al-/g;
70 0           $text =~ s/(b\\vow{i})\\alif{}l/$1-al-/g;
71 0           $text =~ s/([\=\s\-\%])\\alif{}\\vow{([ui])}/$1"$2/g;
72 0           $text =~ s/([\=\s\-\%])\\alif{}/$1i/g;
73 0           $text =~ s/(\\vow{aN})\\alif{}/$1/g;
74 0           $text =~ s/\\alif{}(\\vow{aN})/$1/g;
75 0           $text =~ s/\\vow{a}\\alif{}/\\vow{A}/g;
76 0           $text =~ s/\\alif{}/\\aux{A}/g;
77              
78 0           $text =~ s/\\madda{}/'A/g;
79              
80 0           $text =~ s/\\vow{a}\\maq{}/\\vow{Y}/g;
81 0           $text =~ s/\\maq{}(\\vow{aN})/\\vow{aNY}/g;
82 0           $text =~ s/\\vow{aN}\\maq{}/\\vow{aNY}/g;
83 0           $text =~ s/\\maq{}/\\aux{Y}/g;
84              
85 0           $text =~ s/i(}?)y([^aiuAIUY])/I$1$2/g; # produces \ham{I}, too
86 0           $text =~ s/u(}?)w([^aiuAIUY])/U$1$2/g;
87              
88 0           $text =~ s/([iIuU]})(\\ham{a})/$1-$2/g;
89 0           $text =~ s/([\-\s])\\ham{a}([^\\])/$1'\\aux{a}$2/g;
90 0           $text =~ s/([^\}\s])\\ham{a}/$1\\aux{a}'/g;
91              
92 0           $text =~ s/([^\-\s])(\\ham{i})/$1-$2/g;
93 0           $text =~ s/\\ham{i}([^\\])/'\\aux{i}$1/g;
94              
95 0           $text =~ s/([^\}])(\\ham{w})/$1\\aux{u}$2/g;
96 0           $text =~ s/(\\ham{w})([^\\])/$1\\aux{u}$2/g;
97              
98 0           $text =~ s/([^\}])(\\ham{y})/$1\\aux{i}$2/g;
99 0           $text =~ s/(\\ham{y})([^\\])/$1\\aux{i}$2/g;
100              
101 0           $text =~ s/\\ham{[aiwy]}/'/g;
102 0           $text =~ s/\\ham{I}/'I/g;
103              
104 0           $text =~ s/(?
105              
106              
107 2     2   15 no strict 'refs';
  2         11  
  2         4526  
108              
109 0 0 0       if (defined ${ $cls . '::enmode' } and ${ $cls . '::enmode' } == 3) {
  0 0 0        
  0 0 0        
  0            
110              
111 0           $text =~ s/\\vow{(.+?)}/$1/g;
112 0           $text =~ s/\\aux{(.+?)}/"$1/g;
113 0           $text =~ s/\\sukun{}/"/g;
114             }
115 0           elsif (defined ${ $cls . '::enmode' } and ${ $cls . '::enmode' } == 2) {
  0            
116              
117 0           $text =~ s/\\vow{(.+?)}/"$1/g;
118 0           $text =~ s/\\aux{(.+?)}/$1/g;
119 0           $text =~ s/\\sukun{}/"/g;
120             }
121 0           elsif (defined ${ $cls . '::enmode' } and ${ $cls . '::enmode' } == 4) {
122              
123 0           $text =~ s/\\vow{(.+?)}/$1/g;
124 0           $text =~ s/\\aux{(.+?)}/$1/g;
125 0           $text =~ s/\\sukun{}//g;
126             }
127              
128 0           return $text;
129             }
130              
131              
132             sub decode ($$;$) {
133 0     0 1   my ($cls, $text, $check) = @_;
134 0           my $one;
135              
136 0 0         $_[1] = '' if $check; # this is what in-place edit needs
137              
138 0 0         $cls->initialize_decode() unless %decode_used;
139              
140 0           $text = "\n" . $text . "\n";
141              
142 0           $text =~ s/_a/a/g; # is there any special character for the defective fatha?
143 0           $text =~ s/_U/U/g; # _U only affects the pronunciation, not the spelling
144              
145 0           foreach $one (@shams, '\\\'', @qamar) {
146              
147 0           $text =~ s/(?
148 0           $text =~ s/(?
149             # alas! using $one in the replacing expression produces extra \\
150             }
151              
152 0           $text =~ s/([\s\-])([aiu])/$1\\L{}$2/gs;
153              
154 0           $text =~ s/([\s\-])'([auUY])/$1\\H{a}$2/gs;
155 0           $text =~ s/([\s\-])'([iI])/$1\\H{i}$2/gs;
156 0           $text =~ s/([\s\-])'A/$1\\M{}/gs;
157              
158 0           $text =~ s/(I|y\\O{})'(aN[AY]?[\s\-])/$1\\H{y}$2/gs;
159 0           $text =~ s/a'(|\\D{})(|[au]N?)([\s\-])/a\\H{a}$1$2$3/gs;
160 0           $text =~ s/a'(|\\D{})(iN?)([\s\-])/a\\H{i}$1$2$3/gs;
161 0           $text =~ s/i'(|\\D{})(|[aiu]N?)([\s\-])/i\\H{y}$1$2$3/gs;
162 0           $text =~ s/u'(|\\D{})(|[aiu]N?)([\s\-])/u\\H{w}$1$2$3/gs;
163 0           $text =~ s/'(|\\D{})(|[aiu]N?)([\s\-])/\\H{}$1$2$3/gs;
164              
165 0           $text =~ s/([iI]|y\\O{})'(|\\D{})/$1\\H{y}$2/g;
166 0           $text =~ s/'(|\\D{})([iI])/\\H{y}$1$2/g;
167 0           $text =~ s/([uU])'(|\\D{})/$1\\H{w}$2/g;
168 0           $text =~ s/'(|\\D{})([uU])/\\H{w}$1$2/g;
169 0           $text =~ s/A'(|\\D{})/A\\H{}$1/g; # how do you write ?
170 0           $text =~ s/a'(\\D{})/a\\H{a}$1/g; # how do you write ?
171 0           $text =~ s/'A/\\M{}/g;
172 0           $text =~ s/'a/\\H{a}a/g;
173 0           $text =~ s/'Y/\\H{a}Y/g;
174              
175 0           $text =~ s/'/\\H{a}a/g; # final resort
176              
177 0           foreach $one (@shams) { $text =~ s/($one)\-$one/l$1\\D{}/g; }
  0            
178 0           foreach $one ('\\\\', @qamar) { $text =~ s/l\-($one)/l\\O{}$1/g; }
  0            
179             # alas! using $one in the replacing expression produces extra \\
180              
181 0           $text =~ s/aNY/\\V{aN}\\Q{}/g;
182 0           $text =~ s/(?<=A\\H{}|\\H{a})aN/\\V{aN}/g;
183 0           $text =~ s/(?<=T)aN/\\V{aN}/g;
184              
185 0           $text =~ s/(?
186 0           $text =~ s/(?
187 0           $text =~ s/(?
188              
189 0           $text =~ s/UA/\\V{u}w\\L{}/g;
190 0           $text =~ s/aWA?/\\V{a}w\\O{}\\L{}/g;
191              
192 0           $text =~ s/([^{])a/$1\\V{a}/g;
193 0           $text =~ s/([^{])i/$1\\V{i}/g;
194 0           $text =~ s/([^{])u/$1\\V{u}/g;
195              
196 0           $text =~ s/A/\\V{a}\\L{}/g;
197 0           $text =~ s/Iy/\\V{i}y\\D{}/g;
198 0           $text =~ s/I/\\V{i}y/g;
199 0           $text =~ s/Uw/\\V{u}w\\D{}/g;
200 0           $text =~ s/U/\\V{u}w/g;
201 0           $text =~ s/Y/\\V{a}\\Q{}/g;
202              
203 0           $text =~ s/\-//g;
204              
205 0           $text =~ s/l((\\V\{[aiu]\}|\\D\{\}|\\O\{\})+)(\\L\{\}|\\H\{[ai]\}|\\M\{\})/l$3$1/g;
206              
207 0           foreach $one (keys %decode_used) { # risky .. the order matters and negative lookahead \{ is just right
208              
209 0           while ($text =~ s/(?
210             }
211              
212 0           $text = substr $text, 1, -1; # remove additional "\n"s
213              
214 0           return $text;
215             }
216              
217              
218             sub initialize_encode ($) {
219 0     0 0   my $cls = shift @_;
220              
221 0           %encode_used = (
222             # "p", # 81 #"\201",
223             # "^c", # 8D #"\215",
224             # "^z", # 8E #"\216",
225             # "\217", # 8F #"\217",
226             # "g", # 90 #"\220",
227             "\x{060C}", ",", # A1 "\241", '\\,', # 161 "\xA1", # "\xD8\x8C" right-to-left-comma
228             # "\\lq ", # AB #"\253",
229             "\x{061B}", ";", # BA "\272", '\\;', # 186 "\xBA", # "\xD8\x9B" right-to-left-semicolon
230             # "\\rq", # BB #"\273",
231             "\x{061F}", "?", # BF "\277", '\\?', # 191 "\xBF", # "\xD8\x9F" right-to-left-question-mark
232             "\x{0621}", "'", # C1 "\301", '\\\\H{}', # 193 "\xC1", # "\xD8\xA1" hamza-on-the-line
233             "\x{0622}", "\\madda{}", # C2 "\302", '\\\\M{}', # 194 "\xC2", # "\xD8\xA2" madda-over-'alif
234             "\x{0623}", "\\ham{a}", # C3 "\303", '\\\\H{a}', # 195 "\xC3", # "\xD8\xA3" hamza-over-'alif
235             "\x{0624}", "\\ham{w}", # C4 "\304", '\\\\H{w}', # 196 "\xC4", # "\xD8\xA4" hamza-over-waaw
236             "\x{0625}", "\\ham{i}", # C5 "\305", '\\\\H{i}', # 197 "\xC5", # "\xD8\xA5" hamza-under-'alif
237             "\x{0626}", "\\ham{y}", # C6 "\306", '\\\\H{y}', # 198 "\xC6", # "\xD8\xA6" hamza-over-yaa'
238             "\x{0627}", "\\alif{}", # C7 "\307", '\\\\L{}', # 199 "\xC7", # "\xD8\xA7" bare 'alif
239             "\x{0628}", "b", # C8 "\310", 'b', # 200 "\xC8", # "\xD8\xA8"
240             "\x{0629}", "T", # C9 "\311", 'T', # 201 "\xC9", # "\xD8\xA9"
241             "\x{062A}", "t", # CA "\312", 't', # 202 "\xCA", # "\xD8\xAA"
242             "\x{062B}", "_t", # CB "\313", '\\_t', # 203 "\xCB", # "\xD8\xAB" <_t>
243             "\x{062C}", "^g", # CC "\314", '\\^g', # 204 "\xCC", # "\xD8\xAC" <^g>
244             "\x{062D}", ".h", # CD "\315", '\\.h', # 205 "\xCD", # "\xD8\xAD" <.h>
245             "\x{062E}", "_h", # CE "\316", '\\_h', # 206 "\xCE", # "\xD8\xAE" <_h>
246             "\x{062F}", "d", # CF "\317", 'd', # 207 "\xCF", # "\xD8\xAF"
247             "\x{0630}", "_d", # D0 "\320", '\\_d', # 208 "\xD0", # "\xD8\xB0" <_d>
248             "\x{0631}", "r", # D1 "\321", 'r', # 209 "\xD1", # "\xD8\xB1"
249             "\x{0632}", "z", # D2 "\322", 'z', # 210 "\xD2", # "\xD8\xB2"
250             "\x{0633}", "s", # D3 "\323", 's', # 211 "\xD3", # "\xD8\xB3"
251             "\x{0634}", "^s", # D4 "\324", '\\^s', # 212 "\xD4", # "\xD8\xB4" <^s>
252             "\x{0635}", ".s", # D5 "\325", '\\.s', # 213 "\xD5", # "\xD8\xB5" <.s>
253             "\x{0636}", ".d", # D6 "\326", '\\.d', # 214 "\xD6", # "\xD8\xB6" <.d>
254             # "\327", # D7 #"\327",
255             "\x{0637}", ".t", # D8 "\330", '\\.t', # 216 "\xD8", # "\xD8\xB7" <.t>
256             "\x{0638}", ".z", # D9 "\331", '\\.z', # 217 "\xD9", # "\xD8\xB8" <.z>
257             "\x{0639}", "`", # DA "\332", '\\`', # 218 "\xDA", # "\xD8\xB9" <`>
258             "\x{063A}", ".g", # DB "\333", '\\.g', # 219 "\xDB", # "\xD8\xBA" <.g>
259             "\x{0640}", "-", # DC "\334", '--', # 220 "\xDC", # "\xD9\x80" ta.twiil
260             "\x{0641}", "f", # DD "\335", 'f', # 221 "\xDD", # "\xD9\x81"
261             "\x{0642}", "q", # DE "\336", 'q', # 222 "\xDE", # "\xD9\x82"
262             "\x{0643}", "k", # DF "\337", 'k', # 223 "\xDF", # "\xD9\x83"
263             # "\340", # E0 #"\340",
264             "\x{0644}", "l", # E1 "\341", 'l', # 225 "\xE1", # "\xD9\x84"
265             # "\342", # E2 #"\342",
266             "\x{0645}", "m", # E3 "\343", 'm', # 227 "\xE3", # "\xD9\x85"
267             "\x{0646}", "n", # E4 "\344", 'n', # 228 "\xE4", # "\xD9\x86"
268             "\x{0647}", "h", # E5 "\345", 'h', # 229 "\xE5", # "\xD9\x87"
269             "\x{0648}", "w", # E6 "\346", 'w', # 230 "\xE6", # "\xD9\x88"
270             "\x{0649}", "\\maq{}", # EC "\354", '\\\\Q{}', # 236 "\xEC", # "\xD9\x89" 'alif maq.suura
271             "\x{064A}", "y", # ED "\355", 'y', # 237 "\xED", # "\xD9\x8A"
272             "\x{064B}", "\\vow{aN}", # F0 "\360", '\\\\V{aN}', # 240 "\xF0", # "\xD9\x8B"
273             "\x{064C}", "\\vow{uN}", # F1 "\361", '\\\\V{uN}', # 241 "\xF1", # "\xD9\x8C"
274             "\x{064D}", "\\vow{iN}", # F2 "\362", '\\\\V{iN}', # 242 "\xF2", # "\xD9\x8D"
275             "\x{064E}", "\\vow{a}", # F3 "\363", '\\\\V{a}', # 243 "\xF3", # "\xD9\x8E"
276             "\x{064F}", "\\vow{u}", # F5 "\365", '\\\\V{u}', # 245 "\xF5", # "\xD9\x8F"
277             "\x{0650}", "\\vow{i}", # F6 "\366", '\\\\V{i}', # 246 "\xF6", # "\xD9\x90"
278             "\x{0651}", "\\shadda{}", # F8 "\370", '\\\\D{}', # 248 "\xF8", # "\xD9\x91" ^sadda
279             "\x{0652}", "\\sukun{}", # FA "\372", '\\\\O{}', # 250 "\xFA", # "\xD9\x92" sukuun
280             "\x{0670}", # '\\\\A{}', # 243 "\xF3", # "\xD9\xB0" <_a> ->
281             "\x{0671}", # '\\\\W{}', # 199 "\xC7", # "\xD9\xB1" wa.sla-on-'alif -> bare 'alif
282             );
283              
284              
285 2     2   13 no strict 'refs';
  2         3  
  2         1118  
286              
287 0 0         $cls->enmode(defined ${ $cls . '::enmode' } ? ${ $cls . '::enmode' } : 'default');
  0            
  0            
288             }
289              
290              
291             sub initialize_decode ($) {
292 0     0 0   my $cls = shift @_;
293              
294 0           @shams = ('t', '\\_t', 'd', '\\_d', 'r', 'z', 's', '\\^s', '\\.s', '\\.d', '\\.t', '\\.z', 'l', 'n');
295 0           @qamar = ('b', '\\^g', '\\.h', '\\_h', '\\`', '\\.g', 'f', 'q', 'k', 'm', 'h', 'w', 'y');
296              
297 0           %decode_used = (
298             # 'p', # 129 "\x81",
299             # '\\^c', # 141 "\x8D",
300             # '\\^z', # 142 "\x8E",
301             # 'g', # 144 "\x90",
302             '\\,', "\x{060C}", # 161 "\xA1", # "\xD8\x8C" right-to-left-comma
303             '\\;', "\x{061B}", # 186 "\xBA", # "\xD8\x9B" right-to-left-semicolon
304             '\\?', "\x{061F}", # 191 "\xBF", # "\xD8\x9F" right-to-left-question-mark
305             '\\\\H{}', "\x{0621}", # 193 "\xC1", # "\xD8\xA1" hamza-on-the-line
306             '\\\\M{}', "\x{0622}", # 194 "\xC2", # "\xD8\xA2" madda-over-'alif
307             '\\\\H{a}', "\x{0623}", # 195 "\xC3", # "\xD8\xA3" hamza-over-'alif
308             '\\\\H{w}', "\x{0624}", # 196 "\xC4", # "\xD8\xA4" hamza-over-waaw
309             '\\\\H{i}', "\x{0625}", # 197 "\xC5", # "\xD8\xA5" hamza-under-'alif
310             '\\\\H{y}', "\x{0626}", # 198 "\xC6", # "\xD8\xA6" hamza-over-yaa'
311             '\\\\L{}', "\x{0627}", # 199 "\xC7", # "\xD8\xA7" bare 'alif
312             'b', "\x{0628}", # 200 "\xC8", # "\xD8\xA8"
313             'T', "\x{0629}", # 201 "\xC9", # "\xD8\xA9"
314             't', "\x{062A}", # 202 "\xCA", # "\xD8\xAA"
315             '\\_t', "\x{062B}", # 203 "\xCB", # "\xD8\xAB" <_t>
316             '\\^g', "\x{062C}", # 204 "\xCC", # "\xD8\xAC" <^g>
317             '\\.h', "\x{062D}", # 205 "\xCD", # "\xD8\xAD" <.h>
318             '\\_h', "\x{062E}", # 206 "\xCE", # "\xD8\xAE" <_h>
319             'd', "\x{062F}", # 207 "\xCF", # "\xD8\xAF"
320             '\\_d', "\x{0630}", # 208 "\xD0", # "\xD8\xB0" <_d>
321             'r', "\x{0631}", # 209 "\xD1", # "\xD8\xB1"
322             'z', "\x{0632}", # 210 "\xD2", # "\xD8\xB2"
323             's', "\x{0633}", # 211 "\xD3", # "\xD8\xB3"
324             '\\^s', "\x{0634}", # 212 "\xD4", # "\xD8\xB4" <^s>
325             '\\.s', "\x{0635}", # 213 "\xD5", # "\xD8\xB5" <.s>
326             '\\.d', "\x{0636}", # 214 "\xD6", # "\xD8\xB6" <.d>
327             '\\.t', "\x{0637}", # 216 "\xD8", # "\xD8\xB7" <.t>
328             '\\.z', "\x{0638}", # 217 "\xD9", # "\xD8\xB8" <.z>
329             '\\`', "\x{0639}", # 218 "\xDA", # "\xD8\xB9" <`>
330             '\\.g', "\x{063A}", # 219 "\xDB", # "\xD8\xBA" <.g>
331             '--', "\x{0640}", # 220 "\xDC", # "\xD9\x80" ta.twiil
332             'f', "\x{0641}", # 221 "\xDD", # "\xD9\x81"
333             'q', "\x{0642}", # 222 "\xDE", # "\xD9\x82"
334             'k', "\x{0643}", # 223 "\xDF", # "\xD9\x83"
335             'l', "\x{0644}", # 225 "\xE1", # "\xD9\x84"
336             'm', "\x{0645}", # 227 "\xE3", # "\xD9\x85"
337             'n', "\x{0646}", # 228 "\xE4", # "\xD9\x86"
338             'h', "\x{0647}", # 229 "\xE5", # "\xD9\x87"
339             'w', "\x{0648}", # 230 "\xE6", # "\xD9\x88"
340             '\\\\Q{}', "\x{0649}", # 236 "\xEC", # "\xD9\x89" 'alif maq.suura
341             'y', "\x{064A}", # 237 "\xED", # "\xD9\x8A"
342             '\\\\V{aN}', "\x{064B}", # 240 "\xF0", # "\xD9\x8B"
343             '\\\\V{uN}', "\x{064C}", # 241 "\xF1", # "\xD9\x8C"
344             '\\\\V{iN}', "\x{064D}", # 242 "\xF2", # "\xD9\x8D"
345             '\\\\V{a}', "\x{064E}", # 243 "\xF3", # "\xD9\x8E"
346             '\\\\V{u}', "\x{064F}", # 245 "\xF5", # "\xD9\x8F"
347             '\\\\V{i}', "\x{0650}", # 246 "\xF6", # "\xD9\x90"
348             '\\\\D{}', "\x{0651}", # 248 "\xF8", # "\xD9\x91" ^sadda
349             '\\\\O{}', "\x{0652}", # 250 "\xFA", # "\xD9\x92" sukuun
350             '\\\\A{}', "\x{0670}", # 243 "\xF3", # "\xD9\xB0" <_a> ->
351             '\\\\W{}', "\x{0671}", # 199 "\xC7", # "\xD9\xB1" wa.sla-on-'alif -> bare 'alif
352             );
353              
354              
355 2     2   13 no strict 'refs';
  2         4  
  2         370  
356              
357 0 0         $cls->demode(defined ${ $cls . '::demode' } ? ${ $cls . '::demode' } : 'default');
  0            
  0            
358             }
359              
360              
361             sub enmode ($$) {
362 0     0 0   my ($cls, $mode) = @_;
363              
364 0 0         $cls = blessed $cls if ref $cls;
365              
366 0 0         $mode = 'undef' unless defined $mode;
367 0 0         $mode = $modemap{$mode} if exists $modemap{$mode};
368              
369 2     2   18 no strict 'refs';
  2         3  
  2         225  
370              
371 0           my $return = ${ $cls . '::enmode' };
  0            
372              
373 0           ${ $cls . '::enmode' } = $mode;
  0            
374              
375 0           return $return;
376             }
377              
378              
379             sub demode ($$) {
380 0     0 0   my ($cls, $mode) = @_;
381              
382 0 0         $cls = blessed $cls if ref $cls;
383              
384 0 0         $mode = 'undef' unless defined $mode;
385 0 0         $mode = $modemap{$mode} if exists $modemap{$mode};
386              
387 2     2   14 no strict 'refs';
  2         4  
  2         254  
388              
389 0           my $return = ${ $cls . '::demode' };
  0            
390              
391 0           ${ $cls . '::demode' } = $mode;
  0            
392              
393 0           return $return;
394             }
395              
396              
397             1;
398              
399             __END__