Refactor verbosity-controlled output to STDERR into debug() subroutine.
This commit is contained in:
parent
8da4e15fbf
commit
ca49579fa1
1 changed files with 77 additions and 164 deletions
241
stow.in
241
stow.in
|
@ -34,10 +34,11 @@ $ProgramName =~ s{.*/}{};
|
||||||
|
|
||||||
# Verbosity rules:
|
# Verbosity rules:
|
||||||
#
|
#
|
||||||
# 0: errors only
|
# 0: errors only
|
||||||
# > 0: print operations: LINK/UNLINK/MKDIR/RMDIR
|
# >= 1: print operations: LINK/UNLINK/MKDIR/RMDIR
|
||||||
# > 1: print trace: stow/unstow package/contents/node
|
# >= 2: print trace: stow/unstow package/contents/node
|
||||||
# > 2: print trace detail: "_this_ already points to _that_"
|
# >= 3: print trace detail: "_this_ already points to _that_"
|
||||||
|
# >= 4: debug helper routines
|
||||||
#
|
#
|
||||||
# All output (except for version() and usage()) is to stderr to preserve
|
# All output (except for version() and usage()) is to stderr to preserve
|
||||||
# backward compatibility.
|
# backward compatibility.
|
||||||
|
@ -108,9 +109,7 @@ if ( not caller() ) {
|
||||||
if (not -d join_paths($Stow_Path,$package)) {
|
if (not -d join_paths($Stow_Path,$package)) {
|
||||||
error("The given package name ($package) is not in your stow path");
|
error("The given package name ($package) is not in your stow path");
|
||||||
}
|
}
|
||||||
if ($Option{'verbose'} > 1) {
|
debug(2, "Unstowing package $package...");
|
||||||
warn "Unstowing package $package...\n";
|
|
||||||
}
|
|
||||||
if ($Option{'compat'}) {
|
if ($Option{'compat'}) {
|
||||||
unstow_contents_orig(
|
unstow_contents_orig(
|
||||||
join_paths($Stow_Path,$package), # path to package
|
join_paths($Stow_Path,$package), # path to package
|
||||||
|
@ -123,26 +122,20 @@ if ( not caller() ) {
|
||||||
'', # target is current_dir
|
'', # target is current_dir
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
if ($Option{'verbose'} > 1) {
|
debug(2, "Unstowing package $package...done");
|
||||||
warn "Unstowing package $package...done\n";
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
for my $package (@Pkgs_To_Stow) {
|
for my $package (@Pkgs_To_Stow) {
|
||||||
if (not -d join_paths($Stow_Path,$package)) {
|
if (not -d join_paths($Stow_Path,$package)) {
|
||||||
error("The given package name ($package) is not in your stow path");
|
error("The given package name ($package) is not in your stow path");
|
||||||
}
|
}
|
||||||
if ($Option{'verbose'} > 1) {
|
debug(2, "Stowing package $package...");
|
||||||
warn "Stowing package $package...\n";
|
|
||||||
}
|
|
||||||
stow_contents(
|
stow_contents(
|
||||||
join_paths($Stow_Path,$package), # path package
|
join_paths($Stow_Path,$package), # path package
|
||||||
'', # target is current dir
|
'', # target is current dir
|
||||||
join_paths($Stow_Path,$package), # source from target
|
join_paths($Stow_Path,$package), # source from target
|
||||||
);
|
);
|
||||||
if ($Option{'verbose'} > 1) {
|
debug(2, "Stowing package $package...done");
|
||||||
warn "Stowing package $package...done\n";
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# --verbose: tell me what you are planning to do
|
# --verbose: tell me what you are planning to do
|
||||||
|
@ -264,6 +257,22 @@ sub process_options {
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#===== SUBROUTINE ============================================================
|
||||||
|
# Name : debug()
|
||||||
|
# Purpose : log to STDERR based on verbosity setting
|
||||||
|
# Parameters: $level => minimum verbosity level required to output this message
|
||||||
|
# : $msg => the message
|
||||||
|
# Returns : n/a
|
||||||
|
# Throws : no exceptions
|
||||||
|
# Comments : none
|
||||||
|
#=============================================================================
|
||||||
|
sub debug {
|
||||||
|
my ($level, $msg) = @_;
|
||||||
|
if ($Option{'verbose'} >= $level) {
|
||||||
|
warn "$msg\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
#===== SUBROUTINE ============================================================
|
#===== SUBROUTINE ============================================================
|
||||||
# Name : get_defaults()
|
# Name : get_defaults()
|
||||||
# Purpose : search for default settings in any .stow files
|
# Purpose : search for default settings in any .stow files
|
||||||
|
@ -384,10 +393,8 @@ sub set_stow_path {
|
||||||
# set our one global
|
# set our one global
|
||||||
$Stow_Path = File::Spec->abs2rel($stow_dir);
|
$Stow_Path = File::Spec->abs2rel($stow_dir);
|
||||||
|
|
||||||
if ($Option{'verbose'} > 1) {
|
debug(2, "current dir is " . getcwd());
|
||||||
warn "current dir is ".getcwd()."\n";
|
debug(2, "stow dir path is $Stow_Path");
|
||||||
warn "stow dir path is $Stow_Path\n";
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#===== SUBROUTINE ===========================================================
|
#===== SUBROUTINE ===========================================================
|
||||||
|
@ -406,12 +413,8 @@ sub stow_contents {
|
||||||
|
|
||||||
my ($path, $target, $source) = @_;
|
my ($path, $target, $source) = @_;
|
||||||
|
|
||||||
if ($Option{'verbose'} > 1){
|
debug(2, "Stowing contents of $path");
|
||||||
warn "Stowing contents of $path\n";
|
debug(3, "--- $target => $source");
|
||||||
}
|
|
||||||
if ($Option{'verbose'} > 2){
|
|
||||||
warn "--- $target => $source\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
if (not -d $path) {
|
if (not -d $path) {
|
||||||
error("stow_contents() called on a non-directory: $path");
|
error("stow_contents() called on a non-directory: $path");
|
||||||
|
@ -451,21 +454,15 @@ sub stow_node {
|
||||||
|
|
||||||
my ($path, $target, $source) = @_;
|
my ($path, $target, $source) = @_;
|
||||||
|
|
||||||
if ($Option{'verbose'} > 1) {
|
debug(2, "Stowing $path");
|
||||||
warn "Stowing $path\n";
|
debug(3, "--- $target => $source");
|
||||||
}
|
|
||||||
if ($Option{'verbose'} > 2) {
|
|
||||||
warn "--- $target => $source\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
# 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) {
|
||||||
my $second_source = read_a_link($source);
|
my $second_source = read_a_link($source);
|
||||||
if ($second_source =~ m{\A/} ) {
|
if ($second_source =~ m{\A/} ) {
|
||||||
conflict("source is an absolute symlink $source => $second_source");
|
conflict("source is an absolute symlink $source => $second_source");
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "absolute symlinks cannot be unstowed");
|
||||||
warn "absolute symlinks cannot be unstowed";
|
|
||||||
}
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -478,9 +475,7 @@ sub stow_node {
|
||||||
if (not $old_source) {
|
if (not $old_source) {
|
||||||
error("Could not read link: $target");
|
error("Could not read link: $target");
|
||||||
}
|
}
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "--- Evaluate existing link: $target => $old_source");
|
||||||
warn "--- Evaluate existing link: $target => $old_source\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
# does it point to a node under our stow directory?
|
# does it point to a node under our stow directory?
|
||||||
my $old_path = find_stowed_path($target, $old_source);
|
my $old_path = find_stowed_path($target, $old_source);
|
||||||
|
@ -492,19 +487,13 @@ sub stow_node {
|
||||||
# does the existing $target actually point to anything?
|
# does the existing $target actually point to anything?
|
||||||
if (is_a_node($old_path)) {
|
if (is_a_node($old_path)) {
|
||||||
if ($old_source eq $source) {
|
if ($old_source eq $source) {
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "--- Skipping $target as it already points to $source");
|
||||||
warn "--- Skipping $target as it already points to $source\n";
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
elsif (defer($target)) {
|
elsif (defer($target)) {
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "--- deferring installation of: $target");
|
||||||
warn "--- deferring installation of: $target\n";
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
elsif (override($target)) {
|
elsif (override($target)) {
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "--- overriding installation of: $target");
|
||||||
warn "--- overriding installation of: $target\n";
|
|
||||||
}
|
|
||||||
do_unlink($target);
|
do_unlink($target);
|
||||||
do_link($source,$target);
|
do_link($source,$target);
|
||||||
}
|
}
|
||||||
|
@ -515,9 +504,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 the tree at that point
|
# then we can unfold the tree at that point
|
||||||
|
|
||||||
if ($Option{'verbose'} > 2){
|
debug(3, "--- Unfolding $target");
|
||||||
warn "--- Unfolding $target\n";
|
|
||||||
}
|
|
||||||
do_unlink($target);
|
do_unlink($target);
|
||||||
do_mkdir($target);
|
do_mkdir($target);
|
||||||
stow_contents($old_path, $target, join_paths('..',$old_source));
|
stow_contents($old_path, $target, join_paths('..',$old_source));
|
||||||
|
@ -533,17 +520,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
|
||||||
if ($Option{'verbose'} > 2){
|
debug(3, "--- replacing invalid link: $path");
|
||||||
warn "--- replacing invalid link: $path\n";
|
|
||||||
}
|
|
||||||
do_unlink($target);
|
do_unlink($target);
|
||||||
do_link($source, $target);
|
do_link($source, $target);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif (is_a_node($target)) {
|
elsif (is_a_node($target)) {
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "--- Evaluate existing node: $target");
|
||||||
warn("--- Evaluate existing node: $target\n");
|
|
||||||
}
|
|
||||||
if (is_a_dir($target)) {
|
if (is_a_dir($target)) {
|
||||||
stow_contents($path, $target, join_paths('..',$source));
|
stow_contents($path, $target, join_paths('..',$source));
|
||||||
}
|
}
|
||||||
|
@ -577,12 +560,8 @@ sub unstow_contents_orig {
|
||||||
if ($target eq $Stow_Path or -e "$target/.stow" or -e "$target/.nonstow") {
|
if ($target eq $Stow_Path or -e "$target/.stow" or -e "$target/.nonstow") {
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
if ($Option{'verbose'} > 1){
|
debug(2, "Unstowing in $target");
|
||||||
warn "Unstowing in $target\n";
|
debug(3, "--- path is $path");
|
||||||
}
|
|
||||||
if ($Option{'verbose'} > 2){
|
|
||||||
warn "--- path is $path\n";
|
|
||||||
}
|
|
||||||
if (not -d $target) {
|
if (not -d $target) {
|
||||||
error("unstow_contents() called on a non-directory: $target");
|
error("unstow_contents() called on a non-directory: $target");
|
||||||
}
|
}
|
||||||
|
@ -617,18 +596,12 @@ sub unstow_node_orig {
|
||||||
|
|
||||||
my ($path, $target) = @_;
|
my ($path, $target) = @_;
|
||||||
|
|
||||||
if ($Option{'verbose'} > 1) {
|
debug(2, "Unstowing $target");
|
||||||
warn "Unstowing $target\n";
|
debug(3, "--- path is $path");
|
||||||
}
|
|
||||||
if ($Option{'verbose'} > 2) {
|
|
||||||
warn "--- path is $path\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
# does the target exist
|
# does the target exist
|
||||||
if (is_a_link($target)) {
|
if (is_a_link($target)) {
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "Evaluate existing link: $target");
|
||||||
warn("Evaluate existing link: $target\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
# where is the link pointing?
|
# where is the link pointing?
|
||||||
my $old_source = read_a_link($target);
|
my $old_source = read_a_link($target);
|
||||||
|
@ -650,17 +623,13 @@ sub unstow_node_orig {
|
||||||
do_unlink($target);
|
do_unlink($target);
|
||||||
}
|
}
|
||||||
elsif (override($target)) {
|
elsif (override($target)) {
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "--- overriding installation of: $target");
|
||||||
warn("--- overriding installation of: $target\n");
|
|
||||||
}
|
|
||||||
do_unlink($target);
|
do_unlink($target);
|
||||||
}
|
}
|
||||||
# else leave it alone
|
# else leave it alone
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
if ($Option{'verbose'} > 2){
|
debug(3, "--- removing invalid link into a stow directory: $path");
|
||||||
warn "--- removing invalid link into a stow directory: $path\n";
|
|
||||||
}
|
|
||||||
do_unlink($target);
|
do_unlink($target);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -693,12 +662,8 @@ sub unstow_contents {
|
||||||
if ($target eq $Stow_Path or -e "$target/.stow") {
|
if ($target eq $Stow_Path or -e "$target/.stow") {
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
if ($Option{'verbose'} > 1){
|
debug(2, "Unstowing in $target");
|
||||||
warn "Unstowing in $target\n";
|
debug(3, "--- path is $path");
|
||||||
}
|
|
||||||
if ($Option{'verbose'} > 2){
|
|
||||||
warn "--- path is $path\n";
|
|
||||||
}
|
|
||||||
if (not -d $path) {
|
if (not -d $path) {
|
||||||
error("unstow_contents() called on a non-directory: $path");
|
error("unstow_contents() called on a non-directory: $path");
|
||||||
}
|
}
|
||||||
|
@ -736,18 +701,12 @@ sub unstow_node {
|
||||||
|
|
||||||
my ($path, $target) = @_;
|
my ($path, $target) = @_;
|
||||||
|
|
||||||
if ($Option{'verbose'} > 1) {
|
debug(2, "Unstowing $path");
|
||||||
warn "Unstowing $path\n";
|
debug(3, "--- target is $target");
|
||||||
}
|
|
||||||
if ($Option{'verbose'} > 2) {
|
|
||||||
warn "--- target is $target\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
# does the target exist
|
# does the target exist
|
||||||
if (is_a_link($target)) {
|
if (is_a_link($target)) {
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "Evaluate existing link: $target");
|
||||||
warn("Evaluate existing link: $target\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
# where is the link pointing?
|
# where is the link pointing?
|
||||||
my $old_source = read_a_link($target);
|
my $old_source = read_a_link($target);
|
||||||
|
@ -780,14 +739,10 @@ sub unstow_node {
|
||||||
# package.
|
# package.
|
||||||
|
|
||||||
#elsif (defer($target)) {
|
#elsif (defer($target)) {
|
||||||
# if ($Option{'verbose'} > 2) {
|
# debug(3, "--- deferring to installation of: $target");
|
||||||
# warn("--- deferring to installation of: $target\n");
|
|
||||||
# }
|
|
||||||
#}
|
#}
|
||||||
#elsif (override($target)) {
|
#elsif (override($target)) {
|
||||||
# if ($Option{'verbose'} > 2) {
|
# debug(3, "--- overriding installation of: $target");
|
||||||
# warn("--- overriding installation of: $target\n");
|
|
||||||
# }
|
|
||||||
# do_unlink($target);
|
# do_unlink($target);
|
||||||
#}
|
#}
|
||||||
#else {
|
#else {
|
||||||
|
@ -799,16 +754,12 @@ sub unstow_node {
|
||||||
#}
|
#}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
if ($Option{'verbose'} > 2){
|
debug(3, "--- removing invalid link into a stow directory: $path");
|
||||||
warn "--- removing invalid link into a stow directory: $path\n";
|
|
||||||
}
|
|
||||||
do_unlink($target);
|
do_unlink($target);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif (-e $target) {
|
elsif (-e $target) {
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "Evaluate existing node: $target");
|
||||||
warn("Evaluate existing node: $target\n");
|
|
||||||
}
|
|
||||||
if (-d $target) {
|
if (-d $target) {
|
||||||
unstow_contents($path, $target);
|
unstow_contents($path, $target);
|
||||||
|
|
||||||
|
@ -916,10 +867,8 @@ sub cleanup_invalid_links {
|
||||||
not -e join_paths($dir,$source) and # bad link
|
not -e join_paths($dir,$source) and # bad link
|
||||||
find_stowed_path($node_path,$source) # owned by stow
|
find_stowed_path($node_path,$source) # owned by stow
|
||||||
){
|
){
|
||||||
if ($Option{'verbose'} > 2) {
|
debug(3, "--- removing stale link: $node_path => " .
|
||||||
warn "--- removing stale link: $node_path => ",
|
join_paths($dir,$source));
|
||||||
join_paths($dir,$source), "\n";
|
|
||||||
}
|
|
||||||
do_unlink($node_path);
|
do_unlink($node_path);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -941,9 +890,7 @@ sub foldable {
|
||||||
|
|
||||||
my ($target) = @_;
|
my ($target) = @_;
|
||||||
|
|
||||||
if ($Option{'verbose'} > 2){
|
debug(3, "--- Is $target foldable?");
|
||||||
warn "--- Is $target foldable?\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
opendir my $DIR, $target
|
opendir my $DIR, $target
|
||||||
or error(qq{Cannot read directory "$target" ($!)\n});
|
or error(qq{Cannot read directory "$target" ($!)\n});
|
||||||
|
@ -988,9 +935,7 @@ sub foldable {
|
||||||
|
|
||||||
# if the resulting path is owned by stow, we can fold it
|
# if the resulting path is owned by stow, we can fold it
|
||||||
if (find_stowed_path($target,$parent)) {
|
if (find_stowed_path($target,$parent)) {
|
||||||
if ($Option{'verbose'} > 2){
|
debug(3, "--- $target is foldable");
|
||||||
warn "--- $target is foldable\n";
|
|
||||||
}
|
|
||||||
return $parent;
|
return $parent;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
|
@ -1011,9 +956,7 @@ sub fold_tree {
|
||||||
|
|
||||||
my ($target,$source) = @_;
|
my ($target,$source) = @_;
|
||||||
|
|
||||||
if ($Option{'verbose'} > 2){
|
debug(3, "--- Folding tree: $target => $source");
|
||||||
warn "--- Folding tree: $target => $source\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
opendir my $DIR, $target
|
opendir my $DIR, $target
|
||||||
or error(qq{Cannot read directory "$target" ($!)\n});
|
or error(qq{Cannot read directory "$target" ($!)\n});
|
||||||
|
@ -1046,10 +989,8 @@ sub conflict {
|
||||||
|
|
||||||
my $message = sprintf($format, @args);
|
my $message = sprintf($format, @args);
|
||||||
|
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "CONFLICT: $message");
|
||||||
warn qq{CONFLICT: $message\n};
|
push @Conflicts, "CONFLICT: $message\n";
|
||||||
}
|
|
||||||
push @Conflicts, qq{CONFLICT: $message\n};
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1125,9 +1066,7 @@ sub override {
|
||||||
#============================================================================
|
#============================================================================
|
||||||
sub process_tasks {
|
sub process_tasks {
|
||||||
|
|
||||||
if ($Option{'verbose'} > 1) {
|
debug(2, "Processing tasks...");
|
||||||
warn "Processing tasks...\n"
|
|
||||||
}
|
|
||||||
|
|
||||||
# strip out all tasks with a skip action
|
# strip out all tasks with a skip action
|
||||||
@Tasks = grep { $_->{'action'} ne 'skip' } @Tasks;
|
@Tasks = grep { $_->{'action'} ne 'skip' } @Tasks;
|
||||||
|
@ -1177,9 +1116,7 @@ sub process_tasks {
|
||||||
internal_error(qq(bad task action: $task->{'action'}));
|
internal_error(qq(bad task action: $task->{'action'}));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if ($Option{'verbose'} > 1) {
|
debug(2, "Processing tasks...done");
|
||||||
warn "Processing tasks...done\n"
|
|
||||||
}
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1410,18 +1347,14 @@ sub do_link {
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "LINK: $newfile => $oldfile (duplicates previous action)");
|
||||||
warn "LINK: $newfile => $oldfile (duplicates previous action)\n";
|
|
||||||
}
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
elsif ( $task_ref->{'action'} eq 'remove' ) {
|
elsif ( $task_ref->{'action'} eq 'remove' ) {
|
||||||
if ( $task_ref->{'source'} eq $oldfile ) {
|
if ( $task_ref->{'source'} eq $oldfile ) {
|
||||||
# no need to remove a link we are going to recreate
|
# no need to remove a link we are going to recreate
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "LINK: $newfile => $oldfile (reverts previous action)");
|
||||||
warn "LINK: $newfile => $oldfile (reverts previous action)\n";
|
|
||||||
}
|
|
||||||
$Link_Task_For{$newfile}->{'action'} = 'skip';
|
$Link_Task_For{$newfile}->{'action'} = 'skip';
|
||||||
delete $Link_Task_For{$newfile};
|
delete $Link_Task_For{$newfile};
|
||||||
return;
|
return;
|
||||||
|
@ -1434,9 +1367,7 @@ sub do_link {
|
||||||
}
|
}
|
||||||
|
|
||||||
# creating a new link
|
# creating a new link
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "LINK: $newfile => $oldfile");
|
||||||
warn "LINK: $newfile => $oldfile\n";
|
|
||||||
}
|
|
||||||
my $task = {
|
my $task = {
|
||||||
action => 'create',
|
action => 'create',
|
||||||
type => 'link',
|
type => 'link',
|
||||||
|
@ -1464,16 +1395,12 @@ sub do_unlink {
|
||||||
if (exists $Link_Task_For{$file} ) {
|
if (exists $Link_Task_For{$file} ) {
|
||||||
my $task_ref = $Link_Task_For{$file};
|
my $task_ref = $Link_Task_For{$file};
|
||||||
if ( $task_ref->{'action'} eq 'remove' ) {
|
if ( $task_ref->{'action'} eq 'remove' ) {
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "UNLINK: $file (duplicates previous action)");
|
||||||
warn "UNLINK: $file (duplicates previous action)\n";
|
|
||||||
}
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
elsif ( $task_ref->{'action'} eq 'create' ) {
|
elsif ( $task_ref->{'action'} eq 'create' ) {
|
||||||
# do need to create a link then remove it
|
# do need to create a link then remove it
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "UNLINK: $file (reverts previous action)");
|
||||||
warn "UNLINK: $file (reverts previous action)\n";
|
|
||||||
}
|
|
||||||
$Link_Task_For{$file}->{'action'} = 'skip';
|
$Link_Task_For{$file}->{'action'} = 'skip';
|
||||||
delete $Link_Task_For{$file};
|
delete $Link_Task_For{$file};
|
||||||
return;
|
return;
|
||||||
|
@ -1492,10 +1419,8 @@ sub do_unlink {
|
||||||
}
|
}
|
||||||
|
|
||||||
# remove the link
|
# remove the link
|
||||||
if ($Option{'verbose'}) {
|
#debug(1, "UNLINK: $file (" . (caller())[2] . ")");
|
||||||
#warn "UNLINK: $file (".(caller())[2].")\n";
|
debug(1, "UNLINK: $file");
|
||||||
warn "UNLINK: $file\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
my $source = readlink $file or error("could not readlink $file");
|
my $source = readlink $file or error("could not readlink $file");
|
||||||
|
|
||||||
|
@ -1548,15 +1473,11 @@ sub do_mkdir {
|
||||||
my $task_ref = $Dir_Task_For{$dir};
|
my $task_ref = $Dir_Task_For{$dir};
|
||||||
|
|
||||||
if ($task_ref->{'action'} eq 'create') {
|
if ($task_ref->{'action'} eq 'create') {
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "MKDIR: $dir (duplicates previous action)");
|
||||||
warn "MKDIR: $dir (duplicates previous action)\n";
|
|
||||||
}
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
elsif ($task_ref->{'action'} eq 'remove') {
|
elsif ($task_ref->{'action'} eq 'remove') {
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "MKDIR: $dir (reverts previous action)");
|
||||||
warn "MKDIR: $dir (reverts previous action)\n";
|
|
||||||
}
|
|
||||||
$Dir_Task_For{$dir}->{'action'} = 'skip';
|
$Dir_Task_For{$dir}->{'action'} = 'skip';
|
||||||
delete $Dir_Task_For{$dir};
|
delete $Dir_Task_For{$dir};
|
||||||
return;
|
return;
|
||||||
|
@ -1566,9 +1487,7 @@ sub do_mkdir {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "MKDIR: $dir");
|
||||||
warn "MKDIR: $dir\n";
|
|
||||||
}
|
|
||||||
my $task = {
|
my $task = {
|
||||||
action => 'create',
|
action => 'create',
|
||||||
type => 'dir',
|
type => 'dir',
|
||||||
|
@ -1607,15 +1526,11 @@ sub do_rmdir {
|
||||||
my $task_ref = $Link_Task_For{$dir};
|
my $task_ref = $Link_Task_For{$dir};
|
||||||
|
|
||||||
if ($task_ref->{'action'} eq 'remove' ) {
|
if ($task_ref->{'action'} eq 'remove' ) {
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "RMDIR $dir (duplicates previous action)");
|
||||||
warn "RMDIR $dir (duplicates previous action)\n";
|
|
||||||
}
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
elsif ($task_ref->{'action'} eq 'create' ) {
|
elsif ($task_ref->{'action'} eq 'create' ) {
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "MKDIR $dir (reverts previous action)");
|
||||||
warn "MKDIR $dir (reverts previous action)\n";
|
|
||||||
}
|
|
||||||
$Link_Task_For{$dir}->{'action'} = 'skip';
|
$Link_Task_For{$dir}->{'action'} = 'skip';
|
||||||
delete $Link_Task_For{$dir};
|
delete $Link_Task_For{$dir};
|
||||||
return;
|
return;
|
||||||
|
@ -1625,9 +1540,7 @@ sub do_rmdir {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if ($Option{'verbose'}) {
|
debug(1, "RMDIR $dir");
|
||||||
warn "RMDIR $dir\n";
|
|
||||||
}
|
|
||||||
my $task = {
|
my $task = {
|
||||||
action => 'remove',
|
action => 'remove',
|
||||||
type => 'dir',
|
type => 'dir',
|
||||||
|
|
Loading…
Reference in a new issue