File Coverage

blib/lib/Lingua/AR/Word/Stem.pm
Criterion Covered Total %
statement 17 42 40.4
branch 5 30 16.6
condition n/a
subroutine 4 6 66.6
pod 0 4 0.0
total 26 82 31.7


line stmt bran cond sub pod time code
1             package Lingua::AR::Word;
2              
3 1     1   5 use strict;
  1         3  
  1         36  
4 1     1   5 use utf8;
  1         2  
  1         5  
5              
6              
7             sub stem{
8              
9 1     1 0 2 my $stem;
10 1         3 my $word=shift;
11              
12              
13             #let's strip down every prefix and suffix I'm aware of.
14             #(actually suffixes relative to people like possessive adjs are NOT chopped)
15              
16 1 50       40 if($word=~/^( #the prefixes
17             [وفب]*ال|
18             [بيلمتوسن]*ت|
19             [بلوكف]*م|
20             [ال]*ل|[
21             ولسف]*ي|[
22             وفلب]*ا|
23             )
24             (.*?) # the stem
25             ( # the suffixes
26             ات|
27             وا|
28             تا|
29             ون|
30             وه|
31             ان|
32             تي|
33             ته|
34             تم|
35             كم|
36             ه[نم]*|
37             ها|
38             ية|
39             تك|
40             نا|
41             ي[نه]*|
42             [ةهيا]|
43             )
44             $/x)
45             {
46 1         6 $word=$2;
47             }
48              
49             #let's strip down all other unnecessary letters according to the length of the word
50 1 50       7 if(length($word)==3){
51 0         0 $stem=$word;
52             }
53             else{
54 1 50       5 if(length($word)==4){
55 1         5 $stem=&four($word);
56             }
57             else{
58 0 0       0 if(length($word)==5){
59 0         0 $stem=&five($word);
60             }
61             else{
62 0 0       0 if(length($word)==6){
63 0         0 $stem=&six($word);
64             }
65             else{
66 0         0 $stem="NotFound";
67             }
68             }
69             }
70             }
71              
72 1         6 return $stem;
73             }
74              
75             sub four{
76 1     1 0 2 my $word=shift;
77            
78 1 50       14 if($word=~/(.)(.)(ا|ي|و)(.)/){
    50          
79 0         0 $word=$1.$2.$4;
80             }
81             elsif ($word=~/(.)(ا|و|ط|ي)(.)(.)/){
82 1         8 $word=$1.$3.$4;
83             }
84             else{
85 0           $word="NotFound";
86             }
87             }
88              
89             sub five{
90 0     0 0   my $word=shift;
91            
92 0 0         if($word=~/(.)(.)(ا)(ا)(.)/){
    0          
    0          
    0          
    0          
    0          
93 0           $word=$1.$2.$5;
94             }
95             elsif ($word=~/(.)(ت|ي)(.)(ا)(.)/){
96 0           $word=$1.$3.$5;
97             }
98             elsif ($word=~/(.)(و)(ا)(.)(.)/){
99 0           $word=$1.$4.$5;
100             }
101             elsif ($word=~/(.)(ا)(.)(ي|و)(.)/){
102 0           $word=$1.$3.$5;
103             }
104             elsif ($word=~/(.)(.)(.)(ا|ي|و)(.)/){
105 0           $word=$1.$2.$3.$5;
106 0           $word=&four($word);
107             }
108             elsif ($word=~/(.)(.)(ا|ي)(.)(.)/){
109 0           $word=$1.$2.$4.$5;
110 0           $word=&four($word);
111             }
112             else{
113 0           $word="NotFound";
114             }
115             }
116              
117             sub six{
118 0     0 0   my $word=shift;
119            
120 0 0         if($word=~/(.)(و)(ا)(.)(ي)(.)/){
    0          
121 0           $word=$1.$4.$6;
122             }
123             elsif ($word=~/(.)(.)(ا)(.)(ي)(.)/){
124 0           $word=$1.$2.$4.$6;
125 0           $word=&four($word);
126             }
127             else{
128 0           $word="NotFound";
129             }
130             }
131              
132             1;
133             __END__