git-archimport.perlon commit remove shellquote usage for tags (a7fb51d)
   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 - 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
  31Add print in front of the shell commands invoked via backticks. 
  32
  33=cut
  34
  35use strict;
  36use warnings;
  37use Getopt::Std;
  38use File::Spec;
  39use File::Temp qw(tempfile tempdir);
  40use File::Path qw(mkpath);
  41use File::Basename qw(basename dirname);
  42use String::ShellQuote;
  43use Time::Local;
  44use IO::Socket;
  45use IO::Pipe;
  46use POSIX qw(strftime dup2);
  47use Data::Dumper qw/ Dumper /;
  48use IPC::Open2;
  49
  50$SIG{'PIPE'}="IGNORE";
  51$ENV{'TZ'}="UTC";
  52
  53my $git_dir = $ENV{"GIT_DIR"} || ".git";
  54$ENV{"GIT_DIR"} = $git_dir;
  55my $ptag_dir = "$git_dir/archimport/tags";
  56
  57our($opt_h,$opt_v, $opt_T,
  58    $opt_C,$opt_t);
  59
  60sub usage() {
  61    print STDERR <<END;
  62Usage: ${\basename $0}     # fetch/update GIT from Arch
  63       [ -h ] [ -v ] [ -T ] [ -t tempdir ] 
  64       repository/arch-branch [ repository/arch-branch] ...
  65END
  66    exit(1);
  67}
  68
  69getopts("Thvt:") or usage();
  70usage if $opt_h;
  71
  72@ARGV >= 1 or usage();
  73my @arch_roots = @ARGV;
  74
  75my ($tmpdir, $tmpdirname) = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
  76my $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
  80my @psets  = ();                # the collection
  81my %psets  = ();                # the collection, by name
  82
  83my %rptags = ();                # my reverse private tags
  84                                # to map a SHA1 to a commitid
  85
  86foreach 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
 184my $import = 0;
 185unless (-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
 218foreach 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
 431sub branchname {
 432    my $id = shift;
 433    $id =~ s#^.+?/##;
 434    my @parts = split(m/--/, $id);
 435    return join('--', @parts[0..1]);
 436}
 437
 438sub 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
 456sub 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
 522sub 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
 586sub 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
 614sub 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
 652sub 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        die "Cannot find merge base for $branch and $ps->{branch}" if $?;
 696        chomp $mergebase;
 697
 698        # now walk up to the mergepoint collecting what patches we have
 699        my $branchtip = git_rev_parse($ps->{branch});
 700        my @ancestors = `git-rev-list --merge-order $branchtip ^$mergebase`;
 701        my %have; # collected merges this branch has
 702        foreach my $merge (@{$ps->{merges}}) {
 703            $have{$merge} = 1;
 704        }
 705        my %ancestorshave;
 706        foreach my $par (@ancestors) {
 707            $par = commitid2pset($par);
 708            if (defined $par->{merges}) {
 709                foreach my $merge (@{$par->{merges}}) {
 710                    $ancestorshave{$merge}=1;
 711                }
 712            }
 713        }
 714        # print "++++ Merges in $ps->{id} are....\n";
 715        # my @have = sort keys %have;   print Dumper(\@have);
 716
 717        # merge what we have with what ancestors have
 718        %have = (%have, %ancestorshave);
 719
 720        # see what the remote branch has - these are the merges we 
 721        # will want to have in a consecutive series from the mergebase
 722        my $otherbranchtip = git_rev_parse($branch);
 723        my @needraw = `git-rev-list --merge-order $otherbranchtip ^$mergebase`;
 724        my @need;
 725        foreach my $needps (@needraw) {         # get the psets
 726            $needps = commitid2pset($needps);
 727            # git-rev-list will also
 728            # list commits merged in via earlier 
 729            # merges. we are only interested in commits
 730            # from the branch we're looking at
 731            if ($branch eq $needps->{branch}) {
 732                push @need, $needps->{id};
 733            }
 734        }
 735
 736        # print "++++ Merges from $branch we want are....\n";
 737        # print Dumper(\@need);
 738
 739        my $newparent;
 740        while (my $needed_commit = pop @need) {
 741            if ($have{$needed_commit}) {
 742                $newparent = $needed_commit;
 743            } else {
 744                last; # break out of the while
 745            }
 746        }
 747        if ($newparent) {
 748            push @parents, $newparent;
 749        }
 750
 751
 752    } # end foreach branch
 753
 754    # prune redundant parents
 755    my %parents;
 756    foreach my $p (@parents) {
 757        $parents{$p} = 1;
 758    }
 759    foreach my $p (@parents) {
 760        next unless exists $psets{$p}{merges};
 761        next unless ref    $psets{$p}{merges};
 762        my @merges = @{$psets{$p}{merges}};
 763        foreach my $merge (@merges) {
 764            if ($parents{$merge}) { 
 765                delete $parents{$merge};
 766            }
 767        }
 768    }
 769    @parents = keys %parents;
 770    @parents = map { " -p " . ptag($_) } @parents;
 771    return @parents;
 772}
 773
 774sub git_rev_parse {
 775    my $name = shift;
 776    my $val  = `git-rev-parse $name`;
 777    die "Error: git-rev-parse $name" if $?;
 778    chomp $val;
 779    return $val;
 780}
 781
 782# resolve a SHA1 to a known patchset
 783sub commitid2pset {
 784    my $commitid = shift;
 785    chomp $commitid;
 786    my $name = $rptags{$commitid} 
 787        || die "Cannot find reverse tag mapping for $commitid";
 788    $name =~ s|,|/|;
 789    my $ps   = $psets{$name} 
 790        || (print Dumper(sort keys %psets)) && die "Cannot find patchset for $name";
 791    return $ps;
 792}