1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
#!/usr/bin/perl
# PODNAME: annex-to-annex-reinject
# ABSTRACT: use 'git annex reinject' to redo 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 <http://www.gnu.org/licenses/>.
=head1 SYNOPSIS
=head1 DESCRIPTION
=cut
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;
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");
sub is_empty_dir {
-d $_[0] or return 0;
opendir(my $dirh, $_[0]);
my @files = grep { $_ ne '.' && $_ ne '..' } readdir $dirh;
return @files == 0;
}
|
