From 4ee46956d3ed75bb3516a0e07a1235ef3c6c09ef Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 7 Feb 2020 23:43:50 -0700 Subject: convert remaining two scripts to App:: modules Signed-off-by: Sean Whitton --- lib/App/annex_to_annex_dropunused.pm | 74 +++++++++++++++++++ lib/App/annex_to_annex_reinject.pm | 136 +++++++++++++++++++++++++++++++++++ 2 files changed, 210 insertions(+) create mode 100644 lib/App/annex_to_annex_dropunused.pm create mode 100644 lib/App/annex_to_annex_reinject.pm (limited to 'lib') diff --git a/lib/App/annex_to_annex_dropunused.pm b/lib/App/annex_to_annex_dropunused.pm new file mode 100644 index 0000000..89b16b5 --- /dev/null +++ b/lib/App/annex_to_annex_dropunused.pm @@ -0,0 +1,74 @@ +package App::annex_to_annex_dropunused; +# ABSTRACT: drop old hardlinks migrated by annex-to-annex +# +# Copyright (C) 2019-2020 Sean Whitton +# +# 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 . + +use 5.028; +use strict; +use warnings; + +use autodie; +use Git::Annex; + +# This script used to have a --dest option which specified the +# destination annex previously used with annex-to-annex. Then, if the +# unused file had a hardlink count of 1, but was present in the +# destination annex, this script would drop it. +# +# That was somewhat dangerous functionality because it involves this +# script running `git annex dropunused --force` for files with a +# hardlink count of 1. And further, it is not actually needed, +# because running annex-to-annex-reinject after +# annex-to-annex-dropunused handles such files in a way that is safer. +# +# It is still good to run this script before annex-to-annex-reinject +# to make the latter faster. + +exit main() unless caller; + +=func main + +Implementation of annex-to-annex-dropunused(1). Please see +documentation for that command. + +=cut + +sub main { + my $annex = Git::Annex->new; + + my @to_drop; + my @unused_files = grep { !$_->{bad} && !$_->{tmp} } @{ $annex->unused }; + + foreach my $unused_file (@unused_files) { + my $content = $annex->abs_contentlocation($unused_file->{key}); + my $link_count = (stat $content)[3]; + my @logs + = $annex->git->log({ no_textconv => 1 }, "-S", $unused_file->{key}); + + next + unless $logs[0] + and $logs[0]->message =~ /migrated by annex-to-annex/; + next unless $link_count > 1; + + push @to_drop, $unused_file->{number}; + } + + $annex->git->annex("dropunused", { force => 1 }, @to_drop); + + return 0; +} + +1; diff --git a/lib/App/annex_to_annex_reinject.pm b/lib/App/annex_to_annex_reinject.pm new file mode 100644 index 0000000..c208d05 --- /dev/null +++ b/lib/App/annex_to_annex_reinject.pm @@ -0,0 +1,136 @@ +package App::annex_to_annex_reinject; +# ABSTRACT: annex-to-annex-reinject +# +# Copyright (C) 2019-2020 Sean Whitton +# +# 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 . + +use 5.028; +use strict; +use warnings; + +use autodie; +use Git::Annex; +use File::Basename qw(basename dirname); +use File::chmod; +$File::chmod::UMASK = 0; +use File::Path qw(rmtree); +use File::Spec::Functions qw(rel2abs); +use File::Find; +use Try::Tiny; + +exit main() unless caller; + +=func main + +Implementation of annex-to-annex-reinject(1). Please see +documentation for that command. + +=cut + +sub main { + die "usage: annex-to-annex-reinject SOURCEANNEX DESTANNEX\n" + unless @ARGV == 2; + + my $source = Git::Annex->new($ARGV[0]); + my $dest = Git::Annex->new($ARGV[1]); + #<<< + try { + $source->git->rev_parse({ git_dir => 1 }); + } catch { + die "$ARGV[0] doesn't look like a git repository ..\n"; + }; + try { + $dest->git->rev_parse({ git_dir => 1 }); + } catch { + die "$ARGV[1] doesn't look like a git repository ..\n"; + }; + #>>> + + # `git annex reinject` doesn't work in a bare repo atm + my $use_worktree + = ($dest->git->rev_parse({ is_bare_repository => 1 }))[0] eq 'true'; + my ($temp, $worktree); + if ($use_worktree) { + $temp = tempdir(CLEANUP => 1, DIR => dirname $ARGV[1]); + say "bare repo; our git worktree is in $temp"; + $dest->git->worktree("add", { force => 1, detach => 1 }, + rel2abs($temp), "synced/master"); + } + + my ($source_uuid) = $source->git->config('annex.uuid'); + die "couldn't get source annex uuid" + unless $source_uuid =~ /\A[a-z0-9-]+\z/; + my $spk = $source->batch("setpresentkey"); + + my ($source_objects_dir) + = $source->git->rev_parse({ git_path => 1 }, "annex/objects"); + $source_objects_dir = rel2abs $source_objects_dir, $ARGV[0]; + my $reinject_from = $use_worktree ? $temp : $ARGV[1]; + say "reinjecting from $source_objects_dir into $reinject_from"; + find({ + wanted => sub { + -f or return; + say "\nconsidering $_"; + my $dir = dirname $_; + chmod "u+w", $dir, $_; + system "git", "-C", $reinject_from, "annex", "reinject", + "--known", $_; + if (-e $_) { + chmod "u-w", $dir, $_; + } else { + my $key = basename $_; + say "telling setpresentkey process '$key $source_uuid 0'"; + say for $spk->say("$key $source_uuid 0"); + # alt. to setpresentkey: + # say "fscking key $key in $ARGV[0]"; + # system 'git', '-C', $ARGV[0], 'annex', 'fsck', + # '--numcopies=1', '--key', $key; + say "cleaning up empty dirs"; + foreach + my $d ($dir, dirname($dir), dirname(dirname($dir))) { + last unless _is_empty_dir($d); + rmdir $d; + } + } + }, + no_chdir => 1 + }, + $source_objects_dir + ); + if ($use_worktree) { + # we can't use `git worktree remove` because the way git-annex + # worktree support works breaks that command: git-annex replaces + # the .git worktree file with a symlink + rmtree $temp; + $dest->git->worktree("prune"); + } + + # cause setpresentkey changes to be recorded in git-annex branch + undef $spk; + sleep 1; + $source->git->annex("merge"); + + return 0; +} + + +sub _is_empty_dir { + -d $_[0] or return 0; + opendir(my $dirh, $_[0]); + my @files = grep { $_ ne '.' && $_ ne '..' } readdir $dirh; + return @files == 0; +} + +1; -- cgit v1.2.3