#!/usr/bin/perl -w
########################################################################
# Create a set of unified diffs from a set of updates.
# Apply these diffs, using patch, to create the set of files that would
# have been created by update using the given set of updates.
#
# Larry Solheim Jan,2013
########################################################################

require 5;
use strict;
use File::Basename;
use File::Copy;
use Getopt::Long;
use Text::Tabs;
use Cwd qw(cwd abs_path);
# stat with the access/modify/change file timestamps in subsecond resolution
use Time::HiRes qw(stat);

# Declare global variables
use vars qw( $stamp %usrvar $verbose $wrkd $CCRNSRC $modver %updefs );
use vars qw( %LSMOD %LSSUB %SCRIPT %SOURCE %DUPLICATE );
use vars qw( @usr_srcdir %USRSRC $recursive );
use vars qw( $with_compile_updates $with_up_to_cpp );
use vars qw( %DIFFScpp $PATCH %PATCH_FILES %NEW_FILES @patched_files %is_c_update );

use Sys::Hostname;
my $host = hostname();
$host =~ s/^(.*?)\..*$/$1/;

# Define a local variable to indicate the root dir of the CCRN source tree
my $CCRNSRC = "";
if ( $ENV{CCRNSRC} ) {
  # Define CCRNSRC if it is defined in the current environment
  # The official UVic CCRNSRC source tree is out of date
  # However, a subdir named $CCRNSRC/sv08src does contain regularly updated source
  # This dir only exists at UVic so it should be safe to use it if it exists
  if ( -d "$ENV{CCRNSRC}/sv08src" ) {
    $CCRNSRC = "$ENV{CCRNSRC}/sv08src";
  } elsif ( -d "$ENV{CCRNSRC}" ) {
    $CCRNSRC = "$ENV{CCRNSRC}";
  } else {
    die "** EE ** CCRNSRC=$ENV{CCRNSRC} is not a directory\n";
  }
  # Follow any links
  $CCRNSRC = readlink $CCRNSRC if -l $CCRNSRC;
  # Ensure this is an absolute pathname
  $CCRNSRC = abs_path( $CCRNSRC );
} else {
  warn "up2patch: CCRNSRC is not defined in this environment.\n";
}

# Determine which machine we are running on and the local patch program to use
$PATCH = "patch";
my $mach_name = "";
if ($host =~ /^lx/) {
  # Assume this is a machine in Victoria
  $mach_name = $host;
} elsif ( $host =~ /^joule/ ) {
  $mach_name = "joule";
} elsif ( $host =~ /^ib3/ ) {
  $mach_name = "pollux";
} elsif ( $host =~ /^c1/ ) {
  $mach_name = "spica";
  $PATCH = "/opt/freeware/bin/patch";
} elsif ( $host =~ /^c2/ ) {
  $mach_name = "hadar";
  $PATCH = "/opt/freeware/bin/patch";
} elsif ( $host =~ /^(xc1)/ ) {
  $mach_name = "hare";
} elsif ( $host =~ /^(xc2)/ ) {
  $mach_name = "brooks";
} elsif ( $host =~ /^(xc3)/ ) {
  $mach_name = "banting";
} elsif ( $host =~ /^(xc4)/ ) {
  $mach_name = "daley";
} else {
  die "** EE ** Unrecognized host $host\n";
}

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

# put the name of the invoking script into $Runame
chomp(my $Runame = `basename $0`);

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

# modvar is used to determine where source files are to be found
my $modver = "";

# wrkd is the name of a directory used as the cwd for this program
# This dir will be created if it does not exist
my $wrkd = "tmp_up2patch_$stamp";

# clean is a boolean flag used to determine whether or not wrkd
# is removed after the job completes
my $clean = 1;

# Boolean flag to apply the patches created below, converted from updates
my $patch_updated = 1;

# Copy patch files (containing unified diffs) to the invoking dir
# in addition to the actual patched files
my $copy_patch_files = 0;

# A list of user suppled directories in which source code to be updated
# may be found. Files in these dirs will be used before files with the same
# name that are found in the "standard" location
# At least one of $CCRNSRC and @usr_srcdir must be defined
my @usr_srcdir = ();

# A boolean flag used to determine if subdirs of any user supplied source
# directories will be read recursively by locate_source
my $recursive = 0;

# A boolean flag to determine if compile updates (%c fname) will cause the
# file to be copied into the working directory or not
# If this is false then compile updates are ignored
my $with_compile_updates = 0;

# A boolean flag to determine if embedded update directives are to be converted
# to equivalent cpp directives in source files processed below
my $with_up_to_cpp = 0;

# A boolean flag used to determine if patched files are to be compared with
# updated files
my $compare_update = 0;

# Create a file containing a list of all files created by this program
# and copied to the invoking directory. One file per line.
my $write_files_copied_list = 1;

# List all command line parameters that may be set by the user
my @cmdl_params = ( "verbose", "modver", "wrkd", "srcd", "srcd_list" );

my ( @NonOpt, @Flist );

# Define a usage function
my $Usage = sub {
  my ($msg)=@_;
  if ($msg) {print "${Runame}: $msg\n"};
  print <<EOR;
  Usage: $Runame [options|defs] modver=STRING file_containing_updates [...]
Purpose: Create a set of diffs from a set of updates read from input files.
         Patch files using these diffs and copy the modified files to the invoking directory.

The file_containing_updates may contain only updates, delimited by lines of the form
"### update model ..." or "### update sub ..." etc, or it could be an entire model job string.
If it is a model job string then only the first job in the string is relevant.
Updates are cumulative when multiple update files are present on the command line.

Options:
  --noclean     ...Do not remove the temporary working dir created by this program
                   This directory will never be removed unless it was created by this program.
  --copy_patch  ...Move patch files (containing unified diffs) to the invoking directory
                   This will be in addition to the actual files that were modified.
                   Patches will be named FILE_patch where FILE is the file created by the patch.
  --copy_cup    ...In addition to any files that are actually modifed by updates, also copy files
                   that are associated with "%c FILE" updates, back to the invoking directory.
                   Normally only the files that are actually modified are returned.
  --update      ...After patches have been applied to the relevant files, also run update and
                   compare the patched files with the updated files (for debugging only).
                   Note that update will insert seemingly random blank lines and this comparison will
                   show these differences. Fortunately, blank lines in fortran code can be ignored.
  --recursive   ...Read user supplied source dirs (specified via "srcd=DIR") recursively
  --verbose     ...Increase verbosity (multiple --verbose options are additive)
  --help        ...Show this usage info

Definitions:
  modver=STRING ...The model version (e.g. gcm16, gcm13e, ...) A value for modver is mandatory.
                   modver is used to select version specific source from the standard source tree.
  wrkd=DIR      ...The name of a temporary working directory used by this program
  srcd=DIR      ...The name of a user supplied source directory containing files to be updated
                   Mulitiple "srcd=Char" definitions are allowed.
                   Using "--recursive" will cause subdirs of srcd to be searched recursively.
  verbose=INT   ...Set verbosity to a specific level (this will override --verbose)
EOR
  die "\n";
};

# Process command line arguments
$Getopt::Long::ignorecase = 0;
$Getopt::Long::order = $PERMUTE;
&GetOptions("help"          => \&$Usage,
            "verbose"       => sub {$verbose++},
            "clean!"        => \$clean,
            "recursive!"    => \$recursive,
            "copy_patch!"   => \$copy_patch_files,
            "update!"       => \$compare_update,
            "copy_cup!"     => \$with_compile_updates,
            "cpp!"          => \$with_up_to_cpp,
             "<>"           => sub {push @NonOpt,$_[0]})
            or &$Usage;

# with_up_to_cpp implies with_compile_updates
$with_compile_updates = 1 if $with_up_to_cpp;

# compare_update implies patch_updated
$patch_updated = 1 if $compare_update;

# Process non option command line args
foreach (@NonOpt) {
  next unless $_;
  if (/=/) {
    # This is a variable assignment of the form "var=val"
    # Strip quotes, if any and assign $var and $val
    s/^\s*"(.*)"\s*$/$1/;
    s/^\s*'(.*)'\s*$/$1/;
    my ($var,$val) = /^\s*(.*?)=(.*)/;

    # Check for invalid parameter names
    my $found = 0;
    foreach my $parm (@cmdl_params) {
      if ( $parm eq $var ) {
        $found = 1;
        last;
      }
    }
    die "** EE ** Invalid command line parameter name --> $var <--\n" unless $found;

    # Strip quotes from the value, if any
    $val =~ s/^\s*"(.*)"\s*$/$1/;
    $val =~ s/^\s*'(.*)'\s*$/$1/;

    # Require a non NULL value
    die "** EE ** Missing value for command line definition $_\n" if $val =~ /^\s*$/;

    # Add all variable defs found on the command line to the usrvar hash
    # Multiple variable assignments for the same variable will be added
    # to a list of values for that variable.
    # Each individual assignment will be split on whitespace and added
    # as a separate entry in the list of values.
    $val =~ s/^\s*(.*?)\s*$/$1/;
    push @{$usrvar{$var}}, split(/\s+/,$val);
    next;
  }

  # Any remaining command line args should be file names
  push @Flist, $_;
}

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

# Set verbose from a command line definition
if ( $usrvar{verbose} ) {
  # Only the first element of this array is significant, all others are ignored
  # This will use only the first assignment found on the command line
  $verbose = @{$usrvar{verbose}}[0];
  if (scalar(@{$usrvar{verbose}})>1) {
    warn "up2patch: multiple values for verbose found on command line. --> @{$usrvar{verbose}} <--\n";
    warn "up2patch: Using verbose = $verbose\n";
  }
  die "** EE ** verbose must be a positive integer or zero.\n" unless $verbose =~/^\s*\d+\s*$/;
}

