-p for pruning

This commit is contained in:
adam 2006-01-02 01:48:25 +00:00 committed by Adam Spiers
parent d2afbae421
commit 59778b9596
2 changed files with 44 additions and 9 deletions

23
Stow.pm
View file

@ -141,8 +141,8 @@ sub JoinPaths {
sub Unstow {
my($targetdir, $stow, $PkgsToUnstow) = @_;
# Note $targetdir is relative to the top of the target hierarchy,
# i.e. $opts{target}.
# $targetdir is the directory we're unstowing in, relative to the
# top of the target hierarchy, i.e. $opts{target}.
#
# $stow is the stow directory (the one containing the source
# packages), and is always relative to $targetdir. So as we
@ -227,7 +227,7 @@ sub Unstow {
$pure = 0;
}
}
elsif (-d $contentPath) {
elsif (-d $contentPath && ! &PruneTree($targetdir, $content, $PkgsToUnstow)) {
# recurse
my ($subpure, $subother) = &Unstow(
&JoinPaths($targetdir, $content),
@ -272,6 +272,23 @@ sub Unstow {
return ($pure, $othercollection);
}
sub PruneTree {
my ($targetdir, $subdir, $PkgsToUnstow) = @_;
return 0 unless $opts{prune};
my $relpath = &JoinPaths($targetdir, $subdir);
foreach my $pkg (keys %$PkgsToUnstow) {
my $abspath = &JoinPaths($opts{stow}, $pkg, $relpath);
if (-d $abspath) {
warn "# Not pruning $relpath since -d $abspath\n" if $opts{verbose} > 4;
return 0;
}
}
warn "# Pruning $relpath\n" if $opts{verbose} > 2;
return 1;
}
# This is the tree folding which the stow manual refers to.
sub CoalesceTrees {
my($parent, $stow, @trees) = @_;

30
stow.in
View file

@ -45,11 +45,12 @@ use Sh 'glob_to_re';
use Stow;
my $ignore_file = File::Spec->join($ENV{HOME}, ".cvsignore");
my $ignore_re = get_ignore_re_from_file($ignore_file);
my $ignore_re = Stow::get_ignore_re_from_file($ignore_file);
my %opts = (
conflicts => 0,
delete => 0,
prune => 0,
not_really => 0,
verbose => 0,
stow => undef,
@ -57,16 +58,21 @@ my %opts = (
restow => 0,
);
Getopt::Long::Configure('noignorecase', 'bundling');
GetOptions(
\%opts,
'conflicts|c', 'not_really|n', 'stow|dir|d=s', 'target|t=s',
'verbose|v:+', 'delete|D', 'version|V', 'help|h',
'delete|D', 'prune|p', 'restow|R',
'conflicts|c', 'not_really|n',
'stow|dir|d=s', 'target|t=s',
'verbose|v:+', 'version|V', 'help|h',
)
or usage();
version() if $opts{version};
usage() if $opts{help};
usage("Pruning only makes sense when deleting or restowing")
if $opts{prune} and ! ($opts{delete} || $opts{restow});
usage("No packages named") unless @ARGV;
Stow::SetOptions(%opts);
@ -76,13 +82,23 @@ my @Collections = @ARGV;
Stow::CheckCollections(@Collections);
if ($opts{delete} || $opts{restow}) {
Stow::Unstow('', &RelativePath($opts{target}, $opts{stow}), \@Collections);
# These are the packages we are unstowing.
my %to_unstow = map { $_ => 1 } @Collections;
Stow::Unstow(
'',
Stow::RelativePath($opts{target}, $opts{stow}),
\%to_unstow,
);
}
if (!$opts{delete} || $opts{restow}) {
if (! $opts{delete} || $opts{restow}) {
foreach my $Collection (@ARGV) {
warn "Stowing package $Collection...\n" if $opts{verbose};
Stow::StowContents($Collection, &RelativePath($opts{target}, $opts{stow}));
Stow::StowContents(
$Collection,
Stow::RelativePath($opts{target}, $opts{stow}),
);
}
}
@ -104,6 +120,8 @@ sub usage {
-v or --verbose adds 1; --verbose=N sets level)
-D, --delete Unstow instead of stow
-R, --restow Restow (like stow -D followed by stow)
-p, --prune When deleting, skip target subdirectories not in
the package dir (faster but may leave symlinks)
-V, --version Show Stow version number
-h, --help Show this help
EOT