#!/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 <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;