view release on metacpan or  search on metacpan

lib/App/git_annex_reviewunused.pm  view on Meta::CPAN

package App::git_annex_reviewunused;
# 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/>.
$App::git_annex_reviewunused::VERSION = '0.008';
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;


sub main {
    shift if $_[0] and ref $_[0] eq ""; # in case main called as a class method
    local @ARGV = @{ $_[0] } if $_[0] and ref $_[0] ne "";

    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 = grep {
        # 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 $ret = $_->{contentlocation}
          = $annex->abs_contentlocation($_->{key});

        if ($from_arg) {
            #<<<
            try {
                $annex->annex->readpresentkey($_->{key}, $uuid);
            } catch {
                $ret = 0;
            };
            #>>>
        }

        $ret;
    } $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];
        my $contentlocation = $unused_file->{contentlocation};

        system qw(clear -x) unless $just_print;
        _say_bold("unused file #" . $unused_file->{number} . ":");

        if ($unused_file->{bad} or $unused_file->{tmp}) {