API-GitForge

 view release on metacpan or  search on metacpan

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

use API::GitForge::GitLab;

our @EXPORT_OK = qw(new_from_domain forge_access_token remote_forge_info);

our %known_forges = (
    "github.com"       => "API::GitForge::GitHub",
    "salsa.debian.org" => "API::GitForge::GitLab",
);


sub new_from_domain {
    my %opts = @_;
    croak "unknown domain" unless exists $known_forges{ $opts{domain} };
    $known_forges{ $opts{domain} }->new(%opts);
}


sub forge_access_token {
    my $domain = shift;
    my $root = $ENV{XDG_CONFIG_HOME} || catfile $ENV{HOME}, ".config";
    my $file = catfile $root, "gitforge", "access_tokens", $domain;
    -e $file and -r _ or croak "$file does not exist or is not readable";
    open my $fh, "<", $file or die "failed to open $file for reading: $!";
    chomp(my $key = <$fh>);
    $key;
}


sub remote_forge_info {
    my $remote = shift;
    my $git    = Git::Wrapper->new(getcwd);
    my ($uri) = $git->remote("get-url", $remote);
    $uri =~ m#^https?://([^:/@]+)/#
      or $uri =~ m#^(?:\w+\@)?([^:/@]+):#
      or croak "couldn't determine git forge info from $remote remote";
    ($1, $');
}

1;

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

use strict;
use warnings;

use Role::Tiny::With;

use Carp;
use Net::GitHub;

with "API::GitForge::Role::GitForge";

sub _make_api {
    my $self = shift;
    my %opts;
    $opts{access_token} = $self->{_access_token}
      if exists $self->{_access_token};
    $self->{_api} = Net::GitHub->new(%opts);
}

sub _ensure_fork {
    my ($self, $upstream) = @_;
    my ($org,  $repo)     = _extract_repo($upstream);

    my $repos       = $self->{_api}->repos;
    my $user        = $self->{_api}->user->show->{login};
    my @user_repos  = $repos->list_user($user);
    my $repo_exists = sub {
        grep { $_->{name} eq $repo } @user_repos;
    };
    if (&$repo_exists) {
        $self->_assert_fork_has_parent($upstream);
    } else {
        $repos->create_fork($org, $repo);
        until (&$repo_exists) {
            sleep 5;
            @user_repos = $repos->list_user($user);
        }
    }
    return "https://github.com/$user/$repo";
}

sub _assert_fork_has_parent {
    my ($self, $upstream) = @_;
    my (undef, $repo)     = _extract_repo($upstream);
    my $user = $self->{_api}->user->show->{login};
    my $fork = $self->{_api}->repos->get($user, $repo);

    $fork->{parent}{full_name} eq $upstream
      or croak
      "$user/$repo does not have parent $upstream; don't know what to do";
}

sub _clean_config_repo {
    my ($self, $target) = @_;
    my ($org,  $repo)   = _extract_repo($target);
    my $repos = $self->{_api}->repos;
    $repos->set_default_user_repo($org, $repo);
    $repos->update({
        name          => "$repo",
        has_wiki      => 0,
        has_issues    => 0,
        has_downloads => 0,
        has_pages     => 0,
        has_projects  => 0,
    });
}

sub _clean_config_fork {
    my ($self, $upstream) = @_;
    my (undef, $repo)     = _extract_repo($upstream);
    my $user = $self->{_api}->user->show->{login};

    my $repos = $self->{_api}->repos;
    $repos->set_default_user_repo($user, $repo);
    $repos->update({
        name           => "$repo",
        homepage       => "",
        description    => "Temporary fork for pull request(s)",
        default_branch => "gitforge",
    });

    $self->_clean_config_repo("$user/$repo");
}

sub _ensure_repo {
    my ($self, $target) = @_;
    my ($org,  $repo)   = _extract_repo($target);
    my $repos       = $self->{_api}->repos;
    my $user        = $self->{_api}->user->show->{login};
    my %create_opts = (name => $repo);
    my $list_method;
    if ($org eq $user) {
        $list_method = "list_user";
    } else {
        $list_method = "list_org";
        $create_opts{org} = $org unless $org eq $user;
    }
    my @list_repos  = $repos->$list_method($org);
    my $repo_exists = sub {
        grep { $_->{name} eq $repo } @list_repos;
    };
    unless (&$repo_exists) {
        $repos->create(\%create_opts);
        until (&$repo_exists) {
            sleep 5;
            @list_repos = $repos->$list_method($org);
        }
    }
    return "https://github.com/$org/$repo";
}

sub _nuke_fork {
    my ($self, $upstream) = @_;
    $self->_assert_fork_has_parent($upstream);
    my (undef, $repo)     = _extract_repo($upstream);
    my $user = $self->{_api}->user->show->{login};
    $self->{_api}->repos->delete($user, $repo);
}

sub _extract_repo {
    $_[0] =~ m#^([^/]+)/(.+)(?:\.git)?$#;
    ($1, $2);
}

1;

__END__

=pod

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

use strict;
use warnings;

use Role::Tiny::With;

use Carp;
use GitLab::API::v4;

with "API::GitForge::Role::GitForge";

sub _make_api {
    my $self = shift;
    my %opts = (url => "https://" . $self->{_domain} . "/api/v4");
    $opts{private_token} = $self->{_access_token}
      if exists $self->{_access_token};
    $self->{_api} = GitLab::API::v4->new(%opts);
}

sub _ensure_fork {
    my ($self, $upstream) = @_;
    my ($path, $repo)     = _extract_project_id($upstream);

    my $user = $self->{_api}->current_user->{username};
    my @user_repos;
    my $update_user_repos = sub {
        @user_repos
          = @{ $self->{_api}->projects({ search => "$user/$repo" }) };
    };
    my $repo_exists = sub {
        grep { $_->{path_with_namespace} eq "$user/$repo" } @user_repos;
    };
    &$update_user_repos;
    if (&$repo_exists) {
        $self->_assert_fork_has_parent($upstream);
    } else {
        $self->{_api}->fork_project("$path/$repo");
        until (&$repo_exists) {
            sleep 5;
            &$update_user_repos;
        }
    }
    return "https://" . $self->{_domain} . "/$user/$repo.git";
}

sub _assert_fork_has_parent {
    my ($self, $upstream) = @_;
    my ($path, $repo)     = _extract_project_id($upstream);
    my $user = $self->{_api}->current_user->{username};
    my $fork = $self->{_api}->project("$user/$repo");

    $fork->{forked_from_project}{path_with_namespace} eq $path . "/" . $repo
      or croak
      "$user/$repo does not have parent $upstream; don't know what to do";
}

sub _clean_config_repo {
    my ($self, $target) = @_;
    my ($ns,   $repo)   = _extract_project_id($target);

    $self->{_api}->edit_project(
        "$ns/$repo",
        {
            issues_access_level         => "disabled",
            merge_requests_access_level => "disabled",
        });
}

sub _clean_config_fork {
    my ($self, $upstream) = @_;
    my (undef, $repo)     = _extract_project_id($upstream);
    my $user = $self->{_api}->current_user->{username};

    $self->{_api}->edit_project(
        "$user/$repo",
        {
            default_branch      => "gitforge",
            description         => "Temporary fork for merge request(s)",
            issues_access_level => "disabled",
            # merge requests have to be enabled in the fork in order
            # to submit merge requests to the upstream repo from which
            # we forked, it seems
            merge_requests_access_level => "enabled",
        });
}

sub _ensure_repo {
    my ($self, $target) = @_;
    my ($ns,   $repo)   = _extract_project_id($target);
    return if $self->{_api}->project($target);
    my $namespace = $self->{_api}->namespace($ns)
      or croak "invalid project namespace $ns";
    $self->{_api}
      ->create_project({ name => $repo, namespace_id => $namespace->{id} });
}

sub _nuke_fork {
    my ($self, $upstream) = @_;
    $self->_assert_fork_has_parent($upstream);
    my (undef, $repo) = _extract_project_id($upstream);
    my $user = $self->{_api}->current_user->{username};
    $self->{_api}->delete_project("$user/$repo");
}

sub _ensure_fork_branch_unprotected {
    my ($self, $upstream, $branch) = @_;
    my (undef, $repo) = _extract_project_id($upstream);
    my $user = $self->{_api}->current_user->{username};
    return unless $self->{_api}->protected_branch("$user/$repo", $branch);
    $self->{_api}->unprotect_branch("$user/$repo", $branch);
}

sub _extract_project_id {
    my $project = shift;
    $project =~ s#(?:\.git)?/?$##;
    $project =~ m#/([^/]+)$#;
    ($`, $1);
}

1;

__END__

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

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;

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

    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;
}


sub nuke_fork { shift->_nuke_fork(@_) }


sub clean_config_repo { shift->_clean_config_repo(@_) }


sub clean_config_fork { shift->_clean_config_fork(@_) }

requires
  qw<_make_api _ensure_repo _clean_config_repo _clean_config_fork
     _ensure_fork _nuke_fork>;

1;

__END__

=pod

lib/App/git/clean_forge_fork.pm  view on Meta::CPAN

use Git::Wrapper;
use API::GitForge qw(new_from_domain forge_access_token remote_forge_info);
use Try::Tiny;
use Cwd;

my $exit_main = 0;

CORE::exit main unless caller;


sub main {
    shift if $_[0] and ref $_[0] eq "";
    local @ARGV = @{ $_[0] } if $_[0] and ref $_[0] ne "";

    my $term     = Term::ReadLine->new("brand");
    my $upstream = "origin";
    my $git      = Git::Wrapper->new(getcwd);
    #<<<
    try {
        $git->rev_parse({ git_dir => 1 });
    } catch {

lib/App/git/clean_forge_fork.pm  view on Meta::CPAN

        $fork_uri eq ($git->remote(qw(get-url fork)))[0]
          or die "fork remote exists but has wrong URI\n";
    } else {
        $git->remote(qw(add fork), $fork_uri);
    }

  EXIT_MAIN:
    return $exit_main;
}

sub exit { $exit_main = shift // 0; goto EXIT_MAIN }

__END__

=pod

=encoding UTF-8

=head1 NAME

App::git::clean_forge_fork - create tidy forks for pull requests

lib/App/git/clean_forge_repo.pm  view on Meta::CPAN

use Getopt::Long;
use Git::Wrapper;
use API::GitForge qw(new_from_domain forge_access_token remote_forge_info);
use Try::Tiny;

my $exit_main = 0;

CORE::exit main unless caller;


sub main {
    shift if $_[0] and ref $_[0] eq "";
    local @ARGV = @{ $_[0] } if $_[0] and ref $_[0] ne "";

    my $term   = Term::ReadLine->new("brand");
    my $remote = "origin";
    my $git    = Git::Wrapper->new(getcwd);
    #<<<
    try {
        $git->rev_parse({ git_dir => 1 });
    } catch {

lib/App/git/clean_forge_repo.pm  view on Meta::CPAN

    my $forge = new_from_domain
      domain       => $forge_domain,
      access_token => forge_access_token $forge_domain;
    $forge->clean_repo($forge_repo);

  EXIT_MAIN:
    return $exit_main;
}

sub exit { $exit_main = shift // 0; goto EXIT_MAIN }

__END__

=pod

=encoding UTF-8

=head1 NAME

App::git::clean_forge_repo - create repos on git forges with optional features disabled

lib/App/git/nuke_forge_fork.pm  view on Meta::CPAN

use API::GitForge qw(new_from_domain forge_access_token remote_forge_info);
use Try::Tiny;
use Cwd;
use Term::UI;

my $exit_main = 0;

CORE::exit main unless caller;


sub main {
    shift if $_[0] and ref $_[0] eq "";
    local @ARGV = @{ $_[0] } if $_[0] and ref $_[0] ne "";

    my $term     = Term::ReadLine->new("brand");
    my $upstream = "origin";
    my $git      = Git::Wrapper->new(getcwd);
    #<<<
    try {
        $git->rev_parse({ git_dir => 1 });
    } catch {

lib/App/git/nuke_forge_fork.pm  view on Meta::CPAN

    my $forge = new_from_domain
      domain       => $forge_domain,
      access_token => forge_access_token $forge_domain;
    $forge->nuke_fork($upstream_repo);
    $git->remote(qw(rm fork));

  EXIT_MAIN:
    return $exit_main;
}

sub exit { $exit_main = shift // 0; goto EXIT_MAIN }

__END__

=pod

=encoding UTF-8

=head1 NAME

App::git::nuke_forge_fork - delete forks created by git-clean-forge-fork(1)