165c4b1365
Make the usage string consistent with Git. Reviewed-by: Jonathan Nieder <jrnieder@gmail.com> Signed-off-by: David Aguilar <davvid@gmail.com> Signed-off-by: Junio C Hamano <gitster@pobox.com>
1135 lines
36 KiB
Perl
Executable File
1135 lines
36 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# This tool is copyright (c) 2005, Martin Langhoff.
|
|
# It is released under the Gnu Public License, version 2.
|
|
#
|
|
# The basic idea is to walk the output of tla abrowse,
|
|
# fetch the changesets and apply them.
|
|
#
|
|
|
|
=head1 Invocation
|
|
|
|
git archimport [ -h ] [ -v ] [ -o ] [ -a ] [ -f ] [ -T ]
|
|
[ -D depth] [ -t tempdir ] <archive>/<branch> [ <archive>/<branch> ]
|
|
|
|
Imports a project from one or more Arch repositories. It will follow branches
|
|
and repositories within the namespaces defined by the <archive/branch>
|
|
parameters supplied. If it cannot find the remote branch a merge comes from
|
|
it will just import it as a regular commit. If it can find it, it will mark it
|
|
as a merge whenever possible.
|
|
|
|
See man (1) git-archimport for more details.
|
|
|
|
=head1 TODO
|
|
|
|
- create tag objects instead of ref tags
|
|
- audit shell-escaping of filenames
|
|
- hide our private tags somewhere smarter
|
|
- find a way to make "cat *patches | patch" safe even when patchfiles are missing newlines
|
|
- sort and apply patches by graphing ancestry relations instead of just
|
|
relying in dates supplied in the changeset itself.
|
|
tla ancestry-graph -m could be helpful here...
|
|
|
|
=head1 Devel tricks
|
|
|
|
Add print in front of the shell commands invoked via backticks.
|
|
|
|
=head1 Devel Notes
|
|
|
|
There are several places where Arch and git terminology are intermixed
|
|
and potentially confused.
|
|
|
|
The notion of a "branch" in git is approximately equivalent to
|
|
a "archive/category--branch--version" in Arch. Also, it should be noted
|
|
that the "--branch" portion of "archive/category--branch--version" is really
|
|
optional in Arch although not many people (nor tools!) seem to know this.
|
|
This means that "archive/category--version" is also a valid "branch"
|
|
in git terms.
|
|
|
|
We always refer to Arch names by their fully qualified variant (which
|
|
means the "archive" name is prefixed.
|
|
|
|
For people unfamiliar with Arch, an "archive" is the term for "repository",
|
|
and can contain multiple, unrelated branches.
|
|
|
|
=cut
|
|
|
|
use 5.008;
|
|
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;
|
|
usage: git archimport # fetch/update GIT from Arch
|
|
[ -h ] [ -v ] [ -o ] [ -a ] [ -f ] [ -T ] [ -D depth ] [ -t tempdir ]
|
|
repository/arch-branch [ repository/arch-branch] ...
|
|
END
|
|
exit(1);
|
|
}
|
|
|
|
getopts("fThvat:D:") or usage();
|
|
usage if $opt_h;
|
|
|
|
@ARGV >= 1 or usage();
|
|
# $arch_branches:
|
|
# values associated with keys:
|
|
# =1 - Arch version / git 'branch' detected via abrowse on a limit
|
|
# >1 - Arch version / git 'branch' of an auxiliary branch we've merged
|
|
my %arch_branches = map { my $branch = $_; $branch =~ s/:[^:]*$//; $branch => 1 } @ARGV;
|
|
|
|
# $branch_name_map:
|
|
# maps arch branches to git branch names
|
|
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++;
|
|
}
|
|
|
|
## Order patches by time
|
|
# FIXME see if we can find a more optimal way to do this by graphing
|
|
# the ancestry data and walking it, that way we won't have to rely on
|
|
# client-supplied dates
|
|
@psets = sort {$a->{date}.$b->{id} cmp $b->{date}.$b->{id}} @psets;
|
|
|
|
#print Dumper \@psets;
|
|
|
|
##
|
|
## TODO cleanup irrelevant patches
|
|
## and put an initial import
|
|
## or a full tag
|
|
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;
|
|
}
|
|
|
|
# process patchsets
|
|
# extract the Arch repository name (Arch "archive" in Arch-speak)
|
|
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;
|
|
}
|
|
|
|
# convert a fully-qualified revision or version to a unique dirname:
|
|
# normalperson@yhbt.net-05/mpd--uclinux--1--patch-2
|
|
# becomes: normalperson@yhbt.net-05,mpd--uclinux--1
|
|
#
|
|
# the git notion of a branch is closer to
|
|
# archive/category--branch--version than archive/category--branch, so we
|
|
# use this to convert to git branch names.
|
|
# Also, keep archive names but replace '/' with ',' since it won't require
|
|
# subdirectories, and is safer than swapping '--' which could confuse
|
|
# reverse-mapping when dealing with bastard branches that
|
|
# are just archive/category--version (no --branch)
|
|
sub tree_dirname {
|
|
my $revision = shift;
|
|
my $name = extract_versionname($revision);
|
|
$name =~ s#/#,#;
|
|
return $name;
|
|
}
|
|
|
|
# old versions of git-archimport just use the <category--branch> part:
|
|
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;
|
|
|
|
# retrieve default archive, since $branch_name_map keys might not include it
|
|
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;
|
|
}
|
|
|
|
# the native changeset processing strategy. This is very fast, but
|
|
# does not handle permissions or any renames involving directories
|
|
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;
|
|
|
|
# used by the accurate strategy:
|
|
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-inventory',
|
|
'--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");
|
|
}
|
|
|
|
|
|
# =for reference
|
|
# notes: *-files/-directories keys cannot have spaces, they're always
|
|
# pika-escaped. Everything after the first newline
|
|
# A log entry looks like:
|
|
# Revision: moodle-org--moodle--1.3.3--patch-15
|
|
# Archive: arch-eduforge@catalyst.net.nz--2004
|
|
# Creator: Penny Leach <penny@catalyst.net.nz>
|
|
# Date: Wed May 25 14:15:34 NZST 2005
|
|
# Standard-date: 2005-05-25 02:15:34 GMT
|
|
# New-files: lang/de/.arch-ids/block_glossary_random.php.id
|
|
# lang/de/.arch-ids/block_html.php.id
|
|
# New-directories: lang/de/help/questionnaire
|
|
# lang/de/help/questionnaire/.arch-ids
|
|
# Renamed-files: .arch-ids/db_sears.sql.id db/.arch-ids/db_sears.sql.id
|
|
# db_sears.sql db/db_sears.sql
|
|
# Removed-files: lang/be/docs/.arch-ids/release.html.id
|
|
# lang/be/docs/.arch-ids/releaseold.html.id
|
|
# Modified-files: admin/cron.php admin/delete.php
|
|
# admin/editor.html backup/lib.php backup/restore.php
|
|
# New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15
|
|
# Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+)
|
|
# summary can be multiline with a leading space just like the above fields
|
|
# Keywords:
|
|
#
|
|
# Updating yadda tadda tadda madda
|
|
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;
|
|
}
|
|
}
|
|
|
|
# write/read a tag
|
|
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;
|
|
}
|
|
}
|
|
|
|
# write/read a private tag
|
|
# reads fail softly if the tag isn't there
|
|
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;
|
|
}
|
|
my %ancestorshave;
|
|
foreach my $par (@ancestors) {
|
|
$par = commitid2pset($par);
|
|
if (defined $par->{merges}) {
|
|
foreach my $merge (@{$par->{merges}}) {
|
|
$ancestorshave{$merge}=1;
|
|
}
|
|
}
|
|
}
|
|
# print "++++ Merges in $ps->{id} are....\n";
|
|
# my @have = sort keys %have; print Dumper(\@have);
|
|
|
|
# merge what we have with what ancestors have
|
|
%have = (%have, %ancestorshave);
|
|
|
|
# see what the remote branch has - these are the merges we
|
|
# will want to have in a consecutive series from the mergebase
|
|
my $otherbranchtip = git_rev_parse($branch);
|
|
my @needraw = `git-rev-list --topo-order $otherbranchtip ^$mergebase`;
|
|
my @need;
|
|
foreach my $needps (@needraw) { # get the psets
|
|
$needps = commitid2pset($needps);
|
|
# git-rev-list will also
|
|
# list commits merged in via earlier
|
|
# merges. we are only interested in commits
|
|
# from the branch we're looking at
|
|
if ($branch eq $needps->{branch}) {
|
|
push @need, $needps->{id};
|
|
}
|
|
}
|
|
|
|
# print "++++ Merges from $branch we want are....\n";
|
|
# print Dumper(\@need);
|
|
|
|
my $newparent;
|
|
while (my $needed_commit = pop @need) {
|
|
if ($have{$needed_commit}) {
|
|
$newparent = $needed_commit;
|
|
} else {
|
|
last; # break out of the while
|
|
}
|
|
}
|
|
if ($newparent) {
|
|
push @parents, $newparent;
|
|
}
|
|
|
|
|
|
} # end foreach branch
|
|
|
|
# prune redundant parents
|
|
my %parents;
|
|
foreach my $p (@parents) {
|
|
$parents{$p} = 1;
|
|
}
|
|
foreach my $p (@parents) {
|
|
next unless exists $psets{$p}{merges};
|
|
next unless ref $psets{$p}{merges};
|
|
my @merges = @{$psets{$p}{merges}};
|
|
foreach my $merge (@merges) {
|
|
if ($parents{$merge}) {
|
|
delete $parents{$merge};
|
|
}
|
|
}
|
|
}
|
|
|
|
@parents = ();
|
|
foreach (keys %parents) {
|
|
push @parents, '-p', ptag($_);
|
|
}
|
|
return @parents;
|
|
}
|
|
|
|
sub git_rev_parse {
|
|
my $name = shift;
|
|
my $val = `git-rev-parse $name`;
|
|
die "Error: git-rev-parse $name" if $?;
|
|
chomp $val;
|
|
return $val;
|
|
}
|
|
|
|
# resolve a SHA1 to a known patchset
|
|
sub commitid2pset {
|
|
my $commitid = shift;
|
|
chomp $commitid;
|
|
my $name = $rptags{$commitid}
|
|
|| die "Cannot find reverse tag mapping for $commitid";
|
|
$name =~ s|,|/|;
|
|
my $ps = $psets{$name}
|
|
|| (print Dumper(sort keys %psets)) && die "Cannot find patchset for $name";
|
|
return $ps;
|
|
}
|
|
|
|
|
|
# an alternative to `command` that allows input to be passed as an array
|
|
# to work around shell problems with weird characters in arguments
|
|
sub safe_pipe_capture {
|
|
my @output;
|
|
if (my $pid = open my $child, '-|') {
|
|
@output = (<$child>);
|
|
close $child or die join(' ',@_).": $! $?";
|
|
} else {
|
|
exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
|
|
}
|
|
return wantarray ? @output : join('',@output);
|
|
}
|
|
|
|
# `tla logs -rf -d <dir> | head -n1` or `baz tree-id <dir>`
|
|
sub arch_tree_id {
|
|
my $dir = shift;
|
|
chomp( my $ret = (safe_pipe_capture($TLA,'logs','-rf','-d',$dir))[0] );
|
|
return $ret;
|
|
}
|
|
|
|
sub archive_reachable {
|
|
my $archive = shift;
|
|
return 1 if $reachable{$archive};
|
|
return 0 if $unreachable{$archive};
|
|
|
|
if (system "$TLA whereis-archive $archive >/dev/null") {
|
|
if ($opt_a && (system($TLA,'register-archive',
|
|
"http://mirrors.sourcecontrol.net/$archive") == 0)) {
|
|
$reachable{$archive} = 1;
|
|
return 1;
|
|
}
|
|
print STDERR "Archive is unreachable: $archive\n";
|
|
$unreachable{$archive} = 1;
|
|
return 0;
|
|
} else {
|
|
$reachable{$archive} = 1;
|
|
return 1;
|
|
}
|
|
}
|