#!/usr/bin/env perl
use warnings;
use strict;
use File::Basename 'fileparse';
use Cwd qw/getcwd abs_path/;
use File::Spec::Functions qw/ splitdir catdir catfile
	file_name_is_absolute rel2abs rootdir /;
use String::ShellQuote 'shell_quote';
use Graph;

my @queue = @ARGV;

# gather all dirs, files, and links
my (%dirs,%files,%links);
while ( my $targ = shift @queue ) {
	$targ = rel2abs($targ);
	die "does not exist: $targ" unless -e $targ;
	my @path = splitdir($targ);
	for my $i (1..$#path) {
		my $cur = catdir(@path[0..$i]);
		if ( -l $cur ) {
			defined( $links{$cur} = readlink($cur) )
				or die "readlink $cur: $!";
			# enqueue everything in the link chain
			# (excluding already seen symlinks)
			push @queue, grep { !$links{$_} } resolvesymlink($cur);
		}
		elsif ( -f $cur ) { $files{abs_path($cur)}++ }
		elsif ( -d $cur ) { $dirs{abs_path($cur)}++ }
		else { warn "skipping $cur, unknown type" }
	}
}

# simplify the dirs to shorten the mkdir command
my $dg = Graph->new;
for my $d (keys %dirs) {
	my @s = splitdir($d);
	$dg->add_edge(catdir(@s[0..$_]), catdir(@s[0..$_-1])) for 1..$#s;
}
# exterior vertices = leaves of the tree
my @dirs = grep { $_ ne rootdir } sort $dg->exterior_vertices;
print "mkdir -p ",shell_quote(@dirs),"\n" if @dirs;

# output the files
print "touch ",shell_quote(sort keys %files),"\n" if %files;

# determine dependencies in symlinks via a topological sort
my $lg = Graph->new;
for my $l (keys %links) {
	my @res = resolvesymlink($l);
	die "unexpected resolvesymlink($l)" if @res<2;
	$lg->add_edge($l, $res[1]); # link depends on its target
	my @s = splitdir($l);
	for my $i (reverse 1..$#s-1) {
		my $d = catdir(@s[0..$i]);
		# if there's a link in the paths, this link depends on it too
		$lg->add_edge($l, $d) if defined $links{$d};
	}
}
my @links = reverse grep { defined $links{$_} } $lg->topological_sort;
print "ln -snf ",shell_quote($links{$_}, $_),"\n" for @links;

# from https://bitbucket.org/haukex/htools/src/master/relink (a500e09)
sub resolvesymlink {
	my $file = shift;
	die "not absolute: $file" unless file_name_is_absolute($file);
	my @files;
	my $origwd = getcwd;
	my $rv = eval { # in eval so orig working dir is always restored
		my $f = $file;
		while (1) {
			my $dir;
			($f,$dir) = fileparse($f);
			last unless -d $dir;
			chdir $dir or die "chdir $dir: $!";
			push @files, catfile(getcwd,$f);
			last unless -l $f;
			defined( $f = readlink $f )
				or die "readlink $f (cwd=".getcwd."): $!";
		}
	1 }; my $err = $@||'unknown error';
	chdir $origwd or die "chdir $origwd: $!";
	die $err unless $rv;
	return @files ? @files : ($file);
}

__END__

mkdir -p /tmp/bar /tmp/foo
touch /tmp/foo/one
ln -snf /tmp/bar /tmp/foo/quz
ln -snf ../foo/one /tmp/bar/two
ln -snf ../foo/quz /tmp/bar/baz
ln -snf ../foo/one /tmp/bar/baz/two