#!/usr/bin/perl

use File::Spec::Functions qw(
	abs2rel
	rel2abs
	file_name_is_absolute
	);
use File::Basename;

# XXX use Getopt::Helpful; (Except for the looped dependency!)
#     (e.g. relink hop_to_links ~/.bin is needed to setup Getopt::Helpful!)
# (get Module::Build::LiveInstall working?
# XXX solved with eval() in BEGIN{} ?
use Cwd qw(getcwd abs_path);
my $rel = 0;
our $verbose = 0;
use Getopt::Long;
GetOptions(
	'r|relative' => \$rel,
	) or usage("invalid options");

my ($target, $linkname) = @ARGV;

unless(($target and $linkname) and (-e $target)) {
	usage();
}
sub usage {
	print "usage:\n";
	$caller = $0;
	$caller =~ s#.*/##;
	print "\t$caller <target> <linkname>\n";
	print "recreates symlinks without having to delete existing links" ,
			" and specify absolute paths\n";
	exit;
} # end subroutine usage definition
########################################################################

# XXX needs to not dereference linked files
$target = abs_path($target) unless $rel;

# try to behave like ln:
if((-d $linkname) and (! -d $target)) {
	# get basename
	my $base = basename($target);
	$linkname =~ s#/*$#/#;
	$linkname .= $base;
	## print "changed linkname: $linkname\n";exit;
}
# XXX some other error-checking would be good at this point, and there are
# other features of ln which are not supported here (such as creating a
# symlink to a directory inside of a directory.)


if($rel) {
	# fancier stuff here...
	my $ret_dir = getcwd();
	my $link_dir = dirname($linkname);
	chdir($link_dir) or die "ack!";
	## warn "link is going to be in $link_dir\n";
	0 and warn "$target\n";
	$target = abs2rel(
		file_name_is_absolute($target) ? $target : "$ret_dir/$target"
		);
	0 and warn "$target\n";
	chdir($ret_dir) or die "ack!";

}
## print "aiming at $target\n";

if(-l $linkname) {
	# check the current target:
	my $was_target = readlink($linkname);
	if(file_name_is_absolute($was_target)) {
		# this is just to get the trailing slash handled:
		# (and to cleanup ../foo/../foo/ paths?
		$was_target = abs_path($was_target);
		if($was_target eq $target) { # XXX not true in relative mode!
			print "no change\n";
			exit;
		}
	}
	$verbose and print "- $linkname -> $was_target\n";
	unlink($linkname) or die "cannot unlink $linkname\n";
}
else {
	(-e $linkname) and die "$linkname is not a link\n";
}
# at this point, we just do the link
symlink($target, $linkname) or die "cannot create $linkname\n";
$verbose and print "+ $linkname -> $target\n";