I have not benchmarked this, but it is probably faster than your current version. HTH
use warnings;
use strict;
while (<DATA>) {
chomp;
print "$_ -> ";
my $len = length;
if ( s/(\w)\1{2,}\Z/$1$1/ ) {
$len -= length;
print "$len -> $_";
}
print "\n";
}
__DATA__
ACTGCTAGGGGGGG
TCAGCTAGCNA
ACTGSCGACAAAA
GTCTGAGTTATTT
Update: davido encouraged me to present my alternative version. I converted the original array based variation into a string based one, hoping (not measured) for better speed. So, in the sense of TIMTOWTDI:
use strict;
use warnings;
my $in = shift || 'GATATTTTTTT';
$_ = $in;
my $last = substr $_, -1;
if ( length > 2 and substr($_, -2, 1) eq $last ) {
chop while substr($_, -1) eq $last;
$_ .= $last . $last;
}
print "in : $in\n";
print "out: $_\n";