[darcs-users] darcs_repatch.pl - fixing hopelessly broken conflicting patches
Nathan Gray
kolibrie at graystudios.org
Mon Aug 13 16:00:01 UTC 2007
I started out a fellow on darcs a while back. I found out last week
that he had dozens of patches he had never sent back to the main repo.
Some of them pushed just fine, about twenty did not, due to a conflict
in a parent patch from about a month ago.
The patch recorded some hunks that had nothing to do with the
comment, and those were the hunks that were encountering conflicts.
So we needed to remove those hunks from the patch so that we could
push the rest of the patch. We could not amend-record nor unrecord,
because of all the dependent patches burying the conflicting patch.
The answer was to write a quick Perl script to deconstruct the
patches, then put them back together again, with the conflicting parts
removed.
We still needed to do some manual cleanup after running the script,
but it was possible, and we had preserved the patch history.
The concept is:
darcs diff each patch reported by darcs push --dry-run
clone the target repo
apply each diff to the cloned target repo using patch
record a new patch on the cloned target repo with the same
author, name, comment, and timestamp as the original patch
manually clean up any .rej files generated by patch
Hopefully you will never encounter a situation requiring the use of
this script. I am providing it here in case you do find yourself in a
similar situation.
-kolibrie
#!/usr/bin/perl
=head1 NAME
darcs_repatch.pl - reconstruct darcs patches
=head1 SYNOPSIS
perl darcs_repatch.pl -h
=head1 DESCRIPTION
This script generates C<patch>-style diffs of darcs patches not
contained in a target repo, then uses C<patch> to apply those diffs
and record them with the same author, patch name, comment, and
timestamp as the original patch.
NEVER USE THIS SCRIPT ON PATCHES WHICH HAVE BEEN DISTRIBUTED TO
OTHER REPOS.
This script can be useful to resolve conflicts which are buried deep
underneath dependent patches. It effectively deconstructs a darcs
patch into a diff, then reconstructs the patch without the conflicts,
because those are weeded out during the merge of the diff against
the target repo.
It makes copies of the repos in question and does not alter any of
the original repos. However, USE AT YOUR OWN RISK.
You may have to do some work to resolve conflicts C<patch> was unable
to handle, which are contained in the C<.rej> files it generates.
=cut
use XML::Twig;
use IO::File;
use Getopt::Long;
my %param = ();
GetOptions(\%param, 'local=s', 'remote=s', 'h|help!');
usage() if $param{h};
sub usage {
print qq{Usage: $0 --local REPO --remote REPO
--local path to repo with bad patches
--remote path to parent/upstream/good repo
-h display this usage message\n};
exit;
}
# we want to make local copies of the repos so we do not mess up the originals
# and so that operations are faster
my $bad = clone_repo($param{local}) or die("failed to clone $param{local}\n");
my $good = clone_repo($param{remote}) or die("failed to clone $param{remote}\n");
my $target = clone_repo($good);
# add .rej to boring list for target repo (failed patch merges)
add_boring($target, '\.rej$');
# read in all the patches from the XML format
my @bad_patches = read_patches($bad);
#my @good_patches = read_patches($good);
# determine which patches should be reconstructed
my @queued_patches = patches_to_push($bad, $good, \@bad_patches);
# determine 'diff' output for each patch to be reconstructed
foreach my $patch (@queued_patches) {
$patch->{diff} = determine_diff($bad, $patch->{hash});
#$patch->{files} = determine_files($bad, $patch->{hash});
# attempt to apply each diff to the target repo and record changes
apply_diff($target, $patch);
record_changeset($target, $patch);
#exit;
}
if (@queued_patches) {
print "---\nGenerated merged repo at:\n $target\nYou may use this repo in place of:\n $param{local}\nafter manually merging in changes from any .rej files generated by 'patch'.\n";
} else {
print "Did not find any patches in $param{locol} to reconstruct\n";
}
sub clone_repo {
my $original = shift;
my $target = '/tmp/' . uuidgen();
print "cloning $original -> $target\n";
return $target unless system('darcs', 'get', $original, $target);
return;
}
sub uuidgen {
my $string = `uuidgen`;
chomp $string;
return $string;
}
sub add_boring {
my $repo = shift;
my $fh = IO::File->new("$repo/_darcs/prefs/boring", '>>') || return;
$fh->print(@_);
}
sub read_patches {
my $repo = shift;
chdir($repo);
print "reading history for $repo\n";
my $xml = `darcs changes --xml`;
my @nodes = ();
my $twig = XML::Twig->new(
twig_roots => {
'changelog/patch' => sub {
my ($twig, $node) = @_;
push @nodes, $node->simplify(keyattr => []);
$twig->purge; # clear node from memory
},
},
);
unless ($twig->safe_parse($xml)) {
warn $@ . "\n";
}
print "found " . scalar(@nodes) . " patches\n";
return @nodes if wantarray;
return \@nodes;
}
sub patches_to_push {
my $local = shift;
my $remote = shift;
my $all_patches = shift;
my @queued_patches;
print "finding patches in $local which are not yet in $remote\n";
chdir($local);
my $fh = IO::File->new("darcs push --dry-run $remote |") || return;
while (my $line = $fh->getline) {
if ($line =~ /^\s*\*\s+(.+)$/) {
my $name = $1;
push @queued_patches, find_patch($name, $all_patches);
}
}
return @queued_patches;
}
sub find_patch {
my $name = shift;
my $all_patches = shift;
foreach my $patch (@$all_patches) {
if ($name eq $patch->{name}) {
print "found $name\n";
return $patch;
}
}
}
sub determine_diff {
my $repo = shift;
my $hash = shift;
print "determining diff for $hash\n";
chdir $repo;
my $diff = `darcs diff -u --match 'hash $hash'`;
}
sub determine_files {
my $repo = shift;
my $hash = shift;
print "determining files contained in $hash\n";
chdir $repo;
my $xml = `darcs annotate -s --xml --match 'hash $hash'`;
$xml = '<xml>' . $xml . '</xml>'; # current output is not well formed
#print $xml . "\n";
my @nodes = ();
my $twig = XML::Twig->new(
twig_roots => {
'summary/add_file' => sub {
my ($twig, $node) = @_;
my $data = $node->simplify(keyattr => []);
push @nodes, { name => trim_whitespace($data), action => 'add_file' };
print " add file $nodes[-1]{name}\n";
$twig->purge; # clear node from memory
},
'summary/modify_file' => sub {
my ($twig, $node) = @_;
my $data = $node->simplify(keyattr => []);
$data->{name} = trim_whitespace(delete $data->{content});
$data->{action} = 'modify_file';
push @nodes, $data;
print " modify file $nodes[-1]{name}\n";
$twig->purge; # clear node from memory
},
'summary/remove_file' => sub {
my ($twig, $node) = @_;
my $data = $node->simplify(keyattr => []);
push @nodes, { name => trim_whitespace($data), action => 'remove_file' };
print " remove file $nodes[-1]{name}\n";
$twig->purge; # clear node from memory
},
'summary/add_directory' => sub {
my ($twig, $node) = @_;
my $data = $node->simplify(keyattr => []);
push @nodes, { name => trim_whitespace($data), action => 'add_directory' };
print " add directory $nodes[-1]{name}\n";
$twig->purge; # clear node from memory
},
'summary/remove_directory' => sub {
my ($twig, $node) = @_;
my $data = $node->simplify(keyattr => []);
push @nodes, { name => trim_whitespace($data), action => 'remove_directory' };
print " remove directory $nodes[-1]{name}\n";
$twig->purge; # clear node from memory
},
},
);
unless ($twig->safe_parse($xml)) {
warn $@ . "\n";
}
return @nodes if wantarray;
return \@nodes;
}
sub trim_whitespace {
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
sub apply_diff {
my $repo = shift;
my $patch = shift;
print "applying diff for $patch->{hash} to repo $repo\n";
write_file("/tmp/$patch->{hash}", $patch->{diff});
chdir $repo;
system("patch -p 1 < /tmp/$patch->{hash}");
unlink("/tmp/$patch->{hash}");
}
sub write_file {
my $file = shift;
my $fh = IO::File->new($file, '>') || return;
$fh->print(@_);
}
sub record_changeset {
my $repo = shift;
my $patch = shift;
print "recording $patch->{date} $patch->{author}: $patch->{name}\n";
chdir $repo;
my $fh = IO::File->new('|darcs record --look-for-adds --all --pipe') or return;
$fh->print($patch->{date} . "\n");
$fh->print($patch->{author} . "\n");
$fh->print($patch->{name} . "\n");
$fh->print($patch->{comment} . "\n") if $patch->{comment};
$fh->close;
}
=head1 AUTHOR
Nathan Gray E<lt>kolibrie at cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2007 by Nathan Gray
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
=cut
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
Url : http://lists.osuosl.org/pipermail/darcs-users/attachments/20070813/86431613/attachment.pgp
More information about the darcs-users
mailing list