Oops! Correct version of Perl script

[Gary Polhill]

Apologies -- my previous posting contained a duff script. Here's the
correct one:

#!/usr/bin/perl -s
#
# linkup.pl
#
# Perl script to link up the needed software. Expects to find a file
# swarm.config containing a list of directories containing the needed software
# for swarm. One directory should be on each line.
#
# It works by examining each directory in turn, and creating links to the files
# and sub-directories it finds. If a subsequent directory is found to require
# a link that has already been made to a sub-directory of a previous needed
# software directory, then the link is removed, a directory created, and the
# original needed software directory and current sub-directory are each
# recursed to make links to the files that belong there.
#
# The goal is to bring together all the library, header and binary files,
# manual or info pages and any other data or directories the needed software
# packages store in their directories under one place (which, as far as this
# script is concerned, is the current working directory), using the minimum
# number of symbolic links.

open(CONFIG, "<swarm.config") ||
  die "swarm.config: $! -- If not found, it should be in current working ".
  "directory\n";
                                # Open the Swarm configuration file, which is
                                # expected to be in the current working
                                # directory
$k = 0;
while(<CONFIG>) {
  if(/^(.+)$/) {                # Read through the Swarm configuration file,
    $need[$k] = $1;             # building an array of needed software
    $k++;                       # directories to search.
  }
}
close(CONFIG);
foreach $needdir (@need) {      # For each Swarm needed software directory,
  &linkupdir($needdir, ".");    # call a subroutine to link to the files that
}                               # are found there from under the current
                                # working directory.

exit 0;                         # Exit this program

# Subroutines ###################

# linkupdir is a subroutine to recursively build up the links to a piece of
# needed software under the destination directory.
#
# Arguments: 2
# 1 - The directory to start searching for files to link to (this will be a
#     (sub directory of) a Swarm needed software directory) -- the source
#     directory
# 2 - The directory in which the links are to be built up -- the destination
#     directory
#
# After reading in the files in the source directory, it iterates through each
# file found building links as follows:
#
# If there is a file of the same name in the destination directory, then
#   If the file is a symbolic link to a directory, then
#     Remove the symbolic link and create the directory in the destination
#       directory
#     Recurse to build links to the original location the symbolic link
#       pointed to
#     Recurse to build links to this directory in current source directory
#   Else If the file is a symbolic link to a file, then
#     Complain
#   Else If the file is a directory, then
#     Recurse to build links to this directory in current source directory
#   Else
#     Create a symbolic link in the destination directory to the file in the
#       source directory

sub linkupdir {
  local($fromdir, $todir) = @_;
  if(!opendir(FROMDIR, "$fromdir")) {
    print STDERR "Could not open $fromdir: $!\n";
    return;                     # Open up the needed software (sub)directory
  }
  local(@files) = grep(!/^\.\.?$/, readdir(FROMDIR));
                                # Read all the files in the directory
  foreach $file (@files) {      # Iterate through all the files
    if(-e "$todir/$file") {
                                # File exists in destination directory
      if(-l "$todir/$file") {
                                # It is a symbolic link
        local($link) = readlink("$todir/$file");
                                # Get the link destination
        if(-d "$link") {
                                # The link points to a directory
          if(!unlink("$todir/$file")) {
                                # Delete the link
            print STDERR "$file needs to be shared by $link and ",
             "$fromdir/$file in $todir. Cannot remove the ",
             "original link to create a directory: $!\n";
             next;
          }
          elsif(defined($verbose)) {
            print "Removed link from $todir/$file to $link\n";
          }
          if(!mkdir("$todir/$file", 0755)) {
                                # Create a directory instead of the link
            print STDERR "Could not create $todir/$file to share ",
            "it between $fromdir/$file and $link: $!\n";
            next;
          }
          elsif(defined($verbose)) {
            print "Created directory $todir/$file\n";
          }
          &linkupdir("$link", "$todir/$file");
                                # Make links to all the contents of the
                                # directory the deleted link originally pointed
                                # to
          if(-d "$fromdir/$file") {
            &linkupdir("$fromdir/$file", "$todir/$file");
                                # Make links to all the contents of the
                                # sub-directory we've found
          }
          else {
            print STDERR "CONFLICT: $file is a directory in $link, but a ",
            "plain file in $fromdir/$file\n";
          }
        }
        else {
          print STDERR "CONFLICT: $file has already been linked to $link in ",
          "$todir -- cannot link it to $fromdir/$file\n";
        }
      }
      elsif(-d "$todir/$file") {
        &linkupdir("$fromdir/$file", "$todir/$file");
                                # This is a directory we've had to create to
                                # resolve conflicts before. Recurse.
      }
      else {
        print STDERR "CONFLICT: Cannot link $file in $fromdir because it ",
        "already exists in $todir\n";
      }
    }
    else {
      if(!symlink("$fromdir/$file", "$todir/$file")) {
        print STDERR "Could not link $todir/$file to ",
        "$fromdir/$file: $!\n";
      }
      elsif(defined($verbose)) {
        print "Linked $todir/$file to $fromdir/$file\n";
      }                         # Create the symbolic link
    }
  }
}



                  ==================================
   Swarm-Support is for discussion of the technical details of the day
   to day usage of Swarm.  For list administration needs (esp.
   [un]subscribing), please send a message to <address@hidden>
   with "help" in the body of the message.