#!/usr/bin/perl

require 'getargs.pl';

$ShadowDir = '.';
$Verbose   = 0;

$SkipDefault = '^(RCS|SCCS|CVS)$';
$Skip        = $ENV{ 'SHADOWSKIP' } || $SkipDefault;
$TreeOnly    = 0;

$Usage = <<_HELP_MESSAGE_;

    Makes a 'shadow' copy (named 'shadowdir', if specified - in the 
    current directory if not) of 'realdir'.  For each directory under 
    'realdir', a directory with the same name is created in the shadow; 
    for each non-directory object under 'realdir', a symbolic link to
    it is created in the equivalent place in the shadow.

    The --treeonly option causes only the directory structure to be 
    copied; no symbolic links are created or modified.

    This will relink existing symbolic links, but will not affect any 
    real file system objects under an existing directory.  Names of 
    these pre-existing real objects in the shadow will be printed if 
    the 'verbose' option is specified.

    Normally invisible files or directories (ones whose name begins 
    with '.') are not shadowed.

    You may specify other names to be skipped with the '--skip' option; 
    the argument specifies a perl regular expression.  The default,
    '(RCS|SCCS|CVS)', will skip objects named 'RCS', 'SCCS', or 
    'CVS'.  This default is overridden by the environment variable 
    'SHADOWSKIP'.

    By default, a link named '.LINK' to 'realdir' is created in the 
    shadow, and all links in the shadow are made through that link (which 
    provides an easy way to switch between 'real' directories for a shadow).
    This link name may be changed with the 'linkname' option, or you 
    can create direct links for each object by specifying the 'direct' 
    option.

_HELP_MESSAGE_

&getargs( '-', 'v|verbose',  0, 'Verbose'
         ,'-', 'd|direct',   0, 'DirectLinks'
         ,'-', 't|treeonly', 0, 'TreeOnly'
         ,'-', 'l|linkname', 1, 'LinkName'
         ,'-', 's|skip',     1, 'Skip'
         ,'m', 'realdir',    1, 'RealDir'
         ,'o', 'shadowdir',  1, 'ShadowDir'
         ,'h', '',           0, 'Usage'
         ) || exit 1;

if ( defined( $Help ) )
{
    print     exit 0;
}

die "Cannot specify both '--direct' and '--linkname'\n"
    if defined( $DirectLinks ) && defined( $LinkName );

$DirectLinks = 0 
    unless defined( $DirectLinks );

$LinkName = '.LINK' 
    unless defined( $LinkName );

$RealDir   =~ s|/$||;
$ShadowDir =~ s|/$||;

die "Invalid directory name '$RealDir'\n"
    unless $RealDir =~ m|[-\w+./]+|;

die "Real directory may not be a relative path name\n"
    unless $RealDir =~ m|^/|;

die "Invalid directory name '$ShadowDir'\n"
    unless $ShadowDir =~ m|[-\w+./]+|;

die "'$LinkName' is not allowed as a  symbolic link name\n"
    unless $LinkName =~ m|[-\w.+]+|;

die "'$RealDir' is not a directory\n"
    unless -d $RealDir;

die "Cannot read directory '$RealDir'\n"
    unless -r $RealDir;

&Warn( "RealDir '$RealDir'\nShadowDir '$ShadowDir'\n" );

if ( ! -d $ShadowDir )
{
    die "'$ShadowDir' is not a directory\n"
        if -e _;

    mkdir( $ShadowDir, 0777 )
        || die "Can't create '$ShadowDir':\n\t$!\n";

    if ( ! $DirectLinks && ! $TreeOnly )
    {
        $_ = "$ShadowDir/$LinkName";

        symlink( $RealDir, $_ )
            || die "Can't create symlink '$_':\n\t$!\n";
    }                   
}
else
{
    die "Cannot write in '$ShadowDir'\n"
        unless -w _;

    if ( ! $DirectLinks && ! $TreeOnly )
    {
        $_ = "$ShadowDir/$LinkName";
        if ( -l )
        {
            if ( readlink ne $_ )
            {
                unlink $_
                    || die "Can't replace '$_':\n\t$!\n";

                symlink( $RealDir, $_ )
                    || die "Can't create symlink '$_':\n\t$!\n";
            }
        }
        elsif ( -e "$ShadowDir/$LinkName" ) 
        {
            die "'$_' already exists and is not a symbolic link\n";
        }                          
        else 
        {
            symlink( $RealDir, $_ )
                || die "Can't create symlink '$_':\n\t$!\n";
        }
    }
}

$DownPath = '';
$UpPath   = '.';             

&shadowDir( $RealDir, $ShadowDir );

exit 0;

sub shadowDir #
{
    local( $RealPath, $ShadowPath ) = @_[0..1];
    local( @Objects );

    $RealPath =~ s|//|/|;

    opendir( THISDIR, $RealPath )
        || die "Can't open directory '$RealPath':\n\t$!\n";
    @Objects = readdir THISDIR;
    closedir THISDIR;

    foreach ( @Objects )
    {
        /^\./ && next;
        
        if (   ( -l "$RealPath/$_" )
            || ( /$Skip/o )
            )
        {
            &mkLink( $_ );
        }
        elsif ( -d "$RealPath/$_" )
        {
            &descendInto( $_ );
            &shadowDir( "$RealPath/$_", "$ShadowPath/$_" );
            &returnFrom( $_ );
        }
        else
        {
            &mkLink( $_ );
        }
    }
}

sub descendInto # $SubDir
{
    local( $SubDir ) = $_[0];
    local( $Dir );

    ( $Dir = "$ShadowDir/$DownPath/$SubDir" ) =~ s|//|/|g;

    -d $Dir || mkdir( $Dir, 0777 )
        || die "Failed to create subdirectory '$Dir'\n \t$!\n";

    ( $DownPath = "$DownPath/$SubDir"  )  =~ s|^/||;
    ( $UpPath   = "../$UpPath" )          =~ s|/$||;
}

sub returnFrom # $SubDir
{
    local( $SubDir ) = $_[0];

    $DownPath =~ s|/?$SubDir$||
        || die "Internal Error - invalid DownPath '$DownPath'";

    $UpPath   =~ s|^\.\./?||
        || die "Internal Error - invalid UpPath '$UpPath'";
}

sub mkLink # Object 
#! uses globals $DownPath $UpPath $LinkName $RealDir $ShadowDir
{
    local( $Object ) = $_[0];
    local( $Target, $Path, $Link );

    if ( ! $TreeOnly )
    {
        ( $Link   = "$ShadowDir/$DownPath/$Object" ) =~ s|//|/|;
        ( $Target = "$RealDir/$DownPath/$Object" )   =~ s|//|/|;

        if ( -e $Link && ! -l $Link )
        {
            &Warn( "\t '$Link' already exists\n" );
            return;
        }
        elsif ( -l $Link )
        {
            unlink $Link
                || &Warn( "Unable to replace '$Link':\n\t$!\n" );
        }

        $Path = ( $DirectLinks 
                 ? "$RealDir/$DownPath/$Object"
                 : "$UpPath/$LinkName/$DownPath/$Object"
                 );
        $Path =~ s|//|/|;
        $Path =~ s|/$||;

        symlink( $Path, $Link )
            || die 
                "Failed trying to create '$Link':\n\t$!\n";
    }
}

sub Warn
{
    warn @_ if $Verbose;
}