1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
#!/usr/bin/perl -w
use IPC::Open2;
#use bytes;
$debug = 1;
$hack = 1;
$minwordlength = 2;
$comp_recourse_limit = 0;
my @tail_checked_fail;
#my($rdrblack, $wtrblack);
print "start\n";
#open(BLACKPIPE, '|ispell -d german -a');
#open(SPELLPIPE, '|ispell -d german -a');
#open(COMPPIPE, '|ispell -d german -a');
#open2($rdrblack, $wtrblack, 'ispell', '-dgerman', '-a');
open2(\*RDRBLACK, \*WTRBLACK, 'ispell', '-dgermanbl', '-a','-Tlatin1');
open2(\*RDRSPELL, \*WTRSPELL, 'ispell', '-dgerman', '-a','-Tlatin1');
#open2(\*RDRSPELL, \*WTRSPELL, 'cspell');
open2(\*RDRCOMP, \*WTRCOMP, 'ispell', '-dgermancomp', '-a','-Tlatin1');
open(BLA,"</tmp/bla6.txt");
for (qw(RDRBLACK RDRSPELL RDRCOMP)) {
$tmp = "";
while (($tmp ne "\n")) {
sysread($_,$tmp,1);
}
}
print "start2\n";
#while (<STDIN>) {
while (<BLA>) {
&abbruch if (m/^q$/);
s/\/.*//;
for $word (m/[\"a-z\303\244\204\266\274\234\237]+/gi) {
print "spellchecking $word.\n" if ($debug);
# the same word tail can be looked up multiple times in various incarnations of the spellcheck function, so we try to remember the number of tailing characters of missed main dictionary lookups in a global array. This is little overhead but may save lots of CPU cycles:
@tail_checked_fail = ();
$ret=&spellcheck($word,0) or $ret = "nix";
print "RESULT: $ret\n";
if ($hack) {
my $replword=$word;
$replword =~ s/$ret$//;
print WTRCOMP "$replword\n";
$bekannt=0;
while (<RDRCOMP>) {
$bekannt = 1 if (m/^[\+\*]/);
last if ($_ eq "\n");
}
next if ($bekannt);
print "insert $replword ? ";
my $a = <>;
&abbruch if ($a =~ m/^q$/);
if ($a =~ m/^y$/) {
print "nehme Wort auf!\n";
print WTRCOMP "*$replword\n";
sleep 0.3;
}
}
}
}
sub spellcheck {
my $word = shift;
my $rec_limit = shift;
# return "" if ($rec_limit >$comp_recourse_limit);
my $okay="0";
my $ret = "";
my $word_len = length($word);
print "spellcheck invoked with $word and $rec_limit\n";
if (not $tail_checked_fail[$word_len]) {
print WTRBLACK $word,"\n";
while (<RDRBLACK> and not $hack) {
print "OUT BLACK$rec_limit: $_";
$okay = 1 if (m/^[\+\*]/);
last if ($_ eq "\n");
}
print $okay,"\n";
if ($okay and not $hack) {
$ret = "blacklisted";
$tail_checked_fail[$word_len] = 1;
} else {
print WTRSPELL &myucfirst($word),"\n";
while (<RDRSPELL>) {
print "OUT SPELL$rec_limit: $_";
$okay = 1 if (m/^[\+\*]/);
last if ($_ eq "\n");
}
print $okay,"\n";
if ($okay) {
$ret = "korrekt";
if ($hack) {$ret=$word;}
}
}
}
print "L: ",$word_len," > ",$minwordlength*2,"\n";
if ((not $ret) and ($word_len > ($minwordlength*2-1)) and not ($rec_limit > $comp_recourse_limit)) {
print "if... entered\n";
my $i=$minwordlength;
while ($i++ < ($word_len-$minwordlength)) {
if (not $hack) {
print WTRCOMP &myucfirst(substr($word,0,$i)),"\n";
$okay="0";
while (<RDRCOMP>) {
print "OUT COMP$rec_limit: $_";
$okay = 1 if (m/^[\+\*]/);
last if ($_ eq "\n");
}
print $okay,"\n";
}
if ($okay or $hack) {
print "OKAY in if reached...$rec_limit\n";
$ret = &spellcheck(substr($word,$i),$rec_limit+1);
print "ret=$ret\n";
last if ($ret =~ m/korrekt/ or ($hack and $ret));
}
}
}
return $ret;
}
sub abbruch {
close (RDRSPELL);
close (WTRSPELL);
close (RDRCOMP);
close (WTRCOMP);
close (RDRBLACK);
close (WTRBLACK);
exit 0;
}
sub myucfirst {
my $foo = shift;
$foo =~ s/^//;
$foo =~ s/^//;
$foo =~ s/^//;
$foo =~ s/^//;
return ucfirst($foo);
}
|
