Andrew's git / gitweb.git / git-archimport.perl
?
git-archimport.perlon commit [PATCH] archimport - update in-script doco, options tidyup (241b596)
   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
  14Imports a project from one or more Arch repositories. It will follow branches
  15and repositories within the namespaces defined by the <archive/branch>
  16parameters suppplied. If it cannot find the remote branch a merge comes from
  17it will just import it as a regular commit. If it can find it, it will mark it 
  18as a merge whenever possible.
  19
  20See 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
  33Add print in front of the shell commands invoked via backticks. 
  34
  35=cut
  36
  37use strict;
  38use warnings;
  39use Getopt::Std;
  40use File::Spec;
  41use File::Temp qw(tempfile);
  42use File::Path qw(mkpath);
  43use File::Basename qw(basename dirname);
  44use String::ShellQuote;
  45use Time::Local;
  46use IO::Socket;
  47use IO::Pipe;
  48use POSIX qw(strftime dup2);
  49use Data::Dumper qw/ Dumper /;
  50use IPC::Open2;
  51
  52$SIG{'PIPE'}="IGNORE";
  53$ENV{'TZ'}="UTC";
  54
  55our($opt_h,$opt_v, $opt_T,
  56    $opt_C,$opt_t);
  57
  58sub usage() {
  59    print STDERR <<END;
  60Usage: ${\basename $0}     # fetch/update GIT from Arch
  61       [ -h ] [ -v ] [ -T ] [ -t tempdir ] 
  62       repository/arch-branch [ repository/arch-branch] ...
  63END
  64    exit(1);
  65}
  66
  67getopts("Thvt:") or usage();
  68usage if $opt_h;
  69
  70@ARGV >= 1 or usage();
  71my @arch_roots = @ARGV;
  72
  73my $tmp = $opt_t;
  74$tmp ||= '/tmp';
  75$tmp .= '/git-archimport/';
  76
  77my @psets  = ();                # the collection
  78my %psets  = ();                # the collection, by name
  79
  80my %rptags = ();                # my reverse private tags
  81                                # to map a SHA1 to a commitid
  82
  83foreach 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
 181my $import = 0;
 182unless (-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
 212foreach 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
 424sub branchname {
 425    my $id = shift;
 426    $id =~ s#^.+?/##;
 427    my @parts = split(m/--/, $id);
 428    return join('--', @parts[0..1]);
 429}
 430
 431sub 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
 449sub 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
 515sub 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
 574sub 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
 601sub 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
 638sub 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
 756sub 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
 765sub 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}