A little bit of smoke and mirrors, then...

$_ = 'TTTDDDTTTTTTX';

my @patterns = qw(TTT DDD TD TTTTTT);

my %tags;

for my $pat (@patterns) {
    my $pat2 = substr($pat,0,1).'(?='.substr($pat,1,length($pat)).')';
+ # T(?=TT) only REALLY matches the first char, but that still works
    while(/($pat2)/g) {
        print "$pat = $-[0] $+[0]\n";
        push @{$tags{$-[0]}}, "<SPAN CLASS=$pat>";
        push @{$tags{$-[0]+length($pat)}}, "</SPAN>"; # instead of usi
+ng $+[0] we use $-[0]+the length of the string matched, since it is a
+ fixed string, no problems.
    }
}

my $currentpos = 0;
print "$_\n";
for my $pos (sort { $a <=> $b } keys %tags) {
    print substr($_,0,($pos-$currentpos),'');
    print join('',@{$tags{$pos}});
    $currentpos = $pos;
}
print $_,"\n";
[download]