File Coverage

blib/lib/Text/DoubleMetaphone_PP.pm
Criterion Covered Total %
statement 21 378 5.5
branch 0 252 0.0
condition 0 273 0.0
subroutine 7 10 70.0
pod 0 3 0.0
total 28 916 3.0


line stmt bran cond sub pod time code
1             package Text::DoubleMetaphone_PP;
2              
3 1     1   25779 use 5.008007;
  1         4  
  1         40  
4 1     1   7 use strict;
  1         2  
  1         46  
5 1     1   4 use warnings;
  1         6  
  1         87  
6              
7             require Exporter;
8             our @ISA = qw(Exporter);
9             our @EXPORT_OK = qw(double_metaphone_pp);
10             our $VERSION = '0.03';
11              
12 1     1   1186 use utf8;
  1         12  
  1         5  
13             binmode(STDOUT, ":utf8");
14              
15             sub double_metaphone_pp {
16             # $pm for Primary Metaphone
17 0     0 0   my $pm;
18             # $sm for Secondary Metaphone
19             my $sm;
20             # $c for current letter being used. 0 index of word
21 0           my $c = 0;
22 0           my $length = length($_[0]);
23 0 0         return 0 if $length < 1;
24 0           my $last = $length - 1;
25 0           my $alternate = 0;
26 0 0         if (substr($_[0], 0, 2) =~ /gn|kn|pn|wr|ps/i) {
27 0           $c++;
28             }
29 0 0         if (substr($_[0], 0, 1) =~ /x/i) {
30 0           $pm .= "S";
31 0           $sm .= "S";
32 0           $c++;
33             }
34 1     1   256 no warnings('uninitialized');
  1         2  
  1         129  
35 0   0       LOOP: while (length($pm) < 4 and length($sm) < 4) {
36 0 0         last LOOP if ($c >= $length);
37 1 0   1   6 if (substr($_[0], $c, 1) =~ /a|ǎ|e|i|o|o|u|y/i) {
  1 0       2  
  1 0       14  
  0 0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
38 0 0 0       if ($c == 0) {
    0          
39 0           $pm .= "A";
40 0           $sm .= "A";
41 0           $c++;
42             } elsif($c + 1 == $last and substr($_[0], $c, 2) =~ /ǎu/i) {
43 0           $sm .= "F";
44 0           $c += 2;
45             } else {
46 0           $c++;
47             }
48             } elsif (substr($_[0], $c, 1) =~ /b/i) {
49 0           $pm .= "P";
50 0           $sm .= "P";
51 0           $c++;
52 0 0         $c++ if substr($_[0], $c, 1) =~ /b/i;
53             } elsif (substr($_[0], $c, 1) =~ /ç/i) {
54 0           $pm .= "S";
55 0           $sm .= "S";
56 0           $c++;
57             } elsif (substr($_[0], $c, 1) =~ /c/i) {
58 0 0 0       if (($c > 1) and !&is_vowel($_[0], $c - 2) and
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0          
59             substr($_[0], $c - 1, 3) =~ /ach/i and
60             (substr($_[0], $c + 2, 1) !~ /i/i and
61             (substr($_[0], $c + 2, 1) !~ /e/i or
62             substr($_[0], $c - 2, 6) =~ /bacher|macher/i))) {
63 0           $pm .= "K";
64 0           $sm .= "K";
65 0           $c += 2;
66             } elsif ($c == 0 and substr($_[0], $c, 6) =~ /caesar/i) {
67 0           $pm .= "S";
68 0           $sm .= "S";
69 0           $c += 2;
70             } elsif (substr($_[0], $c, 4) =~ /chia/i) {
71 0           $pm .= "K";
72 0           $sm .= "K";
73 0           $c += 2;
74             } elsif (substr($_[0], $c, 2) =~ /ch/i) {
75 0 0 0       if ($c > 0 and substr($_[0], $c, 4) =~ /chae/i) {
    0 0        
    0 0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
76 0           $pm .= "K";
77 0           $sm .= "X";
78             } elsif ($c == 0 and
79             (substr($_[0], $c + 1, 5) =~ /harac|haris/i or
80             substr($_[0], $c + 1, 3) =~ /hor|hym|hia|hem/i) and
81             substr($_[0], 0, 5) !~ /chore/i) {
82 0           $pm .= "K";
83 0           $sm .= "K";
84             } elsif ((substr($_[0], 0, 4) =~ /van |von /i or substr($_[0], 0, 3) =~ /sch/i)
85             or substr($_[0], $c - 2, 6) =~ /orches|archit|orchid/i
86             or substr($_[0], $c + 2, 1) =~ /t|s/i
87             or ((substr($_[0], $c - 1, 1) =~ /a|e|o|u/i or $c == 0)
88             and (substr($_[0], $c + 2, 1) =~ /l|r|n|m|b|h|f|v|w| /i
89             or ($c + 2) > $last))) {
90 0           $pm .= "K";
91 0           $sm .= "K";
92             } else {
93 0 0         if ($c > 0) {
94 0 0         if (substr($_[0], 0, 2) =~ /mc/i) {
95 0           $pm .= "K";
96 0           $sm .= "K";
97             } else {
98 0           $pm .= "X";
99 0           $sm .= "K";
100             }
101             } else {
102 0           $pm .= "X";
103 0           $sm .= "X";
104             }
105             }
106 0           $c += 2;
107             } elsif (substr($_[0], $c, 2) =~ /cz/i and substr($_[0], $c -2, 4) !~ /wicz/i) {
108 0           $pm .= "S";
109 0           $sm .= "X";
110 0           $c += 2;
111             } elsif (substr($_[0], $c + 1, 3) =~ /cia/i) {
112 0           $pm .= "X";
113 0           $sm .= "X";
114 0           $c += 3;
115             } elsif (substr($_[0], $c, 2) =~ /cc/i and !($c == 1 and substr($_[0], 0, 1) =~ /m/i)) {
116 0 0 0       if (substr($_[0], $c + 2, 1) =~ /e|h|i/i and substr($_[0], $c + 2, 2) !~ /hu/i) {
117 0 0 0       if (($c == 1 and substr($_[0], $c - 1, 1) =~ /a/i) or
      0        
118             substr($_[0], $c - 1, 5) =~ /uccee|ucces/i) {
119 0           $pm .= "KS";
120 0           $sm .= "KS";
121             } else {
122 0           $pm .= "X";
123 0           $sm .= "X";
124             }
125 0           $c += 3;
126             } else {
127 0           $pm .= "K";
128 0           $sm .= "K";
129 0           $c += 2;
130             }
131             } elsif (substr($_[0], $c, 2) =~ /ck|cg|cq/i) {
132 0           $pm .= "K";
133 0           $sm .= "K";
134 0           $c += 2;
135             } elsif (substr($_[0], $c, 2) =~ /ci|ce|cy/i) {
136 0 0         if (substr($_[0], $c, 3) =~ /cio|cie|cia/i) {
137 0           $pm .= "S";
138 0           $sm .= "X";
139             } else {
140 0           $pm .= "S";
141 0           $sm .= "S";
142             }
143 0           $c += 2;
144             } elsif (substr($_[0], $c + 1, 2) =~ / c| g| q/i) {
145 0           $pm .= "K";
146 0           $sm .= "K";
147 0           $c += 3;
148             } else {
149 0           $pm .= "K";
150 0           $sm .= "K";
151 0 0 0       if (substr($_[0], $c + 1, 1) =~ /c|k|q/i and substr($_[0], $c + 1, 2) !~ /ce|ce/i) {
152 0           $c += 2;
153             } else {
154 0           $c++;
155             }
156             }
157             } elsif (substr($_[0], $c, 1) =~ /d/i) {
158 0 0         if (substr($_[0], $c, 2) =~ /dg/i) {
    0          
159 0 0         if (substr($_[0], $c + 2, 1) =~ /e|i|y/i) {
160 0           $pm .= "J";
161 0           $sm .= "J";
162 0           $c += 3;
163             } else {
164 0           $pm .= "TK";
165 0           $sm .= "TK";
166 0           $c += 2;
167             }
168             } elsif (substr($_[0], $c, 2) =~ /dt|dd/i) {
169 0           $pm .= "T";
170 0           $sm .= "T";
171 0           $c += 2;
172             } else {
173 0           $pm .= "T";
174 0           $sm .= "T";
175 0           $c++;
176             }
177             } elsif (substr($_[0], $c, 1) =~ /f/i) {
178 0 0         if (substr($_[0], $c + 1, 1) =~ /f/i) {
179 0           $c += 2;
180             } else {
181 0           $c++;
182             }
183 0           $pm .= "F";
184 0           $sm .= "F";
185             } elsif (substr($_[0], $c, 1) =~ /ǧ/i) {
186 0           $c++;
187             } elsif (substr($_[0], $c, 1) =~ /g/i) {
188 0 0 0       if (substr($_[0], $c + 1, 1) =~ /h/i) {
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
      0        
189 0 0 0       if ($c > 0 and !&is_vowel($_[0], $c -1)) {
    0 0        
    0 0        
      0        
      0        
      0        
      0        
190 0           $pm .= "K";
191 0           $sm .= "K";
192 0           $c += 2;
193             } elsif ($c < 3 && $c == 0) {
194 0 0         if (substr($_[0], $c + 2, 1) =~ /i/i) {
195 0           $pm .= "J";
196 0           $sm .= "J";
197             } else {
198 0           $pm .= "K";
199 0           $sm .= "K";
200             }
201 0           $c += 2;
202             } elsif (($c > 1 and substr($_[0], $c - 2, 1) =~ /b|d|h/i)
203             or ($c > 2 and substr($_[0], $c - 3, 1) =~ /b|d|h/i)
204             or ($c > 3 and substr($_[0], $c - 4, 1) =~ /b|h/i)) {
205 0           $c += 2;
206             } else {
207 0 0 0       if ($c > 2 and substr($_[0], $c - 1, 1) =~ /u/i
    0 0        
      0        
208             and substr($_[0], $c - 3, 1) =~ /c|g|l|r|t/i) {
209 0           $pm .= "F";
210 0           $sm .= "F";
211             } elsif ($c > 0 and substr($_[0], $c - 1, 1) !~ /i/i) {
212 0           $pm .= "K";
213 0           $sm .= "K";
214             }
215 0           $c += 2;
216             }
217             } elsif (substr($_[0], $c + 1, 1) =~ /n/i) {
218 0 0 0       if ($c == 1 and &is_vowel($_[0], 0) and !&slavo_germanic($_[0])) {
    0 0        
      0        
219 0           $pm .= "KN";
220 0           $sm .= "N";
221             } elsif (substr($_[0], $c + 2, 2) !~ /ey/i
222             and substr($_[0], $c + 1, 1) !~ /y/i and !&slavo_germanic($_[0])) {
223 0           $pm .= "N";
224 0           $sm .= "KN";
225             } else {
226 0           $pm .= "KN";
227 0           $sm .= "KN";
228             }
229 0           $c += 2;
230             } elsif (substr($_[0], $c + 1, 2) =~ /li/i and !&slavo_germanic($_[0])) {
231 0           $pm .= "KL";
232 0           $sm .= "L";
233 0           $c += 2;
234             } elsif ($c == 0 and (substr($_[0], $c + 1, 1) =~ /y/i
235             or substr($_[0], $c + 1, 2) =~ /es|ep|eb|el|ey|ib|il|in|ie|ei|er/i)) {
236 0           $pm .= "K";
237 0           $sm .= "J";
238 0           $c += 2;
239             } elsif ((substr($_[0], $c + 1, 2) =~ /er/i or substr($_[0], $c + 1, 1) =~ /y/i)
240             and substr($_[0], 0, 6) !~ /danger|ranger|manger/i
241             and substr($_[0], $c - 1, 1) !~ /e|i/i
242             and substr($_[0], $c - 1, 3) !~ /rgy|ogy/i) {
243 0           $pm .= "K";
244 0           $sm .= "J";
245 0           $c += 2;
246             } elsif (substr($_[0], $c + 1, 1) =~ /e|i|y/i or substr($_[0], $c - 1, 4) =~ /aggi|oggi/i) {
247 0 0 0       if ((substr($_[0], 0, 4) =~ /van |von /i or substr($_[0], 0, 3) =~ /sch/i)
    0 0        
248             or substr($_[0], $c + 1, 2) =~ /et/i) {
249 0           $pm .= "K";
250 0           $sm .= "K";
251             } elsif (substr($_[0], $c + 1, 4) =~ /^ier |^ier$/i) {
252 0           $pm .= "J";
253 0           $sm .= "J";
254             } else {
255 0           $pm .= "J";
256 0           $sm .= "K";
257             }
258 0           $c += 2;
259             } elsif (substr($_[0], $c + 1, 1) =~ /g/i) {
260 0           $pm .= "K";
261 0           $sm .= "K";
262 0           $c += 2;
263             } else {
264 0           $pm .= "K";
265 0           $sm .= "K";
266 0           $c++;
267             }
268             } elsif (substr($_[0], $c, 1) =~ /h/i) {
269 0 0 0       if (($c == 0 or &is_vowel($_[0], $c - 1)) and &is_vowel($_[0], $c + 1)) {
      0        
270 0           $pm .= "H";
271 0           $sm .= "H";
272 0           $c += 2;
273             } else {
274 0           $c++;
275             }
276             } elsif (substr($_[0], $c, 1) =~ /j/i) {
277 0 0 0       if (substr($_[0], $c, 4) =~ /jose/i or substr($_[0], 0, 4) =~ /san /i) {
    0 0        
278 0 0 0       if (($c == 0 and (substr($_[0], $c + 4, 1) eq ' ' or ($c +4 > $last)))
      0        
      0        
279             or substr($_[0], 0, 4) =~ /san /i) {
280 0           $pm .= "H";
281 0           $sm .= "H";
282             } else {
283 0           $pm .= "J";
284 0           $sm .= "H";
285             }
286 0           $c++;
287             } elsif ($c == 0 and substr($_[0], $c, 4) !~ /jose/i) {
288 0           $pm .= "J";
289 0           $sm .= "A";
290 0 0         if (substr($_[0], $c + 1, 1) =~ /j/i) {
291 0           $c += 2;
292             } else {
293 0           $c++;
294             }
295             } else {
296 0 0 0       if (&is_vowel($_[0], $c - 1) and !&slavo_germanic($_[0])
      0        
      0        
297             and (substr($_[0], $c + 1, 1) =~ /a/i or substr($_[0], $c + 1, 1) =~ /o/i)) {
298 0           $pm .= "J";
299 0           $sm .= "H";
300             } else {
301 0 0         if ($c == $last) {
302 0           $pm .= "J";
303             } else {
304 0 0 0       if (substr($_[0], $c + 1, 1) !~ /l|t|k|s|n|m|b|z/i
305             and substr($_[0], $c -1, 1) !~ /s|k|l/i) {
306 0           $pm .= "J";
307 0           $sm .= "J";
308             }
309             }
310             }
311 0 0         if (substr($_[0], $c + 1, 1) =~ /j/i) {
312 0           $c += 2;
313             } else {
314 0           $c++;
315             }
316             }
317             } elsif (substr($_[0], $c, 1) =~ /k/i) {
318 0 0         if (substr($_[0], $c + 1, 1) =~ /k/i) {
319 0           $c += 2;
320             } else {
321 0           $c++;
322             }
323 0           $pm .= "K";
324 0           $sm .= "K";
325             } elsif (substr($_[0], $c, 1) =~ /l/i) {
326 0 0         if (substr($_[0], $c + 1, 1) =~ /l/i) {
327 0 0 0       if (($c == $length - 3 and substr($_[0], $c - 1, 4) =~ /illo|illa|alle/i)
      0        
      0        
      0        
328             or ((substr($_[0], $last - 1, 2) =~ /as|os/i or substr($_[0], $last, 1) =~ /a|o/i)
329             and substr($_[0], $c - 1, 4) =~ /alle/i)) {
330 0           $pm .= "L";
331 0           $c += 2;
332             } else {
333 0           $c += 2;
334 0           $pm .= "L";
335 0           $sm .= "L";
336             }
337             } else {
338 0           $c++;
339 0           $pm .= "L";
340 0           $sm .= "L";
341             }
342             } elsif (substr($_[0], $c, 1) =~ /m/i) {
343 0 0 0       if ((substr($_[0], $c - 1, 3) =~ /umb/i
      0        
      0        
344             and ($c + 1 == $last or substr($_[0], $c + 2, 2) =~ /er/i))
345             or substr($_[0], $c + 1, 1) =~ /m/i) {
346 0           $c += 2;
347             } else {
348 0           $c++;
349             }
350 0           $pm .= "M";
351 0           $sm .= "M";
352             } elsif (substr($_[0], $c, 1) =~ /n/i) {
353 0 0         if (substr($_[0], $c + 1, 1) =~ /n/i) {
354 0           $c += 2;
355             } else {
356 0           $c++;
357             }
358 0           $pm .= "N";
359 0           $sm .= "N";
360             } elsif (substr($_[0], $c, 1) =~ /ñ/i) {
361 0           $c++;
362 0           $pm .= "N";
363 0           $sm .= "N";
364             } elsif (substr($_[0], $c, 1) =~ /p/i) {
365 0 0         if (substr($_[0], $c + 1, 1) =~ /h/i) {
    0          
366 0           $pm .= "F";
367 0           $sm .= "F";
368 0           $c += 2;
369             } elsif (substr($_[0], $c + 1, 1) =~ /p|b/i) {
370 0           $c += 2;
371 0           $pm .= "P";
372 0           $sm .= "P";
373             } else {
374 0           $c++;
375 0           $pm .= "P";
376 0           $sm .= "P";
377             }
378             } elsif (substr($_[0], $c, 1) =~ /q/i) {
379 0 0         if (substr($_[0], $c + 1, 1) =~ /q/i) {
380 0           $c += 2;
381             } else {
382 0           $c++;
383             }
384 0           $pm .= "K";
385 0           $sm .= "K";
386             } elsif (substr($_[0], $c, 1) =~ /r/i) {
387 0 0 0       if ($c == $last and !&slavo_germanic($_[0]) and substr($_[0], $c - 2, 2) =~ /ie/i
      0        
      0        
388             and substr($_[0], $c - 4, 2) !~ /me|ma/i) {
389 0           $sm .= "R";
390             } else {
391 0           $pm .= "R";
392 0           $sm .= "R";
393             }
394 0 0         if (substr($_[0], $c + 1, 1) =~ /r/i) {
395 0           $c += 2;
396             } else {
397 0           $c++;
398             }
399             } elsif (substr($_[0], $c, 1) =~ /ş/i) {
400 0           $pm .= "X";
401 0           $sm .= "X";
402 0           $c++;
403             } elsif (substr($_[0], $c, 1) =~ /s/i) {
404 0 0 0       if (substr($_[0], $c - 1, 3) =~ /isl|ysl/i) {
    0 0        
    0 0        
    0 0        
    0          
    0          
405 0           $c++;
406             } elsif ($c == 0 and substr($_[0], $c, 5) =~ /sugar/i) {
407 0           $pm .= "X";
408 0           $sm .= "S";
409 0           $c++;
410             } elsif (substr($_[0], $c, 2) =~ /sh/i) {
411 0 0         if (substr($_[0], $c + 1, 4) =~ /heim|hoek|holm|holz/i) {
412 0           $pm .= "S";
413 0           $sm .= "S";
414             } else {
415 0           $pm .= "X";
416 0           $sm .= "X";
417             }
418 0           $c += 2;
419             } elsif (substr($_[0], $c, 3) =~ /sio|sia/i or substr($_[0], $c, 4) =~ /sian/i) {
420 0 0         if (!&slavo_germanic($_[0])) {
421 0           $pm .= "S";
422 0           $sm .= "X";
423             } else {
424 0           $pm .= "S";
425 0           $sm .= "S";
426             }
427 0           $c += 3;
428             } elsif (($c == 0 and substr($_[0], $c + 1, 1) =~ /m|n|l|w/i) or substr($_[0], $c + 1, 1) =~ /z/i) {
429 0           $pm .= "S";
430 0           $sm .= "X";
431 0 0         if (substr($_[0], $c + 1, 1) =~ /z/i) {
432 0           $c += 2;
433             } else {
434 0           $c++;
435             }
436             } elsif (substr($_[0], $c, 2) =~ /sc/i) {
437 0 0         if (substr($_[0], $c + 2, 1) =~ /h/i) {
    0          
438 0 0         if (substr($_[0], $c + 3, 2) =~ /oo|er|en|uy|ed|em/i) {
439 0 0         if (substr($_[0], $c + 3, 2) =~ /er|en/i) {
440 0           $pm .= "X";
441 0           $sm .= "SK";
442             } else {
443 0           $pm .= "SK";
444 0           $sm .= "SK";
445             }
446 0           $c += 3;
447             } else {
448 0 0 0       if ($c == 0 and !&is_vowel($_[0], 3) and substr($_[0], 3, 1) !~ /w/i) {
      0        
449 0           $pm .= "X";
450 0           $sm .= "S";
451             } else {
452 0           $pm .= "X";
453 0           $sm .= "X";
454             }
455 0           $c += 3;
456             }
457             } elsif (substr($_[0], $c + 2, 1) =~ /e|i|y/i) {
458 0           $pm .= "S";
459 0           $sm .= "S";
460 0           $c += 3;
461             } else {
462 0           $pm .= "SK";
463 0           $sm .= "SK";
464 0           $c += 3;
465             }
466             } else {
467 0 0 0       if ($c == $last and substr($_[0], $c - 2, 2) =~ /ai|oi/i) {
468 0           $sm .= "S";
469             } else {
470 0           $pm .= "S";
471 0           $sm .= "S";
472             }
473 0 0         if (substr($_[0], $c + 1, 1) =~ /s|z/i) {
474 0           $c += 2;
475             } else {
476 0           $c++;
477             }
478             }
479             } elsif (substr($_[0], $c, 1) =~ /t/i) {
480 0 0 0       if (substr($_[0], $c, 4) =~ /tion/i) {
    0          
    0          
    0          
481 0           $pm .= "X";
482 0           $sm .= "X";
483 0           $c += 3;
484             } elsif (substr($_[0], $c, 3) =~ /tia|tch/i) {
485 0           $pm .= "X";
486 0           $sm .= "X";
487 0           $c += 3;
488             } elsif (substr($_[0], $c, 2) =~ /th/i or substr($_[0], $c, 3) =~ /tth/i) {
489 0 0 0       if (substr($_[0], $c + 2, 2) =~ /om|am/i or substr($_[0], 0, 4) =~ /van |von /i
      0        
490             or substr($_[0], 0, 3) =~ /sch/i) {
491 0           $pm .= "T";
492 0           $sm .= "T";
493             } else {
494 0           $pm .= "0";
495 0           $sm .= "T";
496             }
497 0           $c += 2;
498             } elsif (substr($_[0], $c + 1, 1) =~ /t|d/i) {
499 0           $pm .= "T";
500 0           $sm .= "T";
501 0           $c += 2;
502             } else {
503 0           $pm .= "T";
504 0           $sm .= "T";
505 0           $c++;
506             }
507             } elsif (substr($_[0], $c, 1) =~ /v/i) {
508 0 0         if (substr($_[0], $c + 1, 1) =~ /v/i) {
509 0           $c += 2;
510             } else {
511 0           $c++;
512             }
513 0           $pm .= "F";
514 0           $sm .= "F";
515             } elsif (substr($_[0], $c, 1) =~ /w/i) {
516 0 0         if (substr($_[0], $c, 2) =~ /wr/i ) {
517 0           $pm .= "R";
518 0           $sm .= "R";
519 0           $c += 2;
520             } else {
521 0 0 0       if ($c == 0 and (&is_vowel($_[0], $c + 1) or substr($_[0], $c, 2) =~ /wh/i)) {
      0        
522 0 0         if (&is_vowel($_[0], $c + 1)) {
523 0           $pm .= "A";
524 0           $sm .= "F";
525             } else {
526 0           $pm .= "A";
527 0           $sm .= "A";
528             }
529             }
530 0 0 0       if (($c == $last and &is_vowel($_[0], $c - 1))
    0 0        
      0        
531             or substr($_[0], $c - 1, 5) =~ /ewski|ewsky|owski|owsky/i
532             or substr($_[0], 0, 3) =~ /sch/i) {
533 0           $sm .= "F";
534 0           $c++;
535             } elsif (substr($_[0], $c, 4) =~ /wicz|witz/i) {
536 0           $pm .= "TS";
537 0           $sm .= "FX";
538 0           $c += 4;
539             } else {
540 0           $c++;
541             }
542             }
543             } elsif (substr($_[0], $c, 1) =~ /x/i) {
544 0 0 0       if (!($c == $last
      0        
545             and (substr($_[0], $c - 3, 3) =~ /iau|eau/i or substr($_[0], $c - 2, 2) =~ /au|ou/i))) {
546 0           $pm .= "KS";
547 0           $sm .= "KS";
548             }
549 0 0         if (substr($_[0], $c + 1, 1) =~ /c|x/i) {
550 0           $c += 2;
551             } else {
552 0           $c++;
553             }
554             } elsif (substr($_[0], $c, 1) =~ /z/i) {
555 0 0         if (substr($_[0], $c + 1, 1) =~ /h/i) {
556 0           $pm .= "J";
557 0           $sm .= "J";
558 0           $c += 2;
559             } else {
560 0 0 0       if (substr($_[0], $c + 1, 2) =~ /zo|zi|za/i
      0        
      0        
561             or (&slavo_germanic($_[0]) and $c > 0 and substr($_[0], $c - 1, 1) !~ /t/i)) {
562 0           $pm .= "S";
563 0           $sm .= "TS";
564             } else {
565 0           $pm .= "S";
566 0           $sm .= "S";
567             }
568 0 0         if (substr($_[0], $c + 1, 1) =~ /z/i) {
569 0           $c += 2;
570             } else {
571 0           $c++;
572             }
573             }
574             } else {
575 0           $c++;
576             }
577             }
578 0           (my $primary = substr($pm, 0, 4)) =~ s/\s$//;
579 0           (my $secondary = substr($sm, 0, 4)) =~ s/\s$//;
580 0           return($primary, $secondary);
581             }
582              
583             sub is_vowel {
584 1     1   49453 no warnings('uninitialized');
  1         3  
  1         239  
585 0 0 0 0 0   if (($_[1] < 0) or($_[1] >= length($_[0]))) {
586 0           return 0;
587             } else {
588 0 0         return 1 if (substr($_[0], $_[1], 1) =~ /a|e|i|o|u|y/i);
589 0           return 0;
590             }
591             }
592              
593             sub slavo_germanic {
594 0 0   0 0   if ($_[0] =~ /w|k|cz|witz/i) {
595 0           return 1;
596             } else {
597 0           return 0;
598             }
599             }
600              
601             1;
602             __END__