cj-git-patchtool-wiggle

#!/usr/bin/perl -w

# Fri Sep  3 14:50:55 EDT 2010
(my $email='chrjae%gmail,com')=~ tr/%,/@./;

use strict;

use Getopt::Long;
use Chj::Util::AskYN qw(maybe_askyn);
use Chj::xpipe;
use Chj::Unix::Exitcode;
use Chj::xperlfunc ':all';
use Chj::xopen 'xopen_read';
use Chj::xtmpfile;
use Chj::IO::Command;

sub hash_add ($$$) {
    my ($h,$k,$v)=@_;
    push @{$$h{$k}}, $v;
}


$0=~ /(.*?)([^\/]+)\z/s or die "?";
my ($mydir, $myname)=($1,$2);
sub usage {
    print STDERR map{"$_\n"} @_ if @_;
    print "$myname basedir patchfilename
 -or-
$myname basedir/patchfilename

  apply patchfile, then feed the rejects to wiggle,
  if those worked out, save the new diff into the patchfile.

  Careful:
    - runs reset --hard
    - modifies the patchfile (but that should be in Git)

  (Christian Jaeger <$email>)
";
exit (@_ ? 1 : 0);
}

our $verbose=0;
#our $opt_dry;
GetOptions("verbose"=> \$verbose,
           "help"=> sub{usage},
           #"dry-run"=> \$opt_dry,
           ) or exit 1;

our $patchpath = do {
    if (@ARGV==2) {
        my($basedir,$patchfilename)=@ARGV;
        "$basedir/$patchfilename"
    } elsif (@ARGV==1) {
        $ARGV[0]
    } else {
        usage
    }
};


my $oldpatch= xopen_read $patchpath;

xxsystem "git","reset","--hard";

#hm grr how again pipelines sigh whatever
my $rej= do {
    my ($r,$w)=xpipe;
    if (xfork) {
        $w->xclose;

        my @rej;
        while (<$r>) {
            next if /^patching file /;
            next if /^Hunk #\d+ FAILED/;
            chomp;
            if (/\d+ out of \d+ hunks? (?:FAILED|ignored).*saving rejects to file (.*)/) {
                my $file=$1;
                if ($file=~ s/^'//) {
                    $file=~ s/'$// or die "hmm [$file] how?";
                }
                push @rej, $file;
            } elsif ($_ eq 'Reversed (or previously applied) patch detected!  Assume -R? [n] ') {
                print "NOTE: $_\n";
                #since i'm not sure what to do then.
            } elsif ($_ eq 'Apply anyway? [n] ') {
                print "NOTE: $_\n";
                #grr.  why does it ask when I said -f ?
            } elsif ($_ eq 'Skipping patch.') {
                print "NOTE: $_\n";
                #HMMMMM.
            } elsif (/^Hunk #\d+ succeeded/) {
                # print?
                print "NOTE: $_\n";
            } elsif (/^patch: .* malformed patch at/) {
                # handedited patch, from xemacs, hum. anyway, hope it
                # will be fixed by wiggle.
                print "NOTE: $_\n";
                #hm. but die anyway, it seems patch does not produce
                #an actual rej file then!
                die "cannot proceed";
            } elsif (my ($lineno) = /can't find file to patch at input line (\d+)/) {
                # somehow patch reports the line after the one with
                # the path (in addition to being 0-based)
                $lineno--;
                my $f = xopen_read $patchpath;
                my @lines = $f->xreadline;
                @lines >= $lineno or die "bug";
                my $linestr = $lines[$lineno-1];
                $linestr=~ s{^\+\+\+ b/}{} or die "bug";
                my $filepath = $linestr;
                die "can't find file to patch at '$patchpath' line $lineno: $filepath";
            } elsif ($_ eq '') {
                #eh.whatever
            } else {
                die "unknown message from patch: '$_'";
            }
        }

        $r->xclose;
        #my $code= xwait;
        xwait;
        my $code= $?; #GAH
        ($code==0
         or $code== (1<<8))
          or do {
              die "patch died of a serious error, code ".exitcode($code);
          };

        \@rej
    } else {
        $r->xclose;
        $w->xdup2(1);
        $w->xdup2(2);
        my $p= Chj::IO::Command->new_receiver("patch",
                                              "--ignore-whitespace",
                                              "-p1");
        $oldpatch->xsendfile_to ($p);
        $oldpatch->xclose;
        $p->xfinish;
        exit;
    }
};

