debian/shadowtree

#!/usr/bin/perl

use strict;
use warnings;
use File::Find;
use File::Spec;
use Cwd;

sub usage()
{
    my $name = (File::Spec->splitpath($0))[2];
    print <<EOT
Usage:

    $name destination
EOT
    ;
    exit 0;
}

sub get_first_subdir($$)
{
    my @path = File::Spec->splitdir(File::Spec->rel2abs(shift));
    my @base = File::Spec->splitdir(File::Spec->rel2abs(shift));

    while (@path and @base and $path[0] eq $base[0])
    {
        shift @path;
        shift @base;
    }

    @base ? '' : $path[0];
}

my $dst = shift;

if (not defined $dst or $dst eq '')
{
    usage();
}

my $src = File::Spec->rel2abs(cwd());

$dst = File::Spec->rel2abs($dst);

if (! -d $dst)
{
    my $path = '';
    foreach my $d (File::Spec->splitdir($dst))
    {
        $path = File::Spec->catdir($path, $d);
        if (! -d $path)
        {
            mkdir $path or die "Can't create directory $path: $!";
        }
    }
}

my $subdir = File::Spec->rel2abs(get_first_subdir($dst, $src), $src);
my @path = File::Spec->splitdir($dst);
my $curdir = File::Spec->catdir(@path);

find {
    wanted => sub {
        if ($File::Find::name eq $subdir or /^(CVS(?:\.adm)?|RCS|SCCS)$/)
        {
            $File::Find::prune = 1;
            return;
        }
        elsif ($_ eq File::Spec->curdir)
        {
            return;
        }
        elsif (-d)
        {
            push @path, $_;
            $curdir = File::Spec->catdir(@path);
            mkdir $curdir unless -d $curdir;
        }
        else
        {
            my $basename = (File::Spec->splitpath($File::Find::name))[2];
            my $filename = File::Spec->catfile($curdir, $basename);
            unlink $filename;
            symlink File::Spec->abs2rel($File::Find::name, $curdir), $filename;
        }
    },
    postprocess => sub {
        pop @path;
    }
}, $src;