Blame bin/bbspell

Packit e20377
#!/usr/bin/perl -w
Packit e20377
use IPC::Open2;
Packit e20377
#use bytes;
Packit e20377
$debug = 1;
Packit e20377
$hack = 1;
Packit e20377
$minwordlength = 2;
Packit e20377
$comp_recourse_limit = 0;
Packit e20377
my @tail_checked_fail;
Packit e20377
#my($rdrblack, $wtrblack);
Packit e20377
Packit e20377
print "start\n";
Packit e20377
#open(BLACKPIPE, '|ispell -d german -a');
Packit e20377
#open(SPELLPIPE, '|ispell -d german -a');
Packit e20377
#open(COMPPIPE, '|ispell -d german -a');
Packit e20377
#open2($rdrblack, $wtrblack, 'ispell', '-dgerman', '-a');
Packit e20377
open2(\*RDRBLACK, \*WTRBLACK, 'ispell', '-dgermanbl', '-a','-Tlatin1');
Packit e20377
open2(\*RDRSPELL, \*WTRSPELL, 'ispell', '-dgerman', '-a','-Tlatin1');
Packit e20377
#open2(\*RDRSPELL, \*WTRSPELL, 'cspell');
Packit e20377
open2(\*RDRCOMP, \*WTRCOMP, 'ispell', '-dgermancomp', '-a','-Tlatin1');
Packit e20377
open(BLA,"
Packit e20377
for (qw(RDRBLACK RDRSPELL RDRCOMP)) {
Packit e20377
	$tmp = "";
Packit e20377
	while (($tmp ne "\n")) {
Packit e20377
		sysread($_,$tmp,1);
Packit e20377
	}
Packit e20377
}
Packit e20377
print "start2\n";
Packit e20377
#while (<STDIN>) {
Packit e20377
while (<BLA>) {
Packit e20377
	&abbruch if (m/^q$/);
Packit e20377
	s/\/.*//;
Packit e20377
	for $word (m/[\"a-zäöüÄÖÜßéÉ\303\244\204\266\274\234\237]+/gi) {
Packit e20377
		print "spellchecking $word.\n" if ($debug);
Packit e20377
		# 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:
Packit e20377
		@tail_checked_fail = ();
Packit e20377
		$ret=&spellcheck($word,0) or $ret = "nix";
Packit e20377
		print "RESULT: $ret\n";
Packit e20377
		if ($hack) {
Packit e20377
			my $replword=$word;
Packit e20377
			$replword =~ s/$ret$//;
Packit e20377
			print WTRCOMP "$replword\n";
Packit e20377
			$bekannt=0;
Packit e20377
			while (<RDRCOMP>) {
Packit e20377
				$bekannt = 1 if (m/^[\+\*]/);
Packit e20377
				last if ($_ eq "\n");
Packit e20377
			}
Packit e20377
			next if ($bekannt);
Packit e20377
			print "insert $replword ? ";
Packit e20377
			my $a = <>;
Packit e20377
			&abbruch if ($a =~ m/^q$/);
Packit e20377
			if ($a =~ m/^y$/) {
Packit e20377
				print "nehme Wort auf!\n";
Packit e20377
				print WTRCOMP "*$replword\n";
Packit e20377
				sleep 0.3;
Packit e20377
			}
Packit e20377
		}
Packit e20377
	}
Packit e20377
}
Packit e20377
Packit e20377
sub spellcheck {
Packit e20377
	my $word = shift;
Packit e20377
	my $rec_limit = shift;
Packit e20377
#	return "" if ($rec_limit >$comp_recourse_limit);
Packit e20377
	my $okay="0";
Packit e20377
	my $ret = "";
Packit e20377
	my $word_len = length($word);
Packit e20377
	print "spellcheck invoked with $word and $rec_limit\n";
Packit e20377
	if (not $tail_checked_fail[$word_len]) {
Packit e20377
		print WTRBLACK $word,"\n";
Packit e20377
		while (<RDRBLACK> and not $hack) {
Packit e20377
			print "OUT BLACK$rec_limit: $_";
Packit e20377
			$okay = 1 if (m/^[\+\*]/);
Packit e20377
			last if ($_ eq "\n");
Packit e20377
		}
Packit e20377
		print $okay,"\n";
Packit e20377
		if ($okay and not $hack) {
Packit e20377
			$ret = "blacklisted";
Packit e20377
			$tail_checked_fail[$word_len] = 1;
Packit e20377
		} else {
Packit e20377
			print WTRSPELL &myucfirst($word),"\n";
Packit e20377
			while (<RDRSPELL>) {
Packit e20377
				print "OUT SPELL$rec_limit: $_";
Packit e20377
				$okay = 1 if (m/^[\+\*]/);
Packit e20377
				last if ($_ eq "\n");
Packit e20377
			}
Packit e20377
			print $okay,"\n";
Packit e20377
			if ($okay) {
Packit e20377
				$ret = "korrekt";
Packit e20377
				if ($hack) {$ret=$word;}
Packit e20377
			}
Packit e20377
		}
Packit e20377
		
Packit e20377
	}
Packit e20377
	print "L: ",$word_len," > ",$minwordlength*2,"\n";
Packit e20377
	if ((not $ret) and ($word_len > ($minwordlength*2-1)) and not ($rec_limit > $comp_recourse_limit)) {
Packit e20377
		print "if... entered\n";
Packit e20377
		my $i=$minwordlength;
Packit e20377
		while ($i++ < ($word_len-$minwordlength)) {
Packit e20377
			if (not $hack) {
Packit e20377
				print WTRCOMP &myucfirst(substr($word,0,$i)),"\n";
Packit e20377
				$okay="0";
Packit e20377
				while (<RDRCOMP>) {
Packit e20377
					print "OUT COMP$rec_limit: $_";
Packit e20377
					$okay = 1 if (m/^[\+\*]/);
Packit e20377
					last if ($_ eq "\n");
Packit e20377
				}
Packit e20377
				print $okay,"\n";
Packit e20377
			}
Packit e20377
			if ($okay or $hack) {
Packit e20377
				print "OKAY in if reached...$rec_limit\n";
Packit e20377
				$ret = &spellcheck(substr($word,$i),$rec_limit+1);
Packit e20377
				print "ret=$ret\n";
Packit e20377
				last if ($ret =~ m/korrekt/ or ($hack and $ret));
Packit e20377
			}
Packit e20377
		}
Packit e20377
	}
Packit e20377
	return $ret;
Packit e20377
}
Packit e20377
Packit e20377
sub abbruch {
Packit e20377
	close (RDRSPELL);
Packit e20377
	close (WTRSPELL);
Packit e20377
	close (RDRCOMP);
Packit e20377
	close (WTRCOMP);
Packit e20377
	close (RDRBLACK);
Packit e20377
	close (WTRBLACK);
Packit e20377
	exit 0;
Packit e20377
}
Packit e20377
sub myucfirst {
Packit e20377
	my $foo =  shift;
Packit e20377
	$foo =~ s/^é/É/;
Packit e20377
	$foo =~ s/^ä/Ä/;
Packit e20377
	$foo =~ s/^ö/Ö/;
Packit e20377
	$foo =~ s/^ü/Ü/;
Packit e20377
	return ucfirst($foo);
Packit e20377
}