use strict; use warnings; my $str = 'foo bar baz'; while () { chomp; print "$_\n" if ob1($str, $_); } sub ob1 { my ($w1, $w2) = @_; return 0 if (abs(length($w1) - length($w2)) > 1); return 1 if $w1 eq $w2; if (length($w1) == length($w2)) { my ($i, $c); for ($i = 0; $i < length($w1); $i++) { $c++ if substr($w1, $i, 1) ne substr($w2, $i, 1); return 0 if $c && $c > 1; } return 1; } if (length($w1) > length($w2)) { my $t = $w1; $w1 = $w2; $w2 = $t; } $w1 = join '.?', '', split(//, $w1), ''; return 1 if $w2 =~ /$w1/; return 0; } __DATA__ fooo bar baz foo bar baaz foo bbar baz foo bar baz foo bar bz fob bar biz fooo bar bazz #### adbc abc a eq a -> 1 d ne b -> c eq c <- 2 b eq b <- 3 d ne a <-