#!/usr/bin/perl
#
#NAME
#  Ln - link with backup
#  Mv - move with backup
#
#SYNOPSIS
#
#REQUIRES
#
	push @INC, split(':',$ENV{'PATH'});
	require "Backup.pm";
#
#DESCRIPTION
#
#OPTIONS
#
#BUGS
#
#SEE ALSO
#
#AUTHOR
#  John Chambers <jc@trillian.mit.edu>

$| = 1;
$exitstat = 0;
($me = $0) =~ s".*/"";
$V = $ENV{"V_$me"} || $ENV{"D_$me"} || 1;
$buplim = 8;	# Limit to depth of backups.
%names = ('Cp' => 1, 'Ln' => 1, 'LN' => 1, 'Mv' => 1);

unless ($names{$me}) {
	print STDERR "$me: Don't recognize my own name.\n" if $V>0;
	exit 1;
}

$args = @ARGV;
print "$me: We have $args args.\n" if $V>1;
if ($args < 1) {
	print STDERR "Usage: $me file1 file2\n\t$me file... dir\n";
	exit 1;
}
if ($args < 2) {
	push @ARGV, '.';
}
@dirs = @files = ();

for $a (@ARGV) {
	if (-d $a) {
		push @dirs, $a;
	} else {
		push @files, $a;
	}
}
$files = @files;
$dirs  = @dirs;

if ($dirs < 1 && $files == 2) {
	$src = $files[0];
	$trg = $files[1];
	print "$me: \"$src\" to \"$trg\".\n" if $V>1;
	&DoIt($me,$src,$trg);
	exit $exitstat;
}

if ($dirs < 1 && $files != 2) {
	print "$me: Linking to . because no directories and $files files.\n" if $V>1;
	push @dirs, '.';
}

for $f (@files) {
	for $d (@dirs) {
		$src = $f;
		($g = $f) =~ s".*/"";
		($trg = "$d/$g") =~ s"^\./+"";
		&DoIt($me,$src,$trg);
	}
}

exit $exitstat;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#
sub DoIt {
	local($op,$src,$trg) = @_;
	if ($op eq 'Cp') {
		print "$me: Copy \"$src\" -> \"$trg\"\n" if $V>1;
		&Cp($src,$trg);
	} elsif ($op eq 'LN') {
		print "$me: Link \"$src\" -> \"$trg\"\n" if $V>1;
		&Ln($src,$trg);
	} elsif ($op eq 'Ln') {
		print "$me: Link \"$src\" -> \"$trg\"\n" if $V>1;
		&Ln($src,$trg);
	} elsif ($op eq 'Mv') {
		print "$me: Move \"$src\" -> \"$trg\"\n" if $V>1;
		&Mv($src,$trg);
	} else {
		print STDERR "$me: Don't recognize operation \"$op\".\n" if $V>0;
		$exitstat = 1;
	}
	return $exitstat;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Copy source file to target file.  Return 0 if successful, err code if not.
sub Cp {
	local($src,$trg) = @_;
	local($F) = "$me/Ln";
	print "$F: \"$src\" -> \"$trg\".\n" if $V>1;
	if (-f $trg) {
		$bdepth = 0;
		return $exitstat if &Backup($trg);
	}
	if (open(SRC,"<$src")) {				# Can we read the source file?
		if (open(TRG,">$trg")) {			# Can we write the target file?
			local($r,$w,$buffer,$bufsiz);	# Looks OK; proceed with copy.
			print "$F: linked \"$src\" -> \"$trg\".\n" if $V>1;
			$bufsiz = 10000;				# How big are our chunks?
			while (($r = sysread(SRC,$buffer,$bufsiz)) > 0) {
				unless (($w = syswrite(TRG,$buffer,$r)) == $r) {
					print STDERR "$F: Can't write \"$trg\" ($!)\n" if $V>0;
					$exitstat = int($!);	# Copy failed.
					close SRC;
					close TRG;
					return $exitstat;		# Abort the copy.
				}
			}
			close TRG;
		} else {
			print STDERR "$F: Can't write \"$trg\" ($!)\n" if $V>0;
			$exitstat = int($!);	# Copy failed.
		}
		close SRC;
	} else {
		print STDERR "$F: Can't read \"$src\" ($!)\n" if $V>0;
		$exitstat = int($!);	# Copy failed.
	}
	return $exitstat;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Link source file to target file.  Return 0 if successful, err code if not.
sub Ln {
	local($src,$trg) = @_;
	local($F) = "$me/Ln";
	print "$F: \"$src\" -> \"$trg\".\n" if $V>1;
	if (-f $trg) {
		$bdepth = 0;
		return $exitstat if &Backup($trg);
	}
	if (link($src,$trg)) {
		print "$F: linked \"$src\" -> \"$trg\".\n" if $V>1;
	} else {
		print STDERR "$F: Can't link \"$src\" -> \"$trg\" ($!)\n" if $V>0;
		$exitstat = int($!);	# Link to backup failed.
	}
	return $exitstat;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Move source file to target file.  Return 0 if successful, err code if not.
sub Mv {
	local($src,$trg) = @_;
	local($F) = "$me/Mv";
	print "$F: \"$src\" -> \"$trg\".\n" if $V>1;
	if (-f $trg) {
		$bdepth = 0;
		return $exitstat if &Backup($trg);
	}
	if (link($src,$trg)) {
		print "$F: linked \"$src\" -> \"$trg\".\n" if $V>1;
		if ($x = unlink($src)) {	# get rid of current name.
			print "$F: unlink(\"$src\") returned $x.\n" if $V>1;
		} else {
			print STDERR "$F: Can't unlink \"$src\" ($!)\n" if $V>0;
			$exitstat = int($!);	# Unlink failed.
		}
	} else {
		print "$F: Can't link \"$src\" -> \"$trg\" ($!)\n" if $V>1;
		if (&Cp($src,$trg)) {
			print STDERR "$F: Can't copy \"$src\" -> \"$trg\" ($!)\n" if $V>0;
			$exitstat = int($!);	# Unlink failed.
		} else {
			print "$F: Copied \"$src\" -> \"$trg\".\n" if $V>1;
			if ($x = unlink($src)) {	# get rid of current name.
				print "$F: unlink(\"$src\") returned $x.\n" if $V>1;
			} else {
				print STDERR "$F: Can't unlink \"$src\" ($!)\n" if $V>0;
				$exitstat = int($!);	# Unlink failed.
			}
		}
		$exitstat = int($!);	# Link to backup failed.
	}
	return $exitstat;
}

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