if ($verbose > 10) {
  foreach (sort keys %usrvar) {
    print "$_: @{$usrvar{$_}}\n";
  }
}

# Set modver from a command line definition
if ( $usrvar{modver} ) {
  # Only the first element of this array is significant, all others are ignored
  # This will use only the first assignment found on the command line
  $modver = @{$usrvar{modver}}[0];
  if (scalar(@{$usrvar{modver}})>1) {
    warn "up2patch: multiple values for modver found on command line. --> @{$usrvar{modver}} <--\n";
    warn "up2patch: Using modver = $modver\n";
  }
  warn "up2patch: ** WW ** modver = $modver but $CCRNSRC/source/lsmod/agcm/$modver is not a directory\n"
      unless -d "$CCRNSRC/source/lsmod/agcm/$modver";
} else {
  die "up2patch: ** EE ** modver=STRING is required on the command line.\n";
}

# Set wrkd from a command line definition
if ( $usrvar{wrkd} ) {
  # Only the first element of this array is significant, all others are ignored
  # Use only the first assignment found on the command line
  $wrkd = @{$usrvar{wrkd}}[0];
  if (scalar(@{$usrvar{wrkd}})>1) {
    warn "up2patch: multiple values for wrkd found on command line. --> @{$usrvar{wrkd}} <--\n";
    warn "up2patch: Using wrkd = $wrkd\n";
  }
}

# Set usr_srcdir from a command line definition
if ( $usrvar{srcd} ) {
  @usr_srcdir = @{$usrvar{srcd}};
}

if ( $usrvar{srcd_list} ) {
  my $srcd_list_file = @{$usrvar{srcd_list}}[0];

  # Read the list of pathnames, one per line, from the user supplied file
  my @plist;
  open(PLIST, "<$srcd_list_file") or die "${Runame}: Unable to open $srcd_list_file   $!\n";
  while (<PLIST>) {
    chomp($_);
    next if /^\s*#/;
    next if /^\s*$/;
    # Use only the first whitespace separated word found on this line
    my $dir = (split(" ",$_))[0];

    # Make sure this is an absolute pathname and strip any trailing "/"
    $dir = abs_path( $dir );

    # Ensure this dir exists
    die "${Runame}: User supplied srcd_list directory $dir is not a directory\n" unless -d $dir;

    # Append to plist
    push @plist, $dir;
  }
  close(PLIST);

  if ( scalar(@plist) ) {
    # Append plist to the list of user supplied paths 
    push @usr_srcdir, @plist;
  } else {
    warn "${Runame}: **WW** No directory paths were found in $srcd_list_file\n";
  }
}

# If neither $CCRNSRC nor @usr_srcdir are defined then
# there is no place to find source code
unless ( $CCRNSRC or scalar(@usr_srcdir) ) {
  print "One or both of the following two conditions must be satisfied in order\n";
  print "for $Runame to be able to find source code to be updated.\n";
  print "  1) CCRNSRC must be defined in your current environment and\n";
  print "     point to the root of the standard source tree.\n";
  print "  2) srcd must be defined on the command line and point to\n";
  print "     one or more dirs in which source code may be found.\n";
  die "** EE ** Neither CCRNSRC nor srcd are defined.\n";
}

if ( $verbose > 10 ) {
  print "Source to be updated will be from model version --> $modver <--\n";
  if ( scalar(@usr_srcdir) ) {
    print "and from the following user supplied directories:\n";
    print join("\n",@usr_srcdir),"\n";
  }
}

# Save the name of the current working directory for use below
my $CWD = cwd();

# Ensure all file names in Flist are absolute path names
foreach (@Flist) {
  die "** EE ** $_ is not a regular file.\n  Stopped" unless -f "$_";

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

  # Make sure this is an absolute pathname and remove any trailing "/"
  $_ = abs_path( $_ );

}

# Define the LSMOD, LSSUB, SCRIPT and USRSRC hashes containing source location information
die "** EE ** Problem in locate_source.\n" unless locate_source();

# Create and move into the temporary working directory
if (-d $wrkd) {
  # Never delete wrkd unless it has been created here
  $clean = 0;
} else {
  # Create the working dir
  mkdir $wrkd or die "** EE ** Unable to create ${wrkd}:  $!\n";
}
chdir $wrkd or die "** EE ** Unable to change to ${wrkd}:  $!\n";

# Process each file passed in on the command line in sequence
my %UPDATES;
foreach my $file (@Flist) {
  die "** EE ** $file is not a regular file.\n  Stopped" unless -f "$file";

  print "\nProcessing $file\n";

  # Read the file containing updates into memory
  my $upsrc = '';
  open (FILE, "<$file") || die "** EE ** cannot open $file for input";
    while (<FILE>) {
      # Expand tabs as each line is read
      $upsrc .= expand($_);
    }
  close FILE;

  # Extract updates from this file
  if ( $upsrc =~ m/^\s*#end_of_job\s*$/m ) {
    # When a file contains the line "#end_of_job", assume that this file is
    # a CCCma job string and process accordingly

    # 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, $upsrc, {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 > 2) {
      print_jobs(\@JOBS, {PREFIX => "--- ", LINES => 5});
    }

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

  } else {

    # If this is not a CCCma job string then assume it contains only updates
    my $subOPTS = {VERBOSE=>$verbose, PARENT=>"file::$file"};
    my @SECTION = rip_job_sections($upsrc, $subOPTS);
    if (scalar(@SECTION) > 0) {
      %UPDATES = update_defs({VERBOSE=>1}, @SECTION);
    }
    die "** EE ** Did not find any updates in $file\n" unless %UPDATES;
  }

  if ($verbose > 10) {
    foreach (sort keys %UPDATES) {
      print "$_  :: type $UPDATES{$_}{type}\n$UPDATES{$_}{text}\n";
    }
  }

  print "\nCreating patches from updates found in $file\n";

  # Convert updates to diffs
  my $diffs_href = up_to_udiff( \%UPDATES );

  # Create patch files from these diffs
  # There will be one patch file for each source file that is modified
  write_patch_files( $diffs_href, "patch" );

}

if ($patch_updated) {

  print "\n=======================\nApplying patches...\n";

  # Patch files that would be updated using the newly created diffs
  mkdir "orig" or die "** EE ** Unable to create directory orig/  $!\n";
  foreach my $patch_file ( glob("*_patch") ) {
    push @patched_files, $patch_file =~ m/^(.*)_patch$/;
    my @sh_out = syscmd( "$PATCH -u -b -B orig/ <$patch_file", $verbose );
  }

  if ( $with_up_to_cpp ) {
    # Create patch files for any source files that are modified by replacing
    # embedded update directives with equivalent cpp directives

    # If no patch file currently exists for this source file then create
    # a patch file with the suffix "patch"
    # If a patch file already exists for this source file then create a second
    # patch file with suffix "patch2"

    # This routine will also patch the source files it creates patches for
    my @fpatt = ("*.f", "*.f90", "*.dk", "*.cdk", "*.F", "*.F90");
    foreach my $source_file ( map {glob("$_")} @fpatt ) {
      write_cpp_patch_files($source_file);
    }
  }

  if ($compare_update) {
    mkdir "update" or die "** EE ** Unable to create directory update/  $!\n";
    chdir "update" or die "** EE ** Unable to change to dir update:  $!\n";

    print "\n=======================\nComparing updated vs patched files...\n";

    # Create separate files containing model, sub and script updates
    my $upref = extract_update_type( "model", \%UPDATES );
    my $model_updates = "model_updates";
    if ( $upref ) {
      open (FILE, ">>$model_updates") || die "** EE ** cannot open $model_updates for output";
      foreach my $update (sort uporder keys %{$upref}) {
        print FILE uc($update),"\n";
        print FILE $upref->{$update}{text};
      }
      close FILE;
      if ( $verbose > 1 ) {
        print "File containing model updates: ",abs_path( $model_updates ),"\n";
      }
    }

    undef $upref;
    $upref = extract_update_type( "sub", \%UPDATES );
    my $sub_updates = "sub_updates";
    if ( $upref ) {
      open (FILE, ">>$sub_updates") || die "** EE ** cannot open $sub_updates for output";
      foreach my $update (sort uporder keys %{$upref}) {
        print FILE uc($update),"\n";
        print FILE $upref->{$update}{text};
      }
      close FILE;
      if ( $verbose > 1 ) {
        print "File containing sub updates: ",abs_path( $sub_updates ),"\n";
      }
    }

    undef $upref;
    $upref = extract_update_type( "script", \%UPDATES );
    my $script_updates = "script_updates";
    if ( $upref ) {
      open (FILE, ">>$script_updates") || die "** EE ** cannot open $script_updates for output";
      foreach my $update (sort uporder keys %{$upref}) {
        print FILE uc($update),"\n";
        print FILE $upref->{$update}{text};
      }
      close FILE;
      if ( $verbose > 1 ) {
        print "File containing script updates: ",abs_path( $script_updates ),"\n";
      }
    }

    # Run update for each of these files
    my @sh_out = ();
    my @lines = ();
    $ENV{OSbin} = '';
    $ENV{CCRNSRC} = $CCRNSRC;

    # Model updates
    if ( -s $model_updates ) {
      chomp(@sh_out = `update noexpd lib=lsmod/agcm/$modver input=$model_updates output=model_code`);
      if ($?) {
        foreach (@sh_out) {
          print "$_\n";
        }
        die "** EE ** Problem executing update model   status=",$?>>8,"\n";
      }

      # Split the output file into separate files, one per deck
      my @model_files;
      @lines = `cat model_code`;
      foreach (@lines) {
        if ( /^[%*]\s*deck/i ) {
          (my $fname) = $_ =~ m/^[%*]\s*\w+\s*(\w+)/;
          # print "Model deck name = $fname\n";
          push @model_files, $fname;
          close FILE;
          open(FILE, ">>$fname") || die "** EE ** cannot open $fname for output. Stopped";
        }
        print FILE;
      }
      close FILE;

      # Compare these files with those created using patch
      foreach my $file ( @model_files ) {
        my $filep = "../\L${file}.dk";
        unless ( -s $filep ) {
          $filep = "../\L${file}.cdk";
        }
        if ( -s $filep ) {
          my $cmd = "diff -b $file $filep";
          print "  --- updated vs patched model file: $cmd\n";
          my $err = syscmd( $cmd, 1, 0 );
        }
      }
    }

    # Sub updates
    if ( -s $sub_updates ) {
      chomp(@sh_out = `gtupsub $sub_updates sub_code $modver`);
      if ($?) {
        foreach (@sh_out) {
          print "$_\n";
        }
        die "** EE ** Problem executing update sub   status=",$?>>8,"\n";
      }

      # Split the output file into separate files, one per subroutine
      my @sub_files;
      @lines = `cat sub_code`;
      my $ifile = 0;
      my $fname = "";
      my $sub_name = "";
      foreach (@lines) {
        if ( /^\s*subroutine\s+(\w+)/i ) {
          $sub_name = $1;
          if ( $sub_name ) {
            $fname = "\L${sub_name}.f";
          } else {
            $fname = sprintf("sub%3.3d",++$ifile);
          }
          push @sub_files, $fname;
          open(FILE, ">>$fname") || die "** EE ** cannot open $fname for output";
        }
        print FILE;
        if ( /^\s*end\s*$/i ) {
          $sub_name = "";
          close FILE;
          open(FILE, ">>$fname") || die "** EE ** cannot open $fname for output";
        }
      }
      close FILE;

      # Compare these files with those created using patch
      foreach my $file ( @sub_files ) {
        my $filep = "../\L$file";
        if ( -s $filep ) {
          my $cmd = "diff -b $file $filep";
          print "  --- updated vs patched sub file: $cmd\n";
          my $err = syscmd( $cmd, 1, 0 );
        }
      }
    }

    # Script updates
    if ( -s $script_updates ) {
      chomp(@sh_out = `update noexpd lib=diag4 input=$script_updates output=script_code`);
      if ($?) {
        foreach (@sh_out) {
          print "$_\n";
        }
        die "** EE ** Problem executing update script   status=",$?>>8,"\n";
      }
    }
  }
}

