App-Git-Autofixup
view release on metacpan or search on metacpan
git-autofixup view on Meta::CPAN
}
return @hunks;
}
# Dequote and unescape filenames that appear in diff output.
#
# If the filename is otherwise "normal" but contains spaces it's followed by a
# trailing tab, and if it contains uncommon control characters or non-ASCII
# characters, then the filename gets surrounded in double-quotes and non-ASCII
# characters get replaced with octal escape sequences.
#
# For details about exactly what gets quoted, see the sq_lookup array in
# git/quote.c.
#
# Assume --no-prefix or similar has been used and the diff doesn't include
# src/dst prefixes.
sub dequote_diff_filename {
$_ = shift;
s/\t$//m; # Remove trailing tab.
if (startswith($_, '"')) {
s/^"|"$//gm; # Remove surrounding quotes.
# Replace octal and control character escapes.
s/\\((?:\d{3})|(?:[abtnvfr"\\]))/"qq(\\$1)"/eeg;
}
return $_;
}
sub git_cmd {
return ('git', @GIT_OPTIONS, @_);
}
# With a linear git history there'll be a single merge base that's easy to
# refer to with @{upstream}, but during an interactive rebase we need to get
# the "current" branch from the rebase metadata.
#
# Unusual cases:
#
# While there can be multiple merge bases if there have been criss-cross
# merges, there'll still be a single fork point unless the relevant reflog
# entries have already been garbage-collected.
#
# When multiple upstreams are configured via `branch.<name>.merge` in git's
# config the most correct approach is probably to find the fork-point for each
# merge value and return those. But it seems unlikely that someone is doing
# octopus merges and using git-autofixup, so we're not handling that specially
# currently.
sub find_merge_bases {
my $upstream = '@{upstream}';
# If an interactive rebase is in progress, derive the upstream from the
# rebase meatadata.
my $gitdir = git_dir();
if (-e "$gitdir/rebase-merge") {
my $branch = slurp("$gitdir/rebase-merge/head-name");
chomp $branch;
$branch =~ s#^refs/heads/##;
$upstream = "$branch\@{upstream}";
}
# `git merge-base` will fail if there's no tracking branch. In that case
# redirect stderr and communicate failure by returning an empty list. Also,
# with the --fork-point option, no merge bases are returned if the relevant
# reflog entries have been GC'd, so fall back to normal merge-bases.
my @merge_bases = ();
my ($out, $err, $exit_code) = capture(qw(git merge-base --all --fork-point), $upstream, 'HEAD');
if ($exit_code == 0) {
@merge_bases = map {chomp; $_} split(/\n/, $out);
} else {
my ($out, $err, $exit_code) = capture(qw(git merge-base --all), $upstream, 'HEAD');
if ($exit_code != 0) {
die "git merge-base: $err";
}
@merge_bases = map {chomp; $_} split("\n", $out);
}
return wantarray ? @merge_bases : \@merge_bases;
}
sub git_dir {
my ($out, $err, $exit_code) = capture(qw(git rev-parse --git-dir));
if ($exit_code != 0) {
warn "git rev-parse --git-dir: $err\n";
die "Can't find repo's git dir\n";
}
chomp $out;
return $out;
}
sub toplevel_dir {
my ($out, $err, $exit_code) = capture(qw(git rev-parse --show-toplevel));
if ($exit_code != 0) {
warn "git rev-parse --show-toplevel: $err\n";
die "Can't find repo's toplevel dir\n";
}
chomp $out;
return $out;
}
# Run the given command, capture stdout and stderr, and return an array of
# (stdout, stderr, exit_code).
sub capture {
open(my $out_fh, '>', undef) or die "create stdout tempfile: $!";
open(my $err_fh, '>', undef) or die "create stderr tempfile: $!";
my $pid = open3(my $in_fh, $out_fh, $err_fh, @_);
waitpid $pid, 0;
if ($? & 127) {
my $signal = $? & 127;
die "capture: child died with signal $signal; exiting";
}
my $exit_code = $? >> 8;
local $/; # slurp
my $stdout = readline $out_fh;
my $stderr = readline $err_fh;
my @array = ($stdout, $stderr, $exit_code);
return wantarray ? @array : \@array;
}
# Return a description of what $? means.
sub child_error_desc {
my $err = shift;
if ($err == -1) {
return "failed to execute: $!";
} elsif ($err & 127) {
return "died with signal " . ($err & 127);
} else {
return "exited with " . ($err >> 8);
}
}
sub slurp {
my $filename = shift;
open my $fh, '<', $filename or die "slurp $filename: $!";
local $/;
my $content = readline $fh;
return $content;
}
sub summary_for_commits {
my @upstreams = @_;
my %commits;
my $negative = join(" ", map {"^$_"} @upstreams);
my @lines = qx(git log --no-merges --format=%H:%s HEAD $negative);
die "git log: " . child_error_desc($?) if $?;
for (@lines) {
chomp;
my ($sha, $msg) = split ':', $_, 2;
$commits{$sha} = $msg;
}
return \%commits;
}
# Return targets of fixup!/squash! commits.
sub sha_aliases {
my $summary_for = shift;
my %aliases;
my @targets = keys(%{$summary_for});
for my $sha (@targets) {
my $summary = $summary_for->{$sha};
next if $summary !~ /^(?:fixup|squash)! (.*)/;
my $prefix = $1;
if ($prefix =~ /^(?:(?:fixup|squash)! ){2}/) {
die "fixup commits for fixup commits aren't supported: $sha";
}
my @matches = grep {startswith($summary_for->{$_}, $prefix)} @targets;
if (@matches > 1) {
die "ambiguous fixup commit target: multiple commit summaries start with: $prefix\n";
} elsif (@matches == 0) {
die "no fixup target in topic branch: $sha\n";
} elsif (@matches == 1) {
$aliases{$sha} = $matches[0];
}
}
return \%aliases;
}
( run in 1.570 second using v1.01-cache-2.11-cpan-f56aa216473 )