use strict;

use warnings;

use Getopt::Std;

use File::Temp qw(tempdir);

use File::Path qw(mkpath rmtree);

use File::Basename qw(basename dirname);

use Data::Dumper qw/ Dumper /;

use IPC::Open2;

$SIG{'PIPE'}="IGNORE";

$ENV{'TZ'}="UTC";

my $git_dir = $ENV{"GIT_DIR"} || ".git";

$ENV{"GIT_DIR"} = $git_dir;

my $ptag_dir = "$git_dir/archimport/tags";

our($opt_h,$opt_f,$opt_v,$opt_T,$opt_t,$opt_D,$opt_a,$opt_o);

sub usage() {

print STDERR <<END;

exit(1);

}

getopts("fThvat:D:") or usage();

usage if $opt_h;

@ARGV >= 1 or usage();

my %arch_branches = map { my $branch = $_; $branch =~ s/:[^:]*$//; $branch => 1 } @ARGV;

my %branch_name_map = map { m/^(.*):([^:]*)$/; $1 => $2 } grep { m/:/ } @ARGV;

$ENV{'TMPDIR'} = $opt_t if $opt_t; # $ENV{TMPDIR} will affect tempdir() calls:

my $tmp = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);

$opt_v && print "+ Using $tmp as temporary directory\n";

unless (-d $git_dir) { # initial import needs empty directory

opendir DIR, '.' or die "Unable to open current directory: $!\n";

while (my $entry = readdir DIR) {

$entry =~ /^\.\.?$/ or

die "Initial import needs an empty current working directory.\n"

}

closedir DIR

}

my $default_archive; # default Arch archive

my %reachable = (); # Arch repositories we can access

my %unreachable = (); # Arch repositories we can't access :<

my @psets = (); # the collection

my %psets = (); # the collection, by name

my %stats = ( # Track which strategy we used to import:

get_tag => 0, replay => 0, get_new => 0, get_delta => 0,

simple_changeset => 0, import_or_tag => 0

);

my %rptags = (); # my reverse private tags

# to map a SHA1 to a commitid

my $TLA = $ENV{'ARCH_CLIENT'} || 'tla';

