]> git.ipfire.org Git - thirdparty/git.git/blame - git-archimport.perl
archimport: don't die on merge-base failure
[thirdparty/git.git] / git-archimport.perl
CommitLineData
d3968363
ML
1#!/usr/bin/perl -w
2#
3# This tool is copyright (c) 2005, Martin Langhoff.
4# It is released under the Gnu Public License, version 2.
5#
6# The basic idea is to walk the output of tla abrowse,
7# fetch the changesets and apply them.
8#
241b5967 9
d3968363
ML
10=head1 Invocation
11
241b5967 12 git-archimport [ -h ] [ -v ] [ -T ] [ -t tempdir ] <archive>/<branch> [ <archive>/<branch> ]
d3968363 13
241b5967
ML
14Imports a project from one or more Arch repositories. It will follow branches
15and repositories within the namespaces defined by the <archive/branch>
16parameters suppplied. If it cannot find the remote branch a merge comes from
17it will just import it as a regular commit. If it can find it, it will mark it
18as a merge whenever possible.
d3968363 19
241b5967 20See man (1) git-archimport for more details.
d3968363 21
241b5967 22=head1 TODO
d3968363 23
241b5967 24 - create tag objects instead of ref tags
d3968363 25 - audit shell-escaping of filenames
241b5967
ML
26 - hide our private tags somewhere smarter
27 - find a way to make "cat *patches | patch" safe even when patchfiles are missing newlines
d3968363
ML
28
29=head1 Devel tricks
30
31Add print in front of the shell commands invoked via backticks.
32
33=cut
34
35use strict;
36use warnings;
37use Getopt::Std;
38use File::Spec;
127bf00f 39use File::Temp qw(tempfile tempdir);
d3968363
ML
40use File::Path qw(mkpath);
41use File::Basename qw(basename dirname);
42use String::ShellQuote;
43use Time::Local;
44use IO::Socket;
45use IO::Pipe;
46use POSIX qw(strftime dup2);
47use Data::Dumper qw/ Dumper /;
48use IPC::Open2;
49
50$SIG{'PIPE'}="IGNORE";
51$ENV{'TZ'}="UTC";
52
1d4710d0
ML
53my $git_dir = $ENV{"GIT_DIR"} || ".git";
54$ENV{"GIT_DIR"} = $git_dir;
a7fb51d3 55my $ptag_dir = "$git_dir/archimport/tags";
1d4710d0 56
d3968363 57our($opt_h,$opt_v, $opt_T,
3292ae47 58 $opt_C,$opt_t);
d3968363
ML
59
60sub usage() {
61 print STDERR <<END;
62Usage: ${\basename $0} # fetch/update GIT from Arch
241b5967 63 [ -h ] [ -v ] [ -T ] [ -t tempdir ]
d3968363
ML
64 repository/arch-branch [ repository/arch-branch] ...
65END
66 exit(1);
67}
68
241b5967 69getopts("Thvt:") or usage();
d3968363
ML
70usage if $opt_h;
71
72@ARGV >= 1 or usage();
73my @arch_roots = @ARGV;
74
127bf00f
ML
75my ($tmpdir, $tmpdirname) = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
76my $tmp = $opt_t || 1;
77$tmp = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
78$opt_v && print "+ Using $tmp as temporary directory\n";
d3968363 79
d3968363 80my @psets = (); # the collection
b779d5f0
ML
81my %psets = (); # the collection, by name
82
83my %rptags = (); # my reverse private tags
84 # to map a SHA1 to a commitid
d3968363
ML
85
86foreach my $root (@arch_roots) {
87 my ($arepo, $abranch) = split(m!/!, $root);
88 open ABROWSE, "tla abrowse -f -A $arepo --desc --merges $abranch |"
89 or die "Problems with tla abrowse: $!";
90
91 my %ps = (); # the current one
92 my $mode = '';
93 my $lastseen = '';
94
95 while (<ABROWSE>) {
96 chomp;
97
98 # first record padded w 8 spaces
99 if (s/^\s{8}\b//) {
100
101 # store the record we just captured
102 if (%ps) {
103 my %temp = %ps; # break references
104 push (@psets, \%temp);
b779d5f0 105 $psets{$temp{id}} = \%temp;
d3968363
ML
106 %ps = ();
107 }
108
109 my ($id, $type) = split(m/\s{3}/, $_);
110 $ps{id} = $id;
111 $ps{repo} = $arepo;
112
113 # deal with types
114 if ($type =~ m/^\(simple changeset\)/) {
115 $ps{type} = 's';
116 } elsif ($type eq '(initial import)') {
117 $ps{type} = 'i';
118 } elsif ($type =~ m/^\(tag revision of (.+)\)/) {
119 $ps{type} = 't';
120 $ps{tag} = $1;
121 } else {
122 warn "Unknown type $type";
123 }
124 $lastseen = 'id';
125 }
126
127 if (s/^\s{10}//) {
128 # 10 leading spaces or more
129 # indicate commit metadata
130
131 # date & author
132 if ($lastseen eq 'id' && m/^\d{4}-\d{2}-\d{2}/) {
133
134 my ($date, $authoremail) = split(m/\s{2,}/, $_);
135 $ps{date} = $date;
136 $ps{date} =~ s/\bGMT$//; # strip off trailign GMT
137 if ($ps{date} =~ m/\b\w+$/) {
138 warn 'Arch dates not in GMT?! - imported dates will be wrong';
139 }
140
141 $authoremail =~ m/^(.+)\s(\S+)$/;
142 $ps{author} = $1;
143 $ps{email} = $2;
144
145 $lastseen = 'date';
146
147 } elsif ($lastseen eq 'date') {
148 # the only hint is position
149 # subject is after date
150 $ps{subj} = $_;
151 $lastseen = 'subj';
152
153 } elsif ($lastseen eq 'subj' && $_ eq 'merges in:') {
154 $ps{merges} = [];
155 $lastseen = 'merges';
156
157 } elsif ($lastseen eq 'merges' && s/^\s{2}//) {
158 push (@{$ps{merges}}, $_);
159 } else {
160 warn 'more metadata after merges!?';
161 }
162
163 }
164 }
165
166 if (%ps) {
167 my %temp = %ps; # break references
b779d5f0
ML
168 push (@psets, \%temp);
169 $psets{ $temp{id} } = \%temp;
d3968363
ML
170 %ps = ();
171 }
172 close ABROWSE;
173} # end foreach $root
174
175## Order patches by time
176@psets = sort {$a->{date}.$b->{id} cmp $b->{date}.$b->{id}} @psets;
177
178#print Dumper \@psets;
179
180##
181## TODO cleanup irrelevant patches
182## and put an initial import
183## or a full tag
3292ae47 184my $import = 0;
1d4710d0 185unless (-d $git_dir) { # initial import
d3968363
ML
186 if ($psets[0]{type} eq 'i' || $psets[0]{type} eq 't') {
187 print "Starting import from $psets[0]{id}\n";
3292ae47
ML
188 `git-init-db`;
189 die $! if $?;
190 $import = 1;
d3968363
ML
191 } else {
192 die "Need to start from an import or a tag -- cannot use $psets[0]{id}";
193 }
b779d5f0
ML
194} else { # progressing an import
195 # load the rptags
1d4710d0 196 opendir(DIR, "$git_dir/archimport/tags")
b779d5f0
ML
197 || die "can't opendir: $!";
198 while (my $file = readdir(DIR)) {
a7fb51d3
EW
199 # skip non-interesting-files
200 next unless -f "$ptag_dir/$file";
201
202 # convert first '--' to '/' from old git-archimport to use
203 # as an archivename/c--b--v private tag
204 if ($file !~ m!,!) {
205 my $oldfile = $file;
206 $file =~ s!--!,!;
207 print STDERR "converting old tag $oldfile to $file\n";
208 rename("$ptag_dir/$oldfile", "$ptag_dir/$file") or die $!;
209 }
b779d5f0
ML
210 my $sha = ptag($file);
211 chomp $sha;
b779d5f0
ML
212 $rptags{$sha} = $file;
213 }
214 closedir DIR;
d3968363
ML
215}
216
3292ae47 217# process patchsets
d3968363
ML
218foreach my $ps (@psets) {
219
220 $ps->{branch} = branchname($ps->{id});
221
222 #
223 # ensure we have a clean state
224 #
225 if (`git diff-files`) {
226 die "Unclean tree when about to process $ps->{id} " .
227 " - did we fail to commit cleanly before?";
228 }
229 die $! if $?;
230
3292ae47
ML
231 #
232 # skip commits already in repo
233 #
234 if (ptag($ps->{id})) {
37f15d50 235 $opt_v && print " * Skipping already imported: $ps->{id}\n";
3292ae47
ML
236 next;
237 }
238
37f15d50
ML
239 print " * Starting to work on $ps->{id}\n";
240
d3968363
ML
241 #
242 # create the branch if needed
243 #
3292ae47
ML
244 if ($ps->{type} eq 'i' && !$import) {
245 die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";
d3968363
ML
246 }
247
3292ae47 248 unless ($import) { # skip for import
1d4710d0 249 if ( -e "$git_dir/refs/heads/$ps->{branch}") {
d3968363
ML
250 # we know about this branch
251 `git checkout $ps->{branch}`;
252 } else {
253 # new branch! we need to verify a few things
254 die "Branch on a non-tag!" unless $ps->{type} eq 't';
255 my $branchpoint = ptag($ps->{tag});
256 die "Tagging from unknown id unsupported: $ps->{tag}"
257 unless $branchpoint;
258
259 # find where we are supposed to branch from
260 `git checkout -b $ps->{branch} $branchpoint`;
52586ecb
ML
261
262 # If we trust Arch with the fact that this is just
263 # a tag, and it does not affect the state of the tree
264 # then we just tag and move on
265 tag($ps->{id}, $branchpoint);
266 ptag($ps->{id}, $branchpoint);
267 print " * Tagged $ps->{id} at $branchpoint\n";
268 next;
d3968363
ML
269 }
270 die $! if $?;
271 }
272
d3968363
ML
273 #
274 # Apply the import/changeset/merge into the working tree
275 #
276 if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
d3968363 277 apply_import($ps) or die $!;
3292ae47 278 $import=0;
d3968363
ML
279 } elsif ($ps->{type} eq 's') {
280 apply_cset($ps);
281 }
282
283 #
284 # prepare update git's index, based on what arch knows
285 # about the pset, resolve parents, etc
286 #
287 my $tree;
288
289 my $commitlog = `tla cat-archive-log -A $ps->{repo} $ps->{id}`;
290 die "Error in cat-archive-log: $!" if $?;
291
292 # parselog will git-add/rm files
293 # and generally prepare things for the commit
294 # NOTE: parselog will shell-quote filenames!
295 my ($sum, $msg, $add, $del, $mod, $ren) = parselog($commitlog);
296 my $logmessage = "$sum\n$msg";
297
298
299 # imports don't give us good info
300 # on added files. Shame on them
301 if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
1d4710d0 302 `find . -type f -print0 | grep -zv '^./$git_dir' | xargs -0 -l100 git-update-index --add`;
215a7ad1 303 `git-ls-files --deleted -z | xargs --no-run-if-empty -0 -l100 git-update-index --remove`;
d3968363
ML
304 }
305
306 if (@$add) {
307 while (@$add) {
308 my @slice = splice(@$add, 0, 100);
309 my $slice = join(' ', @slice);
215a7ad1
JH
310 `git-update-index --add $slice`;
311 die "Error in git-update-index --add: $!" if $?;
d3968363
ML
312 }
313 }
314 if (@$del) {
315 foreach my $file (@$del) {
316 unlink $file or die "Problems deleting $file : $!";
317 }
318 while (@$del) {
319 my @slice = splice(@$del, 0, 100);
320 my $slice = join(' ', @slice);
215a7ad1
JH
321 `git-update-index --remove $slice`;
322 die "Error in git-update-index --remove: $!" if $?;
d3968363
ML
323 }
324 }
325 if (@$ren) { # renamed
326 if (@$ren % 2) {
327 die "Odd number of entries in rename!?";
328 }
329 ;
330 while (@$ren) {
331 my $from = pop @$ren;
332 my $to = pop @$ren;
333
334 unless (-d dirname($to)) {
335 mkpath(dirname($to)); # will die on err
336 }
337 #print "moving $from $to";
338 `mv $from $to`;
339 die "Error renaming $from $to : $!" if $?;
215a7ad1
JH
340 `git-update-index --remove $from`;
341 die "Error in git-update-index --remove: $!" if $?;
342 `git-update-index --add $to`;
343 die "Error in git-update-index --add: $!" if $?;
d3968363
ML
344 }
345
346 }
347 if (@$mod) { # must be _after_ renames
348 while (@$mod) {
349 my @slice = splice(@$mod, 0, 100);
350 my $slice = join(' ', @slice);
215a7ad1
JH
351 `git-update-index $slice`;
352 die "Error in git-update-index: $!" if $?;
d3968363
ML
353 }
354 }
355
215a7ad1 356 # warn "errors when running git-update-index! $!";
d3968363
ML
357 $tree = `git-write-tree`;
358 die "cannot write tree $!" if $?;
359 chomp $tree;
360
361
362 #
363 # Who's your daddy?
364 #
365 my @par;
1d4710d0
ML
366 if ( -e "$git_dir/refs/heads/$ps->{branch}") {
367 if (open HEAD, "<$git_dir/refs/heads/$ps->{branch}") {
d3968363
ML
368 my $p = <HEAD>;
369 close HEAD;
370 chomp $p;
371 push @par, '-p', $p;
372 } else {
373 if ($ps->{type} eq 's') {
374 warn "Could not find the right head for the branch $ps->{branch}";
375 }
376 }
377 }
378
b779d5f0
ML
379 if ($ps->{merges}) {
380 push @par, find_parents($ps);
381 }
d3968363
ML
382 my $par = join (' ', @par);
383
384 #
385 # Commit, tag and clean state
386 #
387 $ENV{TZ} = 'GMT';
388 $ENV{GIT_AUTHOR_NAME} = $ps->{author};
389 $ENV{GIT_AUTHOR_EMAIL} = $ps->{email};
390 $ENV{GIT_AUTHOR_DATE} = $ps->{date};
391 $ENV{GIT_COMMITTER_NAME} = $ps->{author};
392 $ENV{GIT_COMMITTER_EMAIL} = $ps->{email};
393 $ENV{GIT_COMMITTER_DATE} = $ps->{date};
394
395 my ($pid, $commit_rh, $commit_wh);
396 $commit_rh = 'commit_rh';
397 $commit_wh = 'commit_wh';
398
399 $pid = open2(*READER, *WRITER, "git-commit-tree $tree $par")
400 or die $!;
401 print WRITER $logmessage; # write
402 close WRITER;
403 my $commitid = <READER>; # read
404 chomp $commitid;
405 close READER;
406 waitpid $pid,0; # close;
407
408 if (length $commitid != 40) {
409 die "Something went wrong with the commit! $! $commitid";
410 }
411 #
412 # Update the branch
413 #
1d4710d0 414 open HEAD, ">$git_dir/refs/heads/$ps->{branch}";
d3968363
ML
415 print HEAD $commitid;
416 close HEAD;
8366a10a 417 system('git-update-ref', 'HEAD', "$ps->{branch}");
d3968363
ML
418
419 # tag accordingly
420 ptag($ps->{id}, $commitid); # private tag
421 if ($opt_T || $ps->{type} eq 't' || $ps->{type} eq 'i') {
422 tag($ps->{id}, $commitid);
423 }
424 print " * Committed $ps->{id}\n";
425 print " + tree $tree\n";
426 print " + commit $commitid\n";
b779d5f0
ML
427 $opt_v && print " + commit date is $ps->{date} \n";
428 $opt_v && print " + parents: $par \n";
d3968363
ML
429}
430
431sub branchname {
432 my $id = shift;
433 $id =~ s#^.+?/##;
434 my @parts = split(m/--/, $id);
435 return join('--', @parts[0..1]);
436}
437
438sub apply_import {
439 my $ps = shift;
440 my $bname = branchname($ps->{id});
441
442 `mkdir -p $tmp`;
443
444 `tla get -s --no-pristine -A $ps->{repo} $ps->{id} $tmp/import`;
445 die "Cannot get import: $!" if $?;
1d4710d0 446 `rsync -v --archive --delete --exclude '$git_dir' --exclude '.arch-ids' --exclude '{arch}' $tmp/import/* ./`;
d3968363
ML
447 die "Cannot rsync import:$!" if $?;
448
449 `rm -fr $tmp/import`;
450 die "Cannot remove tempdir: $!" if $?;
451
452
453 return 1;
454}
455
456sub apply_cset {
457 my $ps = shift;
458
459 `mkdir -p $tmp`;
460
461 # get the changeset
462 `tla get-changeset -A $ps->{repo} $ps->{id} $tmp/changeset`;
463 die "Cannot get changeset: $!" if $?;
464
465 # apply patches
466 if (`find $tmp/changeset/patches -type f -name '*.patch'`) {
467 # this can be sped up considerably by doing
468 # (find | xargs cat) | patch
469 # but that cna get mucked up by patches
470 # with missing trailing newlines or the standard
471 # 'missing newline' flag in the patch - possibly
472 # produced with an old/buggy diff.
473 # slow and safe, we invoke patch once per patchfile
474 `find $tmp/changeset/patches -type f -name '*.patch' -print0 | grep -zv '{arch}' | xargs -iFILE -0 --no-run-if-empty patch -p1 --forward -iFILE`;
475 die "Problem applying patches! $!" if $?;
476 }
477
478 # apply changed binary files
479 if (my @modified = `find $tmp/changeset/patches -type f -name '*.modified'`) {
480 foreach my $mod (@modified) {
481 chomp $mod;
482 my $orig = $mod;
483 $orig =~ s/\.modified$//; # lazy
484 $orig =~ s!^\Q$tmp\E/changeset/patches/!!;
485 #print "rsync -p '$mod' '$orig'";
486 `rsync -p $mod ./$orig`;
487 die "Problem applying binary changes! $!" if $?;
488 }
489 }
490
491 # bring in new files
1d4710d0 492 `rsync --archive --exclude '$git_dir' --exclude '.arch-ids' --exclude '{arch}' $tmp/changeset/new-files-archive/* ./`;
d3968363
ML
493
494 # deleted files are hinted from the commitlog processing
495
496 `rm -fr $tmp/changeset`;
497}
498
499
500# =for reference
501# A log entry looks like
502# Revision: moodle-org--moodle--1.3.3--patch-15
503# Archive: arch-eduforge@catalyst.net.nz--2004
504# Creator: Penny Leach <penny@catalyst.net.nz>
505# Date: Wed May 25 14:15:34 NZST 2005
506# Standard-date: 2005-05-25 02:15:34 GMT
507# New-files: lang/de/.arch-ids/block_glossary_random.php.id
508# lang/de/.arch-ids/block_html.php.id
509# New-directories: lang/de/help/questionnaire
510# lang/de/help/questionnaire/.arch-ids
511# Renamed-files: .arch-ids/db_sears.sql.id db/.arch-ids/db_sears.sql.id
512# db_sears.sql db/db_sears.sql
513# Removed-files: lang/be/docs/.arch-ids/release.html.id
514# lang/be/docs/.arch-ids/releaseold.html.id
515# Modified-files: admin/cron.php admin/delete.php
516# admin/editor.html backup/lib.php backup/restore.php
517# New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15
518# Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+)
519# Keywords:
520#
521# Updating yadda tadda tadda madda
522sub parselog {
523 my $log = shift;
524 #print $log;
525
526 my (@add, @del, @mod, @ren, @kw, $sum, $msg );
527
528 if ($log =~ m/(?:\n|^)New-files:(.*?)(?=\n\w)/s ) {
529 my $files = $1;
530 @add = split(m/\s+/s, $files);
531 }
532
533 if ($log =~ m/(?:\n|^)Removed-files:(.*?)(?=\n\w)/s ) {
534 my $files = $1;
535 @del = split(m/\s+/s, $files);
536 }
537
538 if ($log =~ m/(?:\n|^)Modified-files:(.*?)(?=\n\w)/s ) {
539 my $files = $1;
540 @mod = split(m/\s+/s, $files);
541 }
542
543 if ($log =~ m/(?:\n|^)Renamed-files:(.*?)(?=\n\w)/s ) {
544 my $files = $1;
545 @ren = split(m/\s+/s, $files);
546 }
547
548 $sum ='';
549 if ($log =~ m/^Summary:(.+?)$/m ) {
550 $sum = $1;
551 $sum =~ s/^\s+//;
552 $sum =~ s/\s+$//;
553 }
554
555 $msg = '';
556 if ($log =~ m/\n\n(.+)$/s) {
557 $msg = $1;
558 $msg =~ s/^\s+//;
559 $msg =~ s/\s+$//;
560 }
561
562
563 # cleanup the arrays
564 foreach my $ref ( (\@add, \@del, \@mod, \@ren) ) {
565 my @tmp = ();
566 while (my $t = pop @$ref) {
567 next unless length ($t);
568 next if $t =~ m!\{arch\}/!;
569 next if $t =~ m!\.arch-ids/!;
570 next if $t =~ m!\.arch-inventory$!;
f84f9d38
ML
571 # tla cat-archive-log will give us filenames with spaces as file\(sp)name - why?
572 # we can assume that any filename with \ indicates some pika escaping that we want to get rid of.
573 if ($t =~ /\\/ ){
574 $t = `tla escape --unescaped '$t'`;
575 }
d3968363
ML
576 push (@tmp, shell_quote($t));
577 }
578 @$ref = @tmp;
579 }
580
581 #print Dumper [$sum, $msg, \@add, \@del, \@mod, \@ren];
582 return ($sum, $msg, \@add, \@del, \@mod, \@ren);
583}
584
585# write/read a tag
586sub tag {
587 my ($tag, $commit) = @_;
a7fb51d3
EW
588
589 # don't use subdirs for tags yet, it could screw up other porcelains
590 $tag =~ s|/|,|;
d3968363
ML
591
592 if ($commit) {
a7fb51d3 593 open(C,">","$git_dir/refs/tags/$tag")
d3968363
ML
594 or die "Cannot create tag $tag: $!\n";
595 print C "$commit\n"
596 or die "Cannot write tag $tag: $!\n";
597 close(C)
598 or die "Cannot write tag $tag: $!\n";
a7fb51d3 599 print " * Created tag '$tag' on '$commit'\n" if $opt_v;
d3968363 600 } else { # read
a7fb51d3 601 open(C,"<","$git_dir/refs/tags/$tag")
d3968363
ML
602 or die "Cannot read tag $tag: $!\n";
603 $commit = <C>;
604 chomp $commit;
605 die "Error reading tag $tag: $!\n" unless length $commit == 40;
606 close(C)
607 or die "Cannot read tag $tag: $!\n";
608 return $commit;
609 }
610}
611
612# write/read a private tag
613# reads fail softly if the tag isn't there
614sub ptag {
615 my ($tag, $commit) = @_;
a7fb51d3
EW
616
617 # don't use subdirs for tags yet, it could screw up other porcelains
618 $tag =~ s|/|,|g;
d3968363 619
a7fb51d3
EW
620 my $tag_file = "$ptag_dir/$tag";
621 my $tag_branch_dir = dirname($tag_file);
622 mkpath($tag_branch_dir) unless (-d $tag_branch_dir);
d3968363
ML
623
624 if ($commit) { # write
a7fb51d3 625 open(C,">",$tag_file)
d3968363
ML
626 or die "Cannot create tag $tag: $!\n";
627 print C "$commit\n"
628 or die "Cannot write tag $tag: $!\n";
629 close(C)
630 or die "Cannot write tag $tag: $!\n";
b779d5f0
ML
631 $rptags{$commit} = $tag
632 unless $tag =~ m/--base-0$/;
d3968363
ML
633 } else { # read
634 # if the tag isn't there, return 0
a7fb51d3 635 unless ( -s $tag_file) {
d3968363
ML
636 return 0;
637 }
a7fb51d3 638 open(C,"<",$tag_file)
d3968363
ML
639 or die "Cannot read tag $tag: $!\n";
640 $commit = <C>;
641 chomp $commit;
642 die "Error reading tag $tag: $!\n" unless length $commit == 40;
643 close(C)
644 or die "Cannot read tag $tag: $!\n";
b779d5f0
ML
645 unless (defined $rptags{$commit}) {
646 $rptags{$commit} = $tag;
647 }
d3968363
ML
648 return $commit;
649 }
650}
b779d5f0
ML
651
652sub find_parents {
653 #
654 # Identify what branches are merging into me
655 # and whether we are fully merged
656 # git-merge-base <headsha> <headsha> should tell
657 # me what the base of the merge should be
658 #
659 my $ps = shift;
660
661 my %branches; # holds an arrayref per branch
662 # the arrayref contains a list of
663 # merged patches between the base
664 # of the merge and the current head
665
666 my @parents; # parents found for this commit
667
668 # simple loop to split the merges
669 # per branch
670 foreach my $merge (@{$ps->{merges}}) {
671 my $branch = branchname($merge);
672 unless (defined $branches{$branch} ){
673 $branches{$branch} = [];
674 }
675 push @{$branches{$branch}}, $merge;
676 }
677
678 #
679 # foreach branch find a merge base and walk it to the
680 # head where we are, collecting the merged patchsets that
681 # Arch has recorded. Keep that in @have
682 # Compare that with the commits on the other branch
683 # between merge-base and the tip of the branch (@need)
684 # and see if we have a series of consecutive patches
685 # starting from the merge base. The tip of the series
686 # of consecutive patches merged is our new parent for
687 # that branch.
688 #
689 foreach my $branch (keys %branches) {
37f15d50
ML
690
691 # check that we actually know about the branch
692 next unless -e "$git_dir/refs/heads/$branch";
693
b779d5f0 694 my $mergebase = `git-merge-base $branch $ps->{branch}`;
9b626e75
EW
695 if ($?) {
696 # Don't die here, Arch supports one-way cherry-picking
697 # between branches with no common base (or any relationship
698 # at all beforehand)
699 warn "Cannot find merge base for $branch and $ps->{branch}";
700 next;
701 }
b779d5f0
ML
702 chomp $mergebase;
703
704 # now walk up to the mergepoint collecting what patches we have
705 my $branchtip = git_rev_parse($ps->{branch});
706 my @ancestors = `git-rev-list --merge-order $branchtip ^$mergebase`;
707 my %have; # collected merges this branch has
708 foreach my $merge (@{$ps->{merges}}) {
709 $have{$merge} = 1;
710 }
711 my %ancestorshave;
712 foreach my $par (@ancestors) {
713 $par = commitid2pset($par);
714 if (defined $par->{merges}) {
715 foreach my $merge (@{$par->{merges}}) {
716 $ancestorshave{$merge}=1;
717 }
718 }
719 }
720 # print "++++ Merges in $ps->{id} are....\n";
721 # my @have = sort keys %have; print Dumper(\@have);
722
723 # merge what we have with what ancestors have
724 %have = (%have, %ancestorshave);
725
726 # see what the remote branch has - these are the merges we
727 # will want to have in a consecutive series from the mergebase
728 my $otherbranchtip = git_rev_parse($branch);
729 my @needraw = `git-rev-list --merge-order $otherbranchtip ^$mergebase`;
730 my @need;
731 foreach my $needps (@needraw) { # get the psets
732 $needps = commitid2pset($needps);
733 # git-rev-list will also
734 # list commits merged in via earlier
735 # merges. we are only interested in commits
736 # from the branch we're looking at
737 if ($branch eq $needps->{branch}) {
738 push @need, $needps->{id};
739 }
740 }
741
742 # print "++++ Merges from $branch we want are....\n";
743 # print Dumper(\@need);
744
745 my $newparent;
746 while (my $needed_commit = pop @need) {
747 if ($have{$needed_commit}) {
748 $newparent = $needed_commit;
749 } else {
750 last; # break out of the while
751 }
752 }
753 if ($newparent) {
754 push @parents, $newparent;
755 }
756
757
758 } # end foreach branch
759
760 # prune redundant parents
761 my %parents;
762 foreach my $p (@parents) {
763 $parents{$p} = 1;
764 }
765 foreach my $p (@parents) {
766 next unless exists $psets{$p}{merges};
767 next unless ref $psets{$p}{merges};
768 my @merges = @{$psets{$p}{merges}};
769 foreach my $merge (@merges) {
770 if ($parents{$merge}) {
771 delete $parents{$merge};
772 }
773 }
774 }
775 @parents = keys %parents;
776 @parents = map { " -p " . ptag($_) } @parents;
777 return @parents;
778}
779
780sub git_rev_parse {
781 my $name = shift;
782 my $val = `git-rev-parse $name`;
783 die "Error: git-rev-parse $name" if $?;
784 chomp $val;
785 return $val;
786}
787
788# resolve a SHA1 to a known patchset
789sub commitid2pset {
790 my $commitid = shift;
791 chomp $commitid;
792 my $name = $rptags{$commitid}
793 || die "Cannot find reverse tag mapping for $commitid";
a7fb51d3 794 $name =~ s|,|/|;
b779d5f0
ML
795 my $ps = $psets{$name}
796 || (print Dumper(sort keys %psets)) && die "Cannot find patchset for $name";
797 return $ps;
798}