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

Improve debug levels.

Browse source
This commit is contained in:
Adam Spiers 2011-11-26 18:55:10 +00:00
parent 4933d9623d
commit d672e3e6cf
2 changed files with 45 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

77
lib/Stow.pm.in
View file

@ -339,11 +339,10 @@ sub stow_contents {
return if $self->should_skip_target_which_is_stow_dir($target); return if $self->should_skip_target_which_is_stow_dir($target);
my $cwd = getcwd(); my $cwd = getcwd();
my $msg = "Stowing contents of $path in package $package " my $msg = "Stowing contents of $path (cwd=$cwd)";
. "(cwd=$cwd, stow dir=$self->{stow_path})"; $msg =~ s!$ENV{HOME}(/|$)!~$1!g;
$msg =~ s!$ENV{HOME}/!~/!g; debug(3, $msg);
debug(2, $msg); debug(4, " => $source");
debug(3, "--- $target => $source");
error("stow_contents() called with non-directory path: $path") error("stow_contents() called with non-directory path: $path")
unless -d $path; unless -d $path;
@ -390,8 +389,8 @@ sub stow_node {
my $path = join_paths($stow_path, $package, $target); my $path = join_paths($stow_path, $package, $target);
debug(2, "Stowing $path"); debug(3, "Stowing $path");
debug(3, "--- $target => $source"); debug(4, " => $source");
# Don't try to stow absolute symlinks (they can't be unstowed) # Don't try to stow absolute symlinks (they can't be unstowed)
if (-l $source) { if (-l $source) {
@ -402,7 +401,7 @@ sub stow_node {
$package, $package,
"source is an absolute symlink $source => $second_source" "source is an absolute symlink $source => $second_source"
); );
debug(3, "absolute symlinks cannot be unstowed"); debug(3, "Absolute symlinks cannot be unstowed");
return; return;
} }
} }
@ -414,7 +413,7 @@ sub stow_node {
if (not $existing_source) { if (not $existing_source) {
error("Could not read link: $target"); error("Could not read link: $target");
} }
debug(3, "--- Evaluate existing link: $target => $existing_source"); debug(4, " Evaluate existing link: $target => $existing_source");
# Does it point to a node under any stow directory? # Does it point to a node under any stow directory?
my ($existing_path, $existing_stow_path, $existing_package) = my ($existing_path, $existing_stow_path, $existing_package) =
@ -431,13 +430,13 @@ sub stow_node {
# Does the existing $target actually point to anything? # Does the existing $target actually point to anything?
if ($self->is_a_node($existing_path)) { if ($self->is_a_node($existing_path)) {
if ($existing_source eq $source) { if ($existing_source eq $source) {
debug(3, "--- Skipping $target as it already points to $source"); debug(2, "--- Skipping $target as it already points to $source");
} }
elsif ($self->defer($target)) { elsif ($self->defer($target)) {
debug(3, "--- deferring installation of: $target"); debug(2, "--- Deferring installation of: $target");
} }
elsif ($self->override($target)) { elsif ($self->override($target)) {
debug(3, "--- overriding installation of: $target"); debug(2, "--- Overriding installation of: $target");
$self->do_unlink($target); $self->do_unlink($target);
$self->do_link($source, $target); $self->do_link($source, $target);
} }
@ -448,7 +447,7 @@ sub stow_node {
# and the proposed new link points to a directory, # and the proposed new link points to a directory,
# then we can unfold (split open) the tree at that point # then we can unfold (split open) the tree at that point
debug(3, "--- Unfolding $target which was already owned by $existing_package"); debug(2, "--- Unfolding $target which was already owned by $existing_package");
$self->do_unlink($target); $self->do_unlink($target);
$self->do_mkdir($target); $self->do_mkdir($target);
$self->stow_contents( $self->stow_contents(
@ -475,13 +474,13 @@ sub stow_node {
} }
else { else {
# The existing link is invalid, so replace it with a good link # The existing link is invalid, so replace it with a good link
debug(3, "--- replacing invalid link: $path"); debug(2, "--- replacing invalid link: $path");
$self->do_unlink($target); $self->do_unlink($target);
$self->do_link($source, $target); $self->do_link($source, $target);
} }
} }
elsif ($self->is_a_node($target)) { elsif ($self->is_a_node($target)) {
debug(3, "--- Evaluate existing node: $target"); debug(4, " Evaluate existing node: $target");
if ($self->is_a_dir($target)) { if ($self->is_a_dir($target)) {
$self->stow_contents( $self->stow_contents(
$self->{stow_path}, $self->{stow_path},
@ -566,9 +565,9 @@ sub unstow_contents_orig {
my $cwd = getcwd(); my $cwd = getcwd();
my $msg = "Unstowing from $target (compat mode, cwd=$cwd, stow dir=$self->{stow_path})"; my $msg = "Unstowing from $target (compat mode, cwd=$cwd, stow dir=$self->{stow_path})";
$msg =~ s!$ENV{HOME}/!~/!g; $msg =~ s!$ENV{HOME}(/|$)!~$1!g;
debug(2, $msg); debug(3, $msg);
debug(3, "--- source path is $path"); debug(4, " source path is $path");
# In compat mode we traverse the target tree not the source tree, # In compat mode we traverse the target tree not the source tree,
# so we're unstowing the contents of /target/foo, there's no # so we're unstowing the contents of /target/foo, there's no
# guarantee that the corresponding /stow/mypkg/foo exists. # guarantee that the corresponding /stow/mypkg/foo exists.
@ -607,12 +606,12 @@ sub unstow_node_orig {
my $path = join_paths($stow_path, $package, $target); my $path = join_paths($stow_path, $package, $target);
debug(2, "Unstowing $target (compat mode)"); debug(3, "Unstowing $target (compat mode)");
debug(3, "--- source path is $path"); debug(4, " source path is $path");
# Does the target exist? # Does the target exist?
if ($self->is_a_link($target)) { if ($self->is_a_link($target)) {
debug(3, "Evaluate existing link: $target"); debug(4, " Evaluate existing link: $target");
# Where is the link pointing? # Where is the link pointing?
my $existing_source = $self->read_a_link($target); my $existing_source = $self->read_a_link($target);
@ -637,13 +636,13 @@ sub unstow_node_orig {
$self->do_unlink($target); $self->do_unlink($target);
} }
elsif ($self->override($target)) { elsif ($self->override($target)) {
debug(3, "--- overriding installation of: $target"); debug(2, "--- overriding installation of: $target");
$self->do_unlink($target); $self->do_unlink($target);
} }
# else leave it alone # else leave it alone
} }
else { else {
debug(3, "--- removing invalid link into a stow directory: $path"); debug(2, "--- removing invalid link into a stow directory: $path");
$self->do_unlink($target); $self->do_unlink($target);
} }
} }
@ -663,7 +662,7 @@ sub unstow_node_orig {
); );
} }
else { else {
debug(3, "$target did not exist to be unstowed"); debug(2, "$target did not exist to be unstowed");
} }
return; return;
} }
@ -691,8 +690,8 @@ sub unstow_contents {
my $cwd = getcwd(); my $cwd = getcwd();
my $msg = "Unstowing from $target (cwd=$cwd, stow dir=$self->{stow_path})"; my $msg = "Unstowing from $target (cwd=$cwd, stow dir=$self->{stow_path})";
$msg =~ s!$ENV{HOME}/!~/!g; $msg =~ s!$ENV{HOME}/!~/!g;
debug(2, $msg); debug(3, $msg);
debug(3, "--- source path is $path"); debug(4, " source path is $path");
# We traverse the source tree not the target tree, so $path must exist. # We traverse the source tree not the target tree, so $path must exist.
error("unstow_contents() called with non-directory path: $path") error("unstow_contents() called with non-directory path: $path")
unless -d $path; unless -d $path;
@ -737,12 +736,12 @@ sub unstow_node {
my $path = join_paths($stow_path, $package, $target); my $path = join_paths($stow_path, $package, $target);
debug(2, "Unstowing $path"); debug(3, "Unstowing $path");
debug(3, "--- target is $target"); debug(4, " target is $target");
# Does the target exist? # Does the target exist?
if ($self->is_a_link($target)) { if ($self->is_a_link($target)) {
debug(3, "Evaluate existing link: $target"); debug(4, " Evaluate existing link: $target");
# Where is the link pointing? # Where is the link pointing?
my $existing_source = $self->read_a_link($target); my $existing_source = $self->read_a_link($target);
@ -778,10 +777,10 @@ sub unstow_node {
# package. # package.
#elsif (defer($target)) { #elsif (defer($target)) {
# debug(3, "--- deferring to installation of: $target"); # debug(2, "--- deferring to installation of: $target");
#} #}
#elsif ($self->override($target)) { #elsif ($self->override($target)) {
# debug(3, "--- overriding installation of: $target"); # debug(2, "--- overriding installation of: $target");
# $self->do_unlink($target); # $self->do_unlink($target);
#} #}
#else { #else {
@ -794,12 +793,12 @@ sub unstow_node {
#} #}
} }
else { else {
debug(3, "--- removing invalid link into a stow directory: $path"); debug(2, "--- removing invalid link into a stow directory: $path");
$self->do_unlink($target); $self->do_unlink($target);
} }
} }
elsif (-e $target) { elsif (-e $target) {
debug(3, "Evaluate existing node: $target"); debug(4, " Evaluate existing node: $target");
if (-d $target) { if (-d $target) {
$self->unstow_contents($stow_path, $package, $target); $self->unstow_contents($stow_path, $package, $target);
@ -817,7 +816,7 @@ sub unstow_node {
} }
} }
else { else {
debug(3, "$target did not exist to be unstowed"); debug(2, "$target did not exist to be unstowed");
} }
return; return;
} }
@ -951,7 +950,7 @@ sub cleanup_invalid_links {
not -e join_paths($dir, $source) and # bad link not -e join_paths($dir, $source) and # bad link
$self->path_owned_by_package($node_path, $source) # owned by stow $self->path_owned_by_package($node_path, $source) # owned by stow
){ ){
debug(3, "--- removing stale link: $node_path => " . debug(2, "--- removing stale link: $node_path => " .
join_paths($dir, $source)); join_paths($dir, $source));
$self->do_unlink($node_path); $self->do_unlink($node_path);
} }
@ -1165,9 +1164,9 @@ sub ignore {
my $package_dir = join_paths($stow_path, $package); my $package_dir = join_paths($stow_path, $package);
my ($path_regexp, $segment_regexp) = my ($path_regexp, $segment_regexp) =
$self->get_ignore_regexps($package_dir); $self->get_ignore_regexps($package_dir);
debug(3, " Ignore list regexp for paths: " . debug(5, " Ignore list regexp for paths: " .
(defined $path_regexp ? "/$path_regexp/" : "none")); (defined $path_regexp ? "/$path_regexp/" : "none"));
debug(3, " Ignore list regexp for segments: " . debug(5, " Ignore list regexp for segments: " .
(defined $segment_regexp ? "/$segment_regexp/" : "none")); (defined $segment_regexp ? "/$segment_regexp/" : "none"));
if (defined $path_regexp and "/$target" =~ $path_regexp) { if (defined $path_regexp and "/$target" =~ $path_regexp) {
@ -1201,11 +1200,11 @@ sub get_ignore_regexps {
for my $file ($local_stow_ignore, $global_stow_ignore) { for my $file ($local_stow_ignore, $global_stow_ignore) {
if (-e $file) { if (-e $file) {
debug(3, " Using ignore file: $file"); debug(5, " Using ignore file: $file");
return $self->get_ignore_regexps_from_file($file); return $self->get_ignore_regexps_from_file($file);
} }
else { else {
debug(4, " $file didn't exist"); debug(5, " $file didn't exist");
} }
} }

9
lib/Stow/Util.pm
View file

@ -93,12 +93,17 @@ Verbosity rules:
=item >= 1: print operations: LINK/UNLINK/MKDIR/RMDIR =item >= 1: print operations: LINK/UNLINK/MKDIR/RMDIR
=item >= 2: print trace: stow/unstow package/contents/node =item >= 2: print operation exceptions
=item >= 3: print trace detail: "_this_ already points to _that_" e.g. "_this_ already points to _that_", skipping, deferring,
overriding, fixing invalid links
=item >= 3: print trace detail: trace: stow/unstow/package/contents/node
=item >= 4: debug helper routines =item >= 4: debug helper routines
=item >= 5: debug ignore lists
=back =back
=cut =cut