drop code migrated to Git-Annex CPAN distribution & use that dist

1 files changed, 11 insertions, 254 deletions

diff --git a/perl5/Local/MrRepo/Repo/Git/Annex.pm b/perl5/Local/MrRepo/Repo/Git/Annex.pm
index 4330dc49..9c6dec30 100644
--- a/perl5/Local/MrRepo/Repo/Git/Annex.pm
+++ b/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 App::annex_review_unused;
 use Data::Compare;
 use Exporter 'import';
 use File::Spec::Functions qw(rel2abs catfile);
@@ -66,263 +67,19 @@ sub review {
     my ($review_unused) = $self->git->config(qw(--local --get --type=bool
                                                 --default true
                                                 mrrepo.review-unused));
-    $issues = $self->review_unused(interactive => 0) || $issues
-      if $review_unused eq 'true';
 
-    return $issues;
-}
-
-sub review_unused {
-    my $self = shift;
-    my %opts = @_;
-
-    my $used_refspec_config;
-    try { ($used_refspec_config) = $self->git->config("annex.used-refspec") };
-
-    $opts{interactive} //= 0;
-    # only supply a default value for this if annex.used-refspec has
-    # not been configured, so that annex.used-refspec takes effect if
-    # our caller does not supply a used_refspec
-    $opts{used_refspec} //= "+refs/heads/*:-refs/heads/synced/*"
-      unless defined $used_refspec_config;
-
-    my %unused_args = ();
-    $unused_args{used_refspec} = $opts{used_refspec}
-      if exists $opts{used_refspec};
-    my %dropunused_args = (force => 1);
-    $unused_args{from} = $dropunused_args{from} = $opts{from}
-      if defined $opts{from};
-
-    my @to_drop      = ();
-    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"
-              . " `git annex dropunused':");
-        say "    " . $_->{number} . "     " . $_->{key} for @unused_files;
-        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 = $self->abs_contentlocation($unused_file->{key});
-        if (defined $opts{from}) {
-            try {
-                $self->git->annex("readpresentkey", $unused_file->{key},
-                    $uuid);
-            }
-            catch {
-                splice @unused_files, $i, 1;
-                next UNUSED;
-            };
-        } elsif (!defined $contentlocation) {
-            splice @unused_files, $i, 1;
-            next UNUSED;
-        }
-
-        system('clear', '-x') if $opts{interactive};
-        say_bold("unused file #" . $unused_file->{number} . ":");
-
-        if ($unused_file->{bad} || $unused_file->{tmp}) {
-            say "  looks like stale tmp or bad file, with key "
-              . $unused_file->{key};
-        } else {
-            my @log_lines = @{ $unused_file->{log_lines} };
-            if ($opts{interactive}) {
-                # truncate log output if necessary to ensure user's
-                # terminal does not scroll
-                my (undef, $height) = GetTerminalSize();
-                splice @log_lines, (($height - 5) - @log_lines)
-                  if @log_lines > ($height - 5);
-            }
-            print "\n";
-            say for @log_lines;
-            if ($opts{interactive}) {
-                my $response;
-                while (1) {
-                    # before prompting, clear out stdin, to avoid
-                    # registered a keypress more than once
-                    ReadMode 4;
-                    1 while defined ReadKey(-1);
-
-                    my @opts = ('y', 'n');
-                    push @opts, 'o' if defined $contentlocation;
-                    push @opts, ('d', 'b') if $i > 0;
-                    print "Drop this unused files?  ("
-                      . join('/', @opts) . ") ";
-
-                    # Term::ReadKey docs recommend ReadKey(-1) but
-                    # that means we need an infinite loop calling
-                    # ReadKey(-1) over and over, which ramps up system
-                    # load
-                    my $response = ReadKey(0);
-                    ReadMode 0;
-
-                    # respond to C-c
-                    exit 0 if ord($response) == 3;
-
-                    say $response;
-                    $response = lc($response);
-                    if ($response eq 'y') {
-                        push @to_drop, $unused_file->{number};
-                        last;
-                    } elsif ($response eq 'n') {
-                        last;
-                    } elsif ($response eq 'o' and defined $contentlocation) {
-                        system('xdg-open', $contentlocation);
-                    } elsif ($response eq 'b' and $i > 0) {
-                        $i--;
-                        pop @to_drop
-                          if @to_drop
-                          and $to_drop[$#to_drop] eq
-                          $unused_files[$i]->{number};
-                        next UNUSED;
-                    } elsif ($response eq 'd' and $i > 0) {
-                        # user wants to drop the list we've
-                        # accumulated up until now and get out of this
-                        # script
-                        last UNUSED;
-                    } else {
-                        say "invalid response";
-                    }
-                }
-            }
-        }
-        print "\n";
-        $i++;
-    }
-
-    if (@to_drop) {
-        say_spaced_bullet("Will dropunused"
-              . (exists $dropunused_args{force} ? " with --force:" : ":"));
-        say "@to_drop\n";
-        $self->git->annex("dropunused", \%dropunused_args, @to_drop)
-          if prompt_yn("Go ahead with this?");
-    }
-    # return boolean value representing whether or not there are any
-    # unused files left after this run.  note in non-interactive mode
-    # @to_drop will be empty so will always return 1 if we got this
-    # far in the subroutine
-    if (@to_drop == @unused_files) {
-        delete $self->{_unused_files};
-        unlink $self->_unused_cache_file;
-        return 0;
-    } else {
-        return 1;
+    if ($review_unused eq "true") {
+        #<<<
+        try {
+            $issues = App::annex_review_unused->main(["--just-print"])
+              || $issues;
+        } catch {
+            $issues = 1;
+        };
+        #>>>
     }
-}
 
