cache data gathered about unused files (untested)

2 files changed, 81 insertions, 15 deletions

diff --git a/lib/perl5/Local/MrRepo/Repo/Git.pm b/lib/perl5/Local/MrRepo/Repo/Git.pm
index ad7a8996..90dc8f4c 100644
--- a/lib/perl5/Local/MrRepo/Repo/Git.pm
+++ b/lib/perl5/Local/MrRepo/Repo/Git.pm
@@ -137,4 +137,10 @@ sub review {
     return $issues;
 }
 
+sub git_path {
+    my $self = shift;
+    my ($path) = $self->git->rev_parse({ git_path => 1 }, $_[0]);
+    return rel2abs($path, $self->toplevel);
+}
+
 1;
diff --git a/lib/perl5/Local/MrRepo/Repo/Git/Annex.pm b/lib/perl5/Local/MrRepo/Repo/Git/Annex.pm
index d3fa4ead..866f6293 100644
--- a/lib/perl5/Local/MrRepo/Repo/Git/Annex.pm
+++ b/lib/perl5/Local/MrRepo/Repo/Git/Annex.pm
@@ -21,6 +21,7 @@ use warnings;
 use lib "$ENV{HOME}/lib/perl5";
 use parent 'Local::MrRepo::Repo::Git';
 
+use Data::Compare;
 use Exporter 'import';
 use File::Spec::Functions qw(rel2abs);
 use Git::Wrapper;
@@ -29,6 +30,8 @@ use Local::ScriptStatus;
 use Try::Tiny;
 use Term::ReadKey;
 use Local::Interactive qw(prompt);
+use Storable;
+use List::Util qw(all);
 
 our @EXPORT_OK = ();
 
@@ -80,8 +83,9 @@ sub review_unused {
       if defined $opts{from};
 
     my @to_drop      = ();
-    my @unused_files = @{ $self->get_unused(\%unused_args) };
-    $self->log_unused(\@unused_files);
+    my $unused_files = $self->unused_files(\%unused_args);
+    $self->log_unused();
+    my @unused_files = @$unused_files;
     return 0 if @unused_files == 0;
     unless ($opts{interactive}) {
         say_spaced_bullet("There are unused files you can drop with"
@@ -90,9 +94,30 @@ sub review_unused {
         print "\n";
     }
 
+    my ($uuid) = $self->git->config("remote.".$opts{from}.".annex-uuid")
+      if defined $opts{from};
+
     my $i = 0;
   UNUSED: while ($i < @unused_files) {
         my $unused_file = $unused_files[$i];
+
+        # check the unused file still exists i.e. has not been dropped
+        # already (in the case of reviewing unused files at a remote,
+        # just check that it's not been dropped according to the local
+        # git-annex branch) use checkpresentkey in that case
+        my $contentlocation;
+        if (defined $opts{from}) {
+            try {
+                $self->git->annex("readpresentkey", $unused_file->{key}, $uuid);
+            }
+            catch {
+                $i++, next UNUSED;
+            };
+        } else {
+            $contentlocation = $self->abs_contentlocation($unused_file->{key});
+            $i++, next UNUSED unless defined $contentlocation;
+        }
+
         system('clear', '-x') if $opts{interactive};
         say_bold("unused file #" . $unused_file->{number} . ":");
 
@@ -140,8 +165,7 @@ sub review_unused {
                     } elsif ($response eq 'n') {
                         last;
                     } elsif ($response eq 'o') {
-                        system('xdg-open',
-                            $self->abs_contentlocation($unused_file->{key}));
+                        system('xdg-open', $contentlocation);
                     } elsif ($response eq 'b' and $i > 0) {
                         pop @to_drop
                           if $to_drop[$#to_drop] eq
@@ -170,29 +194,60 @@ sub review_unused {
     return @to_drop != @unused_files;
 }
 
-sub get_unused {
-    my $self = shift;
 
-    my @unused_files;
+sub unused_files {
+    my ($self, $unused_args) = @_;
+
+    my $annex_dir = $self->git_path("annex");
+    my $cache_file = catfile($annex_dir, "unused_info");
+    $self->{_unused_files} //= retrieve($cache_file) if -e $cache_file;
+
+    # see if cached result needs to be invalidated
+    if (defined $self->{_unused_files}) {
+        my $last_unused = (stat(catfile($annex_dir, "unused")))[9];
+        my %branch_timestamps
+          = map { split ' ' }
+          $self->git->for_each_ref(
+            { format => '%(refname:short) %(committerdate:unix)' },
+            "refs/heads/");
+
+        # we don't need to invalidate the cache if the git-annex
+        # branch has changed, because the worst that can happen is we
+        # try to drop a file which has already been dropped
+        delete $branch_timestamps{'git-annex'};
+
+        if (    $last_unused <= $self->{_unused_files}->{timestamp}
+            and Compare($unused_args, $self->{_unused_files}->{unused_args})
+            and all { $_ < $last_unused } values %branch_timestamps) {
+            return $self->{_unused_files}->{unused};
+        } else {
+            delete $self->{_unused_files};
+        }
+    }
+
+    # if we're still in the method at this point then the cache was
+    # invalidated; regenerate it
     my ($bad, $tmp) = (0, 0);
-    foreach ($self->git->annex("unused", @_)) {
+    foreach ($self->git->annex("unused", $unused_args)) {
         if (/Some corrupted files have been preserved by fsck, just in case/) {
             ($bad, $tmp) = (1, 0);
         } elsif (/Some partially transferred data exists in temporary files/) {
             ($bad, $tmp) = (0, 1);
         } elsif (/^    ([0-9]+) +([^ ]+)$/) {
-            push @unused_files,
+            push @{ $self->{_unused_files}->{unused} },
               { number => $1, key => $2, bad => $bad, tmp => $tmp };
         }
     }
-    return \@unused_files;
+    $self->{_unused_files}->{timestamp}   = time();
+    $self->{_unused_files}->{unused_args} = $unused_args;
+    store($self->{_unused_files}, $cache_file);
+    return $self->{_unused_files}->{unused};
 }
 
 sub log_unused {
-    my $self         = shift;
-    my $unused_files = shift;
+    my $self = shift;
 
-    foreach my $unused_file (@$unused_files) {
+    foreach my $unused_file (@{ $self->{_unused_files}->{unused} }) {
         # We need the RUN here to avoid special postprocessing but
         # also to get the -c option passed -- unclear how to pass
         # short options to git itself, not the 'log' subcommand,
@@ -216,8 +271,13 @@ sub abs_contentlocation {
     my $self = shift;
     my $key  = shift;
 
-    my ($contentlocation)
-      = $self->git->annex("contentlocation", $key);
+    my $contentlocation;
+    try {
+        ($contentlocation) = $self->git->annex("contentlocation", $key);
+    }
+    catch {
+        return undef;
+    };
     return rel2abs($contentlocation, $self->toplevel);
 }