#!/usr/bin/perl -w
########################################################################
# Move a directory that may contain CCCma "saved" files.
# Resave any previously saved files in the new location.
#
# Larry Solheim Jul 2010
#
# $Id: mvcccd 640 2011-02-02 18:31:28Z acrnrls $
########################################################################

require 5;
use Shell qw(rm);

# Declare global variables
use vars qw(%TMP_SAVED &mv_saved_dir &scan_for_saved &scan_for_saved_sub
             &delete_saved_dir &delete_saved_list
            &resave_saved &shcmd $verbose $stamp);

chomp($Runame = `basename $0`);

# Get the hostname on which this script was invoked
use Sys::Hostname;
$host = hostname();
$host =~ s/^(.*?)\..*/$1/;

# Determine the physical location of hostname (cccma or cmc)
my $domain = (split(/\s+/, `grep search /etc/resolv.conf`))[1];
if ($domain) {
  $domain =~ s/^\s*int\.//i if $domain =~ /^\s*int\./;
  $location = (split /\./, $domain)[0];
} else {
  if ($host) {
    $location = "Unknown";
    if ($host =~ /^lx/)   {$location = "cccma"};
    if ($host =~ /^erg/)  {$location = "cmc"};
    if ($host =~ /^alef/) {$location = "cmc"};
    if ($host =~ /^ib/)   {$location = "cmc"};
    if ($host =~ /^c\d/)  {$location = "cmc"};
  } else {
    $location = "Unknown";
  }
}

# Invoking user
$user = (getpwuid($<))[0];

# define a unique stamp for file name id etc
chomp($stamp = "${host}_" . `date "+%Y%j"$$`);

# add_link is a boolean flag to determine if a link to the new directory
# location should be added in the old location.
$add_link = 1;

# verbose is used to limit or expand diagnostic output
$verbose = 0;

# diff_after_copy is a boolean flag to determine if a diff between the source
# destination directories is done before the source dir is deleted
$diff_after_copy = 0;

# create_when_missing is a boolean flag to determine if file stubs are to be
# created, just prior to calling "access" and "delete", when they do not exist
$create_when_missing = 0;

# Force an overwrite of any existing destination directory.
# If $force_overwrite is non zero then the destination directory will be
# removed prior to the copy. All saved files in and below the user specified
# destination directory will be "access"ed and "delete"ed prior to removing
# the destination directory.
$force_overwrite = 0;

# scan_only is a boolean flag to determine if directories are simply scanned
# for saved file but not copied or removed.
$scan_only = 0;

# user_must_own_source_dir is a boolean flag which, if true, means that the
# invoking user must also own the source directory which is being copied.
# This is normally necessary in order that officially saved files may be
# deleted from this dir after the source dir is copied. This may be reset
# by the user, which may be desireable if either there are no officially saved
# files in the source dir or the invoking user has write privileges there.
$user_must_own_source_dir = 1;

# Define a usage function
$Usage = sub {
  my ($msg)=@_;
  if ($msg) {print "${Runame}: $msg\n"};
  print <<EOR;
  Usage: $Runame [options] dira dirb
Purpose: move a directory while preserving any officialy saved files
Comment: dira must exist and have rwx permission for the invoking user
         dirb or its parent directory must exist and be writeable
Options:
  --scan      ...only scan the source dir for saved files, do not copy
  --nolink    ...do not recreate dira as a link to dirb after the move
                 This link is created by default.
  --force     ...force an overwrite of any existing destination directory
                 Any offically saved files found in this dir will be "unsaved".
  --diff      ...determine a diff between dira and dirb before removing dira
  --verbose   ...increase verbosity (additive)
  --help      ...display usage info
EOR
  if ($msg) {
    exit 1;
  } else {
    exit 0;
  }
};

