::
:: Рекурсивно создает жесткие ссылки для всех файлов в директории.
:: Это очень удобно для разделения одних и тех же библиотек между
:: разными проектами. (Создавать символьные ссылки на целые директории
:: нельзя, потому что большинство программ не понимают символьных
:: ссылок и начинают рекурсивно удалять содержимое директорий, когда
:: кто-то удаляет символьную ссылку.)
::
:: Например:
::   j path\to\src .
:: Создаст в текущей директории поддиректорию src, в ней создаст все
:: вложенные поддиректории, и в каждой из них создаст жесткие ссылки
:: (junction) для соответствующих файлов из path\to\src.
::
:: Должен быть установлен модуль Perl Win32::Hardlink.
::

@echo off
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
exit;
#!perl -w
#line 6
#########################################################################
use File::Basename;
my $src = $ARGV[0] or usage();
my $dst = $ARGV[1] || basename($src);

junction($src, $dst);

sub junction {
        my ($src, $dst) = @_;
        if (!-e $src) {
                die "$src does not exist\n";
        }
        # File?
        if (-f $src) {
                if (-e $dst && !-f $dst) {
                        warn "Conflict: -f $src -> !-f $dst\n";
                        return;
                }
                if (-f $dst) {
                        print "f $src -> $dst\n";
                        return;
                } else {
                        print "l $src -> $dst ";
                        my $r = hlink($src, $dst);
                        print($r? "ok" : "skip");
                        print "\n";
                        return $r;
                }
        }
        # Directory?
        if (-d $src) {
                if (-e $dst && !-d $dst) {
                        warn "Conflict: -d $src -> !-d $dst\n";
                        return;
                }
                if (!-d $dst) {
                        print "D $dst\n";
                        mkdir($dst, 0777) or die "Could not create $dst\n";
                } else {
                        print "d $dst\n";
                }
                opendir(local *D, $src) or die "Could not open $src\n";
                foreach my $e (readdir D) {
                        next if $e eq "." || $e eq "..";
                        next if $e eq "CVS";
                        junction("$src/$e", "$dst/$e");
                }
                return 1;
        }
        # Hmmm...
        die "Unknown file type: $src\n";
}

sub hlink {
        my ($src, $dst) = @_;
        local $^W;
        use Win32::Hardlink;
        $src =~ s{/}{\\}sg;
        $dst =~ s{/}{\\}sg;
        my $r = link($src => $dst);
        return $r;
}

sub usage {
        die "Usage:\n  $0 <src-dir> <dst-dir>\n";
}