# Move back to the original working directory
chdir $CWD or die "** EE ** Unable to change to ${CWD}:  $!\n";

# Maintain a list of files that are copied to the invoking directory
my @files_copied = ();

if ( scalar( @patched_files ) ) {
  # There are some file created by running patch
  # Copy these new files to the invoking directory
  foreach ( @patched_files ) {
    syscmd( "mv $wrkd/$_ ." );
    push @files_copied, "$_";
  }
  print "\nCopied the following new or modified files to $CWD:\n";
  my $line = "";
  foreach ( @patched_files ) {
    my $lline = $line . "$_";
    if ( length($lline) > 100 ) {
      print "\t$line\n";
      $line = "$_";
    } else {
      $line .= $line ? " $_" : "$_";
    }
  }
  print "\t$line\n" if $line;
}

if ( $with_compile_updates ) {
  # Also copy any files associated with "%c FILE" updates that were not already copied
  # above as one of the newly created or modified files
  my @copied_c_update;
  foreach my $key ( sort keys %is_c_update ) {
    # Do not copy files that were already copied above
    next if grep /^$key$/, @patched_files;
    syscmd( "cp $wrkd/$key ." );
    push @copied_c_update, $key;
    push @files_copied, "$key";
  }
  if ( scalar(@copied_c_update) ) {
    my $msg = "unmodified files associated with \"%c FILE\" updates to $CWD:";
    print "\nCopied the following $msg\n";
    my $line = "";
    foreach ( @copied_c_update ) {
      my $lline = $line . "$_";
      if ( length($lline) > 100 ) {
        print "\t$line\n";
        $line = "$_";
      } else {
        $line .= $line ? " $_" : "$_";
      }
    }
    print "\t$line\n" if $line;
  }
}

if ( $copy_patch_files ) {
  # Also copy the patch files (containing unified diffs) to the invoking directory
  my @patch_files = map {m@^$wrkd/(.*)$@} map {glob($_)} "$wrkd/*_patch", "$wrkd/*_patch2";
  if ( scalar(@patch_files) ) {
    foreach ( @patch_files ) {
      syscmd( "mv $wrkd/$_ ." );
      push @files_copied, "$_";
    }
    print "\nCopied the following patch files to $CWD:\n";
    my $line = "";
    foreach ( @patch_files ) {
      my $lline = $line . "$_";
      if ( length($lline) > 100 ) {
        print "\t$line\n";
        $line = "$_";
      } else {
        $line .= $line ? " $_" : "$_";
      }
    }
    print "\t$line\n" if $line;
  }
}

if ( scalar(@files_copied) and $write_files_copied_list ) {
  my $file_list = "files_created_by_up2patch";
  open(FILE, ">$file_list") || die "** EE ** Cannot open $file_list for output.  $!";
  foreach ( @files_copied ) {
    print FILE "$_\n";
  }
  close(FILE);
  print "\nThe complete list of files copied is in $file_list\n";
  print "Note: You can delete all these files by typing\n";
  print "          xargs rm <$file_list\n";
  if ( $copy_patch_files ) {
    print "      You can print all patch files by typing\n";
    print "          grep '_patch\$' $file_list | xargs cat\n";
  }
}

# Clean up
if ( $clean ) {
  syscmd( "rm -fr $wrkd" );
} else {
  print "\nFiles remain in $wrkd";
}
print "\n";

########################################################
##################### End of main ######################
########################################################

sub syscmd {
  use strict;
  my $cmd = shift;
  my $show_stdout = shift;
  my $stop_on_error = shift;

  die "** EE ** Missing system command string\n" unless $cmd;

  $stop_on_error = 1 unless defined $stop_on_error;

  if ( $verbose > 1 ) {
    print "syscmd: $cmd\n";
  }

  chomp(my @sh_out = `$cmd 2>&1`);
  my $sh_err = $?;
  if ( $show_stdout or $sh_err ) {
    foreach (@sh_out) {print "$_\n"}
  }
  if ( $stop_on_error and $sh_err ) {
    die "** EE **  Problem executing\n   $cmd\n";
  }

  # Return command stdout in array context, otherwise return command status
  return wantarray ? @sh_out : $sh_err;

}

sub write_cpp_patch_files {
  use strict;
  use File::Basename;
  # The name of a file containing source code to be processed
  my $fsrc = shift;

  die "** EE ** write_cpp_patch_files: No file name provided.\n" unless $fsrc;
  die "** EE ** write_cpp_patch_files: $fsrc is missing or empty.\n" unless -s $fsrc;

  my $orig_name = basename($fsrc);

  # Read the input source file into memory for use in up_to_cpp
  my @OLD_SOURCE = `cat $fsrc 2>&1`;
  if ($?) {
    foreach (@OLD_SOURCE) {print "$_\n"}
    die "** EE ** Problem executing --> cat $fsrc <-- status=",$?>>8,"\n";
  }

  # Replace embedded update directives with equivalent cpp directives
  my @NEW_SOURCE = up_to_cpp( \@OLD_SOURCE, $orig_name );

  # If there were no changes to this source file then do nothing more
  return 1 unless scalar(@NEW_SOURCE);

  my $fnew = "${orig_name}_new";
  open( FNEW, ">$fnew" ) || die "** EE ** Unable to open file $fnew for writing.";
  foreach (@NEW_SOURCE) {
    print FNEW;
  }
  close FNEW;

  # Get a unified format diff into cppdiff
  my @cppdiff = `diff -u $fsrc $fnew`;
  # Note, the cppdiff array will contain newlines at the end of each element
  # Note: diff returns 0 if the files are the same
  #                    1 if files differ
  #                    2 on error
  if ($?==2) {
    foreach (@cppdiff) {print "$_"}
    die "** EE ** Problem executing --> diff -u $fsrc $fnew <-- status=",$?>>8,"\n";
  }

  # Remove the temporary fnew file from disk and from memory
  unlink $fnew or die "** EE ** Unable to remove $fnew\n";
  undef @NEW_SOURCE;

  if ( $verbose > 10 ) {
    print "\n$orig_name \tscalar(cppdiff) = ",scalar(@cppdiff),"\n";
    foreach (@cppdiff) {
      print "$_\n";
    }
  }

  # If @cppdiff is not empty then there were modifications done to
  # the source file by up_to_cpp and we must create a patch file
  if ( scalar(@cppdiff) > 2 ) {
    # Each chunk begins with a 2 line header that supplies file information
    # including the path name and a time stamp for both files
    # Define the header lines for this file
    my $time_stamp_orig = set_patch_time_stamp( $orig_name );
    # chomp(my $time_stamp_orig = `date --reference=$orig_name '+%Y-%m-%d %T.%N %z'`);
    my $time_stamp_new = "1970-01-01 00:00:00.000000000 +0000";
    my $head1 = "--- $orig_name\t$time_stamp_orig\n";
    my $head2 = "+++ /dev/null\t$time_stamp_new\n";

    # Remove the first 2 elements of cppdiff which will contain the 2 line header
    # from the diff done above and replace them with the new header lines
    splice(@cppdiff,0,2);
    unshift(@cppdiff,$head1,$head2);

    # Create the new patch file
    # The patch file will be named for the source file with "_patch" appended
    # unless a file by that name exists and is not empty. In this case the
    # patch file suffix will be "_patch2"
    my $patch_file = "${orig_name}_patch";
    my $patch_exists = 0;
    $patch_exists = 1 if -s $patch_file;
    $patch_file = "${orig_name}_patch2" if $patch_exists;
    open(FILE, ">$patch_file") || die "** EE ** cannot open $patch_file for output";
    foreach ( @cppdiff ) {
      print FILE;
    }
    close FILE;

    # Now patch the file with the patch just created
    # Set patch command line options to back up the original source file in the dir orig/
    # unless a previous patch already put a copy of the original in orig/
    my $backup = "-b -B orig/";
    $backup = " " if $patch_exists;
    my @sh_out = syscmd( "$PATCH -u $backup <$patch_file", 1 );
    # my @sh_out = `patch $backup <$patch_file 2>&1`;
    # my $cmd_err = $?;
    # if ( $verbose > 1 ) {
    #   foreach (@sh_out) {print "$_"}
    # }
    # if ( $cmd_err ) {
    #   foreach (@sh_out) {print "$_"}
    #   die "** EE ** Problem executing --> patch $backup <$patch_file <-- status=",$cmd_err>>8,"\n";
    # }

    if ( $patch_exists ) {
      # This file was modified prior to applying the current patch
      # Generate the diffs between this latest file and the original file
      # in order to get a combined patch for all modifications
      my $forg = "orig/$fsrc";
      die "** EE ** Original file is missing --> $forg <--\n" unless -f $forg;
      my @alldiff = `diff -u $forg $fsrc`;
      # Note, the cppdiff array will contain newlines at the end of each element
      # Note: diff returns 0 if the files are the same
      #                    1 if files differ
      #                    2 on error
      if ($?==2) {
        foreach (@cppdiff) {print "$_"}
        die "** EE ** Problem executing --> diff -u $fsrc $fnew <-- status=",$?>>8,"\n";
      }

      # Remove the first 2 elements of alldiff which will contain the 2 line header
      # from the diff done above and replace them with the new header lines
      splice(@alldiff,0,2);
      if ( -s $forg ) {
        # If the original file has a non zero size then
        # assume it is not associated with a deck update
        unshift(@alldiff,$head1,$head2);
      } else {
        # If the original file has zero size then assume it is associated
        # with a deck update and reverse the order of the header lines
        unshift(@alldiff,$head2,$head1);
      }

      # Create the new patch file
      # The patch file will be named for the source file with "_patch" appended
      # overwriting any existing patch file
      my $patch_file = "${orig_name}_patch";
      open(FILE, ">$patch_file") || die "** EE ** cannot open $patch_file for output";
      foreach ( @alldiff ) {
        print FILE;
      }
      close FILE;

     # Remove the "patch2" file created above
     unlink "${orig_name}_patch2";
    }
  }

}

