view release on metacpan or  search on metacpan

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

        say "Give the token a name of your choice, e.g. 'git-pr', and give it the 'repo' permission.";
        say "The 'public_repo' permission is enough if you only plan to use it with public repositories.\n";
        $token = _prompt('GitHub OAuth personal access token');
    }
    # Make sure a token is specified
    die("No token was specified. No changes have been made to your configuration.\n")
        unless $token;
    # Store authorization token
    my ($content, $rc) = _run_ext(qw(git config --global github.pr-token), $token);
    die("git config returned message '$content' and code $rc when trying to store your token.\n")
        if $rc != 0;
    say "Access token stored successfully. Go to https://github.com/settings/tokens to revoke access.";
    return 0;
}

sub _state {
    my ($self, $number, $state) = @_;
    croak("Please specify a pull request number") unless $number;
    croak("Please specify a pull request state") unless $state;
    my $remote_repo = _find_github_remote();
    return _api_update(
        "/repos/$remote_repo/pulls/$number",
        { "state" => $state },
    );
}

sub _fetch_one {
    my ($self, $number) = @_;
    my $remote_repo = _find_github_remote();
    return _api_read("/repos/$remote_repo/pulls/$number");
}

sub _find_github_remote {
    # Parse lines from git and use first found github repo
    my @repos;
    my $repo_map = {};
    foreach my $line ( _qx('git', 'remote -v') ) {
        my ($remote, $url, $type) = split /\s+/, $line;
        next unless $type eq '(fetch)'; # only consider fetch remotes
        next unless $url =~ m/github\.com/; # only consider remotes to github
        if ( $url =~ m{github.com[:/](.+?)(?:\.git)?$} ) {
            push @repos, $1;
            $repo_map->{$1} = $remote;
        }
    }

    # Allow override for testing
    @repos = ( $ENV{"GITHUB_REPO"} ) if $ENV{'GITHUB_REPO'};

    die("No valid GitHub repos found.\n")
        unless @repos;

    # Try each repo found in turn
    while ( my $repo = shift @repos ) {
        print "Fetching GitHub repo: $repo\n"
            if DEBUG;
        # Fetch repo information
        my ($repo_info, $code) = _api_read("/repos/$repo", 'return_on_error');

        # Skip repo which is not found
        if ( $code eq 404 ) {
            print STDERR "WARNING: Skipping invalid GitHub repo: $repo\n";
            if ( $repo_map->{$repo} ) {
                print STDERR "WARNING:\n";
                print STDERR "WARNING: Remove invalid git remote with command:\n";
                print STDERR "WARNING:   git remote remove $repo_map->{$repo}\n";
                print STDERR "WARNING:\n";
            }
            next;
        }

        # Return the parent repo if repo is a fork
        return $repo_info->{'parent'}->{'full_name'}
            if $repo_info->{'fork'};

        # Not a fork, use this repo
        return $repo;
    }

    die("No valid GitHub repo found. List of remotes exhausted.\n");
}

# Ask the user for some information
# Disable local echo if $hide_echo is true (for passwords)
sub _prompt {
    my ($label, $hide_echo) = @_;
    _echo('off') if $hide_echo;
    print "$label: " if defined $label;
    my $input = scalar <STDIN>;
    chomp $input;
    print "\n";
    _echo('on') if $hide_echo;
    return $input;
}

# Turn local echo on or off (Unix only for now)
sub _echo {
    my ($state) = @_;
    croak("Please specify an echo state of on or off") unless $state;

    # Test if we're on Unix (snatched from Platform::Unix)
    my $is_unix = $^O =~ /^(Linux|.*BSD.*|.*UNIX.*|Darwin|Solaris|SunOS|Haiku|Next|dec_osf|svr4|sco_sv|unicos.*|.*x)$/i;

    if ( $is_unix ) {
        return _run_ext(qw{stty -echo}) if $state eq 'off';
        return _run_ext(qw{stty echo})  if $state eq 'on';
    }

    # Don't know how to turn local echo on or off on other platforms.
    # If you happen to know how, please send a pull request with a fix
    return;
}

# Generate a random temporary filename with the given prefix
sub _tmpfile {
    my ($prefix) = @_;
    $prefix = defined $prefix ? "${prefix}-" : '';
    $prefix =~ s{[^A-Za-z0-9_-]}{-}g;
    srand($$ + time);
    my $random = $$;
    $random .= int(rand(10)) for 1..10;