commit-patch

#!/usr/bin/perl -w
# Copyright © 2003-2021 David Caldwell <david@porkrind.org>
#                   and Jim Radford <radford@bleackbean.org>
# This code can be distributed under the terms of the GNU Public License (Version 2 or greater).

my $VERSION = '2.6.2';
my $FALLBACK_EDITOR = 'vi';

use strict;
use Cwd qw(abs_path);
use File::Basename;
use lib dirname(abs_path($0))."/local/lib/perl5";
use IPC::Run;
use File::Temp qw(tempfile);
use Getopt::Long;
use Pod::Usage;

my ($dry_run, $verbose);
sub run {
    if ($verbose || $dry_run) {
        for (@_) {
            print join ' ', map { $_ =~ / / ? "\"$_\"" : $_ } @$_ if ref $_ eq 'ARRAY';
            print " $_ " if ref $_ eq '';
            print '[',ref $_,'] ' if ref $_ ne 'ARRAY' && ref $_ ne '';
        }
        print "\n";
    }
    return 1 if $dry_run;
    IPC::Run::run(@_);
}

sub trim($) {
    my $s = shift;
    $s =~ s/^\s*//;
    $s =~ s/\s*$//;
    $s
}

my %clean; # Rename keys to values on any error (rollback). Unlinks keys on success.
my $repo=".";
my $amend;
my %vc;
while (!$vc{name}) {
    if (-d "$repo/CVS" && $repo eq '.') {
        %vc = (name         => 'cvs',
               diff         => 'cvs diff -Nu',
               commit       => 'cvs commit',
               message      => sub { ('-m', $_[0]) },
               message_file => sub { ('-F', $_[0]) },
               add          => 'cvs add',
               remove       => 'cvs rm',
               patcharg     => '-p0',
               lsdiffarg    => []);
    } elsif (-d "$repo/.svn") {
        %vc = (name         => 'svn',
               diff         => 'svn diff -x -u',
               commit       => 'svn commit',
               message      => sub { ('-m', $_[0]) },
               message_file => sub { ('-F', $_[0]) },
               add          => 'svn add',
               remove       => 'svn delete',
               patcharg     => '-p0',
               lsdiffarg    => []);
    } elsif (-d "$repo/_darcs") {
        %vc = (name         => 'darcs',
               diff         => 'darcs diff -u',
               add          => 'darcs add',
               remove       => 'true',
               commit       => 'darcs record --all',
               amend        => 'darcs amend-record --all',
               patcharg     => '-p1',
               lsdiffarg    => [qw(--strip 1)],
               message      => sub {
                   return () if $amend; # Darcs amend doesn't have --logfile, so don't support comments on amend.
                   # Darcs doesn't like multiline -m comments so we have to put the log message into a file and use --logfile. Yuck.
                   #return ('-m', $_[0]);
                   my $message = $_[0];
                   $message .= "\n" unless $message =~ /\n$/s; # Darcs does screwey stuff when logfile has no trailing \n.
                   my ($message_file, $message_filename) = tempfile("commit-patch-message-XXXXXXXX", UNLINK=>0);
                   print $message_file $message;
                   close $message_file;
                   $clean{$message_filename} = undef; # make sure we delete this file on exit.
                   ("--logfile=$message_filename");
               },
               message_file => sub { die "Darcs doesn't support --message-file and --amend" if $amend; ("--logfile=$_[0]" ) });
    } elsif (-d "$repo/.hg") {
        %vc = (name         => 'hg',
               diff         => 'hg diff',
               commit       => 'hg commit',
               message      => sub { ('-m', $_[0]) },
               message_file => sub { ('--logfile', $_[0]) },
               add          => 'hg addremove',
               remove       => 'true',
               patcharg     => '-p1',
               lsdiffarg    => [qw(--strip 1)]);
    } elsif (-d "$repo/.bzr") {
        %vc = (name         => 'bzr',
               diff         => 'bzr diff',
               commit       => 'bzr commit',
               message      => sub { ('-m', $_[0]) },
               message_file => sub { ('--file', $_[0]) },
               add          => 'bzr add',
               remove       => 'true',
               patcharg     => '-p0',
               lsdiffarg    => []);
        chdir $repo; # otherwise commit-partial from within a project subdir fails.
    } elsif (-d "$repo/.git") {
        %vc = (name         => 'git',
               diff         => 'git diff --relative', # Use --relative here because "git diff | git apply --cached" fails to apply hunks from files not in your current dir tree
               commit       => 'git commit',
               amend        => 'git commit --amend',
               message      => sub { ('-m', $_[0]) },
               message_file => sub { ('-F', $_[0]) },
               previous_message => sub { my $prev; run([qw(git log -1 --pretty=format:%s%n%b)], '>', \$prev); $prev });
        # Git is special cased below.
    } elsif (-d "$repo/_MTN") {
        %vc = (name         => 'mtn',
               diff         => 'mtn automate content_diff',
               commit       => 'mtn commit',
               message      => sub { ('-m', $_[0]) },
               message_file => sub { ('--message-file', $_[0]) },
               add          => 'mtn add',
               remove       => 'mtn drop',
               patcharg     => '-p0',
               lsdiffarg    => []);
    } else {
        $repo.="/..";
        printf("Trying back a dir: $repo, abs:%s\n", abs_path($repo));
        die "couldn't find repo" if abs_path($repo) eq "/";
    }
}

