# resetlinks.pl
# Peter Webb, June 2004
#
# This Perl script is used by BUILDMCR. BUILDMCR takes a list of MATLAB
# files and packages them into a ZIP file for distribution. However, BUILDMCR 
# "moves" some some of the binary files it distributes; the unpacked archive
# does not have exactly the same directory hierarchy as the original set of
# files. If the original set of files contains one or more symbolic links to
# files that are moved by BUILDMCR, the symbolic links need to be reset to
# point to the moved file's new location.
#
# Given a list of files that have been moved, and the name of a file 
# containing the original set of files:
#
#  * Examine each file in the original set to determine if it is a symbolic
#    link.
#
#  * For each symbolic link, check to see if it points to a file that has
#    been moved. These symbolic links will be broken if they are stored into
#    the ZIP file.
#
#  * For each "broken" symbolic link, create a new, temporary, symbolic link
#    that points to the moved location of the file.

# usage: Print usage message and exit with a non-zero error code
sub usage
{
    my $name = shift;
    print "Usage: %s -o <original list> -m <moved files>\n";
    print "   Each list is the name of a file containing a list of files.\n";
    print "   The moved files are specified, one per line, as:\n";
    print "        <original path>:<new path>\n";
    exit(-1);
}

# mktemp: Generate a temporary file name. The file name incorporates the
# PID and a counter.

sub mktemp
{
    $root = "/tmp/resetlinks";
    $tmp = $tempFileCount;
    $tempFileCount++;
    $tfile = $root . "." . "$$" . "." . "$tmp";
    $tfile;
}

# resolvepath: Return a full (absolute) path to the linked-to file.
#
# Inputs: The path to the linked-to file and the full path to the
# link file itself. The linked-to path may be relative.
#
# Output: The full path to the linked-to file, with any relative 
# directory navigation completely resolved.

sub resolvepath
{
    my $linkedTo = shift;
    my $linkedFrom = shift;

    # Don't do anything if the link is specified by absolute path
    if ($linkedTo =~ /^[\/]/)
    {
        $retval = $linkedTo;
    }
    else
    {
	# Chop the filename part off the back of the linkedFrom path
	$lastSep = rindex $linkedFrom, "/";
	if ($lastSep >= 0)
	{
	    $linkedFrom = substr $linkedFrom, 0, $lastSep;
	}

        while ($linkedTo =~ /(^[.][.]?[\/])/)
        {
	    $prefixCount = length($1);

	    # Chop the ../ from the front of the linkedTo path
	    $linkedTo = substr $linkedTo, $prefixCount ;

	    # Chop the last directory off the back of the linkedFrom path
            $lastSep = rindex $linkedFrom, "/";
            if ($lastSep >= 0)
            {
                $linkedFrom = substr $linkedFrom, 0, $lastSep;
	    }
	}
	$retval = $linkedFrom . "/" . $linkedTo;
    }
    $retval;
}

# Strip the given root from the given path.
sub striproot
{
    my $root = shift;
    my $path = shift;

    # If the roots don't end with a /, make them end with a / (we
    # want to strip off the / when we strip off the root, below).

    if ($root !~ /\/$/)
    {
	$root = $root . "/";
    }

    $path =~ s/$root//;
    $path;
}

# Determine the appropriate root for the symbolic link. 
#
# Big assumption: all relatively-specified files are rooted at the same
# directory.

sub reroot
{
    my $newRoot = shift;
    my $newLocation = shift;
    my $origRoot = shift;
    my $origLocation = shift;
    my $newLink = "";

    # Strip the roots from each location.
    
    $newLocation = striproot($newRoot, $newLocation);
    $origLocation = striproot($origRoot, $origLocation);

    # Count the directories from the original location up to the root.
    # This is equal to the number of path separators in the path.
    # tr/x/y/ returns the number of x's turned into y's. This allows us
    # to count the x's without perturbing the string, if tr/x/x/.
    $count = $origLocation =~ tr/\//\//;

    # For each directory we counted, put a ../ on the relative path.
    for ($i=0; $i<$count; $i++)
    {
	$newLink = $newLink . "../";
    }

    # Now we're at the root (where we know the new location is rooted),
    # we simply append the path to the new location, and voila! we have
    # the relative path to our new file location. And it only took 250 lines
    # of code. Was it worth it? Only our users will know.
    $newLink = $newLink . $newLocation;

    $newLink;
}

# Load the getopt module for command line processing
use Getopt::Std;

# Parse the command line for options. Set:
#	$opt_o to the file containing original list of files
# 	$opt_m to the file containing the list of moved files
# 	$opt_n to the new root location
# 	$opt_r to the original root location
getopt('omnr');

# Error handling -- all options are required.
if (length($opt_m) == 0)
{
    print "List of moved files (-m) must be specified.\n";
    usage();
}

if (! -e $opt_m)
{
    print "List of moved files ($opt_o) must exist.\n";
    usage();
}

if (length($opt_n) == 0)
{
    print "New root location (-n) must be specified.\n";
    usage();
}

if (length($opt_o) == 0)
{
    print "List of original files (-o) must be specified.\n";
    usage();
}

if (! -e $opt_o)
{
    print "List of original files ($opt_o) must exist.\n";
    usage();
}

if (length($opt_r) == 0)
{
    print "Original root location (-r) must be specified.\n";
    usage();
}


# Get going! Put the list of moved files into a hash, so that we can look up
# the new path when given the old path.

open(MOVED_FILES, $opt_m) || die "Could not open list of moved files: $opt_m";
while(<MOVED_FILES>)
{
    ($original, $moved) =  split(':');
    chomp $original;
    chomp $moved;
    @movedFileHash{$original} = $moved;
}
close(MOVED_FILES);

# Iterate over the list of original files, looking for links to moved files.
open(ORIG_FILES, $opt_o) ||
    die "Could not open list of original files: $opt_o";
$tempFileCount = 0;
$count = 0;
while(<ORIG_FILES>)
{
    chomp;
    $original = $_;
    # Look for symbolic links
    if (-l $original)
    {
	# Does the symbolic link point to a moved file?
	$link = readlink($original);
	$fullLink = resolvepath($link, $original);
        if (length($movedFileHash{$fullLink}) > 0)
	{
	    # Determine the (relative or absolute) location of
	    # the linked-to file after it has been moved. If the
	    # file was originally linked to with a relative link,
	    # we must compute a relative link for it after it has
	    # been moved.
	    #
	    # One wrinkle: If the original link file has itself been moved,
	    # make sure we point the link from its NEW location to the
	    # new location of the linked-to file. (This is the evil case
	    # in which both files have been moved.)
	    
	    $originalRoot = $opt_r;
	    if (length($movedFileHash{$original}) > 0)
	    {
		$original = $movedFileHash{$original};
		$destLink = $original;
		$originalRoot = $opt_n;
	    }

            $linkedTo = reroot($opt_n, $movedFileHash{$fullLink},
			       $originalRoot, $original);

            # Create a temporary link that points to the moved location
            $tempname = mktemp;
            symlink($linkedTo, $tempname) ||
	        die "Failed to create symbolic link\n  $tempname\nto file\n  $movedFileHash{$fullLink}";
	    $destLink = striproot($originalRoot, $original);
	    printf("%s:%s\n", $destLink, $tempname);
	}
    }
}

# Everything OK, exit with status zero, like a good little script
0;