view release on metacpan or  search on metacpan

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

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 {