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 }