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