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