view release on metacpan or  search on metacpan

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

package App::annex_to_annex_reinject;
# ABSTRACT: annex-to-annex-reinject
#
# 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::annex_to_annex_reinject::VERSION = '0.008';
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;
use File::Temp qw(tempdir);

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 "";

    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