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 my $ptag_dir = "$git_dir/archimport/tags";
  56
  57 our($opt_h,$opt_v, $opt_T,
  58     $opt_C,$opt_t);
  59
  60 sub usage() {
  61     print STDERR <<END;
  62 Usage: ${\basename $0}     # fetch/update GIT from Arch
  63        [ -h ] [ -v ] [ -T ] [ -t tempdir ]
  64        repository/arch-branch [ repository/arch-branch] ...
  65 END
  66     exit(1);
  67 }
  68
  69 getopts("Thvt:") or usage();
  70 usage if $opt_h;
  71
  72 @ARGV >= 1 or usage();
  73 my @arch_roots = @ARGV;
  74
  75 my ($tmpdir, $tmpdirname) = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
  76 my $tmp = $opt_t || 1;
  77 $tmp = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
  78 $opt_v && print "+ Using $tmp as temporary directory\n";
  79
  80 my @psets  = ();                # the collection
  81 my %psets  = ();                # the collection, by name
  82
  83 my %rptags = ();                # my reverse private tags
  84                                 # to map a SHA1 to a commitid
  85
  86 foreach 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);
 105                 $psets{$temp{id}} = \%temp;
 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
 168         push (@psets, \%temp);
 169         $psets{ $temp{id} } = \%temp;
 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
 184 my $import = 0;
 185 unless (-d $git_dir) { # initial import
 186     if ($psets[0]{type} eq 'i' || $psets[0]{type} eq 't') {
 187         print "Starting import from $psets[0]{id}\n";
 188         `git-init-db`;
 189         die $! if $?;
 190         $import = 1;
 191     } else {
 192         die "Need to start from an import or a tag -- cannot use $psets[0]{id}";
 193     }
 194 } else {    # progressing an import
 195     # load the rptags
 196     opendir(DIR, "$git_dir/archimport/tags")
 197         || die "can't opendir: $!";
 198     while (my $file = readdir(DIR)) {
 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         }
 210         my $sha = ptag($file);
 211         chomp $sha;
 212         $rptags{$sha} = $file;
 213     }
 214     closedir DIR;
 215 }
 216
 217 # process patchsets
 218 foreach 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
 231     #
 232     # skip commits already in repo
 233     #
 234     if (ptag($ps->{id})) {
 235       $opt_v && print " * Skipping already imported: $ps->{id}\n";
 236       next;
 237     }
 238
 239     print " * Starting to work on $ps->{id}\n";
 240
 241     #
 242     # create the branch if needed
 243     #
 244     if ($ps->{type} eq 'i' && !$import) {
 245         die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";
 246     }
 247
 248     unless ($import) { # skip for import
 249         if ( -e "$git_dir/refs/heads/$ps->{branch}") {
 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`;
 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;
 269         }
 270         die $! if $?;
 271     }
 272
 273     #
 274     # Apply the import/changeset/merge into the working tree
 275     #
 276     if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
 277         apply_import($ps) or die $!;
 278         $import=0;
 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') {
 302         `find . -type f -print0 | grep -zv '^./$git_dir' | xargs -0 -l100 git-update-index --add`;
 303         `git-ls-files --deleted -z | xargs --no-run-if-empty -0 -l100 git-update-index --remove`;
 304     }
 305
 306     if (@$add) {
 307         while (@$add) {
 308             my @slice = splice(@$add, 0, 100);
 309             my $slice = join(' ', @slice);
 310             `git-update-index --add $slice`;
 311             die "Error in git-update-index --add: $!" if $?;
 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);
 321             `git-update-index --remove $slice`;
 322             die "Error in git-update-index --remove: $!" if $?;
 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 $?;
 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 $?;
 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);
 351             `git-update-index $slice`;
 352             die "Error in git-update-index: $!" if $?;
 353         }
 354     }
 355
 356     # warn "errors when running git-update-index! $!";
 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;
 366     if ( -e "$git_dir/refs/heads/$ps->{branch}") {
 367         if (open HEAD, "<$git_dir/refs/heads/$ps->{branch}") {
 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
 379     if ($ps->{merges}) {
 380         push @par, find_parents($ps);
 381     }
 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     #
 414     open  HEAD, ">$git_dir/refs/heads/$ps->{branch}";
 415     print HEAD $commitid;
 416     close HEAD;
 417     system('git-update-ref', 'HEAD', "$ps->{branch}");
 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";
 427     $opt_v && print "   + commit date is  $ps->{date} \n";
 428     $opt_v && print "   + parents:  $par \n";
 429 }
 430
 431 sub branchname {
 432     my $id = shift;
 433     $id =~ s#^.+?/##;
 434     my @parts = split(m/--/, $id);
 435     return join('--', @parts[0..1]);
 436 }
 437
 438 sub 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 $?;
 446     `rsync -v --archive --delete --exclude '$git_dir' --exclude '.arch-ids' --exclude '{arch}' $tmp/import/* ./`;
 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
 456 sub 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
 492     `rsync --archive --exclude '$git_dir' --exclude '.arch-ids' --exclude '{arch}' $tmp/changeset/new-files-archive/* ./`;
 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
 522 sub 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$!;
 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            }
 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
 586 sub tag {
 587     my ($tag, $commit) = @_;
 588
 589     # don't use subdirs for tags yet, it could screw up other porcelains
 590     $tag =~ s|/|,|;
 591
 592     if ($commit) {
 593         open(C,">","$git_dir/refs/tags/$tag")
 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";
 599         print " * Created tag '$tag' on '$commit'\n" if $opt_v;
 600     } else {                    # read
 601         open(C,"<","$git_dir/refs/tags/$tag")
 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
 614 sub ptag {
 615     my ($tag, $commit) = @_;
 616
 617     # don't use subdirs for tags yet, it could screw up other porcelains
 618     $tag =~ s|/|,|g;
 619
 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);
 623
 624     if ($commit) {              # write
 625         open(C,">",$tag_file)
 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";
 631         $rptags{$commit} = $tag
 632             unless $tag =~ m/--base-0$/;
 633     } else {                    # read
 634         # if the tag isn't there, return 0
 635         unless ( -s $tag_file) {
 636             return 0;
 637         }
 638         open(C,"<",$tag_file)
 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";
 645         unless (defined $rptags{$commit}) {
 646             $rptags{$commit} = $tag;
 647         }
 648         return $commit;
 649     }
 650 }
 651
 652 sub 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) {
 690
 691         # check that we actually know about the branch
 692         next unless -e "$git_dir/refs/heads/$branch";
 693
 694         my $mergebase = `git-merge-base $branch $ps->{branch}`;
 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         }
 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
 780 sub 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
 789 sub commitid2pset {
 790     my $commitid = shift;
 791     chomp $commitid;
 792     my $name = $rptags{$commitid}
 793         || die "Cannot find reverse tag mapping for $commitid";
 794     $name =~ s|,|/|;
 795     my $ps   = $psets{$name}
 796         || (print Dumper(sort keys %psets)) && die "Cannot find patchset for $name";
 797     return $ps;
 798 }