line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyrights 2020 by [Eleonora ]. |
2
|
|
|
|
|
|
|
# For other contributors see ChangeLog. |
3
|
|
|
|
|
|
|
# See the manual pages for details on the licensing terms. |
4
|
|
|
|
|
|
|
# Pod stripped from pm file by OODoc 2.01. |
5
|
|
|
|
|
|
|
package Text::Unmunch; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = 0.1; |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
72536
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
10
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
11
|
1
|
|
|
1
|
|
612
|
use open qw( :encoding(UTF-8) :std ); |
|
1
|
|
|
|
|
1255
|
|
|
1
|
|
|
|
|
6
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub new{ |
14
|
1
|
|
|
1
|
1
|
91
|
my ($class,$args) = @_; |
15
|
|
|
|
|
|
|
my $self = bless { aff => $args->{aff}, |
16
|
|
|
|
|
|
|
wf => $args->{wf}, |
17
|
|
|
|
|
|
|
sfx => $args->{sfx}, |
18
|
|
|
|
|
|
|
pfx => $args->{pfx}, |
19
|
|
|
|
|
|
|
debug => $args->{debug}, |
20
|
1
|
|
|
|
|
10
|
debug_class => 0, |
21
|
|
|
|
|
|
|
}, $class; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub check_args{ |
26
|
4
|
|
|
4
|
0
|
6
|
my $self = shift; |
27
|
|
|
|
|
|
|
|
28
|
4
|
50
|
33
|
|
|
25
|
if (not defined $self->{aff} or not defined $self->{wf}){ |
29
|
0
|
|
|
|
|
0
|
die "affix file and word file must be defined\n"; |
30
|
|
|
|
|
|
|
} |
31
|
4
|
50
|
33
|
|
|
118
|
if( not -e $self->{aff} or not -e $self->{wf}){ |
32
|
0
|
|
|
|
|
0
|
die "either $self->{aff} or $self->{wf} does not exist\n"; |
33
|
|
|
|
|
|
|
} |
34
|
4
|
50
|
|
|
|
15
|
if(not defined $self->{debug}){ |
35
|
0
|
|
|
|
|
0
|
$self->{debug} = ''; |
36
|
|
|
|
|
|
|
} |
37
|
4
|
50
|
|
|
|
11
|
if($self->{debug} ne ""){ |
38
|
4
|
|
|
|
|
11
|
$self->{debug_class} = substr($self->{debug}, 3); |
39
|
|
|
|
|
|
|
} |
40
|
4
|
50
|
|
|
|
20
|
if(not defined $self->{sfx}){ |
|
|
100
|
|
|
|
|
|
41
|
0
|
|
|
|
|
0
|
$self->{sfx} = ''; |
42
|
|
|
|
|
|
|
} elsif(length($self->{sfx}) > 1){ |
43
|
1
|
|
|
|
|
11
|
$self->{sfx} = substr( $self->{sfx}, 1); |
44
|
|
|
|
|
|
|
} |
45
|
4
|
50
|
|
|
|
14
|
if(not defined $self->{pfx}){ |
|
|
100
|
|
|
|
|
|
46
|
0
|
|
|
|
|
0
|
$self->{pfx} = ''; |
47
|
|
|
|
|
|
|
} elsif(length($self->{pfx}) > 1){ |
48
|
1
|
|
|
|
|
6
|
$self->{pfx} = substr( $self->{pfx}, 1); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
4
|
100
|
100
|
|
|
17
|
if($self->{sfx} ne '' and $self->{sfx} eq 's'){ |
52
|
1
|
|
|
|
|
3
|
$self->{sfx} = 1; |
53
|
|
|
|
|
|
|
} |
54
|
4
|
100
|
100
|
|
|
16
|
if($self->{pfx} ne '' and $self->{pfx} eq 'p'){ |
55
|
1
|
|
|
|
|
2
|
$self->{pfx} = 1; |
56
|
|
|
|
|
|
|
} |
57
|
4
|
100
|
66
|
|
|
14
|
if(($self->{sfx} eq '') and ($self->{pfx} eq '')){ |
58
|
1
|
|
|
|
|
3
|
$self->{pfx} = 1; |
59
|
1
|
|
|
|
|
3
|
$self->{sfx} = 1; |
60
|
|
|
|
|
|
|
} |
61
|
4
|
100
|
|
|
|
14
|
if($self->{debug_class} >= 2){ |
62
|
1
|
|
|
|
|
10
|
print "r_s:$self->{sfx} r_p:$self->{pfx} deb:$self->{debug} af:$self->{aff} wf:$self->{wf}\n"; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# get aff file |
68
|
|
|
|
|
|
|
sub get_aff{ |
69
|
1
|
|
|
1
|
0
|
756
|
my $self = shift; |
70
|
1
|
|
|
|
|
7
|
return $self->{aff}; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# set aff file |
74
|
|
|
|
|
|
|
sub set_aff{ |
75
|
0
|
|
|
0
|
0
|
0
|
my ($self,$new_aff) = @_; |
76
|
0
|
|
|
|
|
0
|
$self->{aff} = $new_aff; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# get wf |
80
|
|
|
|
|
|
|
sub get_wf{ |
81
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
82
|
1
|
|
|
|
|
5
|
return $self->{wf}; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# set wf |
86
|
|
|
|
|
|
|
sub set_wf{ |
87
|
0
|
|
|
0
|
0
|
0
|
my ($self,$new_wf) = @_; |
88
|
0
|
|
|
|
|
0
|
$self->{wf} = $new_wf; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
# get sfx |
91
|
|
|
|
|
|
|
sub get_sfx{ |
92
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
93
|
1
|
|
|
|
|
4
|
return $self->{sfx}; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
# set sfx |
96
|
|
|
|
|
|
|
sub set_sfx{ |
97
|
1
|
|
|
1
|
0
|
599
|
my ($self,$new_sfx) = @_; |
98
|
1
|
|
|
|
|
3
|
$self->{sfx} = $new_sfx; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
# get pfx |
101
|
|
|
|
|
|
|
sub get_pfx{ |
102
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
103
|
1
|
|
|
|
|
4
|
return $self->{pfx}; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
# set pfx |
106
|
|
|
|
|
|
|
sub set_pfx{ |
107
|
1
|
|
|
1
|
0
|
599
|
my ($self,$new_pfx) = @_; |
108
|
1
|
|
|
|
|
4
|
$self->{pfx} = $new_pfx; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
# get debug |
111
|
|
|
|
|
|
|
sub get_debug{ |
112
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
113
|
1
|
|
|
|
|
5
|
return $self->{debug}; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
# set debug |
116
|
|
|
|
|
|
|
sub set_debug{ |
117
|
1
|
|
|
1
|
0
|
703
|
my ($self,$new_debug) = @_; |
118
|
1
|
|
|
|
|
3
|
$self->{debug} = $new_debug; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
# return formatted string of the product |
121
|
|
|
|
|
|
|
sub to_string{ |
122
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
0
|
return "aff: $self->{aff}\nwf: $self->{wf}\nsfx: $self->{sfx}\npfx: $self->{pfx}\ndebug: $self->{debug}\ndebug_class: $self->{debug_class}\n"; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub get_endings{ |
128
|
4
|
|
|
4
|
1
|
949
|
my $self = shift; |
129
|
4
|
|
|
|
|
12
|
my ($sfxptr, $hashptr); |
130
|
4
|
|
|
|
|
0
|
my (@sfx_arr, @pfx_arr); |
131
|
|
|
|
|
|
|
|
132
|
4
|
|
|
|
|
14
|
check_args($self); |
133
|
|
|
|
|
|
|
|
134
|
4
|
|
|
|
|
12
|
($sfxptr,$hashptr) = read_in_sfx($self->{aff}, $self->{debug_class}); |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
|
137
|
4
|
50
|
|
|
|
126
|
open(FH, '<', $self->{wf}) or die $!; |
138
|
|
|
|
|
|
|
|
139
|
4
|
|
|
|
|
354
|
while(){ |
140
|
8
|
|
|
|
|
74
|
my @warr = split(/\//, $_); |
141
|
8
|
|
|
|
|
17
|
my $szo = $warr[0]; |
142
|
8
|
|
|
|
|
11
|
my $flags = $warr[1]; |
143
|
8
|
|
|
|
|
18
|
my @flarr = split(//, $flags); |
144
|
8
|
50
|
|
|
|
19
|
if($self->{debug_class} >= 3){ |
145
|
0
|
|
|
|
|
0
|
print "szo:$szo flags:$flags\n"; |
146
|
|
|
|
|
|
|
} |
147
|
8
|
|
|
|
|
32
|
foreach(@flarr){ |
148
|
|
|
|
|
|
|
# get sfx index |
149
|
24
|
|
|
|
|
48
|
my $idx = $hashptr->{$_}; |
150
|
24
|
100
|
|
|
|
43
|
if(defined($idx)){ |
151
|
20
|
100
|
|
|
|
36
|
if($self->{debug_class} >= 2){ |
152
|
5
|
|
|
|
|
29
|
print "tag = $_ idx:$idx\n"; |
153
|
|
|
|
|
|
|
} |
154
|
20
|
|
|
|
|
39
|
my $count = $sfxptr->[$idx]{'count'}; |
155
|
20
|
|
|
|
|
44
|
my $type = $sfxptr->[$idx]{'type'}; |
156
|
20
|
|
|
|
|
26
|
my $comb = $sfxptr->[$idx]{'comb'}; |
157
|
|
|
|
|
|
|
# print "idx:$idx cnt=$count\n"; |
158
|
20
|
|
|
|
|
41
|
for (my $i=0; $i < $count; $i++){ |
159
|
44
|
|
|
|
|
67
|
my ($strip, $addtoword, $cond); |
160
|
44
|
|
|
|
|
68
|
$strip = $sfxptr->[$idx]{'elements'}->[$i]{'strip'}; |
161
|
44
|
|
|
|
|
56
|
$addtoword = $sfxptr->[$idx]{'elements'}->[$i]{'add_to_word'}; |
162
|
44
|
|
|
|
|
63
|
$cond = $sfxptr->[$idx]{'elements'}->[$i]{'condition'}; |
163
|
44
|
50
|
|
|
|
72
|
if($self->{debug_class} >=3){ |
164
|
0
|
|
|
|
|
0
|
print "idx:$idx cnt=$count strip:$strip atw:$addtoword cond:$cond->[0]\n"; |
165
|
|
|
|
|
|
|
} |
166
|
44
|
100
|
|
|
|
79
|
if(met_cond($szo, $cond, $type,$self->{debug_class})){ |
167
|
20
|
|
|
|
|
32
|
my $ujszo; |
168
|
20
|
100
|
|
|
|
40
|
if($type eq 's'){ |
|
|
50
|
|
|
|
|
|
169
|
16
|
|
|
|
|
27
|
$ujszo = strip_add_sfx($szo, $strip, $addtoword); |
170
|
16
|
|
|
|
|
31
|
push(@sfx_arr,$ujszo ); |
171
|
|
|
|
|
|
|
} elsif($type eq 'p'){ |
172
|
4
|
50
|
33
|
|
|
14
|
if($comb eq 'y' or $comb eq 'Y'){ |
173
|
4
|
|
|
|
|
9
|
push( @pfx_arr, $addtoword); |
174
|
|
|
|
|
|
|
} else{ |
175
|
0
|
|
|
|
|
0
|
$ujszo = strip_add_pfx($szo, $strip, $addtoword); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} |
178
|
20
|
100
|
66
|
|
|
70
|
if($self->{sfx} and defined($ujszo)){print "$ujszo\n";} |
|
16
|
|
|
|
|
74
|
|
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
} # flarr |
183
|
8
|
100
|
|
|
|
33
|
if($self->{pfx}){ |
184
|
6
|
50
|
|
|
|
17
|
if($self->{pfx}){ |
185
|
6
|
|
|
|
|
11
|
foreach(@pfx_arr){ |
186
|
3
|
|
|
|
|
12
|
my $pfx = $_; |
187
|
3
|
|
|
|
|
5
|
foreach(@sfx_arr){ |
188
|
6
|
|
|
|
|
11
|
my $ujszo = $pfx.$_; |
189
|
6
|
50
|
|
|
|
12
|
if(defined($ujszo)){print "$ujszo\n";} |
|
6
|
|
|
|
|
18
|
|
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
} # r_prefix |
194
|
8
|
|
|
|
|
13
|
@sfx_arr = (); |
195
|
8
|
|
|
|
|
74
|
@pfx_arr = (); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
4
|
|
|
|
|
193
|
close(FH); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub read_in_sfx{ |
207
|
4
|
|
|
4
|
0
|
9
|
my($affixfile, $debug) = @_; |
208
|
|
|
|
|
|
|
|
209
|
4
|
|
|
|
|
7
|
my $new = 1; |
210
|
4
|
|
|
|
|
7
|
my (@sfx); |
211
|
|
|
|
|
|
|
my ($idx); |
212
|
4
|
|
|
|
|
6
|
$idx = 0; |
213
|
4
|
|
|
|
|
6
|
my $counter = 0; |
214
|
|
|
|
|
|
|
#my $debug = 2; |
215
|
4
|
|
|
|
|
13
|
my %shash; |
216
|
|
|
|
|
|
|
|
217
|
4
|
50
|
|
|
|
123
|
open(FH, '<', $affixfile) or die $!; |
218
|
|
|
|
|
|
|
|
219
|
4
|
|
|
|
|
404
|
while(){ |
220
|
1864
|
100
|
100
|
|
|
7457
|
if(index($_, "SFX ") == 0 or index($_, "PFX ") == 0){ |
221
|
292
|
50
|
|
|
|
487
|
if($debug >=4){ |
222
|
0
|
|
|
|
|
0
|
print $_; |
223
|
|
|
|
|
|
|
} |
224
|
292
|
100
|
|
|
|
429
|
if($new){ |
225
|
92
|
|
|
|
|
350
|
my @fields = split( /\s{1,}/, $_); |
226
|
92
|
|
|
|
|
125
|
my @newarr; |
227
|
|
|
|
|
|
|
# print Dumper (\@fields); |
228
|
92
|
|
|
|
|
238
|
$sfx[$idx]{'count'} = $fields[3]; |
229
|
92
|
|
|
|
|
145
|
$sfx[$idx]{'id'} = $fields[1]; |
230
|
92
|
|
|
|
|
144
|
$sfx[$idx]{'comb'} = $fields[2]; |
231
|
92
|
|
|
|
|
199
|
$shash{$fields[1]} = $idx; |
232
|
92
|
100
|
|
|
|
165
|
if($fields[0] eq 'SFX'){ |
233
|
64
|
|
|
|
|
101
|
$sfx[$idx]{'type'} = 's'; |
234
|
|
|
|
|
|
|
} else{ |
235
|
28
|
|
|
|
|
42
|
$sfx[$idx]{'type'} = 'p'; |
236
|
|
|
|
|
|
|
} |
237
|
92
|
|
|
|
|
126
|
$sfx[$idx]{'elements'} = \@newarr; |
238
|
92
|
|
|
|
|
274
|
$new = 0; |
239
|
|
|
|
|
|
|
} else{ |
240
|
200
|
|
|
|
|
820
|
my @fields = split( /\s{1,}/, $_); |
241
|
200
|
|
|
|
|
332
|
my $r = $sfx[$idx]{'elements'}; |
242
|
200
|
|
|
|
|
321
|
my @newarr = @$r; |
243
|
200
|
|
|
|
|
444
|
$newarr[$counter]{'strip'} = $fields[2]; |
244
|
|
|
|
|
|
|
# |
245
|
|
|
|
|
|
|
# strip /.. from prefix |
246
|
|
|
|
|
|
|
# |
247
|
200
|
|
|
|
|
395
|
my @tmparr = split(/\//, $fields[3]); |
248
|
200
|
|
|
|
|
350
|
$newarr[$counter]{'add_to_word'} = $tmparr[0]; |
249
|
200
|
|
|
|
|
304
|
$newarr[$counter]{'condition'} = read_cond($fields[4], $debug); |
250
|
200
|
|
|
|
|
302
|
$sfx[$idx]{'elements'} = \@newarr; |
251
|
200
|
|
|
|
|
272
|
++ $counter; |
252
|
200
|
100
|
|
|
|
620
|
if($counter eq $sfx[$idx]{'count'}){ |
253
|
92
|
|
|
|
|
117
|
$new = 1; |
254
|
92
|
|
|
|
|
105
|
$counter = 0; |
255
|
92
|
|
|
|
|
264
|
++$idx; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
4
|
|
|
|
|
55
|
close(FH); |
263
|
|
|
|
|
|
|
|
264
|
4
|
|
|
|
|
23
|
return (\@sfx, \%shash); |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub read_cond{ |
269
|
200
|
|
|
200
|
0
|
320
|
my($condition, $debug) = @_; |
270
|
|
|
|
|
|
|
|
271
|
200
|
|
|
|
|
234
|
my @carr; |
272
|
|
|
|
|
|
|
|
273
|
200
|
|
|
|
|
239
|
my $in_loop = 0; |
274
|
200
|
|
|
|
|
429
|
my @condarr = split(//, $condition); |
275
|
200
|
|
|
|
|
255
|
my ($tcarr); |
276
|
200
|
|
|
|
|
286
|
foreach (@condarr){ |
277
|
828
|
100
|
|
|
|
1421
|
if ($_ eq '['){ |
|
|
100
|
|
|
|
|
|
278
|
108
|
50
|
|
|
|
158
|
if(!$in_loop){ |
279
|
108
|
|
|
|
|
159
|
$in_loop = 1; |
280
|
|
|
|
|
|
|
} else { |
281
|
0
|
|
|
|
|
0
|
print "error1 in condition $condition\n"; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
elsif($_ eq ']'){ |
285
|
108
|
50
|
|
|
|
138
|
if($in_loop) { |
286
|
108
|
|
|
|
|
210
|
push(@carr, $tcarr); |
287
|
108
|
|
|
|
|
159
|
$in_loop = 0; |
288
|
108
|
|
|
|
|
166
|
$tcarr = ''; |
289
|
|
|
|
|
|
|
}else { |
290
|
0
|
|
|
|
|
0
|
print "error2 in condition $condition\n"; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
}else { |
293
|
612
|
100
|
|
|
|
824
|
if($in_loop){ |
294
|
464
|
|
|
|
|
648
|
$tcarr .= $_; |
295
|
|
|
|
|
|
|
}else{ |
296
|
148
|
|
|
|
|
327
|
push(@carr, $_); |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
} |
301
|
200
|
50
|
|
|
|
342
|
if($debug >=4){ |
302
|
0
|
|
|
|
|
0
|
my $condarrsize = @carr; |
303
|
0
|
|
|
|
|
0
|
my $i; |
304
|
0
|
|
|
|
|
0
|
print "carr: $condarrsize\n"; |
305
|
0
|
|
|
|
|
0
|
for ($i = 0; $i < $condarrsize; $i++){ |
306
|
0
|
|
|
|
|
0
|
print "$i $carr[$i]\n"; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
} |
309
|
200
|
|
|
|
|
475
|
return \@carr; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
sub met_cond{ |
314
|
44
|
|
|
44
|
0
|
71
|
my($szo, $condref, $type, $debug) = @_; |
315
|
|
|
|
|
|
|
|
316
|
44
|
|
|
|
|
81
|
my @carr = @$condref; |
317
|
44
|
|
|
|
|
53
|
my $condarrsize = @carr; |
318
|
44
|
50
|
|
|
|
82
|
if($debug >=5){ |
319
|
0
|
|
|
|
|
0
|
print "condarrsize:$condarrsize\n"; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
44
|
100
|
66
|
|
|
117
|
if($carr[0] eq '.' and $condarrsize == 1 ){ |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
323
|
12
|
|
|
|
|
37
|
return 1; |
324
|
|
|
|
|
|
|
}elsif ($type eq 's'){ |
325
|
32
|
|
|
|
|
53
|
my $lszo = length($szo); |
326
|
32
|
|
|
|
|
43
|
my $szoidx = $lszo - 1; |
327
|
32
|
|
|
|
|
39
|
my $i; |
328
|
32
|
|
|
|
|
52
|
for($i = $condarrsize -1; $i >=0; $i--){ |
329
|
40
|
|
|
|
|
91
|
my $tobechecked = substr($szo, $szoidx, 1); |
330
|
40
|
50
|
|
|
|
64
|
if($debug >= 4){ |
331
|
0
|
|
|
|
|
0
|
print "tbc:$tobechecked szdx:$szoidx ci:$carr[$i]\n"; |
332
|
|
|
|
|
|
|
} |
333
|
40
|
100
|
|
|
|
77
|
if(length($carr[$i]) == 1){ |
334
|
16
|
100
|
66
|
|
|
48
|
if ( $carr[$i] ne $tobechecked and $carr[$i] ne '.'){ |
335
|
8
|
50
|
|
|
|
11
|
if($debug >= 3){ |
336
|
0
|
|
|
|
|
0
|
print "no match1\n"; |
337
|
|
|
|
|
|
|
} |
338
|
8
|
|
|
|
|
27
|
return 0; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
} else{ |
341
|
24
|
|
|
|
|
78
|
my $j ; |
342
|
24
|
|
|
|
|
33
|
my $matched = 0; |
343
|
24
|
|
|
|
|
28
|
my $clen = length($carr[$i]); |
344
|
24
|
100
|
|
|
|
46
|
if(substr($carr[$i],0,1) eq '^'){ # inverted check |
345
|
12
|
|
|
|
|
26
|
for($j = 1; $j < $clen; $j++){ |
346
|
60
|
100
|
|
|
|
127
|
if(substr($carr[$i],$j,1) eq $tobechecked){ |
347
|
4
|
50
|
|
|
|
29
|
if($debug >= 3){ |
348
|
0
|
|
|
|
|
0
|
print "no match2\n"; |
349
|
|
|
|
|
|
|
} |
350
|
4
|
|
|
|
|
17
|
return 0; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
8
|
|
|
|
|
12
|
$matched = 1; |
354
|
|
|
|
|
|
|
} else{ # at least one matches |
355
|
12
|
|
|
|
|
20
|
for($j = 1; $j < $clen; $j++){ |
356
|
40
|
50
|
|
|
|
90
|
if(substr($carr[$i],$j,1) eq $tobechecked){ |
357
|
0
|
|
|
|
|
0
|
$matched = 1; |
358
|
0
|
|
|
|
|
0
|
last; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
} |
362
|
20
|
100
|
|
|
|
34
|
if($matched eq 0){ |
363
|
12
|
50
|
|
|
|
31
|
if($debug >= 3){ |
364
|
0
|
|
|
|
|
0
|
print "no match3 i= $i szi: $szoidx tbc:$tobechecked\n"; |
365
|
|
|
|
|
|
|
} |
366
|
12
|
|
|
|
|
42
|
return 0; |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
} |
369
|
16
|
|
|
|
|
32
|
--$szoidx; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
} elsif($type eq 'p'){ |
373
|
0
|
|
|
|
|
0
|
my $szoidx = 0; |
374
|
0
|
|
|
|
|
0
|
my $i; |
375
|
0
|
|
|
|
|
0
|
for($i = 0; $i <= $condarrsize -1; $i++){ |
376
|
0
|
|
|
|
|
0
|
my $tobechecked = substr($szo, $szoidx, 1); |
377
|
0
|
0
|
|
|
|
0
|
if($debug >= 4){ |
378
|
0
|
|
|
|
|
0
|
print "tbc:$tobechecked szdx:$szoidx ci:$carr[$i]\n"; |
379
|
|
|
|
|
|
|
} |
380
|
0
|
0
|
|
|
|
0
|
if(length($carr[$i]) == 1){ |
381
|
0
|
0
|
|
|
|
0
|
if ( $carr[$i] ne $tobechecked ){ |
382
|
0
|
0
|
|
|
|
0
|
if($debug >= 3){ |
383
|
0
|
|
|
|
|
0
|
print "no match1\n"; |
384
|
|
|
|
|
|
|
} |
385
|
0
|
|
|
|
|
0
|
return 0; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
} else{ |
388
|
0
|
|
|
|
|
0
|
my $j ; |
389
|
0
|
|
|
|
|
0
|
my $matched = 0; |
390
|
0
|
|
|
|
|
0
|
my $clen = length($carr[$i]); |
391
|
0
|
0
|
|
|
|
0
|
if(substr($carr[$i],0,1) eq '^'){ # inverted check |
392
|
0
|
|
|
|
|
0
|
for($j = 1; $j < $clen; $j++){ |
393
|
0
|
0
|
|
|
|
0
|
if(substr($carr[$i],$j,1) eq $tobechecked){ |
394
|
0
|
0
|
|
|
|
0
|
if($debug >= 3){ |
395
|
0
|
|
|
|
|
0
|
print "no match2\n"; |
396
|
|
|
|
|
|
|
} |
397
|
0
|
|
|
|
|
0
|
return 0; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
} |
400
|
0
|
|
|
|
|
0
|
$matched = 1; |
401
|
|
|
|
|
|
|
} else{ # at least one matches |
402
|
0
|
|
|
|
|
0
|
for($j = 1; $j < $clen; $j++){ |
403
|
0
|
0
|
|
|
|
0
|
if(substr($carr[$i],$j,1) eq $tobechecked){ |
404
|
0
|
|
|
|
|
0
|
$matched = 1; |
405
|
0
|
|
|
|
|
0
|
last; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
} |
409
|
0
|
0
|
|
|
|
0
|
if($matched eq 0){ |
410
|
0
|
0
|
|
|
|
0
|
if($debug >= 3){ |
411
|
0
|
|
|
|
|
0
|
print "no match3 i= $i szi: $szoidx tbc:$tobechecked\n"; |
412
|
|
|
|
|
|
|
} |
413
|
0
|
|
|
|
|
0
|
return 0; |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
} |
416
|
0
|
|
|
|
|
0
|
++$szoidx; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
} |
420
|
8
|
|
|
|
|
23
|
return 1; |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
sub strip_add_sfx{ |
424
|
16
|
|
|
16
|
0
|
30
|
my($szo, $strip, $atw) = @_; |
425
|
16
|
100
|
|
|
|
33
|
if($strip ne '0'){ |
426
|
4
|
|
|
|
|
13
|
$szo = substr($szo, 0, (length($szo)-length($strip))); |
427
|
|
|
|
|
|
|
} |
428
|
16
|
|
|
|
|
36
|
return $szo.$atw; |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
sub strip_add_pfx{ |
432
|
0
|
|
|
0
|
0
|
|
my($szo, $strip, $atw) = @_; |
433
|
0
|
0
|
|
|
|
|
if($strip ne '0'){ |
434
|
0
|
|
|
|
|
|
$szo = substr($szo, 0, (length($szo)-length($strip))); |
435
|
|
|
|
|
|
|
} |
436
|
0
|
|
|
|
|
|
return $atw.$szo; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
1; |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
__END__ |