sub write_patch_files {
  # Create patch files from a set of diffs
  use strict;
  # A reference to a hash containing info about the diffs
  my $diffs_href = shift;
  # Patch file created here will be named as the file name with $sfx appended
  my $sfx = shift;

  # There will be one patch file for each source file that is modified
  foreach my $update (sort uporder keys %{$diffs_href}) {
    if ($verbose > 5) {
      print "$update\n";
      print "file_orig: $diffs_href->{$update}{file_orig}\n";
      print "file_new : $diffs_href->{$update}{file_new}\n";
      if ($verbose > 6) {
        print @{$diffs_href->{$update}{chunk}},"\n";
      }
    }

    # Determine the name of this patch file
    my $fname = "";
    if ( $diffs_href->{$update}{file_orig} ) {
      # Use the original file name unless it is /dev/null
      unless ( $diffs_href->{$update}{file_orig} eq "/dev/null" ) {
        $fname = basename($diffs_href->{$update}{file_orig});
      }
    }
    unless ( $fname ) {
      # Use the new file name unless it is /dev/null
      # This will happen with a "deck" update
      if ( $diffs_href->{$update}{file_new} ) {
        unless ( $diffs_href->{$update}{file_new} eq "/dev/null" ) {
          $fname = basename($diffs_href->{$update}{file_new});
        }
      }
    }
    unless ( $fname ) {
      (my $upname) = $update =~ /^[%*]\s*\w+\s+(\w+)/;
      $fname = "$upname";
    }

    # Add this file name to a global hash
    $NEW_FILES{$fname} = 1;

    # The name of the patch file will be the name of the
    # source file with a user supplied suffix added
    $fname .= "_$sfx";
    # Add the patch file name to a global hash
    $PATCH_FILES{$fname} = 1;

    my $file_exists = 1;
    $file_exists = 0 unless -f "$fname";
    open (FILE, ">>$fname") || die "** EE ** cannot open $fname for output";
    foreach ( @{$diffs_href->{$update}{chunk}} ) {
      if ($file_exists) {
        # If the file exists then assume that the 2 line file info header
        # was written to the file when it was created and strip these
        # header lines from the patch file
        next if /^---\s+/;
        next if /^\+\+\+\s+/;
      }
      print FILE;
    }
    close FILE;
  }
  return 1;
}

sub uporder {
  # Sort updates (e.g. strings of the form "%i unpack8.301") on the
  # deck name and the first line number combined.
  # Only %c, %i, %d and %deck updates are sorted this way
  # all others simply return 0
  return 0 if $a =~ m/^[%*]\s*(id|df|call|if|endif)\s+/i
            or $b =~ m/^[%*]\s*(id|df|call|if|endif)\s+/i;
  my ($Na,$La) = $a =~ m/^[%*]\s*\w+\s*(\w+)(?:\.(\d+))?/;
  my ($Nb,$Lb) = $b =~ m/^[%*]\s*\w+\s*(\w+)(?:\.(\d+))?/;
  die "** EE ** uporder: Invalid input $a ... $b\n" unless($Na and $Nb);
  $La = 0 unless $La;
  $Lb = 0 unless $Lb;
  my $aa = sprintf("%s-%8.8d",$Na,$La);
  my $bb = sprintf("%s-%8.8d",$Nb,$Lb);
  lc($aa) cmp lc($bb);
}

sub check_updates {
  # Ensure that there are no line number conflicts in the input set of updates
  use strict;
  # A reference to a hash containing info about updates
  my $upref = shift;

  my %UPLINES;
  foreach my $update (sort uporder keys %{$upref}) {
    # Extract the update directive keyword (e.g. "i", "d", "deck", ...)
    (my $upkey) = $update =~ m/^[%*]\s*(\w+)/;

    # Ignore all update directives except "i" and "d"
    next if $upkey =~ /^id$/i;
    next if $upkey =~ /^df$/i;
    next if $upkey =~ /^c$/i;
    next if $upkey =~ /^call$/i;
    next if $upkey =~ /^if$/i;
    next if $upkey =~ /^endif$/i;
    next if $upkey =~ /^(com)?deck$/i;

    # Determine the update file name (without suffix) to use as a hash key
    (my $fname) = $update =~ m/^[%*]\s*\w+\s*(\w+)/;

    # Build a list of update strings for each file to be updated
    push @{$UPLINES{$fname}{range}}, $update;
  }

  foreach my $fname ( keys %UPLINES ) {
    # Scan the list of updates associated with each file to be updated to ensure
    # that there are no overlapping line numbers for updates to this file
    my $N = scalar(@{$UPLINES{$fname}{range}});
    my ($i, $j, $line1, $line2, $line3, $line4, $update1, $update2);
    for ($i=0; $i<$N-1; $i++) {
      $update1 = @{$UPLINES{$fname}{range}}[$i];
      ($line1,$line2) = $update1 =~ m/\.(\d+)(?:\s*,\s*(\d+))?\s*$/;
      $line2 = $line1 unless $line2;
      # Set line2 = 0 for an "insert" update which contains only 1 line number
      $line2 = 0 if $update1 =~ m/^[%*]\s*i\s+$/i;
      for ($j=$i+1; $j<$N; $j++) {
        $update2 = @{$UPLINES{$fname}{range}}[$j];
        ($line3,$line4) = $update2 =~ m/\.(\d+)(?:\s*,\s*(\d+))?\s*$/;
        $line4 = $line3 unless $line4;
        # Set line4 = 0 for an "insert" update which contains only 1 line number
        $line4 = 0 if $update2 =~ m/^[%*]\s*i\s+$/i;
        my $status = 1;
        if ($line2 and $line4) {
          # Both ranges correspond with delete updates
          $status = 0 if ($line1>=$line3 and $line1<=$line4);
          $status = 0 if ($line2>=$line3 and $line2<=$line4);
          $status = 0 if ($line3>=$line1 and $line3<=$line2);
          $status = 0 if ($line4>=$line1 and $line4<=$line2);
        } elsif ($line2) {
          # The first range corresponds with delete updates
          # The second range corresponds with insert updates
          $status = 0 if ($line3>=$line1 and $line3<=$line2);
        } elsif ($line4) {
          # The first range corresponds with insert updates
          # The second range corresponds with delete updates
          $status = 0 if ($line1>=$line3 and $line1<=$line4);
        } else {
          # Both ranges correspond with insert updates
          $status = 0 if ($line1 == $line3);
        }
        if ($status == 0) {
          print "check_updates: Update line conflict found for $fname\n";
          print "Overlapping line ranges for updates:\n";
          print "    $update1\n";
          print "    $update2\n";
          return 0;
        }
      }
    }
  }
  return 1;
}

sub extract_update_type {
  # Extract a set of updates for a specific type, either "model", "sub" or "script"
  use strict;
  # A string containing the update type. One of "model", "sub" or "script"
  my $uptype = shift;
  # A reference to a hash containing info about updates
  my $upref = shift;

  my %type_updates;

  # Process each update in the order determined by the uporder function
  foreach my $update (sort uporder keys %{$upref}) {
    # update is a string containing the update directive (e.g. "%i unpack8.301")

    # Extract the update directive keyword (e.g. "i", "d", "deck", ...)
    (my $upkey) = $update =~ m/^[%*]\s*(\w+)/;

    # Ignore all update directives except "i", "d", "deck", "comdeck"
    next if $upkey =~ /^id$/i;
    next if $upkey =~ /^df$/i;
    next if $upkey =~ /^c$/i;
    next if $upkey =~ /^call$/i;
    next if $upkey =~ /^if$/i;
    next if $upkey =~ /^endif$/i;

    if ( $upref->{$update}{type} =~ m/^$uptype$/i ) {
      $type_updates{$update} = $upref->{$update};
    }
  }
  return \%type_updates;
}