print "Ok, patch possibly applied.\n";

my $nwiggles=0;
my %wiggled;
for my $rejfile (@$rej) {
    print "Calling wiggle for '$rejfile'..\n";
    # +-copy from /opt/chj/bin/wiggle¬
    my $file= $rejfile;
    $file=~ s/\.rej$//
      or die "file '$file' does not have suffix .rej";
    $wiggled{$file}++;
    {
        my $porig=$file.".porig";
        if (-e $porig) {
            unlink $porig;
        }
    }
    my $stat= xlstat $file;
    my $res= xsystem "wiggle", "--replace", $file, $rejfile;
    # reconstruct the x flag that wiggle dropped.
    xchmod $stat->mode, $file;
    if ($res) {
        if (!maybe_askyn "wiggle exited with error code $res; continue? ") {
            die "stopped by user request.\n";
        }
    }
    $nwiggles++;
}

print "Ok, $nwiggles wiggles.\n";


sub parse_patch ($) {
    my ($in)= @_;
    my @headlines;
    my @diffparts;
    # ({ oldfilename=> ..,
    #    newfilename=> ..,
    #    lines=> [ lines.. ] }.. )
    my $touchedfilename2parts= {};
    my $maybe_current_collector;
    while (<$in>) {
        if (my ($a,$b)= m{^diff --git a/(\S*) b/(\S*)}) {
            # ^XX this is a bit unsafe, could be part of commit
            # message! A proper check would be for "---" then
            # emptyline then diff? or something. Also assumes no
            # whitespace(/special chars) in paths.

            $maybe_current_collector= [$_];
            my $part=  +{ oldfilename=> $a,
                          newfilename=> $b,
                          lines=> $maybe_current_collector};
            push @diffparts, $part;
            hash_add $touchedfilename2parts, $a, $part;
            hash_add $touchedfilename2parts, $b, $part
              unless $a eq $b;
        } else {
            if ($maybe_current_collector) {
                push @$maybe_current_collector, $_;
            } else {
                push @headlines, $_;
            }
        }
    }
    +{ headlines=> \@headlines,
       diffparts=> \@diffparts,
       touchedfilename2parts=> $touchedfilename2parts,
     }
}


{
    # Update the patchfile:

    # Copy the head from oldpatch, and an assortment of diff parts
    # from `git diff` and the old patch.

    $oldpatch->xrewind;
    my $oldp= parse_patch($oldpatch);
    $oldpatch->xclose;

    # Get the `git diff`, also split into parts:
    my $d= Chj::IO::Command->new_sender ("git","diff");
    my $gitp= parse_patch($d);
    $d->xxfinish;

    # Recreate the patchfile:
    my $new= xtmpfile $patchpath;
    $new->xprint(@{ $oldp->{headlines} });

    for my $diffpart (@{ $oldp->{diffparts} }) {
        my $filename= $diffpart->{newfilename};
        # Take diff part from gitp if present, otherwise from
        # oldp. Note that we can't just look at
        # $gitp->{touchedfilename2part}{$filename} to know whether wee
        # need to choose gitp, since if it wasn't wiggled, the git
        # diff will still have the file but as a deletion.
        if (my $ps= $gitp->{touchedfilename2parts}{$filename}) {
            for my $p (@$ps) {
                $new->xprint(@{$p->{lines}});
            }
        } else {
            $new->xprint(@{$diffpart->{lines}});
        }
    }
    $new->xclose;
    $new->xputback;
}

print "Ok.\n";

#use Chj::ruse;
#use Chj::Backtrace; use Chj::repl; repl;
#use Chj::Trapl;