Improve conflict reporting

bin/stow.in

@@ -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
+    if (%conflicts) {
-    # --simulate:  don't execute planned operations
+        foreach my $action ('unstow', 'stow') {
-
+            next unless $conflicts{$action};
-    if (scalar @conflicts) {
+            foreach my $package (sort keys %{ $conflicts{$action} }) {
-        warn "WARNING: conflicts detected:\n";
+                warn "WARNING! ${action}ing $package would cause conflicts:\n";
-        warn $_ foreach @conflicts;
+                    #if $stow->get_action_count > 1;
-        warn "WARNING: all operations aborted.\n";
+                foreach my $message (sort @{ $conflicts{$action}{$package} }) {
+                    warn "  * $message\n";
+                }
+            }
+        }
+        warn "All operations aborted.\n";
         exit 1;
     }
     else {

lib/Stow.pm.in

@@ -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;
+    my %conflicts = $stow->get_conflicts;
-    $stow->process_tasks() unless @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},
+                    'stow',
-                    $target,
+                    $package,
-                    $existing_source,
+                    "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},
+            #        'unstow',
-            #        $target,
+            #        $package,
-            #        $existing_source
+            #        "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
+# Parameters: $package => the package involved with the conflicting operation
-#           : @args   => paths that conflict
+#           : $message => a description of the conflict
 # Returns   : n/a
-# Throws    : fatal exception unless 'conflicts' option is set
+# Throws    : none
-# Comments  : indicates what type of conflict it is
+# 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

t/stow_contents.t

@@ -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'
 );
 

t/unstow_contents.t

@@ -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 &&
+    $stow->get_conflict_count == 1 &&
-    $conflicts[0] =~ m!existing target is neither a link nor a directory: man12/man1/file12\.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' 
 );

t/unstow_contents_orig.t

@@ -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 &&
+    $stow->get_conflict_count == 1 &&
-    $conflicts[0] =~ m!existing target is neither a link nor a directory: man12/man1/file12\.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' 
 );