#!/usr/bin/perl
# Filename:	lnR
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License
  my $VERSION=	1.00;
# Description:	Recursively links a bunch of files with a matching dir structure
use strict;

##################################################
# Setup the variables
##################################################
my $PROGNAME = $0;
$PROGNAME =~ s|.*/||;

my $SYMBOLIC =	0;
my $IGNORE =	0;
my $VERBOSE =	0;

umask 022;      # 0755

use Cwd qw(abs_path getcwd);

##################################################
# Usage
##################################################
sub usage {
  my $msg;
  foreach $msg (@_) { print "ERROR:  $msg\n"; }
  print "\n";
  print "Usage:\t$PROGNAME <from> <to>\n";
  print "\tRecursively copy a bunch of directories, using soft links for files\n";
  print "\t-ignore\tFiles/dirs matching this regexp will be ignored\n";
  print "\t-s\tUse symbolic links\n";
  print "\t-v\tVerbose\n";
  print "\n";
  print "\tUse absolute path for 'from' if you want absolute links\n";
  print "\n";
  exit -1;
}

sub parse_args {
  my ($from,$to);
  while ($#ARGV>=0) {
    my $arg=shift(@ARGV);
    if ($arg =~ /^-h$/) { usage(); }
    if ($arg =~ /^-v$/) { $VERBOSE=1; next; }
    if ($arg =~ /^-s/) { $SYMBOLIC=1; next; }
    if ($arg =~ /^-ignore/) { $IGNORE=shift(@ARGV); next; }
    if ($arg =~ /^-/) { usage("Unknown option: $arg"); }
    if (!$from) {
      $from = $arg;
    } elsif (!$to) {
      $to = $arg;
    } else {
      usage("Too many locations specified [$arg, $from, $to]");
    }
  }
  usage("No from location defined") unless $from;
  usage("From location needs to be a directory") unless -d $from;
  usage("No to location defined") unless $to;

  ($from,$to)
}

##################################################
# Handle a directory
##################################################
sub do_dir {
  my ($from,$to,$back) = @_;

  print "do_dir $from -> $to\n" if ($VERBOSE);

  return print STDERR "[$PROGNAME] Couldn't read directory [$from]\n"
    unless (opendir(FROM,$from));
  my @from = grep(!/^\.{1,2}$/,readdir(FROM));
  closedir(FROM);
  @from = grep(!/$IGNORE/,@from) if ($IGNORE);
  my @from_files = grep(-f "$from/$_", @from);
  my @from_dirs = grep(-d "$from/$_", @from);
  my %from_files;   foreach ( @from_files ) { $from_files{$_} = 1; }
  my %from_dirs;   foreach ( @from_dirs ) { $from_dirs{$_} = 1; }

  my @to;
  if (opendir(TO,$to)) {
    @to = grep(!/^\.{1,2}$/,readdir(TO));
    closedir(TO);
  }

  my @to_links = grep(-l "$to/$_", @to);
  my @to_dirs = grep(-d "$to/$_", @to);
  my %to_links;   foreach ( @to_links ) { $to_links{$_} = 1; }
  my %to_dirs;   foreach ( @to_dirs ) { $to_dirs{$_} = 1; }

  # Clean out to directory first
  foreach my $link ( @to_links ) {
    unless ($from_files{$link}) {
      print "Remove $to/$link\n" if ($VERBOSE);
      print STDERR "[$PROGNAME] Couldn't remove old link [$to/$link]\n"
        unless unlink "$to/$link";
    }
  }
  foreach my $dir ( @to_dirs ) {
    unless ($from_dirs{$dir}) {
      print "Remove $to/$dir/\n" if ($VERBOSE);
      system("/bin/rm -Rf \Q$to/$dir\E") if ($to ne "" && $dir ne "");
      print STDERR "[$PROGNAME] Couldn't remove old directory [$to/$dir]\n$!\n"
        if ($?);
    }
  }

  # Build new links
  foreach my $link ( @from_files ) {
    next if (-l "$to/$link");
    if (-e "$to/$link") {
      print STDERR "[$PROGNAME] Warning: File exists [$to/$link]\n";
      next;
    }
    if ($SYMBOLIC) {
      print "Link $back/$link -> $to\n" if ($VERBOSE);
      print STDERR "[$PROGNAME] Couldn't link [$to/$link]\n"
        unless symlink("$back/$link","$to/$link");
    } else {
      print "Link $from/$link -> $to\n" if ($VERBOSE);
      print STDERR "[$PROGNAME] Couldn't link [$to/$link]\n"
        unless link("$from/$link","$to/$link");
    }
  }

  my $abs = ($back =~ m|^/|) ? 1 : 0;
  my $new_back = $abs ? $back : "../$back";

  # Build new directories
  foreach my $dir ( @from_dirs ) {
    if (!-d "$to/$dir") {
      print "mkdir $to/$dir\n" if ($VERBOSE);
      mkdir("$to/$dir",0755) ||
        die("[$PROGNAME] Couldn't make new directory [$to/$dir]\n");
    }
    do_dir("$from/$dir","$to/$dir","$new_back/$dir");
  }
}

##################################################
# Main code
##################################################
sub main {
  my ($from,$to) = parse_args();

  (-d $to) || mkdir("$to",0755) ||
    die("[$PROGNAME] Couldn't make new directory [$to]\n");

  # Figure out the path from $to to where $from is
  my $back;
  if (!$SYMBOLIC) {
    $back = "";		# Don't need to fixup path for hard links
  } elsif ($from =~ m|^/|) {
    $back = $from;
  } else {
    # Assume the last element is the destination
    my $to_path = $to;
    $to_path = $to_path || "/";
    usage("Can't find destination location [$to_path]") unless -d $to_path;
    my @from_path = split('/',abs_path($from));
    my @to_path = split('/',abs_path($to_path));
    # Find the highest common directory
    while ($from_path[0] eq $to_path[0]) { shift @from_path; shift @to_path; }
    # Go back for each element left in to_path
    $back = "../" x (@to_path);
    # And go up all the elements left in from_path
    $back .= join('/',@from_path);
  }

  do_dir($from,$to,$back);
}
main();