view release on metacpan or  search on metacpan

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

sub read_ref {
    my ( $self, $ref ) = @_;
    my $repo = $self->_repo or return '';
    my $content = try {
        return '' unless $repo->reference_exists($ref);
        my $r      = $repo->reference($ref);
        my $oid    = $r->target;
        return '' unless $oid;
        my $commit = $repo->commit($oid);
        my $tree   = $commit->tree;
        my $entry  = $tree->entry_by_name('data');
        return '' unless $entry;
        return $repo->blob( $entry->{oid} )->content;
    } catch { '' };
    # Match historical CLI behaviour: cat-file's trailing newline was chomped.
    chomp $content if defined $content;
    return $content;
}

sub ref_exists {
    my ( $self, $ref ) = @_;
    my $repo = $self->_repo or return 0;
    return $repo->reference_exists($ref) ? 1 : 0;
}

sub delete_ref {
    my ( $self, $ref ) = @_;
    my $repo = $self->_repo or return 0;
    try { $repo->reference_delete($ref) };
    return 1;
}

# ----- Remote / network ops: native via Git::Native::Remote -----

sub has_remote {
    my ( $self, $remote ) = @_;
    $remote //= 'origin';
    my $repo = $self->_repo or return 0;
    return $repo->has_remote($remote);
}

# Default credentials callback: SSH-agent → ~/.ssh/id_ed25519 → ~/.ssh/id_rsa
# → default → fail. Matches CLI `git`'s implicit auth chain.
sub _default_credentials_cb {
    my @tried;
    return sub {
        my (%args) = @_;
        my $user  = $args{username_from_url} || 'git';
        my $types = $args{allowed_types}    || 0;

        # GIT_CREDENTIAL_SSH_KEY = 1<<1 = 2
        if ( $types & 2 ) {
            return Git::Native::Credential->ssh_agent( username => $user )
                unless $tried[0]++;
            for my $k (qw( id_ed25519 id_rsa )) {
                my $priv = "$ENV{HOME}/.ssh/$k";
                next unless -r $priv;
                next if $tried[1]{$k}++;
                return Git::Native::Credential->ssh_key(
                    username    => $user,
                    private_key => $priv,
                    public_key  => "$priv.pub",
                    passphrase  => '',
                );
            }
        }
        # GIT_CREDENTIAL_DEFAULT = 1<<3 = 8
        if ( ( $types & 8 ) && !$tried[2]++ ) {
            return Git::Native::Credential->default;
        }
        return undef;   # PASSTHROUGH — give up
    };
}

sub fetch {
    my ( $self, $remote ) = @_;
    $remote //= 'origin';
    my $repo = $self->_repo or return 0;
    return 1 unless $repo->has_remote($remote);
    return try {
        my $r = $repo->remote($remote);
        $r->fetch(
            refspecs    => [],   # use configured refspecs
            credentials => _default_credentials_cb(),
        );
        1;
    } catch { $self->{_last_error} = "$_"; 0 };
}

sub push {
    my ( $self, $remote, $refspec ) = @_;
    $remote //= 'origin';
    my $repo = $self->_repo or return 0;
    return 1 unless $repo->has_remote($remote);
    $refspec //= '+refs/karr/*:refs/karr/*';
    return try {
        my $r = $repo->remote($remote);
        $r->push(
            refspecs    => [$refspec],
            credentials => _default_credentials_cb(),
            prune       => 1,
        );
        1;
    } catch { $self->{_last_error} = "$_"; 0 };
}

sub pull {
    my ( $self, $remote ) = @_;
    $remote //= 'origin';
    my $repo = $self->_repo or return 0;
    return 1 unless $repo->has_remote($remote);
    return try {
        my $r = $repo->remote($remote);
        $r->fetch(
            refspecs    => ['refs/karr/*:refs/karr/*'],
            credentials => _default_credentials_cb(),
        );
        1;
    } catch { $self->{_last_error} = "$_"; 0 };
}