#!/usr/bin/perl

# pragmata
use strict;
use warnings;

# ----------------------------------------------------------------------
# constants

my @CRITERIA =
  (

   { function => 'DIST',
     metric => 'STD DEV',
     units => 'ft',
     ranges => [ 3.4567,        # center value
                 ''      => 0.001, # center tolerance
                 green   => 0.01, # color => tolerance
                 yellow  => 0.2,
                 red     => -1 ] }, # default

   { function => 'AREA',
     metric => 'STD DEV',
     units => 'ft^2',
     ranges => [ 2.78,
                 ''      => 0.01,
                 blue    => 0.1,
                 orange  => 0.3,
                 red     => -1 ] },

   { function => 'DIST2',
     metric => 'DISTANCE',
     units => 'm',
     ranges => [ 3.2,
                 ''      => 0.01,
                 green   => 0.1,
                 orange  => 0.3,
                 red     => -1 ] },

   # if multiple criteria matches the same measurement, the
   # later criteria will be nested inside the earlier ones.
   { function => 'DIST2',
     metric => 'DISTANCE',
     units => 'm',
     ranges => [ 3.2,
                 ''      => 0.01,
                 green2   => 0.1,
                 orange2  => 0.3,
                 red2     => -1 ] }

); # end of @CRITERIA

# ----------------------------------------------------------------------
# regexps ("_nc" means "non capturing"

# match line that starts new function.
#   $1 - function short name
#   $2 - function long description
my $func_start_re = qr/ ^ ( [[:upper:][[:upper:][:digit:]]* ) \s+
                        - \s+ ( .*? ) \s* $ /x;

# a single base unit
my $unit_name_re = qr/ [[:alpha:]]\w* /x;
my $unit_exp_re = qr/ [+-]?\d+ /x;
my $unit_re    = qr/ ( $unit_name_re ) (?: \^ ( $unit_exp_re ) )? /x;
my $unit_re_nc = qr/   $unit_name_re   (?: \^   $unit_exp_re   )? /x;

# a single floating-point number (borrowed from 'perlfaq4'):
my $float_re = qr/ [+-]? (?=\d|\.\d) \d* (?:\.\d*)?
                   (?:[Ee][+-]?\d+)? /x;

# match a single measurement
#   $1 - scalar value
#   $2 - space
#   $3 - units
my $measurement_re    = qr/ ( $float_re ) ( \s+ )
                            ( $unit_re_nc (?: \* $unit_re_nc )* ) /x;
my $measurement_re_nc = qr/   $float_re     \s+
                              $unit_re_nc (?: \* $unit_re_nc )*   /x;

# and one metric line:
#   $1 - leading whitespace
#   $2 - metric name
#   $3 - colon + whitespace
#   $4 - rest of line (0 or more measurements), including trailing newline
my $metric_line_re = qr/ ^ (   \s+ ) ( [A-Z ]+ )
                           ( : \s+ ) ( .* ) $ /sx;

# and just to make the conditionals self-documenting...
my $blank_line_re = qr/ ^ \s* $ /x;

# ----------------------------------------------------------------------
# subroutines

# my $vals = highlight $vals, $crit;
#
# highlight measurements in $vals according to $crit.

sub highlight
{
    my ( $vals, $crit ) = @_;

    # this regex captures three groups, and the -1 keeps
    # leading/trailing empty strings
    my @chunks = split /$measurement_re/, $vals, -1;
    my $rv = '';

  CHUNKS:
    while ( @chunks > 1 )
    {
        my ( $plain, $scalar, $space, $units ) = splice @chunks, 0, 4;
        $rv .= $plain;

        unless ( $units eq $crit->{units} )
        {
            $rv .= $scalar . $space . $units;
            next CHUNKS;
        }

        my @ranges = @{ $crit->{ranges} };
        my $center = shift @ranges;
        my $markup;

      RANGE:
        while ( @ranges )
        {
            my ( $color, $tol ) = splice @ranges, 0, 2;
            my $min = $center - $tol;
            my $max = $center + $tol;
            if ( $tol == -1 || ( $min <= $scalar && $scalar <= $max ) )
            {
                $markup = "<span color=\"$color\">" if $color;
                last RANGE;
            }
        }

        if ( my $markup_end = $markup )
        {
            $markup_end =~ s!<(\w+).*>!</$1>!;
            $rv .= $markup . $scalar . $space . $units . $markup_end;
        }
        else
        {
            $rv .=           $scalar . $space . $units              ;
        }
    }
    return join '', $rv, @chunks;
}

# ----------------------------------------------------------------------
# main processing

my @cur_crit;

while ( my $line = <DATA> )
{
    if ( $line =~ $func_start_re )
    {
        my $func = $1;
        @cur_crit = grep { $_->{function} eq $func } @CRITERIA;
    }
    elsif ( $line =~ $blank_line_re )
    {
        undef @cur_crit;
    }
    elsif ( $line =~ $metric_line_re )
    {
        my ( $indent, $metric, $space, $vals ) =
          (       $1,      $2,     $3,    $4 );

        foreach my $crit ( grep { $_->{metric} eq $metric } @cur_crit )
        {
            $vals = highlight $vals, $crit;
        }

        $line = join '', $indent, $metric, $space, $vals;
    }
    print $line;
}

exit 0;
__DATA__
DIST - Distance
     DISTANCE:       12.3456 ft              4.5678 m
     STD DEV:        3.4567 ft               1.2345 m

AREA - Area
     AREA:           2345.6789 ft^2          345.6789 m^2
     PERIMETER:      234.5678 ft             89.0123 m
     STD DEV:        3.4567 ft               1.2345 m

DIST - Distance
     DISTANCE:       12.3456 ft              4.5678 m
     STD DEV:        3.4567 ft               1.2345 m

DIST - Distance
     DISTANCE:       8.9012 ft               3.0123 m
     STD DEV:        1.2345 ft               0.4567 m

DIST2 - Distance
     DISTANCE:       8.9012 ft               3.0123 m
     STD DEV:        1.2345 ft               0.4567 m