#!/usr/bin/perl use strict; use Getopt::Long; my($no_cvs, $failures_only, $minor_updates); &Getopt::Long::Configure('bundling'); GetOptions( 'no-cvs|n' => \$no_cvs, 'failures-only|f' => \$failures_only, 'minor-updates|u' => \$minor_updates, ) or &usage; my $interesting_fuzz = $minor_updates ? '\d' : '[2-9]'; chdir('patches') if -d 'patches'; if (!-f 'verify-patches') { die <); close IN; mkdir('tmp', 0777) unless -d 'tmp'; chdir('tmp') or die "Unable to chdir to 'tmp'"; mkdir('workdir') unless -d 'workdir'; open(OUT, '>exclude') or die $!; print OUT <) { last if /^--- /; if (/^Depends-On-Patch: (\S+.diff)$/) { my $dep = $1; $has_dependencies = 1; print "\nApplying dependency patch $dep...\n"; if (system("patch -d cvsdir -p0 -b -Vt -Zf <../$dep") != 0) { print "Unable to cleanly apply dependency patch -- skipping $diff\n"; system "rm -f cvsdir/*.rej cvsdir/*/*.rej"; &restore_cvsdir; next DIFF; } } } close IN; my $default = apply_patch($diff); if ($default =~ s/^D,// || $default eq 'N') { my $def = generate_new_patch($diff); $default = 'U,N' if $default eq 'N' && $def eq 'E'; $default = 'N' if !$minor_updates && $default eq 'U,N'; } PROMPT: while (1) { print "\n----------- $diff ------------\n", "\nFix rejects, Diff create, Edit both diffs, Update patch,\n", "Apply patch again, !(CMD), Build rsync, Next, Quit: [$default] "; my $ans = ; chomp $ans; $ans = $default if $ans eq ''; while ($ans =~ s/^\s*(!|\w)((?workdir/Makefile') or die $!; print OUT "srcdir=.\n\n"; while () { last if /^gen:/; } print OUT $_; while () { last if /^clean:/; print OUT $_; } close IN; close OUT; } my $need_autoconf; my $conf_opts; open(IN, "../$diff") or die $!; while () { if (!defined $conf_opts) { $conf_opts = '' if /^---/; if (m#^\s*\./configure( .+)#) { $conf_opts = $1; } } if (m#^--- orig/(configure\.in|/aclocal\.m4)#) { $need_autoconf = 1; last; } } close IN; chdir('workdir') or die $!; system "autoconf; autoheader" if $need_autoconf; system "make proto; ./configure $CONF_OPTS $conf_opts; make"; chdir('..') or die $!; $default = '!make test'; next; } if ($cmd eq 'D') { $default = generate_new_patch($diff); next; } if ($cmd eq 'E') { chdir('workdir') or die $!; system "vim -d ../../$diff ../new.patch"; chdir('..') or die $!; $default = 'U,A,D'; next; } if ($cmd eq 'F') { chdir('workdir') or die $!; system "vim @rejects"; chdir('..') or die $!; $default = 'D,E'; next; } if ($cmd eq 'N') { last PROMPT; } if ($cmd eq 'Q') { exit; } if ($cmd eq 'U') { system "cp -p new.patch ../$diff"; print "\nUpdated $diff from new.patch\n"; $default = 'A'; next; } } } &restore_cvsdir; } exit; sub apply_patch { my($diff) = @_; undef @new; system "rsync -a --delete --exclude='*~' cvsdir/ workdir/"; print "\nApplying patch $diff...\n"; undef @rejects; my($saw_failure, $saw_offset, $saw_fuzz); open(IN, "patch -d workdir -p0 --no-backup-if-mismatch -Zf <../$diff |") or die $!; while () { print $_; chomp; if (s/^patching file //) { push(@new, $_) unless -f "cvsdir/$_"; } elsif (s/.* saving rejects to file //) { push(@rejects, $_); } elsif (/^Hunk #\d+ FAILED/) { $saw_failure = 1; } elsif (/^Hunk #\d+ succeeded at \d+( with fuzz $interesting_fuzz)?/o) { $saw_fuzz ||= defined $1; $saw_offset = 1; } } close IN; return 'F,D,E' if $saw_failure; return 'D,E' if $saw_fuzz && !$failures_only; return 'D,U,N' if $saw_offset && !$failures_only; 'N'; } sub generate_new_patch { my($diff) = @_; foreach (@new) { system "touch -r workdir/$_ cvsdir/$_"; } open(IN, "../$diff") or die $!; open(OUT, '>new.patch') or die $!; while () { last if /^--- /; print OUT $_; } close IN; open(IN, 'diff --exclude-from=exclude -upr cvsdir workdir |') or die $!; while () { next if /^(diff -|Index: |Only in )/; s#^\Q--- cvsdir/\E#--- orig/#; s#^\Q+++ workdir/\E#+++ #; s#(\.000000000)? \+0000$##; print OUT $_; } close IN; close OUT; foreach (@new) { unlink("cvsdir/$_"); } print "\nDiffing... "; if (system("diff ../$diff new.patch >/dev/null") == 0) { print "new patch is identical to old.\n"; return 'N'; } print "New patch DIFFERS from old.\n"; 'E'; } sub restore_cvsdir { return unless $has_dependencies; $has_dependencies = 0; foreach (glob('*.~[1-9]~'), glob('*/*.~[1-9]~')) { my $fn; ($fn = $_) =~ s/\.~1~$//; if ($fn eq $_) { unlink($_); } elsif (-r $fn) { rename($_, $fn); } else { unlink($_); unlink($fn); } } } sub usage { die <