##---------------------------------------------------------------------------##
##  @(#) Shadow.pm 1.4 97/04/18 16:13:30 @(#)
##
##  Author:
##      Earl Hood       ehood@medusa.acs.uci.edu
##  Description:
##      A module for shadowing a directory structure via symbolic
##	links.
##---------------------------------------------------------------------------##
##    Copyright (C) 1997        Earl Hood, ehood@medusa.acs.uci.edu
##
##    This program is free software; you can redistribute it and/or modify
##    it under the terms of the GNU General Public License as published by
##    the Free Software Foundation; either version 2 of the License, or
##    (at your option) any later version.
##
##    This program is distributed in the hope that it will be useful,
##    but WITHOUT ANY WARRANTY; without even the implied warranty of
##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##    GNU General Public License for more details.
##
##    You should have received a copy of the GNU General Public License
##    along with this program; if not, write to the Free Software
##    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##---------------------------------------------------------------------------##

package Shadow;

use Exporter ();
@ISA = qw( Exporter );
@EXPORT = qw( &shadow_dir 
	    );  

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

$pwd_prg = '/bin/pwd';	# Program to get current working directory

##---------------------------------------------------------------------------##
##	shadow_dir mirrors a directory structure via symbolic links.
##
##	Arguments:
##	    $in_src	: Source directory to shadow.  If not
##			  absolute, the return value of pwd(1)
##			  is prepended.
##	    $in_dst	: Destination directory.  The directory
##			  must exist, and it does not need to be
##			  an absolute path.
##	    $in_prune	: List of directories to prune on when
##			  shadowing.  A symlink will be made to
##			  the directory, and it will not be
##			  descended.
##	    $in_quiet	: Do not print progress.  Errors and warnings
##			  are still printed.
##	    $in_yesall	: Assume "yes" to all questions.
##
##	Return:
##	    1 if no error.
##	    0 if error.
##
sub shadow_dir {
    my $in_src = shift;
    my $in_dst = shift;
    my $in_prune = shift;
    my $in_quiet = shift;
    my $in_yesall = shift;

    ## Define "local" globals for recursive routine
    local(%Prune) = ();
    local($Quiet) = ($in_quiet);
    local($YesAll) = ($in_yesall);

    @Prune{@{$in_prune}} = (1) x scalar(@{$in_prune})  if $in_prune;

    ## Check is $in_src is relative
    if ($in_src !~ m|^/|) {
	my $pwd = `$pwd_prg`;
	chomp $pwd;
	$in_src = "$pwd/$in_src";
    }

    ## We actual call a private routine so we can catch dies from
    ## a nested recursive call.

    eval {
	_shadow_dir($in_src, $in_dst);
    };
    $@ ? 0 : 1;
}

##---------------------------------------------------------------------------##
sub _shadow_dir {
    my $src = shift;		# Source directory
    my $dst = shift;		# Destination directory

    my(@files) = ();
    my(%files) = ();

    if (! -d $src) {
	die "Error: $src is not a directory, or does not exist\n";
    }
    if (! -d $dst) {
	die "Error: $dst is not a directory, or does not exist\n";
    }
    if (!opendir(DIR, $src)) {
	warn "Warning: Unable to open $src\n";
	return 0;
    }
    @files = readdir(DIR);
    closedir(DIR);

    ## The hash is currently not required, but may be useful if
    ## simple filename exclusion needs to be added.

    @files{@files} = (1) x scalar(@files);
    delete $files{'.'};
    delete $files{'..'};

    my($srcfile, $dstfile, $srcmod, $dstmod, $slink);
    LOOP: foreach $file (keys %files) {
	$srcfile = "$src/$file";
	$dstfile = "$dst/$file";

	if (-l $dstfile) {
	    if (! -e ($slink = readlink($dstfile))) {
		next  LOOP
		    unless $YesAll or
			   &_confirm("$dstfile appears to point to a " .
				     "nonexistent file\n\t$slink. Remove?");
		if (!unlink($dstfile)) {
		    warn "Warning: Unable to remove $dstfile\n";
		    next LOOP;
		}
	    }
	    next LOOP;
	}

	$srcmod = (stat($srcfile))[9];
	if (-e $dstfile) {
	    $dstmod = (stat($dstfile))[9];
	} else {
	    $dstmod = 0;
	}

	BLK1: {
	    if (-d $srcfile) {
		last BLK1  if defined($Prune{$file}) or -l $srcfile;

		if (-e $dstfile or mkdir($dstfile, 0777)) {
		    print STDOUT "$dstfile\n"  unless $Quiet;
		    &_shadow_dir($srcfile, $dstfile)
			unless defined($Prune{$file});
		} else {
		    warn "Warning: Unable to create $dstfile\n"
		}
		next LOOP;
	    }
	}

	next LOOP  if $dstmod >= $srcmod;	# Next if dst newer than src
	next LOOP  if -d $dstfile;		# Next if dst a directory

	if ($dstmod) {
	    next  LOOP unless $YesAll or
			      &_confirm("$srcfile is newer than\n" .
				        "\t$dstfile, replace?");
	    if (!unlink($dstfile)) {
		warn "Warning: Unable to remove $dstfile\n";
		next LOOP;
	    }
	}
	if (!symlink($srcfile, $dstfile)) {
	    warn "Warning: Unable to create link: $dstfile -> $srcfile\n";
	} else {
	    print STDOUT "$dstfile -> $srcfile\n"  unless $Quiet;
	}
    }
    1;
}

##---------------------------------------------------------------------------##
sub _confirm {
    my $txt = shift;

    print STDOUT "$txt [y] ";
    $_ = <STDIN>;
    s/\s//g;
    return 1  unless $_;
    return 1  if (/^y/i);
    0;
}

##---------------------------------------------------------------------------##
1;