view release on metacpan or  search on metacpan

lib/App/GitHubPullRequest.pm  view on Meta::CPAN

    # If no URL specified, just return the API URL
    return $prefix unless defined $url;
    # If URL already looks like a GitHub API URL, do nothing
    return $url if _is_api_url($url);
    # Create an API URL out of a partial URL as
    $url =~ s{^/*}{}; # Remove initial slashes, if any
    return $prefix . $url;
}

# Check if a URL is a GitHub API URL
sub _is_api_url {
    my ($url) = @_;
    croak("Please specify a URL to verify") unless $url;
    my $prefix = _api_url();
    return 1 if index($url, $prefix) == 0;
    return 0;
}

# Perform an API GET request
sub _api_read {
    my ($url, $return_on_error) = @_;
    my ($response, $code) = _get_url(
        _api_url($url),
        $return_on_error,
    );
    return decode_json($response), $code
        if $return_on_error;
    return decode_json($response);
}

# Perform an API POST request
sub _api_create {
    my ($url, $data, @rest) = @_;
    return decode_json(
        _post_url(
            _api_url($url),
            'application/json',
            encode_json($data),
            @rest,
        )
    );
}

# Perform an API PATCH request
sub _api_update {
    my ($url, $data) = @_;
    return decode_json(
        _patch_url(
            _api_url($url),
            'application/json',
            encode_json($data),
        )
    );
}

# Perform HTTP GET
sub _get_url {
    my ($url, $return_on_error) = @_;
    croak("Please specify a URL") unless $url;

    # See if we should use credentials
    my @credentials;
    if ( _is_api_url($url) ) {
        my $token = _qx('git', 'config github.pr-token');
        @credentials = ( '-H', "Authorization: token $token" ) if $token;
    }

    # Send request
    my ($content, $rc) = _run_ext(
        'curl',
        '-L',                            # follow redirects
        '-s',                            # be silent
        '-w', '%{http_code}',            # include HTTP status code at end of stdout
        @credentials,                    # Logon credentials, if any
        $url,                            # The URL we're GETing
    );
    die("curl failed to fetch $url with code $rc.\n") if $rc != 0;

    my $code = substr($content, -3, 3, '');

    return $content, $code if $return_on_error;

    if ( $code >= 400 ) {
        die("Fetching URL $url failed with code $code:\n$content");
    }

    return $content;
}

# Perform HTTP PATCH
sub _patch_url {
    my ($url, $mimetype, $data) = @_;
    croak("Please specify a URL") unless $url;
    croak("Please specify a mimetype") unless $mimetype;
    croak("Please specify some data") unless $data;

    # See if we should use credentials
    my @credentials;
    if ( _is_api_url($url) ) {
        my $token = _qx('git', 'config github.pr-token');
        die("You must login before you can modify information.\n")
            unless $token;
        @credentials = ( '-H', "Authorization: token $token" );
    }

    # Send request
    my ($content, $rc) = _run_ext(
        'curl',
        '-s',                            # be silent
        '-w', '%{http_code}',            # include HTTP status code at end of stdout
        '-X', 'PATCH',                   # perform an HTTP PATCH
        '-H', "Content-Type: $mimetype", # What kind of data we're sending
        '-d', $data,                     # Our data
        @credentials,                    # Logon credentials, if any
        $url,                            # The URL we're PATCHing
    );
    die("curl failed to patch $url with code $rc.\n") if $rc != 0;

    my $code = substr($content, -3, 3, '');
    if ( $code >= 400 ) {
        die("If you get 'Validation Failed' error without any reason,"
          . " most likely the pull request has already been merged or closed by the repo owner.\n"
          . "URL: $url\n"
          . "Code: $code\n"
          . $content
        ) if $code == 422;
        die("Patching URL $url failed with code $code:\n$content");
    }

    return $content;
}

# Perform HTTP POST
sub _post_url {
    my ($url, $mimetype, $data, $user, $password, $two_factor_token) = @_;
    croak("Please specify a URL") unless $url;
    croak("Please specify a mimetype") unless $mimetype;
    croak("Please specify some data") unless $data;

    # See if we should use credentials
    my @credentials;
    if ( _is_api_url($url) ) {
        my $token = _qx('git', 'config github.pr-token');
        die("You must login before you can modify information.\n")
            unless $token or ( $user and $password );
        if ( $user and $password ) {
            @credentials = ( '-u', "$user:$password" );
            push @credentials, '-H', "X-GitHub-OTP: $two_factor_token"
                if $two_factor_token;
        }
        else {
            @credentials = ( '-H', "Authorization: token $token" ) if $token;
        }
    }

    # Send request
    my ($content, $rc) = _run_ext(
        'curl',
        '-s',                            # be silent
        '-w', '%{http_code}',            # include HTTP status code at end of stdout
        '-X', 'POST',                    # perform an HTTP POST
        '-H', "Content-Type: $mimetype", # What kind of data we're sending
        '-d', $data,                     # Our data
        @credentials,                    # Logon credentials, if any
        $url,                            # The URL we're POSTing to
    );
    die("curl failed to post to $url with code $rc.\n") if $rc != 0;

    my $code = substr($content, -3, 3, '');
    if ( $code >= 400 ) {
        die("Posting to URL $url failed with code $code:\n$content");
    }

    return $content;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

App::GitHubPullRequest - Command-line tool to query GitHub pull requests

=head1 VERSION

version 0.6.0

=head1 SYNOPSIS

    $ git pr
    $ git pr list closed # not shown by default
    $ git pr show 7      # also includes comments
    $ git pr patch 7     # can be piped to colordiff if you like colors
    $ git pr checkout 7  # create upstream tracking branch pr/7
    $ git pr help

    $ git pr authorize   # Get access token for commands below
    $ git pr close 7
    $ git pr open 7
    $ git pr comment 7 'This is good stuff!'

=head1 INSTALLATION

Install it by just typing in these few lines in your shell:

    $ curl -L http://cpanmin.us | perl - --self-upgrade
    $ cpanm App::GitHubPullRequest

The following external programs are required:

=over 4

=item *

L<git(1)>

=item *

L<curl(1)>