view release on metacpan or  search on metacpan

lib/App/karr/Git.pm  view on Meta::CPAN

    }

    # Read before the push, never after -- see L</push>: a ref written in
    # between is published without being in the snapshot, which leaves the
    # mirror lagging the remote, the direction that converges harmlessly.
    my $local      = $self->ref_oids(FOUNDATION_ROOT) || {};
    my $tombstones = $self->_pending_deletes(FOUNDATION_ROOT);
    # A tombstone whose ref is back in the namespace is stale, not a deletion.
    my @deletes = grep { !exists $local->{$_} } sort keys %$tombstones;

    # Nothing here and nothing deleted is nothing to say, and saying it would
    # be an error: a wildcard refspec matching no local ref, sent on its own,
    # makes git exit non-zero ("No refs in common and none specified"), so
    # every repository that is not the hub would end `karr sync` complaining
    # about a namespace it does not have. This is also what keeps the second
    # round trip off the boards that never carry fleet state.
    return 1 unless %$local || @deletes;

    my @refspecs = ( FOUNDATION_REFSPEC, map { ":$_" } @deletes );
    return 0 unless $self->_push_refspecs( $remote, \@refspecs );

    $self->_mirror_local_state( $remote, $local, \@deletes,
        FOUNDATION_ROOT, FOUNDATION_MIRROR_ROOT );
    $self->_clear_pending_deletes( $tombstones, \@deletes );
    return 1;
}


sub _reconcile_foundation {
    my ( $self, $remote, $prefix, $tracked ) = @_;
    return unless $self->_repo;

    my ($plan) = $self->_mirror_plan( FOUNDATION_ROOT, $prefix, $tracked );

    my ( @conflicts, @unapplied, @stale );
    for my $step (@$plan) {
        my ( $ref, $oid, undef, $conflict ) = @$step;
        my $applied = defined $oid
            ? $self->_write_ref_untracked( $ref, $oid )
            : $self->_delete_ref_untracked($ref);
        if ($applied) {
            CORE::push @conflicts, $ref if $conflict;
            next;
        }
        # Same rule as the board's: the mirror goes back to what this ref had
        # before the fetch, and the pull stops (#154).
        CORE::push @unapplied, $ref;
        CORE::push @stale, $self->_rollback_mirror_ref(
            $prefix, $tracked, $ref, FOUNDATION_ROOT );
    }

    $self->_warn_foundation_conflicts( $remote, \@conflicts ) if @conflicts;
    die $self->_unapplied_refs_error( $remote, \@unapplied, \@stale )
        if @unapplied;
    return;
}

# Said, but not parked. The board keeps the losing side under
# refs/karr-conflict/ because a displaced card is something a person reads back
# and re-applies; a displaced chain step is a plan, and the answer to a plan
# that lost a race is another planning round, not an archaeology dig. What is
# worth saying is that it happened at all: two planners writing one chain is
# the condition, and the operator is the only one who can end it.
sub _warn_foundation_conflicts {
    my ( $self, $remote, $refs ) = @_;
    my $names = join ', ', map { substr $_, length FOUNDATION_ROOT } @$refs;
    warn "karr: this clone and the remote '$remote' both changed $names "
       . "under " . FOUNDATION_ROOT . " since the last sync.\n"
       . "The remote version is now in place and the local one is not kept. "
       . "Re-plan rather than re-edit.\n";
    return;
}

# Fallback transport via the system `git` CLI so that ssh-config directives
# libgit2 ignores (ProxyCommand, Host aliases, IdentityFile, insteadOf) are
# honoured. Returns 1 on success, 0 on failure (setting _last_error to the real
# git-CLI stderr). $verb is 'push' or 'fetch'. @$refspecs may be empty
# (fetch => configured refspecs). %opt: prune => bool. Disabled by
# KARR_NO_CLI_FALLBACK=1.
#
# `push` runs with --porcelain so the per-ref outcomes come back parseable.
# The CLI already exits non-zero on a rejection, so the failure was never
# invisible here the way it was natively (#84) -- but the error contract has
# to be the same on both transports, or "which ref did the server refuse, and
# why" would depend on which one happened to run.
sub _cli_transport {
    my ( $self, $verb, $remote, $refspecs, %opt ) = @_;
    return 0 if $ENV{KARR_NO_CLI_FALLBACK};

    my @args = ($verb);
    CORE::push @args, '--porcelain' if $verb eq 'push';
    CORE::push @args, '--prune' if $opt{prune};
    CORE::push @args, $remote, @$refspecs;

    my $native = $self->{_last_error};
    my $run    = $self->_run_git(@args);

    if ( $run->{failure} eq 'start' ) {
        $self->{_last_error} =
            "git CLI fallback unavailable: $run->{err}"
          . ( defined $native ? " (native: $native)" : '' );
        return 0;
    }

    my $detail = $run->{err};
    $detail =~ s/\s+\z//;
    my $suffix = length $detail ? ": $detail" : '';

    if ( $run->{failure} eq 'timeout' ) {
        $self->{_last_error} = "git $verb (CLI fallback) timed out after "
          . "$run->{timeout}s and was killed$suffix";
        return 0;
    }

    # `$? >> 8` is 0 both for "exited cleanly" and for "died from a signal",
    # so a git the OOM killer, a Ctrl-C on the process group or a SIGPIPE took
    # down used to be reported as a successful transport -- the task was
    # announced as created and the remote never saw it (#42). The signal bits
    # have to be read first.
    if ( my $sig = $run->{status} & 127 ) {
        $self->{_last_error} =