locmaint: look for old coldbkups

1 files changed, 50 insertions, 1 deletions

diff --git a/bin/locmaint b/bin/locmaint
index ad146482..1a0788d0 100755
--- a/bin/locmaint
+++ b/bin/locmaint
@@ -61,10 +61,11 @@ use constant {
     UNSTABLE => 'unstable',
 };
 
+use Array::Utils qw(array_minus);
 use File::Basename;
 use File::Find;
 use File::Path qw(make_path);
-use File::Spec::Functions qw(rel2abs catfile);
+use File::Spec::Functions qw(abs2rel rel2abs catfile);
 use Getopt::Long;
 use Local::Homedir;
 use Local::Interactive qw(interactive_ensure_subroutine
@@ -346,6 +347,17 @@ sub do_coldbkup {
     backup_repo($_->{uri}, catfile($gitbk, "athena_gcrypt", $_->{dir}))
       for @gcrypt_repos;
 
+    # check for old backups to be cleaned up
+    my $old_coldbkups =
+      find_old_coldbkups(catfile($gitbk, "athena"), \@athena_repos);
+    $old_coldbkups =
+      find_old_coldbkups(catfile($gitbk, "athena_gcrypt"), \@gcrypt_repos)
+      || $old_coldbkups;
+    if ($old_coldbkups) {
+        say_spaced_bullet("Can remove if archived into annex.");
+        get_ack();
+    }
+
     # repos from Debian's salsa
     mkdir catfile($gitbk, "salsa");
     if (open my $fh,
@@ -738,3 +750,40 @@ sub backup_repo {
             });
     }
 }
+
+=head find_old_coldbkups($directory, \@backups)
+
+Find git repos in C<$directory> which do not have entries in
+C<\@backups>.  C<@backups> is an array of hashrefs, where the C<dir>
+key of each hash is the relative path to the git repo under
+C<$directory>.
+
+=cut
+
+sub find_old_coldbkups {
+    my ($directory, $backups) = @_;
+    $directory = rel2abs($directory);
+    my @dirs = map { $_->{dir} } @$backups;
+    my @repos;
+    find({
+            wanted =>
+              sub { -d and /\.git$/ and push @repos, abs2rel($_, $directory) },
+            # we have to recurse into subdirs because we have repos in
+            # subdirs of the repo root on athena, but for speed, avoid
+            # looking inside git or git annex objects dirs
+            preprocess => sub {
+                grep { !/\A(objects|tmp|transfer|journal)\z/ } @_;
+            },
+            no_chdir => 1
+        },
+        $directory
+    );
+    my @old_coldbkups = array_minus(@repos, @dirs);
+    if (@old_coldbkups == 0) {
+        return 0;
+    } else {
+        say_bold("Repos in $directory not present on the remote:");
+        print "  $_\n" for @old_coldbkups;
+        return 1;
+    }
+}