Andrew's git / gitweb.git / git-archimport.perl
?
git-archimport.perlon commit Fix fd leak in http-fetch (54a9ba0)
   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;
  55
  56our($opt_h,$opt_v, $opt_T,
  57    $opt_C,$opt_t);
  58
  59sub usage() {
  60    print STDERR <<END;
  61Usage: ${\basename $0}     # fetch/update GIT from Arch
  62       [ -h ] [ -v ] [ -T ] [ -t tempdir ] 
  63       repository/arch-branch [ repository/arch-branch] ...
  64END
  65    exit(1);
  66}
  67
  68getopts("Thvt:") or usage();
  69usage if $opt_h;
  70
  71@ARGV >= 1 or usage();
  72my @arch_roots = @ARGV;
  73
  74my ($tmpdir, $tmpdirname) = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
  75my $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
  79my @psets  = ();                # the collection
  80my %psets  = ();                # the collection, by name
  81
  82my %rptags = ();                # my reverse private tags
  83                                # to map a SHA1 to a commitid
  84
  85foreach 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
 183my $import = 0;
 184unless (-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
 214foreach 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
 428sub branchname {
 429    my $id = shift;
 430    $id =~ s#^.+?/##;
 431    my @parts = split(m/--/, $id);
 432    return join('--', @parts[0..1]);
 433}
 434
 435sub 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
 453sub 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
 519sub 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
 583sub 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
 610sub 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
 647sub 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
 769sub 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
 778sub 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}