blob: 9cb123a07df88c975cf1b0d6c5832cb410175dd0 [file] [log] [blame]
Ævar Arnfjörð Bjarmason3328ace2010-09-24 20:00:53 +00001#!/usr/bin/perl
Martin Langhoffd3968362005-08-30 21:56:52 +12002#
3# This tool is copyright (c) 2005, Martin Langhoff.
4# It is released under the Gnu Public License, version 2.
5#
Junio C Hamanoa6080a02007-06-07 00:04:01 -07006# The basic idea is to walk the output of tla abrowse,
7# fetch the changesets and apply them.
Martin Langhoffd3968362005-08-30 21:56:52 +12008#
martin@catalyst.net.nz241b5962005-09-11 21:26:05 +12009
Martin Langhoffd3968362005-08-30 21:56:52 +120010=head1 Invocation
11
Stephan Beyer1b1dd232008-07-13 15:36:15 +020012 git archimport [ -h ] [ -v ] [ -o ] [ -a ] [ -f ] [ -T ]
Junio C Hamanoa6080a02007-06-07 00:04:01 -070013 [ -D depth] [ -t tempdir ] <archive>/<branch> [ <archive>/<branch> ]
Martin Langhoffd3968362005-08-30 21:56:52 +120014
martin@catalyst.net.nz241b5962005-09-11 21:26:05 +120015Imports a project from one or more Arch repositories. It will follow branches
16and repositories within the namespaces defined by the <archive/branch>
Pavel Roskin82e5a822006-07-10 01:50:18 -040017parameters supplied. If it cannot find the remote branch a merge comes from
Junio C Hamanoa6080a02007-06-07 00:04:01 -070018it will just import it as a regular commit. If it can find it, it will mark it
martin@catalyst.net.nz241b5962005-09-11 21:26:05 +120019as a merge whenever possible.
Martin Langhoffd3968362005-08-30 21:56:52 +120020
martin@catalyst.net.nz241b5962005-09-11 21:26:05 +120021See man (1) git-archimport for more details.
Martin Langhoffd3968362005-08-30 21:56:52 +120022
martin@catalyst.net.nz241b5962005-09-11 21:26:05 +120023=head1 TODO
Martin Langhoffd3968362005-08-30 21:56:52 +120024
martin@catalyst.net.nz241b5962005-09-11 21:26:05 +120025 - create tag objects instead of ref tags
Martin Langhoffd3968362005-08-30 21:56:52 +120026 - audit shell-escaping of filenames
martin@catalyst.net.nz241b5962005-09-11 21:26:05 +120027 - hide our private tags somewhere smarter
Junio C Hamanoa6080a02007-06-07 00:04:01 -070028 - find a way to make "cat *patches | patch" safe even when patchfiles are missing newlines
Eric Wong3e525e62005-11-23 23:55:04 -080029 - 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...
Martin Langhoffd3968362005-08-30 21:56:52 +120032
33=head1 Devel tricks
34
Junio C Hamanoa6080a02007-06-07 00:04:01 -070035Add print in front of the shell commands invoked via backticks.
Martin Langhoffd3968362005-08-30 21:56:52 +120036
Eric Wong22ff00f2005-11-12 01:29:20 -080037=head1 Devel Notes
38
39There are several places where Arch and git terminology are intermixed
40and potentially confused.
41
42The notion of a "branch" in git is approximately equivalent to
43a "archive/category--branch--version" in Arch. Also, it should be noted
44that the "--branch" portion of "archive/category--branch--version" is really
45optional in Arch although not many people (nor tools!) seem to know this.
46This means that "archive/category--version" is also a valid "branch"
47in git terms.
48
49We always refer to Arch names by their fully qualified variant (which
50means the "archive" name is prefixed.
51
52For people unfamiliar with Arch, an "archive" is the term for "repository",
53and can contain multiple, unrelated branches.
54
Martin Langhoffd3968362005-08-30 21:56:52 +120055=cut
56
Ævar Arnfjörð Bjarmasond48b2842010-09-24 20:00:52 +000057use 5.008;
Martin Langhoffd3968362005-08-30 21:56:52 +120058use strict;
59use warnings;
60use Getopt::Std;
Eric Wong42f44b02005-11-23 23:52:43 -080061use File::Temp qw(tempdir);
Eric Wongf88961a2005-11-23 23:48:57 -080062use File::Path qw(mkpath rmtree);
Martin Langhoffd3968362005-08-30 21:56:52 +120063use File::Basename qw(basename dirname);
Martin Langhoffd3968362005-08-30 21:56:52 +120064use Data::Dumper qw/ Dumper /;
65use IPC::Open2;
66
67$SIG{'PIPE'}="IGNORE";
68$ENV{'TZ'}="UTC";
69
martin@catalyst.net.nz1d4710d2005-09-11 21:26:05 +120070my $git_dir = $ENV{"GIT_DIR"} || ".git";
71$ENV{"GIT_DIR"} = $git_dir;
Eric Wonga7fb51d2005-11-12 01:25:33 -080072my $ptag_dir = "$git_dir/archimport/tags";
martin@catalyst.net.nz1d4710d2005-09-11 21:26:05 +120073
Eric Wong3e525e62005-11-23 23:55:04 -080074our($opt_h,$opt_f,$opt_v,$opt_T,$opt_t,$opt_D,$opt_a,$opt_o);
Martin Langhoffd3968362005-08-30 21:56:52 +120075
76sub usage() {
77 print STDERR <<END;
David Aguilar165c4b12013-02-23 16:50:13 -080078usage: git archimport # fetch/update GIT from Arch
Eric Wong42f45702005-12-18 17:23:50 -080079 [ -h ] [ -v ] [ -o ] [ -a ] [ -f ] [ -T ] [ -D depth ] [ -t tempdir ]
Martin Langhoffd3968362005-08-30 21:56:52 +120080 repository/arch-branch [ repository/arch-branch] ...
81END
82 exit(1);
83}
84
Eric Wong3e525e62005-11-23 23:55:04 -080085getopts("fThvat:D:") or usage();
Martin Langhoffd3968362005-08-30 21:56:52 +120086usage if $opt_h;
87
88@ARGV >= 1 or usage();
Eric Wong42f44b02005-11-23 23:52:43 -080089# $arch_branches:
90# values associated with keys:
91# =1 - Arch version / git 'branch' detected via abrowse on a limit
Pavel Roskin82e5a822006-07-10 01:50:18 -040092# >1 - Arch version / git 'branch' of an auxiliary branch we've merged
Paolo Bonzinid9cb5392007-03-07 10:43:41 +010093my %arch_branches = map { my $branch = $_; $branch =~ s/:[^:]*$//; $branch => 1 } @ARGV;
94
95# $branch_name_map:
96# maps arch branches to git branch names
97my %branch_name_map = map { m/^(.*):([^:]*)$/; $1 => $2 } grep { m/:/ } @ARGV;
Martin Langhoffd3968362005-08-30 21:56:52 +120098
Eric Wong5744f272005-11-23 23:50:27 -080099$ENV{'TMPDIR'} = $opt_t if $opt_t; # $ENV{TMPDIR} will affect tempdir() calls:
100my $tmp = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
martin@catalyst.net.nz127bf002005-09-11 21:26:05 +1200101$opt_v && print "+ Using $tmp as temporary directory\n";
Martin Langhoffd3968362005-08-30 21:56:52 +1200102
Gerrit Pape11dbe9e2007-02-03 22:38:59 +0000103unless (-d $git_dir) { # initial import needs empty directory
104 opendir DIR, '.' or die "Unable to open current directory: $!\n";
105 while (my $entry = readdir DIR) {
106 $entry =~ /^\.\.?$/ or
107 die "Initial import needs an empty current working directory.\n"
108 }
109 closedir DIR
110}
111
Paolo Bonzinid9cb5392007-03-07 10:43:41 +0100112my $default_archive; # default Arch archive
Eric Wong42f44b02005-11-23 23:52:43 -0800113my %reachable = (); # Arch repositories we can access
114my %unreachable = (); # Arch repositories we can't access :<
Martin Langhoffd3968362005-08-30 21:56:52 +1200115my @psets = (); # the collection
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200116my %psets = (); # the collection, by name
Eric Wong3e525e62005-11-23 23:55:04 -0800117my %stats = ( # Track which strategy we used to import:
118 get_tag => 0, replay => 0, get_new => 0, get_delta => 0,
119 simple_changeset => 0, import_or_tag => 0
120);
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200121
122my %rptags = (); # my reverse private tags
123 # to map a SHA1 to a commitid
Eric Wong2777ef72005-11-23 23:47:39 -0800124my $TLA = $ENV{'ARCH_CLIENT'} || 'tla';
Martin Langhoffd3968362005-08-30 21:56:52 +1200125
Eric Wong42f44b02005-11-23 23:52:43 -0800126sub do_abrowse {
127 my $stage = shift;
128 while (my ($limit, $level) = each %arch_branches) {
129 next unless $level == $stage;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700130
131 open ABROWSE, "$TLA abrowse -fkD --merges $limit |"
Eric Wong42f44b02005-11-23 23:52:43 -0800132 or die "Problems with tla abrowse: $!";
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700133
Eric Wong42f44b02005-11-23 23:52:43 -0800134 my %ps = (); # the current one
135 my $lastseen = '';
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700136
Eric Wong42f44b02005-11-23 23:52:43 -0800137 while (<ABROWSE>) {
138 chomp;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700139
Eric Wong42f44b02005-11-23 23:52:43 -0800140 # first record padded w 8 spaces
141 if (s/^\s{8}\b//) {
142 my ($id, $type) = split(m/\s+/, $_, 2);
Martin Langhoffd3968362005-08-30 21:56:52 +1200143
Eric Wong42f44b02005-11-23 23:52:43 -0800144 my %last_ps;
145 # store the record we just captured
146 if (%ps && !exists $psets{ $ps{id} }) {
147 %last_ps = %ps; # break references
148 push (@psets, \%last_ps);
149 $psets{ $last_ps{id} } = \%last_ps;
Martin Langhoffd3968362005-08-30 21:56:52 +1200150 }
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700151
Eric Wong42f44b02005-11-23 23:52:43 -0800152 my $branch = extract_versionname($id);
153 %ps = ( id => $id, branch => $branch );
154 if (%last_ps && ($last_ps{branch} eq $branch)) {
155 $ps{parent_id} = $last_ps{id};
156 }
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700157
Eric Wong42f44b02005-11-23 23:52:43 -0800158 $arch_branches{$branch} = 1;
159 $lastseen = 'id';
Martin Langhoffd3968362005-08-30 21:56:52 +1200160
Eric Wong42f44b02005-11-23 23:52:43 -0800161 # deal with types (should work with baz or tla):
162 if ($type =~ m/\(.*changeset\)/) {
163 $ps{type} = 's';
164 } elsif ($type =~ /\(.*import\)/) {
165 $ps{type} = 'i';
Eric Wong6df896b2005-11-23 23:53:55 -0800166 } elsif ($type =~ m/\(tag.*?(\S+\@\S+).*?\)/) {
Eric Wong42f44b02005-11-23 23:52:43 -0800167 $ps{type} = 't';
168 # read which revision we've tagged when we parse the log
Eric Wong6df896b2005-11-23 23:53:55 -0800169 $ps{tag} = $1;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700170 } else {
Eric Wong42f44b02005-11-23 23:52:43 -0800171 warn "Unknown type $type";
172 }
173
174 $arch_branches{$branch} = 1;
175 $lastseen = 'id';
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700176 } elsif (s/^\s{10}//) {
177 # 10 leading spaces or more
Eric Wong42f44b02005-11-23 23:52:43 -0800178 # indicate commit metadata
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700179
Eric Wong42f44b02005-11-23 23:52:43 -0800180 # date
181 if ($lastseen eq 'id' && m/^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d)/){
182 $ps{date} = $1;
183 $lastseen = 'date';
184 } elsif ($_ eq 'merges in:') {
185 $ps{merges} = [];
186 $lastseen = 'merges';
187 } elsif ($lastseen eq 'merges' && s/^\s{2}//) {
188 my $id = $_;
189 push (@{$ps{merges}}, $id);
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700190
Eric Wong42f44b02005-11-23 23:52:43 -0800191 # aggressive branch finding:
192 if ($opt_D) {
193 my $branch = extract_versionname($id);
194 my $repo = extract_reponame($branch);
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700195
Eric Wong42f44b02005-11-23 23:52:43 -0800196 if (archive_reachable($repo) &&
197 !defined $arch_branches{$branch}) {
198 $arch_branches{$branch} = $stage + 1;
199 }
200 }
201 } else {
202 warn "more metadata after merges!?: $_\n" unless /^\s*$/;
203 }
204 }
205 }
206
207 if (%ps && !exists $psets{ $ps{id} }) {
208 my %temp = %ps; # break references
209 if (@psets && $psets[$#psets]{branch} eq $ps{branch}) {
210 $temp{parent_id} = $psets[$#psets]{id};
211 }
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700212 push (@psets, \%temp);
Eric Wong42f44b02005-11-23 23:52:43 -0800213 $psets{ $temp{id} } = \%temp;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700214 }
215
Eric Wong42f44b02005-11-23 23:52:43 -0800216 close ABROWSE or die "$TLA abrowse failed on $limit\n";
217 }
Martin Langhoffd3968362005-08-30 21:56:52 +1200218} # end foreach $root
219
Eric Wong42f44b02005-11-23 23:52:43 -0800220do_abrowse(1);
221my $depth = 2;
222$opt_D ||= 0;
223while ($depth <= $opt_D) {
224 do_abrowse($depth);
225 $depth++;
226}
227
Martin Langhoffd3968362005-08-30 21:56:52 +1200228## Order patches by time
Eric Wong42f44b02005-11-23 23:52:43 -0800229# FIXME see if we can find a more optimal way to do this by graphing
230# the ancestry data and walking it, that way we won't have to rely on
231# client-supplied dates
Martin Langhoffd3968362005-08-30 21:56:52 +1200232@psets = sort {$a->{date}.$b->{id} cmp $b->{date}.$b->{id}} @psets;
233
234#print Dumper \@psets;
235
236##
237## TODO cleanup irrelevant patches
238## and put an initial import
239## or a full tag
Martin Langhoff3292ae42005-09-04 22:55:06 +1200240my $import = 0;
martin@catalyst.net.nz1d4710d2005-09-11 21:26:05 +1200241unless (-d $git_dir) { # initial import
Martin Langhoffd3968362005-08-30 21:56:52 +1200242 if ($psets[0]{type} eq 'i' || $psets[0]{type} eq 't') {
243 print "Starting import from $psets[0]{id}\n";
Nicolas Pitre5c94f872007-01-12 16:01:46 -0500244 `git-init`;
Martin Langhoff3292ae42005-09-04 22:55:06 +1200245 die $! if $?;
246 $import = 1;
Martin Langhoffd3968362005-08-30 21:56:52 +1200247 } else {
248 die "Need to start from an import or a tag -- cannot use $psets[0]{id}";
249 }
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200250} else { # progressing an import
251 # load the rptags
Eric Wong42f44b02005-11-23 23:52:43 -0800252 opendir(DIR, $ptag_dir)
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200253 || die "can't opendir: $!";
254 while (my $file = readdir(DIR)) {
Eric Wonga7fb51d2005-11-12 01:25:33 -0800255 # skip non-interesting-files
256 next unless -f "$ptag_dir/$file";
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700257
Eric Wonga7fb51d2005-11-12 01:25:33 -0800258 # convert first '--' to '/' from old git-archimport to use
259 # as an archivename/c--b--v private tag
260 if ($file !~ m!,!) {
261 my $oldfile = $file;
262 $file =~ s!--!,!;
263 print STDERR "converting old tag $oldfile to $file\n";
264 rename("$ptag_dir/$oldfile", "$ptag_dir/$file") or die $!;
265 }
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200266 my $sha = ptag($file);
267 chomp $sha;
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200268 $rptags{$sha} = $file;
269 }
270 closedir DIR;
Martin Langhoffd3968362005-08-30 21:56:52 +1200271}
272
Martin Langhoff3292ae42005-09-04 22:55:06 +1200273# process patchsets
Eric Wong22ff00f2005-11-12 01:29:20 -0800274# extract the Arch repository name (Arch "archive" in Arch-speak)
275sub extract_reponame {
276 my $fq_cvbr = shift; # archivename/[[[[category]branch]version]revision]
277 return (split(/\//, $fq_cvbr))[0];
278}
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700279
Eric Wong22ff00f2005-11-12 01:29:20 -0800280sub extract_versionname {
281 my $name = shift;
282 $name =~ s/--(?:patch|version(?:fix)?|base)-\d+$//;
283 return $name;
284}
Martin Langhoffd3968362005-08-30 21:56:52 +1200285
Eric Wong22ff00f2005-11-12 01:29:20 -0800286# convert a fully-qualified revision or version to a unique dirname:
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700287# normalperson@yhbt.net-05/mpd--uclinux--1--patch-2
Eric Wong22ff00f2005-11-12 01:29:20 -0800288# becomes: normalperson@yhbt.net-05,mpd--uclinux--1
289#
290# the git notion of a branch is closer to
291# archive/category--branch--version than archive/category--branch, so we
292# use this to convert to git branch names.
293# Also, keep archive names but replace '/' with ',' since it won't require
294# subdirectories, and is safer than swapping '--' which could confuse
295# reverse-mapping when dealing with bastard branches that
296# are just archive/category--version (no --branch)
297sub tree_dirname {
298 my $revision = shift;
299 my $name = extract_versionname($revision);
300 $name =~ s#/#,#;
301 return $name;
302}
303
Martin Langhofffee33652005-11-17 21:20:45 +1300304# old versions of git-archimport just use the <category--branch> part:
305sub old_style_branchname {
306 my $id = shift;
307 my $ret = safe_pipe_capture($TLA,'parse-package-name','-p',$id);
308 chomp $ret;
309 return $ret;
310}
311
Paolo Bonzinid9cb5392007-03-07 10:43:41 +0100312*git_default_branchname = $opt_o ? *old_style_branchname : *tree_dirname;
313
314# retrieve default archive, since $branch_name_map keys might not include it
315sub get_default_archive {
316 if (!defined $default_archive) {
317 $default_archive = safe_pipe_capture($TLA,'my-default-archive');
318 chomp $default_archive;
319 }
320 return $default_archive;
321}
322
323sub git_branchname {
324 my $revision = shift;
325 my $name = extract_versionname($revision);
326
327 if (exists $branch_name_map{$name}) {
328 return $branch_name_map{$name};
329
330 } elsif ($name =~ m#^([^/]*)/(.*)$#
331 && $1 eq get_default_archive()
332 && exists $branch_name_map{$2}) {
333 # the names given in the command-line lacked the archive.
334 return $branch_name_map{$2};
335
336 } else {
337 return git_default_branchname($revision);
338 }
339}
Eric Wong22ff00f2005-11-12 01:29:20 -0800340
Eric Wong3e525e62005-11-23 23:55:04 -0800341sub process_patchset_accurate {
342 my $ps = shift;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700343
Eric Wong3e525e62005-11-23 23:55:04 -0800344 # switch to that branch if we're not already in that branch:
345 if (-e "$git_dir/refs/heads/$ps->{branch}") {
346 system('git-checkout','-f',$ps->{branch}) == 0 or die "$! $?\n";
Martin Langhoffd3968362005-08-30 21:56:52 +1200347
Eric Wong3e525e62005-11-23 23:55:04 -0800348 # remove any old stuff that got leftover:
349 my $rm = safe_pipe_capture('git-ls-files','--others','-z');
350 rmtree(split(/\0/,$rm)) if $rm;
Martin Langhoffd3968362005-08-30 21:56:52 +1200351 }
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700352
Eric Wong3e525e62005-11-23 23:55:04 -0800353 # Apply the import/changeset/merge into the working tree
354 my $dir = sync_to_ps($ps);
355 # read the new log entry:
356 my @commitlog = safe_pipe_capture($TLA,'cat-log','-d',$dir,$ps->{id});
357 die "Error in cat-log: $!" if $?;
358 chomp @commitlog;
Martin Langhoffd3968362005-08-30 21:56:52 +1200359
Eric Wong3e525e62005-11-23 23:55:04 -0800360 # grab variables we want from the log, new fields get added to $ps:
361 # (author, date, email, summary, message body ...)
362 parselog($ps, \@commitlog);
Martin Langhoff3292ae42005-09-04 22:55:06 +1200363
Eric Wong3e525e62005-11-23 23:55:04 -0800364 if ($ps->{id} =~ /--base-0$/ && $ps->{id} ne $psets[0]{id}) {
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700365 # this should work when importing continuations
Eric Wong3e525e62005-11-23 23:55:04 -0800366 if ($ps->{tag} && (my $branchpoint = eval { ptag($ps->{tag}) })) {
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700367
Eric Wong3e525e62005-11-23 23:55:04 -0800368 # find where we are supposed to branch from
Paolo Bonzinid9cb5392007-03-07 10:43:41 +0100369 if (! -e "$git_dir/refs/heads/$ps->{branch}") {
370 system('git-branch',$ps->{branch},$branchpoint) == 0 or die "$! $?\n";
371
372 # We trust Arch with the fact that this is just a tag,
373 # and it does not affect the state of the tree, so
374 # we just tag and move on. If the user really wants us
375 # to consolidate more branches into one, don't tag because
376 # the tag name would be already taken.
377 tag($ps->{id}, $branchpoint);
378 ptag($ps->{id}, $branchpoint);
379 print " * Tagged $ps->{id} at $branchpoint\n";
380 }
381 system('git-checkout','-f',$ps->{branch}) == 0 or die "$! $?\n";
382
Eric Wong3e525e62005-11-23 23:55:04 -0800383 # remove any old stuff that got leftover:
384 my $rm = safe_pipe_capture('git-ls-files','--others','-z');
385 rmtree(split(/\0/,$rm)) if $rm;
Eric Wong3e525e62005-11-23 23:55:04 -0800386 return 0;
387 } else {
388 warn "Tagging from unknown id unsupported\n" if $ps->{tag};
389 }
390 # allow multiple bases/imports here since Arch supports cherry-picks
391 # from unrelated trees
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700392 }
393
Eric Wong3e525e62005-11-23 23:55:04 -0800394 # update the index with all the changes we got
Eric Wong3ff903b2006-02-18 03:49:38 -0800395 system('git-diff-files --name-only -z | '.
396 'git-update-index --remove -z --stdin') == 0 or die "$! $?\n";
Eric Wong3e525e62005-11-23 23:55:04 -0800397 system('git-ls-files --others -z | '.
398 'git-update-index --add -z --stdin') == 0 or die "$! $?\n";
Eric Wong3e525e62005-11-23 23:55:04 -0800399 return 1;
400}
401
402# the native changeset processing strategy. This is very fast, but
403# does not handle permissions or any renames involving directories
404sub process_patchset_fast {
405 my $ps = shift;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700406 #
Martin Langhoffd3968362005-08-30 21:56:52 +1200407 # create the branch if needed
408 #
Martin Langhoff3292ae42005-09-04 22:55:06 +1200409 if ($ps->{type} eq 'i' && !$import) {
410 die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";
Martin Langhoffd3968362005-08-30 21:56:52 +1200411 }
412
Martin Langhoff3292ae42005-09-04 22:55:06 +1200413 unless ($import) { # skip for import
martin@catalyst.net.nz1d4710d2005-09-11 21:26:05 +1200414 if ( -e "$git_dir/refs/heads/$ps->{branch}") {
Martin Langhoffd3968362005-08-30 21:56:52 +1200415 # we know about this branch
Eric Wongf88961a2005-11-23 23:48:57 -0800416 system('git-checkout',$ps->{branch});
Martin Langhoffd3968362005-08-30 21:56:52 +1200417 } else {
418 # new branch! we need to verify a few things
419 die "Branch on a non-tag!" unless $ps->{type} eq 't';
420 my $branchpoint = ptag($ps->{tag});
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700421 die "Tagging from unknown id unsupported: $ps->{tag}"
Martin Langhoffd3968362005-08-30 21:56:52 +1200422 unless $branchpoint;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700423
Martin Langhoffd3968362005-08-30 21:56:52 +1200424 # find where we are supposed to branch from
Paolo Bonzinid9cb5392007-03-07 10:43:41 +0100425 if (! -e "$git_dir/refs/heads/$ps->{branch}") {
426 system('git-branch',$ps->{branch},$branchpoint) == 0 or die "$! $?\n";
Martin Langhoff52586ec2005-09-04 22:55:29 +1200427
Paolo Bonzinid9cb5392007-03-07 10:43:41 +0100428 # We trust Arch with the fact that this is just a tag,
429 # and it does not affect the state of the tree, so
430 # we just tag and move on. If the user really wants us
431 # to consolidate more branches into one, don't tag because
432 # the tag name would be already taken.
433 tag($ps->{id}, $branchpoint);
434 ptag($ps->{id}, $branchpoint);
435 print " * Tagged $ps->{id} at $branchpoint\n";
436 }
437 system('git-checkout',$ps->{branch}) == 0 or die "$! $?\n";
Eric Wong3e525e62005-11-23 23:55:04 -0800438 return 0;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700439 }
Martin Langhoffd3968362005-08-30 21:56:52 +1200440 die $! if $?;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700441 }
Martin Langhoffd3968362005-08-30 21:56:52 +1200442
Martin Langhoffd3968362005-08-30 21:56:52 +1200443 #
444 # Apply the import/changeset/merge into the working tree
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700445 #
Martin Langhoffd3968362005-08-30 21:56:52 +1200446 if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
Martin Langhoffd3968362005-08-30 21:56:52 +1200447 apply_import($ps) or die $!;
Eric Wong3e525e62005-11-23 23:55:04 -0800448 $stats{import_or_tag}++;
Martin Langhoff3292ae42005-09-04 22:55:06 +1200449 $import=0;
Martin Langhoffd3968362005-08-30 21:56:52 +1200450 } elsif ($ps->{type} eq 's') {
451 apply_cset($ps);
Eric Wong3e525e62005-11-23 23:55:04 -0800452 $stats{simple_changeset}++;
Martin Langhoffd3968362005-08-30 21:56:52 +1200453 }
454
455 #
456 # prepare update git's index, based on what arch knows
457 # about the pset, resolve parents, etc
458 #
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700459
460 my @commitlog = safe_pipe_capture($TLA,'cat-archive-log',$ps->{id});
Martin Langhoffd3968362005-08-30 21:56:52 +1200461 die "Error in cat-archive-log: $!" if $?;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700462
Eric Wong6df896b2005-11-23 23:53:55 -0800463 parselog($ps,\@commitlog);
Martin Langhoffd3968362005-08-30 21:56:52 +1200464
465 # imports don't give us good info
466 # on added files. Shame on them
Eric Wong6df896b2005-11-23 23:53:55 -0800467 if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
Eric Wong6df896b2005-11-23 23:53:55 -0800468 system('git-ls-files --deleted -z | '.
469 'git-update-index --remove -z --stdin') == 0 or die "$! $?\n";
Eric Wong3ff903b2006-02-18 03:49:38 -0800470 system('git-ls-files --others -z | '.
471 'git-update-index --add -z --stdin') == 0 or die "$! $?\n";
Martin Langhoffd3968362005-08-30 21:56:52 +1200472 }
473
Eric Wong6df896b2005-11-23 23:53:55 -0800474 # TODO: handle removed_directories and renamed_directories:
Eric Wong3ff903b2006-02-18 03:49:38 -0800475
Eric Wong6df896b2005-11-23 23:53:55 -0800476 if (my $del = $ps->{removed_files}) {
477 unlink @$del;
Martin Langhoffd3968362005-08-30 21:56:52 +1200478 while (@$del) {
479 my @slice = splice(@$del, 0, 100);
Eric Wong6df896b2005-11-23 23:53:55 -0800480 system('git-update-index','--remove','--',@slice) == 0 or
481 die "Error in git-update-index --remove: $! $?\n";
Martin Langhoffd3968362005-08-30 21:56:52 +1200482 }
483 }
Eric Wong6df896b2005-11-23 23:53:55 -0800484
485 if (my $ren = $ps->{renamed_files}) { # renamed
Martin Langhoffd3968362005-08-30 21:56:52 +1200486 if (@$ren % 2) {
487 die "Odd number of entries in rename!?";
488 }
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700489
Martin Langhoffd3968362005-08-30 21:56:52 +1200490 while (@$ren) {
Eric Wong6df896b2005-11-23 23:53:55 -0800491 my $from = shift @$ren;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700492 my $to = shift @$ren;
Martin Langhoffd3968362005-08-30 21:56:52 +1200493
494 unless (-d dirname($to)) {
495 mkpath(dirname($to)); # will die on err
496 }
Eric Wong3e525e62005-11-23 23:55:04 -0800497 # print "moving $from $to";
Eric Wong6df896b2005-11-23 23:53:55 -0800498 rename($from, $to) or die "Error renaming '$from' '$to': $!\n";
499 system('git-update-index','--remove','--',$from) == 0 or
500 die "Error in git-update-index --remove: $! $?\n";
501 system('git-update-index','--add','--',$to) == 0 or
502 die "Error in git-update-index --add: $! $?\n";
Martin Langhoffd3968362005-08-30 21:56:52 +1200503 }
Martin Langhoffd3968362005-08-30 21:56:52 +1200504 }
Eric Wong6df896b2005-11-23 23:53:55 -0800505
Eric Wong3ff903b2006-02-18 03:49:38 -0800506 if (my $add = $ps->{new_files}) {
507 while (@$add) {
508 my @slice = splice(@$add, 0, 100);
509 system('git-update-index','--add','--',@slice) == 0 or
510 die "Error in git-update-index --add: $! $?\n";
511 }
512 }
513
Eric Wong6df896b2005-11-23 23:53:55 -0800514 if (my $mod = $ps->{modified_files}) {
Martin Langhoffd3968362005-08-30 21:56:52 +1200515 while (@$mod) {
516 my @slice = splice(@$mod, 0, 100);
Eric Wong6df896b2005-11-23 23:53:55 -0800517 system('git-update-index','--',@slice) == 0 or
518 die "Error in git-update-index: $! $?\n";
Martin Langhoffd3968362005-08-30 21:56:52 +1200519 }
520 }
Eric Wong3e525e62005-11-23 23:55:04 -0800521 return 1; # we successfully applied the changeset
522}
523
524if ($opt_f) {
525 print "Will import patchsets using the fast strategy\n",
526 "Renamed directories and permission changes will be missed\n";
527 *process_patchset = *process_patchset_fast;
528} else {
529 print "Using the default (accurate) import strategy.\n",
530 "Things may be a bit slow\n";
531 *process_patchset = *process_patchset_accurate;
532}
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700533
Eric Wong3e525e62005-11-23 23:55:04 -0800534foreach my $ps (@psets) {
535 # process patchsets
536 $ps->{branch} = git_branchname($ps->{id});
537
538 #
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700539 # ensure we have a clean state
540 #
Eric Wong3e525e62005-11-23 23:55:04 -0800541 if (my $dirty = `git-diff-files`) {
542 die "Unclean tree when about to process $ps->{id} " .
543 " - did we fail to commit cleanly before?\n$dirty";
544 }
545 die $! if $?;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700546
Eric Wong3e525e62005-11-23 23:55:04 -0800547 #
548 # skip commits already in repo
549 #
550 if (ptag($ps->{id})) {
551 $opt_v && print " * Skipping already imported: $ps->{id}\n";
Eric Wong10945e02005-11-23 23:58:16 -0800552 next;
Eric Wong3e525e62005-11-23 23:55:04 -0800553 }
554
555 print " * Starting to work on $ps->{id}\n";
556
557 process_patchset($ps) or next;
558
Junio C Hamano215a7ad2005-09-07 17:26:23 -0700559 # warn "errors when running git-update-index! $!";
Eric Wong3e525e62005-11-23 23:55:04 -0800560 my $tree = `git-write-tree`;
Martin Langhoffd3968362005-08-30 21:56:52 +1200561 die "cannot write tree $!" if $?;
562 chomp $tree;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700563
Martin Langhoffd3968362005-08-30 21:56:52 +1200564 #
565 # Who's your daddy?
566 #
567 my @par;
martin@catalyst.net.nz1d4710d2005-09-11 21:26:05 +1200568 if ( -e "$git_dir/refs/heads/$ps->{branch}") {
Eric Wongf88961a2005-11-23 23:48:57 -0800569 if (open HEAD, "<","$git_dir/refs/heads/$ps->{branch}") {
Martin Langhoffd3968362005-08-30 21:56:52 +1200570 my $p = <HEAD>;
571 close HEAD;
572 chomp $p;
573 push @par, '-p', $p;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700574 } else {
Martin Langhoffd3968362005-08-30 21:56:52 +1200575 if ($ps->{type} eq 's') {
576 warn "Could not find the right head for the branch $ps->{branch}";
577 }
578 }
579 }
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700580
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200581 if ($ps->{merges}) {
582 push @par, find_parents($ps);
583 }
Martin Langhoffd3968362005-08-30 21:56:52 +1200584
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700585 #
Martin Langhoffd3968362005-08-30 21:56:52 +1200586 # Commit, tag and clean state
587 #
588 $ENV{TZ} = 'GMT';
589 $ENV{GIT_AUTHOR_NAME} = $ps->{author};
590 $ENV{GIT_AUTHOR_EMAIL} = $ps->{email};
591 $ENV{GIT_AUTHOR_DATE} = $ps->{date};
592 $ENV{GIT_COMMITTER_NAME} = $ps->{author};
593 $ENV{GIT_COMMITTER_EMAIL} = $ps->{email};
594 $ENV{GIT_COMMITTER_DATE} = $ps->{date};
595
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700596 my $pid = open2(*READER, *WRITER,'git-commit-tree',$tree,@par)
Martin Langhoffd3968362005-08-30 21:56:52 +1200597 or die $!;
Paolo Bonzinia94f4572007-02-28 21:02:02 +0100598 print WRITER $ps->{summary},"\n\n";
Miles Bader608403d2007-08-29 21:56:56 -0400599
600 # only print message if it's not empty, to avoid a spurious blank line;
601 # also append an extra newline, so there's a blank line before the
602 # following "git-archimport-id:" line.
603 print WRITER $ps->{message},"\n\n" if ($ps->{message} ne "");
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700604
Eric Wong6df896b2005-11-23 23:53:55 -0800605 # make it easy to backtrack and figure out which Arch revision this was:
606 print WRITER 'git-archimport-id: ',$ps->{id},"\n";
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700607
Martin Langhoffd3968362005-08-30 21:56:52 +1200608 close WRITER;
609 my $commitid = <READER>; # read
610 chomp $commitid;
611 close READER;
612 waitpid $pid,0; # close;
613
614 if (length $commitid != 40) {
615 die "Something went wrong with the commit! $! $commitid";
616 }
617 #
618 # Update the branch
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700619 #
Eric Wongf88961a2005-11-23 23:48:57 -0800620 open HEAD, ">","$git_dir/refs/heads/$ps->{branch}";
Martin Langhoffd3968362005-08-30 21:56:52 +1200621 print HEAD $commitid;
622 close HEAD;
Pavel Roskin8366a102005-11-16 13:27:28 -0500623 system('git-update-ref', 'HEAD', "$ps->{branch}");
Martin Langhoffd3968362005-08-30 21:56:52 +1200624
625 # tag accordingly
626 ptag($ps->{id}, $commitid); # private tag
627 if ($opt_T || $ps->{type} eq 't' || $ps->{type} eq 'i') {
628 tag($ps->{id}, $commitid);
629 }
630 print " * Committed $ps->{id}\n";
631 print " + tree $tree\n";
632 print " + commit $commitid\n";
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200633 $opt_v && print " + commit date is $ps->{date} \n";
Eric Wongf88961a2005-11-23 23:48:57 -0800634 $opt_v && print " + parents: ",join(' ',@par),"\n";
Eric Wong3e525e62005-11-23 23:55:04 -0800635}
636
637if ($opt_v) {
638 foreach (sort keys %stats) {
639 print" $_: $stats{$_}\n";
640 }
641}
642exit 0;
643
644# used by the accurate strategy:
645sub sync_to_ps {
646 my $ps = shift;
647 my $tree_dir = $tmp.'/'.tree_dirname($ps->{id});
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700648
Eric Wong3e525e62005-11-23 23:55:04 -0800649 $opt_v && print "sync_to_ps($ps->{id}) method: ";
650
651 if (-d $tree_dir) {
652 if ($ps->{type} eq 't') {
653 $opt_v && print "get (tag)\n";
654 # looks like a tag-only or (worse,) a mixed tags/changeset branch,
655 # can't rely on replay to work correctly on these
656 rmtree($tree_dir);
657 safe_pipe_capture($TLA,'get','--no-pristine',$ps->{id},$tree_dir);
658 $stats{get_tag}++;
659 } else {
660 my $tree_id = arch_tree_id($tree_dir);
661 if ($ps->{parent_id} && ($ps->{parent_id} eq $tree_id)) {
662 # the common case (hopefully)
663 $opt_v && print "replay\n";
664 safe_pipe_capture($TLA,'replay','-d',$tree_dir,$ps->{id});
665 $stats{replay}++;
666 } else {
667 # getting one tree is usually faster than getting two trees
668 # and applying the delta ...
669 rmtree($tree_dir);
670 $opt_v && print "apply-delta\n";
671 safe_pipe_capture($TLA,'get','--no-pristine',
672 $ps->{id},$tree_dir);
673 $stats{get_delta}++;
674 }
675 }
676 } else {
677 # new branch work
678 $opt_v && print "get (new tree)\n";
679 safe_pipe_capture($TLA,'get','--no-pristine',$ps->{id},$tree_dir);
680 $stats{get_new}++;
681 }
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700682
Eric Wong3e525e62005-11-23 23:55:04 -0800683 # added -I flag to rsync since we're going to fast! AIEEEEE!!!!
684 system('rsync','-aI','--delete','--exclude',$git_dir,
685# '--exclude','.arch-inventory',
686 '--exclude','.arch-ids','--exclude','{arch}',
687 '--exclude','+*','--exclude',',*',
688 "$tree_dir/",'./') == 0 or die "Cannot rsync $tree_dir: $! $?";
689 return $tree_dir;
Martin Langhoffd3968362005-08-30 21:56:52 +1200690}
691
Martin Langhoffd3968362005-08-30 21:56:52 +1200692sub apply_import {
693 my $ps = shift;
Eric Wong22ff00f2005-11-12 01:29:20 -0800694 my $bname = git_branchname($ps->{id});
Martin Langhoffd3968362005-08-30 21:56:52 +1200695
Eric Wongf88961a2005-11-23 23:48:57 -0800696 mkpath($tmp);
Martin Langhoffd3968362005-08-30 21:56:52 +1200697
Eric Wongf88961a2005-11-23 23:48:57 -0800698 safe_pipe_capture($TLA,'get','-s','--no-pristine',$ps->{id},"$tmp/import");
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700699 die "Cannot get import: $!" if $?;
Eric Wongf88961a2005-11-23 23:48:57 -0800700 system('rsync','-aI','--delete', '--exclude',$git_dir,
701 '--exclude','.arch-ids','--exclude','{arch}',
702 "$tmp/import/", './');
Martin Langhoffd3968362005-08-30 21:56:52 +1200703 die "Cannot rsync import:$!" if $?;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700704
Eric Wongf88961a2005-11-23 23:48:57 -0800705 rmtree("$tmp/import");
Martin Langhoffd3968362005-08-30 21:56:52 +1200706 die "Cannot remove tempdir: $!" if $?;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700707
Martin Langhoffd3968362005-08-30 21:56:52 +1200708
709 return 1;
710}
711
712sub apply_cset {
713 my $ps = shift;
714
Eric Wongf88961a2005-11-23 23:48:57 -0800715 mkpath($tmp);
Martin Langhoffd3968362005-08-30 21:56:52 +1200716
717 # get the changeset
Eric Wongf88961a2005-11-23 23:48:57 -0800718 safe_pipe_capture($TLA,'get-changeset',$ps->{id},"$tmp/changeset");
Martin Langhoffd3968362005-08-30 21:56:52 +1200719 die "Cannot get changeset: $!" if $?;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700720
Martin Langhoffd3968362005-08-30 21:56:52 +1200721 # apply patches
722 if (`find $tmp/changeset/patches -type f -name '*.patch'`) {
723 # this can be sped up considerably by doing
724 # (find | xargs cat) | patch
Pavel Roskin82e5a822006-07-10 01:50:18 -0400725 # but that can get mucked up by patches
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700726 # with missing trailing newlines or the standard
Martin Langhoffd3968362005-08-30 21:56:52 +1200727 # 'missing newline' flag in the patch - possibly
728 # produced with an old/buggy diff.
729 # slow and safe, we invoke patch once per patchfile
730 `find $tmp/changeset/patches -type f -name '*.patch' -print0 | grep -zv '{arch}' | xargs -iFILE -0 --no-run-if-empty patch -p1 --forward -iFILE`;
731 die "Problem applying patches! $!" if $?;
732 }
733
734 # apply changed binary files
735 if (my @modified = `find $tmp/changeset/patches -type f -name '*.modified'`) {
736 foreach my $mod (@modified) {
737 chomp $mod;
738 my $orig = $mod;
739 $orig =~ s/\.modified$//; # lazy
740 $orig =~ s!^\Q$tmp\E/changeset/patches/!!;
741 #print "rsync -p '$mod' '$orig'";
Eric Wongf88961a2005-11-23 23:48:57 -0800742 system('rsync','-p',$mod,"./$orig");
Martin Langhoffd3968362005-08-30 21:56:52 +1200743 die "Problem applying binary changes! $!" if $?;
744 }
745 }
746
747 # bring in new files
Eric Wongf88961a2005-11-23 23:48:57 -0800748 system('rsync','-aI','--exclude',$git_dir,
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700749 '--exclude','.arch-ids',
Eric Wongf88961a2005-11-23 23:48:57 -0800750 '--exclude', '{arch}',
751 "$tmp/changeset/new-files-archive/",'./');
Martin Langhoffd3968362005-08-30 21:56:52 +1200752
753 # deleted files are hinted from the commitlog processing
754
Eric Wongf88961a2005-11-23 23:48:57 -0800755 rmtree("$tmp/changeset");
Martin Langhoffd3968362005-08-30 21:56:52 +1200756}
757
758
759# =for reference
Eric Wong6df896b2005-11-23 23:53:55 -0800760# notes: *-files/-directories keys cannot have spaces, they're always
761# pika-escaped. Everything after the first newline
762# A log entry looks like:
Martin Langhoffd3968362005-08-30 21:56:52 +1200763# Revision: moodle-org--moodle--1.3.3--patch-15
764# Archive: arch-eduforge@catalyst.net.nz--2004
765# Creator: Penny Leach <penny@catalyst.net.nz>
766# Date: Wed May 25 14:15:34 NZST 2005
767# Standard-date: 2005-05-25 02:15:34 GMT
768# New-files: lang/de/.arch-ids/block_glossary_random.php.id
769# lang/de/.arch-ids/block_html.php.id
770# New-directories: lang/de/help/questionnaire
771# lang/de/help/questionnaire/.arch-ids
772# Renamed-files: .arch-ids/db_sears.sql.id db/.arch-ids/db_sears.sql.id
773# db_sears.sql db/db_sears.sql
774# Removed-files: lang/be/docs/.arch-ids/release.html.id
775# lang/be/docs/.arch-ids/releaseold.html.id
776# Modified-files: admin/cron.php admin/delete.php
777# admin/editor.html backup/lib.php backup/restore.php
778# New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15
779# Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+)
Eric Wong6df896b2005-11-23 23:53:55 -0800780# summary can be multiline with a leading space just like the above fields
Martin Langhoffd3968362005-08-30 21:56:52 +1200781# Keywords:
782#
783# Updating yadda tadda tadda madda
784sub parselog {
Eric Wong6df896b2005-11-23 23:53:55 -0800785 my ($ps, $log) = @_;
786 my $key = undef;
Martin Langhoffd3968362005-08-30 21:56:52 +1200787
Eric Wong6df896b2005-11-23 23:53:55 -0800788 # headers we want that contain filenames:
789 my %want_headers = (
790 new_files => 1,
791 modified_files => 1,
792 renamed_files => 1,
793 renamed_directories => 1,
794 removed_files => 1,
795 removed_directories => 1,
796 );
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700797
Eric Wong6df896b2005-11-23 23:53:55 -0800798 chomp (@$log);
799 while ($_ = shift @$log) {
800 if (/^Continuation-of:\s*(.*)/) {
801 $ps->{tag} = $1;
802 $key = undef;
803 } elsif (/^Summary:\s*(.*)$/ ) {
Paolo Bonzinia94f4572007-02-28 21:02:02 +0100804 # summary can be multiline as long as it has a leading space.
805 # we squeeze it onto a single line, though.
Eric Wong6df896b2005-11-23 23:53:55 -0800806 $ps->{summary} = [ $1 ];
807 $key = 'summary';
808 } elsif (/^Creator: (.*)\s*<([^\>]+)>/) {
809 $ps->{author} = $1;
810 $ps->{email} = $2;
811 $key = undef;
812 # any *-files or *-directories can be read here:
813 } elsif (/^([A-Z][a-z\-]+):\s*(.*)$/) {
814 my $val = $2;
815 $key = lc $1;
816 $key =~ tr/-/_/; # too lazy to quote :P
817 if ($want_headers{$key}) {
818 push @{$ps->{$key}}, split(/\s+/, $val);
819 } else {
820 $key = undef;
821 }
822 } elsif (/^$/) {
823 last; # remainder of @$log that didn't get shifted off is message
824 } elsif ($key) {
825 if (/^\s+(.*)$/) {
826 if ($key eq 'summary') {
827 push @{$ps->{$key}}, $1;
828 } else { # files/directories:
829 push @{$ps->{$key}}, split(/\s+/, $1);
830 }
831 } else {
832 $key = undef;
833 }
834 }
Martin Langhoffd3968362005-08-30 21:56:52 +1200835 }
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700836
Paolo Bonzinia94f4572007-02-28 21:02:02 +0100837 # drop leading empty lines from the log message
838 while (@$log && $log->[0] eq '') {
839 shift @$log;
840 }
841 if (exists $ps->{summary} && @{$ps->{summary}}) {
842 $ps->{summary} = join(' ', @{$ps->{summary}});
843 }
844 elsif (@$log == 0) {
845 $ps->{summary} = 'empty commit message';
846 } else {
847 $ps->{summary} = $log->[0] . '...';
848 }
Eric Wong6df896b2005-11-23 23:53:55 -0800849 $ps->{message} = join("\n",@$log);
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700850
Eric Wong6df896b2005-11-23 23:53:55 -0800851 # skip Arch control files, unescape pika-escaped files
852 foreach my $k (keys %want_headers) {
853 next unless (defined $ps->{$k});
Eric Wong6e331012005-11-23 23:56:31 -0800854 my @tmp = ();
Eric Wong6df896b2005-11-23 23:53:55 -0800855 foreach my $t (@{$ps->{$k}}) {
856 next unless length ($t);
857 next if $t =~ m!\{arch\}/!;
858 next if $t =~ m!\.arch-ids/!;
859 # should we skip this?
860 next if $t =~ m!\.arch-inventory$!;
Martin Langhofff84f9d32005-11-11 18:00:57 +1300861 # tla cat-archive-log will give us filenames with spaces as file\(sp)name - why?
862 # we can assume that any filename with \ indicates some pika escaping that we want to get rid of.
Eric Wong6df896b2005-11-23 23:53:55 -0800863 if ($t =~ /\\/ ){
Eric Wongf88961a2005-11-23 23:48:57 -0800864 $t = (safe_pipe_capture($TLA,'escape','--unescaped',$t))[0];
Martin Langhofff84f9d32005-11-11 18:00:57 +1300865 }
Eric Wong6df896b2005-11-23 23:53:55 -0800866 push @tmp, $t;
Martin Langhoffd3968362005-08-30 21:56:52 +1200867 }
Eric Wong6e331012005-11-23 23:56:31 -0800868 $ps->{$k} = \@tmp;
Martin Langhoffd3968362005-08-30 21:56:52 +1200869 }
Martin Langhoffd3968362005-08-30 21:56:52 +1200870}
871
872# write/read a tag
873sub tag {
874 my ($tag, $commit) = @_;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700875
Martin Langhofffee33652005-11-17 21:20:45 +1300876 if ($opt_o) {
877 $tag =~ s|/|--|g;
878 } else {
Paolo Bonzinid9cb5392007-03-07 10:43:41 +0100879 my $patchname = $tag;
880 $patchname =~ s/.*--//;
881 $tag = git_branchname ($tag) . '--' . $patchname;
Martin Langhofffee33652005-11-17 21:20:45 +1300882 }
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700883
Martin Langhoffd3968362005-08-30 21:56:52 +1200884 if ($commit) {
Eric Wonga7fb51d2005-11-12 01:25:33 -0800885 open(C,">","$git_dir/refs/tags/$tag")
Martin Langhoffd3968362005-08-30 21:56:52 +1200886 or die "Cannot create tag $tag: $!\n";
887 print C "$commit\n"
888 or die "Cannot write tag $tag: $!\n";
889 close(C)
890 or die "Cannot write tag $tag: $!\n";
Eric Wonga7fb51d2005-11-12 01:25:33 -0800891 print " * Created tag '$tag' on '$commit'\n" if $opt_v;
Martin Langhoffd3968362005-08-30 21:56:52 +1200892 } else { # read
Eric Wonga7fb51d2005-11-12 01:25:33 -0800893 open(C,"<","$git_dir/refs/tags/$tag")
Martin Langhoffd3968362005-08-30 21:56:52 +1200894 or die "Cannot read tag $tag: $!\n";
895 $commit = <C>;
896 chomp $commit;
897 die "Error reading tag $tag: $!\n" unless length $commit == 40;
898 close(C)
899 or die "Cannot read tag $tag: $!\n";
900 return $commit;
901 }
902}
903
904# write/read a private tag
905# reads fail softly if the tag isn't there
906sub ptag {
907 my ($tag, $commit) = @_;
Eric Wonga7fb51d2005-11-12 01:25:33 -0800908
909 # don't use subdirs for tags yet, it could screw up other porcelains
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700910 $tag =~ s|/|,|g;
911
Eric Wonga7fb51d2005-11-12 01:25:33 -0800912 my $tag_file = "$ptag_dir/$tag";
913 my $tag_branch_dir = dirname($tag_file);
914 mkpath($tag_branch_dir) unless (-d $tag_branch_dir);
Martin Langhoffd3968362005-08-30 21:56:52 +1200915
916 if ($commit) { # write
Eric Wonga7fb51d2005-11-12 01:25:33 -0800917 open(C,">",$tag_file)
Martin Langhoffd3968362005-08-30 21:56:52 +1200918 or die "Cannot create tag $tag: $!\n";
919 print C "$commit\n"
920 or die "Cannot write tag $tag: $!\n";
921 close(C)
922 or die "Cannot write tag $tag: $!\n";
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700923 $rptags{$commit} = $tag
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200924 unless $tag =~ m/--base-0$/;
Martin Langhoffd3968362005-08-30 21:56:52 +1200925 } else { # read
926 # if the tag isn't there, return 0
Eric Wonga7fb51d2005-11-12 01:25:33 -0800927 unless ( -s $tag_file) {
Martin Langhoffd3968362005-08-30 21:56:52 +1200928 return 0;
929 }
Eric Wonga7fb51d2005-11-12 01:25:33 -0800930 open(C,"<",$tag_file)
Martin Langhoffd3968362005-08-30 21:56:52 +1200931 or die "Cannot read tag $tag: $!\n";
932 $commit = <C>;
933 chomp $commit;
934 die "Error reading tag $tag: $!\n" unless length $commit == 40;
935 close(C)
936 or die "Cannot read tag $tag: $!\n";
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200937 unless (defined $rptags{$commit}) {
938 $rptags{$commit} = $tag;
939 }
Martin Langhoffd3968362005-08-30 21:56:52 +1200940 return $commit;
941 }
942}
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200943
944sub find_parents {
945 #
946 # Identify what branches are merging into me
947 # and whether we are fully merged
948 # git-merge-base <headsha> <headsha> should tell
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700949 # me what the base of the merge should be
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200950 #
951 my $ps = shift;
952
953 my %branches; # holds an arrayref per branch
954 # the arrayref contains a list of
955 # merged patches between the base
956 # of the merge and the current head
957
958 my @parents; # parents found for this commit
959
960 # simple loop to split the merges
961 # per branch
962 foreach my $merge (@{$ps->{merges}}) {
Eric Wong22ff00f2005-11-12 01:29:20 -0800963 my $branch = git_branchname($merge);
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200964 unless (defined $branches{$branch} ){
965 $branches{$branch} = [];
966 }
967 push @{$branches{$branch}}, $merge;
968 }
969
970 #
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700971 # foreach branch find a merge base and walk it to the
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200972 # head where we are, collecting the merged patchsets that
973 # Arch has recorded. Keep that in @have
974 # Compare that with the commits on the other branch
975 # between merge-base and the tip of the branch (@need)
976 # and see if we have a series of consecutive patches
977 # starting from the merge base. The tip of the series
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700978 # of consecutive patches merged is our new parent for
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200979 # that branch.
980 #
981 foreach my $branch (keys %branches) {
Martin Langhoff37f15d52005-09-30 19:15:12 +1200982
983 # check that we actually know about the branch
984 next unless -e "$git_dir/refs/heads/$branch";
985
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200986 my $mergebase = `git-merge-base $branch $ps->{branch}`;
Junio C Hamanoa6080a02007-06-07 00:04:01 -0700987 if ($?) {
988 # Don't die here, Arch supports one-way cherry-picking
989 # between branches with no common base (or any relationship
990 # at all beforehand)
991 warn "Cannot find merge base for $branch and $ps->{branch}";
992 next;
993 }
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200994 chomp $mergebase;
995
996 # now walk up to the mergepoint collecting what patches we have
997 my $branchtip = git_rev_parse($ps->{branch});
Linus Torvalds765ac8e2006-02-28 15:07:20 -0800998 my @ancestors = `git-rev-list --topo-order $branchtip ^$mergebase`;
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +1200999 my %have; # collected merges this branch has
1000 foreach my $merge (@{$ps->{merges}}) {
1001 $have{$merge} = 1;
1002 }
1003 my %ancestorshave;
1004 foreach my $par (@ancestors) {
1005 $par = commitid2pset($par);
1006 if (defined $par->{merges}) {
1007 foreach my $merge (@{$par->{merges}}) {
1008 $ancestorshave{$merge}=1;
1009 }
1010 }
1011 }
1012 # print "++++ Merges in $ps->{id} are....\n";
1013 # my @have = sort keys %have; print Dumper(\@have);
1014
1015 # merge what we have with what ancestors have
1016 %have = (%have, %ancestorshave);
1017
Junio C Hamanoa6080a02007-06-07 00:04:01 -07001018 # see what the remote branch has - these are the merges we
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +12001019 # will want to have in a consecutive series from the mergebase
1020 my $otherbranchtip = git_rev_parse($branch);
Linus Torvalds765ac8e2006-02-28 15:07:20 -08001021 my @needraw = `git-rev-list --topo-order $otherbranchtip ^$mergebase`;
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +12001022 my @need;
1023 foreach my $needps (@needraw) { # get the psets
1024 $needps = commitid2pset($needps);
1025 # git-rev-list will also
Junio C Hamanoa6080a02007-06-07 00:04:01 -07001026 # list commits merged in via earlier
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +12001027 # merges. we are only interested in commits
1028 # from the branch we're looking at
1029 if ($branch eq $needps->{branch}) {
1030 push @need, $needps->{id};
1031 }
1032 }
1033
1034 # print "++++ Merges from $branch we want are....\n";
1035 # print Dumper(\@need);
1036
1037 my $newparent;
1038 while (my $needed_commit = pop @need) {
1039 if ($have{$needed_commit}) {
1040 $newparent = $needed_commit;
1041 } else {
1042 last; # break out of the while
1043 }
1044 }
1045 if ($newparent) {
1046 push @parents, $newparent;
1047 }
1048
1049
1050 } # end foreach branch
1051
1052 # prune redundant parents
1053 my %parents;
1054 foreach my $p (@parents) {
1055 $parents{$p} = 1;
1056 }
1057 foreach my $p (@parents) {
1058 next unless exists $psets{$p}{merges};
1059 next unless ref $psets{$p}{merges};
1060 my @merges = @{$psets{$p}{merges}};
1061 foreach my $merge (@merges) {
Junio C Hamanoa6080a02007-06-07 00:04:01 -07001062 if ($parents{$merge}) {
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +12001063 delete $parents{$merge};
1064 }
1065 }
1066 }
Eric Wong42f44b02005-11-23 23:52:43 -08001067
Eric Wongf88961a2005-11-23 23:48:57 -08001068 @parents = ();
1069 foreach (keys %parents) {
1070 push @parents, '-p', ptag($_);
1071 }
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +12001072 return @parents;
1073}
1074
1075sub git_rev_parse {
1076 my $name = shift;
1077 my $val = `git-rev-parse $name`;
1078 die "Error: git-rev-parse $name" if $?;
1079 chomp $val;
1080 return $val;
1081}
1082
1083# resolve a SHA1 to a known patchset
1084sub commitid2pset {
1085 my $commitid = shift;
1086 chomp $commitid;
Junio C Hamanoa6080a02007-06-07 00:04:01 -07001087 my $name = $rptags{$commitid}
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +12001088 || die "Cannot find reverse tag mapping for $commitid";
Eric Wonga7fb51d2005-11-12 01:25:33 -08001089 $name =~ s|,|/|;
Junio C Hamanoa6080a02007-06-07 00:04:01 -07001090 my $ps = $psets{$name}
martin@catalyst.net.nzb779d5f2005-09-10 23:42:24 +12001091 || (print Dumper(sort keys %psets)) && die "Cannot find patchset for $name";
1092 return $ps;
1093}
Eric Wong2777ef72005-11-23 23:47:39 -08001094
Eric Wong42f44b02005-11-23 23:52:43 -08001095
Pavel Roskin82e5a822006-07-10 01:50:18 -04001096# an alternative to `command` that allows input to be passed as an array
Eric Wong2777ef72005-11-23 23:47:39 -08001097# to work around shell problems with weird characters in arguments
1098sub safe_pipe_capture {
1099 my @output;
1100 if (my $pid = open my $child, '-|') {
1101 @output = (<$child>);
1102 close $child or die join(' ',@_).": $! $?";
1103 } else {
Eric Wong3e525e62005-11-23 23:55:04 -08001104 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
Eric Wong2777ef72005-11-23 23:47:39 -08001105 }
1106 return wantarray ? @output : join('',@output);
1107}
1108
Eric Wong42f44b02005-11-23 23:52:43 -08001109# `tla logs -rf -d <dir> | head -n1` or `baz tree-id <dir>`
1110sub arch_tree_id {
1111 my $dir = shift;
1112 chomp( my $ret = (safe_pipe_capture($TLA,'logs','-rf','-d',$dir))[0] );
1113 return $ret;
1114}
1115
1116sub archive_reachable {
1117 my $archive = shift;
1118 return 1 if $reachable{$archive};
1119 return 0 if $unreachable{$archive};
Junio C Hamanoa6080a02007-06-07 00:04:01 -07001120
Eric Wong42f44b02005-11-23 23:52:43 -08001121 if (system "$TLA whereis-archive $archive >/dev/null") {
1122 if ($opt_a && (system($TLA,'register-archive',
1123 "http://mirrors.sourcecontrol.net/$archive") == 0)) {
1124 $reachable{$archive} = 1;
1125 return 1;
1126 }
1127 print STDERR "Archive is unreachable: $archive\n";
1128 $unreachable{$archive} = 1;
1129 return 0;
1130 } else {
1131 $reachable{$archive} = 1;
1132 return 1;
1133 }
1134}