s/(?<=\d)(?=(?:\d\d\d)+$)/,/g
[download]

I appreciate the comment, but you are actually referring to the perlop perldoc. The bit with the commas was just an example of the only bit of that perldoc that had any mention of s/// not replacing all the time. Otherwise, it has nothing to do with my script.

But I thank you for the effort and the consideration nonetheless.

Matt

print STDERR "\$hystackPatt[$j] = $haystackPatt[$j]\n";
print STDERR "\$rxHaystack[$j] = $rxHaystack[$j]\n";
print STDERR "BEFORE: \$text_seqs[$i] = $text_seqs[$i]\n";
$text_seqs[$i] =~ s{$rxHaystack[$j]}{<span class=$class[$a]>$1</span>}
+gmx;
print STDERR "AFTER: \$text_seqs[$i] = $text_seqs[$i]\n";
[download]

Update never mind...
I just realized you are adding the span tags yourself, so you probably want them to stay. Have you considered just marking all the text positions you need and then going by from the right hand side of the string back putting in your tags. This is pretty simple unless you have overlaps, and even then you could do it easier.

For instance, keep a list of tags and their positions in the original string, storing the start and end tags, then strip off everything in the original string until the next tag, print the string, than print any tags that belong at that position, and go to the next position... FAR easier than re-iterating over and over again...

Here is an example

$_ = 'TTTDDDTTTTTTX';

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

my %tags;

for my $pat (@patterns) {
    while(/($pat)/g) {
        print "$pat = $-[0] $+[0]\n";
        push @{$tags{$-[0]}}, "<SPAN CLASS=$pat>";
        push @{$tags{$+[0]}}, "</SPAN>";
    }
}

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]

I have given that some though. I just haven't worked out in my head how to deal with overlaps. However, I do agree that the way I'm doing it now is really really overblown and silly.

One thing I noticed though, was the output of your code:

TTT = 0 3
TTT = 6 9
TTT = 9 12
DDD = 3 6
TD = 2 4
TTTTTT = 6 12
[download]

It shows the TTT bit matching to 6-9 and 9-12. Ideally, I would need that to match 6-9, 7-10, 8-11, and 9-12. No biggie though. Let me play around with it a bit, and see how it works.

Thanks
Matt

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]

                - Ant
                - Some of my best work - (1 2 3)

Correct me if I'm wrong, but the s/// leaves off at the position just after the last replacement ($+[0]). So, if you have

$str = q{TTTTTTT};
$str =~ s/TTT/ttt/i;
[download]

The problem I've been having is that rather than having s/// leave off at $+[0], I was assuming it left off at $-[0] + 1. The difference being, in the example above, with the /g included, the results would be:

$str = tttTTTT # after the first replacement
$str = ttttTTT # after the second replacement 
....
$str = ttttttt # after all the global matches are said and done
[download]

So, my question becomes, is there a way to set s/// to start looking for replacements at $-[0] + 1 when in a global context, rather than at $+[0]

$str = q{TTTTTTT};
$str = s/TTT/ttt/i;
[download]

That should be =~.

So, my question becomes, is there a way to set s/// to start looking for replacements at $-[0] + 1 when in a global context, rather than at $+[0]

In Perl 6 it will be very easy, a matter of specifying the :ov (:overlap) modifier. In 5's realm you can play with the pos function. There's been a very recent discussion about these topics.

My last reply does that here... you use positive lookahead to match only one char in reality, then use the string length you are matching to get the right hand position. You could also do it by using \G and pos, but I wouldn't suggest it. The positive lookahead works well with these fixed length string matches.

                - Ant
                - Some of my best work - (1 2 3)