#!/usr/bin/perl
# Filename:	lnR
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License
  my $VERSION=	1.02;
# Description:	Recursively links a bunch of files with a matching dir structure
# 		Can keep a "history" so you can remove files from the new
# 		link structure and not have them relinked when you run again.
# Inspiration:	For history: Brett Stauffer <jargoone -at- hotmail>
use strict;

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

my $HISTORY_FILE = ".$PROGNAME.manifest";

umask 022;      # 0755

use Cwd qw(abs_path getcwd);

##################################################
# Usage
##################################################
sub usage {
  my $msg;
  foreach $msg (@_) { print STDERR "ERROR:  $msg\n"; }
print STDERR <<USAGE;

Usage:\t$PROGNAME <from> <to>
  Recursively copy a bunch of directories, using links for files
  -ignore          Files/dirs matching this regexp will be ignored
  -s               Use symbolic links
  -v               Verbose
  -history         Keep history (so you can remove 'to' portions and run again)
  -history=<file>  Name the history file
  
  Use absolute path for 'from' if you want absolute links for -s

USAGE
  exit -1;
}

sub parse_args {
  my ($from,$to,%opt);
  while ($#ARGV>=0) {
    my $arg=shift(@ARGV);
    if ($arg =~ /^-h$/) { usage(); }
    if ($arg =~ /^-v$/) { $opt{verbose}=1; next; }
    if ($arg =~ /^-s/) { $opt{symbolic}=1; next; }
    if ($arg =~ /^-ignore/) { $opt{ignore}=shift(@ARGV); next; }
    if ($arg =~ /^-history(=(.+))?/) { $opt{history}= $2 ? $2 : $HISTORY_FILE; 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;

  (\%opt,$from,$to)
}

##################################################
# Manifest/history file
##################################################
sub read_manifest {
  my ($opt, $from, $to) = @_;
  return unless $opt->{history};

  open(MAN,"<$to/$opt->{history}") || return;
  while (<MAN>) {
    chomp;
    $opt->{manifest}{old}{$_}=1;
  }
  close MAN;
}

sub write_manifest {
  my ($opt, $from, $to) = @_;
  return unless $opt->{history};

  open(MAN,">$to/$opt->{history}")
    || return print STDERR "[$PROGNAME] WARNING: Couldn't write [$to/$opt->{history}]\n";
  foreach my $f ( keys %{$opt->{manifest}{new}} ) {
    print MAN "$f\n";
  }
  close MAN;
}

##################################################
# Handle a directory
##################################################
# Figure out the path from $to to where $from is
sub back {
  my ($opt,$from,$to) = @_;

  # Don't need to fixup path for hard links
  return "" if !$opt->{symbolic};

  # Absolute paths
  return $from if $from =~ m|^/|;

  # 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] && @from_path) { shift @from_path; shift @to_path; }
  # Go back for each element left in to_path
  my $back = "../" x (@to_path);
  # And go up all the elements left in from_path
  $back . join('/',@from_path);
}

sub do_dir {
  my ($opt, $from, $to, $back) = @_;

  print "do_dir $from -> $to\n" if $opt->{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(!/$opt->{ignore}/,@from) if $opt->{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 $opt->{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 $opt->{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 ) {
    my $to_link = "$to/$link";

    # Add to the history manifest
    next if $to_link eq "$to/$opt->{history}";
    $opt->{manifest}{new}{$to_link}=1;

    # Skip it..
    next if -l $to_link;
    if (-e $to_link) {
      print STDERR "[$PROGNAME] Warning: File exists [$to_link]\n";
      next;
    }

    # History skip - it was in the manifest, so we saw it already,
    # but it isn't in the 'to' hierarchy, so they removed it
print STDERR "[$PROGNAME] Skipping removed file [$to_link]\n" if $opt->{manifest}{old}{$to_link};
    print STDERR "[$PROGNAME] Skipping removed file [$to_link]\n"
      if $opt->{manifest}{old}{$to_link} && $opt->{verbose};
    next if $opt->{manifest}{old}{$to_link};

    if ($opt->{symbolic}) {
      print "Link $back/$link -> $to\n" if $opt->{verbose};
      print STDERR "[$PROGNAME] Couldn't link [$to_link]\n"
        unless symlink("$back/$link",$to_link);
    } else {
      print "Link $from/$link -> $to\n" if $opt->{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 ) {
    my $to_dir = "$to/$dir";

    # Add to the history manifest
    $opt->{manifest}{new}{$to_dir}=1;

    if (!-d $to_dir) {
print STDERR "[$PROGNAME] Skipping removed dir [$to_dir]\n" if $opt->{manifest}{old}{$to_dir};
      # History skip (see above)
      print STDERR "[$PROGNAME] Skipping removed dir [$to_dir]\n"
        if $opt->{manifest}{old}{$to_dir} && $opt->{verbose};
      next if $opt->{manifest}{old}{$to_dir};

      print "mkdir $to_dir\n" if $opt->{verbose};
      mkdir($to_dir,0755) ||
        die("[$PROGNAME] Couldn't make new directory [$to_dir]\n");
    }
    do_dir($opt,"$from/$dir",$to_dir,"$new_back/$dir");
  }
}

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

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

  read_manifest($opt, $from, $to);
  do_dir($opt, $from, $to, back($opt, $from, $to));
  write_manifest($opt, $from, $to);
}
main();