convert annex-review-unused into an App:: module

This solves the PATH problem of testing the right version of the
scripts.

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

4 files changed, 232 insertions, 167 deletions

diff --git a/bin/annex-review-unused b/bin/annex-review-unused
index 082f058..99d8798 100755
--- a/bin/annex-review-unused
+++ b/bin/annex-review-unused
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 # PODNAME: annex-review-unused
-# ABSTRACT: interactively process `git annex unused` output
+# ABSTRACT: interactively process 'git annex unused' output
 #
 # Copyright (C) 2019-2020  Sean Whitton <spwhitton@spwhitton.name>
 #
@@ -57,153 +57,5 @@ git-annex-unused(1), git-annex-dropunused(1)
 
 =cut
 
-use 5.028;
-use strict;
-use warnings;
-
-use Getopt::Long;
-use Git::Annex;
-use Try::Tiny;
-use Term::ReadKey;
-use Term::ANSIColor;
-
-my $annex = Git::Annex->new;
-
-my $just_print = 0;
-my ($uuid, $from_arg, $used_refspec_arg, %unused_opts, %dropunused_args);
-GetOptions
-  'from=s'         => \$from_arg,
-  'used-refspec=s' => \$used_refspec_arg,
-  'just-print'     => \$just_print;
-if ($from_arg) {
-    $unused_opts{from} = $dropunused_args{from} = $from_arg;
-    #<<<
-    try {
-        ($uuid) = $annex->git->config("remote." . $from_arg . ".annex-uuid");
-    } catch {
-        die "couldn't determine an annex UUID for $from_arg remote";
-    };
-    #>>>
-}
-$unused_opts{used_refspec} = $used_refspec_arg if $used_refspec_arg;
-
-my @to_drop;
-my @unused_files = @{ $annex->unused(%unused_opts, log => 1) };
-exit unless @unused_files;
-if ($just_print) {
-    say_spaced_bullet("There are unused files you can drop with"
-          . " `git annex dropunused':");
-    say "    " . $_->{number} . "     " . $_->{key} for @unused_files;
-    print "\n";
-}
-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 by using readpresentkey rather than
-    # checkpresentkey)
-    my $contentlocation = $annex->abs_contentlocation($unused_file->{key});
-    if ($from_arg) {
-        #<<<
-        try {
-            $annex->git->annex("readpresentkey", $unused_file->{key}, $uuid);
-        } catch {
-            splice @unused_files, $i, 1;
-            next UNUSED;
-        };
-        #>>>
-    } elsif (!$contentlocation) {
-        splice @unused_files, $i, 1;
-        next UNUSED;
-    }
-
-    system qw(clear -x) unless $just_print;
-    say_bold("unused file #" . $unused_file->{number} . ":");
-
-    if ($unused_file->{bad} or $unused_file->{tmp}) {
-        say "  looks like stale tmp or bad file, with key "
-          . $unused_file->{key};
-    } else {
-        my @log_lines = map { s/^/  /r } @{ $unused_file->{log_lines} };
-        unless ($just_print) {
-            # 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;
-        unless ($just_print) {
-            my $response;
-          READKEY: 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 $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 READKEY;
-                } elsif ($response eq "n") {
-                    last READKEY;
-                } elsif ($response eq "o" and defined $contentlocation) {
-                    system "xdg-open", $contentlocation;
-                } elsif ($response eq "b" and $i > 0) {
-                    $i--;
-                    $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";
-    $annex->git->annex("dropunused", \%dropunused_args, @to_drop)
-      if prompt_yn("Go ahead with this?");
-}
-
-# exit value represents whether or not there are any unused files left
-# after this run.  note that in --just-print mode, @to_drop will be
-# empty, so we'll always exit non-zero if there are any unused files
-exit(@to_drop != @unused_files);
-
-sub say_bold { print colored(['bold'], @_), "\n" }
-
-sub say_bullet { say_bold(" • ", @_) }
-
-sub say_spaced_bullet { say_bold("\n", " • ", @_, "\n") }
+use App::annex_review_unused;
+exit App::annex_review_unused->main;
diff --git a/lib/App/annex_review_unused.pm b/lib/App/annex_review_unused.pm
new file mode 100644
index 0000000..d170601
--- /dev/null
+++ b/lib/App/annex_review_unused.pm
@@ -0,0 +1,191 @@
+package App::annex_review_unused;
+# ABSTRACT: interactively process 'git annex unused' output
+#
+# Copyright (C) 2019-2020  Sean Whitton <spwhitton@spwhitton.name>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use 5.028;
+use strict;
+use warnings;
+
+use subs qw(main exit);
+use Getopt::Long;
+use Git::Annex;
+use Try::Tiny;
+use Term::ReadKey;
+use Term::ANSIColor;
+
+my $exit_main = 0;
+
+CORE::exit main unless caller;
+
+=func main
+
+Implementation of annex-review-unused(1).  Please see documentation
+for that command.
+
+=cut
+
+sub main {
+    my $annex = Git::Annex->new;
+
+    my $just_print = 0;
+    my ($uuid, $from_arg, $used_refspec_arg, %unused_opts, %dropunused_args);
+    GetOptions
+      'from=s'         => \$from_arg,
+      'used-refspec=s' => \$used_refspec_arg,
+      'just-print'     => \$just_print;
+    if ($from_arg) {
+        $unused_opts{from} = $dropunused_args{from} = $from_arg;
+    #<<<
+    try {
+        ($uuid) = $annex->git->config("remote." . $from_arg . ".annex-uuid");
+    } catch {
+        die "couldn't determine an annex UUID for $from_arg remote";
+    };
+    #>>>
+    }
+    $unused_opts{used_refspec} = $used_refspec_arg if $used_refspec_arg;
+
+    my @to_drop;
+    my @unused_files = @{ $annex->unused(%unused_opts, log => 1) };
+    exit unless @unused_files;
+    if ($just_print) {
+        _say_spaced_bullet("There are unused files you can drop with"
+              . " `git annex dropunused':");
+        say "    " . $_->{number} . "     " . $_->{key} for @unused_files;
+        print "\n";
+    }
+    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 by using readpresentkey rather than
+        # checkpresentkey)
+        my $contentlocation = $annex->abs_contentlocation($unused_file->{key});
+        if ($from_arg) {
+        #<<<
+        try {
+            $annex->git->annex("readpresentkey", $unused_file->{key}, $uuid);
+        } catch {
+            splice @unused_files, $i, 1;
+            next UNUSED;
+        };
+        #>>>
+        } elsif (!$contentlocation) {
+            splice @unused_files, $i, 1;
+            next UNUSED;
+        }
+
+        system qw(clear -x) unless $just_print;
+        _say_bold("unused file #" . $unused_file->{number} . ":");
+
+        if ($unused_file->{bad} or $unused_file->{tmp}) {
+            say "  looks like stale tmp or bad file, with key "
+              . $unused_file->{key};
+        } else {
+            my @log_lines = map { s/^/  /r } @{ $unused_file->{log_lines} };
+            unless ($just_print) {
+                # 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;
+            unless ($just_print) {
+                my $response;
+              READKEY: 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 $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 READKEY;
+                    } elsif ($response eq "n") {
+                        last READKEY;
+                    } elsif ($response eq "o" and defined $contentlocation) {
+                        system "xdg-open", $contentlocation;
+                    } elsif ($response eq "b" and $i > 0) {
+                        $i--;
+                        $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";
+        $annex->git->annex("dropunused", \%dropunused_args, @to_drop)
+          if prompt_yn("Go ahead with this?");
+    }
+
+    # exit value represents whether or not there are any unused files left
+    # after this run.  note that in --just-print mode, @to_drop will be
+    # empty, so we'll always exit non-zero if there are any unused files
+    exit(@to_drop != @unused_files);
+
+  EXIT_MAIN:
+    return $exit_main;
+}
+
+sub _say_bold { print colored(['bold'], @_), "\n" }
+
+sub _say_bullet { _say_bold(" • ", @_) }
+
+sub _say_spaced_bullet { _say_bold("\n", " • ", @_, "\n") }
+
+sub exit { $exit_main = shift // 0; goto EXIT_MAIN }
+
+1;
diff --git a/t/24_annex-review-unused.t b/t/24_annex-review-unused.t
index 30e4288..0e8742c 100755
--- a/t/24_annex-review-unused.t
+++ b/t/24_annex-review-unused.t
@@ -5,34 +5,31 @@ use strict;
 use warnings;
 use lib 't/lib';
 
+use App::annex_review_unused;
 use Test::More;
 use t::Setup;
+use t::Util;
 use File::chdir;
 use File::Spec::Functions qw(rel2abs);
-
-# make sure that `make test` will always use the right version of the
-# script we seek to test
-my $aru = "annex-review-unused";
-$aru = rel2abs "blib/script/annex-review-unused"
-  if -x "blib/script/annex-review-unused";
+use Capture::Tiny qw(capture_stdout);
 
 with_temp_annexes {
     my (undef, $source1) = @_;
+    my ($output, $exit);
 
     {
         local $CWD = "source1";
-        system $aru;
-        ok !$?, "it exits zero when no unused files";
+        (undef, undef, $exit) = run_bin "annex-review-unused";
+        ok !$exit, "it exits zero when no unused files";
         sleep 1;
         $source1->rm("foo/foo2/baz");
         $source1->commit({ message => "rm" });
-        my @output = `$aru --just-print`;
-        my $exit = $? >> 8;
-        ok $?, "it exits nonzero when unused files";
-        ok 20 < @output && @output < 30, "it prints ~two log entries";
-        like $output[5], qr/unused file #1/, "it prints an expected line";
+
+        ($output, undef, $exit) = run_bin qw(annex-review-unused --just-print);
+        ok $exit, "it exits nonzero when unused files";
+        ok 20 < @$output && @$output < 30, "it prints ~two log entries";
+        like $output->[5], qr/unused file #1/, "it prints an expected line";
     }
-}
-;
+};
 
 done_testing;
diff --git a/t/lib/t/Util.pm b/t/lib/t/Util.pm
index bb8f59e..b1312f5 100644
--- a/t/lib/t/Util.pm
+++ b/t/lib/t/Util.pm
@@ -8,8 +8,10 @@ use File::Slurp;
 use File::Spec::Functions qw(rel2abs);
 use File::chdir;
 use File::Temp qw(tempdir);
+use Try::Tiny;
+use Capture::Tiny qw(capture);
 
-our @EXPORT = qw( corrupt_annexed_file device_id_issues );
+our @EXPORT = qw( corrupt_annexed_file device_id_issues run_bin );
 
 sub corrupt_annexed_file {
     my ($git, $file) = @_;
@@ -37,4 +39,27 @@ sub device_id_issues {
     return($foo_id != $bar_id);
 }
 
+sub run_bin {
+    (my $bin = "App::" . shift) =~ tr/-/_/;
+    local @ARGV = @_;
+    my ($stdout, $stderr, $exit) = capture {
+        my $exit;
+        #<<<
+        # in order to simulate calling the program at the command
+        # line, convert exceptions into what happens when an ordinary
+        # perl script, invoked from the command line, calls 'die'
+        try {
+            $exit = $bin->main;
+        } catch {
+            say STDERR $_;
+            $exit = 255;
+        };
+        #>>>
+        return $exit;
+    };
+    my @stdout = split "\n", $stdout;
+    my @stderr = split "\n", $stderr;
+    return (\@stdout, \@stderr, $exit);
+}
+
 1;