00dani/stow
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Improve conflict reporting

Browse source
This commit is contained in:
Adam Spiers 2011-11-24 22:49:22 +00:00
parent 81da7be357
commit 3d414dc071
5 changed files with 125 additions and 58 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
bin/stow.in
View file

@ -412,15 +412,20 @@ sub main {
$stow->plan_unstow(@$pkgs_to_unstow);
$stow->plan_stow (@$pkgs_to_stow);
my @conflicts = $stow->get_conflicts;
my %conflicts = $stow->get_conflicts;
# --verbose: tell me what you are planning to do
# --simulate: don't execute planned operations
if (scalar @conflicts) {
warn "WARNING: conflicts detected:\n";
warn $_ foreach @conflicts;
warn "WARNING: all operations aborted.\n";
if (%conflicts) {
foreach my $action ('unstow', 'stow') {
next unless $conflicts{$action};
foreach my $package (sort keys %{ $conflicts{$action} }) {
warn "WARNING! ${action}ing $package would cause conflicts:\n";
#if $stow->get_action_count > 1;
foreach my $message (sort @{ $conflicts{$action}{$package} }) {
warn " * $message\n";
}
}
}
warn "All operations aborted.\n";
exit 1;
}
else {

116
lib/Stow.pm.in
View file

@ -13,8 +13,8 @@ Stow - manage the installation of multiple software packages
$stow->plan_unstow(@pkgs_to_unstow);
$stow->plan_stow (@pkgs_to_stow);
my @conflicts = $stow->get_conflicts;
$stow->process_tasks() unless @conflicts;
my %conflicts = $stow->get_conflicts;
$stow->process_tasks() unless %conflicts;
=head1 DESCRIPTION
@ -109,6 +109,8 @@ sub new {
my $new = bless { }, $class;
$new->{action_count} = 0;
for my $required_arg (qw(dir target)) {
croak "$class->new() called without '$required_arg' parameter\n"
unless exists $opts{$required_arg};
@ -125,8 +127,6 @@ sub new {
join(", ", keys %opts), "\n";
}
$opts{simulate} = 1 if $opts{conflicts};
set_debug_level($new->get_verbosity());
set_test_mode($new->{test_mode});
$new->set_stow_dir();
@ -182,7 +182,8 @@ sub init_state {
my $self = shift;
# Store conflicts during pre-processing
$self->{conflicts} = [];
$self->{conflicts} = {};
$self->{conflict_count} = 0;
# Store command line packages to stow (-S and -R)
$self->{pkgs_to_stow} = [];
@ -236,7 +237,7 @@ sub plan_unstow {
$self->within_target_do(sub {
for my $package (@packages) {
if (not -d join_paths($self->{stow_path}, $package)) {
error("The given package name ($package) is not in your stow path $self->{stow_path}");
error("The stow directory $self->{dir} does not contain package $package");
}
debug(2, "Planning unstow of package $package...");
if ($self->{compat}) {
@ -254,6 +255,7 @@ sub plan_unstow {
);
}
debug(2, "Planning unstow of package $package... done");
$self->{action_count}++;
}
});
}
@ -273,7 +275,7 @@ sub plan_stow {
$self->within_target_do(sub {
for my $package (@packages) {
if (not -d join_paths($self->{stow_path}, $package)) {
error("The given package name ($package) is not in your stow path $self->{stow_path}");
error("The stow directory $self->{dir} does not contain package $package");
}
debug(2, "Planning stow of package $package...");
$self->stow_contents(
@ -283,6 +285,7 @@ sub plan_stow {
join_paths($self->{stow_path}, $package), # source from target
);
debug(2, "Planning stow of package $package... done");
$self->{action_count}++;
}
});
}
@ -387,14 +390,18 @@ sub stow_node {
my $path = join_paths($stow_path, $package, $target);
debug(2, "Stowing from $path");
debug(2, "Stowing $path");
debug(3, "--- $target => $source");
# Don't try to stow absolute symlinks (they can't be unstowed)
if (-l $source) {
my $second_source = $self->read_a_link($source);
if ($second_source =~ m{\A/}) {
$self->conflict("source is an absolute symlink $source => $second_source");
$self->conflict(
'stow',
$package,
"source is an absolute symlink $source => $second_source"
);
debug(3, "absolute symlinks cannot be unstowed");
return;
}
@ -413,7 +420,11 @@ sub stow_node {
my ($existing_path, $existing_stow_path, $existing_package) =
$self->find_stowed_path($target, $existing_source);
if (not $existing_path) {
$self->conflict("existing target is not owned by stow: $target");
$self->conflict(
'stow',
$package,
"existing target is not owned by stow: $target"
);
return; # XXX #
}
@ -455,9 +466,10 @@ sub stow_node {
}
else {
$self->conflict(
q{existing target is stowed to a different package: %s => %s},
$target,
$existing_source,
'stow',
$package,
"existing target is stowed to a different package: "
. "$target => $existing_source"
);
}
}
@ -480,7 +492,9 @@ sub stow_node {
}
else {
$self->conflict(
qq{existing target is neither a link nor a directory: $target}
'stow',
$package,
"existing target is neither a link nor a directory: $target"
);
}
}
@ -643,7 +657,9 @@ sub unstow_node_orig {
}
elsif (-e $target) {
$self->conflict(
qq{existing target is neither a link nor a directory: $target},
'unstow',
$package,
"existing target is neither a link nor a directory: $target",
);
}
else {
@ -744,7 +760,9 @@ sub unstow_node {
$self->find_stowed_path($target, $existing_source);
if (not $existing_path) {
$self->conflict(
qq{existing target is not owned by stow: $target => $existing_source}
'unstow',
$package,
"existing target is not owned by stow: $target => $existing_source"
);
return; # XXX #
}
@ -768,9 +786,10 @@ sub unstow_node {
#}
#else {
# $self->conflict(
# q{existing target is stowed to a different package: %s => %s},
# $target,
# $existing_source
# 'unstow',
# $package,
# "existing target is stowed to a different package: "
# . "$target => $existing_source"
# );
#}
}
@ -791,7 +810,9 @@ sub unstow_node {
}
else {
$self->conflict(
qq{existing target is neither a link nor a directory: $target},
'unstow',
$package,
"existing target is neither a link nor a directory: $target",
);
}
}
@ -1042,32 +1063,56 @@ sub fold_tree {
#===== METHOD ===============================================================
# Name : conflict()
# Purpose : handle conflicts in stow operations
# Parameters: $format => message printf format
# : @args => paths that conflict
# Parameters: $package => the package involved with the conflicting operation
# : $message => a description of the conflict
# Returns : n/a
# Throws : fatal exception unless 'conflicts' option is set
# Comments : indicates what type of conflict it is
# Throws : none
# Comments : none
#============================================================================
sub conflict {
my $self = shift;
my ($format, @args) = @_;
my ($action, $package, $message) = @_;
my $message = sprintf($format, @args);
debug(2, "CONFLICT when ${action}ing $package: $message");
$self->{conflicts}{$action}{$package} ||= [];
push @{ $self->{conflicts}{$action}{$package} }, $message;
$self->{conflict_count}++;
debug(1, "CONFLICT: $message");
push @{ $self->{conflicts} }, "CONFLICT: $message\n";
return;
}
=head2 get_conflicts()
Returns a list of all potential conflicts discovered.
Returns a nested hash of all potential conflicts discovered: the keys
are actions ('stow' or 'unstow'), and the values are hashrefs whose
keys are stow package names and whose values are conflict
descriptions, e.g.:
(
stow => {
perl => [
"existing target is not owned by stow: bin/a2p"
"existing target is neither a link nor a directory: bin/perl"
]
}
)
=cut
sub get_conflicts {
my $self = shift;
return @{ $self->{conflicts} };
return %{ $self->{conflicts} };
}
=head2 get_conflict_count()
Returns the number of conflicts found.
=cut
sub get_conflict_count {
my $self = shift;
return $self->{conflict_count};
}
=head2 get_tasks()
@ -1081,6 +1126,17 @@ sub get_tasks {
return @{ $self->{tasks} };
}
=head2 get_action_count()
Returns the number of actions planned for this Stow instance.
=cut
sub get_action_count {
my $self = shift;
return $self->{action_count};
}
#===== METHOD ================================================================
# Name : ignore
# Purpose : determine if the given path matches a regex in our ignore list

17
t/stow_contents.t
View file

@ -18,7 +18,7 @@ init_test_dirs();
cd("$OUT_DIR/target");
my $stow;
my @conflicts;
my %conflicts;
# Note that each of the following tests use a distinct set of files
@ -84,9 +84,10 @@ make_file('bin4'); # this is a file but named like a directory
make_dir('../stow/pkg4/bin4');
make_file('../stow/pkg4/bin4/file4');
$stow->plan_stow('pkg4');
@conflicts = $stow->get_conflicts();
%conflicts = $stow->get_conflicts();
like(
$conflicts[-1], qr(CONFLICT:.*existing target is neither a link nor a directory)
$conflicts{stow}{pkg4}[-1],
qr(existing target is neither a link nor a directory)
=> 'link to new dir conflicts with existing non-directory'
);
@ -99,9 +100,10 @@ make_dir('bin5');
make_link('bin5/file5','../../empty');
make_dir('../stow/pkg5/bin5/file5');
$stow->plan_stow('pkg5');
@conflicts = $stow->get_conflicts();
%conflicts = $stow->get_conflicts();
like(
$conflicts[-1], qr(CONFLICT:.*not owned by stow)
$conflicts{stow}{pkg5}[-1],
qr(not owned by stow)
=> 'target already exists but is not owned by stow'
);
@ -134,9 +136,10 @@ make_link('bin7/node7','../../stow/pkg7a/bin7/node7');
make_dir('../stow/pkg7b/bin7/node7');
make_file('../stow/pkg7b/bin7/node7/file7');
$stow->plan_stow('pkg7b');
@conflicts = $stow->get_conflicts();
%conflicts = $stow->get_conflicts();
like(
$conflicts[-1], qr(CONFLICT:.*existing target is stowed to a different package)
$conflicts{stow}{pkg7b}[-1],
qr(existing target is stowed to a different package)
=> 'link to new dir conflicts with existing stowed non-directory'
);

16
t/unstow_contents.t
View file

@ -20,7 +20,7 @@ cd("$OUT_DIR/target");
# Note that each of the following tests use a distinct set of files
my $stow;
my @conflicts;
my %conflicts;
#
# unstow a simple tree minimally
@ -106,9 +106,10 @@ make_dir('../stow/pkg5/bin5');
make_link('bin5', '../not-stow');
$stow->plan_unstow('pkg5');
@conflicts = $stow->get_conflicts;
%conflicts = $stow->get_conflicts;
like(
$conflicts[-1], qr(CONFLICT:.*existing target is not owned by stow)
$conflicts{unstow}{pkg5}[-1],
qr(existing target is not owned by stow)
=> q(existing link not owned by stow)
);
@ -300,10 +301,11 @@ stderr_like(
qr/There are no outstanding operations to perform/,
'no tasks to process when unstowing pkg12 for third time'
);
@conflicts = $stow->get_conflicts;
%conflicts = $stow->get_conflicts;
ok(
@conflicts == 1 &&
$conflicts[0] =~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
$stow->get_conflict_count == 1 &&
$conflicts{unstow}{pkg12}[0]
=~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
=> 'unstow pkg12 for third time'
);
@ -320,7 +322,7 @@ make_link("$OUT_DIR/target/bin13", '../stow/pkg13/bin13');
$stow->plan_unstow('pkg13');
$stow->process_tasks();
ok(
scalar($stow->get_conflicts) == 0 &&
$stow->get_conflict_count == 0 &&
-f "$OUT_DIR/stow/pkg13/bin13/file13" && ! -e "$OUT_DIR/target/bin13"
=> 'unstow a simple tree'
);

13
t/unstow_contents_orig.t
View file

@ -20,7 +20,7 @@ cd("$OUT_DIR/target");
# Note that each of the following tests use a distinct set of files
my $stow;
my @conflicts;
my %conflicts;
#
# unstow a simple tree minimally
@ -111,7 +111,7 @@ $stow->plan_unstow('pkg5');
# cause any conflicts.
#
#like(
# $Conflicts[-1], qr(CONFLICT:.*can't unlink.*not owned by stow)
# $Conflicts[-1], qr(can't unlink.*not owned by stow)
# => q(existing link not owned by stow)
#);
ok(
@ -307,10 +307,11 @@ stderr_like(
qr/There are no outstanding operations to perform/,
'no tasks to process when unstowing pkg12 for third time'
);
@conflicts = $stow->get_conflicts;
%conflicts = $stow->get_conflicts;
ok(
@conflicts == 1 &&
$conflicts[0] =~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
$stow->get_conflict_count == 1 &&
$conflicts{unstow}{pkg12}[0]
=~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
=> 'unstow pkg12 for third time'
);
@ -327,7 +328,7 @@ make_link("$OUT_DIR/target/bin13", '../stow/pkg13/bin13');
$stow->plan_unstow('pkg13');
$stow->process_tasks();
ok(
scalar($stow->get_conflicts) == 0 &&
$stow->get_conflict_count == 0 &&
-f "$OUT_DIR/stow/pkg13/bin13/file13" && ! -e "$OUT_DIR/target/bin13"
=> 'unstow a simple tree'
);