view release on metacpan or  search on metacpan

lib/Git/Annex.pm  view on Meta::CPAN

#
# 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/>.
$Git::Annex::VERSION = '0.008';

use 5.028;
use strict;
use warnings;

use Cwd;
use File::chdir;
use Git::Wrapper;
use Git::Repository;
use Try::Tiny;
use File::Spec::Functions qw(catfile rel2abs);
use Storable;
use Data::Compare;
use List::Util qw(all);
use Time::HiRes qw(stat time);
use Git::Annex::BatchCommand;
use IPC::System::Simple qw(capturex);


sub new {
    my ($class, $toplevel) = @_;

    $toplevel = $toplevel ? rel2abs($toplevel) : getcwd;

    # if we're in a working tree, rise up to the root of the working
    # tree -- for flexibility, don't require that we're actually in a
    # git repo at all
    my $pid = fork;
    die "fork() failed: $!" unless defined $pid;
    if ($pid) {
        wait;
        chomp($toplevel = capturex "git",
            "-C", $toplevel, "rev-parse", "--show-toplevel")
          if $?;
    } else {
        close STDERR;
        my $output;
        try {
            $output = capturex "git", "-C", $toplevel, "rev-parse",
              "--is-inside-work-tree";
        };
        exit($output and $output =~ /true/);
    }

    bless { toplevel => $toplevel } => $class;
}


sub toplevel { shift->{toplevel} }


sub git {
    my $self = shift;
    $self->{git} //= Git::Wrapper->new($self->toplevel);
}

# =attr repo

# Returns an instance of L<Git::Repository> initialised in the repository.

# =cut

# has repo => (
#     is => 'lazy',
#     # we don't know (here) whether our repo is bare or not, so we
#     # don't know whether to use the git_dir or work_tree arguments to
#     # Git::Repository::new, so we chdir and let call without arguments
#     default => sub { local $CWD = shift->toplevel; Git::Repository->new });


sub unused {
    my ($self, %opts) = @_;
    $opts{log} //= 0;
    my $used_refspec_config;
    try { ($used_refspec_config) = $self->git->config("annex.used-refspec") };
    $opts{used_refspec}
      //= ($used_refspec_config // "+refs/heads/*:-refs/heads/synced/*");

    my %unused_args;
    for (qw(from used_refspec)) {
        $unused_args{$_} = $opts{$_} if defined $opts{$_};
    }

    $self->{_unused} //= retrieve $self->_unused_cache
      if -e $self->_unused_cache;
    # see if cache needs to be invalidated, whether or not we just
    # retrieved it
    if (defined $self->{_unused}) {
        my $git_annex_unused = $self->_git_path(qw(annex unused));
        my $last_unused      = (stat $git_annex_unused)[9];
        my %branch_timestamps
          = map { split }
          $self->git->for_each_ref(
            { format => '%(refname:short) %(committerdate:unix)' },
            "refs/heads/");

        # we don't need to invalidate the cache if the git-annex
        # branch has changed, because the worst that can happen is we
        # try to drop a file which has already been dropped
        delete $branch_timestamps{'git-annex'};

        $self->_clear_unused_cache
          unless $last_unused <= $self->{_unused}{timestamp}
          and Compare(\%unused_args, $self->{_unused}{unused_args})
          and all { $_ < $last_unused } values %branch_timestamps;