d5c7e47967119a94b72d0459a1f6931c57161afe
1#!/usr/bin/env perl
2# Copyright (C) 2006, Eric Wong <normalperson@yhbt.net>
3# License: GPL v2 or later
4use warnings;
5use strict;
6use vars qw/ $AUTHOR $VERSION
7 $SVN_URL $SVN_INFO $SVN_WC $SVN_UUID
8 $GIT_SVN_INDEX $GIT_SVN
9 $GIT_DIR $REV_DIR $GIT_SVN_DIR/;
10$AUTHOR = 'Eric Wong <normalperson@yhbt.net>';
11$VERSION = '1.1.0-pre';
12use Cwd qw/abs_path/;
14$GIT_DIR = abs_path($ENV{GIT_DIR} || '.git');
15$ENV{GIT_DIR} = $GIT_DIR;
16my $LC_ALL = $ENV{LC_ALL};
18# make sure the svn binary gives consistent output between locales and TZs:
19$ENV{TZ} = 'UTC';
20$ENV{LC_ALL} = 'C';
21# If SVN:: library support is added, please make the dependencies
23# optional and preserve the capability to use the command-line client.
24# use eval { require SVN::... } to make it lazy load
25# We don't use any modules not in the standard Perl distribution:
26use Carp qw/croak/;
27use IO::File qw//;
28use File::Basename qw/dirname basename/;
29use File::Path qw/mkpath/;
30use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/;
31use File::Spec qw//;
32use POSIX qw/strftime/;
33my $sha1 = qr/[a-f\d]{40}/;
34my $sha1_short = qr/[a-f\d]{4,40}/;
35my ($_revision,$_stdin,$_no_ignore_ext,$_no_stop_copy,$_help,$_rmdir,$_edit,
36 $_find_copies_harder, $_l, $_cp_similarity,
37 $_repack, $_repack_nr, $_repack_flags,
38 $_template, $_shared, $_no_default_regex, $_no_graft_copy,
39 $_version, $_upgrade, $_authors, $_branch_all_refs, @_opt_m);
40my (@_branch_from, %tree_map, %users);
41my ($_svn_co_url_revs, $_svn_pg_peg_revs);
42my @repo_path_split_cache;
43my %fc_opts = ( 'no-ignore-externals' => \$_no_ignore_ext,
45 'branch|b=s' => \@_branch_from,
46 'branch-all-refs|B' => \$_branch_all_refs,
47 'authors-file|A=s' => \$_authors,
48 'repack:i' => \$_repack,
49 'repack-flags|repack-args|repack-opts=s' => \$_repack_flags);
50my ($_trunk, $_tags, $_branches);
52my %multi_opts = ( 'trunk|T=s' => \$_trunk,
53 'tags|t=s' => \$_tags,
54 'branches|b=s' => \$_branches );
55my %init_opts = ( 'template=s' => \$_template, 'shared' => \$_shared );
56# yes, 'native' sets "\n". Patches to fix this for non-*nix systems welcome:
58my %EOL = ( CR => "\015", LF => "\012", CRLF => "\015\012", native => "\012" );
59my %cmd = (
61 fetch => [ \&fetch, "Download new revisions from SVN",
62 { 'revision|r=s' => \$_revision, %fc_opts } ],
63 init => [ \&init, "Initialize a repo for tracking" .
64 " (requires URL argument)",
65 \%init_opts ],
66 commit => [ \&commit, "Commit git revisions to SVN",
67 { 'stdin|' => \$_stdin,
68 'edit|e' => \$_edit,
69 'rmdir' => \$_rmdir,
70 'find-copies-harder' => \$_find_copies_harder,
71 'l=i' => \$_l,
72 'copy-similarity|C=i'=> \$_cp_similarity,
73 %fc_opts,
74 } ],
75 'show-ignore' => [ \&show_ignore, "Show svn:ignore listings", { } ],
76 rebuild => [ \&rebuild, "Rebuild git-svn metadata (after git clone)",
77 { 'no-ignore-externals' => \$_no_ignore_ext,
78 'upgrade' => \$_upgrade } ],
79 'graft-branches' => [ \&graft_branches,
80 'Detect merges/branches from already imported history',
81 { 'merge-rx|m' => \@_opt_m,
82 'no-default-regex' => \$_no_default_regex,
83 'no-graft-copy' => \$_no_graft_copy } ],
84 'multi-init' => [ \&multi_init,
85 'Initialize multiple trees (like git-svnimport)',
86 { %multi_opts, %fc_opts } ],
87 'multi-fetch' => [ \&multi_fetch,
88 'Fetch multiple trees (like git-svnimport)',
89 \%fc_opts ],
90);
91my $cmd;
93for (my $i = 0; $i < @ARGV; $i++) {
94 if (defined $cmd{$ARGV[$i]}) {
95 $cmd = $ARGV[$i];
96 splice @ARGV, $i, 1;
97 last;
98 }
99};
100my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
102read_repo_config(\%opts);
104GetOptions(%opts, 'help|H|h' => \$_help,
105 'version|V' => \$_version,
106 'id|i=s' => \$GIT_SVN) or exit 1;
107set_default_vals();
109usage(0) if $_help;
110version() if $_version;
111usage(1) unless defined $cmd;
112init_vars();
113load_authors() if $_authors;
114load_all_refs() if $_branch_all_refs;
115svn_compat_check();
116migration_check() unless $cmd =~ /^(?:init|multi-init)$/;
117$cmd{$cmd}->[0]->(@ARGV);
118exit 0;
119####################### primary functions ######################
121sub usage {
122 my $exit = shift || 0;
123 my $fd = $exit ? \*STDERR : \*STDOUT;
124 print $fd <<"";
125git-svn - bidirectional operations between a single Subversion tree and git
126Usage: $0 <command> [options] [arguments]\n
127 print $fd "Available commands:\n" unless $cmd;
129 foreach (sort keys %cmd) {
131 next if $cmd && $cmd ne $_;
132 print $fd ' ',pack('A13',$_),$cmd{$_}->[1],"\n";
133 foreach (keys %{$cmd{$_}->[2]}) {
134 # prints out arguments as they should be passed:
135 my $x = s#[:=]s$## ? '<arg>' : s#[:=]i$## ? '<num>' : '';
136 print $fd ' ' x 17, join(', ', map { length $_ > 1 ?
137 "--$_" : "-$_" }
138 split /\|/,$_)," $x\n";
139 }
140 }
141 print $fd <<"";
142\nGIT_SVN_ID may be set in the environment or via the --id/-i switch to an
143arbitrary identifier if you're tracking multiple SVN branches/repositories in
144one git repository and want to keep them separate. See git-svn(1) for more
145information.
146 exit $exit;
148}
149sub version {
151 print "git-svn version $VERSION\n";
152 exit 0;
153}
154sub rebuild {
156 $SVN_URL = shift or undef;
157 my $newest_rev = 0;
158 if ($_upgrade) {
159 sys('git-update-ref',"refs/remotes/$GIT_SVN","$GIT_SVN-HEAD");
160 } else {
161 check_upgrade_needed();
162 }
163 my $pid = open(my $rev_list,'-|');
165 defined $pid or croak $!;
166 if ($pid == 0) {
167 exec("git-rev-list","refs/remotes/$GIT_SVN") or croak $!;
168 }
169 my $latest;
170 while (<$rev_list>) {
171 chomp;
172 my $c = $_;
173 croak "Non-SHA1: $c\n" unless $c =~ /^$sha1$/o;
174 my @commit = grep(/^git-svn-id: /,`git-cat-file commit $c`);
175 next if (!@commit); # skip merges
176 my $id = $commit[$#commit];
177 my ($url, $rev, $uuid) = ($id =~ /^git-svn-id:\s(\S+?)\@(\d+)
178 \s([a-f\d\-]+)$/x);
179 if (!$rev || !$uuid || !$url) {
180 # some of the original repositories I made had
181 # indentifiers like this:
182 ($rev, $uuid) = ($id =~/^git-svn-id:\s(\d+)
183 \@([a-f\d\-]+)/x);
184 if (!$rev || !$uuid) {
185 croak "Unable to extract revision or UUID from ",
186 "$c, $id\n";
187 }
188 }
189 # if we merged or otherwise started elsewhere, this is
191 # how we break out of it
192 next if (defined $SVN_UUID && ($uuid ne $SVN_UUID));
193 next if (defined $SVN_URL && defined $url && ($url ne $SVN_URL));
194 print "r$rev = $c\n";
196 unless (defined $latest) {
197 if (!$SVN_URL && !$url) {
198 croak "SVN repository location required: $url\n";
199 }
200 $SVN_URL ||= $url;
201 $SVN_UUID ||= $uuid;
202 setup_git_svn();
203 $latest = $rev;
204 }
205 assert_revision_eq_or_unknown($rev, $c);
206 sys('git-update-ref',"svn/$GIT_SVN/revs/$rev",$c);
207 $newest_rev = $rev if ($rev > $newest_rev);
208 }
209 close $rev_list or croak $?;
210 if (!chdir $SVN_WC) {
211 svn_cmd_checkout($SVN_URL, $latest, $SVN_WC);
212 chdir $SVN_WC or croak $!;
213 }
214 $pid = fork;
216 defined $pid or croak $!;
217 if ($pid == 0) {
218 my @svn_up = qw(svn up);
219 push @svn_up, '--ignore-externals' unless $_no_ignore_ext;
220 sys(@svn_up,"-r$newest_rev");
221 $ENV{GIT_INDEX_FILE} = $GIT_SVN_INDEX;
222 index_changes();
223 exec('git-write-tree') or croak $!;
224 }
225 waitpid $pid, 0;
226 croak $? if $?;
227 if ($_upgrade) {
229 print STDERR <<"";
230Keeping deprecated refs/head/$GIT_SVN-HEAD for now. Please remove it
231when you have upgraded your tools and habits to use refs/remotes/$GIT_SVN
232 }
234}
235sub init {
237 $SVN_URL = shift or die "SVN repository location required " .
238 "as a command-line argument\n";
239 $SVN_URL =~ s!/+$!!; # strip trailing slash
240 unless (-d $GIT_DIR) {
241 my @init_db = ('git-init-db');
242 push @init_db, "--template=$_template" if defined $_template;
243 push @init_db, "--shared" if defined $_shared;
244 sys(@init_db);
245 }
246 setup_git_svn();
247}
248sub fetch {
250 my (@parents) = @_;
251 check_upgrade_needed();
252 $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
253 my @log_args = -d $SVN_WC ? ($SVN_WC) : ($SVN_URL);
254 unless ($_revision) {
255 $_revision = -d $SVN_WC ? 'BASE:HEAD' : '0:HEAD';
256 }
257 push @log_args, "-r$_revision";
258 push @log_args, '--stop-on-copy' unless $_no_stop_copy;
259 my $svn_log = svn_log_raw(@log_args);
261 my $base = next_log_entry($svn_log) or croak "No base revision!\n";
263 my $last_commit = undef;
264 unless (-d $SVN_WC) {
265 svn_cmd_checkout($SVN_URL,$base->{revision},$SVN_WC);
266 chdir $SVN_WC or croak $!;
267 read_uuid();
268 $last_commit = git_commit($base, @parents);
269 assert_tree($last_commit);
270 } else {
271 chdir $SVN_WC or croak $!;
272 read_uuid();
273 eval { $last_commit = file_to_s("$REV_DIR/$base->{revision}") };
274 # looks like a user manually cp'd and svn switch'ed
275 unless ($last_commit) {
276 sys(qw/svn revert -R ./);
277 assert_svn_wc_clean($base->{revision});
278 $last_commit = git_commit($base, @parents);
279 assert_tree($last_commit);
280 }
281 }
282 my @svn_up = qw(svn up);
283 push @svn_up, '--ignore-externals' unless $_no_ignore_ext;
284 my $last = $base;
285 while (my $log_msg = next_log_entry($svn_log)) {
286 assert_tree($last_commit);
287 if ($last->{revision} >= $log_msg->{revision}) {
288 croak "Out of order: last >= current: ",
289 "$last->{revision} >= $log_msg->{revision}\n";
290 }
291 # Revert is needed for cases like:
292 # https://svn.musicpd.org/Jamming/trunk (r166:167), but
293 # I can't seem to reproduce something like that on a test...
294 sys(qw/svn revert -R ./);
295 assert_svn_wc_clean($last->{revision});
296 sys(@svn_up,"-r$log_msg->{revision}");
297 $last_commit = git_commit($log_msg, $last_commit, @parents);
298 $last = $log_msg;
299 }
300 unless (-e "$GIT_DIR/refs/heads/master") {
301 sys(qw(git-update-ref refs/heads/master),$last_commit);
302 }
303 close $svn_log->{fh};
304 return $last;
305}
306sub commit {
308 my (@commits) = @_;
309 check_upgrade_needed();
310 if ($_stdin || !@commits) {
311 print "Reading from stdin...\n";
312 @commits = ();
313 while (<STDIN>) {
314 if (/\b($sha1_short)\b/o) {
315 unshift @commits, $1;
316 }
317 }
318 }
319 my @revs;
320 foreach my $c (@commits) {
321 chomp(my @tmp = safe_qx('git-rev-parse',$c));
322 if (scalar @tmp == 1) {
323 push @revs, $tmp[0];
324 } elsif (scalar @tmp > 1) {
325 push @revs, reverse (safe_qx('git-rev-list',@tmp));
326 } else {
327 die "Failed to rev-parse $c\n";
328 }
329 }
330 chomp @revs;
331 chdir $SVN_WC or croak "Unable to chdir $SVN_WC: $!\n";
333 my $info = svn_info('.');
334 my $fetched = fetch();
335 if ($info->{Revision} != $fetched->{revision}) {
336 print STDERR "There are new revisions that were fetched ",
337 "and need to be merged (or acknowledged) ",
338 "before committing.\n";
339 exit 1;
340 }
341 $info = svn_info('.');
342 read_uuid($info);
343 my $svn_current_rev = $info->{'Last Changed Rev'};
344 foreach my $c (@revs) {
345 my $mods = svn_checkout_tree($svn_current_rev, $c);
346 if (scalar @$mods == 0) {
347 print "Skipping, no changes detected\n";
348 next;
349 }
350 $svn_current_rev = svn_commit_tree($svn_current_rev, $c);
351 }
352 print "Done committing ",scalar @revs," revisions to SVN\n";
353}
354sub show_ignore {
356 require File::Find or die $!;
357 my $exclude_file = "$GIT_DIR/info/exclude";
358 open my $fh, '<', $exclude_file or croak $!;
359 chomp(my @excludes = (<$fh>));
360 close $fh or croak $!;
361 $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
363 chdir $SVN_WC or croak $!;
364 my %ign;
365 File::Find::find({wanted=>sub{if(lstat $_ && -d _ && -d "$_/.svn"){
366 s#^\./##;
367 @{$ign{$_}} = svn_propget_base('svn:ignore', $_);
368 }}, no_chdir=>1},'.');
369 print "\n# /\n";
371 foreach (@{$ign{'.'}}) { print '/',$_ if /\S/ }
372 delete $ign{'.'};
373 foreach my $i (sort keys %ign) {
374 print "\n# ",$i,"\n";
375 foreach (@{$ign{$i}}) { print '/',$i,'/',$_ if /\S/ }
376 }
377}
378sub graft_branches {
380 my $gr_file = "$GIT_DIR/info/grafts";
381 my ($grafts, $comments) = read_grafts($gr_file);
382 my $gr_sha1;
383 if (%$grafts) {
385 # temporarily disable our grafts file to make this idempotent
386 chomp($gr_sha1 = safe_qx(qw/git-hash-object -w/,$gr_file));
387 rename $gr_file, "$gr_file~$gr_sha1" or croak $!;
388 }
389 my $l_map = read_url_paths();
391 my @re = map { qr/$_/is } @_opt_m if @_opt_m;
392 unless ($_no_default_regex) {
393 push @re, ( qr/\b(?:merge|merging|merged)\s+(\S.+)/is,
394 qr/\b(?:from|of)\s+(\S.+)/is );
395 }
396 foreach my $u (keys %$l_map) {
397 if (@re) {
398 foreach my $p (keys %{$l_map->{$u}}) {
399 graft_merge_msg($grafts,$l_map,$u,$p);
400 }
401 }
402 graft_file_copy($grafts,$l_map,$u) unless $_no_graft_copy;
403 }
404 write_grafts($grafts, $comments, $gr_file);
406 unlink "$gr_file~$gr_sha1" if $gr_sha1;
407}
408sub multi_init {
410 my $url = shift;
411 $_trunk ||= 'trunk';
412 $_trunk =~ s#/+$##;
413 $url =~ s#/+$## if $url;
414 if ($_trunk !~ m#^[a-z\+]+://#) {
415 $_trunk = '/' . $_trunk if ($_trunk !~ m#^/#);
416 unless ($url) {
417 print STDERR "E: '$_trunk' is not a complete URL ",
418 "and a separate URL is not specified\n";
419 exit 1;
420 }
421 $_trunk = $url . $_trunk;
422 }
423 if ($GIT_SVN eq 'git-svn') {
424 print "GIT_SVN_ID set to 'trunk' for $_trunk\n";
425 $GIT_SVN = $ENV{GIT_SVN_ID} = 'trunk';
426 }
427 init_vars();
428 init($_trunk);
429 complete_url_ls_init($url, $_branches, '--branches/-b', '');
430 complete_url_ls_init($url, $_tags, '--tags/-t', 'tags/');
431}
432sub multi_fetch {
434 # try to do trunk first, since branches/tags
435 # may be descended from it.
436 if (-d "$GIT_DIR/svn/trunk") {
437 print "Fetching trunk\n";
438 defined(my $pid = fork) or croak $!;
439 if (!$pid) {
440 $GIT_SVN = $ENV{GIT_SVN_ID} = 'trunk';
441 init_vars();
442 fetch(@_);
443 exit 0;
444 }
445 waitpid $pid, 0;
446 croak $? if $?;
447 }
448 rec_fetch('', "$GIT_DIR/svn", @_);
449}
450########################### utility functions #########################
452sub rec_fetch {
454 my ($pfx, $p, @args) = @_;
455 my @dir;
456 foreach (sort <$p/*>) {
457 if (-r "$_/info/url") {
458 $pfx .= '/' if $pfx && $pfx !~ m!/$!;
459 my $id = $pfx . basename $_;
460 next if $id eq 'trunk';
461 print "Fetching $id\n";
462 defined(my $pid = fork) or croak $!;
463 if (!$pid) {
464 $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
465 init_vars();
466 fetch(@args);
467 exit 0;
468 }
469 waitpid $pid, 0;
470 croak $? if $?;
471 } elsif (-d $_) {
472 push @dir, $_;
473 }
474 }
475 foreach (@dir) {
476 my $x = $_;
477 $x =~ s!^\Q$GIT_DIR\E/svn/!!;
478 rec_fetch($x, $_);
479 }
480}
481sub complete_url_ls_init {
483 my ($url, $var, $switch, $pfx) = @_;
484 unless ($var) {
485 print STDERR "W: $switch not specified\n";
486 return;
487 }
488 $var =~ s#/+$##;
489 if ($var !~ m#^[a-z\+]+://#) {
490 $var = '/' . $var if ($var !~ m#^/#);
491 unless ($url) {
492 print STDERR "E: '$var' is not a complete URL ",
493 "and a separate URL is not specified\n";
494 exit 1;
495 }
496 $var = $url . $var;
497 }
498 chomp(my @ls = safe_qx(qw/svn ls --non-interactive/, $var));
499 my $old = $GIT_SVN;
500 defined(my $pid = fork) or croak $!;
501 if (!$pid) {
502 foreach my $u (map { "$var/$_" } (grep m!/$!, @ls)) {
503 $u =~ s#/+$##;
504 if ($u !~ m!\Q$var\E/(.+)$!) {
505 print STDERR "W: Unrecognized URL: $u\n";
506 die "This should never happen\n";
507 }
508 my $id = $pfx.$1;
509 print "init $u => $id\n";
510 $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
511 init_vars();
512 init($u);
513 }
514 exit 0;
515 }
516 waitpid $pid, 0;
517 croak $? if $?;
518}
519sub common_prefix {
521 my $paths = shift;
522 my %common;
523 foreach (@$paths) {
524 my @tmp = split m#/#, $_;
525 my $p = '';
526 while (my $x = shift @tmp) {
527 $p .= "/$x";
528 $common{$p} ||= 0;
529 $common{$p}++;
530 }
531 }
532 foreach (sort {length $b <=> length $a} keys %common) {
533 if ($common{$_} == @$paths) {
534 return $_;
535 }
536 }
537 return '';
538}
539# this isn't funky-filename safe, but good enough for now...
541sub graft_file_copy {
542 my ($grafts, $l_map, $u) = @_;
543 my $paths = $l_map->{$u};
544 my $pfx = common_prefix([keys %$paths]);
545 my $pid = open my $fh, '-|';
547 defined $pid or croak $!;
548 unless ($pid) {
549 exec(qw/svn log -v/, $u.$pfx) or croak $!;
550 }
551 my ($r, $mp) = (undef, undef);
552 while (<$fh>) {
553 chomp;
554 if (/^\-{72}$/) {
555 $mp = $r = undef;
556 } elsif (/^r(\d+) \| /) {
557 $r = $1 unless defined $r;
558 } elsif (/^Changed paths:/) {
559 $mp = 1;
560 } elsif ($mp && m#^ [AR] /(\S.*?) \(from /(\S+?):(\d+)\)$#) {
561 my $dbg = "r$r | $_";
562 my ($p1, $p0, $r0) = ($1, $2, $3);
563 my $c;
564 foreach my $x (keys %$paths) {
565 next unless ($p1 =~ /^\Q$x\E/);
566 my $i = $paths->{$x};
567 my $f = "$GIT_DIR/svn/$i/revs/$r";
568 unless (-r $f) {
569 print STDERR "r$r of $i not imported,",
570 " $dbg\n";
571 next;
572 }
573 $c = file_to_s($f);
574 }
575 next unless $c;
576 foreach my $x (keys %$paths) {
577 next unless ($p0 =~ /^\Q$x\E/);
578 my $i = $paths->{$x};
579 my $f = "$GIT_DIR/svn/$i/revs/$r0";
580 while ($r0 && !-r $f) {
581 # could be an older revision, too...
582 $r0--;
583 $f = "$GIT_DIR/svn/$i/revs/$r0";
584 }
585 unless (-r $f) {
586 print STDERR "r$r0 of $i not imported,",
587 " $dbg\n";
588 next;
589 }
590 my $r1 = file_to_s($f);
591 $grafts->{$c}->{$r1} = 1;
592 }
593 }
594 }
595}
596sub process_merge_msg_matches {
598 my ($grafts, $l_map, $u, $p, $c, @matches) = @_;
599 my (@strong, @weak);
600 foreach (@matches) {
601 # merging with ourselves is not interesting
602 next if $_ eq $p;
603 if ($l_map->{$u}->{$_}) {
604 push @strong, $_;
605 } else {
606 push @weak, $_;
607 }
608 }
609 foreach my $w (@weak) {
610 last if @strong;
611 # no exact match, use branch name as regexp.
612 my $re = qr/\Q$w\E/i;
613 foreach (keys %{$l_map->{$u}}) {
614 if (/$re/) {
615 push @strong, $_;
616 last;
617 }
618 }
619 last if @strong;
620 $w = basename($w);
621 $re = qr/\Q$w\E/i;
622 foreach (keys %{$l_map->{$u}}) {
623 if (/$re/) {
624 push @strong, $_;
625 last;
626 }
627 }
628 }
629 my ($rev) = ($c->{m} =~ /^git-svn-id:\s(?:\S+?)\@(\d+)
630 \s(?:[a-f\d\-]+)$/xsm);
631 unless (defined $rev) {
632 ($rev) = ($c->{m} =~/^git-svn-id:\s(\d+)
633 \@(?:[a-f\d\-]+)/xsm);
634 return unless defined $rev;
635 }
636 foreach my $m (@strong) {
637 my ($r0, $s0) = find_rev_before($rev, $m);
638 $grafts->{$c->{c}}->{$s0} = 1 if defined $s0;
639 }
640}
641sub graft_merge_msg {
643 my ($grafts, $l_map, $u, $p, @re) = @_;
644 my $x = $l_map->{$u}->{$p};
646 my $rl = rev_list_raw($x);
647 while (my $c = next_rev_list_entry($rl)) {
648 foreach my $re (@re) {
649 my (@br) = ($c->{m} =~ /$re/g);
650 next unless @br;
651 process_merge_msg_matches($grafts,$l_map,$u,$p,$c,@br);
652 }
653 }
654}
655sub read_uuid {
657 return if $SVN_UUID;
658 my $info = shift || svn_info('.');
659 $SVN_UUID = $info->{'Repository UUID'} or
660 croak "Repository UUID unreadable\n";
661 s_to_file($SVN_UUID,"$GIT_SVN_DIR/info/uuid");
662}
663sub quiet_run {
665 my $pid = fork;
666 defined $pid or croak $!;
667 if (!$pid) {
668 open my $null, '>', '/dev/null' or croak $!;
669 open STDERR, '>&', $null or croak $!;
670 open STDOUT, '>&', $null or croak $!;
671 exec @_ or croak $!;
672 }
673 waitpid $pid, 0;
674 return $?;
675}
676sub repo_path_split {
678 my $full_url = shift;
679 $full_url =~ s#/+$##;
680 foreach (@repo_path_split_cache) {
682 if ($full_url =~ s#$_##) {
683 my $u = $1;
684 $full_url =~ s#^/+##;
685 return ($u, $full_url);
686 }
687 }
688 my ($url, $path) = ($full_url =~ m!^([a-z\+]+://[^/]*)(.*)$!i);
690 $path =~ s#^/+##;
691 my @paths = split(m#/+#, $path);
692 while (quiet_run(qw/svn ls --non-interactive/, $url)) {
694 my $n = shift @paths || last;
695 $url .= "/$n";
696 }
697 push @repo_path_split_cache, qr/^(\Q$url\E)/;
698 $path = join('/',@paths);
699 return ($url, $path);
700}
701sub setup_git_svn {
703 defined $SVN_URL or croak "SVN repository location required\n";
704 unless (-d $GIT_DIR) {
705 croak "GIT_DIR=$GIT_DIR does not exist!\n";
706 }
707 mkpath([$GIT_SVN_DIR]);
708 mkpath(["$GIT_SVN_DIR/info"]);
709 mkpath([$REV_DIR]);
710 s_to_file($SVN_URL,"$GIT_SVN_DIR/info/url");
711 open my $fd, '>>', "$GIT_SVN_DIR/info/exclude" or croak $!;
713 print $fd '.svn',"\n";
714 close $fd or croak $!;
715 my ($url, $path) = repo_path_split($SVN_URL);
716 s_to_file($url, "$GIT_SVN_DIR/info/repo_url");
717 s_to_file($path, "$GIT_SVN_DIR/info/repo_path");
718}
719sub assert_svn_wc_clean {
721 my ($svn_rev) = @_;
722 croak "$svn_rev is not an integer!\n" unless ($svn_rev =~ /^\d+$/);
723 my $lcr = svn_info('.')->{'Last Changed Rev'};
724 if ($svn_rev != $lcr) {
725 print STDERR "Checking for copy-tree ... ";
726 my @diff = grep(/^Index: /,(safe_qx(qw(svn diff),
727 "-r$lcr:$svn_rev")));
728 if (@diff) {
729 croak "Nope! Expected r$svn_rev, got r$lcr\n";
730 } else {
731 print STDERR "OK!\n";
732 }
733 }
734 my @status = grep(!/^Performing status on external/,(`svn status`));
735 @status = grep(!/^\s*$/,@status);
736 if (scalar @status) {
737 print STDERR "Tree ($SVN_WC) is not clean:\n";
738 print STDERR $_ foreach @status;
739 croak;
740 }
741}
742sub assert_tree {
744 my ($treeish) = @_;
745 croak "Not a sha1: $treeish\n" unless $treeish =~ /^$sha1$/o;
746 chomp(my $type = `git-cat-file -t $treeish`);
747 my $expected;
748 while ($type eq 'tag') {
749 chomp(($treeish, $type) = `git-cat-file tag $treeish`);
750 }
751 if ($type eq 'commit') {
752 $expected = (grep /^tree /,`git-cat-file commit $treeish`)[0];
753 ($expected) = ($expected =~ /^tree ($sha1)$/);
754 die "Unable to get tree from $treeish\n" unless $expected;
755 } elsif ($type eq 'tree') {
756 $expected = $treeish;
757 } else {
758 die "$treeish is a $type, expected tree, tag or commit\n";
759 }
760 my $old_index = $ENV{GIT_INDEX_FILE};
762 my $tmpindex = $GIT_SVN_INDEX.'.assert-tmp';
763 if (-e $tmpindex) {
764 unlink $tmpindex or croak $!;
765 }
766 $ENV{GIT_INDEX_FILE} = $tmpindex;
767 index_changes(1);
768 chomp(my $tree = `git-write-tree`);
769 if ($old_index) {
770 $ENV{GIT_INDEX_FILE} = $old_index;
771 } else {
772 delete $ENV{GIT_INDEX_FILE};
773 }
774 if ($tree ne $expected) {
775 croak "Tree mismatch, Got: $tree, Expected: $expected\n";
776 }
777 unlink $tmpindex;
778}
779sub parse_diff_tree {
781 my $diff_fh = shift;
782 local $/ = "\0";
783 my $state = 'meta';
784 my @mods;
785 while (<$diff_fh>) {
786 chomp $_; # this gets rid of the trailing "\0"
787 if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s
788 $sha1\s($sha1)\s([MTCRAD])\d*$/xo) {
789 push @mods, { mode_a => $1, mode_b => $2,
790 sha1_b => $3, chg => $4 };
791 if ($4 =~ /^(?:C|R)$/) {
792 $state = 'file_a';
793 } else {
794 $state = 'file_b';
795 }
796 } elsif ($state eq 'file_a') {
797 my $x = $mods[$#mods] or croak "Empty array\n";
798 if ($x->{chg} !~ /^(?:C|R)$/) {
799 croak "Error parsing $_, $x->{chg}\n";
800 }
801 $x->{file_a} = $_;
802 $state = 'file_b';
803 } elsif ($state eq 'file_b') {
804 my $x = $mods[$#mods] or croak "Empty array\n";
805 if (exists $x->{file_a} && $x->{chg} !~ /^(?:C|R)$/) {
806 croak "Error parsing $_, $x->{chg}\n";
807 }
808 if (!exists $x->{file_a} && $x->{chg} =~ /^(?:C|R)$/) {
809 croak "Error parsing $_, $x->{chg}\n";
810 }
811 $x->{file_b} = $_;
812 $state = 'meta';
813 } else {
814 croak "Error parsing $_\n";
815 }
816 }
817 close $diff_fh or croak $!;
818 return \@mods;
820}
821sub svn_check_prop_executable {
823 my $m = shift;
824 return if -l $m->{file_b};
825 if ($m->{mode_b} =~ /755$/) {
826 chmod((0755 &~ umask),$m->{file_b}) or croak $!;
827 if ($m->{mode_a} !~ /755$/) {
828 sys(qw(svn propset svn:executable 1), $m->{file_b});
829 }
830 -x $m->{file_b} or croak "$m->{file_b} is not executable!\n";
831 } elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
832 sys(qw(svn propdel svn:executable), $m->{file_b});
833 chmod((0644 &~ umask),$m->{file_b}) or croak $!;
834 -x $m->{file_b} and croak "$m->{file_b} is executable!\n";
835 }
836}
837sub svn_ensure_parent_path {
839 my $dir_b = dirname(shift);
840 svn_ensure_parent_path($dir_b) if ($dir_b ne File::Spec->curdir);
841 mkpath([$dir_b]) unless (-d $dir_b);
842 sys(qw(svn add -N), $dir_b) unless (-d "$dir_b/.svn");
843}
844sub precommit_check {
846 my $mods = shift;
847 my (%rm_file, %rmdir_check, %added_check);
848 my %o = ( D => 0, R => 1, C => 2, A => 3, M => 3, T => 3 );
850 foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
851 if ($m->{chg} eq 'R') {
852 if (-d $m->{file_b}) {
853 err_dir_to_file("$m->{file_a} => $m->{file_b}");
854 }
855 # dir/$file => dir/file/$file
856 my $dirname = dirname($m->{file_b});
857 while ($dirname ne File::Spec->curdir) {
858 if ($dirname ne $m->{file_a}) {
859 $dirname = dirname($dirname);
860 next;
861 }
862 err_file_to_dir("$m->{file_a} => $m->{file_b}");
863 }
864 # baz/zzz => baz (baz is a file)
865 $dirname = dirname($m->{file_a});
866 while ($dirname ne File::Spec->curdir) {
867 if ($dirname ne $m->{file_b}) {
868 $dirname = dirname($dirname);
869 next;
870 }
871 err_dir_to_file("$m->{file_a} => $m->{file_b}");
872 }
873 }
874 if ($m->{chg} =~ /^(D|R)$/) {
875 my $t = $1 eq 'D' ? 'file_b' : 'file_a';
876 $rm_file{ $m->{$t} } = 1;
877 my $dirname = dirname( $m->{$t} );
878 my $basename = basename( $m->{$t} );
879 $rmdir_check{$dirname}->{$basename} = 1;
880 } elsif ($m->{chg} =~ /^(?:A|C)$/) {
881 if (-d $m->{file_b}) {
882 err_dir_to_file($m->{file_b});
883 }
884 my $dirname = dirname( $m->{file_b} );
885 my $basename = basename( $m->{file_b} );
886 $added_check{$dirname}->{$basename} = 1;
887 while ($dirname ne File::Spec->curdir) {
888 if ($rm_file{$dirname}) {
889 err_file_to_dir($m->{file_b});
890 }
891 $dirname = dirname $dirname;
892 }
893 }
894 }
895 return (\%rmdir_check, \%added_check);
896 sub err_dir_to_file {
898 my $file = shift;
899 print STDERR "Node change from directory to file ",
900 "is not supported by Subversion: ",$file,"\n";
901 exit 1;
902 }
903 sub err_file_to_dir {
904 my $file = shift;
905 print STDERR "Node change from file to directory ",
906 "is not supported by Subversion: ",$file,"\n";
907 exit 1;
908 }
909}
910sub svn_checkout_tree {
912 my ($svn_rev, $treeish) = @_;
913 my $from = file_to_s("$REV_DIR/$svn_rev");
914 assert_tree($from);
915 print "diff-tree $from $treeish\n";
916 my $pid = open my $diff_fh, '-|';
917 defined $pid or croak $!;
918 if ($pid == 0) {
919 my @diff_tree = qw(git-diff-tree -z -r);
920 if ($_cp_similarity) {
921 push @diff_tree, "-C$_cp_similarity";
922 } else {
923 push @diff_tree, '-C';
924 }
925 push @diff_tree, '--find-copies-harder' if $_find_copies_harder;
926 push @diff_tree, "-l$_l" if defined $_l;
927 exec(@diff_tree, $from, $treeish) or croak $!;
928 }
929 my $mods = parse_diff_tree($diff_fh);
930 unless (@$mods) {
931 # git can do empty commits, but SVN doesn't allow it...
932 return $mods;
933 }
934 my ($rm, $add) = precommit_check($mods);
935 my %o = ( D => 1, R => 0, C => -1, A => 3, M => 3, T => 3 );
937 foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
938 if ($m->{chg} eq 'C') {
939 svn_ensure_parent_path( $m->{file_b} );
940 sys(qw(svn cp), $m->{file_a}, $m->{file_b});
941 apply_mod_line_blob($m);
942 svn_check_prop_executable($m);
943 } elsif ($m->{chg} eq 'D') {
944 sys(qw(svn rm --force), $m->{file_b});
945 } elsif ($m->{chg} eq 'R') {
946 svn_ensure_parent_path( $m->{file_b} );
947 sys(qw(svn mv --force), $m->{file_a}, $m->{file_b});
948 apply_mod_line_blob($m);
949 svn_check_prop_executable($m);
950 } elsif ($m->{chg} eq 'M') {
951 apply_mod_line_blob($m);
952 svn_check_prop_executable($m);
953 } elsif ($m->{chg} eq 'T') {
954 sys(qw(svn rm --force),$m->{file_b});
955 apply_mod_line_blob($m);
956 sys(qw(svn add --force), $m->{file_b});
957 svn_check_prop_executable($m);
958 } elsif ($m->{chg} eq 'A') {
959 svn_ensure_parent_path( $m->{file_b} );
960 apply_mod_line_blob($m);
961 sys(qw(svn add --force), $m->{file_b});
962 svn_check_prop_executable($m);
963 } else {
964 croak "Invalid chg: $m->{chg}\n";
965 }
966 }
967 assert_tree($treeish);
969 if ($_rmdir) { # remove empty directories
970 handle_rmdir($rm, $add);
971 }
972 assert_tree($treeish);
973 return $mods;
974}
975# svn ls doesn't work with respect to the current working tree, but what's
977# in the repository. There's not even an option for it... *sigh*
978# (added files don't show up and removed files remain in the ls listing)
979sub svn_ls_current {
980 my ($dir, $rm, $add) = @_;
981 chomp(my @ls = safe_qx('svn','ls',$dir));
982 my @ret = ();
983 foreach (@ls) {
984 s#/$##; # trailing slashes are evil
985 push @ret, $_ unless $rm->{$dir}->{$_};
986 }
987 if (exists $add->{$dir}) {
988 push @ret, keys %{$add->{$dir}};
989 }
990 return \@ret;
991}
992sub handle_rmdir {
994 my ($rm, $add) = @_;
995 foreach my $dir (sort {length $b <=> length $a} keys %$rm) {
997 my $ls = svn_ls_current($dir, $rm, $add);
998 next if (scalar @$ls);
999 sys(qw(svn rm --force),$dir);
1000 my $dn = dirname $dir;
1002 $rm->{ $dn }->{ basename $dir } = 1;
1003 $ls = svn_ls_current($dn, $rm, $add);
1004 while (scalar @$ls == 0 && $dn ne File::Spec->curdir) {
1005 sys(qw(svn rm --force),$dn);
1006 $dir = basename $dn;
1007 $dn = dirname $dn;
1008 $rm->{ $dn }->{ $dir } = 1;
1009 $ls = svn_ls_current($dn, $rm, $add);
1010 }
1011 }
1012}
1013sub svn_commit_tree {
1015 my ($svn_rev, $commit) = @_;
1016 my $commit_msg = "$GIT_SVN_DIR/.svn-commit.tmp.$$";
1017 my %log_msg = ( msg => '' );
1018 open my $msg, '>', $commit_msg or croak $!;
1019 chomp(my $type = `git-cat-file -t $commit`);
1021 if ($type eq 'commit') {
1022 my $pid = open my $msg_fh, '-|';
1023 defined $pid or croak $!;
1024 if ($pid == 0) {
1026 exec(qw(git-cat-file commit), $commit) or croak $!;
1027 }
1028 my $in_msg = 0;
1029 while (<$msg_fh>) {
1030 if (!$in_msg) {
1031 $in_msg = 1 if (/^\s*$/);
1032 } elsif (/^git-svn-id: /) {
1033 # skip this, we regenerate the correct one
1034 # on re-fetch anyways
1035 } else {
1036 print $msg $_ or croak $!;
1037 }
1038 }
1039 close $msg_fh or croak $!;
1040 }
1041 close $msg or croak $!;
1042 if ($_edit || ($type eq 'tree')) {
1044 my $editor = $ENV{VISUAL} || $ENV{EDITOR} || 'vi';
1045 system($editor, $commit_msg);
1046 }
1047 # file_to_s removes all trailing newlines, so just use chomp() here:
1049 open $msg, '<', $commit_msg or croak $!;
1050 { local $/; chomp($log_msg{msg} = <$msg>); }
1051 close $msg or croak $!;
1052 my ($oneline) = ($log_msg{msg} =~ /([^\n\r]+)/);
1054 print "Committing $commit: $oneline\n";
1055 if (defined $LC_ALL) {
1057 $ENV{LC_ALL} = $LC_ALL;
1058 } else {
1059 delete $ENV{LC_ALL};
1060 }
1061 my @ci_output = safe_qx(qw(svn commit -F),$commit_msg);
1062 $ENV{LC_ALL} = 'C';
1063 unlink $commit_msg;
1064 my ($committed) = ($ci_output[$#ci_output] =~ /(\d+)/);
1065 if (!defined $committed) {
1066 my $out = join("\n",@ci_output);
1067 print STDERR "W: Trouble parsing \`svn commit' output:\n\n",
1068 $out, "\n\nAssuming English locale...";
1069 ($committed) = ($out =~ /^Committed revision \d+\./sm);
1070 defined $committed or die " FAILED!\n",
1071 "Commit output failed to parse committed revision!\n",
1072 print STDERR " OK\n";
1073 }
1074 my @svn_up = qw(svn up);
1076 push @svn_up, '--ignore-externals' unless $_no_ignore_ext;
1077 if ($committed == ($svn_rev + 1)) {
1078 push @svn_up, "-r$committed";
1079 sys(@svn_up);
1080 my $info = svn_info('.');
1081 my $date = $info->{'Last Changed Date'} or die "Missing date\n";
1082 if ($info->{'Last Changed Rev'} != $committed) {
1083 croak "$info->{'Last Changed Rev'} != $committed\n"
1084 }
1085 my ($Y,$m,$d,$H,$M,$S,$tz) = ($date =~
1086 /(\d{4})\-(\d\d)\-(\d\d)\s
1087 (\d\d)\:(\d\d)\:(\d\d)\s([\-\+]\d+)/x)
1088 or croak "Failed to parse date: $date\n";
1089 $log_msg{date} = "$tz $Y-$m-$d $H:$M:$S";
1090 $log_msg{author} = $info->{'Last Changed Author'};
1091 $log_msg{revision} = $committed;
1092 $log_msg{msg} .= "\n";
1093 my $parent = file_to_s("$REV_DIR/$svn_rev");
1094 git_commit(\%log_msg, $parent, $commit);
1095 return $committed;
1096 }
1097 # resync immediately
1098 push @svn_up, "-r$svn_rev";
1099 sys(@svn_up);
1100 return fetch("$committed=$commit")->{revision};
1101}
1102sub rev_list_raw {
1104 my (@args) = @_;
1105 my $pid = open my $fh, '-|';
1106 defined $pid or croak $!;
1107 if (!$pid) {
1108 exec(qw/git-rev-list --pretty=raw/, @args) or croak $!;
1109 }
1110 return { fh => $fh, t => { } };
1111}
1112sub next_rev_list_entry {
1114 my $rl = shift;
1115 my $fh = $rl->{fh};
1116 my $x = $rl->{t};
1117 while (<$fh>) {
1118 if (/^commit ($sha1)$/o) {
1119 if ($x->{c}) {
1120 $rl->{t} = { c => $1 };
1121 return $x;
1122 } else {
1123 $x->{c} = $1;
1124 }
1125 } elsif (/^parent ($sha1)$/o) {
1126 $x->{p}->{$1} = 1;
1127 } elsif (s/^ //) {
1128 $x->{m} ||= '';
1129 $x->{m} .= $_;
1130 }
1131 }
1132 return ($x != $rl->{t}) ? $x : undef;
1133}
1134# read the entire log into a temporary file (which is removed ASAP)
1136# and store the file handle + parser state
1137sub svn_log_raw {
1138 my (@log_args) = @_;
1139 my $log_fh = IO::File->new_tmpfile or croak $!;
1140 my $pid = fork;
1141 defined $pid or croak $!;
1142 if (!$pid) {
1143 open STDOUT, '>&', $log_fh or croak $!;
1144 exec (qw(svn log), @log_args) or croak $!
1145 }
1146 waitpid $pid, 0;
1147 croak $? if $?;
1148 seek $log_fh, 0, 0 or croak $!;
1149 return { state => 'sep', fh => $log_fh };
1150}
1151sub next_log_entry {
1153 my $log = shift; # retval of svn_log_raw()
1154 my $ret = undef;
1155 my $fh = $log->{fh};
1156 while (<$fh>) {
1158 chomp;
1159 if (/^\-{72}$/) {
1160 if ($log->{state} eq 'msg') {
1161 if ($ret->{lines}) {
1162 $ret->{msg} .= $_."\n";
1163 unless(--$ret->{lines}) {
1164 $log->{state} = 'sep';
1165 }
1166 } else {
1167 croak "Log parse error at: $_\n",
1168 $ret->{revision},
1169 "\n";
1170 }
1171 next;
1172 }
1173 if ($log->{state} ne 'sep') {
1174 croak "Log parse error at: $_\n",
1175 "state: $log->{state}\n",
1176 $ret->{revision},
1177 "\n";
1178 }
1179 $log->{state} = 'rev';
1180 # if we have an empty log message, put something there:
1182 if ($ret) {
1183 $ret->{msg} ||= "\n";
1184 delete $ret->{lines};
1185 return $ret;
1186 }
1187 next;
1188 }
1189 if ($log->{state} eq 'rev' && s/^r(\d+)\s*\|\s*//) {
1190 my $rev = $1;
1191 my ($author, $date, $lines) = split(/\s*\|\s*/, $_, 3);
1192 ($lines) = ($lines =~ /(\d+)/);
1193 my ($Y,$m,$d,$H,$M,$S,$tz) = ($date =~
1194 /(\d{4})\-(\d\d)\-(\d\d)\s
1195 (\d\d)\:(\d\d)\:(\d\d)\s([\-\+]\d+)/x)
1196 or croak "Failed to parse date: $date\n";
1197 $ret = { revision => $rev,
1198 date => "$tz $Y-$m-$d $H:$M:$S",
1199 author => $author,
1200 lines => $lines,
1201 msg => '' };
1202 if (defined $_authors && ! defined $users{$author}) {
1203 die "Author: $author not defined in ",
1204 "$_authors file\n";
1205 }
1206 $log->{state} = 'msg_start';
1207 next;
1208 }
1209 # skip the first blank line of the message:
1210 if ($log->{state} eq 'msg_start' && /^$/) {
1211 $log->{state} = 'msg';
1212 } elsif ($log->{state} eq 'msg') {
1213 if ($ret->{lines}) {
1214 $ret->{msg} .= $_."\n";
1215 unless (--$ret->{lines}) {
1216 $log->{state} = 'sep';
1217 }
1218 } else {
1219 croak "Log parse error at: $_\n",
1220 $ret->{revision},"\n";
1221 }
1222 }
1223 }
1224 return $ret;
1225}
1226sub svn_info {
1228 my $url = shift || $SVN_URL;
1229 my $pid = open my $info_fh, '-|';
1231 defined $pid or croak $!;
1232 if ($pid == 0) {
1234 exec(qw(svn info),$url) or croak $!;
1235 }
1236 my $ret = {};
1238 # only single-lines seem to exist in svn info output
1239 while (<$info_fh>) {
1240 chomp $_;
1241 if (m#^([^:]+)\s*:\s*(\S.*)$#) {
1242 $ret->{$1} = $2;
1243 push @{$ret->{-order}}, $1;
1244 }
1245 }
1246 close $info_fh or croak $!;
1247 return $ret;
1248}
1249sub sys { system(@_) == 0 or croak $? }
1251sub eol_cp {
1253 my ($from, $to) = @_;
1254 my $es = svn_propget_base('svn:eol-style', $to);
1255 open my $rfd, '<', $from or croak $!;
1256 binmode $rfd or croak $!;
1257 open my $wfd, '>', $to or croak $!;
1258 binmode $wfd or croak $!;
1259 my $eol = $EOL{$es} or undef;
1261 my $buf;
1262 use bytes;
1263 while (1) {
1264 my ($r, $w, $t);
1265 defined($r = sysread($rfd, $buf, 4096)) or croak $!;
1266 return unless $r;
1267 if ($eol) {
1268 if ($buf =~ /\015$/) {
1269 my $c;
1270 defined($r = sysread($rfd,$c,1)) or croak $!;
1271 $buf .= $c if $r > 0;
1272 }
1273 $buf =~ s/(?:\015\012|\015|\012)/$eol/gs;
1274 $r = length($buf);
1275 }
1276 for ($w = 0; $w < $r; $w += $t) {
1277 $t = syswrite($wfd, $buf, $r - $w, $w) or croak $!;
1278 }
1279 }
1280 no bytes;
1281}
1282sub do_update_index {
1284 my ($z_cmd, $cmd, $no_text_base) = @_;
1285 my $z = open my $p, '-|';
1287 defined $z or croak $!;
1288 unless ($z) { exec @$z_cmd or croak $! }
1289 my $pid = open my $ui, '|-';
1291 defined $pid or croak $!;
1292 unless ($pid) {
1293 exec('git-update-index',"--$cmd",'-z','--stdin') or croak $!;
1294 }
1295 local $/ = "\0";
1296 while (my $x = <$p>) {
1297 chomp $x;
1298 if (!$no_text_base && lstat $x && ! -l _ &&
1299 svn_propget_base('svn:keywords', $x)) {
1300 my $mode = -x _ ? 0755 : 0644;
1301 my ($v,$d,$f) = File::Spec->splitpath($x);
1302 my $tb = File::Spec->catfile($d, '.svn', 'tmp',
1303 'text-base',"$f.svn-base");
1304 $tb =~ s#^/##;
1305 unless (-f $tb) {
1306 $tb = File::Spec->catfile($d, '.svn',
1307 'text-base',"$f.svn-base");
1308 $tb =~ s#^/##;
1309 }
1310 unlink $x or croak $!;
1311 eol_cp($tb, $x);
1312 chmod(($mode &~ umask), $x) or croak $!;
1313 }
1314 print $ui $x,"\0";
1315 }
1316 close $ui or croak $!;
1317}
1318sub index_changes {
1320 my $no_text_base = shift;
1321 do_update_index([qw/git-diff-files --name-only -z/],
1322 'remove',
1323 $no_text_base);
1324 do_update_index([qw/git-ls-files -z --others/,
1325 "--exclude-from=$GIT_SVN_DIR/info/exclude"],
1326 'add',
1327 $no_text_base);
1328}
1329sub s_to_file {
1331 my ($str, $file, $mode) = @_;
1332 open my $fd,'>',$file or croak $!;
1333 print $fd $str,"\n" or croak $!;
1334 close $fd or croak $!;
1335 chmod ($mode &~ umask, $file) if (defined $mode);
1336}
1337sub file_to_s {
1339 my $file = shift;
1340 open my $fd,'<',$file or croak "$!: file: $file\n";
1341 local $/;
1342 my $ret = <$fd>;
1343 close $fd or croak $!;
1344 $ret =~ s/\s*$//s;
1345 return $ret;
1346}
1347sub assert_revision_unknown {
1349 my $revno = shift;
1350 if (-f "$REV_DIR/$revno") {
1351 croak "$REV_DIR/$revno already exists! ",
1352 "Why are we refetching it?";
1353 }
1354}
1355sub trees_eq {
1357 my ($x, $y) = @_;
1358 my @x = safe_qx('git-cat-file','commit',$x);
1359 my @y = safe_qx('git-cat-file','commit',$y);
1360 if (($y[0] ne $x[0]) || $x[0] !~ /^tree $sha1\n$/
1361 || $y[0] !~ /^tree $sha1\n$/) {
1362 print STDERR "Trees not equal: $y[0] != $x[0]\n";
1363 return 0
1364 }
1365 return 1;
1366}
1367sub assert_revision_eq_or_unknown {
1369 my ($revno, $commit) = @_;
1370 if (-f "$REV_DIR/$revno") {
1371 my $current = file_to_s("$REV_DIR/$revno");
1372 if (($commit ne $current) && !trees_eq($commit, $current)) {
1373 croak "$REV_DIR/$revno already exists!\n",
1374 "current: $current\nexpected: $commit\n";
1375 }
1376 return;
1377 }
1378}
1379sub git_commit {
1381 my ($log_msg, @parents) = @_;
1382 assert_revision_unknown($log_msg->{revision});
1383 my $out_fh = IO::File->new_tmpfile or croak $!;
1384 map_tree_joins() if (@_branch_from && !%tree_map);
1386 # commit parents can be conditionally bound to a particular
1388 # svn revision via: "svn_revno=commit_sha1", filter them out here:
1389 my @exec_parents;
1390 foreach my $p (@parents) {
1391 next unless defined $p;
1392 if ($p =~ /^(\d+)=($sha1_short)$/o) {
1393 if ($1 == $log_msg->{revision}) {
1394 push @exec_parents, $2;
1395 }
1396 } else {
1397 push @exec_parents, $p if $p =~ /$sha1_short/o;
1398 }
1399 }
1400 my $pid = fork;
1402 defined $pid or croak $!;
1403 if ($pid == 0) {
1404 $ENV{GIT_INDEX_FILE} = $GIT_SVN_INDEX;
1405 index_changes();
1406 chomp(my $tree = `git-write-tree`);
1407 croak $? if $?;
1408 if (exists $tree_map{$tree}) {
1409 my %seen_parent = map { $_ => 1 } @exec_parents;
1410 foreach (@{$tree_map{$tree}}) {
1411 # MAXPARENT is defined to 16 in commit-tree.c:
1412 if ($seen_parent{$_} || @exec_parents > 16) {
1413 next;
1414 }
1415 push @exec_parents, $_;
1416 $seen_parent{$_} = 1;
1417 }
1418 }
1419 my $msg_fh = IO::File->new_tmpfile or croak $!;
1420 print $msg_fh $log_msg->{msg}, "\ngit-svn-id: ",
1421 "$SVN_URL\@$log_msg->{revision}",
1422 " $SVN_UUID\n" or croak $!;
1423 $msg_fh->flush == 0 or croak $!;
1424 seek $msg_fh, 0, 0 or croak $!;
1425 set_commit_env($log_msg);
1427 my @exec = ('git-commit-tree',$tree);
1429 push @exec, '-p', $_ foreach @exec_parents;
1430 open STDIN, '<&', $msg_fh or croak $!;
1431 open STDOUT, '>&', $out_fh or croak $!;
1432 exec @exec or croak $!;
1433 }
1434 waitpid($pid,0);
1435 croak $? if $?;
1436 $out_fh->flush == 0 or croak $!;
1438 seek $out_fh, 0, 0 or croak $!;
1439 chomp(my $commit = do { local $/; <$out_fh> });
1440 if ($commit !~ /^$sha1$/o) {
1441 croak "Failed to commit, invalid sha1: $commit\n";
1442 }
1443 my @update_ref = ('git-update-ref',"refs/remotes/$GIT_SVN",$commit);
1444 if (my $primary_parent = shift @exec_parents) {
1445 $pid = fork;
1446 defined $pid or croak $!;
1447 if (!$pid) {
1448 close STDERR;
1449 close STDOUT;
1450 exec 'git-rev-parse','--verify',
1451 "refs/remotes/$GIT_SVN^0" or croak $!;
1452 }
1453 waitpid $pid, 0;
1454 push @update_ref, $primary_parent unless $?;
1455 }
1456 sys(@update_ref);
1457 sys('git-update-ref',"svn/$GIT_SVN/revs/$log_msg->{revision}",$commit);
1458 print "r$log_msg->{revision} = $commit\n";
1459 if ($_repack && (--$_repack_nr == 0)) {
1460 $_repack_nr = $_repack;
1461 sys("git repack $_repack_flags");
1462 }
1463 return $commit;
1464}
1465sub set_commit_env {
1467 my ($log_msg) = @_;
1468 my $author = $log_msg->{author};
1469 my ($name,$email) = defined $users{$author} ? @{$users{$author}}
1470 : ($author,"$author\@$SVN_UUID");
1471 $ENV{GIT_AUTHOR_NAME} = $ENV{GIT_COMMITTER_NAME} = $name;
1472 $ENV{GIT_AUTHOR_EMAIL} = $ENV{GIT_COMMITTER_EMAIL} = $email;
1473 $ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_msg->{date};
1474}
1475sub apply_mod_line_blob {
1477 my $m = shift;
1478 if ($m->{mode_b} =~ /^120/) {
1479 blob_to_symlink($m->{sha1_b}, $m->{file_b});
1480 } else {
1481 blob_to_file($m->{sha1_b}, $m->{file_b});
1482 }
1483}
1484sub blob_to_symlink {
1486 my ($blob, $link) = @_;
1487 defined $link or croak "\$link not defined!\n";
1488 croak "Not a sha1: $blob\n" unless $blob =~ /^$sha1$/o;
1489 if (-l $link || -f _) {
1490 unlink $link or croak $!;
1491 }
1492 my $dest = `git-cat-file blob $blob`; # no newline, so no chomp
1494 symlink $dest, $link or croak $!;
1495}
1496sub blob_to_file {
1498 my ($blob, $file) = @_;
1499 defined $file or croak "\$file not defined!\n";
1500 croak "Not a sha1: $blob\n" unless $blob =~ /^$sha1$/o;
1501 if (-l $file || -f _) {
1502 unlink $file or croak $!;
1503 }
1504 open my $blob_fh, '>', $file or croak "$!: $file\n";
1506 my $pid = fork;
1507 defined $pid or croak $!;
1508 if ($pid == 0) {
1510 open STDOUT, '>&', $blob_fh or croak $!;
1511 exec('git-cat-file','blob',$blob) or croak $!;
1512 }
1513 waitpid $pid, 0;
1514 croak $? if $?;
1515 close $blob_fh or croak $!;
1517}
1518sub safe_qx {
1520 my $pid = open my $child, '-|';
1521 defined $pid or croak $!;
1522 if ($pid == 0) {
1523 exec(@_) or croak $!;
1524 }
1525 my @ret = (<$child>);
1526 close $child or croak $?;
1527 die $? if $?; # just in case close didn't error out
1528 return wantarray ? @ret : join('',@ret);
1529}
1530sub svn_compat_check {
1532 my @co_help = safe_qx(qw(svn co -h));
1533 unless (grep /ignore-externals/,@co_help) {
1534 print STDERR "W: Installed svn version does not support ",
1535 "--ignore-externals\n";
1536 $_no_ignore_ext = 1;
1537 }
1538 if (grep /usage: checkout URL\[\@REV\]/,@co_help) {
1539 $_svn_co_url_revs = 1;
1540 }
1541 if (grep /\[TARGET\[\@REV\]\.\.\.\]/, `svn propget -h`) {
1542 $_svn_pg_peg_revs = 1;
1543 }
1544 # I really, really hope nobody hits this...
1546 unless (grep /stop-on-copy/, (safe_qx(qw(svn log -h)))) {
1547 print STDERR <<'';
1548W: The installed svn version does not support the --stop-on-copy flag in
1549 the log command.
1550 Lets hope the directory you're tracking is not a branch or tag
1551 and was never moved within the repository...
1552 $_no_stop_copy = 1;
1554 }
1555}
1556# *sigh*, new versions of svn won't honor -r<rev> without URL@<rev>,
1558# (and they won't honor URL@<rev> without -r<rev>, too!)
1559sub svn_cmd_checkout {
1560 my ($url, $rev, $dir) = @_;
1561 my @cmd = ('svn','co', "-r$rev");
1562 push @cmd, '--ignore-externals' unless $_no_ignore_ext;
1563 $url .= "\@$rev" if $_svn_co_url_revs;
1564 sys(@cmd, $url, $dir);
1565}
1566sub check_upgrade_needed {
1568 my $old = eval {
1569 my $pid = open my $child, '-|';
1570 defined $pid or croak $!;
1571 if ($pid == 0) {
1572 close STDERR;
1573 exec('git-rev-parse',"$GIT_SVN-HEAD") or croak $!;
1574 }
1575 my @ret = (<$child>);
1576 close $child or croak $?;
1577 die $? if $?; # just in case close didn't error out
1578 return wantarray ? @ret : join('',@ret);
1579 };
1580 return unless $old;
1581 my $head = eval { safe_qx('git-rev-parse',"refs/remotes/$GIT_SVN") };
1582 if ($@ || !$head) {
1583 print STDERR "Please run: $0 rebuild --upgrade\n";
1584 exit 1;
1585 }
1586}
1587# fills %tree_map with a reverse mapping of trees to commits. Useful
1589# for finding parents to commit on.
1590sub map_tree_joins {
1591 my %seen;
1592 foreach my $br (@_branch_from) {
1593 my $pid = open my $pipe, '-|';
1594 defined $pid or croak $!;
1595 if ($pid == 0) {
1596 exec(qw(git-rev-list --topo-order --pretty=raw), $br)
1597 or croak $!;
1598 }
1599 while (<$pipe>) {
1600 if (/^commit ($sha1)$/o) {
1601 my $commit = $1;
1602 # if we've seen a commit,
1604 # we've seen its parents
1605 last if $seen{$commit};
1606 my ($tree) = (<$pipe> =~ /^tree ($sha1)$/o);
1607 unless (defined $tree) {
1608 die "Failed to parse commit $commit\n";
1609 }
1610 push @{$tree_map{$tree}}, $commit;
1611 $seen{$commit} = 1;
1612 }
1613 }
1614 close $pipe; # we could be breaking the pipe early
1615 }
1616}
1617sub load_all_refs {
1619 if (@_branch_from) {
1620 print STDERR '--branch|-b parameters are ignored when ',
1621 "--branch-all-refs|-B is passed\n";
1622 }
1623 # don't worry about rev-list on non-commit objects/tags,
1625 # it shouldn't blow up if a ref is a blob or tree...
1626 chomp(@_branch_from = `git-rev-parse --symbolic --all`);
1627}
1628# '<svn username> = real-name <email address>' mapping based on git-svnimport:
1630sub load_authors {
1631 open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
1632 while (<$authors>) {
1633 chomp;
1634 next unless /^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*$/;
1635 my ($user, $name, $email) = ($1, $2, $3);
1636 $users{$user} = [$name, $email];
1637 }
1638 close $authors or croak $!;
1639}
1640sub svn_propget_base {
1642 my ($p, $f) = @_;
1643 $f .= '@BASE' if $_svn_pg_peg_revs;
1644 return safe_qx(qw/svn propget/, $p, $f);
1645}
1646sub git_svn_each {
1648 my $sub = shift;
1649 foreach (`git-rev-parse --symbolic --all`) {
1650 next unless s#^refs/remotes/##;
1651 chomp $_;
1652 next unless -f "$GIT_DIR/svn/$_/info/url";
1653 &$sub($_);
1654 }
1655}
1656sub migration_check {
1658 return if (-d "$GIT_DIR/svn" || !-d $GIT_DIR);
1659 print "Upgrading repository...\n";
1660 unless (-d "$GIT_DIR/svn") {
1661 mkdir "$GIT_DIR/svn" or croak $!;
1662 }
1663 print "Data from a previous version of git-svn exists, but\n\t",
1664 "$GIT_SVN_DIR\n\t(required for this version ",
1665 "($VERSION) of git-svn) does not.\n";
1666 foreach my $x (`git-rev-parse --symbolic --all`) {
1668 next unless $x =~ s#^refs/remotes/##;
1669 chomp $x;
1670 next unless -f "$GIT_DIR/$x/info/url";
1671 my $u = eval { file_to_s("$GIT_DIR/$x/info/url") };
1672 next unless $u;
1673 my $dn = dirname("$GIT_DIR/svn/$x");
1674 mkpath([$dn]) unless -d $dn;
1675 rename "$GIT_DIR/$x", "$GIT_DIR/svn/$x" or croak "$!: $x";
1676 my ($url, $path) = repo_path_split($u);
1677 s_to_file($url, "$GIT_DIR/svn/$x/info/repo_url");
1678 s_to_file($path, "$GIT_DIR/svn/$x/info/repo_path");
1679 }
1680 print "Done upgrading.\n";
1681}
1682sub find_rev_before {
1684 my ($r, $git_svn_id) = @_;
1685 my @revs = map { basename $_ } <$GIT_DIR/svn/$git_svn_id/revs/*>;
1686 foreach my $r0 (sort { $b <=> $a } @revs) {
1687 next if $r0 >= $r;
1688 return ($r0, file_to_s("$GIT_DIR/svn/$git_svn_id/revs/$r0"));
1689 }
1690 return (undef, undef);
1691}
1692sub init_vars {
1694 $GIT_SVN ||= $ENV{GIT_SVN_ID} || 'git-svn';
1695 $GIT_SVN_DIR = "$GIT_DIR/svn/$GIT_SVN";
1696 $GIT_SVN_INDEX = "$GIT_SVN_DIR/index";
1697 $SVN_URL = undef;
1698 $REV_DIR = "$GIT_SVN_DIR/revs";
1699 $SVN_WC = "$GIT_SVN_DIR/tree";
1700}
1701# convert GetOpt::Long specs for use by git-repo-config
1703sub read_repo_config {
1704 return unless -d $GIT_DIR;
1705 my $opts = shift;
1706 foreach my $o (keys %$opts) {
1707 my $v = $opts->{$o};
1708 my ($key) = ($o =~ /^([a-z\-]+)/);
1709 $key =~ s/-//g;
1710 my $arg = 'git-repo-config';
1711 $arg .= ' --int' if ($o =~ /[:=]i$/);
1712 $arg .= ' --bool' if ($o !~ /[:=][sfi]$/);
1713 if (ref $v eq 'ARRAY') {
1714 chomp(my @tmp = `$arg --get-all svn.$key`);
1715 @$v = @tmp if @tmp;
1716 } else {
1717 chomp(my $tmp = `$arg --get svn.$key`);
1718 if ($tmp && !($arg =~ / --bool / && $tmp eq 'false')) {
1719 $$v = $tmp;
1720 }
1721 }
1722 }
1723}
1724sub set_default_vals {
1726 if (defined $_repack) {
1727 $_repack = 1000 if ($_repack <= 0);
1728 $_repack_nr = $_repack;
1729 $_repack_flags ||= '';
1730 }
1731}
1732sub read_grafts {
1734 my $gr_file = shift;
1735 my ($grafts, $comments) = ({}, {});
1736 if (open my $fh, '<', $gr_file) {
1737 my @tmp;
1738 while (<$fh>) {
1739 if (/^($sha1)\s+/) {
1740 my $c = $1;
1741 if (@tmp) {
1742 @{$comments->{$c}} = @tmp;
1743 @tmp = ();
1744 }
1745 foreach my $p (split /\s+/, $_) {
1746 $grafts->{$c}->{$p} = 1;
1747 }
1748 } else {
1749 push @tmp, $_;
1750 }
1751 }
1752 close $fh or croak $!;
1753 @{$comments->{'END'}} = @tmp if @tmp;
1754 }
1755 return ($grafts, $comments);
1756}
1757sub write_grafts {
1759 my ($grafts, $comments, $gr_file) = @_;
1760 open my $fh, '>', $gr_file or croak $!;
1762 foreach my $c (sort keys %$grafts) {
1763 if ($comments->{$c}) {
1764 print $fh $_ foreach @{$comments->{$c}};
1765 }
1766 my $p = $grafts->{$c};
1767 delete $p->{$c}; # commits are not self-reproducing...
1768 my $pid = open my $ch, '-|';
1769 defined $pid or croak $!;
1770 if (!$pid) {
1771 exec(qw/git-cat-file commit/, $c) or croak $!;
1772 }
1773 while (<$ch>) {
1774 if (/^parent ([a-f\d]{40})/) {
1775 $p->{$1} = 1;
1776 } else {
1777 last unless /^\S/i;
1778 }
1779 }
1780 close $ch; # breaking the pipe
1781 print $fh $c, ' ', join(' ', sort keys %$p),"\n";
1782 }
1783 if ($comments->{'END'}) {
1784 print $fh $_ foreach @{$comments->{'END'}};
1785 }
1786 close $fh or croak $!;
1787}
1788sub read_url_paths {
1790 my $l_map = {};
1791 git_svn_each(sub { my $x = shift;
1792 my $u = file_to_s("$GIT_DIR/svn/$x/info/repo_url");
1793 my $p = file_to_s("$GIT_DIR/svn/$x/info/repo_path");
1794 # we hate trailing slashes
1795 if ($u =~ s#(?:^\/+|\/+$)##g) {
1796 s_to_file($u,"$GIT_DIR/svn/$x/info/repo_url");
1797 }
1798 if ($p =~ s#(?:^\/+|\/+$)##g) {
1799 s_to_file($p,"$GIT_DIR/svn/$x/info/repo_path");
1800 }
1801 $l_map->{$u}->{$p} = $x;
1802 });
1803 return $l_map;
1804}
1805__END__
1807Data structures:
1809$svn_log hashref (as returned by svn_log_raw)
1811{
1812 fh => file handle of the log file,
1813 state => state of the log file parser (sep/msg/rev/msg_start...)
1814}
1815$log_msg hashref as returned by next_log_entry($svn_log)
1817{
1818 msg => 'whitespace-formatted log entry
1819', # trailing newline is preserved
1820 revision => '8', # integer
1821 date => '2004-02-24T17:01:44.108345Z', # commit date
1822 author => 'committer name'
1823};
1824@mods = array of diff-index line hashes, each element represents one line
1827 of diff-index output
1828diff-index line ($m hash)
1830{
1831 mode_a => first column of diff-index output, no leading ':',
1832 mode_b => second column of diff-index output,
1833 sha1_b => sha1sum of the final blob,
1834 chg => change type [MCRADT],
1835 file_a => original file name of a file (iff chg is 'C' or 'R')
1836 file_b => new/current file name of a file (any chg)
1837}
1838;