-p for pruning
This commit is contained in:
parent
d2afbae421
commit
59778b9596
2 changed files with 44 additions and 9 deletions
23
Stow.pm
23
Stow.pm
|
@ -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
30
stow.in
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue