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 ] [ -o ] [ -a ] [ -f ] [ -T ]
13 [ -D depth] [ -t tempdir ] <archive>/<branch> [ <archive>/<branch> ]
15 Imports a project from one or more Arch repositories. It will follow branches
16 and repositories within the namespaces defined by the <archive/branch>
17 parameters supplied. If it cannot find the remote branch a merge comes from
18 it will just import it as a regular commit. If it can find it, it will mark it
19 as a merge whenever possible.
21 See man (1) git-archimport for more details.
25 - create tag objects instead of ref tags
26 - audit shell-escaping of filenames
27 - hide our private tags somewhere smarter
28 - find a way to make "cat *patches | patch" safe even when patchfiles are missing newlines
29 - sort and apply patches by graphing ancestry relations instead of just
30 relying in dates supplied in the changeset itself.
31 tla ancestry-graph -m could be helpful here...
35 Add print in front of the shell commands invoked via backticks.
39 There are several places where Arch and git terminology are intermixed
40 and potentially confused.
42 The notion of a "branch" in git is approximately equivalent to
43 a "archive/category--branch--version" in Arch. Also, it should be noted
44 that the "--branch" portion of "archive/category--branch--version" is really
45 optional in Arch although not many people (nor tools!) seem to know this.
46 This means that "archive/category--version" is also a valid "branch"
49 We always refer to Arch names by their fully qualified variant (which
50 means the "archive" name is prefixed.
52 For people unfamiliar with Arch, an "archive" is the term for "repository",
53 and can contain multiple, unrelated branches.
60 use File
::Temp
qw(tempdir);
61 use File
::Path
qw(mkpath rmtree);
62 use File
::Basename
qw(basename dirname);
63 use Data
::Dumper qw
/ Dumper /;
66 $SIG{'PIPE'}="IGNORE";
69 my $git_dir = $ENV{"GIT_DIR"} || ".git";
70 $ENV{"GIT_DIR"} = $git_dir;
71 my $ptag_dir = "$git_dir/archimport/tags";
73 our($opt_h,$opt_f,$opt_v,$opt_T,$opt_t,$opt_D,$opt_a,$opt_o);
77 Usage: ${\basename $0} # fetch/update GIT from Arch
78 [ -h ] [ -v ] [ -o ] [ -a ] [ -f ] [ -T ] [ -D depth ] [ -t tempdir ]
79 repository/arch-branch [ repository/arch-branch] ...
84 getopts
("fThvat:D:") or usage
();
87 @ARGV >= 1 or usage
();
89 # values associated with keys:
90 # =1 - Arch version / git 'branch' detected via abrowse on a limit
91 # >1 - Arch version / git 'branch' of an auxiliary branch we've merged
92 my %arch_branches = map { $_ => 1 } @ARGV;
94 $ENV{'TMPDIR'} = $opt_t if $opt_t; # $ENV{TMPDIR} will affect tempdir() calls:
95 my $tmp = tempdir
('git-archimport-XXXXXX', TMPDIR
=> 1, CLEANUP
=> 1);
96 $opt_v && print "+ Using $tmp as temporary directory\n";
98 unless (-d
$git_dir) { # initial import needs empty directory
99 opendir DIR
, '.' or die "Unable to open current directory: $!\n";
100 while (my $entry = readdir DIR
) {
101 $entry =~ /^\.\.?$/ or
102 die "Initial import needs an empty current working directory.\n"
107 my %reachable = (); # Arch repositories we can access
108 my %unreachable = (); # Arch repositories we can't access :<
109 my @psets = (); # the collection
110 my %psets = (); # the collection, by name
111 my %stats = ( # Track which strategy we used to import:
112 get_tag
=> 0, replay
=> 0, get_new
=> 0, get_delta
=> 0,
113 simple_changeset
=> 0, import_or_tag
=> 0
116 my %rptags = (); # my reverse private tags
117 # to map a SHA1 to a commitid
118 my $TLA = $ENV{'ARCH_CLIENT'} || 'tla';
122 while (my ($limit, $level) = each %arch_branches) {
123 next unless $level == $stage;
125 open ABROWSE
, "$TLA abrowse -fkD --merges $limit |"
126 or die "Problems with tla abrowse: $!";
128 my %ps = (); # the current one
134 # first record padded w 8 spaces
136 my ($id, $type) = split(m/\s+/, $_, 2);
139 # store the record we just captured
140 if (%ps && !exists $psets{ $ps{id
} }) {
141 %last_ps = %ps; # break references
142 push (@psets, \
%last_ps);
143 $psets{ $last_ps{id
} } = \
%last_ps;
146 my $branch = extract_versionname
($id);
147 %ps = ( id
=> $id, branch
=> $branch );
148 if (%last_ps && ($last_ps{branch
} eq $branch)) {
149 $ps{parent_id
} = $last_ps{id
};
152 $arch_branches{$branch} = 1;
155 # deal with types (should work with baz or tla):
156 if ($type =~ m/\(.*changeset\)/) {
158 } elsif ($type =~ /\(.*import\)/) {
160 } elsif ($type =~ m/\(tag.*?(\S+\@\S+).*?\)/) {
162 # read which revision we've tagged when we parse the log
165 warn "Unknown type $type";
168 $arch_branches{$branch} = 1;
170 } elsif (s/^\s{10}//) {
171 # 10 leading spaces or more
172 # indicate commit metadata
175 if ($lastseen eq 'id' && m/^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d)/){
178 } elsif ($_ eq 'merges in:') {
180 $lastseen = 'merges';
181 } elsif ($lastseen eq 'merges' && s/^\s{2}//) {
183 push (@
{$ps{merges
}}, $id);
185 # aggressive branch finding:
187 my $branch = extract_versionname
($id);
188 my $repo = extract_reponame
($branch);
190 if (archive_reachable
($repo) &&
191 !defined $arch_branches{$branch}) {
192 $arch_branches{$branch} = $stage + 1;
196 warn "more metadata after merges!?: $_\n" unless /^\s*$/;
201 if (%ps && !exists $psets{ $ps{id
} }) {
202 my %temp = %ps; # break references
203 if (@psets && $psets[$#psets]{branch
} eq $ps{branch
}) {
204 $temp{parent_id
} = $psets[$#psets]{id
};
206 push (@psets, \
%temp);
207 $psets{ $temp{id
} } = \
%temp;
210 close ABROWSE
or die "$TLA abrowse failed on $limit\n";
212 } # end foreach $root
217 while ($depth <= $opt_D) {
222 ## Order patches by time
223 # FIXME see if we can find a more optimal way to do this by graphing
224 # the ancestry data and walking it, that way we won't have to rely on
225 # client-supplied dates
226 @psets = sort {$a->{date
}.$b->{id
} cmp $b->{date
}.$b->{id
}} @psets;
228 #print Dumper \@psets;
231 ## TODO cleanup irrelevant patches
232 ## and put an initial import
235 unless (-d
$git_dir) { # initial import
236 if ($psets[0]{type
} eq 'i' || $psets[0]{type
} eq 't') {
237 print "Starting import from $psets[0]{id}\n";
242 die "Need to start from an import or a tag -- cannot use $psets[0]{id}";
244 } else { # progressing an import
246 opendir(DIR
, $ptag_dir)
247 || die "can't opendir: $!";
248 while (my $file = readdir(DIR
)) {
249 # skip non-interesting-files
250 next unless -f
"$ptag_dir/$file";
252 # convert first '--' to '/' from old git-archimport to use
253 # as an archivename/c--b--v private tag
257 print STDERR
"converting old tag $oldfile to $file\n";
258 rename("$ptag_dir/$oldfile", "$ptag_dir/$file") or die $!;
260 my $sha = ptag
($file);
262 $rptags{$sha} = $file;
268 # extract the Arch repository name (Arch "archive" in Arch-speak)
269 sub extract_reponame
{
270 my $fq_cvbr = shift; # archivename/[[[[category]branch]version]revision]
271 return (split(/\//, $fq_cvbr))[0];
274 sub extract_versionname
{
276 $name =~ s/--(?:patch|version(?:fix)?|base)-\d+$//;
280 # convert a fully-qualified revision or version to a unique dirname:
281 # normalperson@yhbt.net-05/mpd--uclinux--1--patch-2
282 # becomes: normalperson@yhbt.net-05,mpd--uclinux--1
284 # the git notion of a branch is closer to
285 # archive/category--branch--version than archive/category--branch, so we
286 # use this to convert to git branch names.
287 # Also, keep archive names but replace '/' with ',' since it won't require
288 # subdirectories, and is safer than swapping '--' which could confuse
289 # reverse-mapping when dealing with bastard branches that
290 # are just archive/category--version (no --branch)
292 my $revision = shift;
293 my $name = extract_versionname
($revision);
298 # old versions of git-archimport just use the <category--branch> part:
299 sub old_style_branchname
{
301 my $ret = safe_pipe_capture
($TLA,'parse-package-name','-p',$id);
306 *git_branchname
= $opt_o ?
*old_style_branchname
: *tree_dirname
;
308 sub process_patchset_accurate
{
311 # switch to that branch if we're not already in that branch:
312 if (-e
"$git_dir/refs/heads/$ps->{branch}") {
313 system('git-checkout','-f',$ps->{branch
}) == 0 or die "$! $?\n";
315 # remove any old stuff that got leftover:
316 my $rm = safe_pipe_capture
('git-ls-files','--others','-z');
317 rmtree
(split(/\0/,$rm)) if $rm;
320 # Apply the import/changeset/merge into the working tree
321 my $dir = sync_to_ps
($ps);
322 # read the new log entry:
323 my @commitlog = safe_pipe_capture
($TLA,'cat-log','-d',$dir,$ps->{id
});
324 die "Error in cat-log: $!" if $?
;
327 # grab variables we want from the log, new fields get added to $ps:
328 # (author, date, email, summary, message body ...)
329 parselog
($ps, \
@commitlog);
331 if ($ps->{id
} =~ /--base-0$/ && $ps->{id
} ne $psets[0]{id
}) {
332 # this should work when importing continuations
333 if ($ps->{tag
} && (my $branchpoint = eval { ptag
($ps->{tag
}) })) {
335 # find where we are supposed to branch from
336 system('git-checkout','-f','-b',$ps->{branch
},
337 $branchpoint) == 0 or die "$! $?\n";
339 # remove any old stuff that got leftover:
340 my $rm = safe_pipe_capture
('git-ls-files','--others','-z');
341 rmtree
(split(/\0/,$rm)) if $rm;
343 # If we trust Arch with the fact that this is just
344 # a tag, and it does not affect the state of the tree
345 # then we just tag and move on
346 tag
($ps->{id
}, $branchpoint);
347 ptag
($ps->{id
}, $branchpoint);
348 print " * Tagged $ps->{id} at $branchpoint\n";
351 warn "Tagging from unknown id unsupported\n" if $ps->{tag
};
353 # allow multiple bases/imports here since Arch supports cherry-picks
354 # from unrelated trees
357 # update the index with all the changes we got
358 system('git-diff-files --name-only -z | '.
359 'git-update-index --remove -z --stdin') == 0 or die "$! $?\n";
360 system('git-ls-files --others -z | '.
361 'git-update-index --add -z --stdin') == 0 or die "$! $?\n";
365 # the native changeset processing strategy. This is very fast, but
366 # does not handle permissions or any renames involving directories
367 sub process_patchset_fast
{
370 # create the branch if needed
372 if ($ps->{type
} eq 'i' && !$import) {
373 die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";
376 unless ($import) { # skip for import
377 if ( -e
"$git_dir/refs/heads/$ps->{branch}") {
378 # we know about this branch
379 system('git-checkout',$ps->{branch
});
381 # new branch! we need to verify a few things
382 die "Branch on a non-tag!" unless $ps->{type
} eq 't';
383 my $branchpoint = ptag
($ps->{tag
});
384 die "Tagging from unknown id unsupported: $ps->{tag}"
387 # find where we are supposed to branch from
388 system('git-checkout','-b',$ps->{branch
},$branchpoint);
390 # If we trust Arch with the fact that this is just
391 # a tag, and it does not affect the state of the tree
392 # then we just tag and move on
393 tag
($ps->{id
}, $branchpoint);
394 ptag
($ps->{id
}, $branchpoint);
395 print " * Tagged $ps->{id} at $branchpoint\n";
402 # Apply the import/changeset/merge into the working tree
404 if ($ps->{type
} eq 'i' || $ps->{type
} eq 't') {
405 apply_import
($ps) or die $!;
406 $stats{import_or_tag
}++;
408 } elsif ($ps->{type
} eq 's') {
410 $stats{simple_changeset
}++;
414 # prepare update git's index, based on what arch knows
415 # about the pset, resolve parents, etc
418 my @commitlog = safe_pipe_capture
($TLA,'cat-archive-log',$ps->{id
});
419 die "Error in cat-archive-log: $!" if $?
;
421 parselog
($ps,\
@commitlog);
423 # imports don't give us good info
424 # on added files. Shame on them
425 if ($ps->{type
} eq 'i' || $ps->{type
} eq 't') {
426 system('git-ls-files --deleted -z | '.
427 'git-update-index --remove -z --stdin') == 0 or die "$! $?\n";
428 system('git-ls-files --others -z | '.
429 'git-update-index --add -z --stdin') == 0 or die "$! $?\n";
432 # TODO: handle removed_directories and renamed_directories:
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 $add = $ps->{new_files
}) {
466 my @slice = splice(@
$add, 0, 100);
467 system('git-update-index','--add','--',@slice) == 0 or
468 die "Error in git-update-index --add: $! $?\n";
472 if (my $mod = $ps->{modified_files
}) {
474 my @slice = splice(@
$mod, 0, 100);
475 system('git-update-index','--',@slice) == 0 or
476 die "Error in git-update-index: $! $?\n";
479 return 1; # we successfully applied the changeset
483 print "Will import patchsets using the fast strategy\n",
484 "Renamed directories and permission changes will be missed\n";
485 *process_patchset
= *process_patchset_fast
;
487 print "Using the default (accurate) import strategy.\n",
488 "Things may be a bit slow\n";
489 *process_patchset
= *process_patchset_accurate
;
492 foreach my $ps (@psets) {
494 $ps->{branch
} = git_branchname
($ps->{id
});
497 # ensure we have a clean state
499 if (my $dirty = `git-diff-files`) {
500 die "Unclean tree when about to process $ps->{id} " .
501 " - did we fail to commit cleanly before?\n$dirty";
506 # skip commits already in repo
508 if (ptag
($ps->{id
})) {
509 $opt_v && print " * Skipping already imported: $ps->{id}\n";
513 print " * Starting to work on $ps->{id}\n";
515 process_patchset
($ps) or next;
517 # warn "errors when running git-update-index! $!";
518 my $tree = `git-write-tree`;
519 die "cannot write tree $!" if $?
;
526 if ( -e
"$git_dir/refs/heads/$ps->{branch}") {
527 if (open HEAD
, "<","$git_dir/refs/heads/$ps->{branch}") {
533 if ($ps->{type
} eq 's') {
534 warn "Could not find the right head for the branch $ps->{branch}";
540 push @par, find_parents
($ps);
544 # Commit, tag and clean state
547 $ENV{GIT_AUTHOR_NAME
} = $ps->{author
};
548 $ENV{GIT_AUTHOR_EMAIL
} = $ps->{email
};
549 $ENV{GIT_AUTHOR_DATE
} = $ps->{date
};
550 $ENV{GIT_COMMITTER_NAME
} = $ps->{author
};
551 $ENV{GIT_COMMITTER_EMAIL
} = $ps->{email
};
552 $ENV{GIT_COMMITTER_DATE
} = $ps->{date
};
554 my $pid = open2
(*READER
, *WRITER
,'git-commit-tree',$tree,@par)
556 print WRITER
$ps->{summary
},"\n";
557 print WRITER
$ps->{message
},"\n";
559 # make it easy to backtrack and figure out which Arch revision this was:
560 print WRITER
'git-archimport-id: ',$ps->{id
},"\n";
563 my $commitid = <READER
>; # read
566 waitpid $pid,0; # close;
568 if (length $commitid != 40) {
569 die "Something went wrong with the commit! $! $commitid";
574 open HEAD
, ">","$git_dir/refs/heads/$ps->{branch}";
575 print HEAD
$commitid;
577 system('git-update-ref', 'HEAD', "$ps->{branch}");
580 ptag
($ps->{id
}, $commitid); # private tag
581 if ($opt_T || $ps->{type
} eq 't' || $ps->{type
} eq 'i') {
582 tag
($ps->{id
}, $commitid);
584 print " * Committed $ps->{id}\n";
585 print " + tree $tree\n";
586 print " + commit $commitid\n";
587 $opt_v && print " + commit date is $ps->{date} \n";
588 $opt_v && print " + parents: ",join(' ',@par),"\n";
592 foreach (sort keys %stats) {
593 print" $_: $stats{$_}\n";
598 # used by the accurate strategy:
601 my $tree_dir = $tmp.'/'.tree_dirname
($ps->{id
});
603 $opt_v && print "sync_to_ps($ps->{id}) method: ";
606 if ($ps->{type
} eq 't') {
607 $opt_v && print "get (tag)\n";
608 # looks like a tag-only or (worse,) a mixed tags/changeset branch,
609 # can't rely on replay to work correctly on these
611 safe_pipe_capture
($TLA,'get','--no-pristine',$ps->{id
},$tree_dir);
614 my $tree_id = arch_tree_id
($tree_dir);
615 if ($ps->{parent_id
} && ($ps->{parent_id
} eq $tree_id)) {
616 # the common case (hopefully)
617 $opt_v && print "replay\n";
618 safe_pipe_capture
($TLA,'replay','-d',$tree_dir,$ps->{id
});
621 # getting one tree is usually faster than getting two trees
622 # and applying the delta ...
624 $opt_v && print "apply-delta\n";
625 safe_pipe_capture
($TLA,'get','--no-pristine',
626 $ps->{id
},$tree_dir);
632 $opt_v && print "get (new tree)\n";
633 safe_pipe_capture
($TLA,'get','--no-pristine',$ps->{id
},$tree_dir);
637 # added -I flag to rsync since we're going to fast! AIEEEEE!!!!
638 system('rsync','-aI','--delete','--exclude',$git_dir,
639 # '--exclude','.arch-inventory',
640 '--exclude','.arch-ids','--exclude','{arch}',
641 '--exclude','+*','--exclude',',*',
642 "$tree_dir/",'./') == 0 or die "Cannot rsync $tree_dir: $! $?";
648 my $bname = git_branchname
($ps->{id
});
652 safe_pipe_capture
($TLA,'get','-s','--no-pristine',$ps->{id
},"$tmp/import");
653 die "Cannot get import: $!" if $?
;
654 system('rsync','-aI','--delete', '--exclude',$git_dir,
655 '--exclude','.arch-ids','--exclude','{arch}',
656 "$tmp/import/", './');
657 die "Cannot rsync import:$!" if $?
;
659 rmtree
("$tmp/import");
660 die "Cannot remove tempdir: $!" if $?
;
672 safe_pipe_capture
($TLA,'get-changeset',$ps->{id
},"$tmp/changeset");
673 die "Cannot get changeset: $!" if $?
;
676 if (`find $tmp/changeset/patches -type f -name '*.patch'`) {
677 # this can be sped up considerably by doing
678 # (find | xargs cat) | patch
679 # but that can get mucked up by patches
680 # with missing trailing newlines or the standard
681 # 'missing newline' flag in the patch - possibly
682 # produced with an old/buggy diff.
683 # slow and safe, we invoke patch once per patchfile
684 `find $tmp/changeset/patches -type f -name '*.patch' -print0 | grep -zv '{arch}' | xargs -iFILE -0 --no-run-if-empty patch -p1 --forward -iFILE`;
685 die "Problem applying patches! $!" if $?
;
688 # apply changed binary files
689 if (my @modified = `find $tmp/changeset/patches -type f -name '*.modified'`) {
690 foreach my $mod (@modified) {
693 $orig =~ s/\.modified$//; # lazy
694 $orig =~ s!^\Q$tmp\E/changeset/patches/!!;
695 #print "rsync -p '$mod' '$orig'";
696 system('rsync','-p',$mod,"./$orig");
697 die "Problem applying binary changes! $!" if $?
;
702 system('rsync','-aI','--exclude',$git_dir,
703 '--exclude','.arch-ids',
704 '--exclude', '{arch}',
705 "$tmp/changeset/new-files-archive/",'./');
707 # deleted files are hinted from the commitlog processing
709 rmtree
("$tmp/changeset");
714 # notes: *-files/-directories keys cannot have spaces, they're always
715 # pika-escaped. Everything after the first newline
716 # A log entry looks like:
717 # Revision: moodle-org--moodle--1.3.3--patch-15
718 # Archive: arch-eduforge@catalyst.net.nz--2004
719 # Creator: Penny Leach <penny@catalyst.net.nz>
720 # Date: Wed May 25 14:15:34 NZST 2005
721 # Standard-date: 2005-05-25 02:15:34 GMT
722 # New-files: lang/de/.arch-ids/block_glossary_random.php.id
723 # lang/de/.arch-ids/block_html.php.id
724 # New-directories: lang/de/help/questionnaire
725 # lang/de/help/questionnaire/.arch-ids
726 # Renamed-files: .arch-ids/db_sears.sql.id db/.arch-ids/db_sears.sql.id
727 # db_sears.sql db/db_sears.sql
728 # Removed-files: lang/be/docs/.arch-ids/release.html.id
729 # lang/be/docs/.arch-ids/releaseold.html.id
730 # Modified-files: admin/cron.php admin/delete.php
731 # admin/editor.html backup/lib.php backup/restore.php
732 # New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15
733 # Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+)
734 # summary can be multiline with a leading space just like the above fields
737 # Updating yadda tadda tadda madda
742 # headers we want that contain filenames:
747 renamed_directories
=> 1,
749 removed_directories
=> 1,
753 while ($_ = shift @
$log) {
754 if (/^Continuation-of:\s*(.*)/) {
757 } elsif (/^Summary:\s*(.*)$/ ) {
758 # summary can be multiline as long as it has a leading space
759 $ps->{summary
} = [ $1 ];
761 } elsif (/^Creator: (.*)\s*<([^\>]+)>/) {
765 # any *-files or *-directories can be read here:
766 } elsif (/^([A-Z][a-z\-]+):\s*(.*)$/) {
769 $key =~ tr/-/_/; # too lazy to quote :P
770 if ($want_headers{$key}) {
771 push @
{$ps->{$key}}, split(/\s+/, $val);
776 last; # remainder of @$log that didn't get shifted off is message
779 if ($key eq 'summary') {
780 push @
{$ps->{$key}}, $1;
781 } else { # files/directories:
782 push @
{$ps->{$key}}, split(/\s+/, $1);
791 $ps->{summary
} = join("\n",@
{$ps->{summary
}})."\n";
792 $ps->{message
} = join("\n",@
$log);
794 # skip Arch control files, unescape pika-escaped files
795 foreach my $k (keys %want_headers) {
796 next unless (defined $ps->{$k});
798 foreach my $t (@
{$ps->{$k}}) {
799 next unless length ($t);
800 next if $t =~ m!\{arch\}/!;
801 next if $t =~ m!\.arch-ids/!;
802 # should we skip this?
803 next if $t =~ m!\.arch-inventory$!;
804 # tla cat-archive-log will give us filenames with spaces as file\(sp)name - why?
805 # we can assume that any filename with \ indicates some pika escaping that we want to get rid of.
807 $t = (safe_pipe_capture
($TLA,'escape','--unescaped',$t))[0];
817 my ($tag, $commit) = @_;
822 # don't use subdirs for tags yet, it could screw up other porcelains
827 open(C
,">","$git_dir/refs/tags/$tag")
828 or die "Cannot create tag $tag: $!\n";
830 or die "Cannot write tag $tag: $!\n";
832 or die "Cannot write tag $tag: $!\n";
833 print " * Created tag '$tag' on '$commit'\n" if $opt_v;
835 open(C
,"<","$git_dir/refs/tags/$tag")
836 or die "Cannot read tag $tag: $!\n";
839 die "Error reading tag $tag: $!\n" unless length $commit == 40;
841 or die "Cannot read tag $tag: $!\n";
846 # write/read a private tag
847 # reads fail softly if the tag isn't there
849 my ($tag, $commit) = @_;
851 # don't use subdirs for tags yet, it could screw up other porcelains
854 my $tag_file = "$ptag_dir/$tag";
855 my $tag_branch_dir = dirname
($tag_file);
856 mkpath
($tag_branch_dir) unless (-d
$tag_branch_dir);
858 if ($commit) { # write
859 open(C
,">",$tag_file)
860 or die "Cannot create tag $tag: $!\n";
862 or die "Cannot write tag $tag: $!\n";
864 or die "Cannot write tag $tag: $!\n";
865 $rptags{$commit} = $tag
866 unless $tag =~ m/--base-0$/;
868 # if the tag isn't there, return 0
869 unless ( -s
$tag_file) {
872 open(C
,"<",$tag_file)
873 or die "Cannot read tag $tag: $!\n";
876 die "Error reading tag $tag: $!\n" unless length $commit == 40;
878 or die "Cannot read tag $tag: $!\n";
879 unless (defined $rptags{$commit}) {
880 $rptags{$commit} = $tag;
888 # Identify what branches are merging into me
889 # and whether we are fully merged
890 # git-merge-base <headsha> <headsha> should tell
891 # me what the base of the merge should be
895 my %branches; # holds an arrayref per branch
896 # the arrayref contains a list of
897 # merged patches between the base
898 # of the merge and the current head
900 my @parents; # parents found for this commit
902 # simple loop to split the merges
904 foreach my $merge (@
{$ps->{merges
}}) {
905 my $branch = git_branchname
($merge);
906 unless (defined $branches{$branch} ){
907 $branches{$branch} = [];
909 push @
{$branches{$branch}}, $merge;
913 # foreach branch find a merge base and walk it to the
914 # head where we are, collecting the merged patchsets that
915 # Arch has recorded. Keep that in @have
916 # Compare that with the commits on the other branch
917 # between merge-base and the tip of the branch (@need)
918 # and see if we have a series of consecutive patches
919 # starting from the merge base. The tip of the series
920 # of consecutive patches merged is our new parent for
923 foreach my $branch (keys %branches) {
925 # check that we actually know about the branch
926 next unless -e
"$git_dir/refs/heads/$branch";
928 my $mergebase = `git-merge-base $branch $ps->{branch}`;
930 # Don't die here, Arch supports one-way cherry-picking
931 # between branches with no common base (or any relationship
933 warn "Cannot find merge base for $branch and $ps->{branch}";
938 # now walk up to the mergepoint collecting what patches we have
939 my $branchtip = git_rev_parse
($ps->{branch
});
940 my @ancestors = `git-rev-list --topo-order $branchtip ^$mergebase`;
941 my %have; # collected merges this branch has
942 foreach my $merge (@
{$ps->{merges
}}) {
946 foreach my $par (@ancestors) {
947 $par = commitid2pset
($par);
948 if (defined $par->{merges
}) {
949 foreach my $merge (@
{$par->{merges
}}) {
950 $ancestorshave{$merge}=1;
954 # print "++++ Merges in $ps->{id} are....\n";
955 # my @have = sort keys %have; print Dumper(\@have);
957 # merge what we have with what ancestors have
958 %have = (%have, %ancestorshave);
960 # see what the remote branch has - these are the merges we
961 # will want to have in a consecutive series from the mergebase
962 my $otherbranchtip = git_rev_parse
($branch);
963 my @needraw = `git-rev-list --topo-order $otherbranchtip ^$mergebase`;
965 foreach my $needps (@needraw) { # get the psets
966 $needps = commitid2pset
($needps);
967 # git-rev-list will also
968 # list commits merged in via earlier
969 # merges. we are only interested in commits
970 # from the branch we're looking at
971 if ($branch eq $needps->{branch
}) {
972 push @need, $needps->{id
};
976 # print "++++ Merges from $branch we want are....\n";
977 # print Dumper(\@need);
980 while (my $needed_commit = pop @need) {
981 if ($have{$needed_commit}) {
982 $newparent = $needed_commit;
984 last; # break out of the while
988 push @parents, $newparent;
992 } # end foreach branch
994 # prune redundant parents
996 foreach my $p (@parents) {
999 foreach my $p (@parents) {
1000 next unless exists $psets{$p}{merges
};
1001 next unless ref $psets{$p}{merges
};
1002 my @merges = @
{$psets{$p}{merges
}};
1003 foreach my $merge (@merges) {
1004 if ($parents{$merge}) {
1005 delete $parents{$merge};
1011 foreach (keys %parents) {
1012 push @parents, '-p', ptag
($_);
1019 my $val = `git-rev-parse $name`;
1020 die "Error: git-rev-parse $name" if $?
;
1025 # resolve a SHA1 to a known patchset
1027 my $commitid = shift;
1029 my $name = $rptags{$commitid}
1030 || die "Cannot find reverse tag mapping for $commitid";
1032 my $ps = $psets{$name}
1033 || (print Dumper
(sort keys %psets)) && die "Cannot find patchset for $name";
1038 # an alternative to `command` that allows input to be passed as an array
1039 # to work around shell problems with weird characters in arguments
1040 sub safe_pipe_capture
{
1042 if (my $pid = open my $child, '-|') {
1043 @output = (<$child>);
1044 close $child or die join(' ',@_).": $! $?";
1046 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
1048 return wantarray ?
@output : join('',@output);
1051 # `tla logs -rf -d <dir> | head -n1` or `baz tree-id <dir>`
1054 chomp( my $ret = (safe_pipe_capture
($TLA,'logs','-rf','-d',$dir))[0] );
1058 sub archive_reachable
{
1059 my $archive = shift;
1060 return 1 if $reachable{$archive};
1061 return 0 if $unreachable{$archive};
1063 if (system "$TLA whereis-archive $archive >/dev/null") {
1064 if ($opt_a && (system($TLA,'register-archive',
1065 "http://mirrors.sourcecontrol.net/$archive") == 0)) {
1066 $reachable{$archive} = 1;
1069 print STDERR
"Archive is unreachable: $archive\n";
1070 $unreachable{$archive} = 1;
1073 $reachable{$archive} = 1;