my $commit_partial = $0 =~ /commit-partial/;
my $commit_patch  = !$commit_partial;

my ($message, $message_filename, $retry);
GetOptions("h|help" => sub { pod2usage(1) },
           "n|dry-run"        => \$dry_run,
           "a|amend"          => \$amend,
           "v|verbose"        => \$verbose,
           "version"          => sub { print "Version $VERSION\n"; exit },
           $commit_patch ?
             ("m|message=s"      => \$message,
              "F|message-file=s" => \$message_filename)
             : # commit-partial
             ("r|retry"          => \$retry),
    ) and ($commit_patch   && scalar @ARGV <= 1 ||
           $commit_partial) or pod2usage(2);

my $patch;
if ($commit_patch) {
    if (scalar @ARGV == 1) {
        $patch = shift;
    } else {
        (my $p, $patch) = tempfile("commit-patch-patch-XXXXXXXX", UNLINK=>0);
        print $p $_ while (<>);
        $clean{$patch} = undef;
    }
}

my $vc_commit = $amend ? ($vc{amend} || die "$vc{name} does not support amending.\n") : $vc{commit};

# commit-partial creates a patch file for them and launches their editor.
if ($commit_partial) {
    $patch = "commit.$$.patch";
    $clean{$patch} = undef;

    my $previous_message = !$amend ? '' : $vc{previous_message} && trim $vc{previous_message}->();
    $message = $previous_message;
    if ($retry) {
        use File::Copy;
        copy("#last-comit-partial.patch", $patch);
    } else {
        open PATCH, '>', $patch or die "$patch: $!\n";
        print PATCH "$message\n",
                    "# Enter your commit comment above and edit your patch below.\n",
                    "# (Lines starting with # will be stripped and leading and trailing whitespace removed).\n",
                    "# An empty comment will cancel the operation.\n",
                    "==END_COMMENT==\n" if defined $message;
        close PATCH;

        run([split(/ /,$vc{diff}), @ARGV], '>>', $patch);
    }
    system(($ENV{VISUAL} || $ENV{EDITOR} || $FALLBACK_EDITOR)." ".$patch);
    my $last_patch = "#last-comit-partial.patch";
    unlink "$last_patch.3";
    rename "$last_patch.2", "$last_patch.3";
    rename "$last_patch", "$last_patch.2";
    link $patch, $last_patch;

    if (defined $message) {
        open PATCH, '<', $patch or die "couldn't read $patch: $!\n";
        while (<PATCH>) {
            next if /^\#/;
            goto finished if /^==END_COMMENT==$/;
            $message .= $_;
        }
        die "Couldn't find comment terminator (==END_COMMENT==)\n";
      finished:
        $message = trim($message);
        undef $message if $amend && $message eq $previous_message;
    }

    die "No commit message, so I'm not going to do anything.\n" if !$amend && $message eq '';
}

die "bad patch file: $!" if -z $patch;
die "Invalid message" if !$amend && defined $message && $message eq "";

my @message_opt = $message          ? $vc{message}->($message) :
                  $message_filename ? $vc{message_file}->($message_filename) : ();

