App-Git-Autofixup
view release on metacpan or search on metacpan
git-autofixup view on Meta::CPAN
-c N, --context N set number of diff context lines (default 3)
-e, --exit-code use more detailed exit codes (see --help)
-s N, --strict N set strictness (default 0)
Assign a hunk to fixup a topic branch commit if:
0: either only one topic branch commit is blamed in the hunk context or
blocks of added lines are adjacent to exactly one topic branch commit.
Removing upstream lines is allowed for this level.
1: blocks of added lines are adjacent to exactly one topic branch commit
2: blocks of added lines are surrounded by exactly one topic branch commit
Regardless of strictness level, removed lines are correlated with the
commit they're blamed on, and all the blocks of changed lines in a hunk
must be correlated with the same topic branch commit in order to be
assigned to it. See the --help for more details.
-g ARG, --gitopt ARG
Specify option for git. Can be used multiple times. Deprecated in favor of
GIT_CONFIG_{COUNT,KEY,VALUE} environment variables; see `git help config`.
END
# Parse hunks out of `git diff` output. Return an array of hunk hashrefs.
sub parse_hunks {
my $fh = shift;
my ($file_a, $file_b);
my @hunks;
my $line;
while ($line = <$fh>) {
if ($line =~ /^--- (.*)/) {
$file_a = dequote_diff_filename($1);
} elsif ($line =~ /^\+\+\+ (.*)/) {
$file_b = dequote_diff_filename($1);
} elsif ($line =~ /^@@ -(\d+)(?:,(\d+))? \+\d+(?:,\d+)? @@/) {
my $header = $line;
next if $file_a ne $file_b; # Ignore creations and deletions.
my $lines = [];
while (1) {
$line = <$fh>;
if (!defined($line) || $line =~ /^[^ +\\-]/) {
last;
}
push @{$lines}, $line;
}
push(@hunks, {
file => $file_a,
start => $1,
count => defined($2) ? $2 : 1,
header => $header,
lines => $lines,
});
# The next line after a hunk could be a header for the next commit
# or hunk.
redo if defined $line;
}
}
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";
( run in 2.838 seconds using v1.01-cache-2.11-cpan-59e3e3084b8 )