this seems to do the trick
#!/usr/bin/perl -l
# file storing all legitimate words, one per line
my $DICT = qq(/usr/share/dict/words);
# terms to test for validity
my @TEST = qw(
pizzamilkshake perlmonks pearlmonks hellothere
heytherebaby hey123 timexyz whereangelsare
);
# build dict hash
my %WORDS;
open DICT, "< $DICT" or die $!;
while (<DICT>){
chomp; # chop off whitespace if it's there
$WORDS{uc $_}++; # force UC, add key to %WORDS
}
close DICT;
my (@subs, $giveup, $p1, $p2, $sub);
for my $test (@TEST){
$test = uc $test; # force word to UC at the beginning
@subs = (); # reset sub-match array
$giveup = $p1 = $p2 = 0; # not giving up, starting at the start
while (
!$giveup && # else we've thrown in the towel
$p1 < length($test) # else found match
){
$p1++;
$sub = substr $test, $p2, $p1-$p2; # grab next substring
#print STDERR "sub: $sub";
if ($WORDS{$sub}){ # if it matches a legal word...
#print STDERR "MATCH ($sub) in $test";
push @subs, [ $p1, $p2 ]; # successful path, save it
$p2 = $p1; # advance p2 to the end of the current match
} elsif ($p1 >= length($test)){ # at the end of the string wit
+h no match
# if the entire string doesn't match a word or we have now
+here to
# backtrack...
if ($p2 == 0 || @subs == 0){
#print STDERR "giving up on $test";
$giveup++; # nowhere to go
} else {
#print STDERR "backtracking...";
# reset p1 and p2 to last state and try to get a longe
+r match
($p1, $p2) = @{$subs[$#subs]};
pop @subs; # delete last item... it's path is a dead e
+nd
}
}
}
print ("$test: " . ($giveup ? "NO" : "YES"));
}
perl -MLWP::Simple -e'getprint "http://parseerror.com/p"' |less