Add --no-folding option.

This commit is contained in:
Adam Spiers 2012-02-18 20:13:32 +00:00
parent 17d3586e84
commit ed12c787df
7 changed files with 285 additions and 25 deletions

5
NEWS
View file

@ -2,6 +2,11 @@ News file for Stow.
* Changes in version 2.1.4 * Changes in version 2.1.4
** New --no-folding option
Disables folding of newly stowed directories when stowing, and
refolding of newly foldable directories when unstowing.
** Remove -a option (--adopt still available) ** Remove -a option (--adopt still available)
As --adopt is the only option which allows stow to modify files, it As --adopt is the only option which allows stow to modify files, it

View file

@ -195,6 +195,11 @@ stow directory, and then stowing proceeds as before. So effectively,
the file becomes adopted by the stow package, without its contents the file becomes adopted by the stow package, without its contents
changing. changing.
=item --no-folding
Disable folding of newly stowed directories when stowing, and
refolding of newly foldable directories when unstowing.
=item --ignore=REGEX =item --ignore=REGEX
Ignore files ending in this Perl regex. Ignore files ending in this Perl regex.
@ -476,7 +481,7 @@ sub process_options {
\%options, \%options,
'verbose|v:+', 'help|h', 'simulate|n|no', 'verbose|v:+', 'help|h', 'simulate|n|no',
'version|V', 'compat|p', 'dir|d=s', 'target|t=s', 'version|V', 'compat|p', 'dir|d=s', 'target|t=s',
'adopt', 'adopt', 'no-folding',
# clean and pre-compile any regex's at parse time # clean and pre-compile any regex's at parse time
'ignore=s' => 'ignore=s' =>

View file

@ -327,6 +327,16 @@ pages that are owned by stow and would otherwise cause a conflict.
The regular expression is anchored to the beginning of the path relative to The regular expression is anchored to the beginning of the path relative to
the target directory, because this is what you will want to do most of the time. the target directory, because this is what you will want to do most of the time.
@item --no-folding
This disables any further @ref{tree folding} or @ref{tree refolding}.
If a new subdirectory is encountered whilst stowing a new package, the
subdirectory is created within the target, and its contents are
symlinked, rather than just creating a symlink for the directory. If
removal of symlinks whilst unstowing a package causes a subtree to be
foldable (i.e. only containing symlinks to a single package), that
subtree will not be removed and replaced with a symlink.
@cindex adopting existing files @cindex adopting existing files
@item --adopt @item --adopt
@strong{Warning!} This behaviour is specifically intended to alter the @strong{Warning!} This behaviour is specifically intended to alter the
@ -606,7 +616,8 @@ and it will descend into @file{/usr/local/lib} and create the
tree-folding symlink @file{perl} pointing to tree-folding symlink @file{perl} pointing to
@file{../stow/perl/lib/perl}, and so on. As a rule, Stow only @file{../stow/perl/lib/perl}, and so on. As a rule, Stow only
descends as far as necessary into the target tree when it can create a descends as far as necessary into the target tree when it can create a
tree-folding symlink. tree-folding symlink. However, this behaviour can be changed via
the @option{--no-folding} option; @pxref{Invoking Stow}.
@anchor{Tree unfolding} @anchor{Tree unfolding}
@section Tree unfolding @section Tree unfolding
@ -681,13 +692,20 @@ directory and a @file{man} directory at the top level, then we only scan
@file{/usr/local/lib} or @file{/usr/local/share}, or for that matter @file{/usr/local/lib} or @file{/usr/local/share}, or for that matter
@file{/usr/local/stow}. Any symlink it finds that points into the package @file{/usr/local/stow}. Any symlink it finds that points into the package
being deleted is removed. Any directory that contained only symlinks to the being deleted is removed. Any directory that contained only symlinks to the
package being deleted is removed. Any directory that, after removing symlinks package being deleted is removed.
and empty subdirectories, contains only symlinks to a single other package, is
considered to be a previously ``folded'' tree that was ``split open.'' Stow
will re-fold the tree by removing the symlinks to the surviving package,
removing the directory, then linking the directory back to the surviving
package.
@anchor{tree refolding}
@section Refolding ``foldable'' trees.
@cindex refolding trees
@cindex tree refolding
After removing symlinks and empty subdirectories, any directory that
contains only symlinks to a single other package is considered to be a
previously ``folded'' tree that was ``split open.'' Stow will refold
the tree by removing the symlinks to the surviving package, removing
the directory, then linking the directory back to the surviving
package. However, this behaviour can be prevented via the
@option{--no-folding} option; @pxref{Invoking Stow}.
@c =========================================================================== @c ===========================================================================
@node Conflicts, Mixing Operations, Deleting Packages, Top @node Conflicts, Mixing Operations, Deleting Packages, Top

View file

@ -54,16 +54,17 @@ our @default_global_ignore_regexps =
# These are the default options for each Stow instance. # These are the default options for each Stow instance.
our %DEFAULT_OPTIONS = ( our %DEFAULT_OPTIONS = (
conflicts => 0, conflicts => 0,
simulate => 0, simulate => 0,
verbose => 0, verbose => 0,
paranoid => 0, paranoid => 0,
compat => 0, compat => 0,
test_mode => 0, test_mode => 0,
adopt => 0, adopt => 0,
ignore => [], 'no-folding' => 0,
override => [], ignore => [],
defer => [], override => [],
defer => [],
); );
=head1 CONSTRUCTORS =head1 CONSTRUCTORS
@ -100,6 +101,8 @@ See the documentation for the F<stow> CLI front-end for information on these.
=item * adopt =item * adopt
=item * no-folding
=item * ignore =item * ignore
=item * override =item * override
@ -517,6 +520,15 @@ sub stow_node {
} }
} }
} }
elsif ($self->{'no-folding'} && -d $path) {
$self->do_mkdir($target);
$self->stow_contents(
$self->{stow_path},
$package,
$target,
join_paths('..', $source),
);
}
else { else {
$self->do_link($source, $target); $self->do_link($source, $target);
} }
@ -994,6 +1006,10 @@ sub foldable {
my ($target) = @_; my ($target) = @_;
debug(3, "--- Is $target foldable?"); debug(3, "--- Is $target foldable?");
if ($self->{'no-folding'}) {
debug(3, "--- no because --no-folding enabled");
return '';
}
opendir my $DIR, $target opendir my $DIR, $target
or error(qq{Cannot read directory "$target" ($!)\n}); or error(qq{Cannot read directory "$target" ($!)\n});

108
t/stow.t
View file

@ -7,7 +7,7 @@
use strict; use strict;
use warnings; use warnings;
use Test::More tests => 35; use Test::More tests => 111;
use Test::Output; use Test::Output;
use English qw(-no_match_vars); use English qw(-no_match_vars);
@ -32,7 +32,7 @@ make_file('../stow/pkg1/bin1/file1');
$stow->plan_stow('pkg1'); $stow->plan_stow('pkg1');
$stow->process_tasks(); $stow->process_tasks();
is($stow->get_conflicts(), 0, 'no conflicts with minimal stow'); is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is( is(
readlink('bin1'), readlink('bin1'),
'../stow/pkg1/bin1', '../stow/pkg1/bin1',
@ -387,7 +387,7 @@ make_file("$OUT_DIR/stow/pkg16/bin16/file16");
$stow->plan_stow('pkg16'); $stow->plan_stow('pkg16');
$stow->process_tasks(); $stow->process_tasks();
is($stow->get_conflicts(), 0, 'no conflicts with minimal stow'); is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is( is(
readlink("$OUT_DIR/target/bin16"), readlink("$OUT_DIR/target/bin16"),
'../stow/pkg16/bin16', '../stow/pkg16/bin16',
@ -406,7 +406,7 @@ make_file("$OUT_DIR/stow/pkg17/bin17/file17");
$stow->plan_stow('pkg17'); $stow->plan_stow('pkg17');
$stow->process_tasks(); $stow->process_tasks();
is($stow->get_conflicts(), 0, 'no conflicts with minimal stow'); is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is( is(
readlink("$OUT_DIR/target/bin17"), readlink("$OUT_DIR/target/bin17"),
'../stow/pkg17/bin17', '../stow/pkg17/bin17',
@ -425,10 +425,108 @@ make_file("$OUT_DIR/stow/pkg18/bin18/file18");
$stow->plan_stow('pkg18'); $stow->plan_stow('pkg18');
$stow->process_tasks(); $stow->process_tasks();
is($stow->get_conflicts(), 0, 'no conflicts with minimal stow'); is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
is( is(
readlink("$OUT_DIR/target/bin18"), readlink("$OUT_DIR/target/bin18"),
'../stow/pkg18/bin18', '../stow/pkg18/bin18',
=> "minimal stow of a simple tree with absolute stow and target dirs" => "minimal stow of a simple tree with absolute stow and target dirs"
); );
#
# stow a tree with no-folding enabled -
# no new folded directories should be created, and existing
# folded directories should be split open (unfolded) where
# (and only where) necessary
#
cd("$OUT_DIR/target");
sub create_pkg {
my ($id, $pkg) = @_;
my $stow_pkg = "../stow/$id-$pkg";
make_dir ($stow_pkg);
make_file("$stow_pkg/$id-file-$pkg");
# create a shallow hierarchy specific to this package which isn't
# yet stowed
make_dir ("$stow_pkg/$id-$pkg-only-new");
make_file("$stow_pkg/$id-$pkg-only-new/$id-file-$pkg");
# create a deeper hierarchy specific to this package which isn't
# yet stowed
make_dir ("$stow_pkg/$id-$pkg-only-new2/subdir");
make_file("$stow_pkg/$id-$pkg-only-new2/subdir/$id-file-$pkg");
# create a hierarchy specific to this package which is already
# stowed via a folded tree
make_dir ("$stow_pkg/$id-$pkg-only-old");
make_link("$id-$pkg-only-old", "$stow_pkg/$id-$pkg-only-old");
make_file("$stow_pkg/$id-$pkg-only-old/$id-file-$pkg");
# create a shared hierarchy which this package uses
make_dir ("$stow_pkg/$id-shared");
make_file("$stow_pkg/$id-shared/$id-file-$pkg");
# create a partially shared hierarchy which this package uses
make_dir ("$stow_pkg/$id-shared2/subdir-$pkg");
make_file("$stow_pkg/$id-shared2/$id-file-$pkg");
make_file("$stow_pkg/$id-shared2/subdir-$pkg/$id-file-$pkg");
}
foreach my $pkg (qw{a b}) {
create_pkg('no-folding', $pkg);
}
$stow = new_Stow('no-folding' => 1);
$stow->plan_stow('no-folding-a');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
my @tasks = $stow->get_tasks;
use Data::Dumper;
is(scalar(@tasks), 12 => "6 dirs, 6 links") || warn Dumper(\@tasks);
$stow->process_tasks();
sub check_no_folding {
my ($pkg) = @_;
my $stow_pkg = "../stow/no-folding-$pkg";
is_link("no-folding-file-$pkg", "$stow_pkg/no-folding-file-$pkg");
# check existing folded tree is untouched
is_link("no-folding-$pkg-only-old", "$stow_pkg/no-folding-$pkg-only-old");
# check newly stowed shallow tree is not folded
is_dir_not_symlink("no-folding-$pkg-only-new");
is_link("no-folding-$pkg-only-new/no-folding-file-$pkg",
"../$stow_pkg/no-folding-$pkg-only-new/no-folding-file-$pkg");
# check newly stowed deeper tree is not folded
is_dir_not_symlink("no-folding-$pkg-only-new2");
is_dir_not_symlink("no-folding-$pkg-only-new2/subdir");
is_link("no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg",
"../../$stow_pkg/no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg");
# check shared tree is not folded. first time round this will be
# newly stowed.
is_dir_not_symlink('no-folding-shared');
is_link("no-folding-shared/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared/no-folding-file-$pkg");
# check partially shared tree is not folded. first time round this
# will be newly stowed.
is_dir_not_symlink('no-folding-shared2');
is_link("no-folding-shared2/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
is_link("no-folding-shared2/no-folding-file-$pkg",
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
}
check_no_folding('a');
$stow = new_Stow('no-folding' => 1);
$stow->plan_stow('no-folding-b');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
@tasks = $stow->get_tasks;
is(scalar(@tasks), 10 => '4 dirs, 6 links') || warn Dumper(\@tasks);
$stow->process_tasks();
check_no_folding('a');
check_no_folding('b');

View file

@ -13,6 +13,7 @@ use Carp qw(croak);
use File::Basename; use File::Basename;
use File::Path qw(remove_tree); use File::Path qw(remove_tree);
use File::Spec; use File::Spec;
use Test::More;
use Stow; use Stow;
use Stow::Util qw(parent canon_path); use Stow::Util qw(parent canon_path);
@ -26,6 +27,7 @@ our @EXPORT = qw(
make_dir make_link make_invalid_link make_file make_dir make_link make_invalid_link make_file
remove_dir remove_link remove_dir remove_link
cat_file cat_file
is_link is_dir_not_symlink is_nonexistent_path
); );
our $OUT_DIR = 'tmp-testing-trees'; our $OUT_DIR = 'tmp-testing-trees';
@ -254,6 +256,41 @@ sub cat_file {
return $contents; return $contents;
} }
#===== SUBROUTINE ===========================================================
# Name : is_link()
# Purpose : assert path is a symlink
# Parameters: $path => path to check
# : $dest => target symlink should point to
#============================================================================
sub is_link {
my ($path, $dest) = @_;
ok(-l $path => "$path should be symlink");
is(readlink $path, $dest => "$path symlinks to $dest");
}
#===== SUBROUTINE ===========================================================
# Name : is_dir_not_symlink()
# Purpose : assert path is a directory not a symlink
# Parameters: $path => path to check
#============================================================================
sub is_dir_not_symlink {
my ($path) = @_;
ok(! -l $path => "$path should not be symlink");
ok(-d _ => "$path should be a directory");
}
#===== SUBROUTINE ===========================================================
# Name : is_nonexistent_path()
# Purpose : assert path does not exist
# Parameters: $path => path to check
#============================================================================
sub is_nonexistent_path {
my ($path) = @_;
ok(! -l $path => "$path should not be symlink");
ok(! -e _ => "$path should not exist");
}
1; 1;
# Local variables: # Local variables:

View file

@ -7,7 +7,7 @@
use strict; use strict;
use warnings; use warnings;
use Test::More tests => 23; use Test::More tests => 38;
use Test::Output; use Test::Output;
use English qw(-no_match_vars); use English qw(-no_match_vars);
@ -341,8 +341,89 @@ ok(
=> 'unstow a simple tree with absolute stow and target dirs' => 'unstow a simple tree with absolute stow and target dirs'
); );
#
# unstow a tree with no-folding enabled -
# no refolding should take place
#
cd("$OUT_DIR/target");
sub create_and_stow_pkg {
my ($id, $pkg) = @_;
my $stow_pkg = "../stow/$id-$pkg";
make_dir ($stow_pkg);
make_file("$stow_pkg/$id-file-$pkg");
# create a shallow hierarchy specific to this package and stow
# via folding
make_dir ("$stow_pkg/$id-$pkg-only-folded");
make_file("$stow_pkg/$id-$pkg-only-folded/file-$pkg");
make_link("$id-$pkg-only-folded", "$stow_pkg/$id-$pkg-only-folded");
# create a deeper hierarchy specific to this package and stow
# via folding
make_dir ("$stow_pkg/$id-$pkg-only-folded2/subdir");
make_file("$stow_pkg/$id-$pkg-only-folded2/subdir/file-$pkg");
make_link("$id-$pkg-only-folded2",
"$stow_pkg/$id-$pkg-only-folded2");
# create a shallow hierarchy specific to this package and stow
# without folding
make_dir ("$stow_pkg/$id-$pkg-only-unfolded");
make_file("$stow_pkg/$id-$pkg-only-unfolded/file-$pkg");
make_dir ("$id-$pkg-only-unfolded");
make_link("$id-$pkg-only-unfolded/file-$pkg",
"../$stow_pkg/$id-$pkg-only-unfolded/file-$pkg");
# create a deeper hierarchy specific to this package and stow
# without folding
make_dir ("$stow_pkg/$id-$pkg-only-unfolded2/subdir");
make_file("$stow_pkg/$id-$pkg-only-unfolded2/subdir/file-$pkg");
make_dir ("$id-$pkg-only-unfolded2/subdir");
make_link("$id-$pkg-only-unfolded2/subdir/file-$pkg",
"../../$stow_pkg/$id-$pkg-only-unfolded2/subdir/file-$pkg");
# create a shallow shared hierarchy which this package uses, and stow
# its contents without folding
make_dir ("$stow_pkg/$id-shared");
make_file("$stow_pkg/$id-shared/file-$pkg");
make_dir ("$id-shared");
make_link("$id-shared/file-$pkg",
"../$stow_pkg/$id-shared/file-$pkg");
# create a deeper shared hierarchy which this package uses, and stow
# its contents without folding
make_dir ("$stow_pkg/$id-shared2/subdir");
make_file("$stow_pkg/$id-shared2/file-$pkg");
make_file("$stow_pkg/$id-shared2/subdir/file-$pkg");
make_dir ("$id-shared2/subdir");
make_link("$id-shared2/file-$pkg",
"../$stow_pkg/$id-shared2/file-$pkg");
make_link("$id-shared2/subdir/file-$pkg",
"../../$stow_pkg/$id-shared2/subdir/file-$pkg");
}
foreach my $pkg (qw{a b}) {
create_and_stow_pkg('no-folding', $pkg);
}
$stow = new_Stow('no-folding' => 1);
$stow->plan_unstow('no-folding-b');
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
use Data::Dumper;
#warn Dumper($stow->get_tasks);
$stow->process_tasks();
is_nonexistent_path('no-folding-b-only-folded');
is_nonexistent_path('no-folding-b-only-folded2');
is_nonexistent_path('no-folding-b-only-unfolded/file-b');
is_nonexistent_path('no-folding-b-only-unfolded2/subdir/file-b');
is_dir_not_symlink('no-folding-shared');
is_dir_not_symlink('no-folding-shared2');
is_dir_not_symlink('no-folding-shared2/subdir');
# Todo # Todo
# #
# Test cleaning up subdirs with --paranoid option # Test cleaning up subdirs with --paranoid option