#!/usr/bin/perl -w
########################################################################
# Determine the differences between 2 or more CCCma model job strings.
#
# The names of files containing the model job strings are supplied on
# the command line. All jobs are compared with the first job.
#
# The comparison includes parmsub variables as well as any cpp
# preprocessor macros that are defined for the ocean source.
#
# Determine the set of all defined cpp macros given a model job string.
# The model job string must contain a CPP_I section as well as a def for
# cgcm_source and optionally user_source.
#
# Larry Solheim Nov 2009
#
# $Id: jobdiff 625 2010-03-25 17:01:36Z acrnrls $
########################################################################

require 5;
use File::Basename;
use File::Copy;
use Getopt::Long;
use Text::Tabs;
use Shell qw(cp);

# define a unique stamp for file name id etc
chomp($stamp = `date "+%j"$$`);

# Identify this script by name
chomp($Runame = `basename $0`);

# define a temporary dir
$TMPDIR = $ENV{CCRNTMP};
$TMPDIR = $ENV{TMPDIR}  unless ($TMPDIR);
$TMPDIR = "/tmp"        unless ($TMPDIR);

# verbose controls the amount of info written to stdout
$verbose = 0;

# Boolean flag to determine if cpp preporcessor macros are to be compared
# between jobs
$compare_cpp_macros = 1;

# Boolean flag to determine if parmsub variables are to be compared between jobs
$compare_vars = 1;

# Boolean flag to determine if updates are to be compared between jobs
$compare_updates = 1;

# Boolean flag to determine if updates comments are displayed in certain output
$show_update_comments = 1;

# Boolean flag to determine if ocean source dirs are to be "diff"ed between jobs
$compare_ocnsrc = 1;

# Boolean flag to determine if output files containing diffs will be created
# If false then output will still go to stdout
$create_out_files = 1;

# Flist will contain all non-option command line args which should be file names
my @Flist = ();

# Find a pager if one is available
# Use the default pager, if defined in env, otherwise use less
unless ($pager = $ENV{PAGER}) {$pager = "less"};
chomp($pagerpath = `which $pager 2>/dev/null`);
unless ( -x $pagerpath) {
  $pager = "more";
  chomp($pagerpath = `which $pager 2>/dev/null`);
}
unless ( -x $pagerpath) {
  $pager = "pg";
  chomp($pagerpath = `which $pager 2>/dev/null`);
}
unless ( -x $pagerpath) {
  $pager = "";
}

# Define a usage function
$Usage = sub {
  my ($msg)=@_;
  if ($msg) {print "${Runame}: $msg\n"};
  print <<EOR;
  Usage: $Runame [options] model_string ...
Purpose: Compare cpp macros and/or shell variable definitions in job strings

         If invoked with a single model_string on the command line
         Then dumps lists of macro and variable definitions

         If invoked with more than one model_string on the command line
         Then compare each subsequent string to the first string found

         By default only the first job in each model string is processed
Options:
  --[no]vars       ...[do not] do shell variable comparison (default compare)
  --[no]cpp        ...[do not] do cpp macro comparison      (default compare)
  --[no]ocnsrc     ...[do not] do compare ocean source dirs (default compare)
  --verbose        ...increase verbosity (additive)
  --help           ...show this usage info
EOR
  die "\n";
};

# Process command line arguments
$Getopt::Long::ignorecase = 0;
$Getopt::Long::order = $PERMUTE;
&GetOptions("help"            => \&$Usage,
            "verbose"         => sub {$verbose++},
            "vars!"           => \$compare_vars,
            "cpp!"            => \$compare_cpp_macros,
            "updates!"        => \$compare_updates,
            "comm_update!"    => \$show_update_comments,
            "ocnsrc!"         => \$compare_ocnsrc,
            "outfiles!"       => \$create_out_files,
            "<>"              => sub {push @Flist,$_[0]})
  or die "Error on command line. Stopped";

&$Usage("At least one file name is required on the command line")
  unless scalar(@Flist);

unless ($compare_cpp_macros or $compare_vars or $compare_updates) {
  print "No action requested.\n";
  print "Specifying --novars, --nocpp and --noupdates is not allowed.\n";
  die "  Stopped";
}

# Remember where we are
chomp($cwd = `pwd`);

# ensure a trailing slash on cwd
$cwd .= '/' unless $cwd =~ m'/$';

# Ensure all file names in Flist exist and are absolute pathnames
foreach (@Flist) {
  if (m?^\s*/?) {
    # Skip over any file name that begins with "/"
    # after verifying that it exists
    die "The file --> $_ <-- is missing.\n    Stopped"
      unless (-f "$_" or -l "$_");
    next;
  }
  if (-f "$_" or -l "$_") {
    # If the file is relative to cwd then prepend cwd
    substr($_,0,0) = "$cwd";
    next;
  }
  # Otherwise this file is not available
  die "The file --> $_ <-- is missing.\n    Stopped";
}

# print "Flist=", join("\n",@Flist), "\n";

# Create a temporary dir and cd into it
my $tmpd = "$TMPDIR/tmp_$stamp";
mkdir("$tmpd",0755) or die "Unable to create temporary dir ${tmpd}:  $!\n";
chdir("$tmpd")      or die "Unable to cd to ${tmpd}:  $!\n";

  my $nfile = 0;
  foreach my $file (@Flist) {
    die "$file is not a regular file.\n  Stopped" unless -f "$file";
    $nfile++;

    # If this is a link then redefine file as the file the link points to
    $file = readlink $file if -l $file;
    die "$file is not a regular file.\n    Stopped" unless -f "$file";

    # Determine directory name and base name from file
    my ($curr_name, $fdir) = fileparse("$file", ());

    my $fsrc = '';
    open (FILE, "<$file") || die "cannot open $file for input";
      while (<FILE>) {
        # Expand tabs as each line is read
        $fsrc .= expand($_);
      }
    close FILE;

    my $curr_fsrc = $fsrc;
    # replace comment lines with empty lines
    $curr_fsrc =~ s/^\s*#.*$//mg;
    # remove all white space
    $curr_fsrc =~ s/\s//sg;
    # If nothing is left then ignore this file
    next unless $curr_fsrc;

    print "JOB STRING: $curr_name\n";

    # ccc_parse returns an array of hashes, one for each "#end_of_job"
    # delimited job in the current file. Each of these hashes contain
    # information about the structure of that job (e.g. here docs,
    # script sections, updates etc).
    my @JOBS = ccc_parse($file, $fsrc, {VERBOSE=>1});

    # Set $job to the full text of the first job in the input job string
    my $job = $JOBS[0]->{body};
    if ($verbose > 10) {
      print "job:\n$job\n";
    }

    # Print the information in the @JOBS array
    if ($verbose > 1) {
      print_jobs(\@JOBS, {PREFIX => "--- ", LINES => 5});
    }

    if ($nfile == 1) {
      # All subsequent files will be compared with the first file on the command line
      $ANAME = $curr_name;

      # Populate the AVARS hash with variable definitions
      %AVARS = extract_vars({VERBOSE=>1}, $JOBS[0]);

      if ($compare_cpp_macros) {
        # Populate the ADEFS hash with cpp macro name/value pairs
        my $cgcm_source = $AVARS{cgcm_source} if exists $AVARS{cgcm_source};
        my $user_source = $AVARS{user_source} if exists $AVARS{user_source};
        %ADEFS = macro_defs($job, $cgcm_source, $user_source, $ANAME);
        die "  Stopped" unless %ADEFS;
      }

      if ($compare_updates) {
        %AUPDATES = update_defs({VERBOSE=>1}, $JOBS[0]);
        if ($verbose > 10) {
          foreach (sort keys %AUPDATES) {
            print "$_  :: type $AUPDATES{$_}{type}\n$AUPDATES{$_}{text}\n";
          }
        }
      }

      if (scalar(@Flist) == 1 or $verbose > 0) {
        # If there was only 1 jobfile on the command line
        # then print all variable/macro definitions found in that job string
        if ($compare_cpp_macros) {
          # Do a case insensitive sort
          foreach (sort { lc($a) cmp lc($b) } keys %ADEFS) {
            printf "MACRO:%30s = %s\n",$_,$ADEFS{$_};
          }
        }
        if ($compare_vars) {
          printf "%s\n","#"x80;
          # Do a case insensitive sort
          foreach (sort { lc($a) cmp lc($b) } keys %AVARS) {
            printf "  VAR:%30s = %s\n",$_,$AVARS{$_};
          }
        }
        if ($compare_updates) {
          printf "%s\n","#"x80;

          $Nupdates = 0;
          $Nscript_updates = 0;
          $Nmodel_updates = 0;
          $Nsub_updates = 0;
          foreach (keys %AUPDATES) {
            $Nupdates++;
            $Nscript_updates++ if $AUPDATES{$_}{type} =~ /^\s*script/i;
            $Nmodel_updates++ if $AUPDATES{$_}{type} =~ /^\s*model/i;
            $Nsub_updates++ if $AUPDATES{$_}{type} =~ /^\s*sub/i;
          }
          print "Number of script updates in $ANAME = $Nscript_updates\n";
          print "Number of  model updates in $ANAME = $Nmodel_updates\n";
          print "Number of    sub updates in $ANAME = $Nsub_updates\n";
          print " Total number of updates in $ANAME = $Nupdates\n\n";

          # Do a case insensitive sort
          foreach (sort update_byname keys %AUPDATES) {
            next unless $AUPDATES{$_}{type} =~ /^\s*script/i;
            printf "UPDATE %s: %s\n",lc($AUPDATES{$_}{type}),$_;
            if ($show_update_comments and $AUPDATES{$_}{comment} !~ /^\s*$/s) {
              printf "%s%s\n",$AUPDATES{$_}{comment},$AUPDATES{$_}{text};
            } else {
              printf "%s\n",$AUPDATES{$_}{text};
            }
          }
          foreach (sort update_byname keys %AUPDATES) {
            next unless $AUPDATES{$_}{type} =~ /^\s*model/i;
            printf "UPDATE %s: %s\n",lc($AUPDATES{$_}{type}),$_;
            if ($show_update_comments and $AUPDATES{$_}{comment} !~ /^\s*$/s) {
              printf "%s%s\n",$AUPDATES{$_}{comment},$AUPDATES{$_}{text};
            } else {
              printf "%s\n",$AUPDATES{$_}{text};
            }
          }
          foreach (sort update_byname keys %AUPDATES) {
            next unless $AUPDATES{$_}{type} =~ /^\s*sub/i;
            printf "UPDATE %s: %s\n",lc($AUPDATES{$_}{type}),$_;
            if ($show_update_comments and $AUPDATES{$_}{comment} !~ /^\s*$/s) {
              printf "%s%s\n",$AUPDATES{$_}{comment},$AUPDATES{$_}{text};
            } else {
              printf "%s\n",$AUPDATES{$_}{text};
            }
          }
          foreach (sort update_byname keys %AUPDATES) {
            next if ($AUPDATES{$_}{type} =~ /^\s*sub/i or
                    $AUPDATES{$_}{type} =~ /^\s*model/i or
                    $AUPDATES{$_}{type} =~ /^\s*script/i);
            printf "UPDATE %s: %s\n",lc($AUPDATES{$_}{type}),$_;
            if ($show_update_comments and $AUPDATES{$_}{comment} !~ /^\s*$/s) {
              printf "%s%s\n",$AUPDATES{$_}{comment},$AUPDATES{$_}{text};
            } else {
              printf "%s\n",$AUPDATES{$_}{text};
            }
          }
        }
      }
    } else {
      $BNAME = $curr_name;

      # Populate the BVARS hash with variable definitions
      undef %BVARS;
      %BVARS = extract_vars({VERBOSE=>1}, $JOBS[0]);

      if ($compare_cpp_macros) {
        # Populate the BDEFS hash with cpp macro name/value pairs
        undef %BDEFS;
        my $cgcm_source = $BVARS{cgcm_source} if exists $BVARS{cgcm_source};
        my $user_source = $BVARS{user_source} if exists $BVARS{user_source};
        %BDEFS = macro_defs($job, $cgcm_source, $user_source, $BNAME);
        die "  Stopped" unless %BDEFS;
      }

      if ($compare_updates) {
        %BUPDATES = update_defs({VERBOSE=>1}, $JOBS[0]);
      }

      if ($verbose > 0) {
        if ($compare_cpp_macros) {
          foreach (sort keys %BDEFS) {printf "MACRO:%30s = %s\n",$_,$BDEFS{$_}}
        }
        if ($compare_vars) {
          foreach (sort keys %BVARS) {printf "  VAR:%30s = %s\n",$_,$BVARS{$_}}
        }
      }

      if ($create_out_files) {
        # Define a file name/file handle for output from the current comparison
        $cmpfile = "diff_${ANAME}_$BNAME";
        $cmpfh = *CMPFILE;
        if ($verbose > 10) {print "cmpfile=$cmpfile\n"}
        open(CMPFILE, ">$cmpfile") || die "cannot open $cmpfile for output";
        my $cgcm_source = $AVARS{cgcm_source};
        my $user_source = $AVARS{user_source};
        $cgcm_source =~ s/^\s*['"]\s*// if $cgcm_source;
        $cgcm_source =~ s/\s*['"]\s*$// if $cgcm_source;
        $user_source =~ s/^\s*['"]\s*// if $user_source;
        $user_source =~ s/\s*['"]\s*$// if $user_source;
        print $cmpfh "JOB STRING: $ANAME\n";
        print $cmpfh "    cgcm_source = ",$cgcm_source ? $cgcm_source : "","\n";
        print $cmpfh "    user_source = ",$user_source ? $user_source : "","\n";
        $cgcm_source = $BVARS{cgcm_source};
        $user_source = $BVARS{user_source};
        $cgcm_source =~ s/^\s*['"]\s*// if $cgcm_source;
        $cgcm_source =~ s/\s*['"]\s*$// if $cgcm_source;
        $user_source =~ s/^\s*['"]\s*// if $user_source;
        $user_source =~ s/\s*['"]\s*$// if $user_source;
        print $cmpfh "JOB STRING: $BNAME\n";
        print $cmpfh "    cgcm_source = ",$cgcm_source ? $cgcm_source : "","\n";
        print $cmpfh "    user_source = ",$user_source ? $user_source : "","\n";
      } else {
        $cmpfile = '';
        $cmpfh = '';
      }

      # Compare the current set of macros/variables with the first set
      if ($compare_cpp_macros) {
        printf "%s\n",'#'x80;
        if ($cmpfh) {
          printf $cmpfh "%s\n",'#'x80;
        }
        if (compare_defs($ANAME, \%ADEFS, $BNAME, \%BDEFS, "MACRO",
                         {VERBOSE => 1, CMPFH => $cmpfh})) {
          print "\n*** CPP MACRO definitions in job strings $ANAME and $BNAME differ.\n\n";
          if ($cmpfh) {
            print $cmpfh "\n*** CPP MACRO definitions in job strings $ANAME and $BNAME differ.\n\n";
          }
        } else {
          print "\n*** CPP MACRO definitions in job strings $ANAME and $BNAME are identical.\n\n";
          if ($cmpfh) {
            print $cmpfh "\n*** CPP MACRO definitions in job strings $ANAME and $BNAME are identical.\n\n";
          }
        }
        if ($compare_ocnsrc) {
          # Run diff on the ocean source dirs that were created by macro_defs
          printf "%s\n",'#'x80;
          if ($cmpfh) {
            printf $cmpfh "%s\n",'#'x80;
          }
          my $asrcd = sprintf("ocnsrc_%s",$ANAME);
          my $bsrcd = sprintf("ocnsrc_%s",$BNAME);
          if ($verbose > 10) {print "asrcd=$asrcd   bsrcd=$bsrcd\n"}
          if ($verbose > 10) {print `ls -l`}
          my $ocndiff = `diff $asrcd $bsrcd`;
          if ($ocndiff) {
            print "\n*** OCN source directories in $ANAME and $BNAME differ:\n$ocndiff\n";
            if ($cmpfh) {
              print $cmpfh "\n*** OCN source directories in $ANAME and $BNAME differ:\n$ocndiff\n";
            }
          } else {
            print "\n*** OCN source directories in $ANAME and $BNAME are identical.\n";
            if ($cmpfh) {
              print $cmpfh "\n*** OCN source directories in $ANAME and $BNAME are identical.\n";
            }
          }
        }
      }

      if ($compare_vars) {
        printf "%s\n",'#'x80;
        if ($cmpfh) {
          printf $cmpfh "%s\n",'#'x80;
        }
        if (compare_defs($ANAME, \%AVARS, $BNAME, \%BVARS, "VAR",
                         {VERBOSE => 1, CMPFH => $cmpfh})) {
          print "\n*** VARIABLE definitions in job strings $ANAME and $BNAME differ.\n\n";
          if ($cmpfh) {
            print $cmpfh "\n*** VARIABLE definitions in job strings $ANAME and $BNAME differ.\n\n";
          }
        } else {
          print "\n*** VARIABLE definitions in job strings $ANAME and $BNAME are identical.\n\n";
          if ($cmpfh) {
            print $cmpfh "\n*** VARIABLE definitions in job strings $ANAME and $BNAME are identical.\n\n";
          }
        }
      }

      if ($compare_updates) {
        printf "%s\n",'#'x80;
        if ($cmpfh) {
          printf $cmpfh "%s\n",'#'x80;
        }
        if (cmp_updates($ANAME, \%AUPDATES, $BNAME, \%BUPDATES,
                           {VERBOSE => 1, CMPFH => $cmpfh})) {
          print "\n*** UPDATES in job strings $ANAME and $BNAME differ.\n\n";
          if ($cmpfh) {
            print $cmpfh "\n*** UPDATES in job strings $ANAME and $BNAME differ.\n\n";
          }
        } else {
          print "\n*** UPDATES in job strings $ANAME and $BNAME are identical.\n\n";
          if ($cmpfh) {
            print $cmpfh "\n*** UPDATES in job strings $ANAME and $BNAME are identical.\n\n";
          }
        }
      }

      # Close the current output file and copy it to cwd
      if ($cmpfh) {
        close($cmpfh);
        cp("$cmpfile","$cwd");
        die "*** ERROR *** cp $cmpfile $cwd : $?\n" if $?;
        print "Created file $cmpfile\n";
      }
    }
  }

# return to the invoking dir and clean up the temp dir
chdir("$cwd")  or die "Unable to cd to ${cwd}:  $!\n";
@scmd = ("rm","-fr","$tmpd");
$rc = 0xffff & system(@scmd);
if ($rc != 0) {die "*** ERROR *** @scmd:  $!\n"};

exit 0;
########################################################
##################### End of main ######################
########################################################

sub compare_defs {
    # Compare the current set of defined macros with the first set
  my ($namea, $hrefa, $nameb, $hrefb, $TAG, $OPTS) = @_;
  use strict;
  my $are_diff = 0;

  my $verbose = 0;
  if (defined $OPTS->{VERBOSE}) {$verbose = $OPTS->{VERBOSE}};

  my $cmpfh = '';
  $cmpfh = $OPTS->{CMPFH} if defined $OPTS->{CMPFH};

  # Find macros/variables that are defined in both jobs but have different values
  if ($verbose > 0) {
    print "\n";
    if ($cmpfh) {
      print $cmpfh "\n";
    }
  }
  foreach (sort keys %$hrefa) {
    if (exists $hrefb->{$_}) {
      if ($hrefa->{$_} ne $hrefb->{$_}) {
        $are_diff = 1;
        if ($verbose > 0) {
          print "${TAG} differs: --> $_ <--\n";
          printf "${TAG}: %25s:  %s = %s\n",$namea,$_,$hrefa->{$_};
          printf "${TAG}: %25s:  %s = %s\n",$nameb,$_,$hrefb->{$_};
          if ($cmpfh) {
            print $cmpfh "${TAG} differs: --> $_ <--\n";
            printf $cmpfh "${TAG}: %25s:  %s = %s\n",$namea,$_,$hrefa->{$_};
            printf $cmpfh "${TAG}: %25s:  %s = %s\n",$nameb,$_,$hrefb->{$_};
          }
        }
      }
    }
  }
  # Find macros/variables that are defined in the first file but not in the second
  if ($verbose > 0) {
    print "\n${TAG}: Defined in $namea but not in $nameb:\n";
    if ($cmpfh) {
      print $cmpfh "\n${TAG}: Defined in $namea but not in $nameb:\n";
    }
  }
  foreach (sort keys %$hrefa) {
    unless (exists $hrefb->{$_}) {
      # This define appears in the first file but not in the current file
      $are_diff = 1;
      if ($verbose > 0) {
        printf "${TAG}: %30s = %s\n",$_, $hrefa->{$_} ? $hrefa->{$_} : "";
        if ($cmpfh) {
          printf $cmpfh "${TAG}: %30s = %s\n",$_, $hrefa->{$_} ? $hrefa->{$_} : "";
        }
      }
    }
  }
  # Find macros/variables that are defined in the second file but not in the first
  if ($verbose > 0) {
    print "\n${TAG}: Defined in $nameb but not in $namea:\n";
    if ($cmpfh) {
      print $cmpfh "\n${TAG}: Defined in $nameb but not in $namea:\n";
    }
  }
  foreach (sort keys %$hrefb) {
    unless (exists $hrefa->{$_}) {
      # This define appears in the current file but not in the first file
      $are_diff = 1;
      if ($verbose > 0) {
        printf "${TAG}: %30s = %s\n",$_, $hrefb->{$_} ? $hrefb->{$_} : "";
        if ($cmpfh) {
          printf $cmpfh "${TAG}: %30s = %s\n",$_, $hrefb->{$_} ? $hrefb->{$_} : "";
        }
      }
    }
  }
  return $are_diff;
}

sub update_byname {
  my ($A) = $a =~ /^\s*[%*]\s*(?:i|d|c|df|id|deck)\s+(.*)/i;
  my ($B) = $b =~ /^\s*[%*]\s*(?:i|d|c|df|id|deck)\s+(.*)/i;
  lc($A) cmp lc($B);
}

sub cmp_updates {
  # Compare the current set of updates with the first set
  my ($namea, $hrefa, $nameb, $hrefb, $OPTS) = @_;
  use strict;
  my $are_diff = 0;

  my $verbose = 0;
  if (defined $OPTS->{VERBOSE}) {$verbose = $OPTS->{VERBOSE}};

  my $cmpfh = '';
  $cmpfh = $OPTS->{CMPFH} if defined $OPTS->{CMPFH};

  # Find updates that are defined in both jobs but have different values
  if ($verbose > 0) {
    print "\n";
    if ($cmpfh) {
      print $cmpfh "\n";
    }
  }
  foreach (sort update_byname keys %$hrefa) {
    if (exists $hrefb->{$_}) {
      my ($diffs) = sys_diff($hrefa->{$_}->{text}, $hrefb->{$_}->{text});
      if ($diffs) {
        $are_diff = 1;
        if ($verbose > 0) {
          my $TAG = "UPDATE " . lc($hrefa->{$_}->{type});
          print "${TAG} differs: --> $_ <--\n";
          printf "${TAG} from %s:\n",$namea;
          my $L = 0;
          foreach (split /\n/, $hrefa->{$_}->{text}) {
            $L++;
            printf "%6d:%s\n",$L,$_;
          }
          printf "${TAG} diff %s %s:\n%s\n",$namea,$nameb,$diffs;
          if ($cmpfh) {
            print $cmpfh "${TAG} differs: --> $_ <--\n";
            printf $cmpfh "${TAG} from %s:\n",$namea;
            my $L = 0;
            foreach (split /\n/, $hrefa->{$_}->{text}) {
              $L++;
              printf $cmpfh "%6d:%s\n",$L,$_;
            }
            printf $cmpfh "${TAG} diff %s %s:\n%s\n",$namea,$nameb,$diffs;
          }
        }
      }
    }
  }

  # Find updates that are defined in the first file but not in the second
  if ($verbose > 0) {
    print "\nUPDATES Defined in $namea but not in $nameb:\n";
    if ($cmpfh) {
      print $cmpfh "\nUPDATES Defined in $namea but not in $nameb:\n";
    }
  }
  foreach (sort update_byname keys %$hrefa) {
    unless (exists $hrefb->{$_}) {
      # This update appears in the first file but not in the current file
      $are_diff = 1;
      if ($verbose > 0) {
        my $TAG = "UPDATE " . lc($hrefa->{$_}->{type});
        printf "${TAG}: %30s\n%s\n",$_, $hrefa->{$_}->{text} ? $hrefa->{$_}->{text} : "";
        if ($cmpfh) {
          printf $cmpfh "${TAG}: %30s\n%s\n",$_, $hrefa->{$_}->{text} ? $hrefa->{$_}->{text} : "";
        }
      }
    }
  }

  # Find updates that are defined in the second file but not in the first
  if ($verbose > 0) {
    print "\nUPDATES Defined in $nameb but not in $namea:\n";
    if ($cmpfh) {
      print $cmpfh "\nUPDATES Defined in $nameb but not in $namea:\n";
    }
  }
  foreach (sort update_byname keys %$hrefb) {
    unless (exists $hrefa->{$_}) {
      # This update appears in the current file but not in the first file
      $are_diff = 1;
      if ($verbose > 0) {
        my $TAG = "UPDATE " . lc($hrefb->{$_}->{type});
        printf "${TAG}: %30s\n%s\n",$_, $hrefb->{$_}->{text} ? $hrefb->{$_}->{text} : "";
        if ($cmpfh) {
          printf $cmpfh "${TAG}: %30s\n%s\n",$_, $hrefb->{$_}->{text} ? $hrefb->{$_}->{text} : "";
        }
      }
    }
  }
  return $are_diff;
}

sub sys_diff {
  # Do a diff on a pair of input strings using the system diff
  my ($stra, $strb, $OPTS) = @_;
  use strict;

  my $verbose = 0;
  if (defined $OPTS->{VERBOSE}) {$verbose = $OPTS->{VERBOSE}};

  # If the strings are equal then simply return undef
  if ($stra eq $strb) {
    return wantarray ? (undef, 0) : undef;
  }

#   # If one string is defined but the other is not then return the defined string
#   if ($stra and not $strb) {
#     return wantarray ? ($stra, 1) : $stra;
#   }
#   if ($strb and not $stra) {
#     return wantarray ? ($strb, 2) : $strb;
#   }

  # define a unique stamp for file name id etc
  my $stamp = '';
  chomp($stamp = `date "+%j"$$`);

  # Create temporary files containing each input string
  my $filea = "FILEA_$stamp";
  open (FILEA, ">$filea") || die "Cannot open $filea for output";
    print FILEA "$stra";
  close FILEA;
  my $fileb = "FILEB_$stamp";
  open (FILEB, ">$fileb") || die "Cannot open $fileb for output";
    print FILEB "$strb";
  close FILEB;

  my $diffs = `diff -b $filea $fileb 2>/dev/null`;

  unlink $filea or die "Cannot unlink $filea\n  Stopped";
  unlink $fileb or die "Cannot unlink $fileb\n  Stopped";

  return wantarray ? ($diffs, 1) : $diffs;
}

sub line_defs {
  # Given a list of lines of the form "#define name value", return
  # a hash of name/value pairs for each line in the input list.
  # Any lines that do not begin with "#define" are ignored.
  # This input list may be created via a system command such as "cpp -dM $file"
  use strict;

  my %DEFS;
  foreach my $def_line (@_) {
    # The first word of each line should always be "#define"
    # If it is not then ignore this line
    next unless $def_line =~ /^\s*#\s*define/i;
    # Strip this off "#define"
    $def_line =~ s/^\s*#\s*define\s*//i;
    # The next token should be the identifier (name) to be defined
    # This will either be an object-like macro definition of the from
    #    #define <identifier> <replacement token list>
    # or a function-like macro definition of the from
    #    #define <identifier>(<parameter list>) <replacement token list>
    # In the function-like macro definition there can be no space between
    # the identifier and the first parenthesis
    # Define a regex to match the first token of either form
    my $nm = q@\w+(\([^)]*\))?@;
    my ($name) = $def_line =~ m/^($nm)/;
    # Strip leading and trailing white space on name
    $name =~ s/^\s*//;
    $name =~ s/\s*$//;
    # The remainder, if any, will be the value
    $def_line =~ s/^$nm//;
    my $val = $def_line;
    # Strip leading and trailing white space on val
    $val =~ s/^\s*//;
    $val =~ s/\s*$//;
    $DEFS{$name} = $val;
  }
  return %DEFS;
}

sub rip_cpp_i {
  # Extract any CPP_I definition that may appear in this job
  # Return 2 strings:
  #   1) the CPP_I section
  #   2) the input job string with the CPP_I section removed
  use strict;
  use Text::Balanced qw(extract_tagged);
  my ($job) = shift;

  my $verbose = 1;

  # Define a set of regexes that will match the first and last lines
  # of the CPP_I section as well as any text found in the input job
  # string that is before the first line of the CPP_I section
  my $start_cpp = qr/(?:^|\n)[ \t]*## *CPP_I_START *\n/si;
  my $stop_cpp = qr/[ \t]*## *CPP_I_END *\n/si;
  my $pfx   = qr/.*?(?=(?:^|\n)[ \t]*## *CPP_I_START)/si;
  if ($verbose > 10) {
    print "start_cpp = $start_cpp\n";
    print "stop_cpp = $stop_cpp\n";
    print "  pfx = $pfx\n";
  }
  my @cpp_i = extract_tagged($job,$start_cpp,$stop_cpp,$pfx);
  print "extract_tagged: ",$@,"\n" if scalar($@);

  my $CPP_I = $cpp_i[4];
  if ($verbose > 1 and $CPP_I) {print "CPP_I section:\n$CPP_I\n"}
  print "CPP_I is missing from the parmsub section\n" unless $CPP_I;

  my $job_out = $cpp_i[2] . "\n" . $cpp_i[1] . "\n";

  if ($verbose > 10) {
    use Data::Dumper 'Dumper';
    print Dumper [ @cpp_i ];
  }

  return wantarray ? ($CPP_I, $job_out) : $CPP_I;
}

sub macro_defs {
  # Given a job string as input, return a hash of name/value pairs of
  # cpp preprocessor macros that are defined in the ocean source dir
  # associated with the input model job.
  use strict qw(vars);
  use Text::Tabs;
  use Shell qw(cp mv);
  my ($job)         = shift;
  my ($cgcm_source) = shift;
  my ($user_source) = shift;
  my ($fname)       = shift;

  my $verbose = 1;

  # define a unique stamp for file name id etc
  chomp(my $stamp = `date "+%j"$$`);

  if ($verbose > 10) {
    my $dbgpath = "$ENV{HOME}/tmp/tmp_jobdiff_${fname}_$stamp";
    open(JOB, ">$dbgpath") || die "cannot open $dbgpath";
    print JOB "\n\n$job\n\n";
    close(JOB);
  }

  # Extract any CPP_I definition that may appear in this job
  my $CPP_I = rip_cpp_i($job);

  unless ($CPP_I) {
    print "The job string in $fname does not contain any CPP_I section.\n";
    return wantarray ? () : undef;
  }

  unless ($cgcm_source) {
    # Extract verbatim values of cgcm_source and user_source from the job string
    $cgcm_source = '';
    $user_source = '';
    foreach (split /\n/, $job) {
      next if /^\s*#/;   # ignore comment lines
      next unless /=/;   # ignore lines without any parameter defs
      s/^([^#]*).*/$1/;  # strip trailing comments
      # values are backtic delimited
      my $bt = q@`[^`]*`@;
      # values are single quote delimited
      my $sq = q@'[^']*'@;
      # values are double quote delimited
      my $dq = q@"[^"]*"@;
      # values are terminated by a semi colon or white space
      my $sw = q@[^\s;]*?(?=[\s;])@;
      # null values
      my $nv = '\s*;';
      ($cgcm_source) = /\bcgcm_source=($bt|$sq|$dq|$sw|$nv)/g unless $cgcm_source;
      ($user_source) = /\buser_source=($bt|$sq|$dq|$sw|$nv)/g unless $user_source;
    }
    $cgcm_source =~ s/^\s*['"]\s*// if $cgcm_source;
    $cgcm_source =~ s/\s*['"]\s*$// if $cgcm_source;
    $user_source =~ s/^\s*['"]\s*// if $user_source;
    $user_source =~ s/\s*['"]\s*$// if $user_source;

    die "Unable to determine a value for cgcm_source.\n    Stopped" unless $cgcm_source;
  } else {
    # Remove any single or double quotes around cgcm_source and user_source
    $cgcm_source =~ s/^\s*['"]\s*// if $cgcm_source;
    $cgcm_source =~ s/\s*['"]\s*$// if $cgcm_source;
    $user_source =~ s/^\s*['"]\s*// if $user_source;
    $user_source =~ s/\s*['"]\s*$// if $user_source;
  }
  if ($verbose > 0) {print "    cgcm_source = ",$cgcm_source ? $cgcm_source : "","\n"}
  if ($verbose > 0) {print "    user_source = ",$user_source ? $user_source : "","\n"}

  # Create a temporary sub directory and cd into it
  chomp(my $cwd = `pwd`);
  my $srcd = sprintf("./ocnsrc_%s",$fname);
  mkdir("$srcd",0755) or die "Unable to create temporary dir ${srcd}:  $!\n";
  chdir("$srcd")      or die "Unable to cd to ${srcd}:  $!\n";
  if ($verbose > 1) {print "Current tmp dir: ",`pwd`,"\n"}

  # Copy CPP_I_* and *.[Fh] into the cwd but exclude all .* files
  opendir(SRCDIR,$cgcm_source) || die "Cannot open dir $cgcm_source\n    Stopped";
  my @srcfiles = grep !/^\./, readdir SRCDIR;
  closedir SRCDIR;
  my @cpp_i_files = grep /^CPP_I_/, @srcfiles;
  my @cgcm_files = grep /\.[Fh]\s*$/, @srcfiles;
  foreach (@cpp_i_files,@cgcm_files) {
    cp("$cgcm_source/$_",".");
    die "*** ERROR *** cp $_ . :  $?\n" if $?;
  }

  # If a user source dir exists then copy all file found therein to
  # this dir, overwriting any files of the same name
  if ($user_source) {
    # Ensure all file are writeable so they may be overwritten
    # by files from user_source
    `chmod u+rw *`;

    # copy CPP_I_* and *.[Fh] but exclude all .* files
    opendir(SRCDIR,$user_source) ||
      die "Cannot open source dir $user_source\n    Stopped";
    my @srcfiles = grep !/^\./, readdir SRCDIR;
    closedir SRCDIR;
    my @cpp_i_files = grep /^CPP_I_/, @srcfiles;
    my @cgcm_files = grep /\.[Fh]\s*$/, @srcfiles;
    foreach (@cpp_i_files,@cgcm_files) {
      cp("$cgcm_source/$_",".");
      die "*** ERROR *** cp $_ . :  $?\n" if $?;
    }
  }

  # Create a list of all *.[fF] files in this dir
  opendir(SRCDIR,".") || die "Cannot open current dir\n    Stopped";
  my @files = grep /\.[Fh]\s*$/, grep !/^\./, readdir SRCDIR;
  closedir SRCDIR;

  # Remove comment lines from the source
  foreach my $src (@files) {
    next unless $src;
    open (SRC1, "<$src") || die "cannot open $src";
    open (SRC2, ">${src}_$stamp") || die "cannot open ${src}_$stamp";
    while (<SRC1>) {print SRC2 unless /^c/i}
    close SRC1;
    close SRC2;
    mv("${src}_$stamp","$src");
    die "*** ERROR *** mv ${src}_$stamp $src : $?\n" if $?;
    # my $XXX = `cat $src`;
    # print "\n$src\n$XXX\n";
  }

  # Create a file containing the cpp directives found in the input job string
  # This file is named CPP_I and will overwrite any existing file by that name
  open (CPP_I, ">CPP_I") || die "cannot open CPP_I for output";
    print CPP_I $CPP_I;
  close CPP_I;

  # Get a list of all predefined macros in the current environment
  my @predefs = split /\n/,
    `touch xxx_${stamp}.h; cpp -dM xxx_${stamp}.h; rm -f xxx_${stamp}.h`;
  if ($verbose > 10) {print "predefs:\n",join("\n",@predefs),"\n"}
  my %predef = line_defs(@predefs);
  if ($verbose > 10) {foreach (keys %predef) {print "$_ = $predef{$_}\n"}}

  # For each *.[Fh] file determine the set of defined macros
  # then filter out the predefined macros and accumulate name/value
  # pairs in %DEFS
  my %DEFS;
  my %XSRC;
  foreach my $src (@files) {
    next unless $src;
    my @xdefs = split /\n/, `cpp -dM $src 2>/dev/null`;
    my %XDEFS = line_defs(@xdefs);
    foreach my $name (keys %XDEFS) {
      next if exists $predef{$name};
      if (exists $DEFS{$name}) {
        if (exists $XDEFS{$name}) {
          # This macro exists in DEFS but also in XDEFS
          # Verify that the two values are the same
          if (defined $DEFS{$name} and defined $XDEFS{$name}) {
            # Both macros also have a value
            if ("$DEFS{$name}" ne "$XDEFS{$name}") {
              # But they are not the same
              print "The macro $name was previously defined as -->$DEFS{$name}<--\n";
              print "but the current value is -->$XDEFS{$name}<--\n";
              # Add another hash entry with the new value
              $DEFS{"${name}:$src"} = $XDEFS{$name};
            }
          }
        }
      } else {
        # This macro is not predefined and does not yet exist in DEFS
        $DEFS{$name} = $XDEFS{$name};
        $XSRC{$name} = $src;
      }
#      push @{$XSRC{$name}}, $src;
    }
    undef @xdefs;
    undef %XDEFS;
  }
#  if ($verbose > 10) {foreach (keys %XSRC) {print "$_: @{$XSRC{$_}}\n"}}
  if ($verbose > 2) {
    foreach my $name (keys %DEFS) {print "$name = $DEFS{$name}\n"}
  }

  # Change back to the parent dir
  chdir("..") or die "Unable to cd to ${cwd}:  $!\n";

  return %DEFS;
}

sub update_defs {
  # Given a top level hash for a single job as produced by ccc_parse,
  # return a hash of all updates found in the job.
  use strict;
  my $OPTS = shift;

  my $verbose = 0;
  $verbose = $OPTS->{VERBOSE} if defined $OPTS->{VERBOSE};

  my %ALLUPDS;

  foreach my $job (@_) {
    if ($job->{child}) {
      my %UPDS = update_defs($OPTS, @{$job->{child}});
      foreach (keys %UPDS) {
        next if exists $ALLUPDS{$_};
        $ALLUPDS{$_} = $UPDS{$_};
      }
    } else {
      # Only use sections without children to avoid redundant calculations
      my $name = $job->{name};
      my $type = $job->{type};
      if ($verbose > 5) {print "update_defs: name=$name  type=$type\n"}
      # Only attempt to extract updates from update sections
      if ($type =~ /^\s*update/) {
        # The subtype (script, model, sub ...) will be the last word of $name
        my ($subtype) = $name =~ /\s+(\w+)\s*$/;
        my %UPDS = rip_updates($job->{body}, {TYPE => $subtype});
        foreach (keys %UPDS) {
          next if exists $ALLUPDS{$_};
          $ALLUPDS{$_} = $UPDS{$_};
        }
      }
    }
  }

  return %ALLUPDS;
}

sub rip_updates {
  # Extract updates from an "update" section and return them in a hash
  use strict qw(vars);
  my $update_sec = shift;
  my $OPTS = shift;

  my $verbose = 0;
  $verbose = $OPTS->{VERBOSE} if defined $OPTS->{VERBOSE};

  my $type = 0;
  $type = $OPTS->{TYPE} if defined $OPTS->{TYPE};

  my %UPDATES;
  # Read the update section line by line adding keys to the output hash
  # as new updates are found
  my $key = '';
  my $cbuf = '';
  foreach my $line (split /\n/, $update_sec) {
    if ($line =~ /^\s*[%*]\s*(i|d|c|df|id|deck)\s+/i) {
      # this is the start of the next update
      $key = $line;
      # Replace all contiguous white space with a single blank char
      # ignoring extra blanks in these update directives
      $key =~ s/\s+/ /g;
      if (exists $UPDATES{$key}) {
        # A duplicate update is found
        die "Duplicate update $key found.\n  Stopped";
      } else {
        # Provide an initial value for this update
        $UPDATES{$key}{text} = '';
        $UPDATES{$key}{type} = $type ? $type : '';
        $cbuf =~ s/^\s*//;
        $cbuf =~ s/\s*$//;
        $cbuf .= "\n";
        $UPDATES{$key}{comment} = $cbuf ? $cbuf : '';
        $cbuf = '';
      }
      next;
    }

    # Skip any delimiter lines of the form "### update ..."
    next if $line =~ /^\s*###.*update/i;

    # Skip any lines that are "commented out" update lines
    next if $line =~ /^\s*#[# \t]*[%*]/i;

    # Everything before the first update should be commments
    unless ($key) {
      # Add this line to cbuf unless it is blank
      $cbuf .= "$line\n" unless $line =~ /^\s*$/;
      next;
    }

    if ($line =~ /^\s*#/) {
      # Store, in cbuf, any lines that are shell comments
      # unless they are really cpp directives
      my $is_cpp_directive = 0;
      if ($line =~ /^#\s*(else|endif)\s*$/) {
        # else
        # endif
        $is_cpp_directive = 1;
      } elsif ($line =~ /^#\s*define(\s+\w+){1,2}\s*$/) {
        # define Name
        # define Name TokenString
        $is_cpp_directive = 1;
      } elsif ($line =~ /^#\s*define\s+\w+\(/) {
        # define Name(...) ...
        $is_cpp_directive = 1;
      } elsif ($line =~ /^#\s*(undef|ifdef|ifndef)\s+\w+\s*$/) {
        # undef  Name
        # ifdef  Name
        # ifndef Name
        $is_cpp_directive = 1;
      } elsif ($line =~ /^#\s*include\s+("\w+"|<\w+>)\s*$/) {
        # include "File"
        # include <File>
        $is_cpp_directive = 1;
      } elsif ($line =~ /^#\s*(if|elif)\s+[(\s]*defined[\s(]/) {
        # if defined ...
        # if (defined ...
        # if (defined(...
        # elif defined ...
        # elif (defined ...
        # elif (defined(...
        $is_cpp_directive = 1;
      }
      unless ($is_cpp_directive) {
        $cbuf .= "$line\n";
        next;
      }
    }

    unless ($UPDATES{$key}{text}) {
      # Ignore blank line that appear before any text in the update
      next if $line =~ /^\s*$/;
    }

    # Append to the current update
    $UPDATES{$key}{text} .= "$line\n";
  }

  # Remove trailing whitespace from the text of all updates
  # and add a single newline
  foreach (keys %UPDATES) {
    $UPDATES{$_}{text} =~ s/\s*$//;
    $UPDATES{$_}{text} .= "\n";
  }

  return %UPDATES;
}

sub print_jobs {
  use strict;
  my $JOBS = shift;
  my $OPTS = shift;

  my $verbose = 0;
  $verbose = $OPTS->{VERBOSE} if defined $OPTS->{VERBOSE};

  my $prefix = '- ';
  $prefix = $OPTS->{PREFIX} if defined $OPTS->{PREFIX};

  my $lines = 10;
  $lines = $OPTS->{LINES} if defined $OPTS->{LINES};

  use vars q($first_prefix);
  $first_prefix = $prefix unless $first_prefix;

  foreach my $job (@$JOBS) {
    print "\n${prefix}","="x80,"\n";
    printf "${prefix}     NAME: %s\n",$job->{name}      ? $job->{name}      : "";
    printf "${prefix}     TYPE: %s\n",$job->{type}      ? $job->{type}      : "";
    printf "${prefix}   PARENT: %s\n",$job->{parent}    ? $job->{parent}    : "";
    printf "${prefix}    LEVEL: %s\n",$job->{level}     ? $job->{level}     : "";
    printf "${prefix}DELIMITER: %s\n",$job->{delimiter} ? $job->{delimiter} : "";
    if ($job->{child}) {
      print_jobs($job->{child}, {PREFIX => "$prefix$first_prefix", LINES => $lines});
    } elsif ($lines > 0) {
      printf "${prefix}     BODY:\n";
      if ($job->{body}) {
        my $k = 0;
        foreach (split '\n',$job->{body}) {
          $k++;
          last if $k > $lines;
          print "$_\n";
        }
      }
    } elsif ($lines < 0) {
      # Print all lines in the body
      printf "${prefix}     BODY:\n%s\n",$job->{level} ? $job->{level} : "";;
    }
  }
}

sub extract_vars {
  use strict;
  my $OPTS = shift;

  my $verbose = 0;
  $verbose = $OPTS->{VERBOSE} if defined $OPTS->{VERBOSE};

  my %ALLVARS;

  foreach my $job (@_) {
    if ($job->{child}) {
      my %VARS = extract_vars($OPTS, @{$job->{child}});
      foreach (keys %VARS) {
        next if exists $ALLVARS{$_};
        $ALLVARS{$_} = $VARS{$_};
      }
    } else {
      # Only use sections without children to avoid redundant calculations
      my $name = $job->{name};
      my $type = $job->{type};
      if ($verbose > 5) {print "extract_vars: name=$name  type=$type\n"}
      # Only attempt to extract variable definitions from param sections
      if ($name =~ /^.*?-param/) {
        my %VARS = shvals($job->{body}, $OPTS);
        foreach (keys %VARS) {
          next if exists $ALLVARS{$_};
          $ALLVARS{$_} = $VARS{$_};
        }
      }
    }
  }
  if ($verbose > 1) {
    foreach (sort keys %ALLVARS) {
      print "extract_vars: $_ = $ALLVARS{$_}\n";
    }
  }

  return %ALLVARS;
}

sub shvals {
  # Given a string containing valid shell script (except possibly containing a
  # CPP_I section) return a hash of all variable definitions found in that script.
  use strict;
  my $script = shift;
  my $OPTS = shift;
  my %VAR;

  my $verbose = 0;
  $verbose = $OPTS->{VERBOSE} if defined $OPTS->{VERBOSE};

  my $read_verbatim = 0;
  $read_verbatim = $OPTS->{VERBATIM} if defined $OPTS->{VERBATIM};

  # Remove any CPP_I section from this script
  my $addr1 = qr/(?:^|\n)[ \t]*## *CPP_I_START *\n/si;
  my $addr2 = qr/[ \t]*## *CPP_I_END *\n/si;
  $script =~ s?$addr1(.*)$addr2??si;
  if ($verbose > 10) {print "script:\n$script\n"}

  if ($read_verbatim) {
    # Do not source input but read var=val definitions verbatim.
    # This may be useful when the input is not a shell script or it
    # is undesireable to execute it as a shell script.
    my @defs;
    foreach (split /\n/, $script) {
      next if /^\s*#/;   # ignore comment lines
      next unless /=/;    # ignore lines without any parameter defs
      s/^([^#]*).*/$1/; # strip trailing comments
      # values are backtic delimited
      my $bt = q@`[^`]*`@;
      # values are single quote delimited
      my $sq = q@'[^']*'@;
      # values are double quote delimited
      my $dq = q@"[^"]*"@;
      # values are terminated by a semi colon or white space
      my $sw = q@[^\s;]*?(?=[\s;])@;
      # null values
      my $nv = '\s*;';
      push @defs, /\b(\w+=(?:$bt|$sq|$dq|$sw|$nv))/g;
    }
    foreach (@defs) {
      my ($var,$val) = split '=',$_,2;
      $var =~ s/^\s+//;       # strip leading white space from variable
      $var =~ s/\s+$//;       # strip trailing white space from variable
      next unless $var;
      $val =~ s/^\s+//;       # strip leading white space from value
      $val =~ s/\s+$//;       # strip trailing white space from value
      $val =~ s/^"(.*)"$/$1/; # strip double quotes from value
      $val =~ s/^'(.*)'$/$1/; # strip single quotes from value
      # add or replace this variable in the param hash
      $VAR{$var} = $val;
    }
  } else {
    # Source input in a shell then extract variable definitions

    # Get the current environment
    # Set IFS explicitly since it will usually contain a newline
    # which will confuse the following loop because it expects
    # the var=val to be on a single line.
    chomp(my @sh_env = `IFS=' '; set`);
    die "*** ERROR *** executing shell set command\n" if $?;
    my %curr_env;
    foreach (@sh_env) {
      # reformat as a hash
      my ($var,$val) = split '=',$_,2;
      $var =~ s/^\s+//;       # strip leading white space from variable
      $var =~ s/\s+$//;       # strip trailing white space from variable
      next unless $var;
      # do not add this var to the curr_env if
      # it was previously defined for $VAR
      next if exists $VAR{$var};
      $curr_env{$var} = $val;
    }

    # Create a temporary file containing a preprocessed
    # version of the input script
    chomp(my $script_file = `echo "shvar_script_$$"`);
    if (open(SH_SCRIPT, ">$script_file")) {
      foreach (split /\n/,$script) {
        # Retain the shebang line, if any,
        # and throw away all comment lines
        unless (/^\s*#!/) {next if /^\s*#/}
        # ignore lines that source scripts via ". script"
        next if /(^\s*|;\s*|\s)\.\s/;
        print SH_SCRIPT "$_\n";
      }
      close(SH_SCRIPT);
      if ($verbose > 5) {print "Created $script_file\n"};
    } else {
      die "shvals: Cannot open file $script_file for output.\n  Stopped";
    }
    if ($verbose > 10) {
      print "PREPROCESSED SCRIPT: $script_file\n";
      print `cat $script_file`;
    }

    # Now get the environment including the input script variables and
    # add variables to the $VAR hash that were defined in the input
    # script but did not exist in the current default environment.
    @sh_env = ();
    chomp(@sh_env = `IFS=' '; . $script_file >/dev/null 2>&1; set`);
    die "*** ERROR *** executing script in $script_file\n" if $?;
    my $rc = 0xffff & system(('rm','-f',"$script_file"));
    if ($rc != 0) {die "*** ERROR *** rm ${script_file}:  $!\n"};
    foreach (@sh_env) {
      # reformat as a hash
      my ($var,$val) = split '=',$_,2;
      $var =~ s/^\s+//;       # strip leading white space from variable
      $var =~ s/\s+$//;       # strip trailing white space from variable
      next unless $var;
      next if exists $curr_env{$var};
      # $val =~ s/^'(.*)'$/$1/;     # strip single quote delimiters
      # $val =~ s/^\s*(.*)\s*$/$1/; # strip leading/trailing white space
      if ($verbose > 0) {
        if (exists $VAR{$var}) {
          if (defined $VAR{$var}) {
            unless ($VAR{$var} eq $val) {
              print "Parameter $var found in script was previously defined\n";
              print "The previous value ($VAR{$var}) will be replaced by $val\n";
            }
          }
        }
      }
      $VAR{$var} = $val;
      if ($verbose > 5) {print "shvals:  ${var}=$val\n"}
    }
  }
  return %VAR;
}

sub ccc_parse {
  use strict;
  my $file = shift;
  my $string = shift;
  my $OPTS = shift;
  # Split the input job string into sections.
  #
  # An array of hashes is returned with each element containing
  # information about 1 section of the job string.

  # The string is first divided into jobs delimited at the end
  # by "#end_of_job". Each of these jobs is then divided into sections
  # by first separating out (possibly nested) here documents, then by
  # identifying parmsub, condef and update sections.

  my $verbose = 0;
  $verbose = $OPTS->{VERBOSE} if defined $OPTS->{VERBOSE};

  # remove_cpp_i is a boolean flag to indicate whether or not we remove
  # the cpp_I section (if any) from wherever it appears in the job string
  my $remove_cpp_i = 0;
  $remove_cpp_i = $OPTS->{REMOVE_CPP_I} if defined $OPTS->{REMOVE_CPP_I};

  # $parent is the name of the section surrounding the current job.
  # It could be this job or a file.
  my $parent = "file::$file";
#  $parent = $OPTS->{PARENT} if defined $OPTS->{PARENT};

  # $level indicates the depth into the tree, staring from level 0.
  my $level = 0;
#  $level = 1 + $OPTS->{LEVEL} if defined $OPTS->{LEVEL};

  # $with_here_delim determines whether the body of the here document
  # is written to the output hash with or without the initial
  # "cat ...>>..." line and final document end delimiter line.
  my $with_here_delim = 0;
  $with_here_delim = $OPTS->{WITH_HERE_DELIM}
    if defined $OPTS->{WITH_HERE_DELIM};

  my @OUT = ();

  # Split the input string into jobs delimited at the end by lines that
  # start with "#end_of_job" (space is optional around the "#")
  foreach (split(/^\s*#\s*end_of_job/mi, $string)) {
    my $curr_job = $_;
    # replace comment lines with empty lines
    $curr_job =~ s/^\s*#.*$//mg;
    # remove all white space
    $curr_job =~ s/\s//sg;
    # If nothing is left then ignore this job
    next unless $curr_job;
    # strip trailing white space and replace the "#end_of_job" delimiter
    s/\s+$/\n/;
    my $job = "$_\n#end_of_job\n";
    my $jobname = "job::main";

    if ($remove_cpp_i) {
      # Remove any CPP_I section that may appear in this job
      my ($CPP_I, $xjob) = rip_cpp_i($job);
      $job = $xjob;
      undef $xjob;
    }

    # Define hash elements
    my $sec = {};
    $sec->{name} = $jobname;
    $sec->{type} = /^.*?::\s*(\w+)/;
    $sec->{parent} = $parent;
    $sec->{delimiter} = '';
    $sec->{level} = $level;
    $sec->{body} = $job;
    $sec->{child} = '';

    # Check this job for the presence of here documents
    my $subOPTS = {VERBOSE=>$verbose, PARENT=>$jobname,
                   LEVEL=>$level, WITH_HERE_DELIM=>$with_here_delim};
    my @HEREDOCS = split_here_doc($job, $subOPTS);
    if (scalar(@HEREDOCS) > 1) {
      # If any here documents are found in this job (scalar(@HEREDOCS) > 1)
      # then add the array of hashes returned from split_here_doc as a
      # child of the current job.
      $sec->{child} = [ @HEREDOCS ];
      if ($verbose > 5) {print "CHILD:\n@HEREDOCS\n"};
    } else {
      # If there were no here documents in this job then split it
      # into sections with rip_job_sections
      my @SECTIONS = rip_job_sections($job, $subOPTS);
      # Add the child if anything at all (scalar(@SECTIONS) > 0)
      # is returned from rip_job_sections
      if (scalar(@SECTIONS) > 0) {
        $sec->{child} = [ @SECTIONS ];
        if ($verbose > 5) {print "CHILD:\n@SECTIONS\n"}
      }
    }
    push @OUT, $sec;
  }

  return @OUT;
}


sub split_here_doc {
  use strict;
  my $job = shift;
  my $OPTS = shift;
  # Split the input string into sections delimited by the
  # beginning and end of any here documents.
  #
  # An array of hashes is returned with each element containing
  # information about 1 section of the input string. A section is
  # either part of a here document or a part of the string that
  # is outside of any here document.

  my $verbose = 0;
  $verbose = $OPTS->{VERBOSE} if defined $OPTS->{VERBOSE};

  # $parent is the name of the section surrounding the current
  # here document. It could be another here document or a job.
  # By default it is the name of the calling routine
  my ($package, $file, $line, $parent) = caller(1);
  $parent = $OPTS->{PARENT} if defined $OPTS->{PARENT};

  # $level indicates the depth into the tree, staring from level 0.
  my $level = 0;
  $level = 1 + $OPTS->{LEVEL} if defined $OPTS->{LEVEL};

  # $with_here_delim determines whether the body of the here document
  # is written to the output hash with or without the enclosing
  # first "cat ...>>..." line and document end delimiters.
  my $with_here_delim = 0;
  $with_here_delim = $OPTS->{WITH_HERE_DELIM}
    if defined $OPTS->{WITH_HERE_DELIM};

  my $nested = 0;
  $nested = $OPTS->{NESTED} if defined $OPTS->{NESTED};

  my @OUT = ();
  my $end_cat = '';
  my $section = '';
  my $here_file_name = $parent;
  # Define a regex that will match a possibly quoted file name
  my $exrex = q!(`[^`]*`|'[^']*'|"[^"]*"|[\w\.\$/-]+)!;
  # loop through the input string line by line
  foreach my $line (split '\n', $job) {
    unless ($end_cat and $line =~ /^\s*cat([\s><]|\d[><]|&>|$)/) {
      if (my ($ecat) = $line =~ m!^\s*cat.*<<\s*('[^']*'|"[^"]*"|[\w\.\$/-]+)!) {
        $ecat =~ s/^'(.*)'$/$1/;
        $ecat =~ s/^"(.*)"$/$1/;
        # Top of a here doc
        unless ($section =~ /^\s*$/) {
          # Append the previous section to the output array
          # but only if it contains non white space
          my $sec = {};
          $sec->{name} = $parent;
          ($sec->{type}) = $parent =~ /^.*?::\s*(\w+)/;
          $sec->{parent} = $parent;
          $sec->{delimiter} = $end_cat;
          $sec->{level} = $level;
          $sec->{body} = $section;
          $sec->{child} = '';
          my $subOPTS = {VERBOSE=>$verbose, PARENT=>$here_file_name,
                         LEVEL=>$level};
          my @SECTIONS = rip_job_sections($section, $subOPTS);
          # Add the child if anything at all (scalar(@SECTIONS) > 0)
          # is returned from rip_job_sections
          if (scalar(@SECTIONS) > 0) {
            $sec->{child} = [ @SECTIONS ];
            if ($verbose > 5) {print "CHILD:\n@SECTIONS\n"}
          }
          push @OUT, $sec;
        }
        # Reinitialize current values
        $end_cat = $ecat;
        if ($with_here_delim) {
          $section = "$line\n";
        } else {
          $section = '';
        }
        # Incorporate the output file name into the name of this here doc
        ($here_file_name) = $line =~ m!^\s*cat.*>\s*$exrex!;
        $here_file_name =~ s/^'(.*)'$/$1/ if $here_file_name;
        $here_file_name =~ s/^"(.*)"$/$1/ if $here_file_name;
        $here_file_name = 'STDIN' unless $line =~ />/;
        $here_file_name = 'heredoc::' . $here_file_name;
        if ($verbose > 5) {
          print "$line\n";
          print "  here_file_name=$here_file_name";
          print "   end_cat=$end_cat";
          print "   parent=$parent\n";
        }
        next;
      }
    }
    if ($end_cat and $line =~ /^$end_cat/) {
      # end of here document
      if ($with_here_delim) {
        $section .= "$line\n";
      }
      unless ($section =~ /^\s*$/) {
        # Append the previous section to the output array
        # but only if it contains non white space
        my $hdoc = $section;
        # strip the first "cat ..." line and the
        # end delimiter from the here document
        my $sec = {};
        $sec->{name} = $here_file_name;
        ($sec->{type}) = $here_file_name =~ /^.*?::\s*(\w+)/;
        $sec->{parent} = $parent;
        $sec->{delimiter} = $end_cat;
        $sec->{level} = $level;
        $sec->{body} = $section;
        $sec->{child} = '';
        # Ensure that the first "cat ..." line and the document end
        # delimiter are stripped from the body of the here doc.
        $hdoc =~ s/^\s*cat[^\n]*\n//s;
        $hdoc =~ s/\n$end_cat[^\n]*$//s;
        if ($nested) {
          # If any nested here documents are found (scalar(@HEREDOCS) > 1)
          # then add the array of hashes returned from split_here_doc as a
          # child of the current here document.
          my $subOPTS = {VERBOSE=>$verbose, PARENT=>$here_file_name,
                         LEVEL=>$level, WITH_HERE_DELIM=>$with_here_delim};
          my @HEREDOCS = split_here_doc($hdoc, $subOPTS);
          if (scalar(@HEREDOCS) > 1) {
            $sec->{child} = [ @HEREDOCS ];
            if ($verbose > 5) {print "CHILD:\n@HEREDOCS\n"}
          } else {
            my $subOPTS = {VERBOSE=>$verbose, PARENT=>$here_file_name,
                           LEVEL=>$level};
            my @SECTIONS = rip_job_sections($hdoc, $subOPTS);
            # Add the child if anything at all (scalar(@SECTIONS) > 0)
            # is returned from rip_job_sections
            if (scalar(@SECTIONS) > 0) {
              $sec->{child} = [ @SECTIONS ];
              if ($verbose > 5) {print "CHILD:\n@SECTIONS\n"}
            } else {
              $sec->{child} = '';
            }
          }
        } else {
          # Do not extract nested here documents
          # Split $hdoc into sections the begin with a line the form /^ *###.*$regex/
          # where $regex is one of gcmparm, parmsub, condef, update.*script,
          # update.*model, update.*sub, update.*ocean or update.*ocean.*sub
          my $subOPTS = {VERBOSE=>$verbose, PARENT=>$here_file_name,
                         LEVEL=>$level};
          my @SECTIONS = rip_job_sections($hdoc, $subOPTS);
          # Add the child if anything at all (scalar(@SECTIONS) > 0)
          # is returned from rip_job_sections
          if (scalar(@SECTIONS) > 0) {
            $sec->{child} = [ @SECTIONS ];
            if ($verbose > 5) {print "CHILD:\n@SECTIONS\n"}
          }
        }
        push @OUT, $sec;
      }
      # Initialize current values
      $end_cat = '';
      $section = '';
      $here_file_name = "$parent";
      next;
    }
    $section .= "$line\n";
  }

  if ($end_cat) {
    # The string finished with a open here document
    die "Syntax error in job string. Incomplete here document.\n  Stopped";
  }

  if ($section) {
    unless ($section =~ /^\s*$/) {
      # Append the previous section to the output array
      # but only if it contains non white space
      my $sec = {};
      $sec->{name} = $here_file_name;
      ($sec->{type}) = $here_file_name =~ /^.*?::\s*(\w+)/;
      $sec->{parent} = $parent;
      $sec->{delimiter} = $end_cat;
      $sec->{level} = $level;
      $sec->{body} = $section;
      $sec->{child} = '';
      my $subOPTS = {VERBOSE=>$verbose, PARENT=>$here_file_name,
                     LEVEL=>$level};
      my @SECTIONS = rip_job_sections($section, $subOPTS);
      # Add the child if anything at all (scalar(@SECTIONS) > 0)
      # is returned from rip_job_sections
      if (scalar(@SECTIONS) > 0) {
        $sec->{child} = [ @SECTIONS ];
        if ($verbose > 5) {print "CHILD:\n@SECTIONS\n"}
      }
      push @OUT, $sec;
    }
  }

  return @OUT;
}

sub rip_job_sections {
  use strict;
  my $string = shift;
  my $OPTS = shift;
  # Split the input string into sections that begin with a line
  # of the form /^ *###.*$regex/ and end with either one of these header
  # lines or a line of the form /^ *end_of_data *$/ or /^ *# *end_of_job *$/.
  # Here regex is one of gcmparm, parmsub, condef, update.*script,
  # update.*model, update.*sub, update.*ocean or update.*ocean.*sub
  #
  # An array of hashes is returned with each element containing
  # information about 1 section of the job string.

  my $verbose = 0;
  $verbose = $OPTS->{VERBOSE} if defined $OPTS->{VERBOSE};

  # $parent is the name of the section surrounding the current
  # here document. It could be another here document or a job.
  # By default it is the name of the calling routine
  my ($package, $file, $line, $parent) = caller(1);
  $parent = $OPTS->{PARENT} if defined $OPTS->{PARENT};

  # $level indicates the depth into the tree, staring from level 0.
  my $level = 0;
  $level = 1 + $OPTS->{LEVEL} if defined $OPTS->{LEVEL};

  # $with_parmsub determines whether gcmparm, parmsub and condef will
  # be returned as individual sections or returned as a single section.
  my $with_parmsub = 0;
  $with_parmsub = $OPTS->{WITH_PARMSUB} if defined $OPTS->{WITH_PARMSUB};

  # $with_updates determines whether all update sections will be
  # returned as individual sections or returned as a single section.
  my $with_update = 1;
  $with_update = $OPTS->{WITH_UPDATE} if defined $OPTS->{WITH_UPDATE};

  # first_sec is a boolean flag to identify the first non-update section
  my $first_sec=1;

  my @OUT = ();
  my $section_name = "sec::shell";
  my $section = '';
  foreach (split /\n/, $string) {
    my $sname = '';
    if ($with_parmsub) {
      if (($sname) = /^\s*###.*(gcmparm)/i or
          ($sname) = /^\s*###.*(parmsub)/i or
          ($sname) = /^\s*###.*(condef)/i) {my $xxx=0}
    }
    if ($with_update and not $sname) {
      if (($sname) = /^\s*###.*(update.*script)/i or
          ($sname) = /^\s*###.*(update.*model)/i or
          ($sname) = /^\s*###.*(update.*sub)/i or
          ($sname) = /^\s*###.*(update.*ocean)/i or
          ($sname) = /^\s*###.*(update.*ocean.*sub)/i) {my $xxx=0}
    }
    if ($sname) {
      # Do not return a section containing only white space
      unless ($section =~ /^\s*$/) {
        my $sec = {};
        $sec->{name} = $section_name;
        if ($first_sec) {
          $first_sec = 0;
          if ($section_name !~ /^.*?::\s*update/ and
              $section !~ /^\s*end_of_data/si) {
            $sec->{name} = "${section_name}-param"
          }
        }
        ($sec->{type}) = $section_name =~ /^.*?::\s*(\w+)/;
        $sec->{parent} = $parent;
        $sec->{delimiter} = '';
        $sec->{level} = $level;
        $sec->{body} = $section;
        $sec->{child} = '';
        push @OUT, $sec;
      }

      # Reinitialize section variables
      $section_name = "sec::$sname";
      $section = "$_\n";
    } else {
      $section .= "$_\n";
    }
  }
  if ($section) {
    # Do not return a section containing only white space
    unless ($section =~ /^\s*$/) {
      my $sec = {};
      $sec->{name} = $section_name;
      if ($first_sec) {
        $first_sec = 0;
        if ($section_name !~ /^.*?::\s*update/ and
            $section !~ /^\s*end_of_data/si) {
          $sec->{name} = "${section_name}-param"
        }
      }
      ($sec->{type}) = $section_name =~ /^.*?::\s*(\w+)/;
      $sec->{parent} = $parent;
      $sec->{delimiter} = '';
      $sec->{level} = $level;
      $sec->{body} = $section;
      $sec->{child} = '';
      push @OUT, $sec;
    }
  }

  return @OUT;
}