3 # This tool is copyright (c) 2005, Martin Langhoff.
4 # It is released under the Gnu Public License, version 2.
6 # The basic idea is to walk the output of tla abrowse,
7 # fetch the changesets and apply them.
12 git-archimport [ -h ] [ -v ] [ -T ] [ -t tempdir ] <archive>/<branch> [ <archive>/<branch> ]
14 Imports a project from one or more Arch repositories. It will follow branches
15 and repositories within the namespaces defined by the <archive/branch>
16 parameters suppplied. If it cannot find the remote branch a merge comes from
17 it will just import it as a regular commit. If it can find it, it will mark it
18 as a merge whenever possible.
20 See man (1) git-archimport for more details.
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 - sort and apply patches by graphing ancestry relations instead of just
29 relying in dates supplied in the changeset itself.
30 tla ancestry-graph -m could be helpful here...
34 Add print in front of the shell commands invoked via backticks.
38 There are several places where Arch and git terminology are intermixed
39 and potentially confused.
41 The notion of a "branch" in git is approximately equivalent to
42 a "archive/category--branch--version" in Arch. Also, it should be noted
43 that the "--branch" portion of "archive/category--branch--version" is really
44 optional in Arch although not many people (nor tools!) seem to know this.
45 This means that "archive/category--version" is also a valid "branch"
48 We always refer to Arch names by their fully qualified variant (which
49 means the "archive" name is prefixed.
51 For people unfamiliar with Arch, an "archive" is the term for "repository",
52 and can contain multiple, unrelated branches.
59 use File::Temp qw(tempdir);
60 use File::Path qw(mkpath rmtree);
61 use File::Basename qw(basename dirname);
62 use Data::Dumper qw/ Dumper /;
65 $SIG{'PIPE'}="IGNORE";
68 my $git_dir = $ENV{"GIT_DIR"} || ".git";
69 $ENV{"GIT_DIR"} = $git_dir;
70 my $ptag_dir = "$git_dir/archimport/tags";
72 our($opt_h,$opt_f,$opt_v,$opt_T,$opt_t,$opt_D,$opt_a,$opt_o);
76 Usage: ${\basename $0} # fetch/update GIT from Arch
77 [ -f ] [ -o ] [ -h ] [ -v ] [ -T ] [ -a ] [ -D depth ] [ -t tempdir ]
78 repository/arch-branch [ repository/arch-branch] ...
83 getopts("fThvat:D:") or usage();
86 @ARGV >= 1 or usage();
88 # values associated with keys:
89 # =1 - Arch version / git 'branch' detected via abrowse on a limit
90 # >1 - Arch version / git 'branch' of an auxilliary branch we've merged
91 my %arch_branches = map { $_ => 1 } @ARGV;
93 $ENV{'TMPDIR'} = $opt_t if $opt_t; # $ENV{TMPDIR} will affect tempdir() calls:
94 my $tmp = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
95 $opt_v && print "+ Using $tmp as temporary directory\n";
97 my %reachable = (); # Arch repositories we can access
98 my %unreachable = (); # Arch repositories we can't access :<
99 my @psets = (); # the collection
100 my %psets = (); # the collection, by name
101 my %stats = ( # Track which strategy we used to import:
102 get_tag => 0, replay => 0, get_new => 0, get_delta => 0,
103 simple_changeset => 0, import_or_tag => 0
106 my %rptags = (); # my reverse private tags
107 # to map a SHA1 to a commitid
108 my $TLA = $ENV{'ARCH_CLIENT'} || 'tla';
112 while (my ($limit, $level) = each %arch_branches) {
113 next unless $level == $stage;
115 open ABROWSE, "$TLA abrowse -fkD --merges $limit |"
116 or die "Problems with tla abrowse: $!";
118 my %ps = (); # the current one
124 # first record padded w 8 spaces
126 my ($id, $type) = split(m/\s+/, $_, 2);
129 # store the record we just captured
130 if (%ps && !exists $psets{ $ps{id} }) {
131 %last_ps = %ps; # break references
132 push (@psets, \%last_ps);
133 $psets{ $last_ps{id} } = \%last_ps;
136 my $branch = extract_versionname($id);
137 %ps = ( id => $id, branch => $branch );
138 if (%last_ps && ($last_ps{branch} eq $branch)) {
139 $ps{parent_id} = $last_ps{id};
142 $arch_branches{$branch} = 1;
145 # deal with types (should work with baz or tla):
146 if ($type =~ m/\(.*changeset\)/) {
148 } elsif ($type =~ /\(.*import\)/) {
150 } elsif ($type =~ m/\(tag.*?(\S+\@\S+).*?\)/) {
152 # read which revision we've tagged when we parse the log
155 warn "Unknown type $type";
158 $arch_branches{$branch} = 1;
160 } elsif (s/^\s{10}//) {
161 # 10 leading spaces or more
162 # indicate commit metadata
165 if ($lastseen eq 'id' && m/^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d)/){
168 } elsif ($_ eq 'merges in:') {
170 $lastseen = 'merges';
171 } elsif ($lastseen eq 'merges' && s/^\s{2}//) {
173 push (@{$ps{merges}}, $id);
175 # aggressive branch finding:
177 my $branch = extract_versionname($id);
178 my $repo = extract_reponame($branch);
180 if (archive_reachable($repo) &&
181 !defined $arch_branches{$branch}) {
182 $arch_branches{$branch} = $stage + 1;
186 warn "more metadata after merges!?: $_\n" unless /^\s*$/;
191 if (%ps && !exists $psets{ $ps{id} }) {
192 my %temp = %ps; # break references
193 if (@psets && $psets[$#psets]{branch} eq $ps{branch}) {
194 $temp{parent_id} = $psets[$#psets]{id};
196 push (@psets, \%temp);
197 $psets{ $temp{id} } = \%temp;
200 close ABROWSE or die "$TLA abrowse failed on $limit\n";
202 } # end foreach $root
207 while ($depth <= $opt_D) {
212 ## Order patches by time
213 # FIXME see if we can find a more optimal way to do this by graphing
214 # the ancestry data and walking it, that way we won't have to rely on
215 # client-supplied dates
216 @psets = sort {$a->{date}.$b->{id} cmp $b->{date}.$b->{id}} @psets;
218 #print Dumper \@psets;
221 ## TODO cleanup irrelevant patches
222 ## and put an initial import
225 unless (-d $git_dir) { # initial import
226 if ($psets[0]{type} eq 'i' || $psets[0]{type} eq 't') {
227 print "Starting import from $psets[0]{id}\n";
232 die "Need to start from an import or a tag -- cannot use $psets[0]{id}";
234 } else { # progressing an import
236 opendir(DIR, $ptag_dir)
237 || die "can't opendir: $!";
238 while (my $file = readdir(DIR)) {
239 # skip non-interesting-files
240 next unless -f "$ptag_dir/$file";
242 # convert first '--' to '/' from old git-archimport to use
243 # as an archivename/c--b--v private tag
247 print STDERR "converting old tag $oldfile to $file\n";
248 rename("$ptag_dir/$oldfile", "$ptag_dir/$file") or die $!;
250 my $sha = ptag($file);
252 $rptags{$sha} = $file;
258 # extract the Arch repository name (Arch "archive" in Arch-speak)
259 sub extract_reponame {
260 my $fq_cvbr = shift; # archivename/[[[[category]branch]version]revision]
261 return (split(/\//, $fq_cvbr))[0];
264 sub extract_versionname {
266 $name =~ s/--(?:patch|version(?:fix)?|base)-\d+$//;
270 # convert a fully-qualified revision or version to a unique dirname:
271 # normalperson@yhbt.net-05/mpd--uclinux--1--patch-2
272 # becomes: normalperson@yhbt.net-05,mpd--uclinux--1
274 # the git notion of a branch is closer to
275 # archive/category--branch--version than archive/category--branch, so we
276 # use this to convert to git branch names.
277 # Also, keep archive names but replace '/' with ',' since it won't require
278 # subdirectories, and is safer than swapping '--' which could confuse
279 # reverse-mapping when dealing with bastard branches that
280 # are just archive/category--version (no --branch)
282 my $revision = shift;
283 my $name = extract_versionname($revision);
288 # old versions of git-archimport just use the <category--branch> part:
289 sub old_style_branchname {
291 my $ret = safe_pipe_capture($TLA,'parse-package-name','-p',$id);
296 *git_branchname = $opt_o ? *old_style_branchname : *tree_dirname;
298 sub process_patchset_accurate {
301 # switch to that branch if we're not already in that branch:
302 if (-e "$git_dir/refs/heads/$ps->{branch}") {
303 system('git-checkout','-f',$ps->{branch}) == 0 or die "$! $?\n";
305 # remove any old stuff that got leftover:
306 my $rm = safe_pipe_capture('git-ls-files','--others','-z');
307 rmtree(split(/\0/,$rm)) if $rm;
310 # Apply the import/changeset/merge into the working tree
311 my $dir = sync_to_ps($ps);
312 # read the new log entry:
313 my @commitlog = safe_pipe_capture($TLA,'cat-log','-d',$dir,$ps->{id});
314 die "Error in cat-log: $!" if $?;
317 # grab variables we want from the log, new fields get added to $ps:
318 # (author, date, email, summary, message body ...)
319 parselog($ps, \@commitlog);
321 if ($ps->{id} =~ /--base-0$/ && $ps->{id} ne $psets[0]{id}) {
322 # this should work when importing continuations
323 if ($ps->{tag} && (my $branchpoint = eval { ptag($ps->{tag}) })) {
325 # find where we are supposed to branch from
326 system('git-checkout','-f','-b',$ps->{branch},
327 $branchpoint) == 0 or die "$! $?\n";
329 # remove any old stuff that got leftover:
330 my $rm = safe_pipe_capture('git-ls-files','--others','-z');
331 rmtree(split(/\0/,$rm)) if $rm;
333 # If we trust Arch with the fact that this is just
334 # a tag, and it does not affect the state of the tree
335 # then we just tag and move on
336 tag($ps->{id}, $branchpoint);
337 ptag($ps->{id}, $branchpoint);
338 print " * Tagged $ps->{id} at $branchpoint\n";
341 warn "Tagging from unknown id unsupported\n" if $ps->{tag};
343 # allow multiple bases/imports here since Arch supports cherry-picks
344 # from unrelated trees
347 # update the index with all the changes we got
348 system('git-ls-files --others -z | '.
349 'git-update-index --add -z --stdin') == 0 or die "$! $?\n";
350 system('git-ls-files --deleted -z | '.
351 'git-update-index --remove -z --stdin') == 0 or die "$! $?\n";
352 system('git-ls-files -z | '.
353 'git-update-index -z --stdin') == 0 or die "$! $?\n";
357 # the native changeset processing strategy. This is very fast, but
358 # does not handle permissions or any renames involving directories
359 sub process_patchset_fast {
362 # create the branch if needed
364 if ($ps->{type} eq 'i' && !$import) {
365 die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";
368 unless ($import) { # skip for import
369 if ( -e "$git_dir/refs/heads/$ps->{branch}") {
370 # we know about this branch
371 system('git-checkout',$ps->{branch});
373 # new branch! we need to verify a few things
374 die "Branch on a non-tag!" unless $ps->{type} eq 't';
375 my $branchpoint = ptag($ps->{tag});
376 die "Tagging from unknown id unsupported: $ps->{tag}"
379 # find where we are supposed to branch from
380 system('git-checkout','-b',$ps->{branch},$branchpoint);
382 # If we trust Arch with the fact that this is just
383 # a tag, and it does not affect the state of the tree
384 # then we just tag and move on
385 tag($ps->{id}, $branchpoint);
386 ptag($ps->{id}, $branchpoint);
387 print " * Tagged $ps->{id} at $branchpoint\n";
394 # Apply the import/changeset/merge into the working tree
396 if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
397 apply_import($ps) or die $!;
398 $stats{import_or_tag}++;
400 } elsif ($ps->{type} eq 's') {
402 $stats{simple_changeset}++;
406 # prepare update git's index, based on what arch knows
407 # about the pset, resolve parents, etc
410 my @commitlog = safe_pipe_capture($TLA,'cat-archive-log',$ps->{id});
411 die "Error in cat-archive-log: $!" if $?;
413 parselog($ps,\@commitlog);
415 # imports don't give us good info
416 # on added files. Shame on them
417 if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
418 system('git-ls-files --others -z | '.
419 'git-update-index --add -z --stdin') == 0 or die "$! $?\n";
420 system('git-ls-files --deleted -z | '.
421 'git-update-index --remove -z --stdin') == 0 or die "$! $?\n";
424 # TODO: handle removed_directories and renamed_directories:
426 if (my $add = $ps->{new_files}) {
428 my @slice = splice(@$add, 0, 100);
429 system('git-update-index','--add','--',@slice) == 0 or
430 die "Error in git-update-index --add: $! $?\n";
434 if (my $del = $ps->{removed_files}) {
437 my @slice = splice(@$del, 0, 100);
438 system('git-update-index','--remove','--',@slice) == 0 or
439 die "Error in git-update-index --remove: $! $?\n";
443 if (my $ren = $ps->{renamed_files}) { # renamed
445 die "Odd number of entries in rename!?";
449 my $from = shift @$ren;
450 my $to = shift @$ren;
452 unless (-d dirname($to)) {
453 mkpath(dirname($to)); # will die on err
455 # print "moving $from $to";
456 rename($from, $to) or die "Error renaming '$from' '$to': $!\n";
457 system('git-update-index','--remove','--',$from) == 0 or
458 die "Error in git-update-index --remove: $! $?\n";
459 system('git-update-index','--add','--',$to) == 0 or
460 die "Error in git-update-index --add: $! $?\n";
464 if (my $mod = $ps->{modified_files}) {
466 my @slice = splice(@$mod, 0, 100);
467 system('git-update-index','--',@slice) == 0 or
468 die "Error in git-update-index: $! $?\n";
471 return 1; # we successfully applied the changeset
475 print "Will import patchsets using the fast strategy\n",
476 "Renamed directories and permission changes will be missed\n";
477 *process_patchset = *process_patchset_fast;
479 print "Using the default (accurate) import strategy.\n",
480 "Things may be a bit slow\n";
481 *process_patchset = *process_patchset_accurate;
484 foreach my $ps (@psets) {
486 $ps->{branch} = git_branchname($ps->{id});
489 # ensure we have a clean state
491 if (my $dirty = `git-diff-files`) {
492 die "Unclean tree when about to process $ps->{id} " .
493 " - did we fail to commit cleanly before?\n$dirty";
498 # skip commits already in repo
500 if (ptag($ps->{id})) {
501 $opt_v && print " * Skipping already imported: $ps->{id}\n";
505 print " * Starting to work on $ps->{id}\n";
507 process_patchset($ps) or next;
509 # warn "errors when running git-update-index! $!";
510 my $tree = `git-write-tree`;
511 die "cannot write tree $!" if $?;
518 if ( -e "$git_dir/refs/heads/$ps->{branch}") {
519 if (open HEAD, "<","$git_dir/refs/heads/$ps->{branch}") {
525 if ($ps->{type} eq 's') {
526 warn "Could not find the right head for the branch $ps->{branch}";
532 push @par, find_parents($ps);
536 # Commit, tag and clean state
539 $ENV{GIT_AUTHOR_NAME} = $ps->{author};
540 $ENV{GIT_AUTHOR_EMAIL} = $ps->{email};
541 $ENV{GIT_AUTHOR_DATE} = $ps->{date};
542 $ENV{GIT_COMMITTER_NAME} = $ps->{author};
543 $ENV{GIT_COMMITTER_EMAIL} = $ps->{email};
544 $ENV{GIT_COMMITTER_DATE} = $ps->{date};
546 my $pid = open2(*READER, *WRITER,'git-commit-tree',$tree,@par)
548 print WRITER $ps->{summary},"\n";
549 print WRITER $ps->{message},"\n";
551 # make it easy to backtrack and figure out which Arch revision this was:
552 print WRITER 'git-archimport-id: ',$ps->{id},"\n";
555 my $commitid = <READER>; # read
558 waitpid $pid,0; # close;
560 if (length $commitid != 40) {
561 die "Something went wrong with the commit! $! $commitid";
566 open HEAD, ">","$git_dir/refs/heads/$ps->{branch}";
567 print HEAD $commitid;
569 system('git-update-ref', 'HEAD', "$ps->{branch}");
572 ptag($ps->{id}, $commitid); # private tag
573 if ($opt_T || $ps->{type} eq 't' || $ps->{type} eq 'i') {
574 tag($ps->{id}, $commitid);
576 print " * Committed $ps->{id}\n";
577 print " + tree $tree\n";
578 print " + commit $commitid\n";
579 $opt_v && print " + commit date is $ps->{date} \n";
580 $opt_v && print " + parents: ",join(' ',@par),"\n";
584 foreach (sort keys %stats) {
585 print" $_: $stats{$_}\n";
590 # used by the accurate strategy:
593 my $tree_dir = $tmp.'/'.tree_dirname($ps->{id});
595 $opt_v && print "sync_to_ps($ps->{id}) method: ";
598 if ($ps->{type} eq 't') {
599 $opt_v && print "get (tag)\n";
600 # looks like a tag-only or (worse,) a mixed tags/changeset branch,
601 # can't rely on replay to work correctly on these
603 safe_pipe_capture($TLA,'get','--no-pristine',$ps->{id},$tree_dir);
606 my $tree_id = arch_tree_id($tree_dir);
607 if ($ps->{parent_id} && ($ps->{parent_id} eq $tree_id)) {
608 # the common case (hopefully)
609 $opt_v && print "replay\n";
610 safe_pipe_capture($TLA,'replay','-d',$tree_dir,$ps->{id});
613 # getting one tree is usually faster than getting two trees
614 # and applying the delta ...
616 $opt_v && print "apply-delta\n";
617 safe_pipe_capture($TLA,'get','--no-pristine',
618 $ps->{id},$tree_dir);
624 $opt_v && print "get (new tree)\n";
625 safe_pipe_capture($TLA,'get','--no-pristine',$ps->{id},$tree_dir);
629 # added -I flag to rsync since we're going to fast! AIEEEEE!!!!
630 system('rsync','-aI','--delete','--exclude',$git_dir,
631 # '--exclude','.arch-inventory',
632 '--exclude','.arch-ids','--exclude','{arch}',
633 '--exclude','+*','--exclude',',*',
634 "$tree_dir/",'./') == 0 or die "Cannot rsync $tree_dir: $! $?";
640 my $bname = git_branchname($ps->{id});
644 safe_pipe_capture($TLA,'get','-s','--no-pristine',$ps->{id},"$tmp/import");
645 die "Cannot get import: $!" if $?;
646 system('rsync','-aI','--delete', '--exclude',$git_dir,
647 '--exclude','.arch-ids','--exclude','{arch}',
648 "$tmp/import/", './');
649 die "Cannot rsync import:$!" if $?;
651 rmtree("$tmp/import");
652 die "Cannot remove tempdir: $!" if $?;
664 safe_pipe_capture($TLA,'get-changeset',$ps->{id},"$tmp/changeset");
665 die "Cannot get changeset: $!" if $?;
668 if (`find $tmp/changeset/patches -type f -name '*.patch'`) {
669 # this can be sped up considerably by doing
670 # (find | xargs cat) | patch
671 # but that cna get mucked up by patches
672 # with missing trailing newlines or the standard
673 # 'missing newline' flag in the patch - possibly
674 # produced with an old/buggy diff.
675 # slow and safe, we invoke patch once per patchfile
676 `find $tmp/changeset/patches -type f -name '*.patch' -print0 | grep -zv '{arch}' | xargs -iFILE -0 --no-run-if-empty patch -p1 --forward -iFILE`;
677 die "Problem applying patches! $!" if $?;
680 # apply changed binary files
681 if (my @modified = `find $tmp/changeset/patches -type f -name '*.modified'`) {
682 foreach my $mod (@modified) {
685 $orig =~ s/\.modified$//; # lazy
686 $orig =~ s!^\Q$tmp\E/changeset/patches/!!;
687 #print "rsync -p '$mod' '$orig'";
688 system('rsync','-p',$mod,"./$orig");
689 die "Problem applying binary changes! $!" if $?;
694 system('rsync','-aI','--exclude',$git_dir,
695 '--exclude','.arch-ids',
696 '--exclude', '{arch}',
697 "$tmp/changeset/new-files-archive/",'./');
699 # deleted files are hinted from the commitlog processing
701 rmtree("$tmp/changeset");
706 # notes: *-files/-directories keys cannot have spaces, they're always
707 # pika-escaped. Everything after the first newline
708 # A log entry looks like:
709 # Revision: moodle-org--moodle--1.3.3--patch-15
710 # Archive: arch-eduforge@catalyst.net.nz--2004
711 # Creator: Penny Leach <penny@catalyst.net.nz>
712 # Date: Wed May 25 14:15:34 NZST 2005
713 # Standard-date: 2005-05-25 02:15:34 GMT
714 # New-files: lang/de/.arch-ids/block_glossary_random.php.id
715 # lang/de/.arch-ids/block_html.php.id
716 # New-directories: lang/de/help/questionnaire
717 # lang/de/help/questionnaire/.arch-ids
718 # Renamed-files: .arch-ids/db_sears.sql.id db/.arch-ids/db_sears.sql.id
719 # db_sears.sql db/db_sears.sql
720 # Removed-files: lang/be/docs/.arch-ids/release.html.id
721 # lang/be/docs/.arch-ids/releaseold.html.id
722 # Modified-files: admin/cron.php admin/delete.php
723 # admin/editor.html backup/lib.php backup/restore.php
724 # New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15
725 # Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+)
726 # summary can be multiline with a leading space just like the above fields
729 # Updating yadda tadda tadda madda
734 # headers we want that contain filenames:
739 renamed_directories => 1,
741 removed_directories => 1,
745 while ($_ = shift @$log) {
746 if (/^Continuation-of:\s*(.*)/) {
749 } elsif (/^Summary:\s*(.*)$/ ) {
750 # summary can be multiline as long as it has a leading space
751 $ps->{summary} = [ $1 ];
753 } elsif (/^Creator: (.*)\s*<([^\>]+)>/) {
757 # any *-files or *-directories can be read here:
758 } elsif (/^([A-Z][a-z\-]+):\s*(.*)$/) {
761 $key =~ tr/-/_/; # too lazy to quote :P
762 if ($want_headers{$key}) {
763 push @{$ps->{$key}}, split(/\s+/, $val);
768 last; # remainder of @$log that didn't get shifted off is message
771 if ($key eq 'summary') {
772 push @{$ps->{$key}}, $1;
773 } else { # files/directories:
774 push @{$ps->{$key}}, split(/\s+/, $1);
783 $ps->{summary} = join("\n",@{$ps->{summary}})."\n";
784 $ps->{message} = join("\n",@$log);
786 # skip Arch control files, unescape pika-escaped files
787 foreach my $k (keys %want_headers) {
788 next unless (defined $ps->{$k});
790 foreach my $t (@{$ps->{$k}}) {
791 next unless length ($t);
792 next if $t =~ m!\{arch\}/!;
793 next if $t =~ m!\.arch-ids/!;
794 # should we skip this?
795 next if $t =~ m!\.arch-inventory$!;
796 # tla cat-archive-log will give us filenames with spaces as file\(sp)name - why?
797 # we can assume that any filename with \ indicates some pika escaping that we want to get rid of.
799 $t = (safe_pipe_capture($TLA,'escape','--unescaped',$t))[0];
809 my ($tag, $commit) = @_;
814 # don't use subdirs for tags yet, it could screw up other porcelains
819 open(C,">","$git_dir/refs/tags/$tag")
820 or die "Cannot create tag $tag: $!\n";
822 or die "Cannot write tag $tag: $!\n";
824 or die "Cannot write tag $tag: $!\n";
825 print " * Created tag '$tag' on '$commit'\n" if $opt_v;
827 open(C,"<","$git_dir/refs/tags/$tag")
828 or die "Cannot read tag $tag: $!\n";
831 die "Error reading tag $tag: $!\n" unless length $commit == 40;
833 or die "Cannot read tag $tag: $!\n";
838 # write/read a private tag
839 # reads fail softly if the tag isn't there
841 my ($tag, $commit) = @_;
843 # don't use subdirs for tags yet, it could screw up other porcelains
846 my $tag_file = "$ptag_dir/$tag";
847 my $tag_branch_dir = dirname($tag_file);
848 mkpath($tag_branch_dir) unless (-d $tag_branch_dir);
850 if ($commit) { # write
851 open(C,">",$tag_file)
852 or die "Cannot create tag $tag: $!\n";
854 or die "Cannot write tag $tag: $!\n";
856 or die "Cannot write tag $tag: $!\n";
857 $rptags{$commit} = $tag
858 unless $tag =~ m/--base-0$/;
860 # if the tag isn't there, return 0
861 unless ( -s $tag_file) {
864 open(C,"<",$tag_file)
865 or die "Cannot read tag $tag: $!\n";
868 die "Error reading tag $tag: $!\n" unless length $commit == 40;
870 or die "Cannot read tag $tag: $!\n";
871 unless (defined $rptags{$commit}) {
872 $rptags{$commit} = $tag;
880 # Identify what branches are merging into me
881 # and whether we are fully merged
882 # git-merge-base <headsha> <headsha> should tell
883 # me what the base of the merge should be
887 my %branches; # holds an arrayref per branch
888 # the arrayref contains a list of
889 # merged patches between the base
890 # of the merge and the current head
892 my @parents; # parents found for this commit
894 # simple loop to split the merges
896 foreach my $merge (@{$ps->{merges}}) {
897 my $branch = git_branchname($merge);
898 unless (defined $branches{$branch} ){
899 $branches{$branch} = [];
901 push @{$branches{$branch}}, $merge;
905 # foreach branch find a merge base and walk it to the
906 # head where we are, collecting the merged patchsets that
907 # Arch has recorded. Keep that in @have
908 # Compare that with the commits on the other branch
909 # between merge-base and the tip of the branch (@need)
910 # and see if we have a series of consecutive patches
911 # starting from the merge base. The tip of the series
912 # of consecutive patches merged is our new parent for
915 foreach my $branch (keys %branches) {
917 # check that we actually know about the branch
918 next unless -e "$git_dir/refs/heads/$branch";
920 my $mergebase = `git-merge-base $branch $ps->{branch}`;
922 # Don't die here, Arch supports one-way cherry-picking
923 # between branches with no common base (or any relationship
925 warn "Cannot find merge base for $branch and $ps->{branch}";
930 # now walk up to the mergepoint collecting what patches we have
931 my $branchtip = git_rev_parse($ps->{branch});
932 my @ancestors = `git-rev-list --merge-order $branchtip ^$mergebase`;
933 my %have; # collected merges this branch has
934 foreach my $merge (@{$ps->{merges}}) {
938 foreach my $par (@ancestors) {
939 $par = commitid2pset($par);
940 if (defined $par->{merges}) {
941 foreach my $merge (@{$par->{merges}}) {
942 $ancestorshave{$merge}=1;
946 # print "++++ Merges in $ps->{id} are....\n";
947 # my @have = sort keys %have; print Dumper(\@have);
949 # merge what we have with what ancestors have
950 %have = (%have, %ancestorshave);
952 # see what the remote branch has - these are the merges we
953 # will want to have in a consecutive series from the mergebase
954 my $otherbranchtip = git_rev_parse($branch);
955 my @needraw = `git-rev-list --merge-order $otherbranchtip ^$mergebase`;
957 foreach my $needps (@needraw) { # get the psets
958 $needps = commitid2pset($needps);
959 # git-rev-list will also
960 # list commits merged in via earlier
961 # merges. we are only interested in commits
962 # from the branch we're looking at
963 if ($branch eq $needps->{branch}) {
964 push @need, $needps->{id};
968 # print "++++ Merges from $branch we want are....\n";
969 # print Dumper(\@need);
972 while (my $needed_commit = pop @need) {
973 if ($have{$needed_commit}) {
974 $newparent = $needed_commit;
976 last; # break out of the while
980 push @parents, $newparent;
984 } # end foreach branch
986 # prune redundant parents
988 foreach my $p (@parents) {
991 foreach my $p (@parents) {
992 next unless exists $psets{$p}{merges};
993 next unless ref $psets{$p}{merges};
994 my @merges = @{$psets{$p}{merges}};
995 foreach my $merge (@merges) {
996 if ($parents{$merge}) {
997 delete $parents{$merge};
1003 foreach (keys %parents) {
1004 push @parents, '-p', ptag($_);
1011 my $val = `git-rev-parse $name`;
1012 die "Error: git-rev-parse $name" if $?;
1017 # resolve a SHA1 to a known patchset
1019 my $commitid = shift;
1021 my $name = $rptags{$commitid}
1022 || die "Cannot find reverse tag mapping for $commitid";
1024 my $ps = $psets{$name}
1025 || (print Dumper(sort keys %psets)) && die "Cannot find patchset for $name";
1030 # an alterative to `command` that allows input to be passed as an array
1031 # to work around shell problems with weird characters in arguments
1032 sub safe_pipe_capture {
1034 if (my $pid = open my $child, '-|') {
1035 @output = (<$child>);
1036 close $child or die join(' ',@_).": $! $?";
1038 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
1040 return wantarray ? @output : join('',@output);
1043 # `tla logs -rf -d <dir> | head -n1` or `baz tree-id <dir>`
1046 chomp( my $ret = (safe_pipe_capture($TLA,'logs','-rf','-d',$dir))[0] );
1050 sub archive_reachable {
1051 my $archive = shift;
1052 return 1 if $reachable{$archive};
1053 return 0 if $unreachable{$archive};
1055 if (system "$TLA whereis-archive $archive >/dev/null") {
1056 if ($opt_a && (system($TLA,'register-archive',
1057 "http://mirrors.sourcecontrol.net/$archive") == 0)) {
1058 $reachable{$archive} = 1;
1061 print STDERR "Archive is unreachable: $archive\n";
1062 $unreachable{$archive} = 1;
1065 $reachable{$archive} = 1;