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 )