]> git.ipfire.org Git - thirdparty/git.git/blame - git-archimport.perl
archimport: first, make sure it still compiles
[thirdparty/git.git] / git-archimport.perl
CommitLineData
d3968363
ML
1#!/usr/bin/perl -w
2#
3# This tool is copyright (c) 2005, Martin Langhoff.
4# It is released under the Gnu Public License, version 2.
5#
6# The basic idea is to walk the output of tla abrowse,
7# fetch the changesets and apply them.
8#
241b5967 9
d3968363
ML
10=head1 Invocation
11
241b5967 12 git-archimport [ -h ] [ -v ] [ -T ] [ -t tempdir ] <archive>/<branch> [ <archive>/<branch> ]
d3968363 13
241b5967
ML
14Imports a project from one or more Arch repositories. It will follow branches
15and repositories within the namespaces defined by the <archive/branch>
16parameters suppplied. If it cannot find the remote branch a merge comes from
17it will just import it as a regular commit. If it can find it, it will mark it
18as a merge whenever possible.
d3968363 19
241b5967 20See man (1) git-archimport for more details.
d3968363 21
241b5967 22=head1 TODO
d3968363 23
241b5967 24 - create tag objects instead of ref tags
d3968363 25 - audit shell-escaping of filenames
241b5967
ML
26 - hide our private tags somewhere smarter
27 - find a way to make "cat *patches | patch" safe even when patchfiles are missing newlines
d3968363
ML
28
29=head1 Devel tricks
30
31Add print in front of the shell commands invoked via backticks.
32
22ff00fc
EW
33=head1 Devel Notes
34
35There are several places where Arch and git terminology are intermixed
36and potentially confused.
37
38The notion of a "branch" in git is approximately equivalent to
39a "archive/category--branch--version" in Arch. Also, it should be noted
40that the "--branch" portion of "archive/category--branch--version" is really
41optional in Arch although not many people (nor tools!) seem to know this.
42This means that "archive/category--version" is also a valid "branch"
43in git terms.
44
45We always refer to Arch names by their fully qualified variant (which
46means the "archive" name is prefixed.
47
48For people unfamiliar with Arch, an "archive" is the term for "repository",
49and can contain multiple, unrelated branches.
50
d3968363
ML
51=cut
52
53use strict;
54use warnings;
55use Getopt::Std;
56use File::Spec;
127bf00f 57use File::Temp qw(tempfile tempdir);
d3968363
ML
58use File::Path qw(mkpath);
59use File::Basename qw(basename dirname);
60use String::ShellQuote;
61use Time::Local;
62use IO::Socket;
63use IO::Pipe;
64use POSIX qw(strftime dup2);
65use Data::Dumper qw/ Dumper /;
66use IPC::Open2;
67
68$SIG{'PIPE'}="IGNORE";
69$ENV{'TZ'}="UTC";
70
1d4710d0
ML
71my $git_dir = $ENV{"GIT_DIR"} || ".git";
72$ENV{"GIT_DIR"} = $git_dir;
a7fb51d3 73my $ptag_dir = "$git_dir/archimport/tags";
1d4710d0 74
fee3365f 75our($opt_h,$opt_v, $opt_T,$opt_t,$opt_o);
d3968363
ML
76
77sub usage() {
78 print STDERR <<END;
79Usage: ${\basename $0} # fetch/update GIT from Arch
fee3365f 80 [ -o ] [ -h ] [ -v ] [ -T ] [ -t tempdir ]
d3968363
ML
81 repository/arch-branch [ repository/arch-branch] ...
82END
83 exit(1);
84}
85
241b5967 86getopts("Thvt:") or usage();
d3968363
ML
87usage if $opt_h;
88
89@ARGV >= 1 or usage();
90my @arch_roots = @ARGV;
91
127bf00f
ML
92my ($tmpdir, $tmpdirname) = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
93my $tmp = $opt_t || 1;
94$tmp = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
95$opt_v && print "+ Using $tmp as temporary directory\n";
d3968363 96
d3968363 97my @psets = (); # the collection
b779d5f0
ML
98my %psets = (); # the collection, by name
99
100my %rptags = (); # my reverse private tags
101 # to map a SHA1 to a commitid
2777ef76 102my $TLA = $ENV{'ARCH_CLIENT'} || 'tla';
d3968363
ML
103
104foreach my $root (@arch_roots) {
105 my ($arepo, $abranch) = split(m!/!, $root);
106 open ABROWSE, "tla abrowse -f -A $arepo --desc --merges $abranch |"
107 or die "Problems with tla abrowse: $!";
108
109 my %ps = (); # the current one
110 my $mode = '';
111 my $lastseen = '';
112
113 while (<ABROWSE>) {
114 chomp;
115
116 # first record padded w 8 spaces
117 if (s/^\s{8}\b//) {
118
119 # store the record we just captured
120 if (%ps) {
121 my %temp = %ps; # break references
122 push (@psets, \%temp);
b779d5f0 123 $psets{$temp{id}} = \%temp;
d3968363
ML
124 %ps = ();
125 }
126
127 my ($id, $type) = split(m/\s{3}/, $_);
128 $ps{id} = $id;
129 $ps{repo} = $arepo;
130
131 # deal with types
132 if ($type =~ m/^\(simple changeset\)/) {
133 $ps{type} = 's';
134 } elsif ($type eq '(initial import)') {
135 $ps{type} = 'i';
136 } elsif ($type =~ m/^\(tag revision of (.+)\)/) {
137 $ps{type} = 't';
138 $ps{tag} = $1;
139 } else {
140 warn "Unknown type $type";
141 }
142 $lastseen = 'id';
143 }
144
145 if (s/^\s{10}//) {
146 # 10 leading spaces or more
147 # indicate commit metadata
148
149 # date & author
150 if ($lastseen eq 'id' && m/^\d{4}-\d{2}-\d{2}/) {
151
152 my ($date, $authoremail) = split(m/\s{2,}/, $_);
153 $ps{date} = $date;
154 $ps{date} =~ s/\bGMT$//; # strip off trailign GMT
155 if ($ps{date} =~ m/\b\w+$/) {
156 warn 'Arch dates not in GMT?! - imported dates will be wrong';
157 }
158
159 $authoremail =~ m/^(.+)\s(\S+)$/;
160 $ps{author} = $1;
161 $ps{email} = $2;
162
163 $lastseen = 'date';
164
165 } elsif ($lastseen eq 'date') {
166 # the only hint is position
167 # subject is after date
168 $ps{subj} = $_;
169 $lastseen = 'subj';
170
171 } elsif ($lastseen eq 'subj' && $_ eq 'merges in:') {
172 $ps{merges} = [];
173 $lastseen = 'merges';
174
175 } elsif ($lastseen eq 'merges' && s/^\s{2}//) {
176 push (@{$ps{merges}}, $_);
177 } else {
178 warn 'more metadata after merges!?';
179 }
180
181 }
182 }
183
184 if (%ps) {
185 my %temp = %ps; # break references
b779d5f0
ML
186 push (@psets, \%temp);
187 $psets{ $temp{id} } = \%temp;
d3968363
ML
188 %ps = ();
189 }
190 close ABROWSE;
191} # end foreach $root
192
193## Order patches by time
194@psets = sort {$a->{date}.$b->{id} cmp $b->{date}.$b->{id}} @psets;
195
196#print Dumper \@psets;
197
198##
199## TODO cleanup irrelevant patches
200## and put an initial import
201## or a full tag
3292ae47 202my $import = 0;
1d4710d0 203unless (-d $git_dir) { # initial import
d3968363
ML
204 if ($psets[0]{type} eq 'i' || $psets[0]{type} eq 't') {
205 print "Starting import from $psets[0]{id}\n";
3292ae47
ML
206 `git-init-db`;
207 die $! if $?;
208 $import = 1;
d3968363
ML
209 } else {
210 die "Need to start from an import or a tag -- cannot use $psets[0]{id}";
211 }
b779d5f0
ML
212} else { # progressing an import
213 # load the rptags
1d4710d0 214 opendir(DIR, "$git_dir/archimport/tags")
b779d5f0
ML
215 || die "can't opendir: $!";
216 while (my $file = readdir(DIR)) {
a7fb51d3
EW
217 # skip non-interesting-files
218 next unless -f "$ptag_dir/$file";
219
220 # convert first '--' to '/' from old git-archimport to use
221 # as an archivename/c--b--v private tag
222 if ($file !~ m!,!) {
223 my $oldfile = $file;
224 $file =~ s!--!,!;
225 print STDERR "converting old tag $oldfile to $file\n";
226 rename("$ptag_dir/$oldfile", "$ptag_dir/$file") or die $!;
227 }
b779d5f0
ML
228 my $sha = ptag($file);
229 chomp $sha;
b779d5f0
ML
230 $rptags{$sha} = $file;
231 }
232 closedir DIR;
d3968363
ML
233}
234
3292ae47 235# process patchsets
22ff00fc
EW
236# extract the Arch repository name (Arch "archive" in Arch-speak)
237sub extract_reponame {
238 my $fq_cvbr = shift; # archivename/[[[[category]branch]version]revision]
239 return (split(/\//, $fq_cvbr))[0];
240}
241
242sub extract_versionname {
243 my $name = shift;
244 $name =~ s/--(?:patch|version(?:fix)?|base)-\d+$//;
245 return $name;
246}
d3968363 247
22ff00fc
EW
248# convert a fully-qualified revision or version to a unique dirname:
249# normalperson@yhbt.net-05/mpd--uclinux--1--patch-2
250# becomes: normalperson@yhbt.net-05,mpd--uclinux--1
251#
252# the git notion of a branch is closer to
253# archive/category--branch--version than archive/category--branch, so we
254# use this to convert to git branch names.
255# Also, keep archive names but replace '/' with ',' since it won't require
256# subdirectories, and is safer than swapping '--' which could confuse
257# reverse-mapping when dealing with bastard branches that
258# are just archive/category--version (no --branch)
259sub tree_dirname {
260 my $revision = shift;
261 my $name = extract_versionname($revision);
262 $name =~ s#/#,#;
263 return $name;
264}
265
fee3365f
ML
266# old versions of git-archimport just use the <category--branch> part:
267sub old_style_branchname {
268 my $id = shift;
269 my $ret = safe_pipe_capture($TLA,'parse-package-name','-p',$id);
270 chomp $ret;
271 return $ret;
272}
273
274*git_branchname = $opt_o ? *old_style_branchname : *tree_dirname;
22ff00fc
EW
275
276# process patchsets
277foreach my $ps (@psets) {
278 $ps->{branch} = git_branchname($ps->{id});
d3968363
ML
279
280 #
281 # ensure we have a clean state
282 #
283 if (`git diff-files`) {
284 die "Unclean tree when about to process $ps->{id} " .
285 " - did we fail to commit cleanly before?";
286 }
287 die $! if $?;
288
3292ae47
ML
289 #
290 # skip commits already in repo
291 #
292 if (ptag($ps->{id})) {
37f15d50 293 $opt_v && print " * Skipping already imported: $ps->{id}\n";
3292ae47
ML
294 next;
295 }
296
37f15d50
ML
297 print " * Starting to work on $ps->{id}\n";
298
d3968363
ML
299 #
300 # create the branch if needed
301 #
3292ae47
ML
302 if ($ps->{type} eq 'i' && !$import) {
303 die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";
d3968363
ML
304 }
305
3292ae47 306 unless ($import) { # skip for import
1d4710d0 307 if ( -e "$git_dir/refs/heads/$ps->{branch}") {
d3968363
ML
308 # we know about this branch
309 `git checkout $ps->{branch}`;
310 } else {
311 # new branch! we need to verify a few things
312 die "Branch on a non-tag!" unless $ps->{type} eq 't';
313 my $branchpoint = ptag($ps->{tag});
314 die "Tagging from unknown id unsupported: $ps->{tag}"
315 unless $branchpoint;
316
317 # find where we are supposed to branch from
318 `git checkout -b $ps->{branch} $branchpoint`;
52586ecb
ML
319
320 # If we trust Arch with the fact that this is just
321 # a tag, and it does not affect the state of the tree
322 # then we just tag and move on
323 tag($ps->{id}, $branchpoint);
324 ptag($ps->{id}, $branchpoint);
325 print " * Tagged $ps->{id} at $branchpoint\n";
326 next;
d3968363
ML
327 }
328 die $! if $?;
329 }
330
d3968363
ML
331 #
332 # Apply the import/changeset/merge into the working tree
333 #
334 if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
d3968363 335 apply_import($ps) or die $!;
3292ae47 336 $import=0;
d3968363
ML
337 } elsif ($ps->{type} eq 's') {
338 apply_cset($ps);
339 }
340
341 #
342 # prepare update git's index, based on what arch knows
343 # about the pset, resolve parents, etc
344 #
345 my $tree;
346
347 my $commitlog = `tla cat-archive-log -A $ps->{repo} $ps->{id}`;
348 die "Error in cat-archive-log: $!" if $?;
349
350 # parselog will git-add/rm files
351 # and generally prepare things for the commit
352 # NOTE: parselog will shell-quote filenames!
353 my ($sum, $msg, $add, $del, $mod, $ren) = parselog($commitlog);
354 my $logmessage = "$sum\n$msg";
355
356
357 # imports don't give us good info
358 # on added files. Shame on them
359 if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
1d4710d0 360 `find . -type f -print0 | grep -zv '^./$git_dir' | xargs -0 -l100 git-update-index --add`;
215a7ad1 361 `git-ls-files --deleted -z | xargs --no-run-if-empty -0 -l100 git-update-index --remove`;
d3968363
ML
362 }
363
364 if (@$add) {
365 while (@$add) {
366 my @slice = splice(@$add, 0, 100);
367 my $slice = join(' ', @slice);
215a7ad1
JH
368 `git-update-index --add $slice`;
369 die "Error in git-update-index --add: $!" if $?;
d3968363
ML
370 }
371 }
372 if (@$del) {
373 foreach my $file (@$del) {
374 unlink $file or die "Problems deleting $file : $!";
375 }
376 while (@$del) {
377 my @slice = splice(@$del, 0, 100);
378 my $slice = join(' ', @slice);
215a7ad1
JH
379 `git-update-index --remove $slice`;
380 die "Error in git-update-index --remove: $!" if $?;
d3968363
ML
381 }
382 }
383 if (@$ren) { # renamed
384 if (@$ren % 2) {
385 die "Odd number of entries in rename!?";
386 }
387 ;
388 while (@$ren) {
389 my $from = pop @$ren;
390 my $to = pop @$ren;
391
392 unless (-d dirname($to)) {
393 mkpath(dirname($to)); # will die on err
394 }
395 #print "moving $from $to";
396 `mv $from $to`;
397 die "Error renaming $from $to : $!" if $?;
215a7ad1
JH
398 `git-update-index --remove $from`;
399 die "Error in git-update-index --remove: $!" if $?;
400 `git-update-index --add $to`;
401 die "Error in git-update-index --add: $!" if $?;
d3968363
ML
402 }
403
404 }
405 if (@$mod) { # must be _after_ renames
406 while (@$mod) {
407 my @slice = splice(@$mod, 0, 100);
408 my $slice = join(' ', @slice);
215a7ad1
JH
409 `git-update-index $slice`;
410 die "Error in git-update-index: $!" if $?;
d3968363
ML
411 }
412 }
413
215a7ad1 414 # warn "errors when running git-update-index! $!";
d3968363
ML
415 $tree = `git-write-tree`;
416 die "cannot write tree $!" if $?;
417 chomp $tree;
418
419
420 #
421 # Who's your daddy?
422 #
423 my @par;
1d4710d0
ML
424 if ( -e "$git_dir/refs/heads/$ps->{branch}") {
425 if (open HEAD, "<$git_dir/refs/heads/$ps->{branch}") {
d3968363
ML
426 my $p = <HEAD>;
427 close HEAD;
428 chomp $p;
429 push @par, '-p', $p;
430 } else {
431 if ($ps->{type} eq 's') {
432 warn "Could not find the right head for the branch $ps->{branch}";
433 }
434 }
435 }
436
b779d5f0
ML
437 if ($ps->{merges}) {
438 push @par, find_parents($ps);
439 }
d3968363
ML
440 my $par = join (' ', @par);
441
442 #
443 # Commit, tag and clean state
444 #
445 $ENV{TZ} = 'GMT';
446 $ENV{GIT_AUTHOR_NAME} = $ps->{author};
447 $ENV{GIT_AUTHOR_EMAIL} = $ps->{email};
448 $ENV{GIT_AUTHOR_DATE} = $ps->{date};
449 $ENV{GIT_COMMITTER_NAME} = $ps->{author};
450 $ENV{GIT_COMMITTER_EMAIL} = $ps->{email};
451 $ENV{GIT_COMMITTER_DATE} = $ps->{date};
452
453 my ($pid, $commit_rh, $commit_wh);
454 $commit_rh = 'commit_rh';
455 $commit_wh = 'commit_wh';
456
457 $pid = open2(*READER, *WRITER, "git-commit-tree $tree $par")
458 or die $!;
459 print WRITER $logmessage; # write
460 close WRITER;
461 my $commitid = <READER>; # read
462 chomp $commitid;
463 close READER;
464 waitpid $pid,0; # close;
465
466 if (length $commitid != 40) {
467 die "Something went wrong with the commit! $! $commitid";
468 }
469 #
470 # Update the branch
471 #
1d4710d0 472 open HEAD, ">$git_dir/refs/heads/$ps->{branch}";
d3968363
ML
473 print HEAD $commitid;
474 close HEAD;
8366a10a 475 system('git-update-ref', 'HEAD', "$ps->{branch}");
d3968363
ML
476
477 # tag accordingly
478 ptag($ps->{id}, $commitid); # private tag
479 if ($opt_T || $ps->{type} eq 't' || $ps->{type} eq 'i') {
480 tag($ps->{id}, $commitid);
481 }
482 print " * Committed $ps->{id}\n";
483 print " + tree $tree\n";
484 print " + commit $commitid\n";
b779d5f0
ML
485 $opt_v && print " + commit date is $ps->{date} \n";
486 $opt_v && print " + parents: $par \n";
d3968363
ML
487}
488
d3968363
ML
489sub apply_import {
490 my $ps = shift;
22ff00fc 491 my $bname = git_branchname($ps->{id});
d3968363
ML
492
493 `mkdir -p $tmp`;
494
495 `tla get -s --no-pristine -A $ps->{repo} $ps->{id} $tmp/import`;
496 die "Cannot get import: $!" if $?;
1d4710d0 497 `rsync -v --archive --delete --exclude '$git_dir' --exclude '.arch-ids' --exclude '{arch}' $tmp/import/* ./`;
d3968363
ML
498 die "Cannot rsync import:$!" if $?;
499
500 `rm -fr $tmp/import`;
501 die "Cannot remove tempdir: $!" if $?;
502
503
504 return 1;
505}
506
507sub apply_cset {
508 my $ps = shift;
509
510 `mkdir -p $tmp`;
511
512 # get the changeset
513 `tla get-changeset -A $ps->{repo} $ps->{id} $tmp/changeset`;
514 die "Cannot get changeset: $!" if $?;
515
516 # apply patches
517 if (`find $tmp/changeset/patches -type f -name '*.patch'`) {
518 # this can be sped up considerably by doing
519 # (find | xargs cat) | patch
520 # but that cna get mucked up by patches
521 # with missing trailing newlines or the standard
522 # 'missing newline' flag in the patch - possibly
523 # produced with an old/buggy diff.
524 # slow and safe, we invoke patch once per patchfile
525 `find $tmp/changeset/patches -type f -name '*.patch' -print0 | grep -zv '{arch}' | xargs -iFILE -0 --no-run-if-empty patch -p1 --forward -iFILE`;
526 die "Problem applying patches! $!" if $?;
527 }
528
529 # apply changed binary files
530 if (my @modified = `find $tmp/changeset/patches -type f -name '*.modified'`) {
531 foreach my $mod (@modified) {
532 chomp $mod;
533 my $orig = $mod;
534 $orig =~ s/\.modified$//; # lazy
535 $orig =~ s!^\Q$tmp\E/changeset/patches/!!;
536 #print "rsync -p '$mod' '$orig'";
537 `rsync -p $mod ./$orig`;
538 die "Problem applying binary changes! $!" if $?;
539 }
540 }
541
542 # bring in new files
1d4710d0 543 `rsync --archive --exclude '$git_dir' --exclude '.arch-ids' --exclude '{arch}' $tmp/changeset/new-files-archive/* ./`;
d3968363
ML
544
545 # deleted files are hinted from the commitlog processing
546
547 `rm -fr $tmp/changeset`;
548}
549
550
551# =for reference
552# A log entry looks like
553# Revision: moodle-org--moodle--1.3.3--patch-15
554# Archive: arch-eduforge@catalyst.net.nz--2004
555# Creator: Penny Leach <penny@catalyst.net.nz>
556# Date: Wed May 25 14:15:34 NZST 2005
557# Standard-date: 2005-05-25 02:15:34 GMT
558# New-files: lang/de/.arch-ids/block_glossary_random.php.id
559# lang/de/.arch-ids/block_html.php.id
560# New-directories: lang/de/help/questionnaire
561# lang/de/help/questionnaire/.arch-ids
562# Renamed-files: .arch-ids/db_sears.sql.id db/.arch-ids/db_sears.sql.id
563# db_sears.sql db/db_sears.sql
564# Removed-files: lang/be/docs/.arch-ids/release.html.id
565# lang/be/docs/.arch-ids/releaseold.html.id
566# Modified-files: admin/cron.php admin/delete.php
567# admin/editor.html backup/lib.php backup/restore.php
568# New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15
569# Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+)
570# Keywords:
571#
572# Updating yadda tadda tadda madda
573sub parselog {
574 my $log = shift;
575 #print $log;
576
577 my (@add, @del, @mod, @ren, @kw, $sum, $msg );
578
579 if ($log =~ m/(?:\n|^)New-files:(.*?)(?=\n\w)/s ) {
580 my $files = $1;
581 @add = split(m/\s+/s, $files);
582 }
583
584 if ($log =~ m/(?:\n|^)Removed-files:(.*?)(?=\n\w)/s ) {
585 my $files = $1;
586 @del = split(m/\s+/s, $files);
587 }
588
589 if ($log =~ m/(?:\n|^)Modified-files:(.*?)(?=\n\w)/s ) {
590 my $files = $1;
591 @mod = split(m/\s+/s, $files);
592 }
593
594 if ($log =~ m/(?:\n|^)Renamed-files:(.*?)(?=\n\w)/s ) {
595 my $files = $1;
596 @ren = split(m/\s+/s, $files);
597 }
598
599 $sum ='';
600 if ($log =~ m/^Summary:(.+?)$/m ) {
601 $sum = $1;
602 $sum =~ s/^\s+//;
603 $sum =~ s/\s+$//;
604 }
605
606 $msg = '';
607 if ($log =~ m/\n\n(.+)$/s) {
608 $msg = $1;
609 $msg =~ s/^\s+//;
610 $msg =~ s/\s+$//;
611 }
612
613
614 # cleanup the arrays
615 foreach my $ref ( (\@add, \@del, \@mod, \@ren) ) {
616 my @tmp = ();
617 while (my $t = pop @$ref) {
618 next unless length ($t);
619 next if $t =~ m!\{arch\}/!;
620 next if $t =~ m!\.arch-ids/!;
621 next if $t =~ m!\.arch-inventory$!;
f84f9d38
ML
622 # tla cat-archive-log will give us filenames with spaces as file\(sp)name - why?
623 # we can assume that any filename with \ indicates some pika escaping that we want to get rid of.
624 if ($t =~ /\\/ ){
625 $t = `tla escape --unescaped '$t'`;
626 }
d3968363
ML
627 push (@tmp, shell_quote($t));
628 }
629 @$ref = @tmp;
630 }
631
632 #print Dumper [$sum, $msg, \@add, \@del, \@mod, \@ren];
633 return ($sum, $msg, \@add, \@del, \@mod, \@ren);
634}
635
636# write/read a tag
637sub tag {
638 my ($tag, $commit) = @_;
a7fb51d3 639
fee3365f
ML
640 if ($opt_o) {
641 $tag =~ s|/|--|g;
642 } else {
643 # don't use subdirs for tags yet, it could screw up other porcelains
644 $tag =~ s|/|,|g;
645 }
d3968363
ML
646
647 if ($commit) {
a7fb51d3 648 open(C,">","$git_dir/refs/tags/$tag")
d3968363
ML
649 or die "Cannot create tag $tag: $!\n";
650 print C "$commit\n"
651 or die "Cannot write tag $tag: $!\n";
652 close(C)
653 or die "Cannot write tag $tag: $!\n";
a7fb51d3 654 print " * Created tag '$tag' on '$commit'\n" if $opt_v;
d3968363 655 } else { # read
a7fb51d3 656 open(C,"<","$git_dir/refs/tags/$tag")
d3968363
ML
657 or die "Cannot read tag $tag: $!\n";
658 $commit = <C>;
659 chomp $commit;
660 die "Error reading tag $tag: $!\n" unless length $commit == 40;
661 close(C)
662 or die "Cannot read tag $tag: $!\n";
663 return $commit;
664 }
665}
666
667# write/read a private tag
668# reads fail softly if the tag isn't there
669sub ptag {
670 my ($tag, $commit) = @_;
a7fb51d3
EW
671
672 # don't use subdirs for tags yet, it could screw up other porcelains
673 $tag =~ s|/|,|g;
d3968363 674
a7fb51d3
EW
675 my $tag_file = "$ptag_dir/$tag";
676 my $tag_branch_dir = dirname($tag_file);
677 mkpath($tag_branch_dir) unless (-d $tag_branch_dir);
d3968363
ML
678
679 if ($commit) { # write
a7fb51d3 680 open(C,">",$tag_file)
d3968363
ML
681 or die "Cannot create tag $tag: $!\n";
682 print C "$commit\n"
683 or die "Cannot write tag $tag: $!\n";
684 close(C)
685 or die "Cannot write tag $tag: $!\n";
b779d5f0
ML
686 $rptags{$commit} = $tag
687 unless $tag =~ m/--base-0$/;
d3968363
ML
688 } else { # read
689 # if the tag isn't there, return 0
a7fb51d3 690 unless ( -s $tag_file) {
d3968363
ML
691 return 0;
692 }
a7fb51d3 693 open(C,"<",$tag_file)
d3968363
ML
694 or die "Cannot read tag $tag: $!\n";
695 $commit = <C>;
696 chomp $commit;
697 die "Error reading tag $tag: $!\n" unless length $commit == 40;
698 close(C)
699 or die "Cannot read tag $tag: $!\n";
b779d5f0
ML
700 unless (defined $rptags{$commit}) {
701 $rptags{$commit} = $tag;
702 }
d3968363
ML
703 return $commit;
704 }
705}
b779d5f0
ML
706
707sub find_parents {
708 #
709 # Identify what branches are merging into me
710 # and whether we are fully merged
711 # git-merge-base <headsha> <headsha> should tell
712 # me what the base of the merge should be
713 #
714 my $ps = shift;
715
716 my %branches; # holds an arrayref per branch
717 # the arrayref contains a list of
718 # merged patches between the base
719 # of the merge and the current head
720
721 my @parents; # parents found for this commit
722
723 # simple loop to split the merges
724 # per branch
725 foreach my $merge (@{$ps->{merges}}) {
22ff00fc 726 my $branch = git_branchname($merge);
b779d5f0
ML
727 unless (defined $branches{$branch} ){
728 $branches{$branch} = [];
729 }
730 push @{$branches{$branch}}, $merge;
731 }
732
733 #
734 # foreach branch find a merge base and walk it to the
735 # head where we are, collecting the merged patchsets that
736 # Arch has recorded. Keep that in @have
737 # Compare that with the commits on the other branch
738 # between merge-base and the tip of the branch (@need)
739 # and see if we have a series of consecutive patches
740 # starting from the merge base. The tip of the series
741 # of consecutive patches merged is our new parent for
742 # that branch.
743 #
744 foreach my $branch (keys %branches) {
37f15d50
ML
745
746 # check that we actually know about the branch
747 next unless -e "$git_dir/refs/heads/$branch";
748
b779d5f0 749 my $mergebase = `git-merge-base $branch $ps->{branch}`;
9b626e75
EW
750 if ($?) {
751 # Don't die here, Arch supports one-way cherry-picking
752 # between branches with no common base (or any relationship
753 # at all beforehand)
754 warn "Cannot find merge base for $branch and $ps->{branch}";
755 next;
756 }
b779d5f0
ML
757 chomp $mergebase;
758
759 # now walk up to the mergepoint collecting what patches we have
760 my $branchtip = git_rev_parse($ps->{branch});
761 my @ancestors = `git-rev-list --merge-order $branchtip ^$mergebase`;
762 my %have; # collected merges this branch has
763 foreach my $merge (@{$ps->{merges}}) {
764 $have{$merge} = 1;
765 }
766 my %ancestorshave;
767 foreach my $par (@ancestors) {
768 $par = commitid2pset($par);
769 if (defined $par->{merges}) {
770 foreach my $merge (@{$par->{merges}}) {
771 $ancestorshave{$merge}=1;
772 }
773 }
774 }
775 # print "++++ Merges in $ps->{id} are....\n";
776 # my @have = sort keys %have; print Dumper(\@have);
777
778 # merge what we have with what ancestors have
779 %have = (%have, %ancestorshave);
780
781 # see what the remote branch has - these are the merges we
782 # will want to have in a consecutive series from the mergebase
783 my $otherbranchtip = git_rev_parse($branch);
784 my @needraw = `git-rev-list --merge-order $otherbranchtip ^$mergebase`;
785 my @need;
786 foreach my $needps (@needraw) { # get the psets
787 $needps = commitid2pset($needps);
788 # git-rev-list will also
789 # list commits merged in via earlier
790 # merges. we are only interested in commits
791 # from the branch we're looking at
792 if ($branch eq $needps->{branch}) {
793 push @need, $needps->{id};
794 }
795 }
796
797 # print "++++ Merges from $branch we want are....\n";
798 # print Dumper(\@need);
799
800 my $newparent;
801 while (my $needed_commit = pop @need) {
802 if ($have{$needed_commit}) {
803 $newparent = $needed_commit;
804 } else {
805 last; # break out of the while
806 }
807 }
808 if ($newparent) {
809 push @parents, $newparent;
810 }
811
812
813 } # end foreach branch
814
815 # prune redundant parents
816 my %parents;
817 foreach my $p (@parents) {
818 $parents{$p} = 1;
819 }
820 foreach my $p (@parents) {
821 next unless exists $psets{$p}{merges};
822 next unless ref $psets{$p}{merges};
823 my @merges = @{$psets{$p}{merges}};
824 foreach my $merge (@merges) {
825 if ($parents{$merge}) {
826 delete $parents{$merge};
827 }
828 }
829 }
830 @parents = keys %parents;
831 @parents = map { " -p " . ptag($_) } @parents;
832 return @parents;
833}
834
835sub git_rev_parse {
836 my $name = shift;
837 my $val = `git-rev-parse $name`;
838 die "Error: git-rev-parse $name" if $?;
839 chomp $val;
840 return $val;
841}
842
843# resolve a SHA1 to a known patchset
844sub commitid2pset {
845 my $commitid = shift;
846 chomp $commitid;
847 my $name = $rptags{$commitid}
848 || die "Cannot find reverse tag mapping for $commitid";
a7fb51d3 849 $name =~ s|,|/|;
b779d5f0
ML
850 my $ps = $psets{$name}
851 || (print Dumper(sort keys %psets)) && die "Cannot find patchset for $name";
852 return $ps;
853}
2777ef76
EW
854
855# an alterative to `command` that allows input to be passed as an array
856# to work around shell problems with weird characters in arguments
857sub safe_pipe_capture {
858 my @output;
859 if (my $pid = open my $child, '-|') {
860 @output = (<$child>);
861 close $child or die join(' ',@_).": $! $?";
862 } else {
863 exec(@_) or die $?; # exec() can fail the executable can't be found
864 }
865 return wantarray ? @output : join('',@output);
866}
867
868