view release on metacpan or  search on metacpan

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

package App::annex_to_annex;
# ABSTRACT: use hardlinks to migrate files between git annex repos
#
# 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::VERSION = '0.008';
use 5.028;
use strict;
use warnings;

use autodie;
use subs qw(main exit);
use Digest::MD5::File qw(file_md5);
use File::Basename qw(dirname basename);
use File::Copy;
use File::Find;
use File::Spec::Functions qw(catfile rel2abs abs2rel);
use Try::Tiny;
use Git::Annex;

my $exit_main = 0;

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

    # only support v7 because supporting v5 too would make things quite
    # complex.  require git-annex >=7.20191009 because it will refuse to
    # work in v5 repos, and because it supports `git annex find --unlocked`
    chomp(my %annex_version_fields = map { split ': ' } `git annex version`);
    die "I need git-annex >=7.20191009 and a v7 repository\n"
      unless $annex_version_fields{'git-annex version'} >= 7.20191009;

    die "need at least two arguments\n" unless @ARGV > 1;
    my $dest = rel2abs pop @ARGV;
    die "dest is not a directory\n" unless -d $dest;
    my $dest_device_id = (stat($dest))[0];
    my $dannex         = Git::Annex->new($dest);
    my $do_commit      = 0;
    if ($ARGV[0] eq '--commit') {
        $do_commit = 1;
        shift @ARGV;

        my @git_status = $dannex->git->RUN("status", { porcelain => 1 });
        die "git repo containing $dest is not clean; please commit\n"
          unless @git_status == 0;

        #<<<
        try {
            $dannex->git->symbolic_ref({ quiet => 1 }, "HEAD");
        } catch {
            die "$dest has a detached HEAD; aborting";
        };
        #>>>
    }
    my @sources = map rel2abs($_), @ARGV;

    # process one entry in @sources at a time because we can start up
    # annex batch processes for each of these as all files under each
    # entry in @sources will lie in the same annex
    foreach my $source (@sources) {
        my $dir   = dirname $source;
        my $annex = Git::Annex->new($dir);
        #<<<
        try {
            $annex->annex->status;
        } catch {
            die "$source does not appear to lie within an annex\n";
        };
        #>>>
        die "$source does not exist\n" unless -e $source;

        if ($do_commit) {
            my @git_status = $annex->git->RUN("status", { porcelain => 1 });
            die "git repo containing $source is not clean; please commit\n"
              unless @git_status == 0;

            #<<<
            try {
                $annex->git->symbolic_ref({ quiet => 1 }, "HEAD");
            } catch {
                die "$dest has a detached HEAD; aborting";
            };
            #>>>
        }