# Process command line arguments
$show_usage = 0;
use Getopt::Long;
$Getopt::Long::ignorecase = 0;
$Getopt::Long::order = $PERMUTE;
&GetOptions("verbose"          => sub {$verbose++},
            "help!"            => \$show_usage,
            "link!"            => \$add_link,
            "diff!"            => \$diff_after_copy,
            "create!"          => \$create_when_missing,
            "force!"           => \$force_overwrite,
            "scan!"            => \$scan_only,
            "own_source!"      => \$user_must_own_source_dir,
            "<>"               => sub {push @NonOpt,$_[0]})
    or &$Usage("Error on command line.");
&$Usage() if $show_usage;

# Process non option command line args
@Dlist = ();
foreach (@NonOpt) {
  next unless $_;
  if (/=/) {
    # This is a variable assignment of the form "var=val"
    # Strip quotes, if any
    s/^\s*"(.*)"\s*$/$1/;
    s/^\s*'(.*)'\s*$/$1/;
    my ($var,$val) = /^\s*(.*?)=(.*)/;
    # Strip quotes from the value, if any
    $val =~ s/^\s*"(.*)"\s*$/$1/;
    $val =~ s/^\s*'(.*)'\s*$/$1/;
    die "Null value supplied with --> $_ <-- on command line.\n"
        unless $val;
    # Add variable defs found on the command line to the env hash
    # or assign these values to specific variables
    if ($var eq "source") {
      # Strip leading/trailing space and ...
      $val =~ s/^\s*(.*?)\s*$/$1/;
      die "Invalid command line arg $_\n";
    } else {
      die "Invalid command line arg $_\n";
    }
    next;
  }

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

if ($scan_only) {
  # Simply scan each dir on the command line for saved files
  foreach $dir (@Dlist) {
    die "$dir is not a directory.\n" unless -d "$dir";
    print "Scanning $dir ...\n";
    $href = scan_for_saved( $dir );
    if ($href) {
      foreach my $p (sort keys %{$href}) {
        if ( $href->{$p} ) {
          # This file exists in DATAPATH
          if ( $href->{$p} =~ /^\s*1\s*$/ ) {
            # The link in DATAPATH points to this file
            print "SAVED: $p\n";
          } else {
            # The link in DATAPATH points to a file in a different dir
            print "SAVED IN DIFFERNT DIR: $p \tIN DIR \t$href->{$p}\n";
          }
        } else {
          # This files does not exist in DATAPATH
          print "NOT SAVED: $p\n";
        }
      }
    } else {
      print "No saved files found in $dir\n";
    }
    print "\n";
  }

  exit;
}

# Sanity checks on directory names supplied on command line
if ( scalar(@Dlist) == 2 ) {
  my $dira = $Dlist[0];
  my $dirb = $Dlist[1];
  die "Null value supplied for dira.\n" unless $dira;
  die "Null value supplied for dirb.\n" unless $dirb;

  # Resolve any links for dira and dirb
  $dira = readlink $dira if -l $dira;
  $dirb = readlink $dirb if -l $dirb;

  die "$dira is not a directory.\n" unless -d "$dira";
  die "$dira must be readable.\n"   unless -r "$dira";
  die "$dira must be writeable.\n"  unless -w "$dira";

  if ($user_must_own_source_dir) {
    # Ensure the invoking user is the owner of the source dir
    my $lsld = shcmd("ls -ld $dira");
    chomp($lsld);
    $owner = (split(/\s+/,$lsld))[2];
    unless ($user eq $owner) {
      warn "The invoking user $user does not own $dira\n";
      die "To override this warning use the command line option --> --noown <--\n";
    }
  }

  # Expand any relative path names
  chomp($dira = `cd $dira ; pwd`) unless $dira =~ m<^\s*/>;

  $dest_dir_exists = 0;
  if ( -d "$dirb" ) {
    # Expand any relative path names
    chomp($dirb = `cd $dirb ; pwd`) unless $dirb =~ m<^\s*/>;
    $dest_dir_exists = 1;
  }

  # Strip any trailing slash
  $dira =~ s</\s*$><> if $dira =~ m</\s*$>;
  $dirb =~ s</\s*$><> if $dirb =~ m</\s*$>;

  $source_path = $dira;
  $dest_path   = $dirb;

} else {
  &$Usage("Exactly two directory names must appear on the command line.");
}

#FIX if (1 == 1) {
#FIX   # Fix a problem
#FIX 
#FIX   # Scan the destination dir and create a new hash that uses similar keys
#FIX   # in which $source_path replaces $dest_path
#FIX   $href = scan_for_saved( $dest_path );
#FIX   if ($href) {
#FIX     %DEST = %{$href};
#FIX     foreach my $p (sort keys %{$href}) {
#FIX       $sp = $p;
#FIX       $sp =~ s/^$dest_path/$source_path/;
#FIX       die "Unable to replace $dest_path with $source_path in $p"
#FIX         unless $sp =~ /^$source_path/;
#FIX       $SOURCE{$sp} = 1;
#FIX       print "p=$p \tsp=$sp\n";
#FIX     }
#FIX   } else {
#FIX     die "No saved files in $dest_path\n";
#FIX   }
#FIX 
#FIX   # Delete every "saved" file found in %SOURCE from DATAPATH and
#FIX   # the local data base then remove the source directory
#FIX   print "Removing the source directory $source_path.\n";
#FIX   my $subOPTS = {CREATE => 1,
#FIX                  SAVED_REF => \%SOURCE};
#FIX   delete_saved_dir( $source_path, $subOPTS );
#FIX 
#FIX   # Resave previously saved files in the directory tree
#FIX   # that is now rooted at $dest_path
#FIX   print "Resaving previously saved files in new dir tree.\n";
#FIX   &resave_saved( \%DEST );
#FIX 
#FIX   if ($add_link) {
#FIX     # Add a link at the old location of source dir to the new location
#FIX     shcmd("ln -s $dest_path $source_path");
#FIX   }
#FIX 
#FIX   exit;
#FIX }

if ( $verbose > 2 ) {
  print "source_path=$source_path   dest_path=$dest_path\n";
}

# Check for existence of the target to avoid an unintentional overwrite
my $target = "$dest_path";
if ( -d "$dest_path" ) {
  my $base_dir = (split(/\//,$source_path))[-1];
  $target = "$dest_path/$base_dir";
}
if ( -e "$target" ) {
  if ( $force_overwrite ) {
    if ( -d "$target" ) {
      # "Unsave" any saved files in this dir before removing
      delete_saved_dir( $target );
    } else {
      # This is not a directory. Simply remove it
      shcmd( "rm -f $target" );
    }
  } else {
    die "$target already exists. Use --force on command line to force overwrite.\n";
  }
}

# Scan the source directory for saved files (create %SOURCE_SAVED)
print "Scanning $source_path ...\n";
$href = scan_for_saved( $source_path );
%SOURCE_SAVED = %{$href} if $href;

if ($verbose > 5) {
  foreach my $p (sort keys %SOURCE_SAVED) {
    print "SOURCE_SAVED: $p\n";
  }
}

# Copy the directory tree, overwriting any existing destination dir
print "Copying $source_path to $dest_path\n";
shcmd("cp -rf --preserve=mode,timestamps $source_path $dest_path");

# Once the dir has been copied then the destination dir will exist and
# we can cd to it in order to expand any relative path names
if ($dest_dir_exists) {
  # The destination dir existed prior to the "cp"
  # Therefore the last pathname in the source_path will be a subdir of
  # this pre existing dest_dir
  $last_path = (split( /\//, $source_path))[-1];
  $dest_dir = "$dest_path/$last_path";
} else {
  # The destination dir did not existed prior to the "cp"
  # Therefore dest_dir will be unchanged
  $dest_dir = "$dest_path";
}
chomp($dest_path = `cd $dest_dir ; pwd`);

if ($diff_after_copy) {
  # Diff the copied directory tree with the original
  shcmd("diff -qr $source_path $dest_path");
}

# Scan the desination directory for saved files (create %DEST_SAVED)
print "Scanning $dest_path ...\n";
$href = scan_for_saved( $dest_path );
%DEST_SAVED = %{$href} if $href;

if ($verbose > 5) {
  foreach my $p (sort keys %DEST_SAVED) {
    print "DEST_SAVED: $p\n";
  }
}

# Ensure that all entries in %SOURCE_SAVED have a corresponding entry
# in %DEST_SAVED with $dest_path substituted for $source_path
foreach (sort keys %SOURCE_SAVED) {
  my ($new_path) = m<^$source_path(.*)$>;
  substr($new_path,0,0) = $dest_path;
  die "mvcccd: Saved file mismatch.\n  $_ \texists but \t$new_path \tdoes not exist.\n"
    unless $DEST_SAVED{$new_path};
  if ($verbose > 5) {
    print "$_ \tand \t$new_path \tmatch.\n";
  }
}

# Ensure that all entries in %DEST_SAVED have a corresponding entry
# in %SOURCE_SAVED with $source_path substituted for $dest_path
foreach (sort keys %DEST_SAVED) {
  my ($new_path) = m<^$dest_path(.*)$>;
  substr($new_path,0,0) = $source_path;
  die "mvcccd: Saved file mismatch.\n  $_ \texists but \t$new_path \tdoes not exist.\n"
    unless $SOURCE_SAVED{$new_path};
  if ($verbose > 5) {
    print "$_ \tand \t$new_path \tmatch.\n";
  }
}

# Set file permissions on all dirs and files below dest_path
shcmd("find $dest_path -type d -exec chmod a+rx \{\} \\;");
shcmd("find $dest_path -type f -exec chmod a+r \{\} \\;");

# Delete every "saved" file found in %SOURCE_SAVED from DATAPATH and
# the local data base then remove the source directory
print "Removing the source directory $source_path.\n";
my $subOPTS = {CREATE => $create_when_missing,
               SAVED_REF => \%SOURCE_SAVED};
delete_saved_dir( $source_path, $subOPTS );

# Resave previously saved files in the directory tree
# that is now rooted at $dest_path
print "Resaving previously saved files in new dir tree.\n";
&resave_saved( \%DEST_SAVED );

if ($add_link) {
  # Add a link at the old location of source dir to the new location
  shcmd("ln -s $dest_path $source_path");
}

print "Directory $source_path moved to $dest_path\n";

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

sub mv_saved_dir {
  # Move a directory containing officially saved files
  use strict;
  my $sdir = shift;  # Source directory
  my $ddir = shift;  # Destination directory

  die "mv_saved_dir: Source $sdir is not a directory.\n" unless -d "$sdir";
  die "mv_saved_dir: Destination $ddir is not a directory.\n" unless -d "$ddir";

  die "mv_saved_dir: Source $sdir must be readable.\n"  unless -r "$sdir";
  die "mv_saved_dir: Destination $ddir must be writeable.\n" unless -w "$ddir";

  my $ret = 1;
  # Get a list of files from the source directory
  my @file_list = ();
  opendir (SOURCE, "$sdir")
    or die "*** ERROR *** Cannot open source directory $sdir  $!";
    # Ignore all ".*" entries
    @file_list = grep { !/^(?:\.\.?$|^\.)/ } readdir SOURCE;
  closedir(SOURCE);

  my %saved;
  # Loop over all file names but only copy regular files that have not been
  # officially saved. Assign %saved with info about saved files in this dir.
  foreach my $file (sort @file_list) {
    # Ignore all directories on the first pass
    next if -d "$sdir/$file";

    if ($file =~ m<\.\d\d\d\s*$>) {
      # If the file name ends with a 3 digit numeric extention
      # then assume that it is an officially "saved" file
      # Assign a local %saved hash with info about files in the current dir
      my ($bname) = $file =~ m<^(.*)\.\d\d\d\s*$>;
      die "mv_saved_dir: Unable to determine base name for $file\n" unless $bname;
      push @{$saved{$bname}}, $file;
    } else {
      # Copy this file as is
      if ($verbose > 5) {
        print "cp -p $sdir/$file $ddir/$file\n";
      }
      `cp -p $sdir/$file $ddir/$file`;
      die "mv_saved_dir: *** ERROR *** cp -p $sdir/$file $ddir/$file : $?\n" if $?;
    }
  }

  # Loop over all saved files and copy only the highest edition number to a
  # file in the destination dir with the same name but without the extension.
  foreach my $bname (sort keys %saved) {
    # Identify the file with the largest extention number
    my @L = sort @{$saved{$bname}};
    my $file = $L[-1];

    # Copy this file without the numeric extension
    if ($verbose > 5) {
      print "cp -p $sdir/$file $ddir/$bname\n";
    }
    `cp -p $sdir/$file $ddir/$bname`;
    die "mv_saved_dir: *** ERROR *** cp -p $sdir/$file $ddir/$bname : $?\n" if $?;
  }

  # Loop over all file names and create sub directories in the destination
  # directory for each sub dir in the source directory
  foreach my $dir (sort @file_list) {
    # Ignore all regular files
    next unless -d "$sdir/$dir";
    my $curr_ddir = "$ddir/$dir";
    my $curr_sdir = "$sdir/$dir";
    if ($verbose > 5) {
      print "mkdir -m 755 $curr_ddir\n";
    }
    `mkdir -m 755 $curr_ddir`;
    die "mv_saved_dir: *** ERROR *** mkdir -m 755 $curr_ddir : $?\n" if $?;

    # Call mv_saved_dir recursively for each sub directory encountered
    &mv_saved_dir($curr_sdir, $curr_ddir);
  }

  return wantarray ? @file_list : $ret;
}

sub scan_for_saved {
  # This is a wrapper around scan_for_saved_sub that will return a hash
  # containing file names of officially saved files in the current directory
  use strict;

  # Source directory to scan
  my $curr_dir = shift;

  # Reference to a hash containing optional args
  my $OPTS = shift;

  # Scan this directory
  undef %TMP_SAVED;
  scan_for_saved_sub( $curr_dir, $OPTS );

  # Assign the global hash to a local variable that will be
  # returned to the calling program
  my %RET = %TMP_SAVED;
  undef %TMP_SAVED;

  if ($verbose > 10) {
    foreach my $p (sort keys %RET) {
      print "scan_for_saved: $p\n";
    }
  }

  return %RET ? \%RET : undef;
}

sub scan_for_saved_sub {
  # Scan a directory for file names with a 3 digit numeric extension
  # Assign a global hash (TMP_SAVED) with these file names as keys
  # It is assumed that these files are "officially" saved files
  use strict;
  use File::Basename;

  # Source directory to scan
  my $curr_dir = shift;

  # Reference to a hash containing optional args
  my $OPTS = shift;

  # Scan this directory and all sub direcories recursively
  my $recurse = 1;
  $recurse = $OPTS->{RECURSE} if defined $OPTS->{RECURSE};

  die "scan_for_saved_sub: $curr_dir is not a directory.\n" unless -d "$curr_dir";
  die "scan_for_saved_sub: $curr_dir must be readable.\n"   unless -r "$curr_dir";

  # Strip any trailing slash on curr_dir
  $curr_dir =~ s</\s*$><> if $curr_dir =~ m</\s*$>;

  # Get a list of files from the current directory
  my @file_list = ();
  opendir (SOURCE, "$curr_dir")
    or die "*** ERROR *** Cannot open source directory $curr_dir  $!";
    # Ignore all ".*" entries
    @file_list = grep { !/^(?:\.\.?$|^\.)/ } readdir SOURCE;
  closedir(SOURCE);

  # Prepend $curr_dir to each file name in this list to create absolute pathnames
  map {s/^\s*(.*?)\s*$/$1/;
       substr($_,0,0)="$curr_dir/" unless /^$curr_dir/;
      } @file_list;

  # Loop over all non directory files in the current directory and identify
  # which are "officially" saved. It is assumed that a file has been saved
  # if its name contains a 3 digit numeric extention.
  foreach my $file (sort @file_list) {
    # Ignore all directories on the first pass
    next if -d "$file";

    my ($bname, $dir, $suffix) = fileparse("$file", '\.\d\d\d');
    if ($verbose > 5) {
      print "scan_for_saved_sub: dir=$dir  bname=$bname  suffix=$suffix\n";
    }

    # Ignore this file unless the file name ends with a 3 digit numeric extention
    next unless $suffix;

    die "scan_for_saved_sub: Invalid file name $file\n" unless $bname;

    # Add the absolute pathname as a key to the global output hash
    # Note: %TMP_SAVED must be global to survive recursion
    $TMP_SAVED{$file} = 1;

    # Find out if this files actually is officially saved
    # by looking for it in DATAPATH
    my @lscmd = `ls -l $ENV{DATAPATH}/$bname$suffix 2>/dev/null`;
    if ($?) {
      # Zero the value assigned to this key to indicate that there is no
      # corresponding file found in DATAPATH
      $TMP_SAVED{$file} = 0;
      if ($verbose > 5) {
        print "$file \texists but \t$ENV{DATAPATH}/$bname$suffix does not exist.\n";
      }
    } else {
      # Determine if the link in DATAPATH points to the current file
      # or to a file in a different directory
      my $run_path = (split(/\s+/,$lscmd[0]))[-1];
      # Set the value to the full pathname to which the link points
      # if the link is to a file in another directory
      $TMP_SAVED{$file} = "$run_path" if "$run_path" ne "$file";
    }
  }

  if ($recurse) {
    # Loop over all sub directories calling scan_for_saved_sub recursively
    foreach my $dir (sort @file_list) {
      # Ignore all regular files
      next unless -d "$dir";
      if ($verbose > 0) {
        print "  scan_for_saved_sub($dir)\n";
      }
      scan_for_saved_sub($dir,$OPTS);
    }
  }

  return 1;
}

sub delete_saved_dir {
  # Delete a directory.
  # If there are officially saved files in this direcory tree then delete
  # these files first, to remove them from DATAPATH and the local database.

  use strict;

  # The name of the directory to be removed
  my $curr_dir = shift;

  # Reference to a hash containing optional args
  my $OPTS = shift;

  # A hash containing file names of saved files in the dir to be removed
  my $saved_ref = '';
  $saved_ref = $OPTS->{SAVED_REF} if defined $OPTS->{SAVED_REF};

  die "delete_saved_dir: $curr_dir is not a directory.\n" unless -d "$curr_dir";
  die "delete_saved_dir: $curr_dir must be readable.\n"   unless -r "$curr_dir";

  unless ( $saved_ref ) {
    # Scan the dir to be removed for saved files
    if ($verbose > 5) {
      print "delete_saved_dir: Scanning $curr_dir for saved files.\n";
    }
    $saved_ref = scan_for_saved( $curr_dir );
  }

  if ( $saved_ref ) {
    # Delete any saved files
    if ($verbose > 5) {
      print "delete_saved_dir: Deleting saved files from $curr_dir\n";
    }
    if ($verbose > 10) {
      foreach ( sort keys %{$saved_ref} ) {
        print "delete_saved_dir: $_\n";
      }
    }
    delete_saved_list($saved_ref, $OPTS);
  }

  # Delete the directory itself
  if ($verbose > 5) {
    print "delete_saved_dir: Removing $curr_dir\n";
  }
  shcmd("rm -fr $curr_dir");

}

sub delete_saved_list {
  # Delete a list of "officially" saved files using "access" and "delete"
  # to remove each file from DATAPATH and the local database

  use strict;
  use File::Basename;

  # Reference to a hash contianing file names of saved files
  my $saved_ref = shift;

  # Reference to a hash containing optional args
  my $OPTS = shift;

  # Abort if any file to be deleted is missing
  my $fail_if_missing = 0;

  # Create the saved file if it is missing
  my $create_when_missing = 0;
  $create_when_missing = $OPTS->{CREATE} if defined $OPTS->{CREATE};

  # Delete officially saved files
  foreach ( sort keys %{$saved_ref} ) {
    my ($bname, $dir, $suffix) = fileparse("$_", '\.\d\d\d');
    die "delete_saved_list: $_ must contain a numeric extension.\n"
      unless $suffix;

    if ($create_when_missing) {
      # Create this file if it does not exist along with any missing directories
      shcmd("mkdir -p $dir") unless -d "$dir";
      shcmd("touch $_") unless -f "$_";
    }

    if ($fail_if_missing) {
      die "delete_saved_list: $_ does not exist.\n" unless -e "$_";
    }

    my $local_name = "${bname}_$stamp";

    $suffix =~ s/^\.//; # Remove the leading '.' from suffix
    my $edition = int($suffix);
    my $ed = "ed=$edition";

    # Delete the officially saved file (do not abort if the file is missing)
    shcmd("access $local_name $bname $ed nocp na");
    shcmd("delete $local_name na");
  }

  return 1;
}

sub shcmd {
  # Execute a simple shell command
  use strict;
  my $cmd = shift;

  # echo or don't echo shell commands depending on the value of $verbose
  my $setx = "";
  $setx = "set -x;" if $verbose > 0;

  my @out = `$setx $cmd`;
  print "\n@out" if $verbose > 2;
  if ($?) {
    my ($package, $file, $line, $parent) = caller(1);
    $parent = "$0" unless $parent;
    $parent = (split('::',$parent))[-1];
    print "\n@out";
    die "${parent}: *** ERROR *** $cmd : $?\n";
  }

  return wantarray ? @out : join('',@out);
}

sub resave_saved {
  # Resave all previously saved files in the new directory tree

  use strict;
  use File::Basename;

  # Reference to a hash whose keys are absolute pathnames for files
  # that are to be saved in the new directory tree
  my $saved_ref = shift;

  # Keep track of where we are now so we can cd back here after the loop below
  chomp(my $CWD = `pwd`);

  # Resave each file found in the $saved_ref hash in the new RUNPATH
  foreach (sort keys %{$saved_ref}) {
    my ($name, $path, $suffix) = fileparse("$_", '\.\d\d\d');
    die "resave_saved: $_ must contain a numeric extension.\n"
      unless $suffix;

    # Strip any trailing slash on the pathname
    $path =~ s</+\s*$><>;
    # Set RUNPATH for the current save
    $ENV{RUNPATH} = $path;

    # Change dirs to the where current file lives
    chdir $path or die "Cannot cd to ${path}:  $!\n";

    # Rename the file to avoid conflict when creating a link in "save"
    my $local_name = "${name}_$stamp";
    shcmd("mv $name$suffix $local_name");

    # Resave with the same edition number
    $suffix =~ s/^\.//; # Remove the leading '.' from suffix
    my $edition = int($suffix);
    my $ed = "ed=$edition";

    # "save" and "release"
    shcmd("save $local_name $name $ed");
    shcmd("release $local_name $name");
  }

  # Change back to the original directory
  chdir $CWD or die "Cannot cd to ${CWD}:  $!\n";

  return 1;
}