Revision control
Copy as Markdown
# Copyright (C) 2017 The Qt Company Ltd.
# Copyright (C) 2019 Oswald Buddenhagen
#
# You may use this file under the terms of the 3-clause BSD license.
# See the file LICENSE from this package for details.
#
package git_gpush;
use v5.14;
use strict;
use warnings;
no warnings qw(io);
use Carp;
$SIG{__WARN__} = \&Carp::cluck;
$SIG{__DIE__} = \&Carp::confess;
use List::Util qw(min max pairmap);
use File::Spec;
use File::Temp qw(mktemp tempfile);
use IPC::Open3 qw(open3);
use Symbol qw(gensym);
use Term::ReadKey;
use Text::Wrap;
use JSON;
our @_imported;
BEGIN {
no strict 'refs';
@_imported = keys %{__PACKAGE__.'::'};
}
##################
# shared options #
##################
our $debug = 0;
our $verbose = 0;
our $quiet = 0;
our $dry_run = 0;
our $mail_mode = 0;
##################
# message output #
##################
$| = 1; # OUTPUT_AUTOFLUSH; in case we're redirecting debug output.
my ($tty_width, undef, undef, undef) = (-t STDOUT) ? GetTerminalSize() : (80);
# This is for messages which even after wrapping will rarely/barely
# exceed a single line, so it does not matter that the output possibly
# violates the "no more than 80 columns for flowed text" guideline.
sub _wrap_wide($)
{
$Text::Wrap::columns = $tty_width + 1;
return wrap("", "", $_[0]);
}
sub wout($)
{
print _wrap_wide($_[0]);
}
sub werr($)
{
print STDERR _wrap_wide($_[0]);
}
sub wfail($)
{
werr($_[0]);
exit(1);
}
# This is for bigger amounts of text.
sub _wrap_narrow($)
{
$Text::Wrap::columns = min($tty_width, 80) + 1;
return wrap("", "", $_[0]);
}
sub nwout($)
{
print _wrap_narrow($_[0]);
}
sub nwerr($)
{
print STDERR _wrap_narrow($_[0]);
}
sub nwfail($)
{
nwerr($_[0]);
exit(1);
}
sub fail($)
{
print STDERR $_[0];
exit(1);
}
sub wrap_mail($)
{
$Text::Wrap::columns = 72; # This is also the default
return wrap("", "", $_[0]);
}
#######################
# subprocess handling #
#######################
use constant {
NUL_STDIN => 0,
USE_STDIN => 1,
FWD_STDIN => 2,
NUL_STDOUT => 0,
USE_STDOUT => 4,
FWD_STDOUT => 8,
NUL_STDERR => 0,
USE_STDERR => 16,
FWD_STDERR => 32,
FWD_OUTPUT => 40,
SILENT_STDIN => 64, # Suppress debug output for stdin
SOFT_FAIL => 256, # A non-zero exit from the process is not fatal
DRY_RUN => 512 # Don't actually run the command if $dry_run is true
};
sub format_cmd(@)
{
return join(' ', map { /\s/ ? '"' . $_ . '"' : $_ } @_);
}
sub open_process($@)
{
my ($flags, @cmd) = @_;
my %process;
$flags &= ~DRY_RUN if (!$dry_run);
$process{flags} = $flags;
if ($flags & DRY_RUN) {
print "+ ".format_cmd(@cmd)." [DRY]\n" if ($debug);
return \%process;
}
my $cmd = format_cmd(@cmd);
$process{cmd} = $cmd;
my ($in, $out, $err);
if ($flags & USE_STDIN) {
$in = \$process{stdin};
} elsif ($flags & FWD_STDIN) {
# open3() closes the handle input is redirected from, which is
# most definitely not what we want to happen to stdin.
no warnings 'once'; # The parser doesn't see the string reference.
open INPUT, '<&STDIN' or wfail("Failed to dup() stdin: $!\n");
$in = \'<&INPUT';
} else {
$in = \'<&NUL';
}
if ($flags & USE_STDOUT) {
$out = \$process{stdout};
} elsif ($flags & FWD_STDOUT) {
$out = \'>&STDOUT';
} else {
$out = \'>&NUL';
}
if ($flags & USE_STDERR) {
$err = \$process{stderr};
$$err = gensym();
} elsif ($flags & FWD_STDERR) {
$err = \'>&STDERR';
} else {
$err = \'>&NUL';
}
print "+ $cmd\n" if ($debug);
open(NUL, '>'.File::Spec->devnull()) or wfail("Failed to open bitbucket: $!\n");
eval { $process{pid} = open3($$in, $$out, $$err, @cmd); };
wfail("Failed to run \"$cmd[0]\": $!\n") if ($@);
close(NUL);
return \%process;
}
sub close_process($)
{
my ($process) = @_;
if ($$process{flags} & DRY_RUN) {
$? = 0;
return;
}
my $cmd = $$process{cmd};
if ($$process{stdout}) {
close($$process{stdout}) or wfail("Failed to close read pipe of '$cmd': $!\n");
}
if ($$process{stderr}) {
close($$process{stderr}) or wfail("Failed to close error read pipe of '$cmd': $!\n");
}
waitpid($$process{pid}, 0) or wfail("Failed to wait for '$cmd': $!\n");
if ($? & 128) {
wfail("'$cmd' crashed with signal ".($? & 127).".\n") if ($? != 141); # allow SIGPIPE
$? = 0;
} elsif ($? && !($$process{flags} & SOFT_FAIL)) {
exit($? >> 8);
}
}
# Write any number of lines to the process' stdin.
# The input is expected to already contain trailing newlines.
# This function must be called exactly once iff USE_STDIN is used.
# Note that this will deadlock with USE_STDOUT if the process outputs
# too much before all input is written.
sub write_process($@)
{
my ($process, @input) = @_;
my $stdin = $$process{stdin};
my $silent = ($$process{flags} & SILENT_STDIN);
my $dry = ($$process{flags} & DRY_RUN);
local $SIG{PIPE} = "IGNORE";
foreach (@input) {
print "> $_" if ($debug && !$silent);
print $stdin $_ if (!$dry);
}
$dry or close($stdin) or wfail("Failed to close write pipe of '$$process{cmd}': $!\n");
}
# Read a line from the process' stdout.
sub read_process($)
{
my ($process) = @_;
my $fh = $$process{stdout};
$_ = <$fh>;
if (defined($_)) {
chomp;
print "- $_\n" if ($debug);
}
return $_;
}
# Read all lines from the process' stdout.
sub read_process_all($)
{
my ($process) = @_;
my $fh = $$process{stdout};
my @lines = <$fh>;
chomp @lines;
printf("Read %d lines.\n", int(@lines)) if ($debug);
return \@lines;
}
# Read any number of null-terminated fields from the process' stdout.
sub read_fields($@)
{
my $process = shift;
my $fh = $$process{stdout};
return 0 if (eof($fh));
local $/ = "\0";
for (@_) { chop($_ = <$fh>); }
return 1;
}
# Read all of a process' output channel as a single string.
sub get_process_output($$)
{
my ($process, $which) = @_;
local $/;
my $fh = $$process{$which};
return <$fh>;
}
# The equivalent of system().
sub run_process($@)
{
my ($flags, @cmd) = @_;
close_process(open_process($flags, @cmd));
}
# The equivalent of popen("r").
sub open_cmd_pipe($@)
{
my ($flags, @cmd) = @_;
return open_process(USE_STDOUT | FWD_STDERR | $flags, @cmd);
}
# Run the specified command and try to read exactly one line from its stdout.
sub read_cmd_line($@)
{
my ($flags, @cmd) = @_;
my $proc = open_cmd_pipe($flags, @cmd);
read_process($proc);
close_process($proc);
return $_;
}
##############
# git basics #
##############
our $gitdir; # $GIT_DIR
our $gitcommondir; # $GIT_COMMON_DIR
sub goto_gitdir()
{
my $cdup = read_cmd_line(0, 'git', 'rev-parse', '--show-cdup');
fail("fatal: This operation must be run in a work tree\n") if (!defined($cdup));
chdir($cdup) unless ($cdup eq "");
$gitdir = read_cmd_line(0, 'git', 'rev-parse', '--git-dir');
$gitcommondir = read_cmd_line(0, 'git', 'rev-parse', '--no-flags', '--git-common-dir');
}
# `git config --list` output, plus contents of .git-gpush-aliases' [config]
our %gitconfig; # { key => [ value, ... ] }
# Pre-processed url.*.insteadOf mappings.
my @url_rewrites;
my @url_rewrites_push;
sub _load_git_config()
{
# Read all git configuration at once, as that's faster than repeated
# git invocations, especially under Windows.
my $cfg = open_cmd_pipe(0, 'git', 'config', '-l', '-z');
while (read_fields($cfg, my $entry)) {
$entry =~ /^([^\n]+)\n(.*)$/;
my ($key, $value) = ($1, $2);
push @{$gitconfig{$key}}, $value;
if ($key =~ /^url\.(.*)\.insteadof$/) {
push @url_rewrites, [ $value, $1 ];
} elsif ($key =~ /^url\.(.*)\.pushinsteadof$/) {
push @url_rewrites_push, [ $value, $1 ];
}
}
close_process($cfg);
# Sort backwards, so longest match is hit first.
@url_rewrites = sort { $$b[0] cmp $$a[0] } @url_rewrites;
@url_rewrites_push = sort { $$b[0] cmp $$a[0] } @url_rewrites_push;
}
sub git_configs($)
{
my ($key) = @_;
my $ref = $gitconfig{$key};
return defined($ref) ? @$ref : ();
}
sub git_config($;$)
{
my ($key, $dflt) = @_;
my @cfg = git_configs($key);
return scalar(@cfg) ? $cfg[-1] : $dflt;
}
sub _rewrite_git_push_url($)
{
my ($url) = @_;
foreach my $ent (@url_rewrites_push, @url_rewrites) {
my ($pfx, $sub) = @$ent;
return $url if ($url =~ s/^\Q$pfx\E/$sub/);
}
return $url;
}
my $curr_tree = "";
our $_indexfile;
END { unlink($_indexfile) if ($_indexfile); }
sub with_local_git_index($@)
{
my ($callback, @args) = @_;
$curr_tree = "";
$_indexfile = mktemp(($ENV{TMPDIR} or "/tmp") . "/git-gpush.XXXXXX");
local $ENV{GIT_INDEX_FILE} = $_indexfile;
local ($SIG{HUP}, $SIG{INT}, $SIG{QUIT}, $SIG{TERM});
$SIG{HUP} = $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub { exit; };
my $ret = $callback->(@args);
unlink($_indexfile);
$_indexfile = undef;
return $ret;
}
#################
# configuration #
#################
sub _file_contents($)
{
my ($filename) = @_;
my @contents = "";
my $fh;
if (-e $filename && open($fh, "< $filename")) {
@contents = <$fh>;
close $fh;
}
return @contents;
}
our %aliases; # { alias => login }
sub load_config()
{
# Read config from .git-gpush-aliases file
my $in_aliases = 1;
foreach my $line (_file_contents($::script_path."/.git-gpush-aliases")) {
chomp $line;
$line =~ s,(#|//).*$,,; # Remove any comments
if ($line =~ /^\[([^]]+)\]/) {
if ($1 eq "aliases") {
$in_aliases = 1;
} elsif ($1 eq "config") {
$in_aliases = 0;
} else {
fail("Unrecognized section '$1' in alias file.\n");
}
} elsif ($line =~ /^\s*([^ =]+)\s*=\s*(.*?)\s*$/) { # Capture the value
if ($in_aliases) {
for my $alias (split(/,/, $1)) {
$aliases{$alias} = $2;
}
} else {
push @{$gitconfig{"gpush.$1"}}, $2;
}
}
}
_load_git_config();
foreach (keys %gitconfig) {
if (/^gpush\.alias\.(.*)$/) {
$aliases{$1} = git_config($_);
}
}
my $mm = git_config('gpush.mailmode', 'false');
if ($mm eq 'true' || $mm eq 'yes') {
$mail_mode = 1;
} elsif ($mm ne 'false' && $mm ne 'no') {
fail("Unrecognized value for gpush.mailmode.\n");
}
}
######################
# branches & remotes #
######################
# Info extracted from $GITDIR/HEAD.
our $head_branch; # May be undef.
our $head_commit;
# The name of the local branch we're working with (not necessarily the
# current branch). May be undef.
our $local_branch;
# The tips of the local and remote branches.
our %local_refs; # { branch => sha1 }
our %remote_refs; # { remote => { branch => sha1 } }
# The name of the local branch's upstream remote, or a configurable fallback.
our $upstream_remote;
# The name of the Gerrit remote, possibly identical to the upstream remote.
our $remote;
# The tips of the remote branches which are excluded from commit listings.
# The commits are already prepared for git-rev-list (prefixed with '^').
our @upstream_excludes;
sub update_excludes()
{
my %heads;
my $urefs = $remote_refs{$upstream_remote};
if ($urefs) {
$heads{$_} = 1 foreach (values %$urefs);
}
if (defined($remote) && ($remote ne $upstream_remote)) {
my $grefs = $remote_refs{$remote};
if ($grefs) {
$heads{$_} = 1 foreach (values %$grefs);
}
}
@upstream_excludes = map { "^$_" } keys %heads;
}
sub resolve_head($)
{
my ($source) = @_;
return $source if ($source ne "HEAD");
return $head_branch // "";
}
sub find_gerrit_remote($)
{
my ($remotes) = @_;
if (defined($local_branch)) {
# If a branch-specific Gerrit remote is configured, use exactly that one.
$remote = git_config("branch.$local_branch.gpushremote");
if (defined($remote)) {
fail("Remote '$remote' configured in branch.$local_branch.gpushremote is invalid.\n")
if (!defined($$remotes{$remote}));
return;
}
}
# Otherwise, if a global Gerrit remote is configured, use exactly that one.
$remote = git_config("gpush.remote");
if (defined($remote)) {
fail("Remote '$remote' configured in gpush.remote is invalid.\n")
if (!defined($$remotes{$remote}));
return;
}
# Otherwise use 'gerrit' if present.
if (defined($$remotes{'gerrit'})) {
$remote = 'gerrit';
return;
}
if (defined($local_branch)) {
# Otherwise, if a branch-specific push remote is configured, use that one.
$remote = git_config("branch.$local_branch.pushremote");
if (defined($remote)) {
fail("Remote '$remote' configured in branch.$local_branch.pushremote is invalid.\n")
if (!defined($$remotes{$remote}));
return;
}
}
# Otherwise, if a global push remote is configured, use that one.
$remote = git_config("remote.pushdefault");
if (defined($remote)) {
fail("Remote '$remote' configured in remote.pushdefault is invalid.\n")
if (!defined($$remotes{$remote}));
return;
}
# Otherwise fall back to the upstream remote.
$remote = $upstream_remote;
}
sub setup_remotes($)
{
my ($source) = @_;
my %remotes;
for my $ky (keys %gitconfig) {
if ($ky =~ /^remote\.(.*)\.url$/) {
$remotes{$1} = 1;
}
}
fail("No remotes configured.\n")
if (!%remotes);
if (defined($local_branch)) {
$upstream_remote = git_config("branch.$local_branch.remote");
fail("$source has invalid upstream remote '$upstream_remote'.\n")
if (defined($upstream_remote) && !defined($remotes{$upstream_remote}));
}
if (!defined($upstream_remote)) {
$upstream_remote = git_config('gpush.upstream');
if (defined($upstream_remote)) {
fail("Remote '$upstream_remote' configured in gpush.upstream is invalid.\n")
if (!defined($remotes{$upstream_remote}));
} else {
$upstream_remote = 'origin';
if (!defined($remotes{$upstream_remote})) {
my @remotes_arr = keys %remotes;
fail("$source has no upstream remote, and cannot guess one.\n")
if (@remotes_arr != 1);
$upstream_remote = $remotes_arr[0];
}
}
wout("Notice: $source has no upstream remote; defaulting to $upstream_remote.\n")
if (!$quiet);
}
if ($mail_mode) {
} elsif (defined($remote)) {
fail("Specified Gerrit remote '$remote' is invalid.\n")
if (!defined($remotes{$remote}));
} else {
find_gerrit_remote(\%remotes);
}
update_excludes();
}
###################
# commit metadata #
###################
our %commit_by_id;
sub init_commit($)
{
my ($commit) = @_;
my $id = $$commit{id};
# Duplicating is bad, because it would discard members which are not
# necessarily re-instantiated. Also, it's an indicator of inefficiency.
die("Commit $id already instantiated")
if ($commit_by_id{$id});
$commit_by_id{$id} = $commit;
}
sub commit_metas_equal($$)
{
my ($commit, $old_commit) = @_;
return ($$commit{message} eq $$old_commit{message})
&& ("@{$$commit{author}}" eq "@{$$old_commit{author}}");
}
sub changes_from_commits($)
{
my ($commits) = @_;
return [ map { $$_{change} } @$commits ];
}
sub get_1st_parent($)
{
my ($commit) = @_;
my $parents = $$commit{parents};
return @$parents ? $$parents[0] : 'ROOT';
}
sub get_1st_parent_tree($)
{
my ($commit) = @_;
# Upstream commits are not visited, so we get no tree id. However,
# as this code aims at series which were not rebased, using the base
# commit itself will work just as well for the series' first commit.
my $parents = $$commit{parents};
return 'ROOT' if (!@$parents);
my $parent_id = $$parents[0];
my $parent = $commit_by_id{$parent_id};
return $parent ? $$parent{tree} : $parent_id;
}
sub get_more_parents($)
{
my ($commit) = @_;
my $parents = $$commit{parents};
return @$parents > 1 ? "@$parents[1..$#$parents]" : "";
}
# Enumerate commits from the specified tip down to the merge base
# with upstream. Merges are handled in --first-parent mode.
sub get_commits_free($)
{
my ($tip) = @_;
my @commits;
while (1) {
my $commit = $commit_by_id{$tip};
last if (!$commit);
unshift @commits, $commit;
$tip = get_1st_parent($commit);
}
return \@commits;
}
# Enumerate the specified number of commits from the specified tip.
# Merges are treated in --first-parent mode.
sub get_commits_count($$$)
{
my ($tip, $count, $tip_raw) = @_;
my @commits;
for (1 .. $count) {
my $commit = $commit_by_id{$tip};
wfail("Range $tip_raw:$count extends beyond the local branch.\n")
if (!$commit);
unshift @commits, $commit;
$tip = get_1st_parent($commit);
}
return \@commits;
}
# Enumerate commits from the specified tip down to the specified base.
# Merges are treated in --first-parent mode.
sub get_commits_base($$$$)
{
my ($base, $tip, $base_raw, $tip_raw) = @_;
# An empty base is understood to mean the merge base with upstream.
# This avoids the need to figure out the actual commit, which is
# particularly useful in the presence of multiple bases due to merges.
return get_commits_free($tip) if (!length($base));
my @commits;
while ($tip ne $base) {
my $commit = $commit_by_id{$tip};
wfail("$base_raw is not an ancestor of $tip_raw within the local branch.\n")
if (!$commit);
unshift @commits, $commit;
$tip = get_1st_parent($commit);
}
return \@commits;
}
########################
# gerrit query results #
########################
use constant {
RVRTYPE_NONE => 0,
RVRTYPE_REV => 1,
RVRTYPE_CC => 2,
RVRTYPE_ANY => 3 # Because Gerrit won't tell via SSH.
};
our %gerrit_info_by_key;
our %gerrit_info_by_sha1;
our %gerrit_infos_by_id;
#############################
# state variable processing #
#############################
{ # start text escape functions
my @escapes = split //, "\\\\\"\"\aa\bb\tt\nn\rr\013v\ff\ee s";
my %esc_to_char = pairmap { $b => $a } @escapes;
my %char_to_esc = pairmap { $a => $b } @escapes;
sub quote_text_prop($;$)
{
my ($in, $sp) = @_;
my $re = $sp ? qr/(\p{Cc}|\\|\"| )/ : qr/(\p{Cc}|\\|\")/;
$in =~ s{$re}{"\\".($char_to_esc{$1} // sprintf("%03o", ord($1)))}ge;
return $in;
}
sub unquote_text_prop($)
{
my ($in) = @_;
$in =~ s{(?>\\([\\\"a-z]|[0-3][0-7][0-7]))}{$esc_to_char{$1} // chr(oct($1))}ge;
return $in;
}
} # end text escape functions
sub quote_list_prop(@)
{
return join(" ", map { quote_text_prop($_, 1) } @_);
}
sub unquote_list_prop($)
{
my ($in) = @_;
return map { unquote_text_prop($_) } split(/ /, $in);
}
our $_textfile;
sub cleanup_textfile()
{
if (defined($_textfile)) {
unlink($_textfile);
$_textfile = undef;
}
}
END { cleanup_textfile(); }
sub write_textfile($)
{
my ($text) = @_;
die("Only one textfile may be active at a time.\n")
if (defined($_textfile));
my $fh;
($fh, $_textfile) =
tempfile("git-gpush.XXXXXX", SUFFIX => ".txt", TMPDIR => 1);
print $fh $text;
close($fh) or fail("Cannot write temporary file.\n");
return $_textfile;
}
sub read_textfile()
{
open(my $fh, $_textfile) or fail("Cannot open temporary file.\n");
local $/;
my $text = <$fh>;
close($fh);
cleanup_textfile();
return $text;
}
sub edit_textfile($)
{
my ($text) = @_;
write_textfile($text);
state $editor = read_cmd_line(0, 'git', 'var', 'GIT_EDITOR');
run_process(FWD_STDIN | FWD_OUTPUT, $editor, $_textfile);
return read_textfile();
}
##################
# state handling #
##################
# This is built upon Change objects with these attributes:
# - key: Sequence number. This runs independently from Gerrit, so
# we can enumerate Changes which were never pushed, and to make
# it possible to re-associate local Changes with remote ones.
# - grp: Group (series) sequence number.
# - id: Gerrit Change-Id.
# - src: Local branch name, or "-" if Change is on a detached HEAD.
# - tgt: Target branch name.
# - topic: Gerrit topic. Persisted only as a cache.
# - fmt: format-patch/send-email options (indirect).
# - dsc: verbose series description / notes (indirect).
# - pushed: SHA1 of the commit this Change was pushed as last time
# from this repository.
# - rebased: prospective value for 'pushed'.
# - base: SHA1 of commit on top of which the entire series which this
# Change is part of was pushed.
# - orig: SHA1 of the _local_ commit 'pushed' was derived from.
# - rorig: same for 'rebased'.
# - nbase/ntgt/ntopic: Non-committed values of the respective
# attributes, used by --group mode.
# - exclude: Flag indicating whether the Change is excluded from
# push --all mode.
# - hide: Flag indicating whether the Change is excluded from all
# pushes.
my $next_key = 10000;
# All known Gerrit Changes for the current repository.
our %change_by_key; # { sequence-number => change-object }
# Same, indexed by Gerrit Change-Id. A Change can exist on multiple branches.
our %changes_by_id; # { gerrit-id => [ change-object, ... ] }
# Changes on the local branch, indexed by SHA1 of previous push.
# Note that other local branches may have gpick'd the same commits.
our %change_by_pushed; # { sha1 => change-object }
my $next_group = 10000;
my $next_prop = 10000;
# Indirect Change properties, which are shared to save space.
# An alternative would be group properties, but this would require
# resolving inconsistencies at inopportune times; in particular,
# we do not want to concern gpick with this at all.
our %prop_by_key;
our $last_gc = 0;
my $state_lines;
my $state_updater = ($0 =~ s,^.*/,,r)." @ARGV";
sub new_prop($)
{
my ($val) = @_;
my $key;
if (length($val)) {
$key = $next_prop++;
$prop_by_key{$key} = $val;
}
return $key;
}
# Perform a batch update of refs.
sub update_refs($$)
{
my ($flags, $updates) = @_;
if (!@$updates) {
print "No refs to update.\n" if ($debug);
return;
}
my $pipe = open_process(USE_STDIN | FWD_STDERR | $flags, "git", "update-ref", "--stdin");
write_process($pipe, @$updates);
close_process($pipe);
}
sub _commit_state($$)
{
my ($blob, $new) = @_;
run_process(FWD_OUTPUT, 'git', 'update-index', '--add', '--cacheinfo',
"100644,$blob,state");
my $tree = read_cmd_line(0, 'git', 'write-tree');
my $sha1 = read_cmd_line(0, 'git', 'commit-tree', '-m', 'Saving state', $tree);
if ($new) {
run_process(FWD_OUTPUT, 'git', 'update-ref', 'refs/gpush/state-new', $sha1);
} else {
run_process(FWD_OUTPUT, 'git', 'update-ref', '-m', $state_updater,
'--create-reflog', 'refs/gpush/state', $sha1);
}
}
sub save_state(;$$)
{
my ($dry, $new) = @_;
print "Saving ".($new ? "new " : "")."state".($dry ? " [DRY]" : "")." ...\n" if ($debug);
my %prop_hash;
my (@lines, @updates);
my %ikeys = map { $_ => 1 } ('irt', 'fmt', 'dsc');
my @fkeys = ('key', 'grp', 'id', 'bgrp', 'base', 'tip', 'src', 'tgt',
'topic', 'ver', 'irt', 'fmt', 'dsc', 'pbase', 'ptip',
'nbgrp', 'nbase', 'ntgt', 'ntopic', 'exclude', 'hide');
my @rkeys = ('pushed', 'ppushed', 'rebased', 'orig', 'rorig');
if ($new) {
push @lines, "verify $new", "updater $state_updater";
push @fkeys, @rkeys;
@rkeys = ();
}
push @lines,
"next_key $next_key",
"next_group $next_group",
"next_prop $next_prop",
"last_gc $last_gc",
"";
foreach my $key (sort keys %change_by_key) {
my $change = $change_by_key{$key};
my $garbage = $$change{garbage};
foreach my $ky (@rkeys) {
my ($val, $oval) = ($garbage ? undef : $$change{$ky}, $$change{'_'.$ky});
if (!defined($val)) {
push @updates, "delete refs/gpush/i${key}_$ky\n"
if (defined($oval));
} else {
push @updates, "update refs/gpush/i${key}_$ky $val\n"
if (!defined($oval) || ($oval ne $val));
}
$$change{'_'.$ky} = $val;
}
next if ($garbage);
foreach my $ky (@fkeys) {
my $val = $$change{$ky};
if (defined($val)) {
# Support empty values without making the file look funny.
# We assume that no property ever contains a literal "".
$val = '""' if (!length($val));
push @lines, "$ky $val";
$prop_hash{int($val)} = 1 if (defined($ikeys{$ky}));
}
}
push @lines, "";
}
push @lines, map { $_.'='.$prop_by_key{$_} } sort keys %prop_hash;
foreach my $ginfo (values %gerrit_info_by_key) {
my $fetched = $$ginfo{fetched};
next if (!defined($fetched));
my $_fetched = \%{$$ginfo{_fetched}};
for my $ky (keys %$fetched) {
my ($val, $oval) = ($$fetched{$ky}, $$_fetched{$ky});
if (!defined($val)) {
push @updates, "delete refs/gpush/g$$ginfo{key}_$ky\n"
if (defined($oval));
} else {
push @updates, "update refs/gpush/g$$ginfo{key}_$ky $val\n"
if (!defined($oval) || ($oval ne $val));
}
$$_fetched{$ky} = $val;
}
}
update_refs($dry ? DRY_RUN : 0, \@updates);
# We save the state file in a git ref as well, so the entire state
# can be synced between hosts with git operations.
if ($new || ("@lines" ne "@$state_lines")) {
my $sts = open_process(USE_STDIN | SILENT_STDIN | USE_STDOUT | FWD_STDERR,
'git', 'hash-object', '-w', '--stdin');
write_process($sts, map { "$_\n" } @lines);
my $blob = read_process($sts);
close_process($sts);
with_local_git_index(\&_commit_state, $blob, $new) if (!$dry);
$state_lines = \@lines;
} else {
print "State file unmodified.\n" if ($debug);
}
}
# Constructor for the Change object.
sub _init_change($$)
{
my ($change, $changeid) = @_;
print "Creating Change $next_key ($changeid).\n" if ($debug);
$$change{key} = $next_key;
$$change{id} = $changeid;
push @{$changes_by_id{$changeid}}, $change;
$change_by_key{$next_key} = $change;
$next_key++;
}
sub load_state_file(;$)
{
my ($new) = @_;
my $ref = $new ? "state-new" : "state";
my $sts = open_process(SOFT_FAIL | USE_STDOUT | NUL_STDERR,
'git', 'cat-file', '-p', "refs/gpush/$ref:state");
$state_lines = read_process_all($sts);
close_process($sts);
return if (!@$state_lines);
my $state_verify;
my $line = 0;
my $inhdr = 1;
my $change;
my @changes;
foreach (@$state_lines) {
$line++;
if (!length($_)) {
$inhdr = 0;
$change = undef;
} elsif (/^(\d+)=(.*)/) {
my ($key, $val) = (int($1), $2);
fail("Bad state file: indirect property with duplicate id at line $line.\n")
if (defined($prop_by_key{$key}));
$prop_by_key{$key} = $val;
} elsif (!/^(\w+) (.*)/) {
fail("Bad state file: Malformed entry at line $line.\n");
} elsif ($inhdr) {
if ($1 eq "next_key") {
$next_key = int($2);
} elsif ($1 eq "next_group") {
$next_group = int($2);
} elsif ($1 eq "next_prop") {
$next_prop = int($2);
} elsif ($1 eq "last_gc") {
$last_gc = int($2);
} elsif ($new && ($1 eq "verify")) {
$state_verify = $2;
} elsif ($new && ($1 eq "updater")) {
$state_updater = $2;
} else {
fail("Bad state file: Unknown header keyword '$1' at line $line.\n");
}
} else {
if (!$change) {
$change = {};
$$change{line} = $line;
push @changes, $change;
}
$$change{$1} = ($2 eq '""') ? "" : $2;
}
}
foreach my $change (@changes) {
my $line = $$change{line};
my ($key, $id) = ($$change{key}, $$change{id});
fail("Bad state file: Change with no key at line $line.\n") if (!$key);
fail("Bad state file: Change with no id at line $line.\n") if (!$id);
fail("Bad state file: Change with duplicate id at line $line.\n")
if (defined($change_by_key{$key}));
$change_by_key{$key} = $change;
push @{$changes_by_id{$id}}, $change;
}
return $state_verify;
}
sub load_refs(@)
{
my (@refs) = @_;
my @updates;
my $info = open_cmd_pipe(0, 'git', 'for-each-ref', '--format=%(objectname) %(refname)', @refs);
while (read_process($info)) {
if (m,^(.{40}) refs/heads/(.*)$,) {
$local_refs{$2} = $1;
} elsif (m,^(.{40}) refs/remotes/([^/]+)/(.*)$,) {
$remote_refs{$2}{$3} = $1;
} elsif (m,^(.{40}) refs/gpush/i(\d+)_(.*)$,) {
my $change = $change_by_key{$2};
if (!$change) {
my $ref = substr($_, 41);
werr("Warning: Unrecognized Change key in state ref $ref - dropping.\n");
# It would cause trouble once the key is re-used.
push @updates, "delete $ref\n";
next;
}
$$change{$3} //= $1; # Don't overwrite value from new file.
$$change{'_'.$3} = $1;
} elsif (m,^(.{40}) refs/gpush/g(\d+)_(\d+)$,) {
my $ginfo = \%{$gerrit_info_by_key{$2}};
$$ginfo{key} = $2;
$$ginfo{fetched}{$3} = $1;
$$ginfo{_fetched}{$3} = $1;
}
}
close_process($info);
update_refs(0, \@updates);
}
sub load_head()
{
open(my $hf, $gitdir."/HEAD") or fail("Repository has no HEAD!?\n");
chomp(my $hd = <$hf>);
close($hf);
if ($hd =~ s/^ref: //) {
$head_branch = $hd;
$hd =~ s,^refs/heads/,,;
$head_commit = $local_refs{$hd};
fail("HEAD points to invalid branch $head_branch.\n")
if (!defined($head_commit));
print "HEAD points to branch $head_branch, commit $head_commit.\n"
if ($debug);
} else {
$head_commit = $hd;
print "HEAD points to commit $head_commit.\n" if ($debug);
}
}
sub load_state($)
{
my ($all) = @_;
print "Loading state ...\n" if ($debug);
load_state_file();
load_refs($all ? "refs/gpush/" : "refs/gpush/i*", "refs/heads/", "refs/remotes/");
load_head();
}
##########################
# commit metadata output #
##########################
# Don't let lists get arbitrarily wide, as this makes them hard to follow.
use constant _LIST_WIDTH => 120;
# The _minimal_ width assumed for annotations, even if absent. This
# ensures that annotations always "stick out" on the right, even if only
# short subjects have annotations.
use constant _ANNOTATION_WIDTH => 6;
# Elide over-long Change subjects, as they add nothing but noise.
use constant _SUBJECT_WIDTH => 70;
# Truncation width for Change-Ids and SHA1s; empirically determined to be
# "sufficiently unambiguous".
use constant _ID_WIDTH => 10;
sub format_id($)
{
my ($id) = @_;
return substr($id, 0, _ID_WIDTH);
}
sub format_subject($$;$)
{
my ($id, $subject, $max) = @_;
$max = _SUBJECT_WIDTH if (!defined($max));
$max += $tty_width if ($max < 0);
$max -= _ID_WIDTH + 3 if (defined($id));
$max = max(25, min(_SUBJECT_WIDTH, $max)) - 5;
# Right-elide if subject is longer than $max + ellipsis:
$subject =~ s/^(.{$max}).{6,}$/$1\[...]/;
return $subject if (!defined($id));
return format_id($id)." ($subject)";
}
sub format_commit($;$)
{
my ($commit, $max) = @_;
return format_subject($$commit{changeid}, $$commit{subject}, $max);
}
sub format_commits($;$)
{
my ($commits, $prefix) = @_;
$prefix = " " if (!defined($prefix));
my $output = "";
foreach my $commit (@$commits) {
$output .= $prefix.format_commit($commit, -length($prefix))."\n";
}
return $output;
}
sub _unpack_report($@)
{
my $report = shift @_;
my @a = ($$report{id}, $$report{subject},
$$report{prefix} // "", $$report{suffix} // "", $$report{annotation} // "");
push @a, length($a[2]) + length($a[3]) + max(length($a[4]), _ANNOTATION_WIDTH);
for (@_) { $_ = shift @a; }
}
sub format_reports($)
{
my ($reports) = @_;
my $width = 0;
foreach my $report (@$reports) {
next if ($$report{type} ne "change");
_unpack_report($report, my ($id, $subject, $pfx_, $sfx_, $ann_, $fixlen));
my $w = length($subject);
$w += _ID_WIDTH + 3 if (defined($id));
$width = max($width, min($w, _SUBJECT_WIDTH) + $fixlen);
}
$width = min($width, $tty_width, _LIST_WIDTH);
my $output = "";
foreach my $report (@$reports) {
my $type = $$report{type} // "";
if ($type eq "flowed") {
$output .= _wrap_narrow($_)."\n" foreach (@{$$report{texts}});
} elsif ($type eq "fixed") {
$output .= join("", @{$$report{texts}});
} elsif ($type eq "change") {
_unpack_report($report, my ($id, $subject, $prefix, $suffix, $annot, $fixlen));
my $w = $width - $fixlen;
my $str = format_subject($id, $subject, min($w, _SUBJECT_WIDTH));
my $spacing = length($annot) ? (" " x max($w - length($str), 0)) : "";
$output .= $prefix.$str.$suffix.$spacing.$annot."\n";
} else {
die("Unknown report type '$type'.\n");
}
}
return $output;
}
sub fail_formatted($)
{
my ($reports) = @_;
fail(format_reports($reports));
}
sub report_text($$@)
{
my ($reports, $type, @texts) = @_;
push @$reports, {
type => $type,
texts => \@texts
};
}
sub report_flowed($@)
{
my ($reports, @texts) = @_;
push @$reports, {
type => "flowed",
texts => \@texts
};
}
sub report_fixed($@)
{
my ($reports, @texts) = @_;
push @$reports, {
type => "fixed",
texts => \@texts
};
}
sub set_change_error($$$)
{
my ($change, $style, $error) = @_;
($$change{error_style}, $$change{error}) = ($style, $error);
}
sub report_local_changes($$;$$)
{
my ($reports, $changes, $prefix, $suffix) = @_;
foreach my $change (@$changes) {
my $commit = $$change{local};
push @$reports, {
type => "change",
id => $$commit{changeid},
subject => $$commit{subject},
prefix => $prefix // " ",
suffix => $suffix,
annotation => $$change{annotation}
};
my $error = $$change{error};
if (defined($error)) {
$error = (" " x (3 + _ID_WIDTH)).$error."\n"
if (($$change{error_style} // 'oneline') eq 'oneline');
report_fixed($reports, $error);
}
}
}
#############################
# commit metadata retrieval #
#############################
use constant _GIT_LOG_ARGS =>
('-z', '--pretty=%H%x00%P%x00%T%x00%B%x00%an%x00%ae%x00%ad%x00%cn%x00%ce%x00%cd');
# Retrieve metadata for commits reachable from the specified tips.
sub visit_commits_raw($$;$)
{
my ($tips, $args, $cid_opt) = @_;
return if (!@$tips);
my @commits;
my $log = open_process(USE_STDIN | USE_STDOUT | FWD_STDERR,
'git', 'log', _GIT_LOG_ARGS, @$args, '--stdin');
write_process($log, map { "$_\n" } @$tips);
while (1) {
my @author = (undef, undef, undef);
my @committer = (undef, undef, undef);
last if (!read_fields($log, my ($id, $parents, $tree, $message), @author, @committer));
# We truncate the subject anyway, so using just the first line is OK.
$message =~ /^(.*)$/m;
my $subject = $1;
my @cids = ($message =~ /^Change-Id: (.+)$/mg);
my $changeid;
if (!@cids) {
fail(format_subject($id, $subject, -18)." has no Change-Id.\n"
."Install the Gerrit commit-msg hook and amend affected Changes,\n"
."or fix the issue directly by running git gpush --add-ids.\n")
if (!$cid_opt);
} else {
# Gerrit uses the last Change-Id if multiple are present.
$changeid = $cids[-1];
}
print "-- $id: ".format_subject($changeid, $subject, -45)."\n" if ($debug);
unshift @commits, {
id => $id,
parents => [ split(/ /, $parents) ],
changeid => $changeid,
subject => $subject,
message => $message,
tree => $tree,
author => \@author,
committer => \@committer
};
}
close_process($log);
return \@commits;
}
# Note: The return value is reliable only for the first call.
sub visit_commits($$;$)
{
my ($tips, $args, $cid_opt) = @_;
my @revs = grep {
if ($commit_by_id{$_}) {
print "Already visited $_.\n" if ($debug);
0;
} else {
1;
}
} @$tips;
return if (!@revs);
# The grep above excludes tips which match previous tips or their
# ancestors. A tip that is a descendant of a previous tip still
# needs to be visited, but the traversal needs to be cut off, so
# pass all previous tips as exclusions to git.
state %visited;
my @excl = map { "^$_" } keys %visited;
$visited{$_} = 1 foreach (@revs);
push @revs, @excl;
my $commits = visit_commits_raw(\@revs, $args, $cid_opt);
foreach my $commit (@$commits) {
init_commit($commit);
# This excludes tips that were in fact ancestors of other tips,
# thereby cutting down the noise in the exclusion list.
delete $visited{$_} foreach (@{$$commit{parents}});
}
return $commits;
}
sub visit_local_commits($;$)
{
my ($tips, $cid_opt) = @_;
# We exclude all upstream heads instead of only that of the current branch,
# because Gerrit will ignore all known commits (reviewed or not).
# This matters for cross-branch pushes and re-targeted Changes, where a commit
# can have known ancestors which aren't on its upstream branch.
# When traversing PatchSets from Gerrit, we need to exclude the heads from the
# gerrit remote as well, as they may be actually ahead of our merge-base with
# upstream.
return visit_commits($tips, \@upstream_excludes, $cid_opt);
}
# SHA1 of the local branch's merge base with upstream.
our $local_base;
# Mapping of Change-Ids to commits on the local branch.
our %changeid2local; # { change-id => SHA1 }
sub source_map_validate();
sub _source_map_prepare_local();
sub source_map_assign($$);
sub source_map_traverse();
sub _source_map_finish_initial();
sub visit_local_branch($;$)
{
my ($tip, $cid_opt) = @_;
# Get the revs ...
print "Enumerating local Changes ...\n" if ($debug);
my $raw_commits = visit_local_commits([ $tip ], $cid_opt);
return [] if (!@$raw_commits);
# Traverse along 1st parents only, unlike visit_local_commits().
my $commits = get_commits_free($$raw_commits[-1]{id});
$local_base = $$commits[0]{parents}[0];
return $commits;
}
sub analyze_local_branch($)
{
my ($commits) = @_;
# ... then sanity-check a bit ...
foreach my $commit (@$commits) {
my $sha1 = $$commit{id};
my $subject = $$commit{subject};
fail("Commit on ".($local_branch // "<detached HEAD>")
." was meant to be squashed:\n "
.format_subject($sha1, $subject, -2)."\n")
if ($subject =~ /^(squash|fixup)! /);
my $changeid = $$commit{changeid};
my $exsha1 = $changeid2local{$changeid};
fail("Duplicate Change-Id $changeid on "
.($local_branch // "<detached HEAD>").":\n "
.format_subject($exsha1, $commit_by_id{$exsha1}{subject}, -2)
."\n ".format_subject($sha1, $subject, -2)."\n")
if (defined($exsha1));
# This both serves as a seen check, and feeds parse_local_rev(),
# which _source_map_prepare_local() calls.
$changeid2local{$changeid} = $sha1;
}
# ... then map them to Change objects ...
_source_map_prepare_local();
while (1) {
foreach my $commit (@$commits) {
source_map_assign($commit, undef);
}
last if (!source_map_traverse());
}
_source_map_finish_initial();
# ... and then add them to the set of local Changes.
my $idx = 0;
my $prev;
foreach my $commit (@$commits) {
my $change = $$commit{change};
$$change{local} = $commit;
$$change{index} = $idx++;
$$change{parent} = $prev;
$$prev{child} = $change if ($prev);
$prev = $change;
my $pushed = $$change{pushed};
$change_by_pushed{$pushed} = $change if (defined($pushed));
}
}
##### ... and also for upstream commits.
# The requirements are quite different than for local commits:
# - we need only the Change-Id as meta data
# - we can just discard Changes without Id
# - we don't want to pollute the %commit_by_id namespace, as doing that
# would violate the assumption that upstream commits are not visited
use constant _GIT_UPSTREAM_LOG_ARGS => ('-z', '--pretty=%H%x00%B');
sub visit_upstream_commits($$)
{
my ($tips, $bases) = @_;
my $base;
if (@$bases == 1) {
$base = $$bases[0];
} else {
# If we have multiple bases, we need to find the oldest one.
$base = read_cmd_line(0, 'git', 'merge-base', '--octopus', @$bases);
}
my %changeids;
my $log = open_process(USE_STDIN | USE_STDOUT | FWD_STDERR,
'git', 'log', _GIT_UPSTREAM_LOG_ARGS, @$tips, "^$base");
while (read_fields($log, my ($commit, $message))) {
my @ids = ($message =~ /^Change-Id: (.+)$/mg);
$changeids{$ids[-1]} = 1 if (@ids);
# We don't print debug messages here, as this would completely
# flood the log.
}
close_process($log);
print "Found ".int(keys %changeids)." Changes.\n" if ($debug);
return \%changeids;
}
#####################
# change resolution #
#####################
# Resolve a possibly abbreviated Change-Id referring to a commit in
# the local branch.
# NB, the most likely source of abbreviated Ids is the gpush output.
sub _sha1_for_partial_local_id($)
{
my ($id) = @_;
state %changeid2local_cache;
return $changeid2local_cache{$id} if (exists($changeid2local_cache{$id}));
my $sha1 = $changeid2local{$id};
if (!defined($sha1)) {
my @sha1s;
my $rx = qr/^\Q$id\E/;
foreach my $changeid (keys %changeid2local) {
push @sha1s, $changeid2local{$changeid} if ($changeid =~ $rx);
}
if (@sha1s) {
fail("$id is ambiguous.\n") if (@sha1s != 1);
$sha1 = $sha1s[0];
}
}
$changeid2local_cache{$id} = $sha1;
return $sha1;
}
use constant {
SPEC_BASE => 0,
SPEC_TIP => 1,
SPEC_PARENT => 2
};
# Mapping of SHA1s rewritten by --add-ids.
our %old2new;
# Parse a revision specification referring to a commit in the local branch.
sub parse_local_rev($$)
{
my ($rev, $scope) = @_;
if ($rev eq 'ROOT') {
fail("ROOT is not valid for tip revspecs.\n")
if ($scope == SPEC_TIP);
return $rev;
} elsif (($rev eq '@{u}') || ($rev eq '@{upstream}')) {
fail("\@{upstream} is not valid for tip revspecs.\n")
if ($scope == SPEC_TIP);
return "";
}
fail("$rev is not a valid rev-spec.\n")
if ($rev !~ /^([^~^]*+)(.*)$/);
my ($core, $rest) = (length($1) ? $1 : "HEAD", $2);
my $out;
if ($core eq 'HEAD') {
$out = $head_commit;
} else {
$core =~ s,^refs/heads/,,;
$out = $local_refs{$core};
$out = _sha1_for_partial_local_id($core) if (!defined($out));
}
$out = read_cmd_line(SOFT_FAIL, 'git', 'rev-parse', '--verify', '-q',
($out // $core).$rest."^{commit}")
if (!defined($out) || length($rest));
fail("$rev is not a valid rev-spec.\n") if (!defined($out));
my $new = $old2new{$out};
if (defined($new)) {
print "Remapping resolved $out => $new.\n" if ($debug);
$out = $new;
}
# There is no point in restricting the base here - subsequent
# use will find out soon enough if it is not reachable.
return $out if ($scope == SPEC_BASE);
return $out if ($commit_by_id{$out});
fail("$rev is outside the local branch.\n");
}
################
# smart series #
################
sub obtain_gid($)
{
my ($changes) = @_;
# First collect the group ids appearing within the set.
my %gid_hash;
foreach my $change (@$changes) {
my $gid = $$change{grp};
$gid_hash{$gid} = 1 if (defined($gid));
}
if (%gid_hash) {
# Then collect all Changes with these group ids ...
my %orphans;
foreach my $change (values %change_by_key) {
my $gid = $$change{grp};
$orphans{$gid}{$$change{key}} = $change
if (defined($gid) && defined($gid_hash{$gid}));
}
# ... and subtract the ones we're currently grouping.
foreach my $change (@$changes) {
my $gid = $$change{grp};
delete $orphans{$gid}{$$change{key}}
if (defined($gid));
}
foreach my $gid (sort keys %gid_hash) {
# If there are no orphans, we are enlarging the group without
# dropping any Changes. Then we can recycle the id.
return $gid if (!%{$orphans{$gid}});
}
}
return $next_group++;
}
sub assign_series($)
{
my ($changes) = @_;
my $gid = obtain_gid($changes);
$$_{grp} = $gid foreach (@$changes);
}
# Deduce a series from a single commit.
# Merges are treated in --first-parent mode.
sub do_determine_series($;$$$)
{
my ($change, $extend, $capture, $forward_only) = @_;
print "Deducing series from $$change{id}\n" if ($debug);
my (@prospects, @changes);
my $group_key;
my $rchange = $change;
while (1) {
my $gid = $$change{grp};
if (!defined($gid)) {
if ($capture && @changes) {
print "Capturing loose $$change{id}\n" if ($debug);
unshift @changes, $change;
} else {
print "Prospectively capturing loose $$change{id}\n" if ($debug);
unshift @prospects, $change;
}
} else {
if (@changes) {
# We already have a proto-series.
# Check whether the new candidate is part of it.
if ($gid != $group_key) {
# Miss; end of series.
print "Breaking off at foreign bound $$change{id}\n" if ($debug);
last;
}
# Hit; add the Change to the series.
print "Adding bound $$change{id} and ".int(@prospects)." prospect(s)\n"
if ($debug);
} elsif (!@prospects || $extend) {
# The specified tip Change is bound, or we are extending
# and the proto-series so far consists of only loose Changes.
print "Adding bound $$change{id} and ".int(@prospects)." prospect(s) at tip\n"
if ($debug);
# This Change determines the series.
$group_key = $gid;
} else {
# Stop when encountering a bound Change after only loose ones
# (unless extending).
print "Breaking off at bound $$change{id} after only loose\n" if ($debug);
last;
}
unshift @changes, $change, @prospects;
@prospects = ();
}
$change = $$change{parent};
last if (!$change);
}
# We also do reverse traversal, so one can re-order the series including
# the last Change, but continue to use the same push command from history.
# But we don't reverse-traverse if the specified Change is loose (and we're
# not extending), based on the assumption that it was meant to be the tip
# - otherwise, the semantics get really unintuitive.
return (\@prospects, undef, $change, []) if (!defined($group_key));
return (\@changes, $group_key, @prospects ? $prospects[-1] : $change, [])
if ($forward_only);
my @rprospects;
while (1) {
$rchange = $$rchange{child};
last if (!defined($rchange));
my $gid = $$rchange{grp};
if (!defined($gid)) {
# We don't automatically capture loose Changes on top of the series,
# again to keep the semantics sane.
print "Prospectively capturing loose $$rchange{id} (reverse)\n" if ($debug);
push @rprospects, $rchange;
} else {
if ($gid != $group_key) {
print "Breaking off at foreign bound $$rchange{id} (reverse)\n" if ($debug);
last;
}
print "Adding bound $$rchange{id} and ".int(@rprospects)." prospect(s) (reverse)\n"
if ($debug);
push @changes, @rprospects, $rchange;
@rprospects = ();
}
}
return (\@changes, $group_key, undef, \@prospects);
}
###################
# commit creation #
###################
# Cache of diffs. Global, so it can be flushed from the outside.
our %commit2diff;
# Apply one commit's diff on top of another commit; return the new tree.
sub apply_diff($$$)
{
my ($commit, $base_id, $flags) = @_;
my $sha1 = $$commit{id};
my $diff = $commit2diff{$sha1};
if (!defined($diff)) {
my $show = open_cmd_pipe(0, 'git', 'diff-tree', '--binary', '--root', "$sha1^!");
$diff = get_process_output($show, 'stdout');
close_process($show);
$commit2diff{$sha1} = $diff;
}
# We don't know the tree when the base is an upstream commit.
# This is just fine, as this will be the first commit in the
# series by definition, so we need to load it anyway. The
# subsequent apply will change it in every case, so there
# is no chance to recycle it, either.
my $base = $commit_by_id{$base_id};
run_process(FWD_STDERR, 'git', 'read-tree', ($base_id eq 'ROOT') ? '--empty' : $base_id)
if (!$base || ($curr_tree ne $$base{tree}));
$curr_tree = "";
my $proc = open_process(SOFT_FAIL | USE_STDIN | SILENT_STDIN | NUL_STDOUT | $flags,
'git', 'apply', '--cached', '-C1', '--whitespace=nowarn');
write_process($proc, $diff);
my $errors = get_process_output($proc, 'stderr')
if ($flags & USE_STDERR);
close_process($proc);
if ($?) {
print "Diff application failed.\n" if ($debug);
return (undef, $errors);
}
$curr_tree = read_cmd_line(0, 'git', 'write-tree');
return ($curr_tree, undef);
}
# Create a commit object from the specified metadata.
sub create_commit_raw($$$$$)
{
my ($parents, $tree, $commit_msg, $author, $committer) = @_;
($ENV{GIT_AUTHOR_NAME}, $ENV{GIT_AUTHOR_EMAIL}, $ENV{GIT_AUTHOR_DATE}) = @$author;
($ENV{GIT_COMMITTER_NAME}, $ENV{GIT_COMMITTER_EMAIL}, $ENV{GIT_COMMITTER_DATE}) = @$committer;
my @pargs = map { ('-p', $_) } @$parents;
my $proc = open_process(USE_STDIN | SILENT_STDIN | USE_STDOUT | FWD_STDERR,
'git', 'commit-tree', $tree, @pargs);
write_process($proc, $commit_msg);
my $sha1 = read_process($proc);
close_process($proc);
return $sha1;
}
sub create_commit($$$$$)
{
my ($parents, $tree, $commit_msg, $author, $committer) = @_;
my $sha1 = create_commit_raw($parents, $tree, $commit_msg, $author, $committer);
my $commit = {
id => $sha1,
parents => $parents,
tree => $tree
};
init_commit($commit);
return $commit;
}
###################
# branch tracking #
###################
# This tracks the local branch each Change lives on, following cherry-picks
# and purges as much as possible.
# Format a single branch name for display.
sub _format_branch($)
{
my ($branch) = @_;
return ($branch ne '-') ? "'$branch'" : '<detached HEAD>';
}
# Format the source branch names from an array of Changes,
# using Oxford English grammar.
sub _format_branches_raw($)
{
my ($changes) = @_;
my @branches = sort map { _format_branch($$_{src}) } @$changes;
my $str = "$branches[0]";
if (@branches > 1) {
if (@branches > 2) {
$str .= ", $branches[$_]" for (1 .. @branches - 2);
$str .= ",";
}
$str .= " and $branches[-1]";
}
return $str;
}
# As above, but with quantifiers to signify that we mean all branches.
sub _format_branches(@)
{
my ($changes) = @_;
my $str = _format_branches_raw($changes);
return $str if (@$changes == 1);
return "both $str" if (@$changes == 2);
return "all of $str";
}
my %sm_notices;
my %sm_failures;
# Format the message about the outcome of a Change assignment attempt.
sub _format_result($$@)
{
my ($new, $fmt, @args) = @_;
my $lbr = $local_branch // "-";
my $event = sprintf("%son %s $fmt.",
$new ? "newly " : "", _format_branch($lbr), @args);
}
sub _push_notice($$$@)
{
my ($commit, $new, $fmt, @args) = @_;
return if ($quiet);
push @{$sm_notices{_format_result($new, $fmt, @args)}}, $commit;
}
sub _push_failure($$$@)
{
my ($commit, $new, $fmt, @args) = @_;
push @{$sm_failures{_format_result($new, $fmt, @args)}}, $commit;
}
sub _format_results($)
{
my ($target) = @_;
my $out = "";
foreach my $event (sort keys %$target) {
my @cmts = map { format_commit($_) } @{$$target{$event}};
$out .= join("\n", @cmts)."\n ".$event."\n";
}
return $out;
}
use constant {
_SRC_NOOP => 0,
_SRC_MOVE => 1,
_SRC_COPY => 2,
_SRC_HIDE => 3
};
my @sm_options;
my $sm_option_new;
my %sm_option_by_id;
my %sm_wanted;
my %sm_present;
my $sm_changed = 0;
my $sm_failed = 0;
my @sm_errors;
# Parse a single command line option relating to source branch tracking.
# $arg is the currently processed argument, while $args are the remaining
# arguments on the command line. If $rmt_ok is true, plus-prefixed remote
# specifications are accepted as well; note that these are not removed
# from the command line, unlike local ones.
sub parse_source_option($$\@)
{
my ($arg, $rmt_ok, $args) = @_;
my $action;
if ($arg eq "--move") {
$action = _SRC_MOVE;
} elsif ($arg eq "--copy") {
$action = _SRC_COPY;
} elsif ($arg eq "--hide") {
$action = _SRC_HIDE;
} else {
return undef;
}
fail("$arg needs an argument.\n")
if (!@$args || ($$args[0] =~ /^-/));
my $orig = shift @$args;
my $tip = $orig;
my ($base, $count);
my $all = 0;
my $branch = $1 if ($tip =~ s,/(.*)$,,);
my $rmt_id;
if ($rmt_ok && $tip =~ /^\+(\w+)/) {
$rmt_id = $1;
unshift @$args, $tip;
} else {
$base = $1 if ($tip =~ s,^(.*)\.\.,,);
$count = $1 if ($tip =~ s,:(.*)$,,);
if ($tip eq "new") {
$tip = undef;
} elsif ($tip eq "all") {
$all = 1;
$tip = undef;
}
fail("Specifying a commit count and a range base are mutually exclusive.\n")
if (defined($base) && defined($count));
if (defined($base) || defined($count)) {
wfail("Specifying a commit count or range base is incompatible with "
."ranges 'new' and 'all'.\n")
if (!defined($tip));
} else {
wfail("Automatic ranges are not supported with $arg."
." Use $tip:1 if you actually meant a single Change.\n")
if (defined($tip));
}
}
fail("$arg does not support specifying a source branch.\n")
if (defined($branch) && ($action != _SRC_MOVE));
push @sm_options, {
action => $action,
orig => $orig,
rmt_id => $rmt_id,
base => defined($base) ? length($base) ? $base : '@{u}' : undef,
tip => defined($tip) ? length($tip) ? $tip : 'HEAD' : undef,
count => $count,
all => $all,
branch => $branch
};
return 1;
}
# Do final sanity checking on the source branch tracking related commands.
sub source_map_validate()
{
my $br = $local_branch // "-";
foreach my $option (@sm_options) {
my $sbr = $$option{branch};
wfail("Source and target branch are both '$br' in attempt to move Changes.\n")
if (defined($sbr) && ($sbr eq $br));
my $rmt_id = $$option{rmt_id};
if (defined($rmt_id)) {
$sm_option_by_id{$rmt_id} = $option;
next;
}
my $raw_tip = $$option{tip};
next if (defined($raw_tip));
wfail("--move, --copy, or --hide with 'all' must be the only such option.\n")
if ($$option{all} && @sm_options != 1);
wfail("Only one of --move, --copy, and --hide may be specified with 'new'.\n")
if (defined($sm_option_new));
$sm_option_new = $option;
}
}
# Expand the supplied ranges into series of commits, and create a reverse
# mapping of commits to command objects.
sub _source_map_prepare_local()
{
foreach my $option (@sm_options) {
my $raw_tip = $$option{tip};
next if (!defined($raw_tip));
my $commits;
my $tip = parse_local_rev($raw_tip, SPEC_TIP);
my $raw_base = $$option{base};
if (defined($raw_base)) {
my $base = parse_local_rev($raw_base, SPEC_BASE);
$commits = get_commits_base($base, $tip, $raw_base, $raw_tip);
} else {
my $count = $$option{count};
$commits = get_commits_count($tip, $count, $raw_tip);
}
foreach my $commit (@$commits) {
my $sha1 = $$commit{id};
my $old_option = $sm_option_by_id{$sha1};
wfail("Range $$option{orig} intersects $$old_option{orig} (at $sha1).\n")
if ($old_option);
$sm_option_by_id{$sha1} = $option;
}
$$option{commits} = $commits;
}
}
# Schedule the removal a single Change object from the state database.
sub _obliterate_change($$)
{
my ($change, $changes) = @_;
print "Obliterating $$change{key} ($$change{id}) from $$change{src}.\n" if ($debug);
@$changes = grep { $_ != $change } @$changes; # From %changes_by_id
$$change{garbage} = 1; # Mark it for %change_by_key traversal
}
# Visit the requested non-current local branches with the purpose of
# determining which Change objects still correspond with actual commits.
sub source_map_traverse()
{
return if ($sm_failed); # Errors are queued, don't iterate
# It would be tempting to always query all local branches in
# advance, to save the extra git call. However, this would also
# collect *really* old branches, and even though they are short,
# calculating the exclusion takes hundreds of milliseconds,
# which is slower than an extra git call even on Windows.
# Additionally, we need to traverse down to the push base of the
# previously pushed Changes (in case they were upstreamed already),
# and this can also have a significant cost if the corresponding
# local branch advanced a lot since a Change was pushed last time,
# so it's better to do that selectively.
return if (!%sm_wanted);
# This loop is likely to run only once per call, so don't bother
# coalescing the resulting visit_*() calls.
foreach my $br (keys %sm_wanted) {
print "Investigating other local branch $br ...\n" if ($debug);
my %present;
my @changes = grep { $$_{src} eq $br } values %change_by_key;
my (@missing, $utips);
my $tip = $local_refs{$br};
if (defined($tip)) {
visit_local_commits([ $tip ]);
my $commits = get_commits_free($tip);
print "Still present on the branch:\n".format_commits($commits) if ($debug);
if (@$commits) {
%present = map { $$_{changeid} => 1 } @$commits;
# Prepare garbage collection.
@missing = grep { !defined($present{$$_{id}}) } @changes;
$utips = [ get_1st_parent($$commits[0]) ];
} else {
@missing = @changes;
$utips = [ $tip ];
}
} else {
print "Branch disappeared.\n" if ($debug);
# The branch was deleted, so all its Changes are missing.
@missing = @changes;
# For the upstream check, we fall back to the branches the Changes
# were targeting. This is worse than using the actual upstream, as
# the target may be outdated and the Change actually went to another
# branch. Also, it's potentially more work.
my $urefs = $remote_refs{$upstream_remote};
if ($urefs) {
my %utiph = map { $_ => 1 } grep { $_ } map { $$urefs{$_} } \
grep { $_ } map { $$_{tgt} } @changes;
$utips = [ keys %utiph ];
}
}
$sm_present{$br} = \%present;
# We may need to garbage-collect the branch.
# Failure to do this would affect cherry-picks of Changes that were
# upstreamed - neither do we want to need --copy for Changes that are
# actually gone, nor do we want them to be detected as moves (and thus
# inherit the now incorrect target branch).
if (@missing) {
# Record the push base of each Change - if a Change is actually
# in our upstream, it will be so between its push base (which
# cannot be younger than the branch's tip at that time) and the
# branch's merge base with upstream.
my %bases = map { $_ => 1 } grep { $_ } map { $$_{base} } @missing;
if (%bases) {
print "Visiting upstream of other local branch $br ...\n" if ($debug);
my $urevs = visit_upstream_commits($utips, [ keys %bases ]);
foreach my $change (@missing) {
my $changeid = $$change{id};
_obliterate_change($change, $changes_by_id{$changeid})
if (defined($$urevs{$changeid}));
}
}
}
}
%sm_wanted = ();
return 1;
}
# Determine which of the Change objects in $changes still refer to
# actual commits.
sub _find_candidate_sources($$$)
{
my ($changes, $vanished, $persisting) = @_;
return 0 if (!$changes);
my $lbr = $local_branch // "-";
my $retry = 0;
foreach my $chg (@$changes) {
# Hidden Changes are supposed to be skipped over, so it
# would be backwards to use them as sources for moves.
next if ($$chg{hide});
my $obr = $$chg{src};
# The current branch is obviously not a sensible source.
next if ($obr eq $lbr);
# Note that detached HEADs "vanish" after switching to an actual
# branch, thereby freeing all Changes assigned to them, sans the
# garbage-collected ones.
my $present = $sm_present{$obr};
if (!$present) {
# Ensure that the branch is visited and garbage-collected.
$sm_wanted{$obr} = 1;
$retry = 1;
} elsif (defined($$present{$$chg{id}})) {
print "$$chg{id} persists on $obr.\n" if ($debug);
push @$persisting, $chg;
} else {
print "$$chg{id} vanished from $obr.\n" if ($debug);
$$chg{vanished} = 1;
push @$vanished, $chg;
}
}
return $retry;
}
sub source_map_assign($$)
{
my ($commit, $reference) = @_;
my $change = $$commit{change};
return $change if ($change);
my $lbr = $local_branch // "-";
my $changeid = $$commit{changeid};
my $changes = $changes_by_id{$changeid};
my %change_by_branch;
if ($changes) {
foreach my $chg (@$changes) {
my $br = $$chg{src};
$change_by_branch{$br} = $chg;
}
}
$change = $change_by_branch{$lbr};
my $new = !$change;
my $option = $sm_option_by_id{$reference // $$commit{id}} // $sm_option_new;
my $want_all = $option && $$option{all};
my $new_only = $option && !defined($$option{tip}) && !$want_all;
my $action = $option ? $$option{action} : _SRC_NOOP;
if ($action == _SRC_COPY || $action == _SRC_HIDE) {
# Note: We don't bother finding Changes which could be recycled -
# gpull will clean up.
# We don't complain about no-ops, as they don't hurt.
my $label = ($action == _SRC_HIDE) ? "hidden" : "copied";
if ($new || !$new_only) {
if ($new) {
$change = {};
_init_change($change, $changeid);
}
$$change{hide} = ($action == _SRC_HIDE) ? 1 : undef;
_push_notice($commit, $new, "marked as $label");
goto CHANGED;
}
print "Already have $$change{key} ($changeid) on $lbr; not $label.\n"
if ($debug);
goto FOUND;
}
if ($new || ($action == _SRC_MOVE && !$new_only)) {
my $schange;
my $sbr = ($action == _SRC_MOVE) ? $$option{branch} : undef;
if (defined($sbr)) {
$schange = $change_by_branch{$sbr};
if (!$schange) {
if ($want_all) {
# We don't take 'all' too literally, as that would be annoying.
print "$changeid isn't on specified source branch $sbr; ignoring.\n"
if ($debug);
goto MAYBENEW;
}
push @sm_errors,
"Change $changeid does not exist on '$sbr'; cannot move.\n";
goto FAIL;
}
if ($$schange{hide}) {
if ($want_all) {
print "$changeid is hidden on specified source branch $sbr; ignoring.\n"
if ($debug);
goto MAYBENEW;
}
push @sm_errors,
"Change $changeid is hidden on '$sbr'; cannot move.\n";
goto FAIL;
}
} else {
my (@vanished, @persisting);
if (_find_candidate_sources($changes, \@vanished, \@persisting)) {
print "Need to come back for $changeid.\n" if ($debug);
return undef;
}
if ($new) {
if (@vanished) {
if (@vanished > 1) {
_push_failure(
$commit, 1, "was/were previously on %s.\n"
." Use --move with a source, or use --copy/--hide",
_format_branches(\@vanished));
goto FAIL;
}
$change = pop @vanished;
# Note: this is a post-fact notice, so if the user failed to use
# --copy/--hide in advance, they'll need to fix it laboriously.
# This seems acceptable, as moving is the much more common case.
_push_notice(
$commit, 1, "was/were previously on %s. Inferring move",
_format_branch($$change{src}));
goto CHANGED;
}
if (!@persisting) {
# This is the common case: an entirely new Change.
goto ISNEW;
}
if ($action != _SRC_MOVE) {
_push_failure(
$commit, 1, "exist(s) also on %s.\n"
." Prune unneeded copies, or use --move/--copy/--hide",
_format_branches_raw(\@persisting));
goto FAIL;
}
} else { # implies $action == _SRC_MOVE
if (!$$change{hide}) {
# Attempts to move over active Changes are most likely mistakes.
_push_failure(
$commit, 0, "is/are not hidden.\n"
." Pass a source to --move if you really mean it");
goto FAIL;
}
if (@vanished) {
if (@vanished > 1) {
_push_failure(
$commit, 0, "was/were previously on %s.\n"
." Pass a source to --move to disambiguate",
_format_branches(\@vanished));
goto FAIL;
}
$schange = pop @vanished;
} elsif (!@persisting) {
_push_failure(
$commit, 0, "exist(s) on no other branch. Use --copy to unhide it/them");
goto FAIL;
}
}
if (!$schange) {
if (@persisting > 1) {
_push_failure(
$commit, $new, "exist(s) also on %s.\n"
." Prune unneeded copies, pass a source to --move,"
." or use --copy/--hide",
_format_branches_raw(\@persisting));
goto FAIL;
}
$schange = pop @persisting;
}
$sbr = $$schange{src};
} # !defined($sbr)
if ($change) {
# If the slot on the current branch is busy, we need to free it first.
# Note that this might be a hidden entry from a previous --move/--hide.
_obliterate_change($change, $changes);
}
if (!$$schange{vanished}) {
# If the Change still does or might exist on the source branch, we
# need to create a hidden entry for it, so it does not appear to be
# new next time around.
my %chg = (src => $sbr, grp => $$schange{grp}, hide => 1);
_init_change(\%chg, $changeid);
print "... and hidden on $sbr.\n" if ($debug);
}
_push_notice($commit, $new, "moved from %s", _format_branch($sbr));
$change = $schange;
goto CHANGED;
}
print "Already have $$change{key} ($changeid) on $lbr; leaving alone.\n"
if ($debug);
goto FOUND;
MAYBENEW:
goto CHANGED if (!$new);
ISNEW:
$change = {};
_init_change($change, $changeid);
CHANGED:
$$change{src} = $lbr;
$sm_changed = 1;
FOUND:
$$commit{change} = $change;
return $change;
FAIL:
$sm_failed = 1;
return undef;
}
sub source_map_finish()
{
wout(_format_results(\%sm_notices)) if (%sm_notices);
werr(_format_results(\%sm_failures)) if (%sm_failures);
werr(join("", @sm_errors)) if (@sm_errors);
exit(1) if ($sm_failed);
print "\n" if (%sm_notices); # Delimit from remaining output.
%sm_notices = ();
}
sub _source_map_finish_initial()
{
foreach my $option (@sm_options) {
# Only --copy & --hide imply grouping.
my $action = $$option{action};
next if ($action != _SRC_COPY && $action != _SRC_HIDE);
my $commits = $$option{commits};
next if (!$commits);
assign_series(changes_from_commits($commits));
$sm_changed = 1;
}
source_map_finish();
save_state($dry_run) if ($sm_changed);
}
# Update the target branches of local Changes according to the data
# from a Gerrit query.
# Each SHA1 is assigned to exactly one PatchSet, which in turn is
# assigned to exactly one Change. That way we can identify each Change
# by the last SHA1 we pushed it with, irrespective of the branch it is
# targeting. If the latter changes on Gerrit, we just follow it, as
# this is what the user usually wants.
sub _update_target_branches($)
{
my ($ginfos) = @_;
my @changed;
my $need_save;
foreach my $ginfo (@$ginfos) {
foreach my $rev (@{$$ginfo{revs}}) {
my $change = $change_by_pushed{$$rev{id}};
next if (!$change);
my $pbr = $$change{tgt} // "";
my $abr = $$ginfo{branch};
next if ($pbr eq $abr);
# Old gpush versions don't store the target branch. Make no noise about that.
if ((length($pbr) && !$quiet) || $debug) {
$$change{annotation} = " [$pbr => $abr]";
push @changed, $change;
}
$$change{tgt} = $abr;
$$change{ntgt} = undef
if (($$change{ntgt} // "") eq $abr);
$need_save = 1;
}
}
if (@changed) {
my @reports;
report_flowed(\@reports,
"Notice: Adjusting ".int(@changed)." Change(s) to server-side re-targeting:");
report_local_changes(\@reports, \@changed);
print format_reports(\@reports)."\n"; # Delimit from remaining output.
# The Changes may be printed again later.
delete $$_{annotation} foreach (@changed);
}
save_state($dry_run) if ($need_save);
}
#######################
# gerrit ssh handling #
#######################
# URL for pushing/fetching from the Gerrit instance.
our $gerrit_url;
# SSH command with arguments for connecting the Gerrit instance.
our @gerrit_ssh;
# Target repository name on the Gerrit instance.
our $gerrit_project;
# Extract Gerrit configuration from the previously determined Gerrit remote.
sub set_gerrit_config($)
{
my ($rmt) = @_;
my $url = git_config('remote.'.$rmt.'.pushurl');
$url = git_config('remote.'.$rmt.'.url') if (!$url);
fail("Remote '$rmt' does not exist.\n") if (!$url);
$url = _rewrite_git_push_url($url);
$gerrit_url = $url;
push @gerrit_ssh, '-p', $2 if (defined($2));
push @gerrit_ssh, $1;
$gerrit_project = $3;
} elsif ($url =~ m,^([^/:]+):([^/].*?)(?:\.git)?/?$,) {
push @gerrit_ssh, $1;
$gerrit_project = $2;
} else {
fail("Remote '$rmt' does not use a supported protocol.\n")
}
if (@gerrit_ssh) {
# Precedence according to git/connect.c:fill_ssh_args()
my $gssh = $ENV{GIT_SSH_COMMAND} // git_config('core.sshcommand');
if (defined($gssh)) {
# Should use shell rules here, but that seems like overkill.
unshift @gerrit_ssh, split(/ /, $gssh);
} else {
unshift @gerrit_ssh, $ENV{GIT_SSH} // 'ssh';
}
}
}
sub query_gerrit_only($;$)
{
my ($ids, $extra) = @_;
my @ginfos;
my $info = open_cmd_pipe(0, @gerrit_ssh, 'gerrit', 'query', '--format', 'JSON',
'--no-limit', '--patch-sets', $extra ? @$extra : (),
"project:$gerrit_project", '\\('.join(' OR ', @$ids).'\\)');
while (read_process($info)) {
my $review = decode_json($_);
defined($review) or fail("Cannot decode JSON string '".chomp($_)."'\n");
my ($key, $changeid) = ($$review{'number'}, $$review{'id'});
next if (!defined($key) || !defined($changeid));
my $ginfo = \%{$gerrit_info_by_key{$key}};
push @{$gerrit_infos_by_id{$changeid}}, $ginfo;
my ($subject, $status) = ($$review{'subject'}, $$review{'status'});
defined($subject) or fail("Huh?! $changeid has no subject?\n");
defined($status) or fail("Huh?! $changeid has no status?\n");
my ($branch, $topic) = ($$review{'branch'}, $$review{'topic'});
defined($branch) or fail("Huh?! $changeid has no branch?\n");
my $pss = $$review{'patchSets'};
defined($pss) or fail("Huh?! $changeid has no PatchSets?\n");
my (@revs, %rev_map);
foreach my $cps (@{$pss}) {
my ($number, $ts, $revision, $base, $ref) =
($$cps{'number'}, $$cps{'createdOn'}, $$cps{'revision'},
$$cps{'gpush-base'}, $$cps{'ref'});
defined($number) or fail("Huh?! PatchSet in $changeid has no number?\n");
defined($ts) or fail("Huh?! PatchSet $number in $changeid has no timestamp?\n");
defined($revision) or fail("Huh?! PatchSet $number in $changeid has no commit?\n");
defined($ref) or fail("Huh?! PatchSet $number in $changeid has no ref?\n");
my %rev = (
id => $revision,
ps => $number,
ts => int($ts),
base => $base,
ref => $ref
);
$revs[$number] = \%rev;
$rev_map{$revision} = \%rev;
$gerrit_info_by_sha1{$revision} = $ginfo;
}
$$ginfo{key} = $key;
$$ginfo{id} = $changeid;
$$ginfo{subject} = $subject;
$$ginfo{status} = $status;
$$ginfo{branch} = $branch;
$$ginfo{topic} = $topic;
$$ginfo{revs} = [ grep { $_ } @revs ]; # Drop deleted ones.
$$ginfo{rev_by_id} = \%rev_map;
my $rvrs = $$review{'allReviewers'};
if ($rvrs) {
# Note: This does not differentiate between reviewers and CCs.
my %reviewers;
foreach my $rvr (@$rvrs) {
foreach my $ky ('name', 'email', 'username') {
my $val = $$rvr{$ky};
$reviewers{$val} = RVRTYPE_ANY if (defined($val));
}
}
$$ginfo{reviewers} = \%reviewers;
}
push @ginfos, $ginfo;
}
close_process($info);
return \@ginfos;
}
sub query_gerrit($;$)
{
my ($ids, $extra) = @_;
_update_target_branches(query_gerrit_only($ids, $extra));
}
#############################
# export all public symbols #
#############################
sub import()
{
no strict 'refs';
my %imported = map { $_ => 1 } @_imported;
undef @_imported;
while (my ($name, $symbol) = each %{__PACKAGE__.'::'}) {
next if (defined($imported{$name}));
next if ($name =~ /^(_.*|BEGIN|END|a|b|import)$/);
# $symbol values referring to constants are resolved, but we want to alias the
# inline function. Other values are typeglobs which can be aliased directly.
*{caller.'::'.$name} = !length(ref($symbol)) ? *$symbol : \&{__PACKAGE__.'::'.$name};
}
}
1;