rube-colorize.pl

#! /bin/perl

#use re 'debug';

$file = qq(DIST - Distance
   DISTANCE:   345.6789 ft   105.3630 m
   STD DEV:     12.3456 ft     3.7630 m

AREA - Area
   AREA:     13041.0119 ft^2 1211.5499 m^2
   PERIMETER:  456.7890 ft    139.2293 m
   STD DEV:     12.3456 ft      3.7630 m

DIST - Distance
   DISTANCE:   345.6789 ft   105.3630 m
   STD DEV:     12.3456 ft     3.7630 m

DIST - Distance
   DISTANCE:   456.7890 ft  123.4567 m
   STD DEV:     23.4567 ft    5.6789 m
);
$function = 'DIST';
$metric   = 'STD DEV';
$unit     = 'ft';
@vals     = ('12.3456', '12.3456', '23.4567');
@cols     = ('green',   'red',     'yellow');


print "######## BAD 1 ########\n";
$s = $file;
for $i (0..$#vals) {
  $val = $vals[$i];
  $col = $cols[$i];
  $s =~ s{($function.*?$metric.*?)(?<!>)($val\s+$unit)}
         {$1<span color="$col">$2</span>}s;
}
print $s; # BAD: colored 12.3456 in AREA

print "\n\n######## BAD 2 ########\n";
$i=$j=0;
$s = $file;
$s =~ s{($function.*?$metric.*?)(?<!>)($vals[$i++]\s+$unit)}
       {$1<span color="$cols[$j++]">$2</span>}gs;

print $s; # BAD: didn't color 23.4567 in last DIST
print "i is now $i\n";
print "j is now $j\n";


print "\n\n######## BAD 3 ########\n";
$i=$j=0;
$s = $file;
push @vals, 'NEVER_MATCH_THIS_STRING';
while ($s =~ s{\G($function.*?$metric.*?)(?<!>)($vals[$i++]\s+$unit)}
              {$1<span color="$cols[$j++]">$2</span>}s) {
  printf "pos is %d\n", pos $s; 
}
pop @vals;
print $s; # BAD: apparently pos and \G are meaningless for s///


print "\n\n######## GOOD 1 ########\n";
$head = '';
$tail = $file;
for $i (0..$#vals) {
  $tail =~ s{(^.*?$function.*?$metric.*?)(?<!>)($vals[$i]\s+$unit)}{}s;
  $head .= qq($1<span color="$cols[$i]">$2</span>);
}
$head .= $tail;
print $head; # GOOD


print "\n\n######## GOOD 2 ########\n";
($s = $file) =~ s!([A-Z]{3,}\s*\-\s*\w+)!SPLIT_HERE$1!g;
@funcs = split /SPLIT_HERE/, $s;
$i=0;
for (@funcs) {
  if (s{^($function.*?$metric.*?)(?<!>)($vals[$i]\s+$unit)}
       {$1<span color="$cols[$i]">$2</span>}s) {
    $i++;
  }
  last if $i > $#vals;
}
$s = join '', @funcs;
print $s; # GOOD