To scramble every word in a string leaving first and last characters intact:

$string = "Hello there this is a scrambled mess";

sub scramble($)
{
  my @a;  
  splice @a,rand (@a+1),0,$_ for split '',(shift);
  join '',@a;
}  

($scrambled = $string) =~ s/(?:(?<=\A\w)|(?<=\W\w))\w+?(?:(?=\w\Z)|(?=
+\w\W))/scramble $&/eg;

print "$scrambled\n";
[download]

Hlelo trehe tihs is a smlbceard mess