-
-sub unused_files {
-    my ($self, $unused_args) = @_;
-
-    my $cache_file = $self->_unused_cache_file;
-    $self->{_unused_files} //= retrieve($cache_file) if -e $cache_file;
-
-    # see if cached result needs to be invalidated
-    if (defined $self->{_unused_files}) {
-        my $annex_dir = $self->git_path("annex");
-        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);
-    %{ $self->{_unused_files}->{unused_args} } = %$unused_args;
-    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 @{ $self->{_unused_files}->{unused} },
-              { number => $1, key => $2, bad => $bad, tmp => $tmp };
-        }
-    }
-    $self->{_unused_files}->{timestamp} = time();
-    $self->_store_unused();
-    return $self->{_unused_files}->{unused};
-}
-
-sub log_unused {
-    my $self = shift;
-
-    foreach my $unused_file (@{ $self->{_unused_files}->{unused} }) {
-        next if defined $unused_file->{log_lines};
-        # 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,
-        # with Git::Wrapper except by using RUN (passing long
-        # options to git itself is easy, per Git::Wrapper docs)
-        @{ $unused_file->{log_lines} } = map { s/^/  /r } $self->git->RUN(
-            "-c",
-            "diff.renameLimit=3000",
-            "log",
-            {
-                stat        => 1,
-                no_textconv => 1
-            },
-            "--color=always",
-            "-S",
-            $unused_file->{key});
-    }
-    $self->_store_unused();
-}
-
-sub _store_unused {
-    my $self = shift;
-    store($self->{_unused_files}, $self->_unused_cache_file);
-}
-
-sub _unused_cache_file {
-    my $annex_dir = shift->git_path("annex");
-    return catfile($annex_dir, "unused_info");
-}
-
-sub abs_contentlocation {
-    my $self = shift;
-    my $key  = shift;
-
-    my $contentlocation;
-    #<<<
-    try {
-        ($contentlocation) = $self->git->annex("contentlocation", $key);
-    } catch {
-        undef $contentlocation;
-    };
-    #>>>
-    return (defined $contentlocation)
-      ? rel2abs($contentlocation, $self->toplevel)
-      : undef;
+    return $issues;
 }
 
 1;