my $inWord= "[-\\w'(),]";
my $notWord= "[^-\\w'(),]";
s#($notWord)(($inWord)\3(?:$inWord)*($inWord)\4)($notWord)#
    my( $pre, $word, $post )= ( $1, $2, $5 );
    my $len= length($word);
    for(  $word =~ /(.)(\1*)/g  ) {
        $len= length($2)  if  length($2) < $len;
    }
    $word =~ s/(.)\1{$len}/$1/g    if  0 < $len;
    $pre . $word . $post;
#ge