#!/usr/bin/perl -w
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#NAME
#  linkfrom - Link files from subdirectories
#
#SYNOPSIS
#  linkfrom [dir/file]..
#
#REQUIRES
#
#DESCRIPTION
# Given files in subdirectories with names of the  form  dir/name.suff,  this
# program  links  them to the current directory with the names name_dir.suff,
# first checking to see that the link hasn't already been done.
#
# It is espected that the dir name will be a (perhaps cryptic) name  for  the
# source  of the files in that directory.  This program links such files into
# the current directory with that source info appended to the file name, just
# before the type suffix.
#
# Target files will be deleted and replaced with a link. By default, the "ln"
# commands  are  shown,  and the overwritten files are indicated by a "ln -f"
# command, showing what happened.  But this is a bit subtle and can easily be
# overlooked.
#
#OPTIONS
# No options yet.
#
#EXAMPLES
#   linkfrom 18*/[A-Z]*.abc
# The directories are named for the year of publication; the  files  will  be
# linked  into  the  current  directory  with  the year in the file name just
# before .abc suffix.
#
#   linkfrom jig/[A-Z]*.abc
# Subdirectories are named for dance rhythms; the files in the jig  directory
# will  be linked into the current directory with "_jig" appended to the name
# (before the ".abc").
#
#FILES
#
#BUGS
#
#SEE ALSO
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu> 2013-07-03
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

$| = 1;
$exitstat = 0;
($P = $0) =~ s".*/"";
$V = $ENV{"V_$P"} || $ENV{"D_$P"} || 1;	# Verbose level.

for $arg (@ARGV) {
	print "$P: arg=\"$arg\"\n" if $V>1;
	unless (-f $arg) {
		print "$P: arg=\"$arg\" doesn't exist.\n" if $V>1;
		next;
	}
	if (($dir,$nam,$suf) = ($arg =~ m"^([^/]+)/(.*)\.(\w+)$")) {
		&onefile($arg,$dir,$nam,$suf);
	} else {
		print "$P: arg=\"$arg\" not parsed.\n" if $V>1;
		next;
	}
}

print "$P: Exit with status $exitstat.\n" if $V>1;
exit $exitstat;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

sub onefile {
	local($p,$d,$n,$s) = @_;
	local($d1,$i1,$d2,$i2);	# device/inode numbers
	local($f) = $n . '_' . $d . '.' . $s;
	print "$F: f=\"$f\"\n" if $V>1;
	if (-f $f) {	# Does the target file exist?
		$d1 = $i1 = $d2 = $i2 = 0;	# device/inode numbers
		($d1,$i1) = stat($p);
		($d2,$i2) = stat($f);
		print "$F: d1=$d1 i1=$i1 p=\"$p\"\n" if $V>2;
		print "$F: d2=$d2 i2=$i2 f=\"$f\"\n" if $V>2;
		if ($d1 == $d2 && $i1 == $i2) {
			print "$F: Target '$f' exists, same as '$p'.\n" if $V>2;
			print "$F: Linked '$p' -> '$f' already.\n" if $V>1;
			return;
		} else {
			print "$F: Target '$f' exists, different than '$p'.\n" if $V>2;
			print "ln -f '$p' '$f'\n" if $V>0;
			system "/bin/ln -f '$p' '$f'";
			print "$F: Link gave \"$?\"\n" if $V>1;
		}
	} else {
		print "$F: Target '$f' does not exist.\n" if $V>2;
		print "ln '$p' '$f'\n" if $V>0;
		system "/bin/ln '$p' '$f'";
		print "$F: Link gave \"$?\"\n" if $V>1;
		
	}
}