view release on metacpan or  search on metacpan

lib/API/GitForge/Role/GitForge.pm  view on Meta::CPAN

package API::GitForge::Role::GitForge;
# ABSTRACT: role implementing generic git forge operations
#
# Copyright (C) 2017, 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/>.
$API::GitForge::Role::GitForge::VERSION = '0.007';

use 5.028;
use strict;
use warnings;

use Role::Tiny;

use Carp;
use File::Temp qw(tempdir);
use Git::Wrapper;
use File::Spec::Functions qw(catfile);


sub new {
    my ($class, %opts) = @_;
    croak "need domain!" unless exists $opts{domain};

    my %attrs = (_domain => $opts{domain});
    $attrs{_access_token} = $opts{access_token} if exists $opts{access_token};
    my $self = bless \%attrs => $class;

    $self->_make_api;

    return $self;
}


sub ensure_repo { shift->_create_repo(@_) }


sub clean_repo {
    my ($self, $repo) = @_;
    $self->_ensure_repo($repo);
    $self->_clean_config_repo($repo);
}


sub ensure_fork { shift->_ensure_fork(@_) }


sub clean_fork {
    my $self     = shift;
    my $fork_uri = $self->_ensure_fork($_[0]);

    my $temp = tempdir CLEANUP => 1;
    my $git = Git::Wrapper->new($temp);
    $git->init;
    my @fork_branches
      = map { m#refs/heads/#; $' } $git->ls_remote("--heads", $fork_uri);
    return $fork_uri if grep /\Agitforge\z/, @fork_branches;

    open my $fh, ">", catfile $temp, "README.md";
    say $fh "This repository exists only in order to submit pull request(s).";
    close $fh;
    $git->add("README.md");
    $git->commit({ message => "Temporary fork for pull request(s)" });

    # We should be able to just say
    #
    #     $git->push($fork_uri, "master:gitforge");
    #
    # but that hangs indefinitely when pushing to (at least) Debian's
    # GitLab instance.  So just bypass Git::Wrapper and do the push
    # ourselves for now
    system qw(git -C), $git->dir, "push", $fork_uri, "master:gitforge";
    $! and croak "failed to push the gitforge branch to $fork_uri";

    $self->_clean_config_fork($_[0]);

    # assume that if we had to create the gitforge branch, we just
    # created the fork, so can go ahead and nuke all branches there.
    if ($self->can("_ensure_fork_branch_unprotected")) {
        $self->_ensure_fork_branch_unprotected($_[0], $_) for @fork_branches;
    }
    # may fail if we couldn't unprotect; that's okay
    eval { $git->push($fork_uri, "--delete", @fork_branches) };

    return $fork_uri;
}