# ptest.pl
#
# Sample program to edit a configuration file.
# This configuration file lacks a formal syntax specification;
# the example configuration below is all I've got.
# All fields should be treated case insensitively.

# The goal is to change field values of:
#   "REGION"  to  "LOCATION"
#   "RUBBISH" to  "TRASH"
# but only if the RECORD value in the VIEW is either "ABC" or "XYZ".

# If you run with:
#   perl ptest.pl >1.tmp 2>2.tmp
# 1.tmp will contain original file, 2.tmp will contain the changed version.

use strict;
use warnings;

my $s_in = <<'GROK';
# comment line
VIEW View1
   RECORD           "ABC"
   FIELD            (
      FIELD            "TYPEFROM"
      FIELD            "REGION"
      FIELD            "RUBBISH"
   )
   INTERVAL         600 SECONDS
END_VIEW
VIEW View2
   RECORD           "HELLO"
   FIELD            (
      FIELD            "TYPETO"
      FIELD            "REGION"
      FIELD            "RUBBISH"
   )
   INTERVAL         700 SECONDS
END_VIEW
# random line 1
VIEW View3
   RECORD           "XYZ"
   FIELD            (
      FIELD            "FLD1"
      FIELD            "Region"
# random line 2
      FIELD            "Rubbish"
   )
   INTERVAL         800 SECONDS
END_VIEW
# random line 3
GROK

# Ensure properly newline terminated
substr( $s_in, -1 ) ne "\n" and $s_in .= "\n";

my @recs = ( 'ABC', 'XYZ' );
my %fldmap = (
   REGION  => 'LOCATION',
   RUBBISH => 'TRASH',
);
my $fldstr = join '|', keys %fldmap;

print $s_in;

my $s_out;
while (1)
{
   # Extract VIEW ... END_VIEW block
   if ( $s_in =~ /\G(^[ \t]*\bVIEW\b.*?^[ \t]*\bEND_VIEW\b)/msgic )
   {
      my $view = $1;
      # Check for matching RECORD in VIEW block
      if ( $view =~ /^[ \t]*\bRECORD\b[ \t]*"(.*?)"/mi )
      {
         my $rec = $1;
         if ( length($rec) && grep( /^\Q$rec\E$/i, @recs ) )
         {
            # Translate fields
            $view =~ s/(\bFIELD\b[ \t]*?")($fldstr)"/$1 . $fldmap{uc($2)} . '"'/gie;
         }
      }
      $s_out .= $view;
   }
   elsif ( $s_in =~ /\G(.*\n)/gc )
   {
      $s_out .= $1;
   }
   else
   {
      last;
   }
}

warn $s_out;