Spell checker

[pingo]

Here is a silly little thing that will attempt to correct misspelled code. I have intentionally left out a few things (unlink and system, for example) to make it somewhat less dangerous to use, but still, if you use this in a production environment you are mad. :-)

package Speller;

use strict;

use Filter::Simple;
use String::Similarity;

my %known;
@known{qw(abs accept alarm and ARGV atan2 BEGIN bind binmode bless cal
+ler chdir chmod chomp chop chown chr chroot close closedir cmp connec
+t continue cos crypt dbmclose dbmopen defined delete die do dump each
+ else elsif END ENV eof eq eval exists exit exp EXPORT EXPORT_OK fcnt
+l fileno flock for foreach fork format formline ge getc getlogin getp
+eername getpgrp getppid getpriority getsockname getsockopt glob gmtim
+e goto grep gt hex HOME if import INC index int ioctl ISA join keys k
+ill last lc lcfirst le length link listen local localtime lock log ls
+tat lt m map mkdir my ne next no not oct open opendir or ord our pack
+ package pipe pop pos print printf prototype push quotemeta rand read
+ readdir readline readlink readpipe recv redo ref rename require rese
+t return reverse rewinddir rindex rmdir s scalar seek seekdir select 
+send setpgrp setpriority setsockopt shift shutdown SIG sin sleep sock
+et socketpair sort splice split sprintf sqrt srand stat strict study 
+sub substr symlink syscall sysopen sysread sysseek syswrite tell tell
+dir tie tied time times tr truncate uc ucfirst umask undef unless unp
+ack unshift untie until use utime values vec wait waitpid wantarray w
+arn while write x xor y)} = undef;

FILTER_ONLY code => \&filter;

sub filter {
    s/\b(?<![\$@%#])([a-z]\w*)\b/check($1)/eg;
}

sub check {
    return $_[0] if exists $known{$_[0]};

    my ($limit, $best_choice) = -1;

    foreach my $known (keys %known) {
    my $similarity = similarity $_[0], $known, $limit;

    if ($similarity > $limit) {
        $best_choice = $known;
        $limit = $similarity;
    }
    }

    return $best_choice;
}

1;

And here is a small example script:

#!/usr/bin/perl -w

use Speller;

yuse struct;

mey @words = qw(samtsirhc yrreM);

fer (moy $i = $#words; $i >= 0; $i--) {
    omy $x = reverb($words[$i]);
    pronto $x, ' ';
}

prunt "\n";