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
|
#!/usr/bin/perl -w
use IPC::Open2;
use Getopt::Long;
GetOptions ('l'=>\$opt_l,
'T=s'=>\$opt_T);
$debug = 1;
#$hack = 1;
$minwordlength = 2;
$comp_recourse_limit = 3;
my @tail_checked_fail;
#my($rdrblack, $wtrblack);
$opt_T="plain" unless ($opt_T);
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','-T'.$opt_T);
open2(\*RDRSPELL, \*WTRSPELL, 'ispell', '-dgerman', '-a','-T'.$opt_T);
open2(\*RDRCOMP, \*WTRCOMP, 'ispell', '-dgermancomp', '-a','-T'.$opt_T);
for (qw(RDRBLACK RDRSPELL RDRCOMP)) {
$tmp = "";
while (($tmp ne "\n")) {
sysread($_,$tmp,1);
}
}
print "start2\n";
while (<STDIN>) {
&abbruch if (m/^q$/);
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";
}
}
sub spellcheck {
my $word = shift;
my $rec_limit = shift;
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>) {
print "OUT BLACK$rec_limit: $_";
$okay = 1 if (m/^[\+\*]/);
last if ($_ eq "\n");
}
print $okay,"\n";
if ($okay) {
$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";
}
}
}
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: $_";
$okay = 1 if (m/^[\+\*]/);
last if ($_ eq "\n");
}
print $okay,"\n";
}
if ($okay or $hack) {
print "OKAY in if reached...\n";
$ret = &spellcheck(substr($word,$i),$rec_limit+1);
if ($hack and ($ret =~ m/korrekt/)) {
print "\"",substr($word,0,$i),"\" aufnehmen? ";
}
last if ($ret =~ m/korrekt/);
}
}
}
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/^//;
$foo =~ s/^\303\251/\303\211/; # ->
$foo =~ s/^\303\244/\303\204/; # >
$foo =~ s/^\303\266/\303\226/; # >
$foo =~ s/^\303\274/\303\234/; # >
return ucfirst($foo);
}
|