# Git pretty much supports what commit-patch does already, so we special case it here.
if ($vc{name} eq 'git') {
    run([qw(git diff --cached --quiet)]) or die "The index is not empty. Cowardly refusing to do anything potentially harmful.\n";
    run([qw(git apply --cached), $patch]) or die "Git failed.\n";
    run([split(/ /,$vc_commit), @message_opt]) or die "Git failed.\n";
    exit;
}

my ($lsdiff_out, $err);
run ["lsdiff", '-s', @{$vc{lsdiffarg}}, $patch], '>', \$lsdiff_out, '2>', \$err or die "lsdiff -s: $! ($err)";
my %lsdiff = map { /^([-+!])\s+(.*)$/ or die "bad lsdiff line: $_\nOut:\n$lsdiff_out"; ( $2 => $1 ) } split(/\n/, $lsdiff_out);
my @added   = grep { $lsdiff{$_} eq '+' } keys %lsdiff;
my @removed = grep { $lsdiff{$_} eq '-' } keys %lsdiff;
my @changed = grep { $lsdiff{$_} eq '!' } keys %lsdiff;
die "No files in patch" unless scalar %lsdiff;

#print "Found $vc{name} in $repo\n";
#printf("files: %s\n", join(",", @files));

for my $f (@changed, @added, @removed) {
    run ["cp", "-f", $f, "$f.orig.$$"] or die "couldn't make backup of $f: $!" if -f $f;
    $clean{"$f.orig.$$"} = $f;
    unlink $f if grep { $_ eq $f } @added; # Needs to be gone so patch can create it
}
$SIG{PIPE} = $SIG{INT} = $SIG{QUIT} = sub { print "Cleanly aborting..\n"; };

my ($out, $working_patch, $non_committed_patch);
run([split(/ /,$vc{diff}),   @changed, @removed], '>', \$working_patch,                         '2>', \$err);# CVS diff dies. Sigh. or die "$err\n";
unless ($working_patch =~ /^\s*$/s) { # Work around an apparent bug in darcs (<http://bugs.darcs.net/issue2067>)
  run(["interdiff", $vc{patcharg}, $patch, '/dev/stdin'], '<', \$working_patch,
                                                          '>', \$non_committed_patch,           '2>', \$err) or die "$err\n";
  run([qw"patch -R --force", $vc{patcharg}], '<', \$working_patch,                  '>', \$out, '2>', \$err) or die "$out\n$err\n";
}
run(["patch", $vc{patcharg}], '<', $patch,                                          '>', \$out, '2>', \$err) or die "patch: $out\n$err\n";
run([split(/ /,$vc{add}),    @added],                                               '>', \$out, '2>', \$err) or die "$vc{add}: $out\n$err\n" if @added;
run([split(/ /,$vc{remove}), @removed],                                             '>', \$out, '2>', \$err) or die "$vc{remove}: $out\n$err\n" if @removed;
# Don't capture stdout or stderr because it can be interactive (cough cough darcs)
run([split(/ /,$vc_commit), @message_opt, @added, @removed, @changed])                                       or die "commit failed.\n";
run(["patch", $vc{patcharg}], '<', \$non_committed_patch,                           '>', \$out, '2>', \$err) or die "patch: $out\n$err\n";

END {
    return if $dry_run;
    if ($?) { # Did we die?
        foreach my $k (grep { $clean{$_} } keys %clean) { rename $k,$clean{$k}; delete $clean{$k} }
    }
    foreach my $k (keys %clean) { unlink $k }
}


=encoding utf-8

=head1 NAME

commit-patch - commit patches to I<Darcs>, I<Git>, I<Mercurial>, I<Bazaar>, I<Monotone>, I<Subversion>, or I<CVS> repositories

=head1 SYNOPSIS

commit-patch [B<--amend>] [B<-m> I<message>] [B<-F> I<message-file>] [B<-v>] [B<--dry-run>] [I<patch-file>]

commit-partial [B<--amend>] [B<-v>] [B<--dry-run>] [B<--retry>] [I<file> ...]

=head1 DESCRIPTION

Normally version control systems don't allow fine grained
commits. B<commit-patch> allows the user to control I<exactly> what
gets committed (or "recorded", in I<Darcs> parlance) by letting the user
supply a patch to be committed rather than using the files in the
current working directory. If I<patch-file> is not supplied on the
command line then the patch will be read from standard input.

