diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2020-02-12 19:09:08 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2020-02-12 19:09:08 -0700 |
commit | 5b1ffc06ef40a97d502399cb7a74412b039fd404 (patch) | |
tree | f9a0ced75e7b09ac89396324b51d5c166fd3f5dc /perl5 | |
parent | 4aadd8850e1f0a02e777d193e2081e8841b99356 (diff) | |
download | dotfiles-5b1ffc06ef40a97d502399cb7a74412b039fd404.tar.gz |
drop code migrated to Git-Annex CPAN distribution & use that dist
Diffstat (limited to 'perl5')
-rw-r--r-- | perl5/Local/MrRepo/Repo/Git/Annex.pm | 265 |
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; |