view release on metacpan or  search on metacpan

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

sub _qx {
    my ($cmd, @rest) = @_;
    _require_binary($cmd);
    $cmd .= " " . join(" ", @rest) if @rest;
    warn("_qx: $cmd\n") if DEBUG;
    return map { chomp; $_ } qx{$cmd}
        if wantarray;
    my $content = qx{$cmd};
    chomp $content;
    return $content;
}

# Run an external command and return STDOUT and exit code
## no critic (Subroutines::RequireArgUnpacking)
sub _run_ext {
    croak("Please specify a command line") unless @_;
    my $cmd = join(" ", @_);
    my $prg = $_[0];
    warn("_run_ext: $cmd\n") if DEBUG;
    _require_binary($prg);
    CORE::open my $fh, "-|", @_ or die("Can't run command '$cmd': $!");
    my $stdout = join("", <$fh>);
    CORE::close $fh;
    my $rc = $? >> 8; # exit code, see perldoc perlvar for details
    return $stdout, $rc;
}
## use critic

# Make sure a program is present in path
sub _require_binary {
    my ($bin) = @_;
    croak("Please specify program to require") unless $bin;
    state %cache;
    unless (exists $cache{$bin}) {
        # Cache miss, let's see if we can find that program
        warn("Checking if '$bin' exists in path\n") if DEBUG;
        # Figure out path elements in a cross-platform way and go through
        # each and check if it has the executable program in it
        my @path = File::Spec->path();
        while (my $dir = shift @path) {
            my $file = File::Spec->catfile($dir, $bin);
            warn("Looking for executable bit on '$file'\n") if DEBUG;
            ## no critic (ValuesAndExpressions::ProhibitCommaSeparatedStatements)
            $cache{$bin} = $file, last if -x $file;
            ## use critic
            $cache{$bin} = 0;
        }
        warn("'$bin' was found at '$cache{$bin}'\n") if DEBUG and $cache{$bin};
    }
    return 1 if $cache{$bin};
    die("You need the program '$bin' in your path to use this feature.\n");
}

# Return the base GitHub API URL as mentioned
# on http://developer.github.com/v3/
sub _api_url {
    my ($url) = @_;
    my $prefix = 'https://api.github.com/';
    # 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) ) {