Trying the latest suggestion...

$s = "foooobaaaarrr";
print "Before: $s\n";
$newword = join '', split(/((\w)+)\2(\1{0,1})/, $s);
print "After:  $newword\n";

Result: no change. Not hereabouts, anyway.