view release on metacpan or  search on metacpan

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

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/>.
$API::GitForge::VERSION = '0.007';

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",
);


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;

__END__

=pod

=encoding UTF-8

=head1 NAME