1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
package API::GitForge;
# ABSTRACT: generic interface to APIs of sites like GitHub, GitLab etc.
#
# Copyright (C) 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/>.
=head1 SYNOPSIS
# try to autodetect the forge type; works for GitHub and some others
my $github = API::GitForge->new_from_domain(
domain => "github.com",
access_key => "12345678"
);
# specify the forge type yourself by instantiating the right class
my $salsa = API::GitForge::GitLab->new(
domain => "salsa.debian.org",
access_key => "abcdef"
);
# generic user operations regardless of the forge type
$github->clean_fork("spwhitton/git-remote-gcrypt");
$salsa->clean_fork("Debian/devscripts");
=head1 STATUS
Unstable. Interface may change.
=head1 DESCRIPTION
A I<git forge> is a site like GitHub, GitLab etc. This module
provides access to some operations which one might wish to perform
against any git forge, wrapping the details of the APIs of particular
forges. An example of such an operation is forking a repository into
the user's own namespace.
See L<API::GitForge::Role::GitForge> for details of all the currently
supported operations. Patches adding other operations, and support
for other git forges, are welcome.
=cut
use 5.028;
use strict;
use warnings;
use Carp;
use Exporter "import";
use File::Spec::Functions qw(catfile);
use Git::Wrapper;
use Cwd;
use API::GitForge::GitHub;
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",
);
=func new_from_domain domain => $domain, access_key => $key
Instantiate an object representing the GitForge at C<$domain> which
does L<API::GitForge::Role::GitForge>. This function will only
succeed for known forges; see C<%API::GitForge::known_forges>. The
C<access_key> argument is optional; if present, it should be an API
key for the forge.
$API::GitForge::known_forges{"ourlab.com"} = "API::GitForge::GitLab";
my $ourlab = API::GitForge::new_from_domain(
domain => "ourlab.com",
access_key => API::GitForge::forge_access_token("ourlab.com")
);
=cut
sub new_from_domain {
my %opts = @_;
croak "unknown domain" unless exists $known_forges{ $opts{domain} };
$known_forges{ $opts{domain} }->new(%opts);
}
=func forge_access_token $domain
Return access token for forge at C<$domain>, assumed to be stored
under C<$ENV{XDG_CONFIG_HOME}/gitforge/access_tokens/$domain> where
the environment variable defaults to C<~/.config> if unset.
=cut
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;
}
=func remote_forge_info $remote
Look at the URL for git remote C<$remote>, as returned by C<git remote
get-url>, assume that this remote is a git forge, and return the
domain name of that forge and the path to the repository.
system qw(git remote add salsa https://salsa.debian.org/spwhitton/foo);
my ($forge_domain, $forge_repo) = API::GitForge::remote_forge_info("salsa");
say $forge_domain; # outputs 'salsa.debian.org'
say $forge_repo; # outputs 'spwhitton/foo'
=cut
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;
|