sub get_update_defs {
  # Determine all tokens defined via "%df" in a set of updates
  use strict;
  # A reference to a hash containing info about updates
  my $upref = shift;

  # Loop over all updates looking for "%df token"
  foreach my $update (keys %{$upref}) {
    # update is a string containing the update directive (e.g. "%i unpack8.301")

    # Extract the token defined by the update keywork "df"
    (my $token) = $update =~ m/^[%*]\s*df\s(\w+)/;

    if ( $token ) {
      # This is a define "%df" update that defines $token
      # Add this to the global updefs hash
      $updefs{$token} = 1;
    }
  }
  return 1;
}

sub up_to_udiff {
  use strict;
  use File::Basename;
  use Text::Tabs;
  # A reference to a hash containing info about updates
  my $upref = shift;

  # Verify that there are no line number conflicts in this set of updates
  check_updates($upref) or die "** EE ** Invalid updates\n";

  # Extract all defined tokens from these updates and store them in %updefs
  get_update_defs($upref);

  my $status = 1;

  # The resulting unified diffs will be returned in %DIFFS
  my %DIFFS;

  # This is the number of context lines that will be retained
  # around each change hunk
  my $context = 3;

  # Process each update in the order determined by the uporder function
  foreach my $update (sort uporder keys %{$upref}) {
    # update is a string containing the update directive (e.g. "%i unpack8.301")

    # Extract the update directive keyword (e.g. "i", "d", "deck", ...)
    (my $upkey) = $update =~ m/^[%*]\s*(\w+)/;

    # Ignore all update directives except "i", "d", "deck", "comdeck" and possibly "c"
    next if $upkey =~ /^id$/i;
    next if $upkey =~ /^df$/i;
    next if $upkey =~ /^call$/i;
    next if $upkey =~ /^if$/i;
    next if $upkey =~ /^endif$/i;

    unless ( $with_compile_updates ) {
      # Ignore compile updates unless the user has requested otherwise
      # When compile updates are not ignored the file in question will
      # simply be copied into the current directory
      next if $upkey =~ /^c$/i;
    }

    # Put the text lines found in this update into an array for use below
    # This array will contain 1 line of text per array element but the
    # trailing newline will be removed from each line
    my @uplist = split("\n",$upref->{$update}{text});

    # Determine the source location associated with this update
    (my $fname) = $update =~ m/^[%*]\s*\w+\s*(\w+)/;
    my $fpatt = "$fname\.(f|f90|f95|F|F90|F95|dk|cdk)";
    # srcref will point to a hash, one of USRSRC, LSMOD, LSSUB or SCRIPT
    my $srcref = undef;
    my @hits = ();
    if ( %USRSRC ) {
      # First look in any user suppled source for file names that match this update
      @hits = grep /^$fpatt$/, keys %USRSRC;
      if ( scalar(@hits) ) {
        $srcref = \%USRSRC;
      }
    }
    unless ( scalar(@hits) ) {
      # If the update matched a user supplied source file or the user did not supply
      # any source files then look in the standard source tree for a match
      if ( $upref->{$update}{type} =~ m/^model$/i ) {
        # This update refers to an lsmod routine
        @hits = grep /^$fpatt$/, keys %LSMOD;
        $srcref = \%LSMOD;
      } elsif ( $upref->{$update}{type} =~ m/^sub$/i ) {
        # This update refers to an lssub routine
        @hits = grep /^$fpatt$/, keys %LSSUB;
        $srcref = \%LSSUB;
      } elsif ( $upref->{$update}{type} =~ m/^script$/i ) {
        # This update refers to a script
        @hits = grep /^$fpatt$/, keys %SCRIPT;
        $srcref = \%SCRIPT;
      } else {
        die "** EE ** up_to_udiff: Invalid update type encountered --> $upref->{$update}{type} <--\n";
      }
    }

    # new_deck is used in the case of a "deck" update to identify whether or not the
    # deck in question is replacing an existing file or is introducing a new one
    my $new_deck = 0;

    # is_deck is set true when this is a "deck" or "comdeck" update
    my $is_deck = $upkey =~ /^(com)?deck$/i;

    my $match = "";
    if ( scalar(@hits) ) {
      if ( scalar(@hits) > 1 ) {
        die "** EE ** up_to_udiff: Found multiple matches for ${fpatt}: ",join(' ',@hits),"\n";
      } else {
        $match = $hits[0];
      }
    } else {
      if ( $is_deck ) {
        # This update replaces an entire deck which does not exist
        # If we get to this point then this is a new deck (no existing source)
        $new_deck = 1;
      } else {
        die "** EE ** up_to_udiff: No file names match --> ${fpatt} <---\n";
      }
    }
    unless ( $new_deck ) {
      die "** EE ** Problem finding source for update \"$update\"\n" unless $srcref->{$match};
    }

    # Determine the name of the original source file, if possible
    # If there is no original source file (e.g. this is a "deck" update that
    # introduces a previously non-existant file) then set this to the name
    # found in the update itself, with an appropriate suffix
    my $orig_name = $srcref->{$match};
    unless ( $orig_name ) {
      if ( $is_deck ) {
        # This will be a "deck" or "comdeck" update
        # Use the filename part of the update with an appropriate suffix as the file name
        if ( $upref->{$update}{type} =~ m/^sub$/i ) {
          $orig_name = "${fname}.f";
        } else {
          # This will be a model or script update and the suffix will be "dk" or "cdk"
          if ( $upkey =~ /^comdeck$/i ) {
            $orig_name = "${fname}.cdk";
          } else {
            $orig_name = "${fname}.dk";
          }
        }
      } else {
        # This will be an insert, delete or compile update and a path name is expected
        die "** EE ** Unable to determine path name for $match whe update is not a (com)deck.\n";
      }
    }
    die "** EE ** Unable to determine path name for $match\n" unless $orig_name;
    if ($verbose > 5) {
      print "\n$update :: $upref->{$update}{type} :: $orig_name\n";
    }

    $orig_name = basename($orig_name);
    if ( $DUPLICATE{$orig_name} ) {
      print "\nAttempting to update a file that appears in more than one location.\n";
      die "** EE ** Unsafe to update file --> $orig_name <--\n   Stopped";
    }

    unless ( exists $SOURCE{$match} or $is_deck ) {
      # Copy the source for this file into memory
      open( SRC, "<$srcref->{$match}" ) || die "** EE ** Unable to open file $srcref->{$match}";
      # expand tabs as each line is read
      while (<SRC>) {
        push @{$SOURCE{$match}}, expand($_);
      }
      close(SRC);

      # Put a copy of this file in the current working dir
      open( SRC, ">$orig_name" ) || die "** EE ** Unable to open file $orig_name for writing.";
      foreach ( @{$SOURCE{$match}} ) {
        print SRC;
      }
      close(SRC);
    }

    # Identify this file as one associated with a "%c FILE" update
    $is_c_update{$match} = 1 if $upkey =~ /^c$/i;

    # Define the change hunk (chunk) corresponding to the current update
    my @chunk = ();
    my $L_orig = 0;
    my $S_orig = 0;
    my $L_new = 0;
    my $S_new = 0;

    # Each chunk begins with a 2 line header that supplies file information
    # including the full path name and a time stamp for both files
    my $file_path_orig = $srcref->{$match};
    $file_path_orig = basename($file_path_orig) if $file_path_orig;
    $file_path_orig = "/dev/null" unless $file_path_orig;
    my $time_stamp_orig = '';
    if ( -s "$orig_name" ) {
      $time_stamp_orig = set_patch_time_stamp( $orig_name );
    } else {
      # When the file date info is not available set the date to the epoch
      $time_stamp_orig = "1970-01-01 00:00:00.000000000 +0000";
    }

    my $file_path_new = '';
    my $time_stamp_new = '';
    if ( $is_deck ) {
      # This is a "deck" or "comdeck" update and so a new file is created
      # which should have the name of the original file (or a derived name
      # if there was no original file)
      $file_path_new = $orig_name;
      # Use the current time to define time_stamp_new
      $time_stamp_new = set_patch_time_stamp();
    } else {
      $file_path_new = "/dev/null";
      # When the file date info is not available set the date to the epoch
      $time_stamp_new = "1970-01-01 00:00:00.000000000 +0000";
    }
    push @chunk, "--- $file_path_orig\t$time_stamp_orig\n";
    push @chunk, "+++ $file_path_new\t$time_stamp_new\n";

    if ( $upkey =~ /^c$/i ) {
      #------------------------------
      # This is a compile (%c) update
      #------------------------------
      # For a "compile" update there is no change to the file due to
      # insert or delete updates so skip to the next loop iteration
      next;

    } elsif ( $upkey =~ m/^i$/i ) {
      #--------------------------------
      # This is an insert (%i) directive
      #--------------------------------
      (my $line) = $update =~ m/\.(\d+)\s*$/;
      die "** EE ** Invalid line number found in update --> $update <--\n"
        unless $line =~ /^[0-9]+$/;
      if ( $upref->{$update}{type} =~ m/^sub$/i ) {
        # For sub updates the line number needs to be decremented by 1
        # to accomodate the "missing" %COMDECK line at the top
        $line--;
      }
      if ($verbose > 1) {
        print "insert at line $line\n";
        print "@{$SOURCE{$match}}[$line-1]\n";
        print "Update:\n$upref->{$update}{text}\n";
      }

      # Add range information. This is a line of the form
      # @@ -L,S +L,S @@
      # L represents the starting line number
      # S represents the number of lines in the hunk
      # The L,S range preceeded by the minus sign corresponds to the original file
      # The L,S range preceeded by the  plus sign corresponds to the new file
      my $context_pre  = $context;
      my $context_post = $context;
      $L_orig = $line - $context + 1;
      # Include delta lines in the line number associated with the orig file
      if ( $L_orig < 1 ) {
        # Some or all context lines prior to the insertion point will not appear
        $context_pre = $context_pre - (1-$L_orig);
        $L_orig = 1;
      }
      if ( ($line + $context) > $#{$SOURCE{$match}} ) {
        # Some or all context lines after the insertion point will not appear
        $context_post = $context_post - (($line + $context) - $#{$SOURCE{$match}} - 1);
      }
      $S_orig = $context_pre + $context_post;
      $L_new = $L_orig;
      $S_new = $context_pre + $context_post + scalar(@uplist);
      push @chunk, "@@ -$L_orig,$S_orig +$L_new,$S_new @@\n";

      # For an insert, the number of lines added are
      # the number of lines in the update

      # Add context lines prior to the insertion point
      my $L1 = $line - $context + 1;
      $L1 = 1 if $L1 < 1;
      my $L2 = $line;
      foreach my $L ( $L1 .. $L2 ) {
        # Context lines are prefixed with a space character
        push @chunk, " @{$SOURCE{$match}}[$L-1]";
      }
      # Add the update lines to be inserted
      $L1 = 1;
      while ( $L1 <= scalar(@uplist) ) {
        # Added lines are prefixed with a plus sign
        push @chunk, "+$uplist[$L1-1]\n";
        $L1++;
      }
      # Add context lines after the insertion point
      $L1 = $line + 1;
      $L2 = $line + $context;
      $L2 = $#{$SOURCE{$match}} if $L2 > $#{$SOURCE{$match}};
      foreach my $L ( $L1 .. $L2 ) {
        # Context lines are prefixed with a space character
        push @chunk, " @{$SOURCE{$match}}[$L-1]";
      }

    } elsif ( $upkey =~ m/^d$/i ) {
      #--------------------------------
      # This is a delete (%d) directive
      #--------------------------------
      my ($line1, $line2) = $update =~ m/\.(\d+)(?:\s*,\s*(\d+))?\s*$/;
      $line2 = $line1 unless $line2;
      die "** EE ** Invalid line number found in update --> $update <--\n"
        unless ($line1 =~ /^[0-9]+$/ and $line2 =~ /^[0-9]+$/);
      if ( $upref->{$update}{type} =~ m/^sub$/i ) {
        # For sub updates the line numbers need to be decremented by 1
        # to accomodate the "missing" %COMDECK line at the top
        $line1--;
        $line2--;
      }
      if ($verbose > 1) {
        print "delete lines $line1 - $line2\n";
      }

      # Add range information. This is a line of the form
      # @@ -L,S +L,S @@
      # L represents the starting line number
      # S represents the number of lines in the hunk
      # The L,S range preceeded by the minus sign corresponds to the original file
      # The L,S range preceeded by the  plus sign corresponds to the new file
      my $context_pre  = $context;
      my $context_post = $context;
      $L_orig = $line1 - $context;
      # Include delta lines in the line number associated with the orig file
      if ($L_orig < 1) {
        # Some or all context lines prior to the insertion point will not appear
        $context_pre = $context_pre - (1-$L_orig);
        $L_orig = 1;
      }
      if ( ($line2 + $context) > $#{$SOURCE{$match}} ) {
        # Some or all context lines after the insertion point will not appear
        $context_post = $context_post - (($line2 + $context) - $#{$SOURCE{$match}} - 1);
      }
      $S_orig = $context_pre + $context_post + $line2 - $line1 + 1;
      $L_new = $L_orig;
      $S_new = $context_pre + $context_post + scalar(@uplist);
      push @chunk, "@@ -$L_orig,$S_orig +$L_new,$S_new @@\n";

      # For a delete, the number of lines added or removed is the difference
      # between the number of lines in the update and the number of lines deleted

      # Add context lines prior to the first line deleted
      my $L1 = $line1 - $context;
      $L1 = 1 if $L1 < 1;
      my $L2 = $line1 - 1;
      foreach my $L ( $L1 .. $L2 ) {
        # Context lines are prefixed with a space character
        push @chunk, " @{$SOURCE{$match}}[$L-1]";
      }
      # Add the lines to be deleted
      foreach my $L ( $line1 .. $line2 ) {
        # Deleted lines are prefixed with a minus sign
        push @chunk, "-@{$SOURCE{$match}}[$L-1]";
      }
      # Add any update lines to be inserted
      $L1 = 1;
      while ( $L1 <= scalar(@uplist) ) {
        # Added lines are prefixed with a plus sign
        push @chunk, "+$uplist[$L1-1]\n";
        $L1++;
      }
      # Add context lines after the last line deleted
      $L1 = $line2 + 1;
      $L2 = $line2 + $context;
      $L2 = $#{$SOURCE{$match}} if $L2 > $#{$SOURCE{$match}};
      foreach my $L ( $L1 .. $L2 ) {
        # Context lines are prefixed with a space character
        push @chunk, " @{$SOURCE{$match}}[$L-1]";
      }

    } elsif ( $upkey =~ m/^(com)?deck$/i ) {
      #---------------------------------------------
      # This is a deck (%deck or %comdeck) directive
      #---------------------------------------------

      # Add range information. This is a line of the form
      # @@ -L,S +L,S @@
      # L represents the starting line number
      # S represents the number of lines in the hunk
      # The L,S range preceeded by the minus sign corresponds to the original file
      # The L,S range preceeded by the  plus sign corresponds to the new file
      # When a file is created the original file range will be -0,0
      # When a file is deleted the new file range will be +0,0
      $L_orig = 0;
      $S_orig = 0;
      $L_new = 1;
      $S_new = scalar(@uplist);
      push @chunk, "@@ -$L_orig,$S_orig +$L_new,$S_new @@\n";

      # Simply add all update lines as new
      foreach ( @uplist ) {
        # Added lines are prefixed with a plus sign
        push @chunk, "+$_\n";
      }

      # For a delete, the number of lines added is
      # the number of lines in the update

    } else {
      die "** EE ** Invalid update --> $update <-- must be one of %c, %d, %i or %deck\n";
    }

    # Assign the current diff to the output hash
    push @{$DIFFS{$update}{chunk}}, @chunk;
    $DIFFS{$update}{file_orig} = $file_path_orig;
    $DIFFS{$update}{file_new}  = $file_path_new;

    if ($verbose > 5) {
      if (scalar(@chunk)) {
        foreach (@chunk) {
          printf "%s",$_;
        }
      }
    }
  }

  return \%DIFFS;
}

sub set_patch_time_stamp {
  use strict;
  # stat with the access/modify/change file timestamps in subsecond resolution
  use Time::HiRes qw(stat gettimeofday);
  # Inverse of built in localtime function
  use Time::Local qw(timelocal);

  my $fname = shift;

  my $mtime_hr;
  my $subsec;

  if ( $fname ) {
    # Use the modification time for the file $fname to determine the time stamp
    # Get subsecond resolution modification time using HiRes stat
    $mtime_hr = (stat $fname)[9];

    # Fractional seconds to 9 decimal places
    $subsec = int( 1000000000*($mtime_hr - int $mtime_hr) );
  } else {
    # Use the current time to determine the time stamp
    ($mtime_hr, $subsec) = gettimeofday;
  }

  die "** EE ** set_patch_time_stamp: Fractional seconds is negative.\n" if $subsec < 0;

  # Ensure subsec is a 9 digit string by adding zeros to the right
  # in shorter strings or truncating longer strings
  my $lsubsec = length $subsec;
  if ( $lsubsec < 9 ) {
    $subsec = $subsec . '0' x (9 - $lsubsec);
  } elsif ( $lsubsec > 9 ) {
    $subsec = sprintf( "%9.9s", $subsec );
  }

  # Get YMD HMS values for this modification time
  my ($sec,$min,$hour,$day,$mon,$year) = localtime($mtime_hr);
  $sec  = sprintf("%2.2d",$sec);
  $min  = sprintf("%2.2d",$min);
  $hour = sprintf("%2.2d",$hour);
  $day  = sprintf("%2.2d",$day);
  $mon  = sprintf("%2.2d",$mon+1);
  $year = sprintf("%4.4d",$year+1900);

  # Determine numeric time zone
  my $now = time;
  my $ltz = timelocal( localtime($now) );
  my $gtz = timelocal( gmtime($now) );
  # Number of hours between here and Greenwich
  my $tz = 100*(($ltz - $gtz)/3600);
  $tz = sprintf("%4.4d",$tz);

  # Finally format the string as required for unified diffs
  my $time_stamp = "${year}-${mon}-${day} ${hour}:${min}:${sec}.$subsec $tz";

  return $time_stamp;

}

sub up_to_cpp {
  ########################################################################
  # Replace update directives with cpp directives
  # The only update directives that are affected are:
  #    COMDECK  DECK  CALL  IF  ENDIF
  # These will be replaced as follows
  # %COMDECK and %DECK replaced by a comment line or removed
  # %CALL              replaced by #include
  # %IF                replaced by one of #ifdef, #ifndef or #if
  # %ENDIF             replaced by #endif
  ########################################################################
  use strict;
  # The contents of a source file to be modified in situ
  my $aref = shift;
  # The name of the file containing fsrc
  my $fname = shift;

  my @RET = ();
  my %defs;

  # A boolean flag to indicate whether or not the file is modified here
  my $changed = 0;

  # This function will return the replacement
  # for %IF update directive lines
  my $ifcond = sub {
    my $up_cond = shift;
    my @clist = split /\s*,\s*/,$up_cond;
    my $ret;
    if (scalar(@clist) == 2) {
      # there is only 1 condition ...use #ifdef or #indef

      # Prepend "_with_" to these token names
      # This will mitigate clashes with existing variables or keywords
      # found in the fortran program (e.g. MPI becomes _with_MPI to avoid replacing
      # the line "use MPI" with the line "use" after preprocessing removes the MPI
      # from that line because there was a #define MPI directive)
      my $token = "_with_$clist[1]";
      $defs{$token} = 0;
      if    ($clist[0] =~ /^\s*DEF/i) {$ret = "#ifdef $token"}
      elsif ($clist[0] =~ /^\s*-DEF/i) {$ret = "#ifndef $token"}
      else {
        die "** EE ** ${Runame}: Illegal update directive: %IF $up_cond found in file $fname\n";
      }
    } else {
      my $cond = '';
      foreach (@clist) {
        SWITCH: {
          /^\s*DEF/i  && do {$cond .= 'defined '; last SWITCH};
          /^\s*-DEF/i && do {$cond .= '!defined '; last SWITCH};
          /^\s*AND/i  && do {$cond .= ' && '; last SWITCH};
          /^\s*OR/i   && do {$cond .= ' || '; last SWITCH};
          # Prepend "_with_" to these token names
          my $token = "_with_${_}";
          $cond .= $token;
          $defs{$token} = 0;
	}
      }
      $ret = "#if $cond";
    }
    return "$ret";
  };

  foreach ( @{$aref} ) {
    my $line = $_;
    if ( $line =~ /^[%*]DECK\s([^\s]*)\s*$/si or
         $line =~ /^[%*]COMDECK\s([^\s]*)\s*$/si ) {
      # Remove %DECK and %COMDECK directive lines
      $changed = 1;
      next;
    }

    # replace update %CALL directives with cpp #include directives
    if ( $line =~ /^[%*]CALL\s+/si ) {
      # This is an update "CALL" directive
      (my $name) = $line =~ /^[%*]CALL\s+([^\s]*)/si;
      # Determine a proper file name from the partial name found on the input line
      my @hits = fname_from_partial( lc($name) );
      if ( scalar(@hits) > 1 ) {
        die "** EE ** up_to_cpp: Found multiple matches for $name: ",join(' ',@hits),"\n";
      } else {
        $name = $hits[0];
      }
      $line = "#include \"$name\"\n";
    }

    # replace %IF and %ENDIF update directives
    $line =~ s/^[%*]IF\s*([^\s]*)\s*$/&$ifcond($1)/seig;
    $line =~ s/^[%*]ENDIF.*$/#endif/sig;

    $line .= "\n" unless $line =~ /\n$/;

    $changed = 1 unless $line eq $_;

    push @RET, $line;
  }

  if ( %defs ) {
    # If any cpp tokens were defined for #if conditionals then add them to
    # the top of this file
    foreach my $token (reverse sort keys %defs) {
      next unless $token;
      $changed = 1;
      # Strip the leading "_with_" that was prepended above
      (my $uptoken) = $token =~ /^\s*_with_(.*)\s*$/;
      if ( $updefs{$uptoken} ) {
        # This token was defined in the updates via %df uptoken
        # so add it as a "defined" name
        unshift @RET, "#define $token\n";
      } else {
        # Otherwise add this token as an undefined name
        unshift @RET, "#undef $token\n";
      }
    }
  }

  if ( $changed ) {
    # Return the modified file if changes were made
    return @RET;
  } else {
    # Otherwise return nothing
    return ();
  }
}

sub fname_from_partial {
  # Find a proper file name from a partial file name that does not contain a suffix
  # This kind of partial file name is what is used in updates (go figure)
  use strict;
  # A partial file name, excluding the suffix
  my $partial = shift;

  # Define a pattern given the partial file name
  my $fpatt = "${partial}\.(f|f90|f95|F|F90|F95|dk|cdk)";

  # srcref will point to a hash, one of USRSRC, LSMOD, LSSUB or SCRIPT
  my $srcref = undef;

  my @hits = ();
  if ( %USRSRC ) {
    # First look in any user suppled source for file names that match this update
    @hits = grep /^$fpatt$/, keys %USRSRC;
    if ( scalar(@hits) ) {
      $srcref = \%USRSRC;
    }
  }
  unless ( scalar(@hits) ) {
    # If the update matched a user supplied source file or the user did not supply
    # any source files then look in the standard source tree for a match

    # Check lsmod file first
    @hits = grep /^$fpatt$/, keys %LSMOD;
    if ( scalar(@hits) ) {
      $srcref = \%LSMOD;
    } else {
      # Check lssub files next
      @hits = grep /^$fpatt$/, keys %LSSUB;
      if ( scalar(@hits) ) {
        $srcref = \%LSSUB;
      } else {
        # Check script files next
        @hits = grep /^$fpatt$/, keys %SCRIPT;
        if ( scalar(@hits) ) {
          $srcref = \%SCRIPT;
	} else {
          die "** EE ** fname_from_partial: Unable to find a file name matching $fpatt\n";
        }
      }
    }
  }

  return @hits;
}

sub locate_source {
  # Determine where source files to be updated live on the current system
  use strict;
  my $status = 1;

  my @lsmod_dir = ();
  my @lssub_dir = ();
  my @script_dir = ();
  if ( $CCRNSRC ) {
    # Define lists of directories that will contain particular source code
    @lsmod_dir  = ( "$CCRNSRC/source/lsmod/agcm/$modver" );
#    # Add the lsmod MODULES dir if present
#    my $modules_dir = "$CCRNSRC/source/lsmod/agcm/$modver/MODULES";
#    push @lsmod_dir, $modules_dir if -d $modules_dir;
    @lssub_dir  = ( "$CCRNSRC/source/lssub/model/agcm/$modver",
                    "$CCRNSRC/source/lssub/comm",
                    "$CCRNSRC/source/lssub/diag" );
    @script_dir = ( "$CCRNSRC/scripts/comm",
                    "$CCRNSRC/scripts/subproc",
                    "$CCRNSRC/source/diag4" );
  }

  foreach my $dir ( @lsmod_dir ) {
    die "** EE ** locate_source: Problem reading directory $dir\n"
        unless read_dir($dir, \%LSMOD, 1);
  }

  foreach my $dir ( @lssub_dir ) {
    die "** EE ** locate_source: Problem reading directory $dir\n"
        unless read_dir($dir, \%LSSUB, 1);
  }

  foreach my $dir ( @script_dir ) {
    die "** EE ** locate_source: Problem reading directory $dir\n"
        unless read_dir($dir, \%SCRIPT, 1);
  }

  foreach my $dir ( @usr_srcdir ) {
    die "** EE ** locate_source: Problem reading directory $dir\n"
        unless read_dir($dir, \%USRSRC, $recursive);
  }

  if ($verbose > 10) {
    foreach (sort keys %LSMOD) {
      print "$_  \t$LSMOD{$_}\n";
      if ($verbose > 11) {
        chomp(my @lines = `cat $LSMOD{$_}`);
        print join("\n",@lines),"\n\n";
      }
    }
    foreach (sort keys %LSSUB) {
      print "$_  \t$LSSUB{$_}\n";
      if ($verbose > 11) {
        chomp(my @lines = `cat $LSSUB{$_}`);
        print join("\n",@lines),"\n\n";
      }
    }
    foreach (sort keys %SCRIPT) {
      print "$_  \t$SCRIPT{$_}\n";
      if ($verbose > 11) {
        chomp(my @lines = `cat $SCRIPT{$_}`);
        print join("\n",@lines),"\n\n";
      }
    }
    foreach (sort keys %USRSRC) {
      print "$_  \t$USRSRC{$_}\n";
      if ($verbose > 11) {
        chomp(my @lines = `cat $USRSRC{$_}`);
        print join("\n",@lines),"\n\n";
      }
    }
  }

  unless ( %LSMOD or %LSSUB or %SCRIPT or %USRSRC ) {
    $status = 0;
  }

  return $status;

}

sub read_dir {
  # Get a list of all files in the given directory and add them to a hash
  use strict;
  use File::Basename;
  # The directory name from which files are read
  my $dir = shift;
  # A hash reference used to store file names found here
  my $href = shift;
  # Boolean flag to determine if subdirs should be read recursively
  my $recurse = shift;

  # Return status
  my $status = 1;

  die "** EE ** read_dir: Missing directory name.\n" unless $dir;
  die "** EE ** read_dir: $dir is not a directory\n" unless -d $dir;
  die "** EE ** read_dir: Missing hash reference.\n" unless $href;

  # Ignore directories named "RCS"
  return 1 if $dir =~ m'/?RCS$';

  # Read the dir and put the file list into @flist
  opendir DIR, $dir || die "** EE ** Unable to open dir $dir";
  # exclude all .* files and files ending with "~" and files named makefile
  # and files that end with .mk
  my @files = grep {!/^\./ and !/~$/ and !/^makefile/i and !/\.mk$/i} readdir DIR;
  closedir DIR;

  foreach (@files) {

    # Determine the full path name
    my $full_path = "$dir/$_";
    if ( $full_path !~ m'^/' ) {
      my ($fname,$fpath) = fileparse("$full_path",());
      chomp( $full_path = `cd $fpath 1>/dev/null 2>&1; pwd` );
      if ( $full_path =~ /\/$/ ) {
        $full_path .= "$fname";
      } else {
        $full_path .= "/$fname";
      }
    }
    unless ( -r $full_path ) {
      if ($verbose > 1) {
        print "Cannot read $full_path  \t...Ignoring.\n";
      }
      next;
    }

    if ( -d $full_path ) {
      # Ignore directories named "RCS"
      next if /^RCS$/;
      if ( $recurse ) {
        read_dir( $full_path, $href, 1 );
      }
      next;
    }

    # There should be no duplicate file names
    if ( exists $href->{$_} ) {
      if ($verbose>5) {
        foreach (sort keys %{$href}) {
          print "$_  \t$href->{$_}\n";
        }
      }
      $DUPLICATE{$_} = 1;
      warn "up2patch: Duplicate file name encountered --> $_ <--\n";
      warn "up2patch: Previous name at $href->{$_}\n";
      warn "up2patch:  Current name at $full_path\n";
      my $err = syscmd( "diff -b $href->{$_} $full_path", 1, 0 );
      if ( $err == 0 ) {
        # There is no difference between these files
        warn "up2patch: ...These files are identical (ignoring changes in white space).\n";
      } else {
        warn "up2patch: ...These files differ.\n";
        warn "up2patch: This will result in a fatal error if $_ is updated.\n";
      }
    }

    # Hash file names against full pathnames
    $href->{$_} = "$full_path";
  }

  return $status;
}

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*$/;
        if ($verbose > 5) {print "update_defs: subtype=$subtype\n"}
        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 "** EE ** 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";
  }

  # Ensure "deck" updates contain a single procedure per update
  foreach (keys %UPDATES) {
    # Ignore anything but a "deck" update
    next unless /^\s*[%*]\s*deck\s+/i;
    my ($deck_name) = /^\s*[%*]\s*deck\s+(\w+)/i;
    my @procs = split_fortran_procs( $UPDATES{$_}{text} );
    if ( scalar(@procs) > 1 ) {
      # There was more than 1 procedure in the text of this update
      my $type    = $UPDATES{$_}{type};
      my $comment = $UPDATES{$_}{comment};
      # Delete the current update
      delete $UPDATES{$_};
      my $proc_names = "";
      foreach my $proc (@procs) {
        # Create a new updates, one for each procedure
        my $key = "%deck \L$proc->{name}";
        if ( $UPDATES{$key} ) {
          my $msg = "Found duplicate procedure --> $proc->{kwrd} $proc->{name} <--";
          $msg .= " in update: $_\n";
          die "** EE ** $msg";
        }
        # Keep track of the procedure names
        $proc_names .= " \L$proc->{name}";
        # Use the comment and type from the update that was split
        $UPDATES{$key}{comment} = $comment;
        $UPDATES{$key}{type} = $type;
        # Use the single procedure text
        $UPDATES{$key}{text} = $proc->{text};
      }
      print "The update --> $_ <-- contains ",scalar(@procs)," procedures: $proc_names\n";
      print "These procedures are split into separate %deck updates.\n";
    } elsif ( scalar(@procs) == 1 ) {
      # There was only one procedure found in this %deck update
      # Verify that the name in the %deck update matches the procedure name
      unless ( "\L$deck_name" eq "\L$procs[0]->{name}" ) {
        my $key = "%deck \L$procs[0]->{name}";
        if ( $verbose > 0 ) {
          print "Renaming update --> $_ <-- as --> $key <--\n";
        }
        if ( $UPDATES{$key} ) {
          my $msg = "Found duplicate procedure --> $procs[0]->{kwrd} $procs[0]->{name} <--";
          $msg .= " in update: $key\n";
          die "** EE ** $msg";
        }
        $UPDATES{$key}{comment} = $UPDATES{$_}{comment};
        $UPDATES{$key}{type} = $UPDATES{$_}{type};
        # Use the single procedure text
        $UPDATES{$key}{text} = $procs[0]->{text};
        delete $UPDATES{$_};
      }
    }
  }

  # 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 split_fortran_procs {
  # Split a string containing lines of fortran source code into an array
  # of code sections where each section is an individual procedure
  # (ie a function, module, program or subroutine)
  use strict;
  my $strng = shift;

  my @p_kwrd;
  my @p_name;
  my $top_kwrd = "";
  my $top_name = "";
  my $text_blob = "";
  my @ret;

  # Define a set of fortran keywords used to identify procedures
  my $kwrd = '(block|function|module|program|subroutine)';

  # Loop over the input string line by line
  foreach my $line ( split(/\n/, $strng) ) {
    # Keep an interm copy of portions of the input string
    $text_blob .= "$line\n";

    # Create a copy of this line without any embedded '!' delimited comments
    my $clean_line =  rm_comments_from_line( $line );

    if ( $clean_line =~ /^\s*($kwrd\s+\w+)/i ) {
      # This is the first line of a procedure
      # Split whatever matched on white space
      my ($sub_kwrd, $sub_name) = split(/\s+/,$1);
      unless ( $sub_name ) {
        warn "up2patch: split_fortran_procs: missing $sub_kwrd name on line --> $line <--\n";
      }
      push @p_kwrd, $sub_kwrd;
      push @p_name, $sub_name;
      if ( scalar(@p_kwrd) == 1 ) {
        # Assign the name and keyword only for a top level procedure
        $top_kwrd = $sub_kwrd;
        $top_name = $sub_name;
      }
#DBG print "stack size: ",scalar(@p_kwrd)," $sub_kwrd $sub_name  in  $top_kwrd $top_name\n";
      next;
    }

    # Look for the last line of the current procedure
    my $is_end = 0;
    if ($clean_line =~ /^\s*end\s*$/i) {
      # A single "end" on a line by itself is ambiguous but usually means
      # the end of the current procedure block, whatever it is
      $is_end = 1;
    } elsif ($clean_line =~ /^\s*end\s*($kwrd.*)/i) {
      # This is the last line of a procedure block
      # Split whatever matched on white space
      my ($end_kwrd, $end_name) = split(/\s+/,$1);
      unless ( $end_name ) {
        warn "up2patch: split_fortran_procs: missing $end_kwrd name on line --> $line <--\n";
        $end_name = " ";
      }
      my $sub_kwrd = $p_kwrd[$#p_kwrd];
      my $sub_name = $p_name[$#p_name];
      # Do a case insensitive test for both keyword and name
      if ( "\L$end_kwrd" eq "\L$sub_kwrd" and "\L$end_name" eq "\L$sub_name" ) {
        # This is the last line of the procedure named $sub_name
        $is_end = 1;
      } else {
        warn "up2patch: split_fortran_procs: Unmatched/overlapping procedure end delimiter --> end $end_kwrd $end_name <--\n";
        warn "up2patch:                      Continuing but this code will not compile.\n";
      }
    }
    if ( $is_end ) {
      if ( scalar(@p_kwrd) == 1 ) {
        # Only write an update for the top level procedure
        # Need a new hash ref for each element of @ret so that
        # the individual hashes are passed back to the caller
        my %proc;
        $proc{kwrd} = $top_kwrd;
        $proc{name} = $top_name;
        $proc{text} = $text_blob;
        push @ret, \%proc;
        $top_kwrd = "";
        $top_name = "";
        $text_blob = "";
      }
#DBG print "stack size: ",scalar(@p_kwrd)," end $p_kwrd[$#p_kwrd] $p_name[$#p_name]\n";
      pop @p_kwrd;
      pop @p_name;
    }
  }

  if ( $text_blob ) {
    # Some lines remain after the end of the last procedure
    # Ignore leftover text that is all whitespace
    unless ( $text_blob =~ /^\s*$/s ) {
      # Otherwise simply append them to the last procedure found
      $ret[$#ret]->{text} .= $text_blob if scalar(@ret);
    }
  }

  return @ret;
}

sub rm_comments_from_line {
  # Remove any '!' delimited comments from a single fortran source line
  # The input line may not contain any newlines
  use strict;
  my $line = shift;

  # Ensure no newlines exists
  die "** EE ** rm_comments_from_line: The input -->\n$line\n<-- contains a newline\n"
      if $line =~ /\n/;

  # Do nothing unless the line contains a '!' character
  if ($line =~ /!/) {
    # Remove '!' delimited comments
    my $line_in = $line;

    # remove all single quoted strings on each line
    $line_in =~ s/'[^']*'//g;

    # remove all double quoted strings on each line
    $line_in =~ s/"[^"]*"//g;

    if ($line_in =~ /!/) {
      # If there is still a "!" after removing quoted segments then
      # detemine what part of the line is the comment
      my ($comment) = $line_in =~ /(!.*)$/;
      # Remove this comment
      $line =~ s/^(.*)\Q$comment\E$/$1/;
    }
  }

  return $line;
}

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 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 "** EE ** 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;
}

