diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2023-05-16 13:16:41 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2023-05-17 15:59:14 -0700 |
commit | 5bfe0e6e3665579d9834030e1b282805cd80f5ea (patch) | |
tree | 148e2e67a94646ec961cd5ea7592a10760f5d853 | |
parent | 268480b3de5778c2c946a5ee0397a359511e183a (diff) | |
download | dotfiles-5bfe0e6e3665579d9834030e1b282805cd80f5ea.tar.gz |
add empty-annexes-from
-rwxr-xr-x | scripts/git/empty-annexes-from | 84 |
1 files changed, 84 insertions, 0 deletions
diff --git a/scripts/git/empty-annexes-from b/scripts/git/empty-annexes-from new file mode 100755 index 00000000..d4eba167 --- /dev/null +++ b/scripts/git/empty-annexes-from @@ -0,0 +1,84 @@ +#!/usr/bin/env perl +use 5.036; + +# This is for emptying a machine that's about to be reinstalled, scrapped etc. +# Assume HOME is the same there as here, and that it uses my ~/.mrconfig. +# We then process only annexes checked out both here and there. +# Before running this, mount a backup drive, s.t. git-annex is more likely to +# be happy about the number of copies that will remain after moving to here. + +use Git::Annex; +use experimental "try"; + +our @leave_used = qw(lib/priv); + +@ARGV == 1 or die "Exactly one argument required\n"; +my $remote = $ARGV[0]; +$remote =~ /\A[a-z]+\z/ or die "Remote name $remote not a short hostname?\n"; +chdir; +my @annexes; +for (`mr ls`) { + chomp; + /^mr list: (?=\/)/ and -d $' or next; + `git -C $' annex status 2>/dev/null`; + $? and next; + `ssh $remote git -C $' annex status 2>/dev/null`; + $? or push @annexes, Git::Annex->new($'); +} + +my @not_done; + +foreach my $annex (@annexes) { + my $tl = $annex->toplevel; + say "Processing $tl"; + (my $rel = $tl) =~ s#\A\Q$ENV{HOME}\E/##; + try { + my ($url) = $annex->git->remote("get-url", $remote); + $url =~ /\A$remote:\Q$rel\E\z/ + or die "$tl $remote remote URL form not recognised\n"; + } catch ($e) { + $e =~ /No such remote/ + ? $annex->git->remote("add", $remote, "$remote:$rel") + : die $e + } + + $annex->annex->sync(qw(--no-content origin), $remote); + $annex->annex->untrust($remote); + + chdir $tl; + if (grep $_ eq $rel, @leave_used) { + $annex->annex->unused({ + used_refspec => +"+refs/remotes/$remote/master:+refs/remotes/$remote/synced/master", + from => $remote + }); + system(qw(git annex move --unused --numcopies=1), "--from=$remote") + == 0 + or die "'git annex move --unused' for $rel exited non-zero\n"; + push @not_done, $rel; + $annex->annex->sync(qw(--no-content origin), $remote); + } else { + $annex->annex->wanted($remote, "standard"); + $annex->annex->required($remote, "standard"); + $annex->annex->ungroup($remote, $_) + for split " ", ($annex->annex->group($remote))[0]; + $annex->annex->group($remote, "unwanted"); + system qw(git annex move --all), "--from=$remote"; + + my @objects = `ssh $remote find $tl/.git/annex/objects`; + if ( @objects == 1 + and $? == 0 + and system("ssh $remote git -C $tl annex uninit") == 0) { + $annex->annex->dead($remote); + $annex->annex->sync("origin"); + } else { + push @not_done, $rel; + $annex->annex->sync("origin", $remote); + } + } + + $annex->git->remote("rm", $remote); +} + +$" = ", "; +warn "Annexes that remain on $remote: @not_done\n" if @not_done; |