view release on metacpan or  search on metacpan

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

    my $baseurl = URI->new(config('baseurl'));
    my ($fh, $credfile) = credential_description_file($baseurl, $password);

    return system("git credential $what <$credfile") == 0;
}

# The get_message routine returns the message argument to the
# --message option. If the option is not present it invokes the git
# editor to let the user compose a message and returns it.

sub get_message {
    return $Options{message} if exists $Options{message};

    chomp(my $editor = qx/git var GIT_EDITOR/);

    error "Please, read 'git help var' to know how to set up an editor for git messages."
        unless $editor;

    require File::Temp;
    my $tmp = File::Temp->new();
    my $filename = $tmp->filename;

    {
        open my $fh, '>', $filename
            or error "Can't open file for writing ($filename): $!\n";
        print $fh <<'EOF';

# Please enter the review message for this change. Lines starting
# with '#' will be ignored, and an empty message aborts the review.
EOF
        close $fh;
    }

    cmd "$editor $filename"
        or error "Aborting because I couldn't invoke '$editor $filename'.";

    my $message;
    {
        open my $fh, '<', $filename
            or error "Can't open file for reading ($filename): $!\n";
        local $/ = undef;       # slurp mode
        $message = <$fh>;
        close $fh;
    }
    $message =~ s/(?<=\n)#.*?\n//gs; # remove all lines starting with '#'
    return $message;
}

# The gerrit routine keeps a cached Gerrit::REST object to which it
# relays REST calls.

sub gerrit {
    my $method = shift;

    state $gerrit;
    unless ($gerrit) {
        my ($username, $password) = get_credentials;
        require Gerrit::REST;
        $gerrit = Gerrit::REST->new(config('baseurl'), $username, $password);
        eval { $gerrit->GET("/projects/" . uri_escape_utf8(config('project'))) };
        if (my $error = $@) {
            set_credentials($username, $password, 'reject') if $error->{code} == 401;
            die $error;
        } else {
            set_credentials($username, $password, 'approve');
        }
    }

    if ($Options{debug}) {
        my ($endpoint, @args) = @_;
        debug "GERRIT->$method($endpoint)";
        if (@args) {
            require Data::Dumper;
            warn Data::Dumper::Dumper(@args);
        }
    }

    return $gerrit->$method(@_);
}

# The gerrit_or_die routine relays its arguments to the gerrit routine
# but catches any exception and dies with a formatted message. It
# should be called instead of gerrit whenever the caller doesn't want
# to treat exceptions.

sub gerrit_or_die {
    my $result = eval { gerrit(@_) };
    die $@->as_text if $@;
    return $result;
}

# The normalize_date routine removes the trailing zeroes from a $date.

sub normalize_date {
    my ($date) = @_;
    $date =~ s/\.0+$//;
    return $date;
}

# The query_changes routine receives a list of strings to query the
# Gerrit server. It returns an array-ref containing a list of
# array-refs, each containing a list of change descriptions.

sub query_changes {
    my @queries = @_;

    return [] unless @queries;

    # If we're inside a git repository, restrict the query to the
    # current project's reviews.
    if (my $project = config('project')) {
        $project = uri_escape_utf8($project);
        @queries = map "q=project:$project+$_", @queries;
    }

    push @queries, "n=$Options{limit}" if $Options{limit};

    push @queries, "o=LABELS";

    my $changes = gerrit_or_die(GET => "/changes/?" . join('&', @queries));
    $changes = [$changes] if ref $changes->[0] eq 'HASH';

    return $changes;
}

# The get_change routine returns the description of a change
# identified by $id. An optional boolean second argument ($allrevs)
# tells if the change description should contain a description of all
# patchsets or just the current one.

sub get_change {
    my ($id, $allrevs) = @_;

    my $revs = $allrevs ? 'ALL_REVISIONS' : 'CURRENT_REVISION';
    return (gerrit_or_die(GET => "/changes/?q=change:$id&o=$revs"))[0][0];
}

# The current_branch routine returns the name of the current branch or
# 'HEAD' in a dettached head state.

sub current_branch {
    chomp(my $branch = qx/git rev-parse --abbrev-ref HEAD/);
    return $branch;
}

# The update_branch routine receives a local $branch name and updates
# it with the homonym branch in the Gerrit remote.

