[PATCH] Add --stowdir and --delete options to chkstow

--K8nIJk4ghYZn606h
Content-Type: text/plain; charset=utf-8
Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable

Hello,

I use GNU stow to manage my dotfiles and I love it.  The only thing I mis=
sed was
a way to remove leftover symlinks whenever I removed a file in my dotfile=
s
repository.

When I looked at the source to find out how easy it might be to implement=
 what I
needed, I stumbled upon chkstow (Which I had not heard of before =E2=80=93=
 A quick
search tells me it=E2=80=99s not even mentioned in the man page) which wa=
s almost
exactly what I looked for.

However, it prints every single symlink that points to non-existing files=
, even
though I only care about those files that point to non-existing files in =
my stow
directory (ie. my dotfiles repository).  Since the target is my home dire=
ctory,
there=E2=80=99s lots of garbage, abandoned projects, etc. lying around wh=
ich contain
stale symlinks.

To accomplish my goals (which I hope are shared by others, hence I=E2=80=99=
m writing
this mail), I added the following command line options:

* --stowdir: Sets the stow directory, so chkstow can determine whether a =
path is
  inside it, in order to ignore symlinks that point to outside of it.  By
  default, this value is set to "/", to stay backwards compatible =E2=80=93=
 this way no
  symlink will be ignored except if you supply this option.

* --delete: Makes chkstow delete all the =E2=80=9Cbogus symlinks=E2=80=9D=
 it discovers.

Both changes are attached as seperate patches to this email.  Feel free t=
o tell
me what I did wrong, since this is the first snippet of perl code I wrote=
 in my
whole life.

Thanks :)

--K8nIJk4ghYZn606h
Content-Type: text/plain; charset=utf-8
Content-Disposition: attachment; filename="0001-Add-stowdir-option-to-chkstow.patch"

From b3d63d2503a0325adfd04e9292f67e62f7b28e02 Mon Sep 17 00:00:00 2001
From: shak-mar <[email protected]>
Date: Thu, 11 Feb 2016 18:18:02 +0100
Subject: [PATCH 1/2] Add --stowdir option to chkstow

---
 bin/chkstow.in | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/bin/chkstow.in b/bin/chkstow.in
index c35ba26..30e72b0 100755
--- a/bin/chkstow.in
+++ b/bin/chkstow.in
@@ -5,7 +5,9 @@ use warnings;
 
 require 5.006_001;
 
+use Cwd;
 use File::Find;
+use File::Spec;
 use Getopt::Long;
 
 my $DEFAULT_TARGET = '/usr/local/';
@@ -14,6 +16,8 @@ our $Wanted   = \&bad_links;
 our %Package  = ();
 our $Stow_dir = '';
 our $Target   = $DEFAULT_TARGET;
+our $Stowdir  = '/';
+our $TopCwd   = Cwd::cwd();
 
 # put the main loop into a block so that tests can load this as a module
 if ( not caller() ) {
@@ -31,7 +35,13 @@ sub process_options {
 	'a|aliens'   => sub { $Wanted = \&aliens    },
 	'l|list'     => sub { $Wanted = \&list      },
 	't|target=s' => \$Target,
+	's|stowdir=s' => \$Stowdir,
 	) or usage();
+    if ($Stowdir and $Wanted != \&bad_links) {
+        print "Only use --stowdir with --badlinks!\n";
+        usage ();
+    }
+    $Stowdir = File::Spec->rel2abs($Stowdir);
     return;
 }
 
@@ -45,6 +55,8 @@ Options:
     -b, --badlinks        Report symlinks that point to non-existent files
     -a, --aliens          Report non-symlinks in the target directory
     -l, --list            List packages in the target directory
+    -s DIR, --stowdir=DIR Ignore bad links to files outside of this directory
+                          (default is "/", so no links are ignored)
 
 --badlinks is the default mode.
 EOT
@@ -85,7 +97,13 @@ sub skip_dirs {
 
 # checking for files that do not link to anything
 sub bad_links {
-    -l && !-e && print "Bogus link: $File::Find::name\n";
+    if (-l && !-e) {
+        my $relpath = $File::Find::name;
+        my $abspath = join('/', $TopCwd, $relpath);
+        my $rel_from_stow = File::Spec->abs2rel(readlink $abspath, $Stowdir);
+        index($rel_from_stow, "..") == 0 && return;
+        print "Bogus link: $relpath\n";
+    }
 }
 
 # checking for files that are not owned by stow
-- 
2.7.0


--K8nIJk4ghYZn606h
Content-Type: text/plain; charset=utf-8
Content-Disposition: attachment; filename="0002-Add-delete-option-to-chkstow.patch"

From 2995d8d5dc49282c71a7aa30aaffccc804d90f46 Mon Sep 17 00:00:00 2001
From: shak-mar <[email protected]>
Date: Thu, 11 Feb 2016 18:13:48 +0100
Subject: [PATCH 2/2] Add --delete option to chkstow

---
 bin/chkstow.in | 15 ++++++++++++---
 1 file changed, 12 insertions(+), 3 deletions(-)

diff --git a/bin/chkstow.in b/bin/chkstow.in
index 30e72b0..e0c53b3 100755
--- a/bin/chkstow.in
+++ b/bin/chkstow.in
@@ -18,6 +18,7 @@ our $Stow_dir = '';
 our $Target   = $DEFAULT_TARGET;
 our $Stowdir  = '/';
 our $TopCwd   = Cwd::cwd();
+our $Delete   = 0;
 
 # put the main loop into a block so that tests can load this as a module
 if ( not caller() ) {
@@ -36,9 +37,10 @@ sub process_options {
 	'l|list'     => sub { $Wanted = \&list      },
 	't|target=s' => \$Target,
 	's|stowdir=s' => \$Stowdir,
+	'd|delete'   => \$Delete,
 	) or usage();
-    if ($Stowdir and $Wanted != \&bad_links) {
-        print "Only use --stowdir with --badlinks!\n";
+    if (($Stowdir or $Delete) and $Wanted != \&bad_links) {
+        print "Only use --stowdir and --delete with --badlinks!\n";
         usage ();
     }
     $Stowdir = File::Spec->rel2abs($Stowdir);
@@ -57,6 +59,7 @@ Options:
     -l, --list            List packages in the target directory
     -s DIR, --stowdir=DIR Ignore bad links to files outside of this directory
                           (default is "/", so no links are ignored)
+    -d, --delete          Delete links discovered by --badlinks
 
 --badlinks is the default mode.
 EOT
@@ -102,7 +105,13 @@ sub bad_links {
         my $abspath = join('/', $TopCwd, $relpath);
         my $rel_from_stow = File::Spec->abs2rel(readlink $abspath, $Stowdir);
         index($rel_from_stow, "..") == 0 && return;
-        print "Bogus link: $relpath\n";
+        if ($Delete) {
+            print "Deleting bogus link: $file...\n";
+            unlink $abspath or die "Failed to delete $abspath: $!";
+        }
+        else {
+            print "Bogus link: $file\n";
+        }
     }
 }
 
-- 
2.7.0


--K8nIJk4ghYZn606h--