#!/usr/bin/perl

# see lndir for an older linkfarm implementation (it just needs more
# configurability and doesn't automatically give you absolute links.)

# translates between svn_hop directory and @INC directory by way of
# creating symlinks.

# Expects a pair of toplevel directories:

# TODO perldoc and more configurability, option parsing, etc.
# TODO make a package and get it on CPAN?
# TODO how to move the refered-to source directories?

use Getopt::Long; GetOptions(
  'r|relative!' => \(my $relative = 0),
  's|shorten=i', => \(my $shorten),
);

my ($from_dir, $dest_dir) = @ARGV;
foreach my $dir ($from_dir, $dest_dir) {
  $dir || usage();
  (-d $dir) || usage();
}
$dest_dir = abs_path($dest_dir);
$dest_dir =~ s#/*$#/#;

########################################################################
sub usage {
  print "usage:\n";
  $caller = $0;
  $caller =~ s#.*/##;
  print "\t$caller <from directory> <to directory>\n";
  exit;
} # end subroutine usage definition
########################################################################

my $namesub;

if(defined($shorten)) {
  ($shorten < 8) and warn "$shorten is insanely short";
  my $dbg = 0;
  # We need to localize the uniqueness and lookup maps based on which
  # branch of the tree we're in currently.
  my %trackmaps;
  my %shortmaps;
  $namesub = sub {
    my ($name) = @_;
    my $outpath = '';
    my $trackpath = '';
    my @parts = split(/\/+/, $name);
    foreach my $part (@parts) {
      my $nmap = $trackmaps{$trackpath} ||= {};
      my $smap = $shortmaps{$trackpath} ||= {};
      $dbg and warn "map for $trackpath -- ", join("|", keys(%$nmap));
      my $orig = $part;
      #warn "start with $orig";
      my $output = sub {
        my ($n) = @_;
        #warn "save $trackpath/$orig -> $n";
        $outpath .= "/$n";
        $trackpath .= "/$orig"; # where we were
      };
      if($nmap->{$part}) {
        #warn "I know $trackpath/$part already";
        $output->($nmap->{$part});
        next;
      }
      $dbg and warn "have $part";
      if(length($part) <= $shorten) { # no need to shorten
        $output->($nmap->{$part} = $part);
        next;
      }
      # shorten it
      my $ext = '';
      if($part =~ s/(\.[^.]{3,4})$//) {
        $ext = $1;
      }
      $dbg and warn "got $part, $ext";
      $part = substr($part, 0, $shorten - length($ext)) . $ext;
      $dbg and warn "made $part";
      # check for duplicates
      if($count = $smap->{$part}) {
        $smap->{$part}++;
        # this makes it too long, but we're already in stupid land
        $part = substr($part, 0, $shorten - length($ext)) .
          "~$count" . $ext;
      }
      else {
        $smap->{$part} = 1;
      }
      $output->($nmap->{$orig} = $part);
    } # end foreach part
    $dbg and warn "now $outpath";
    return($outpath);
  };
}

use File::Path;
use File::Spec::Functions qw(abs2rel rel2abs);
use File::Basename;
use File::Find;
use Cwd qw(abs_path);

# find all files under the from path
my @found;
find({follow => 1, wanted => sub {
  ($File::Find::name =~ m#/.svn/#) and return();
  ($File::Find::name =~ m#/CVS/#) and return();
  ($_ =~ m/^\./) && return();
  unless(-d $_) {
    push(@found, $File::Find::name);
  }
}}, $from_dir);
@found or die "no files found in $from_dir\n";

# should also have a way of cleaning up after ourselves (based on the
# contents of from_dir, unlink the files in dest_dir)

# toggle this based on the name with which we were called (clean_hop_links)
$creating = 1;
my $name = basename($0);
if($name =~ m/clean/) {
  $creating = 0;
}
my $rel_hop = abs2rel(abs_path($from_dir), $dest_dir);
foreach my $file (sort(@found)) {
  my $src = abs_path($file);
  if($relative) { # is like lndir now, but without .svn
    my $d_dir = abs2rel(dirname($src), $from_dir);
    ## warn "d_dir: $dest_dir/$d_dir\n";
    $src = abs2rel($src, $dest_dir . '/' . $d_dir);
    ## warn "src: $src\n";
  }
  my $dfile = abs2rel($file, $from_dir);
  # maybe switch the name
  $dfile = $namesub ? $namesub->($dfile) : $dfile;
  my $dest = $dest_dir . $dfile;
  if($creating) {
    0 and print "$file -> $dest\n";
    unless(-e $dest) {
      my $dir = dirname($dest);
      mkpath([$dir]);
      symlink($src, $dest) or die "cannot make link $dest";
    }
    else {
      warn "$dest already exists... skipping\n";
    }
  }
  else {
    if(-l $dest) {
      print "removing $dest\n";
      unlink($dest) or die "cannot clean link $dest";
    }
    elsif(-e $dest) {
      die "link is not link: $dest";
    }
  }
}


# vim:ts=2:sw=2:et:sta