B<commit-partial> is like commit-patch except that it will create a
patch from the current changes in the current working directory and
launch your editor so that you can edit the patch and the commit
message (using the B<VISUAL> environment variable, or if that isn't
set the B<EDITOR> environment variable, or, if I<that> isn't set,
B<vi>). Any files you specify will be passed to your version control's
diff command.

B<commit-patch> currently supports the following version control systems:
B<I<Darcs>>, B<I<Git>>, B<I<Mercurial>>, B<I<Bazaar>>, B<I<Monotone>>, B<I<Subversion>>, and B<I<CVS>>.

=head1 OPTIONS

B<-a>, B<--amend> - Amend a previous commit. Currently only B<I<Darcs>> and
B<I<Git>> support this option. When used with B<I<Git>> it will amend the
previous commit. When used with B<I<Darcs>>, B<I<Darcs>> will ask you which
patch you want to amend.

B<-m>, B<--message>=I<message> - An optional I<message> to use as the commit
text. If the message is multiple lines then I<Darcs>, I<Git>, and I<Mercurial>
will use the first line as the patch name and the rest as commit
details. If the C<-m> option is not specified then the result will be
the same as whatever the underlying version control system would do if
you didn't specify a message name on the command line. That is,
B<commit-patch> does not interfere with the patch naming process of
the underlying version control system; I<Darcs> will still ask you
interactively; I<CVS> and I<Subversion> will still launch your editor.

B<-F>, B<--message-file>=I<filename> - You can optionally get the
commit message from a file. This is generally only useful for
scripting B<commit-patch>.

B<-v>, B<--verbose> - Turn on debugging. This will print the commands
that B<commit-patch> is running to get the patch committed.

B<-n>, B<--dry-run> - Turn on more paranoid debugging. This will print
the commands that B<commit-patch> will run to get the patch committed
but it won't actually run those commands.

B<-r>, B<--retry> - Only available in I<commit-partial>. This will reload the
last patch that was attempted to be committed into your editor instead of the
current changes in the directory. This is for cases where the patch fails to
commit for some reason and you want to try to fix it instead of starting over.

=head1 DIAGNOSTICS

B<commit-patch> works by manipulating the working directory using
C<patch>, C<interdiff>, and the underlying version control system's
C<diff>.  If any part of the process fails, B<commit-patch> will
attempt to restore the working directory to the state it was before
the command was run. Any errors from the underlying version control
system or from patch will be printed.

=head1 CAVEATS

The patch specified on the command line must originate from the same
place as the current directory. That is, the following will not work:

  cvs diff -u > ../a.patch
  cd ..
  commit-patch a.patch

You B<must> run B<commit-patch> from the same directory that the
original patch was based from.

I<Darcs>, I<Git> and I<Mercurial> put C<a/> and C<b/> in front of all the paths
in the diff output. Don't worry about this; B<commit-patch> takes it into
account.

=head1 EXAMPLES

Typical I<CVS> usage:

  cvs diff -u > a.patch
  emacs a.patch
  commit-patch a.patch

I<Mercurial> usage with a message specified:

  hg diff > a.patch
  emacs a.patch
  commit-patch -m "This is a commit message" a.patch

I<Darcs> usage with a multi-line message specified:

  darcs diff -u > a.patch
  emacs a.patch
  commit-patch -m 'This is the patch name
  Here are the patch details' a.patch

=head1 AUTHORS

=over

=item *

David Caldwell <david@porkrind.org>

=item *

Jim Radford <radford@blackbean.org>

=back

=head1 COPYRIGHT AND LICENSE

Copyright © 2003-2021 by David Caldwell and Jim Radford.

B<commit-patch> is distributed under the GNU General Public
License. See the COPYING file in the distribution for more details.

=head1 HISTORY

B<commit-patch> was originally called C<cvs-commit-patch> and was a
bash script written in 2003 by Jim Radford (with David Caldwell in the
room drawing the procedure on a white board). David later converted it
do C<darcs-commit-patch>, then integrated them back together into
B<commit-patch>. I<Mercurial> support was then added. At some point
David translated from bash into perl because funky bash quoting issues
were causing problems with a repository that had a space in one of the
directory names.

=cut