# Comments about unified diffs

#
# One way to tell if a file has been created/deleted is to look at
# the range of lines affected in the first chunk.
# -0,0 means that it's a created file.
# +0,0 means that it's a deleted file.
#
# 0,0 will never appear in the ranges except in these cases.

#
# A hunk begins with range information and is immediately followed with the line additions,
# line deletions, and any number of the contextual lines.
# The range information is surrounded by double-at signs.
# The format of the range information line is as follows:
#
# @@ -l,s +l,s @@
#
# The hunk range information contains two hunk ranges.
# The range for the hunk of the original file is preceded by a minus symbol,
# and the range for the new file is preceded by a plus symbol.
# Each hunk range is of the format l,s where l is the starting line number
# and s is the number of lines the change hunk applies to for each respective file.
# In many versions of GNU diff, each range can omit the comma and trailing value s,
# in which case s defaults to 1.
# Note that the only really interesting value is the l line number of the first range;
# all the other values can be computed from the diff.

# The hunk range for the original should be the sum of all contextual and deletion
# (including changed) hunk lines.
# The hunk range for the new file should be a sum of all contextual and addition
# (including changed) hunk lines.
# If hunk size information does not correspond with the number of lines in the hunk,
# then the diff could be considered invalid and be rejected.

# If a line is modified, it is represented as a deletion and addition.
# Since the hunks of the original and new file appear in the same hunk,
# such changes would appear adjacent to one another.