sub update_branch {
    my ($branch) = @_;

    my $remote = config('remote');
    cmd "git fetch $remote $branch:$branch";
}

# The change_branch_info routine receives the name of a branch. If
# it's a change-branch, it returns a two-element list containing it's
# upstream name and its id. Otherwise, it returns the empty list.

sub change_branch_info {
    my ($branch) = @_;
    if ($branch =~ m:^change/(?<upstream>.*)/(?<id>[^/]+):) {
        return ($+{upstream}, $+{id});
    }
    return;
}

# The current_change_id routine returns the id of the change branch
# we're currently in. If we're not in a change branch, it returns
# undef.

sub current_change_id {

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

    if (my ($upstream, $id) = change_branch_info($branch)) {
        if (cmd "git checkout $upstream") {
            if ($Options{keep} || ! $Options{delete} && $id =~ /\D/) {
                info "Keeping $branch";
            } else {
                cmd "git branch -D $branch";
            }
        }
    } else {
        error "$Command: You aren't in a change branch. There is no upstream to go to.";
    }

    return;
};

$Commands{'cherry-pick'} = $Commands{cp} = sub {
    get_options(
        'edit',
        'no-commit',
    );

    my @args;
    push @args, '--edit'      if $Options{edit};
    push @args, '--no-commit' if $Options{'no-commit'};

    @ARGV or syntax_error "$Command: Missing CHANGE.";

    my @change_branches = do {
        local $Command = 'fetch';
        $Commands{fetch}->();
    };

    cmd join(' ', 'git cherry-pick', @args, @change_branches);

    return;
};

$Commands{rebase} = sub {
    get_options();

    my ($upstream, $id) = change_branch_info(current_branch)
        or error "$Command: You must be in a change branch to invoke rebase.";

    cmd "git rebase $upstream"
        or error "$Command: please resolve this 'git rebase $upstream' and try again.";
};

$Commands{reviewer} = sub {
    get_options(
        'add=s@',
        'confirm',
        'delete=s@',
    );

    grok_unspecified_change;

    foreach my $id (@ARGV) {
        # First try to make all deletions
        if (my $users = $Options{delete}) {
            foreach my $user (split(/,/, join(',', @$users))) {
                $user = uri_escape_utf8($user);
                gerrit_or_die(DELETE => "/changes/$id/reviewers/$user");
            }
        }

        # Second try to make all additions
        if (my $users = $Options{add}) {
            my $confirm = $Options{confirm} ? 'true' : 'false';
            foreach my $user (split(/,/, join(',', @$users))) {
                gerrit_or_die(POST => "/changes/$id/reviewers", { reviewer => $user, confirm => $confirm});
            }
        }

        # Finally, list current reviewers
        my $reviewers = gerrit_or_die(GET => "/changes/$id/reviewers");

        print "[$id]\n";
        require Text::Table;
        my %labels = map {$_ => undef} map {keys %{$_->{approvals}}} @$reviewers;
        my @labels = sort keys %labels;
        my $table = Text::Table->new('REVIEWER', map {"$_\n&num"} @labels);
        $table->add($_->{name}, @{$_->{approvals}}{@labels})
            foreach sort {$a->{name} cmp $b->{name}} @$reviewers;
        print $table->table(), '-' x 60, "\n";
    }

    return;
};

$Commands{review} = sub {
    get_options(
        'message=s',
        'keep',
    );

    my %review;

    if (my $message = get_message) {
        $review{message} = $message;
    }

    # Set all votes
    while (@ARGV && $ARGV[0] =~ /(?<label>.*)=(?<vote>.*)/) {
        shift @ARGV;
        $review{labels}{$+{label} || 'Code-Review'} = $+{vote};
        $+{vote} =~ /^[+-]?\d$/
            or syntax_error "$Command: Invalid vote ($+{vote}). It must be a single digit optionally prefixed by a [-+] sign.";
    }

    error "$Command: Invalid vote $ARGV[0]." if @ARGV > 1;

    error "$Command: You must specify a message or a vote to review."
        unless keys %review;

    my $local_change = grok_unspecified_change;

    foreach my $id (@ARGV) {
        gerrit_or_die(POST => "/changes/$id/revisions/current/review", \%review);
    }

    checkout_upstream_and_delete_branch