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
|
#!/usr/bin/perl -w
use IPC::Open2;
use Getopt::Long;
GetOptions ('l'=>\$opt_l,
'T=s'=>\$opt_T);
$hack = 0;
$minwordlength = 2;
my @tail_checked_fail;
#my($rdrblack, $wtrblack);
$opt_T="plain" unless ($opt_T);
print "@(#) International Ispell (really BSPELL) Version 3.2.06 08/01/01\n" unless ($opt_l);
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);
}
}
while (<STDIN>) {
&abbruch if (m/^q$/);
for $word (m/[\"a-z\303\244\204\266\274\234\237]+/gi) {
# 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);
if ($ret) {
$ret=($opt_l) ? "":"* $word\n";
} else {
$ret=($opt_l) ? "$word\n":"# $word\n";
}
print "$ret";
print "\n" unless ($opt_l);
}
}
sub spellcheck {
my $word = shift;
my $okay="0";
my $ret = "";
my $word_len = length($word);
if (not $tail_checked_fail[$word_len]) {
print WTRBLACK $word,"\n";
while (<RDRBLACK>) {
$okay = 1 if (m/^[\+\*]/);
last if ($_ eq "\n");
}
if ($okay) {
$ret = "blacklisted";
$tail_checked_fail[$word_len] = 1;
} else {
print WTRSPELL &myucfirst($word),"\n";
while (<RDRSPELL>) {
$okay = 1 if (m/^[\+\*]/);
last if ($_ eq "\n");
}
if ($okay) {
$ret = "korrekt";
}
}
}
if ((not $ret) and ($word_len > ($minwordlength*2-1))) {
my $i=$minwordlength;
while ($i++ < ($word_len-$minwordlength)) {
if (not $hack) {
print WTRCOMP &myucfirst(substr($word,0,$i)),"\n";
$okay="0";
while (<RDRCOMP>) {
$okay = 1 if (m/^[\+\*]/);
last if ($_ eq "\n");
}
}
if ($okay or $hack) {
$ret = &spellcheck(substr($word,$i));
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/^[a-z]/[A-Z]/;
# return $foo;
#}
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);
}
|