sub do_abrowse {

my $stage = shift;

while (my ($limit, $level) = each %arch_branches) {

next unless $level == $stage;

open ABROWSE, "$TLA abrowse -fkD --merges $limit |"

or die "Problems with tla abrowse: $!";

my %ps = (); # the current one

my $lastseen = '';

while (<ABROWSE>) {

chomp;

# first record padded w 8 spaces

if (s/^\s{8}\b//) {

my ($id, $type) = split(m/\s+/, $_, 2);

my %last_ps;

# store the record we just captured

if (%ps && !exists $psets{ $ps{id} }) {

%last_ps = %ps; # break references

push (@psets, \%last_ps);

$psets{ $last_ps{id} } = \%last_ps;

}

my $branch = extract_versionname($id);

%ps = ( id => $id, branch => $branch );

if (%last_ps && ($last_ps{branch} eq $branch)) {

$ps{parent_id} = $last_ps{id};

}

$arch_branches{$branch} = 1;

$lastseen = 'id';

# deal with types (should work with baz or tla):

if ($type =~ m/\(.*changeset\)/) {

$ps{type} = 's';

} elsif ($type =~ /\(.*import\)/) {

$ps{type} = 'i';

} elsif ($type =~ m/\(tag.*?(\S+\@\S+).*?\)/) {

$ps{type} = 't';

# read which revision we've tagged when we parse the log

$ps{tag} = $1;

} else {

warn "Unknown type $type";

}

$arch_branches{$branch} = 1;

$lastseen = 'id';

} elsif (s/^\s{10}//) {

# 10 leading spaces or more

# indicate commit metadata

# date

if ($lastseen eq 'id' && m/^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d)/){

$ps{date} = $1;

$lastseen = 'date';

} elsif ($_ eq 'merges in:') {

$ps{merges} = [];

$lastseen = 'merges';

} elsif ($lastseen eq 'merges' && s/^\s{2}//) {

my $id = $_;

push (@{$ps{merges}}, $id);

# aggressive branch finding:

if ($opt_D) {

my $branch = extract_versionname($id);

my $repo = extract_reponame($branch);

if (archive_reachable($repo) &&

!defined $arch_branches{$branch}) {

$arch_branches{$branch} = $stage + 1;

}

}

} else {

warn "more metadata after merges!?: $_\n" unless /^\s*$/;

}

}

}

if (%ps && !exists $psets{ $ps{id} }) {

my %temp = %ps; # break references

if (@psets && $psets[$#psets]{branch} eq $ps{branch}) {

$temp{parent_id} = $psets[$#psets]{id};

}

push (@psets, \%temp);

$psets{ $temp{id} } = \%temp;

}

close ABROWSE or die "$TLA abrowse failed on $limit\n";

}

} # end foreach $root

do_abrowse(1);

my $depth = 2;

$opt_D ||= 0;

while ($depth <= $opt_D) {

do_abrowse($depth);

$depth++;

}

@psets = sort {$a->{date}.$b->{id} cmp $b->{date}.$b->{id}} @psets;

my $import = 0;

unless (-d $git_dir) { # initial import

if ($psets[0]{type} eq 'i' || $psets[0]{type} eq 't') {

print "Starting import from $psets[0]{id}\n";

`git-init`;

die $! if $?;

$import = 1;

} else {

die "Need to start from an import or a tag -- cannot use $psets[0]{id}";

}

} else { # progressing an import

# load the rptags

opendir(DIR, $ptag_dir)

|| die "can't opendir: $!";

while (my $file = readdir(DIR)) {

# skip non-interesting-files

next unless -f "$ptag_dir/$file";

# convert first '--' to '/' from old git-archimport to use

# as an archivename/c--b--v private tag

if ($file !~ m!,!) {

my $oldfile = $file;

$file =~ s!--!,!;

print STDERR "converting old tag $oldfile to $file\n";

rename("$ptag_dir/$oldfile", "$ptag_dir/$file") or die $!;

}

my $sha = ptag($file);

chomp $sha;

$rptags{$sha} = $file;

}

closedir DIR;

}

sub extract_reponame {

my $fq_cvbr = shift; # archivename/[[[[category]branch]version]revision]

return (split(/\//, $fq_cvbr))[0];

}

sub extract_versionname {

my $name = shift;

$name =~ s/--(?:patch|version(?:fix)?|base)-\d+$//;

return $name;

}

sub tree_dirname {

my $revision = shift;

my $name = extract_versionname($revision);

$name =~ s#/#,#;

return $name;

}

sub old_style_branchname {

my $id = shift;

my $ret = safe_pipe_capture($TLA,'parse-package-name','-p',$id);

chomp $ret;

return $ret;

}

*git_default_branchname = $opt_o ? *old_style_branchname : *tree_dirname;

sub get_default_archive {

if (!defined $default_archive) {

$default_archive = safe_pipe_capture($TLA,'my-default-archive');

chomp $default_archive;

}

return $default_archive;

}

sub git_branchname {

my $revision = shift;

my $name = extract_versionname($revision);

if (exists $branch_name_map{$name}) {

return $branch_name_map{$name};

} elsif ($name =~ m#^([^/]*)/(.*)$#

&& $1 eq get_default_archive()

&& exists $branch_name_map{$2}) {

# the names given in the command-line lacked the archive.

return $branch_name_map{$2};

} else {

return git_default_branchname($revision);

}

}

sub process_patchset_accurate {

my $ps = shift;

# switch to that branch if we're not already in that branch:

if (-e "$git_dir/refs/heads/$ps->{branch}") {

system('git-checkout','-f',$ps->{branch}) == 0 or die "$! $?\n";

# remove any old stuff that got leftover:

my $rm = safe_pipe_capture('git-ls-files','--others','-z');

rmtree(split(/\0/,$rm)) if $rm;

}

# Apply the import/changeset/merge into the working tree

my $dir = sync_to_ps($ps);

# read the new log entry:

my @commitlog = safe_pipe_capture($TLA,'cat-log','-d',$dir,$ps->{id});

die "Error in cat-log: $!" if $?;

chomp @commitlog;

# grab variables we want from the log, new fields get added to $ps:

# (author, date, email, summary, message body ...)

parselog($ps, \@commitlog);

if ($ps->{id} =~ /--base-0$/ && $ps->{id} ne $psets[0]{id}) {

# this should work when importing continuations

if ($ps->{tag} && (my $branchpoint = eval { ptag($ps->{tag}) })) {

# find where we are supposed to branch from

if (! -e "$git_dir/refs/heads/$ps->{branch}") {

system('git-branch',$ps->{branch},$branchpoint) == 0 or die "$! $?\n";

# We trust Arch with the fact that this is just a tag,

# and it does not affect the state of the tree, so

# we just tag and move on. If the user really wants us

# to consolidate more branches into one, don't tag because

# the tag name would be already taken.

tag($ps->{id}, $branchpoint);

ptag($ps->{id}, $branchpoint);

print " * Tagged $ps->{id} at $branchpoint\n";

}

system('git-checkout','-f',$ps->{branch}) == 0 or die "$! $?\n";

# remove any old stuff that got leftover:

my $rm = safe_pipe_capture('git-ls-files','--others','-z');

rmtree(split(/\0/,$rm)) if $rm;

return 0;

} else {

warn "Tagging from unknown id unsupported\n" if $ps->{tag};

}

# allow multiple bases/imports here since Arch supports cherry-picks

# from unrelated trees

}

# update the index with all the changes we got

system('git-diff-files --name-only -z | '.

'git-update-index --remove -z --stdin') == 0 or die "$! $?\n";

system('git-ls-files --others -z | '.

'git-update-index --add -z --stdin') == 0 or die "$! $?\n";

return 1;

}

sub process_patchset_fast {

my $ps = shift;

#

# create the branch if needed

#

if ($ps->{type} eq 'i' && !$import) {

die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";

}

unless ($import) { # skip for import

if ( -e "$git_dir/refs/heads/$ps->{branch}") {

# we know about this branch

system('git-checkout',$ps->{branch});

} else {

# new branch! we need to verify a few things

die "Branch on a non-tag!" unless $ps->{type} eq 't';

my $branchpoint = ptag($ps->{tag});

die "Tagging from unknown id unsupported: $ps->{tag}"

unless $branchpoint;

# find where we are supposed to branch from

if (! -e "$git_dir/refs/heads/$ps->{branch}") {

system('git-branch',$ps->{branch},$branchpoint) == 0 or die "$! $?\n";

# We trust Arch with the fact that this is just a tag,

# and it does not affect the state of the tree, so

# we just tag and move on. If the user really wants us

# to consolidate more branches into one, don't tag because

# the tag name would be already taken.

tag($ps->{id}, $branchpoint);

ptag($ps->{id}, $branchpoint);

print " * Tagged $ps->{id} at $branchpoint\n";

}

system('git-checkout',$ps->{branch}) == 0 or die "$! $?\n";

return 0;

}

die $! if $?;

}

#

# Apply the import/changeset/merge into the working tree

#

if ($ps->{type} eq 'i' || $ps->{type} eq 't') {

apply_import($ps) or die $!;

$stats{import_or_tag}++;

$import=0;

} elsif ($ps->{type} eq 's') {

apply_cset($ps);

$stats{simple_changeset}++;

}

#

# prepare update git's index, based on what arch knows

# about the pset, resolve parents, etc

#

my @commitlog = safe_pipe_capture($TLA,'cat-archive-log',$ps->{id});

die "Error in cat-archive-log: $!" if $?;

parselog($ps,\@commitlog);

# imports don't give us good info

# on added files. Shame on them

if ($ps->{type} eq 'i' || $ps->{type} eq 't') {

system('git-ls-files --deleted -z | '.

'git-update-index --remove -z --stdin') == 0 or die "$! $?\n";

system('git-ls-files --others -z | '.

'git-update-index --add -z --stdin') == 0 or die "$! $?\n";

}

# TODO: handle removed_directories and renamed_directories:

if (my $del = $ps->{removed_files}) {

unlink @$del;

while (@$del) {

my @slice = splice(@$del, 0, 100);

system('git-update-index','--remove','--',@slice) == 0 or

die "Error in git-update-index --remove: $! $?\n";

}

}

if (my $ren = $ps->{renamed_files}) { # renamed

if (@$ren % 2) {

die "Odd number of entries in rename!?";

}

while (@$ren) {

my $from = shift @$ren;

my $to = shift @$ren;

unless (-d dirname($to)) {

mkpath(dirname($to)); # will die on err

}

# print "moving $from $to";

rename($from, $to) or die "Error renaming '$from' '$to': $!\n";

system('git-update-index','--remove','--',$from) == 0 or

die "Error in git-update-index --remove: $! $?\n";

system('git-update-index','--add','--',$to) == 0 or

die "Error in git-update-index --add: $! $?\n";

}

}

if (my $add = $ps->{new_files}) {

while (@$add) {

my @slice = splice(@$add, 0, 100);

system('git-update-index','--add','--',@slice) == 0 or

die "Error in git-update-index --add: $! $?\n";

}

}

if (my $mod = $ps->{modified_files}) {

while (@$mod) {

my @slice = splice(@$mod, 0, 100);

system('git-update-index','--',@slice) == 0 or

die "Error in git-update-index: $! $?\n";

}

}

return 1; # we successfully applied the changeset

}

if ($opt_f) {

print "Will import patchsets using the fast strategy\n",

"Renamed directories and permission changes will be missed\n";

*process_patchset = *process_patchset_fast;

} else {

print "Using the default (accurate) import strategy.\n",

"Things may be a bit slow\n";

*process_patchset = *process_patchset_accurate;

}

foreach my $ps (@psets) {

# process patchsets

$ps->{branch} = git_branchname($ps->{id});

#

# ensure we have a clean state

#

if (my $dirty = `git-diff-files`) {

die "Unclean tree when about to process $ps->{id} " .

" - did we fail to commit cleanly before?\n$dirty";

}

die $! if $?;

#

# skip commits already in repo

#

if (ptag($ps->{id})) {

$opt_v && print " * Skipping already imported: $ps->{id}\n";

next;

}

print " * Starting to work on $ps->{id}\n";

process_patchset($ps) or next;

# warn "errors when running git-update-index! $!";

my $tree = `git-write-tree`;

die "cannot write tree $!" if $?;

chomp $tree;

#

# Who's your daddy?

#

my @par;

if ( -e "$git_dir/refs/heads/$ps->{branch}") {

if (open HEAD, "<","$git_dir/refs/heads/$ps->{branch}") {

my $p = <HEAD>;

close HEAD;

chomp $p;

push @par, '-p', $p;

} else {

if ($ps->{type} eq 's') {

warn "Could not find the right head for the branch $ps->{branch}";

}

}

}

if ($ps->{merges}) {

push @par, find_parents($ps);

}

#

# Commit, tag and clean state

#

$ENV{TZ} = 'GMT';

$ENV{GIT_AUTHOR_NAME} = $ps->{author};

$ENV{GIT_AUTHOR_EMAIL} = $ps->{email};

$ENV{GIT_AUTHOR_DATE} = $ps->{date};

$ENV{GIT_COMMITTER_NAME} = $ps->{author};

$ENV{GIT_COMMITTER_EMAIL} = $ps->{email};

$ENV{GIT_COMMITTER_DATE} = $ps->{date};

my $pid = open2(*READER, *WRITER,'git-commit-tree',$tree,@par)

or die $!;

print WRITER $ps->{summary},"\n\n";

# only print message if it's not empty, to avoid a spurious blank line;

# also append an extra newline, so there's a blank line before the

# following "git-archimport-id:" line.

print WRITER $ps->{message},"\n\n" if ($ps->{message} ne "");

# make it easy to backtrack and figure out which Arch revision this was:

print WRITER 'git-archimport-id: ',$ps->{id},"\n";

close WRITER;

my $commitid = <READER>; # read

chomp $commitid;

close READER;

waitpid $pid,0; # close;

if (length $commitid != 40) {

die "Something went wrong with the commit! $! $commitid";

}

#

# Update the branch

#

open HEAD, ">","$git_dir/refs/heads/$ps->{branch}";

print HEAD $commitid;

close HEAD;

system('git-update-ref', 'HEAD', "$ps->{branch}");

# tag accordingly

ptag($ps->{id}, $commitid); # private tag

if ($opt_T || $ps->{type} eq 't' || $ps->{type} eq 'i') {

tag($ps->{id}, $commitid);

}

print " * Committed $ps->{id}\n";

print " + tree $tree\n";

print " + commit $commitid\n";

$opt_v && print " + commit date is $ps->{date} \n";

$opt_v && print " + parents: ",join(' ',@par),"\n";

}

if ($opt_v) {

foreach (sort keys %stats) {

print" $_: $stats{$_}\n";

}

}

exit 0;

sub sync_to_ps {

my $ps = shift;

my $tree_dir = $tmp.'/'.tree_dirname($ps->{id});

$opt_v && print "sync_to_ps($ps->{id}) method: ";

if (-d $tree_dir) {

if ($ps->{type} eq 't') {

$opt_v && print "get (tag)\n";

# looks like a tag-only or (worse,) a mixed tags/changeset branch,

# can't rely on replay to work correctly on these

rmtree($tree_dir);

safe_pipe_capture($TLA,'get','--no-pristine',$ps->{id},$tree_dir);

$stats{get_tag}++;

} else {

my $tree_id = arch_tree_id($tree_dir);

if ($ps->{parent_id} && ($ps->{parent_id} eq $tree_id)) {

# the common case (hopefully)

$opt_v && print "replay\n";

safe_pipe_capture($TLA,'replay','-d',$tree_dir,$ps->{id});

$stats{replay}++;

} else {

# getting one tree is usually faster than getting two trees

# and applying the delta ...

rmtree($tree_dir);

$opt_v && print "apply-delta\n";

safe_pipe_capture($TLA,'get','--no-pristine',

$ps->{id},$tree_dir);

$stats{get_delta}++;

}

}

} else {

# new branch work

$opt_v && print "get (new tree)\n";

safe_pipe_capture($TLA,'get','--no-pristine',$ps->{id},$tree_dir);

$stats{get_new}++;

}

# added -I flag to rsync since we're going to fast! AIEEEEE!!!!

system('rsync','-aI','--delete','--exclude',$git_dir,

'--exclude','.arch-ids','--exclude','{arch}',

'--exclude','+*','--exclude',',*',

"$tree_dir/",'./') == 0 or die "Cannot rsync $tree_dir: $! $?";

return $tree_dir;

}

sub apply_import {

my $ps = shift;

my $bname = git_branchname($ps->{id});

mkpath($tmp);

safe_pipe_capture($TLA,'get','-s','--no-pristine',$ps->{id},"$tmp/import");

die "Cannot get import: $!" if $?;

system('rsync','-aI','--delete', '--exclude',$git_dir,

'--exclude','.arch-ids','--exclude','{arch}',

"$tmp/import/", './');

die "Cannot rsync import:$!" if $?;

rmtree("$tmp/import");

die "Cannot remove tempdir: $!" if $?;

return 1;

}

sub apply_cset {

my $ps = shift;

mkpath($tmp);

# get the changeset

safe_pipe_capture($TLA,'get-changeset',$ps->{id},"$tmp/changeset");

die "Cannot get changeset: $!" if $?;

# apply patches

if (`find $tmp/changeset/patches -type f -name '*.patch'`) {

# this can be sped up considerably by doing

# (find | xargs cat) | patch

# but that can get mucked up by patches

# with missing trailing newlines or the standard

# 'missing newline' flag in the patch - possibly

# produced with an old/buggy diff.

# slow and safe, we invoke patch once per patchfile

`find $tmp/changeset/patches -type f -name '*.patch' -print0 | grep -zv '{arch}' | xargs -iFILE -0 --no-run-if-empty patch -p1 --forward -iFILE`;

die "Problem applying patches! $!" if $?;

}

# apply changed binary files

if (my @modified = `find $tmp/changeset/patches -type f -name '*.modified'`) {

foreach my $mod (@modified) {

chomp $mod;

my $orig = $mod;

$orig =~ s/\.modified$//; # lazy

$orig =~ s!^\Q$tmp\E/changeset/patches/!!;

#print "rsync -p '$mod' '$orig'";

system('rsync','-p',$mod,"./$orig");

die "Problem applying binary changes! $!" if $?;

}

}

# bring in new files

system('rsync','-aI','--exclude',$git_dir,

'--exclude','.arch-ids',

'--exclude', '{arch}',

"$tmp/changeset/new-files-archive/",'./');

# deleted files are hinted from the commitlog processing

rmtree("$tmp/changeset");

}

sub parselog {

my ($ps, $log) = @_;

my $key = undef;

# headers we want that contain filenames:

my %want_headers = (

new_files => 1,

modified_files => 1,

renamed_files => 1,

renamed_directories => 1,

removed_files => 1,

removed_directories => 1,

);

chomp (@$log);

while ($_ = shift @$log) {

if (/^Continuation-of:\s*(.*)/) {

$ps->{tag} = $1;

$key = undef;

} elsif (/^Summary:\s*(.*)$/ ) {

# summary can be multiline as long as it has a leading space.

# we squeeze it onto a single line, though.

$ps->{summary} = [ $1 ];

$key = 'summary';

} elsif (/^Creator: (.*)\s*<([^\>]+)>/) {

$ps->{author} = $1;

$ps->{email} = $2;

$key = undef;

# any *-files or *-directories can be read here:

} elsif (/^([A-Z][a-z\-]+):\s*(.*)$/) {

my $val = $2;

$key = lc $1;

$key =~ tr/-/_/; # too lazy to quote :P

if ($want_headers{$key}) {

push @{$ps->{$key}}, split(/\s+/, $val);

} else {

$key = undef;

}

} elsif (/^$/) {

last; # remainder of @$log that didn't get shifted off is message

} elsif ($key) {

if (/^\s+(.*)$/) {

if ($key eq 'summary') {

push @{$ps->{$key}}, $1;

} else { # files/directories:

push @{$ps->{$key}}, split(/\s+/, $1);

}

} else {

$key = undef;

}

}

}

# drop leading empty lines from the log message

while (@$log && $log->[0] eq '') {

shift @$log;

}

if (exists $ps->{summary} && @{$ps->{summary}}) {

$ps->{summary} = join(' ', @{$ps->{summary}});

}

elsif (@$log == 0) {

$ps->{summary} = 'empty commit message';

} else {

$ps->{summary} = $log->[0] . '...';

}

$ps->{message} = join("\n",@$log);

# skip Arch control files, unescape pika-escaped files

foreach my $k (keys %want_headers) {

next unless (defined $ps->{$k});

my @tmp = ();

foreach my $t (@{$ps->{$k}}) {

next unless length ($t);

next if $t =~ m!\{arch\}/!;

next if $t =~ m!\.arch-ids/!;

# should we skip this?

next if $t =~ m!\.arch-inventory$!;

# tla cat-archive-log will give us filenames with spaces as file\(sp)name - why?

# we can assume that any filename with \ indicates some pika escaping that we want to get rid of.

if ($t =~ /\\/ ){

$t = (safe_pipe_capture($TLA,'escape','--unescaped',$t))[0];

}

push @tmp, $t;

}

$ps->{$k} = \@tmp;

}

}

sub tag {

my ($tag, $commit) = @_;

if ($opt_o) {

$tag =~ s|/|--|g;

} else {

my $patchname = $tag;

$patchname =~ s/.*--//;

$tag = git_branchname ($tag) . '--' . $patchname;

}

if ($commit) {

open(C,">","$git_dir/refs/tags/$tag")

or die "Cannot create tag $tag: $!\n";

print C "$commit\n"

or die "Cannot write tag $tag: $!\n";

close(C)

or die "Cannot write tag $tag: $!\n";

print " * Created tag '$tag' on '$commit'\n" if $opt_v;

} else { # read

open(C,"<","$git_dir/refs/tags/$tag")

or die "Cannot read tag $tag: $!\n";

$commit = <C>;

chomp $commit;

die "Error reading tag $tag: $!\n" unless length $commit == 40;

close(C)

or die "Cannot read tag $tag: $!\n";

return $commit;

}

}

sub ptag {

my ($tag, $commit) = @_;

# don't use subdirs for tags yet, it could screw up other porcelains

$tag =~ s|/|,|g;

my $tag_file = "$ptag_dir/$tag";

my $tag_branch_dir = dirname($tag_file);

mkpath($tag_branch_dir) unless (-d $tag_branch_dir);

if ($commit) { # write

open(C,">",$tag_file)

or die "Cannot create tag $tag: $!\n";

print C "$commit\n"

or die "Cannot write tag $tag: $!\n";

close(C)

or die "Cannot write tag $tag: $!\n";

$rptags{$commit} = $tag

unless $tag =~ m/--base-0$/;

} else { # read

# if the tag isn't there, return 0

unless ( -s $tag_file) {

return 0;

}

open(C,"<",$tag_file)

or die "Cannot read tag $tag: $!\n";

$commit = <C>;

chomp $commit;

die "Error reading tag $tag: $!\n" unless length $commit == 40;

close(C)

or die "Cannot read tag $tag: $!\n";

unless (defined $rptags{$commit}) {

$rptags{$commit} = $tag;

}

return $commit;

}

}

sub find_parents {

#

# Identify what branches are merging into me

# and whether we are fully merged

# git-merge-base <headsha> <headsha> should tell

# me what the base of the merge should be

#

my $ps = shift;

my %branches; # holds an arrayref per branch

# the arrayref contains a list of

# merged patches between the base

# of the merge and the current head

my @parents; # parents found for this commit

# simple loop to split the merges

# per branch

foreach my $merge (@{$ps->{merges}}) {

my $branch = git_branchname($merge);

unless (defined $branches{$branch} ){

$branches{$branch} = [];

}

push @{$branches{$branch}}, $merge;

}

#

# foreach branch find a merge base and walk it to the

# head where we are, collecting the merged patchsets that

# Arch has recorded. Keep that in @have

# Compare that with the commits on the other branch

# between merge-base and the tip of the branch (@need)

# and see if we have a series of consecutive patches

# starting from the merge base. The tip of the series

# of consecutive patches merged is our new parent for

# that branch.

#

foreach my $branch (keys %branches) {

# check that we actually know about the branch

next unless -e "$git_dir/refs/heads/$branch";

my $mergebase = `git-merge-base $branch $ps->{branch}`;

if ($?) {

# Don't die here, Arch supports one-way cherry-picking

# between branches with no common base (or any relationship

# at all beforehand)

warn "Cannot find merge base for $branch and $ps->{branch}";

next;

}

chomp $mergebase;

# now walk up to the mergepoint collecting what patches we have

my $branchtip = git_rev_parse($ps->{branch});

my @ancestors = `git-rev-list --topo-order $branchtip ^$mergebase`;

my %have; # collected merges this branch has

foreach my $merge (@{$ps->{merges}}) {

$have{$merge} = 1;