#!/usr/bin/env perl
# sym -- create relative symlinks
#
# 2024-xx-xx grawity: This is mostly obsoleted by `ln -rs` on modern Linux.

use warnings;
use strict;
use Cwd qw(realpath);
use File::Basename;
use File::Spec;
use Getopt::Long qw(:config bundling no_ignore_case);

BEGIN {
	if (eval {require Nullroute::Lib}) {
		Nullroute::Lib->import(qw(_debug _warn _err _die));
	} else {
		$::arg0 = basename($0);
		$::debug = !!$ENV{DEBUG};
		$::warnings = 0;
		$::errors = 0;
		sub _debug { warn "debug: @_\n" if $::debug; }
		sub _warn  { warn "warning: @_\n"; ++$::warnings; }
		sub _err   { warn "error: @_\n"; ! ++$::errors; }
		sub _die   { _err(@_); exit 1; }
	}
}

my $force = 0;
my $verbose = 0;
my $dry_run = 0;
my $link_dir;
my $no_deref = 0;
my $realpath = 0;
my $absolute = 0;

sub collapse {
	my ($path) = @_;
	my @path = File::Spec->splitdir($path);
	my @out;
	for (@path) {
		if ($_ eq "..")    { pop @out; }
		elsif ($_ eq ".")  { next; }
		else               { push @out, $_; }
	}
	File::Spec->catdir("", @out);
}

sub do_link {
	my ($target, $link) = @_;

	print "'$link' -> '$target'\n" if $verbose;

	return if $dry_run;

	if ($force && (-l $link || -e $link)) {
		_debug("removing existing \"$link\"");
		unlink($link) or return _err("could not remove \"$link\": $!");
	}

	_debug("creating \"$link\" (target: \"$target\")");
	symlink($target, $link) or return _err("could not create \"$link\": $!");
}

sub usage {
	print "$_\n" for
	"Usage: $::arg0 [-fv] TARGET LINKNAME",
	"       $::arg0 [-fv] TARGET... DIRECTORY",
	"       $::arg0 -R FILE...  ('realpath' emulation)",
	"       $::arg0 -RR FILE... ('realpath -m' emulation)",
	"",                       #
	"  -f, --force            Remove existing destination links",
	"  -v, --verbose          Print each link being created",
	"",
	"  -R, --realpath         Only dereference and print the given paths",
}

# Option parsing

GetOptions(
	"help"			=> sub { usage(); exit; },
	"a|absolute"		=> \$absolute,
	"f|force!"		=> \$force,
	"n|no-dereference"	=> \$no_deref,
	"R|realpath+"		=> \$realpath,
	"r|relative"		=> sub { },
	"s|symbolic"		=> sub { },
	"t|target-directory=s"	=> \$link_dir,
	"v|verbose!"		=> \$verbose,
	"dry-run!"		=> \$dry_run,
) or exit 2;

$verbose ||= $dry_run;

# Main code (realpath mode)

if ($realpath > 1) {
	# `/usr/bin/realpath -m` emulation mode
	for my $file (@ARGV) {
		my $real = realpath($file);
		if (!defined $real) {
			if (-l $file) {
				$file = readlink($file);
				if (!defined $file) {
					_err("readlink: '$file': $!");
					next;
				}
			}
			$real = File::Spec->rel2abs($file);
			$real = collapse($real);
		}
		print "$real\n";
	}
	exit !!$::errors;
}
elsif ($realpath > 0) {
	# `/usr/bin/realpath` emulation mode
	for my $file (@ARGV) {
		my $real = realpath($file);
		if (!defined $real) {
			_err("realpath: '$file': $!");
			next;
		}
		print "$real\n";
	}
	exit !!$::errors;
}

# Main code (normal mode)

my $link_dest;
my $dest_is_dir;

if (defined $link_dir) {
	_debug("\$link_dir (--target) given: '$link_dir'");

	if (!-d $link_dir) {
		_die("destination \"$link_dir\" is not a directory");
	}

	$dest_is_dir = 1;

	_debug("link parent directory: \"$link_dir\"");
}
else {
	_debug("\$link_dir not given, trying to guess");

	if (@ARGV > 1) {
		_debug("more than one arg; taking the last item as destination");
		$link_dest = pop(@ARGV);
	} else {
		_debug("only one arg; assuming . as destination");
		$link_dest = ".";
	}

	if (-l $link_dest && $no_deref) {
		$dest_is_dir = 0;
	} elsif (-d $link_dest || $link_dest =~ m|/$|) {
		$dest_is_dir = 1;
	} else {
		$dest_is_dir = 0;
	}

	if ($dest_is_dir) {
		$link_dir = $link_dest;
	} elsif (@ARGV > 1) {
		_die("destination \"$link_dest\" is not a directory");
	} else {
		$link_dir = dirname($link_dest);
	}

	_debug("\$link_dir guessed: '$link_dir'");
}

# Resolve all symlinks in the target path

my $abs_dir = realpath($link_dir);
if (!defined $abs_dir) {
	_die("destination \"$link_dir\" could not be resolved");
}
$link_dir = $abs_dir;
_debug("\$link_dir converted to absolute path: '$link_dir'");

# Create the links

if (!@ARGV) {
	_die("missing link target(s)");
}

for my $target (@ARGV) {
	my $abs_target;
	my $rel_target;
	my $link_name;

	_debug("* arg (target): \"$target\"");
	#$abs_target = File::Spec->rel2abs($target);
	$abs_target = realpath($target);
	_debug("    - absolute: \"$abs_target\"");
	$rel_target = File::Spec->abs2rel($target, $link_dir);
	_debug("    - relative: \"$rel_target\"");

	if (defined $link_dest && !$dest_is_dir) {
		_debug("  link name <- link_dest");
		$link_name = $link_dest;
	} else {
		_debug("  link name <- basename(rel_target)");
		$link_name = File::Spec->catfile($link_dir, basename($rel_target));
	}
	_debug("  link name: \"$link_name\"");

	do_link($absolute ? $abs_target : $rel_target, $link_name);
}

exit !!$::errors;
