At first blush, this seems to work. Not sure about the performance; I'll poke at it a bit more. It returns the position of the match, which can be 0, so you have to test if the result is
defined.
sub comp
{
my($s1,$s2)=@_;
my @s1 = split('',$s1);
my @s2 = split('',$s2);
my $transpose;
for (my $i=0;$i<@s1;$i++)
{
if ($s1[$i] ne $s2[$i])
{
if ($transpose)
{
return undef;
}
# Uh-oh; they differ. Is this a transposition?
if ( ($s1[$i+1] eq $s2[$i]) &&
($s1[$i] eq $s2[$i+1]))
{
$transpose = $i;
$i++;
}
}
}
return $transpose;
}