git-svn.perl 82.6 KB
Newer Older
E
Eric Wong 已提交
1
#!/usr/bin/env perl
2 3
# Copyright (C) 2006, Eric Wong <normalperson@yhbt.net>
# License: GPL v2 or later
E
Eric Wong 已提交
4 5 6
use warnings;
use strict;
use vars qw/	$AUTHOR $VERSION
7
		$SVN_URL
E
Eric Wong 已提交
8
		$GIT_SVN_INDEX $GIT_SVN
9
		$GIT_DIR $GIT_SVN_DIR $REVDB
10
		$_follow_parent $sha1 $sha1_short $_revision
11 12
		$_cp_remote $_upgrade $_q
		$_authors %users/;
E
Eric Wong 已提交
13
$AUTHOR = 'Eric Wong <normalperson@yhbt.net>';
E
Eric Wong 已提交
14
$VERSION = '@@GIT_VERSION@@';
15

16
$ENV{GIT_DIR} ||= '.git';
17 18
$Git::SVN::default_repo_id = 'git-svn';
$Git::SVN::default_ref_id = $ENV{GIT_SVN_ID} || 'git-svn';
19

20
my $LC_ALL = $ENV{LC_ALL};
21
$Git::SVN::Log::TZ = $ENV{TZ};
E
Eric Wong 已提交
22 23 24
# make sure the svn binary gives consistent output between locales and TZs:
$ENV{TZ} = 'UTC';
$ENV{LC_ALL} = 'C';
25
$| = 1; # unbuffer STDOUT
E
Eric Wong 已提交
26

27
sub fatal (@) { print STDERR @_; exit 1 }
28 29 30 31 32 33
require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
require SVN::Ra;
require SVN::Delta;
if ($SVN::Core::VERSION lt '1.1.0') {
	fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)\n";
}
34
push @Git::SVN::Ra::ISA, 'SVN::Ra';
35 36
push @SVN::Git::Editor::ISA, 'SVN::Delta::Editor';
push @SVN::Git::Fetcher::ISA, 'SVN::Delta::Editor';
E
Eric Wong 已提交
37 38 39 40
use Carp qw/croak/;
use IO::File qw//;
use File::Basename qw/dirname basename/;
use File::Path qw/mkpath/;
41
use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev pass_through/;
42
use IPC::Open3;
43
use Git;
44

45 46 47 48 49
BEGIN {
	my $s;
	foreach (qw/command command_oneline command_noisy command_output_pipe
	            command_input_pipe command_close_pipe/) {
		$s .= "*SVN::Git::Editor::$_ = *SVN::Git::Fetcher::$_ = ".
50
		      "*Git::SVN::Migration::$_ = ".
51
		      "*Git::SVN::Log::$_ = *Git::SVN::$_ = *$_ = *Git::$_; ";
52 53 54 55
	}
	eval $s;
}

56
my ($SVN);
57

58
my $_optimize_commits = 1 unless $ENV{GIT_SVN_NO_OPTIMIZE_COMMITS};
59 60
$sha1 = qr/[a-f\d]{40}/;
$sha1_short = qr/[a-f\d]{4,40}/;
61 62
my ($_stdin, $_help, $_edit,
	$_repack, $_repack_nr, $_repack_flags,
63
	$_message, $_file, $_no_metadata,
64 65
	$_template, $_shared,
	$_version, $_upgrade,
66 67
	$_merge, $_strategy, $_dry_run,
	$_prefix);
E
Eric Wong 已提交
68

69 70 71
my %remote_opts = ( 'username=s' => \$Git::SVN::Prompt::_username,
                    'config-dir=s' => \$Git::SVN::Ra::config_dir,
                    'no-auth-cache' => \$Git::SVN::Prompt::_no_auth_cache );
72
my %fc_opts = ( 'follow-parent|follow' => \$_follow_parent,
73 74
		'authors-file|A=s' => \$_authors,
		'repack:i' => \$_repack,
75
		'no-metadata' => \$_no_metadata,
76
		'quiet|q' => \$_q,
77 78
		'repack-flags|repack-args|repack-opts=s' => \$_repack_flags,
		%remote_opts );
79

80 81 82 83 84
my ($_trunk, $_tags, $_branches);
my %multi_opts = ( 'trunk|T=s' => \$_trunk,
		'tags|t=s' => \$_tags,
		'branches|b=s' => \$_branches );
my %init_opts = ( 'template=s' => \$_template, 'shared' => \$_shared );
E
Eric Wong 已提交
85
my %cmt_opts = ( 'edit|e' => \$_edit,
86 87 88 89
		'rmdir' => \$SVN::Git::Editor::_rmdir,
		'find-copies-harder' => \$SVN::Git::Editor::_find_copies_harder,
		'l=i' => \$SVN::Git::Editor::_rename_limit,
		'copy-similarity|C=i'=> \$SVN::Git::Editor::_cp_similarity
E
Eric Wong 已提交
90
);
91

E
Eric Wong 已提交
92
my %cmd = (
93
	fetch => [ \&cmd_fetch, "Download new revisions from SVN",
94
			{ 'revision|r=s' => \$_revision, %fc_opts } ],
95
	init => [ \&cmd_init, "Initialize a repo for tracking" .
96
			  " (requires URL argument)",
97
			  \%init_opts ],
98 99
	dcommit => [ \&cmd_dcommit,
	             'Commit several diffs to merge with upstream',
100 101 102
			{ 'merge|m|M' => \$_merge,
			  'strategy|s=s' => \$_strategy,
			  'dry-run|n' => \$_dry_run,
103
			%cmt_opts, %fc_opts } ],
104 105 106
	'set-tree' => [ \&cmd_set_tree,
	                "Set an SVN repository to a git tree-ish",
			{ 'stdin|' => \$_stdin, %cmt_opts, %fc_opts, } ],
107
	'show-ignore' => [ \&cmd_show_ignore, "Show svn:ignore listings",
108
			{ 'revision|r=i' => \$_revision } ],
109
	'multi-init' => [ \&cmd_multi_init,
110
			'Initialize multiple trees (like git-svnimport)',
111
			{ %multi_opts, %init_opts, %remote_opts,
E
Eric Wong 已提交
112
			 'revision|r=i' => \$_revision,
113
			 'prefix=s' => \$_prefix,
E
Eric Wong 已提交
114
			} ],
115
	'multi-fetch' => [ \&cmd_multi_fetch,
116 117
			'Fetch multiple trees (like git-svnimport)',
			\%fc_opts ],
118 119 120 121 122
	'migrate' => [ sub { },
	               # no-op, we automatically run this anyways,
	               'Migrate configuration/metadata/layout from
		        previous versions of git-svn',
			\%remote_opts ],
123 124
	'log' => [ \&Git::SVN::Log::cmd_show_log, 'Show commit logs',
			{ 'limit=i' => \$Git::SVN::Log::limit,
125
			  'revision|r=s' => \$_revision,
126 127 128 129 130
			  'verbose|v' => \$Git::SVN::Log::verbose,
			  'incremental' => \$Git::SVN::Log::incremental,
			  'oneline' => \$Git::SVN::Log::oneline,
			  'show-commit' => \$Git::SVN::Log::show_commit,
			  'non-recursive' => \$Git::SVN::Log::non_recursive,
131
			  'authors-file|A=s' => \$_authors,
132 133
			  'color' => \$Git::SVN::Log::color,
			  'pager=s' => \$Git::SVN::Log::pager,
134
			} ],
135 136
	'commit-diff' => [ \&cmd_commit_diff,
	                   'Commit a diff between two trees',
E
Eric Wong 已提交
137 138
			{ 'message|m=s' => \$_message,
			  'file|F=s' => \$_file,
139
			  'revision|r=s' => \$_revision,
E
Eric Wong 已提交
140
			%cmt_opts } ],
E
Eric Wong 已提交
141
);
142

E
Eric Wong 已提交
143 144 145 146 147 148 149 150 151
my $cmd;
for (my $i = 0; $i < @ARGV; $i++) {
	if (defined $cmd{$ARGV[$i]}) {
		$cmd = $ARGV[$i];
		splice @ARGV, $i, 1;
		last;
	}
};

152
my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
153

154
read_repo_config(\%opts);
155 156
my $rv = GetOptions(%opts, 'help|H|h' => \$_help,
				'version|V' => \$_version,
157 158
				'minimize-connections' =>
				  \$Git::SVN::Migration::_minimize,
159
				'id|i=s' => \$Git::SVN::default_ref_id);
160
exit 1 if (!$rv && $cmd ne 'log');
161

E
Eric Wong 已提交
162
usage(0) if $_help;
163
version() if $_version;
164 165
usage(1) unless defined $cmd;
load_authors() if $_authors;
166
unless ($cmd =~ /^(?:init|multi-init|commit-diff)$/) {
167 168
	Git::SVN::Migration::migration_check();
}
169 170 171 172 173
eval {
	Git::SVN::verify_remotes_sanity();
	$cmd{$cmd}->[0]->(@ARGV);
};
fatal $@ if $@;
E
Eric Wong 已提交
174 175 176 177 178 179 180 181 182
exit 0;

####################### primary functions ######################
sub usage {
	my $exit = shift || 0;
	my $fd = $exit ? \*STDERR : \*STDOUT;
	print $fd <<"";
git-svn - bidirectional operations between a single Subversion tree and git
Usage: $0 <command> [options] [arguments]\n
183 184

	print $fd "Available commands:\n" unless $cmd;
E
Eric Wong 已提交
185 186

	foreach (sort keys %cmd) {
187
		next if $cmd && $cmd ne $_;
188
		print $fd '  ',pack('A17',$_),$cmd{$_}->[1],"\n";
189 190
		foreach (keys %{$cmd{$_}->[2]}) {
			# prints out arguments as they should be passed:
191
			my $x = s#[:=]s$## ? '<arg>' : s#[:=]i$## ? '<num>' : '';
192
			print $fd ' ' x 21, join(', ', map { length $_ > 1 ?
193 194 195
							"--$_" : "-$_" }
						split /\|/,$_)," $x\n";
		}
E
Eric Wong 已提交
196 197
	}
	print $fd <<"";
198 199 200 201
\nGIT_SVN_ID may be set in the environment or via the --id/-i switch to an
arbitrary identifier if you're tracking multiple SVN branches/repositories in
one git repository and want to keep them separate.  See git-svn(1) for more
information.
E
Eric Wong 已提交
202 203 204 205

	exit $exit;
}

206
sub version {
207
	print "git-svn version $VERSION (svn $SVN::Core::VERSION)\n";
208 209 210
	exit 0;
}

211 212 213 214 215 216 217 218 219
sub do_git_init_db {
	unless (-d $ENV{GIT_DIR}) {
		my @init_db = ('init');
		push @init_db, "--template=$_template" if defined $_template;
		push @init_db, "--shared" if defined $_shared;
		command_noisy(@init_db);
	}
}

220
sub cmd_init {
221
	my $url = shift or die "SVN repository location required " .
E
Eric Wong 已提交
222
				"as a command-line argument\n";
223 224 225 226
	if (my $repo_path = shift) {
		unless (-d $repo_path) {
			mkpath([$repo_path]);
		}
227 228
		chdir $repo_path or croak $!;
		$ENV{GIT_DIR} = $repo_path . "/.git";
229
	}
230
	do_git_init_db();
231

232
	Git::SVN->init($url);
E
Eric Wong 已提交
233 234
}

235
sub cmd_fetch {
236 237 238 239 240
	if (@_) {
		die "Additional fetch arguments are no longer supported.\n",
		    "Use --follow-parent if you have moved/copied directories
		    instead.\n";
	}
241
	my $gs = Git::SVN->new;
242
	$gs->fetch(parse_revision_argument());
243 244 245 246
	if ($gs->{last_commit} && !verify_ref('refs/heads/master^0')) {
		command_noisy(qw(update-ref refs/heads/master),
		              $gs->{last_commit});
	}
247 248
}

249
sub cmd_set_tree {
E
Eric Wong 已提交
250 251 252 253 254
	my (@commits) = @_;
	if ($_stdin || !@commits) {
		print "Reading from stdin...\n";
		@commits = ();
		while (<STDIN>) {
255
			if (/\b($sha1_short)\b/o) {
E
Eric Wong 已提交
256 257 258 259 260
				unshift @commits, $1;
			}
		}
	}
	my @revs;
261
	foreach my $c (@commits) {
E
Eric Wong 已提交
262
		my @tmp = command('rev-parse',$c);
263 264 265
		if (scalar @tmp == 1) {
			push @revs, $tmp[0];
		} elsif (scalar @tmp > 1) {
E
Eric Wong 已提交
266
			push @revs, reverse(command('rev-list',@tmp));
267
		} else {
268
			fatal "Failed to rev-parse $c\n";
269
		}
E
Eric Wong 已提交
270
	}
271 272 273
	my $gs = Git::SVN->new;
	my ($r_last, $cmt_last) = $gs->last_rev_commit;
	$gs->fetch;
274
	if (defined $gs->{last_rev} && $r_last != $gs->{last_rev}) {
275 276 277 278
		fatal "There are new revisions that were fetched ",
		      "and need to be merged (or acknowledged) ",
		      "before committing.\nlast rev: $r_last\n",
		      " current: $gs->{last_rev}\n";
279
	}
280 281
	$gs->set_tree($_) foreach @revs;
	print "Done committing ",scalar @revs," revisions to SVN\n";
282
}
283

284 285 286 287 288
sub cmd_dcommit {
	my $head = shift;
	my $gs = Git::SVN->new;
	$head ||= 'HEAD';
	my @refs = command(qw/rev-list --no-merges/, $gs->refname."..$head");
289
	my $last_rev;
E
Eric Wong 已提交
290
	foreach my $d (reverse @refs) {
E
Eric Wong 已提交
291
		if (!verify_ref("$d~1")) {
292 293 294 295 296
			fatal "Commit $d\n",
			      "has no parent commit, and therefore ",
			      "nothing to diff against.\n",
			      "You should be working from a repository ",
			      "originally created by git-svn\n";
297
		}
298 299 300
		unless (defined $last_rev) {
			(undef, $last_rev, undef) = cmt_metadata("$d~1");
			unless (defined $last_rev) {
301 302
				fatal "Unable to extract revision information ",
				      "from commit $d~1\n";
303 304
			}
		}
E
Eric Wong 已提交
305 306 307
		if ($_dry_run) {
			print "diff-tree $d~1 $d\n";
		} else {
308
			my %ed_opts = ( r => $last_rev,
309 310 311 312 313 314 315
			                log => get_commit_entry($d)->{log},
			                ra => $gs->ra,
			                tree_a => "$d~1",
			                tree_b => $d,
			                editor_cb => sub {
			                       print "Committed r$_[0]\n";
			                       $last_rev = $_[0]; },
316
			                svn_path => $gs->{path} );
317
			if (!SVN::Git::Editor->new(\%ed_opts)->apply_diff) {
318 319
				print "No changes\n$d~1 == $d\n";
			}
E
Eric Wong 已提交
320 321 322
		}
	}
	return if $_dry_run;
323 324 325 326
	$gs->fetch;
	# we always want to rebase against the current HEAD, not any
	# head that was passed to us
	my @diff = command('diff-tree', 'HEAD', $gs->refname, '--');
E
Eric Wong 已提交
327 328 329 330 331
	my @finish;
	if (@diff) {
		@finish = qw/rebase/;
		push @finish, qw/--merge/ if $_merge;
		push @finish, "--strategy=$_strategy" if $_strategy;
332 333
		print STDERR "W: HEAD and ", $gs->refname, " differ, ",
		             "using @finish:\n", "@diff";
E
Eric Wong 已提交
334
	} else {
335 336 337
		print "No changes between current HEAD and ",
		      $gs->refname, "\nResetting to the latest ",
		      $gs->refname, "\n";
338
		@finish = qw/reset --mixed/;
E
Eric Wong 已提交
339
	}
340
	command_noisy(@finish, $gs->refname);
E
Eric Wong 已提交
341 342
}

343 344 345 346
sub cmd_show_ignore {
	my $gs = Git::SVN->new;
	my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
	$gs->traverse_ignore(\*STDOUT, '', $r);
347 348
}

349
sub cmd_multi_init {
350
	my $url = shift;
351 352
	unless (defined $_trunk || defined $_branches || defined $_tags) {
		usage(1);
353
	}
354 355
	do_git_init_db();
	$_prefix = '' unless defined $_prefix;
356
	$url =~ s#/+$## if defined $url;
357
	if (defined $_trunk) {
358 359 360
		my $trunk_ref = $_prefix . 'trunk';
		# try both old-style and new-style lookups:
		my $gs_trunk = eval { Git::SVN->new($trunk_ref) };
361
		unless ($gs_trunk) {
362 363 364 365
			my ($trunk_url, $trunk_path) =
			                      complete_svn_url($url, $_trunk);
			$gs_trunk = Git::SVN->init($trunk_url, $trunk_path,
						   undef, $trunk_ref);
366
		}
367
	}
368
	return unless defined $_branches || defined $_tags;
369 370 371
	my $ra = $url ? Git::SVN::Ra->new($url) : undef;
	complete_url_ls_init($ra, $_branches, '--branches/-b', $_prefix);
	complete_url_ls_init($ra, $_tags, '--tags/-t', $_prefix . 'tags/');
372 373
}

374
sub cmd_multi_fetch {
375 376 377 378 379
	my $remotes = Git::SVN::read_all_remotes();
	foreach my $repo_id (sort keys %$remotes) {
		my $url = $remotes->{$repo_id}->{url} or next;
		my $fetch = $remotes->{$repo_id}->{fetch} or next;
		Git::SVN::fetch_all($repo_id, $url, $fetch);
380 381 382
	}
}

383 384 385 386 387 388
# this command is special because it requires no metadata
sub cmd_commit_diff {
	my ($ta, $tb, $url) = @_;
	my $usage = "Usage: $0 commit-diff -r<revision> ".
	            "<tree-ish> <tree-ish> [<URL>]\n";
	fatal($usage) if (!defined $ta || !defined $tb);
389
	my $svn_path;
390 391 392 393 394 395 396
	if (!defined $url) {
		my $gs = eval { Git::SVN->new };
		if (!$gs) {
			fatal("Needed URL or usable git-svn --id in ",
			      "the command-line\n", $usage);
		}
		$url = $gs->{url};
397
		$svn_path = $gs->{path};
398 399 400 401 402 403 404 405 406 407 408 409 410 411 412
	}
	unless (defined $_revision) {
		fatal("-r|--revision is a required argument\n", $usage);
	}
	if (defined $_message && defined $_file) {
		fatal("Both --message/-m and --file/-F specified ",
		      "for the commit message.\n",
		      "I have no idea what you mean\n");
	}
	if (defined $_file) {
		$_message = file_to_s($_file);
	} else {
		$_message ||= get_commit_entry($tb)->{log};
	}
	my $ra ||= Git::SVN::Ra->new($url);
413
	$svn_path ||= $ra->{svn_path};
414 415 416 417 418 419
	my $r = $_revision;
	if ($r eq 'HEAD') {
		$r = $ra->get_latest_revnum;
	} elsif ($r !~ /^\d+$/) {
		die "revision argument: $r not understood by git-svn\n";
	}
420 421 422 423 424 425 426 427
	my %ed_opts = ( r => $r,
	                log => $_message,
	                ra => $ra,
	                tree_a => $ta,
	                tree_b => $tb,
	                editor_cb => sub { print "Committed r$_[0]\n" },
	                svn_path => $svn_path );
	if (!SVN::Git::Editor->new(\%ed_opts)->apply_diff) {
428 429 430 431
		print "No changes\n$ta == $tb\n";
	}
}

E
Eric Wong 已提交
432 433
########################### utility functions #########################

434 435 436 437 438 439 440 441 442 443 444 445
sub parse_revision_argument {
	if (!defined $_revision || $_revision eq 'BASE:HEAD') {
		return (undef, undef);
	}
	return ($1, $2) if ($_revision =~ /^(\d+):(\d+)$/);
	return ($_revision, $_revision) if ($_revision =~ /^\d+$/);
	return (undef, $1) if ($_revision =~ /^BASE:(\d+)$/);
	return ($1, undef) if ($_revision =~ /^(\d+):HEAD$/);
	die "revision argument: $_revision not understood by git-svn\n",
	    "Try using the command-line svn client instead\n";
}

446 447 448 449 450 451 452 453
sub complete_svn_url {
	my ($url, $path) = @_;
	$path =~ s#/+$##;
	if ($path !~ m#^[a-z\+]+://#) {
		if (!defined $url || $url !~ m#^[a-z\+]+://#) {
			fatal("E: '$path' is not a complete URL ",
			      "and a separate URL is not specified\n");
		}
454
		return ($url, $path);
455
	}
456
	return ($path, '');
457 458
}

459
sub complete_url_ls_init {
460 461
	my ($ra, $repo_path, $switch, $pfx) = @_;
	unless ($repo_path) {
462 463 464
		print STDERR "W: $switch not specified\n";
		return;
	}
465 466 467 468
	$repo_path =~ s#/+$##;
	if ($repo_path =~ m#^[a-z\+]+://#) {
		$ra = Git::SVN::Ra->new($repo_path);
		$repo_path = '';
469
	} else {
470
		$repo_path =~ s#^/+##;
471
		unless ($ra) {
472
			fatal("E: '$repo_path' is not a complete URL ",
473
			      "and a separate URL is not specified\n");
474
		}
475 476
	}
	my $r = defined $_revision ? $_revision : $ra->get_latest_revnum;
477 478
	my ($dirent, undef, undef) = $ra->get_dir($repo_path, $r);
	my $url = $ra->{url};
479 480
	foreach my $d (sort keys %$dirent) {
		next if ($dirent->{$d}->kind != $SVN::Node::dir);
481 482 483
		my $path =  "$repo_path/$d";
		my $ref = "$pfx$d";
		my $gs = eval { Git::SVN->new($ref) };
484
		# don't try to init already existing refs
485
		unless ($gs) {
486 487
			print "init $url/$path => $ref\n";
			Git::SVN->init($url, $path, undef, $ref);
488 489 490 491
		}
	}
}

E
Eric Wong 已提交
492 493
sub verify_ref {
	my ($ref) = @_;
494 495
	eval { command_oneline([ 'rev-parse', '--verify', $ref ],
	                       { STDERR => 0 }); };
E
Eric Wong 已提交
496 497
}

498
sub get_tree_from_treeish {
499
	my ($treeish) = @_;
500
	# $treeish can be a symbolic ref, too:
E
Eric Wong 已提交
501
	my $type = command_oneline(qw/cat-file -t/, $treeish);
502 503
	my $expected;
	while ($type eq 'tag') {
E
Eric Wong 已提交
504
		($treeish, $type) = command(qw/cat-file tag/, $treeish);
505 506
	}
	if ($type eq 'commit') {
E
Eric Wong 已提交
507 508
		$expected = (grep /^tree /, command(qw/cat-file commit/,
		                                    $treeish))[0];
509
		($expected) = ($expected =~ /^tree ($sha1)$/o);
510 511 512 513 514 515
		die "Unable to get tree from $treeish\n" unless $expected;
	} elsif ($type eq 'tree') {
		$expected = $treeish;
	} else {
		die "$treeish is a $type, expected tree, tag or commit\n";
	}
516 517 518
	return $expected;
}

519 520 521 522 523 524
sub get_commit_entry {
	my ($treeish) = shift;
	my %log_entry = ( log => '', tree => get_tree_from_treeish($treeish) );
	my $commit_editmsg = "$ENV{GIT_DIR}/COMMIT_EDITMSG";
	my $commit_msg = "$ENV{GIT_DIR}/COMMIT_MSG";
	open my $log_fh, '>', $commit_editmsg or croak $!;
E
Eric Wong 已提交
525

526
	my $type = command_oneline(qw/cat-file -t/, $treeish);
527
	if ($type eq 'commit' || $type eq 'tag') {
E
Eric Wong 已提交
528
		my ($msg_fh, $ctx) = command_output_pipe('cat-file',
529
		                                         $type, $treeish);
E
Eric Wong 已提交
530 531 532 533
		my $in_msg = 0;
		while (<$msg_fh>) {
			if (!$in_msg) {
				$in_msg = 1 if (/^\s*$/);
534
			} elsif (/^git-svn-id: /) {
535 536 537
				# skip this for now, we regenerate the
				# correct one on re-fetch anyways
				# TODO: set *:merge properties or like...
E
Eric Wong 已提交
538
			} else {
539
				print $log_fh $_ or croak $!;
E
Eric Wong 已提交
540 541
			}
		}
E
Eric Wong 已提交
542
		command_close_pipe($msg_fh, $ctx);
E
Eric Wong 已提交
543
	}
544
	close $log_fh or croak $!;
E
Eric Wong 已提交
545 546 547

	if ($_edit || ($type eq 'tree')) {
		my $editor = $ENV{VISUAL} || $ENV{EDITOR} || 'vi';
548 549
		# TODO: strip out spaces, comments, like git-commit.sh
		system($editor, $commit_editmsg);
E
Eric Wong 已提交
550
	}
551 552 553 554 555 556
	rename $commit_editmsg, $commit_msg or croak $!;
	open $log_fh, '<', $commit_msg or croak $!;
	{ local $/; chomp($log_entry{log} = <$log_fh>); }
	close $log_fh or croak $!;
	unlink $commit_msg;
	\%log_entry;
557 558
}

E
Eric Wong 已提交
559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576
sub s_to_file {
	my ($str, $file, $mode) = @_;
	open my $fd,'>',$file or croak $!;
	print $fd $str,"\n" or croak $!;
	close $fd or croak $!;
	chmod ($mode &~ umask, $file) if (defined $mode);
}

sub file_to_s {
	my $file = shift;
	open my $fd,'<',$file or croak "$!: file: $file\n";
	local $/;
	my $ret = <$fd>;
	close $fd or croak $!;
	$ret =~ s/\s*$//s;
	return $ret;
}

577 578 579
# '<svn username> = real-name <email address>' mapping based on git-svnimport:
sub load_authors {
	open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
580
	my $log = $cmd eq 'log';
581 582
	while (<$authors>) {
		chomp;
583
		next unless /^(\S+?|\(no author\))\s*=\s*(.+?)\s*<(.+)>\s*$/;
584
		my ($user, $name, $email) = ($1, $2, $3);
585 586 587 588 589
		if ($log) {
			$Git::SVN::Log::rusers{"$name <$email>"} = $user;
		} else {
			$users{$user} = [$name, $email];
		}
590 591 592 593
	}
	close $authors or croak $!;
}

594
# convert GetOpt::Long specs for use by git-config
595
sub read_repo_config {
596
	return unless -d $ENV{GIT_DIR};
597 598 599 600 601
	my $opts = shift;
	foreach my $o (keys %$opts) {
		my $v = $opts->{$o};
		my ($key) = ($o =~ /^([a-z\-]+)/);
		$key =~ s/-//g;
602
		my $arg = 'git-config';
603 604 605 606 607 608 609
		$arg .= ' --int' if ($o =~ /[:=]i$/);
		$arg .= ' --bool' if ($o !~ /[:=][sfi]$/);
		if (ref $v eq 'ARRAY') {
			chomp(my @tmp = `$arg --get-all svn.$key`);
			@$v = @tmp if @tmp;
		} else {
			chomp(my $tmp = `$arg --get svn.$key`);
610
			if ($tmp && !($arg =~ / --bool/ && $tmp eq 'false')) {
611 612 613 614 615 616
				$$v = $tmp;
			}
		}
	}
}

617
sub extract_metadata {
618
	my $id = shift or return (undef, undef, undef);
619 620
	my ($url, $rev, $uuid) = ($id =~ /^git-svn-id:\s(\S+?)\@(\d+)
							\s([a-f\d\-]+)$/x);
621
	if (!defined $rev || !$uuid || !$url) {
622
		# some of the original repositories I made had
623
		# identifiers like this:
624 625 626 627 628
		($rev, $uuid) = ($id =~/^git-svn-id:\s(\d+)\@([a-f\d\-]+)/);
	}
	return ($url, $rev, $uuid);
}

629 630
sub cmt_metadata {
	return extract_metadata((grep(/^git-svn-id: /,
E
Eric Wong 已提交
631
		command(qw/cat-file commit/, shift)))[-1]);
632 633
}

634 635 636
package Git::SVN;
use strict;
use warnings;
637
use vars qw/$default_repo_id $default_ref_id/;
638 639 640 641 642 643 644 645 646 647 648 649 650 651 652
use Carp qw/croak/;
use File::Path qw/mkpath/;
use IPC::Open3;

# properties that we do not log:
my %SKIP_PROP;
BEGIN {
	%SKIP_PROP = map { $_ => 1 } qw/svn:wc:ra_dav:version-url
	                                svn:special svn:executable
	                                svn:entry:committed-rev
	                                svn:entry:last-author
	                                svn:entry:uuid
	                                svn:entry:committed-date/;
}

653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674
sub fetch_all {
	my ($repo_id, $url, $fetch) = @_;
	my @gs;
	my $ra = Git::SVN::Ra->new($url);
	my $head = $ra->get_latest_revnum;
	my $base = $head;
	my $new_remote;
	foreach my $p (sort keys %$fetch) {
		my $gs = Git::SVN->new($fetch->{$p}, $repo_id, $p);
		my $lr = $gs->last_rev;
		if (defined $lr) {
			$base = $lr if ($lr < $base);
		} else {
			$new_remote = 1;
		}
		push @gs, $gs;
	}
	$base = 0 if $new_remote;
	return if (++$base > $head);
	$ra->gs_fetch_loop_common($base, $head, @gs);
}

675 676
sub read_all_remotes {
	my $r = {};
677
	foreach (grep { s/^svn-remote\.// } command(qw/config -l/)) {
678 679 680 681 682 683 684 685 686
		if (m!^(.+)\.fetch=\s*(.*)\s*:\s*refs/remotes/(.+)\s*$!) {
			$r->{$1}->{fetch}->{$2} = $3;
		} elsif (m!^(.+)\.url=\s*(.*)\s*$!) {
			$r->{$1}->{url} = $2;
		}
	}
	$r;
}

687
sub verify_remotes_sanity {
688
	return unless -d $ENV{GIT_DIR};
689 690 691 692 693 694 695 696 697 698 699 700 701 702 703
	my %seen;
	foreach (command(qw/config -l/)) {
		if (m!^svn-remote\.(?:.+)\.fetch=.*:refs/remotes/(\S+)\s*$!) {
			if ($seen{$1}) {
				die "Remote ref refs/remote/$1 is tracked by",
				    "\n  \"$_\"\nand\n  \"$seen{$1}\"\n",
				    "Please resolve this ambiguity in ",
				    "your git configuration file before ",
				    "continuing\n";
			}
			$seen{$1} = $_;
		}
	}
}

704
# we allow more chars than remotes2config.sh...
705 706
sub sanitize_remote_name {
	my ($name) = @_;
707
	$name =~ tr{A-Za-z0-9:,/+-}{.}c;
708 709 710
	$name;
}

711 712 713 714 715 716 717 718 719 720 721
sub find_existing_remote {
	my ($url, $remotes) = @_;
	my $existing;
	foreach my $repo_id (keys %$remotes) {
		my $u = $remotes->{$repo_id}->{url} or next;
		next if $u ne $url;
		$existing = $repo_id;
		last;
	}
	$existing;
}
722

723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753
sub init_remote_config {
	my ($self, $url) = @_;
	$url =~ s!/+$!!; # strip trailing slash
	my $r = read_all_remotes();
	my $existing = find_existing_remote($url, $r);
	if ($existing) {
		print STDERR "Using existing ",
			     "[svn-remote \"$existing\"]\n";
		$self->{repo_id} = $existing;
	} else {
		my $min_url = Git::SVN::Ra->new($url)->minimize_url;
		$existing = find_existing_remote($min_url, $r);
		if ($existing) {
			print STDERR "Using existing ",
				     "[svn-remote \"$existing\"]\n";
			$self->{repo_id} = $existing;
		}
		if ($min_url ne $url) {
			print STDERR "Using higher level of URL: ",
			             "$url => $min_url\n";
			my $old_path = $self->{path};
			$self->{path} = $url;
			$self->{path} =~ s!^\Q$min_url\E/*!!;
			if (length $old_path) {
				$self->{path} .= "/$old_path";
			}
			$url = $min_url;
		}
	}
	my $orig_url;
	if (!$existing) {
754
		# verify that we aren't overwriting anything:
755
		$orig_url = eval {
756
			command_oneline('config', '--get',
757
					"svn-remote.$self->{repo_id}.url")
758
		};
759
		if ($orig_url && ($orig_url ne $url)) {
760
			die "svn-remote.$self->{repo_id}.url already set: ",
761 762
			    "$orig_url\nwanted to set to: $url\n";
		}
763
	}
764 765 766 767 768 769 770 771 772 773
	my ($xrepo_id, $xpath) = find_ref($self->refname);
	if (defined $xpath) {
		die "svn-remote.$xrepo_id.fetch already set to track ",
		    "$xpath:refs/remotes/", $self->refname, "\n";
	}
	command_noisy('config',
		      "svn-remote.$self->{repo_id}.url", $url);
	command_noisy('config', '--add',
		      "svn-remote.$self->{repo_id}.fetch",
		      "$self->{path}:".$self->refname);
774
	$self->{url} = $url;
775 776 777 778 779 780 781 782
}

sub init {
	my ($class, $url, $path, $repo_id, $ref_id) = @_;
	my $self = _new($class, $repo_id, $ref_id, $path);
	if (defined $url) {
		$self->init_remote_config($url);
	}
783 784 785
	$self;
}

786 787 788 789 790 791 792 793 794 795 796 797 798 799
sub find_ref {
	my ($ref_id) = @_;
	foreach (command(qw/config -l/)) {
		next unless m!^svn-remote\.(.+)\.fetch=
		              \s*(.*)\s*:\s*refs/remotes/(.+)\s*$!x;
		my ($repo_id, $path, $ref) = ($1, $2, $3);
		if ($ref eq $ref_id) {
			$path = '' if ($path =~ m#^\./?#);
			return ($repo_id, $path);
		}
	}
	(undef, undef, undef);
}

800
sub new {
801 802 803 804 805 806 807 808 809 810
	my ($class, $ref_id, $repo_id, $path) = @_;
	if (defined $ref_id && !defined $repo_id && !defined $path) {
		($repo_id, $path) = find_ref($ref_id);
		if (!defined $repo_id) {
			die "Could not find a \"svn-remote.*.fetch\" key ",
			    "in the repository configuration matching: ",
			    "refs/remotes/$ref_id\n";
		}
	}
	my $self = _new($class, $repo_id, $ref_id, $path);
811 812 813 814 815 816 817 818
	if (!defined $self->{path} || !length $self->{path}) {
		my $fetch = command_oneline('config', '--get',
		                            "svn-remote.$repo_id.fetch",
		                            ":refs/remotes/$ref_id\$") or
		     die "Failed to read \"svn-remote.$repo_id.fetch\" ",
		         "\":refs/remotes/$ref_id\$\" in config\n";
		($self->{path}, undef) = split(/\s*:\s*/, $fetch);
	}
819 820 821
	$self->{url} = command_oneline('config', '--get',
	                               "svn-remote.$repo_id.url") or
                  die "Failed to read \"svn-remote.$repo_id.url\" in config\n";
822 823 824
	if (-z $self->{db_path} && ::verify_ref($self->refname.'^0')) {
		$self->rebuild;
	}
825 826 827
	$self;
}

828
sub refname { "refs/remotes/$_[0]->{ref_id}" }
829 830 831

sub ra {
	my ($self) = shift;
832
	Git::SVN::Ra->new($self->{url});
833 834
}

835 836 837 838 839 840 841 842 843 844
sub rel_path {
	my ($self) = @_;
	my $repos_root = $self->ra->{repos_root};
	return $self->{path} if ($self->{url} eq $repos_root);
	my $url = $self->{url} .
	          (length $self->{path} ? "/$self->{path}" : $self->{path});
	$url =~ s!^\Q$repos_root\E/*!!g;
	$url;
}

845 846 847
sub traverse_ignore {
	my ($self, $fh, $path, $r) = @_;
	$path =~ s#^/+##g;
848 849
	my $ra = $self->ra;
	my ($dirent, undef, $props) = $ra->get_dir($path, $r);
850
	my $p = $path;
851
	$p =~ s#^\Q$ra->{svn_path}\E/##;
852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869
	print $fh length $p ? "\n# $p\n" : "\n# /\n";
	if (my $s = $props->{'svn:ignore'}) {
		$s =~ s/[\r\n]+/\n/g;
		chomp $s;
		if (length $p == 0) {
			$s =~ s#\n#\n/$p#g;
			print $fh "/$s\n";
		} else {
			$s =~ s#\n#\n/$p/#g;
			print $fh "/$p/$s\n";
		}
	}
	foreach (sort keys %$dirent) {
		next if $dirent->{$_}->kind != $SVN::Node::dir;
		$self->traverse_ignore($fh, "$path/$_", $r);
	}
}

870 871 872
sub last_rev { ($_[0]->last_rev_commit)[0] }
sub last_commit { ($_[0]->last_rev_commit)[1] }

873 874 875 876 877 878
# returns the newest SVN revision number and newest commit SHA1
sub last_rev_commit {
	my ($self) = @_;
	if (defined $self->{last_rev} && defined $self->{last_commit}) {
		return ($self->{last_rev}, $self->{last_commit});
	}
879
	my $c = ::verify_ref($self->refname.'^0');
880
	if ($c) {
881
		my $rev = (::cmt_metadata($c))[1];
882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909
		if (defined $rev) {
			($self->{last_rev}, $self->{last_commit}) = ($rev, $c);
			return ($rev, $c);
		}
	}
	my $offset = -41; # from tail
	my $rl;
	open my $fh, '<', $self->{db_path} or
	                         croak "$self->{db_path} not readable: $!\n";
	seek $fh, $offset, 2;
	$rl = readline $fh;
	defined $rl or return (undef, undef);
	chomp $rl;
	while ($c ne $rl && tell $fh != 0) {
		$offset -= 41;
		seek $fh, $offset, 2;
		$rl = readline $fh;
		defined $rl or return (undef, undef);
		chomp $rl;
	}
	my $rev = tell $fh;
	croak $! if ($rev < 0);
	$rev =  ($rev - 41) / 41;
	close $fh or croak $!;
	($self->{last_rev}, $self->{last_commit}) = ($rev, $c);
	return ($rev, $c);
}

910 911 912 913 914
sub get_fetch_range {
	my ($self, $min, $max) = @_;
	$max ||= $self->ra->get_latest_revnum;
	$min ||= $self->last_rev || 0;
	(++$min, $max);
915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950
}

sub tmp_index_do {
	my ($self, $sub) = @_;
	my $old_index = $ENV{GIT_INDEX_FILE};
	$ENV{GIT_INDEX_FILE} = $self->{index};
	my @ret = &$sub;
	if ($old_index) {
		$ENV{GIT_INDEX_FILE} = $old_index;
	} else {
		delete $ENV{GIT_INDEX_FILE};
	}
	wantarray ? @ret : $ret[0];
}

sub assert_index_clean {
	my ($self, $treeish) = @_;

	$self->tmp_index_do(sub {
		command_noisy('read-tree', $treeish) unless -e $self->{index};
		my $x = command_oneline('write-tree');
		my ($y) = (command(qw/cat-file commit/, $treeish) =~
		           /^tree ($::sha1)/mo);
		if ($y ne $x) {
			unlink $self->{index} or croak $!;
			command_noisy('read-tree', $treeish);
		}
		$x = command_oneline('write-tree');
		if ($y ne $x) {
			::fatal "trees ($treeish) $y != $x\n",
			        "Something is seriously wrong...\n";
		}
	});
}

sub get_commit_parents {
951
	my ($self, $log_entry) = @_;
952
	my (%seen, @ret, @tmp);
953 954 955 956
	# legacy support for 'set-tree'; this is only used by set_tree_cb:
	if (my $ip = $self->{inject_parents}) {
		if (my $commit = delete $ip->{$log_entry->{revision}}) {
			push @tmp, $commit;
957 958
		}
	}
959
	if (my $cur = ::verify_ref($self->refname.'^0')) {
960 961
		push @tmp, $cur;
	}
962
	push @tmp, $_ foreach (@{$log_entry->{parents}}, @tmp);
963 964 965 966 967 968 969 970
	while (my $p = shift @tmp) {
		next if $seen{$p};
		$seen{$p} = 1;
		push @ret, $p;
		# MAXPARENT is defined to 16 in commit-tree.c:
		last if @ret >= 16;
	}
	if (@tmp) {
971
		die "r$log_entry->{revision}: No room for parents:\n\t",
972 973 974 975 976
		    join("\n\t", @tmp), "\n";
	}
	@ret;
}

977
sub full_url {
978
	my ($self) = @_;
979
	$self->{url} . (length $self->{path} ? '/' . $self->{path} : '');
980 981 982
}

sub do_git_commit {
983
	my ($self, $log_entry) = @_;
984 985
	if (my $c = $self->rev_db_get($log_entry->{revision})) {
		croak "$log_entry->{revision} = $c already exists! ",
986 987
		      "Why are we refetching it?\n";
	}
988 989 990
	my $author = $log_entry->{author};
	my ($name, $email) = (defined $::users{$author} ? @{$::users{$author}}
	                   : ($author, "$author\@".$self->ra->uuid));
991 992
	$ENV{GIT_AUTHOR_NAME} = $ENV{GIT_COMMITTER_NAME} = $name;
	$ENV{GIT_AUTHOR_EMAIL} = $ENV{GIT_COMMITTER_EMAIL} = $email;
993
	$ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_entry->{date};
994

995
	my $tree = $log_entry->{tree};
996 997 998 999 1000 1001 1002
	if (!defined $tree) {
		$tree = $self->tmp_index_do(sub {
		                            command_oneline('write-tree') });
	}
	die "Tree is not a valid sha1: $tree\n" if $tree !~ /^$::sha1$/o;

	my @exec = ('git-commit-tree', $tree);
1003
	foreach ($self->get_commit_parents($log_entry)) {
1004 1005 1006 1007
		push @exec, '-p', $_;
	}
	defined(my $pid = open3(my $msg_fh, my $out_fh, '>&STDERR', @exec))
	                                                           or croak $!;
1008
	print $msg_fh $log_entry->{log} or croak $!;
1009
	print $msg_fh "\ngit-svn-id: ", $self->full_url, '@',
1010 1011
	              $log_entry->{revision}, ' ',
		      $self->ra->uuid, "\n" or croak $!;
1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022
	$msg_fh->flush == 0 or croak $!;
	close $msg_fh or croak $!;
	chomp(my $commit = do { local $/; <$out_fh> });
	close $out_fh or croak $!;
	waitpid $pid, 0;
	croak $? if $?;
	if ($commit !~ /^$::sha1$/o) {
		die "Failed to commit, invalid sha1: $commit\n";
	}

	command_noisy('update-ref',$self->refname, $commit);
1023
	$self->rev_db_set($log_entry->{revision}, $commit);
1024

1025
	$self->{last_rev} = $log_entry->{revision};
1026
	$self->{last_commit} = $commit;
1027
	print "r$log_entry->{revision} = $commit\n";
1028 1029 1030
	return $commit;
}

1031 1032 1033 1034 1035 1036 1037 1038 1039 1040
sub revisions_eq {
	my ($self, $r0, $r1) = @_;
	return 1 if $r0 == $r1;
	my $nr = 0;
	$self->ra->get_log([$self->{path}], $r0, $r1,
	                   0, 0, 1, sub { $nr++ });
	return 0 if ($nr > 1);
	return 1;
}

1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053
sub match_paths {
	my ($self, $paths) = @_;
	return 1 if $paths->{'/'};
	$self->{path_regex} ||= qr/^\/\Q$self->{path}\E\/?/;
	grep /$self->{path_regex}/, keys %$paths and return 1;
	my $c = '';
	foreach (split m#/#, $self->rel_path) {
		$c .= "/$_";
		return 1 if $paths->{$c};
	}
	return 0;
}

1054 1055
sub find_parent_branch {
	my ($self, $paths, $rev) = @_;
1056
	return undef unless $::_follow_parent;
1057
	unless (defined $paths) {
1058 1059
		$self->ra->get_log([$self->{path}], $rev, $rev, 0, 1, 1,
		                   sub { $paths = dup_changed_paths($_[0]) });
1060 1061
	}
	return undef unless defined $paths;
1062 1063

	# look for a parent from another branch:
1064 1065 1066 1067 1068 1069 1070 1071 1072
	my @b_path_components = split m#/#, $self->rel_path;
	my @a_path_components;
	my $i;
	while (@b_path_components) {
		$i = $paths->{'/'.join('/', @b_path_components)};
		last if $i;
		unshift(@a_path_components, pop(@b_path_components));
	}
	goto not_found unless defined $i;
1073
	my $branch_from = $i->{copyfrom_path} or goto not_found;
1074 1075 1076 1077 1078
	if (@a_path_components) {
		print STDERR "branch_from: $branch_from => ";
		$branch_from .= '/'.join('/', @a_path_components);
		print STDERR $branch_from, "\n";
	}
1079
	my $r = $i->{copyfrom_rev};
1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099
	my $repos_root = $self->ra->{repos_root};
	my $url = $self->ra->{url};
	my $new_url = $repos_root . $branch_from;
	print STDERR  "Found possible branch point: ",
	              "$new_url => ", $self->full_url, ", $r\n";
	$branch_from =~ s#^/##;
	my $remotes = read_all_remotes();
	my $gs;
	foreach my $repo_id (keys %$remotes) {
		my $u = $remotes->{$repo_id}->{url} or next;
		next if $url ne $u;
		my $fetch = $remotes->{$repo_id}->{fetch};
		foreach my $f (keys %$fetch) {
			next if $f ne $branch_from;
			$gs = Git::SVN->new($fetch->{$f}, $repo_id, $f);
			last;
		}
		last if $gs;
	}
	unless ($gs) {
1100 1101 1102
		my $ref_id = $self->{ref_id};
		$ref_id =~ s/\@\d+$//;
		$ref_id .= "\@$r";
1103 1104
		# just grow a tail if we're not unique enough :x
		$ref_id .= '-' while find_ref($ref_id);
1105
		print STDERR "Initializing parent: $ref_id\n";
1106 1107 1108 1109
		$gs = Git::SVN->init($new_url, '', $ref_id, $ref_id);
	}
	my ($r0, $parent) = $gs->find_rev_before($r, 1);
	if ($::_follow_parent && (!defined $r0 || !defined $parent)) {
1110
		$gs->fetch(0, $r);
1111 1112 1113 1114
		($r0, $parent) = $gs->last_rev_commit;
	}
	if (defined $r0 && defined $parent && $gs->revisions_eq($r0, $r)) {
		print STDERR "Found branch parent: ($self->{ref_id}) $parent\n";
1115
		$self->assert_index_clean($parent);
1116 1117
		my $ed;
		if ($self->ra->can_do_switch) {
1118
			print STDERR "Following parent with do_switch\n";
1119
			# do_switch works with svn/trunk >= r22312, but that
1120
			# is not included with SVN 1.4.3 (the latest version
1121 1122 1123 1124 1125 1126 1127
			# at the moment), so we can't rely on it
			$self->{last_commit} = $parent;
			$ed = SVN::Git::Fetcher->new($self);
			$gs->ra->gs_do_switch($r0, $rev, $gs->{path}, 1,
					      $self->full_url, $ed)
			  or die "SVN connection failed somewhere...\n";
		} else {
1128
			print STDERR "Following parent with do_update\n";
1129 1130 1131 1132 1133
			$ed = SVN::Git::Fetcher->new($self);
			$self->ra->gs_do_update($rev, $rev, $self->{path},
			                        1, $ed)
			  or die "SVN connection failed somewhere...\n";
		}
1134
		print STDERR "Successfully followed parent\n";
1135
		$ed->{new_fetch} = 1;
1136 1137
		return $self->make_log_entry($rev, [$parent], $ed);
	}
1138
not_found:
1139
	print STDERR "Branch parent for path: '/",
1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152
	             $self->rel_path, "' @ r$rev not found:\n";
	return undef unless $paths;
	print STDERR "Changed paths:\n";
	foreach my $x (sort keys %$paths) {
		my $p = $paths->{$x};
		print STDERR "\t$p->{action}\t$x";
		if ($p->{copyfrom_path}) {
			print STDERR "(from $p->{copyfrom_path}: ",
			             "$p->{copyfrom_rev})";
		}
		print STDERR "\n";
	}
	print STDERR '-'x72, "\n";
1153 1154 1155
	return undef;
}

1156
sub do_fetch {
1157
	my ($self, $paths, $rev) = @_;
1158
	my $ed;
1159 1160
	my ($last_rev, @parents);
	if ($self->{last_commit}) {
1161
		$ed = SVN::Git::Fetcher->new($self);
1162 1163 1164 1165 1166
		$last_rev = $self->{last_rev};
		$ed->{c} = $self->{last_commit};
		@parents = ($self->{last_commit});
	} else {
		$last_rev = $rev;
1167 1168 1169 1170
		if (my $log_entry = $self->find_parent_branch($paths, $rev)) {
			return $log_entry;
		}
		$ed = SVN::Git::Fetcher->new($self);
1171
		$ed->{new_fetch} = 1;
1172
	}
1173 1174
	unless ($self->ra->gs_do_update($last_rev, $rev,
	                                $self->{path}, 1, $ed)) {
1175 1176 1177 1178 1179
		die "SVN connection failed somewhere...\n";
	}
	$self->make_log_entry($rev, \@parents, $ed);
}

1180 1181 1182 1183
sub get_untracked {
	my ($self, $ed) = @_;
	my @out;
	my $h = $ed->{empty};
1184 1185
	foreach (sort keys %$h) {
		my $act = $h->{$_} ? '+empty_dir' : '-empty_dir';
1186
		push @out, "  $act: " . uri_encode($_);
1187 1188 1189
		warn "W: $act: $_\n";
	}
	foreach my $t (qw/dir_prop file_prop/) {
1190
		$h = $ed->{$t} or next;
1191 1192 1193
		foreach my $path (sort keys %$h) {
			my $ppath = $path eq '' ? '.' : $path;
			foreach my $prop (sort keys %{$h->{$path}}) {
1194
				next if $SKIP_PROP{$prop};
1195
				my $v = $h->{$path}->{$prop};
1196 1197 1198
				my $t_ppath_prop = "$t: " .
				                    uri_encode($ppath) . ' ' .
				                    uri_encode($prop);
1199
				if (defined $v) {
1200 1201
					push @out, "  +$t_ppath_prop " .
					           uri_encode($v);
1202
				} else {
1203
					push @out, "  -$t_ppath_prop";
1204 1205 1206 1207 1208
				}
			}
		}
	}
	foreach my $t (qw/absent_file absent_directory/) {
1209
		$h = $ed->{$t} or next;
1210 1211
		foreach my $parent (sort keys %$h) {
			foreach my $path (sort @{$h->{$parent}}) {
1212 1213
				push @out, "  $t: " .
				           uri_encode("$parent/$path");
1214 1215 1216 1217 1218
				warn "W: $t: $parent/$path ",
				     "Insufficient permissions?\n";
			}
		}
	}
1219
	\@out;
1220 1221
}

1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240
sub parse_svn_date {
	my $date = shift || return '+0000 1970-01-01 00:00:00';
	my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T
	                                    (\d\d)\:(\d\d)\:(\d\d).\d+Z$/x) or
	                                 croak "Unable to parse date: $date\n";
	"+0000 $Y-$m-$d $H:$M:$S";
}

sub check_author {
	my ($author) = @_;
	if (!defined $author || length $author == 0) {
		$author = '(no author)';
	}
	if (defined $::_authors && ! defined $::users{$author}) {
		die "Author: $author not defined in $::_authors file\n";
	}
	$author;
}

1241
sub make_log_entry {
1242 1243 1244
	my ($self, $rev, $parents, $ed) = @_;
	my $untracked = $self->get_untracked($ed);

1245
	return undef if (! $ed->{new_fetch} && ! $ed->{nr} && ! @$untracked);
1246

1247
	open my $un, '>>', "$self->{dir}/unhandled.log" or croak $!;
1248 1249 1250 1251 1252
	print $un "r$rev\n" or croak $!;
	print $un $_, "\n" foreach @$untracked;
	my %log_entry = ( parents => $parents || [], revision => $rev,
	                  log => '');
	my $rp = $self->ra->rev_proplist($rev);
1253 1254 1255 1256 1257 1258 1259 1260 1261 1262
	foreach (sort keys %$rp) {
		my $v = $rp->{$_};
		if (/^svn:(author|date|log)$/) {
			$log_entry{$1} = $v;
		} else {
			print $un "  rev_prop: ", uri_encode($_), ' ',
		                  uri_encode($v), "\n";
		}
	}
	close $un or croak $!;
1263

1264 1265 1266 1267 1268 1269 1270
	$log_entry{date} = parse_svn_date($log_entry{date});
	$log_entry{author} = check_author($log_entry{author});
	$log_entry{log} .= "\n";
	\%log_entry;
}

sub fetch {
1271
	my ($self, $min_rev, $max_rev, @parents) = @_;
1272
	my ($last_rev, $last_commit) = $self->last_rev_commit;
1273
	my ($base, $head) = $self->get_fetch_range($min_rev, $max_rev);
1274
	return if ($base > $head);
1275
	$self->ra->gs_fetch_loop_common($base, $head, $self);
1276 1277 1278 1279 1280 1281 1282 1283 1284 1285
}

sub set_tree_cb {
	my ($self, $log_entry, $tree, $rev, $date, $author) = @_;
	# TODO: enable and test optimized commits:
	if (0 && $rev == ($self->{last_rev} + 1)) {
		$log_entry->{revision} = $rev;
		$log_entry->{author} = $author;
		$self->do_git_commit($log_entry, "$rev=$tree");
	} else {
1286 1287
		$self->{inject_parents} = { $rev => $tree };
		$self->fetch(undef, undef);
1288 1289 1290 1291 1292
	}
}

sub set_tree {
	my ($self, $tree) = (shift, shift);
1293
	my $log_entry = ::get_commit_entry($tree);
1294 1295 1296
	unless ($self->{last_rev}) {
		fatal("Must have an existing revision to commit\n");
	}
1297 1298 1299 1300 1301 1302 1303 1304 1305
	my %ed_opts = ( r => $self->{last_rev},
	                log => $log_entry->{log},
	                ra => $self->ra,
	                tree_a => $self->{last_commit},
	                tree_b => $tree,
	                editor_cb => sub {
			       $self->set_tree_cb($log_entry, $tree, @_) },
	                svn_path => $self->{path} );
	if (!SVN::Git::Editor->new(\%ed_opts)->apply_diff) {
1306 1307 1308 1309
		print "No changes\nr$self->{last_rev} = $tree\n";
	}
}

1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341
sub rebuild {
	my ($self) = @_;
	print "Rebuilding $self->{db_path} ...\n";
	my ($rev_list, $ctx) = command_output_pipe("rev-list", $self->refname);
	my $latest;
	my $full_url = $self->full_url;
	my $svn_uuid;
	while (<$rev_list>) {
		chomp;
		my $c = $_;
		die "Non-SHA1: $c\n" unless $c =~ /^$::sha1$/o;
		my ($url, $rev, $uuid) = ::cmt_metadata($c);

		# ignore merges (from set-tree)
		next if (!defined $rev || !$uuid);

		# if we merged or otherwise started elsewhere, this is
		# how we break out of it
		if ((defined $svn_uuid && ($uuid ne $svn_uuid)) ||
		    ($full_url && $url && ($url ne $full_url))) {
			next;
		}
		$latest ||= $rev;
		$svn_uuid ||= $uuid;

		$self->rev_db_set($rev, $c);
		print "r$rev = $c\n";
	}
	command_close_pipe($rev_list, $ctx);
	print "Done rebuilding $self->{db_path}\n";
}

1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386
# rev_db:
# Tie::File seems to be prone to offset errors if revisions get sparse,
# it's not that fast, either.  Tie::File is also not in Perl 5.6.  So
# one of my favorite modules is out :<  Next up would be one of the DBM
# modules, but I'm not sure which is most portable...  So I'll just
# go with something that's plain-text, but still capable of
# being randomly accessed.  So here's my ultra-simple fixed-width
# database.  All records are 40 characters + "\n", so it's easy to seek
# to a revision: (41 * rev) is the byte offset.
# A record of 40 0s denotes an empty revision.
# And yes, it's still pretty fast (faster than Tie::File).

sub rev_db_set {
	my ($self, $rev, $commit) = @_;
	length $commit == 40 or croak "arg3 must be a full SHA1 hexsum\n";
	open my $fh, '+<', $self->{db_path} or croak $!;
	my $offset = $rev * 41;
	# assume that append is the common case:
	seek $fh, 0, 2 or croak $!;
	my $pos = tell $fh;
	if ($pos < $offset) {
		print $fh (('0' x 40),"\n") x (($offset - $pos) / 41)
		  or croak $!;
	}
	seek $fh, $offset, 0 or croak $!;
	print $fh $commit,"\n" or croak $!;
	close $fh or croak $!;
}

sub rev_db_get {
	my ($self, $rev) = @_;
	my $ret;
	my $offset = $rev * 41;
	open my $fh, '<', $self->{db_path} or croak $!;
	if (seek $fh, $offset, 0) {
		$ret = readline $fh;
		if (defined $ret) {
			chomp $ret;
			$ret = undef if ($ret =~ /^0{40}$/);
		}
	}
	close $fh or croak $!;
	$ret;
}

1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398
sub find_rev_before {
	my ($self, $rev, $eq_ok) = @_;
	--$rev unless $eq_ok;
	while ($rev > 0) {
		if (my $c = $self->rev_db_get($rev)) {
			return ($rev, $c);
		}
		--$rev;
	}
	return (undef, undef);
}

1399
sub _new {
1400 1401 1402 1403 1404
	my ($class, $repo_id, $ref_id, $path) = @_;
	unless (defined $repo_id && length $repo_id) {
		$repo_id = $Git::SVN::default_repo_id;
	}
	unless (defined $ref_id && length $ref_id) {
1405
		$_[2] = $ref_id = $Git::SVN::default_ref_id;
1406 1407 1408 1409
	}
	$_[1] = $repo_id = sanitize_remote_name($repo_id);
	my $dir = "$ENV{GIT_DIR}/svn/$ref_id";
	$_[3] = $path = '' unless (defined $path);
1410 1411 1412 1413 1414
	mkpath([$dir]);
	unless (-f "$dir/.rev_db") {
		open my $fh, '>>', "$dir/.rev_db" or croak $!;
		close $fh or croak $!;
	}
1415 1416 1417
	bless { ref_id => $ref_id, dir => $dir, index => "$dir/index",
	        path => $path,
	        db_path => "$dir/.rev_db", repo_id => $repo_id }, $class;
1418 1419
}

1420 1421 1422 1423 1424
sub uri_encode {
	my ($f) = @_;
	$f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg;
	$f
}
1425

1426 1427 1428 1429 1430 1431 1432
package Git::SVN::Prompt;
use strict;
use warnings;
require SVN::Core;
use vars qw/$_no_auth_cache $_username/;

sub simple {
1433 1434 1435 1436 1437
	my ($cred, $realm, $default_username, $may_save, $pool) = @_;
	$may_save = undef if $_no_auth_cache;
	$default_username = $_username if defined $_username;
	if (defined $default_username && length $default_username) {
		if (defined $realm && length $realm) {
1438 1439
			print STDERR "Authentication realm: $realm\n";
			STDERR->flush;
1440 1441 1442
		}
		$cred->username($default_username);
	} else {
1443
		username($cred, $realm, $may_save, $pool);
1444 1445 1446 1447 1448 1449 1450
	}
	$cred->password(_read_password("Password for '" .
	                               $cred->username . "': ", $realm));
	$cred->may_save($may_save);
	$SVN::_Core::SVN_NO_ERROR;
}

1451
sub ssl_server_trust {
1452 1453
	my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
	$may_save = undef if $_no_auth_cache;
1454
	print STDERR "Error validating server certificate for '$realm':\n";
1455
	if ($failures & $SVN::Auth::SSL::UNKNOWNCA) {
1456
		print STDERR " - The certificate is not issued by a trusted ",
1457 1458 1459 1460
		      "authority. Use the\n",
	              "   fingerprint to validate the certificate manually!\n";
	}
	if ($failures & $SVN::Auth::SSL::CNMISMATCH) {
1461
		print STDERR " - The certificate hostname does not match.\n";
1462 1463
	}
	if ($failures & $SVN::Auth::SSL::NOTYETVALID) {
1464
		print STDERR " - The certificate is not yet valid.\n";
1465 1466
	}
	if ($failures & $SVN::Auth::SSL::EXPIRED) {
1467
		print STDERR " - The certificate has expired.\n";
1468 1469
	}
	if ($failures & $SVN::Auth::SSL::OTHER) {
1470
		print STDERR " - The certificate has an unknown error.\n";
1471
	}
1472 1473
	printf STDERR
	        "Certificate information:\n".
1474 1475 1476 1477 1478
	        " - Hostname: %s\n".
	        " - Valid: from %s until %s\n".
	        " - Issuer: %s\n".
	        " - Fingerprint: %s\n",
	        map $cert_info->$_, qw(hostname valid_from valid_until
1479
	                               issuer_dname fingerprint);
1480 1481
	my $choice;
prompt:
1482
	print STDERR $may_save ?
1483 1484
	      "(R)eject, accept (t)emporarily or accept (p)ermanently? " :
	      "(R)eject or accept (t)emporarily? ";
1485
	STDERR->flush;
1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499
	$choice = lc(substr(<STDIN> || 'R', 0, 1));
	if ($choice =~ /^t$/i) {
		$cred->may_save(undef);
	} elsif ($choice =~ /^r$/i) {
		return -1;
	} elsif ($may_save && $choice =~ /^p$/i) {
		$cred->may_save($may_save);
	} else {
		goto prompt;
	}
	$cred->accepted_failures($failures);
	$SVN::_Core::SVN_NO_ERROR;
}

1500
sub ssl_client_cert {
1501 1502
	my ($cred, $realm, $may_save, $pool) = @_;
	$may_save = undef if $_no_auth_cache;
1503 1504
	print STDERR "Client certificate filename: ";
	STDERR->flush;
1505 1506 1507 1508 1509 1510
	chomp(my $filename = <STDIN>);
	$cred->cert_file($filename);
	$cred->may_save($may_save);
	$SVN::_Core::SVN_NO_ERROR;
}

1511
sub ssl_client_cert_pw {
1512 1513 1514 1515 1516 1517 1518
	my ($cred, $realm, $may_save, $pool) = @_;
	$may_save = undef if $_no_auth_cache;
	$cred->password(_read_password("Password: ", $realm));
	$cred->may_save($may_save);
	$SVN::_Core::SVN_NO_ERROR;
}

1519
sub username {
1520 1521 1522
	my ($cred, $realm, $may_save, $pool) = @_;
	$may_save = undef if $_no_auth_cache;
	if (defined $realm && length $realm) {
1523
		print STDERR "Authentication realm: $realm\n";
1524 1525 1526 1527 1528
	}
	my $username;
	if (defined $_username) {
		$username = $_username;
	} else {
1529 1530
		print STDERR "Username: ";
		STDERR->flush;
1531 1532 1533 1534 1535 1536 1537 1538 1539
		chomp($username = <STDIN>);
	}
	$cred->username($username);
	$cred->may_save($may_save);
	$SVN::_Core::SVN_NO_ERROR;
}

sub _read_password {
	my ($prompt, $realm) = @_;
1540 1541
	print STDERR $prompt;
	STDERR->flush;
1542 1543 1544 1545 1546 1547 1548 1549
	require Term::ReadKey;
	Term::ReadKey::ReadMode('noecho');
	my $password = '';
	while (defined(my $key = Term::ReadKey::ReadKey(0))) {
		last if $key =~ /[\012\015]/; # \n\r
		$password .= $key;
	}
	Term::ReadKey::ReadMode('restore');
1550 1551
	print STDERR "\n";
	STDERR->flush;
1552 1553 1554
	$password;
}

1555 1556
package main;

1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568
{
	my $kill_stupid_warnings = $SVN::Node::none.$SVN::Node::file.
				$SVN::Node::dir.$SVN::Node::unknown.
				$SVN::Node::none.$SVN::Node::file.
				$SVN::Node::dir.$SVN::Node::unknown.
				$SVN::Auth::SSL::CNMISMATCH.
				$SVN::Auth::SSL::NOTYETVALID.
				$SVN::Auth::SSL::EXPIRED.
				$SVN::Auth::SSL::UNKNOWNCA.
				$SVN::Auth::SSL::OTHER;
}

1569 1570 1571 1572 1573 1574
package SVN::Git::Fetcher;
use vars qw/@ISA/;
use strict;
use warnings;
use Carp qw/croak/;
use IO::File qw//;
1575
use Digest::MD5;
1576 1577 1578 1579 1580 1581

# file baton members: path, mode_a, mode_b, pool, fh, blob, base
sub new {
	my ($class, $git_svn) = @_;
	my $self = SVN::Delta::Editor->new;
	bless $self, $class;
1582
	$self->{c} = $git_svn->{last_commit} if exists $git_svn->{last_commit};
1583 1584 1585 1586 1587
	$self->{empty} = {};
	$self->{dir_prop} = {};
	$self->{file_prop} = {};
	$self->{absent_dir} = {};
	$self->{absent_file} = {};
1588
	$self->{gii} = $git_svn->tmp_index_do(sub { Git::IndexInfo->new });
1589 1590 1591
	$self;
}

1592 1593 1594 1595 1596
sub set_path_strip {
	my ($self, $path) = @_;
	$self->{path_strip} = qr/^\Q$path\E\/?/;
}

1597 1598 1599 1600 1601 1602 1603 1604 1605
sub open_root {
	{ path => '' };
}

sub open_directory {
	my ($self, $path, $pb, $rev) = @_;
	{ path => $path };
}

1606 1607
sub git_path {
	my ($self, $path) = @_;
1608 1609 1610 1611
	if ($self->{path_strip}) {
		$path =~ s!$self->{path_strip}!! or
		  die "Failed to strip path '$path' ($self->{path_strip})\n";
	}
1612 1613 1614
	$path;
}

1615 1616
sub delete_entry {
	my ($self, $path, $rev, $pb) = @_;
1617

1618
	my $gpath = $self->git_path($path);
1619
	# remove entire directories.
1620
	if (command('ls-tree', $self->{c}, '--', $gpath) =~ /^040000 tree/) {
1621 1622
		my ($ls, $ctx) = command_output_pipe(qw/ls-tree
		                                     -r --name-only -z/,
1623
				                     $self->{c}, '--', $gpath);
1624 1625
		local $/ = "\0";
		while (<$ls>) {
1626 1627
			chomp;
			$self->{gii}->remove($_);
1628 1629
			print "\tD\t$_\n" unless $self->{q};
		}
1630
		print "\tD\t$gpath/\n" unless $self->{q};
1631 1632 1633
		command_close_pipe($ls, $ctx);
		$self->{empty}->{$path} = 0
	} else {
1634
		$self->{gii}->remove($gpath);
1635
		print "\tD\t$gpath\n" unless $self->{q};
1636
	}
1637 1638 1639 1640 1641
	undef;
}

sub open_file {
	my ($self, $path, $pb, $rev) = @_;
1642 1643
	my $gpath = $self->git_path($path);
	my ($mode, $blob) = (command('ls-tree', $self->{c}, '--', $gpath)
1644
	                     =~ /^(\d{6}) blob ([a-f\d]{40})\t/);
1645 1646 1647
	unless (defined $mode && defined $blob) {
		die "$path was not found in commit $self->{c} (r$rev)\n";
	}
1648
	{ path => $path, mode_a => $mode, mode_b => $mode, blob => $blob,
1649
	  pool => SVN::Pool->new, action => 'M' };
1650 1651 1652 1653
}

sub add_file {
	my ($self, $path, $pb, $cp_path, $cp_rev) = @_;
1654 1655
	my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
	delete $self->{empty}->{$dir};
1656
	{ path => $path, mode_a => 100644, mode_b => 100644,
1657
	  pool => SVN::Pool->new, action => 'A' };
1658 1659
}

1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688
sub add_directory {
	my ($self, $path, $cp_path, $cp_rev) = @_;
	my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
	delete $self->{empty}->{$dir};
	$self->{empty}->{$path} = 1;
	{ path => $path };
}

sub change_dir_prop {
	my ($self, $db, $prop, $value) = @_;
	$self->{dir_prop}->{$db->{path}} ||= {};
	$self->{dir_prop}->{$db->{path}}->{$prop} = $value;
	undef;
}

sub absent_directory {
	my ($self, $path, $pb) = @_;
	$self->{absent_dir}->{$pb->{path}} ||= [];
	push @{$self->{absent_dir}->{$pb->{path}}}, $path;
	undef;
}

sub absent_file {
	my ($self, $path, $pb) = @_;
	$self->{absent_file}->{$pb->{path}} ||= [];
	push @{$self->{absent_file}->{$pb->{path}}}, $path;
	undef;
}

1689 1690 1691 1692 1693 1694 1695 1696
sub change_file_prop {
	my ($self, $fb, $prop, $value) = @_;
	if ($prop eq 'svn:executable') {
		if ($fb->{mode_b} != 120000) {
			$fb->{mode_b} = defined $value ? 100755 : 100644;
		}
	} elsif ($prop eq 'svn:special') {
		$fb->{mode_b} = defined $value ? 120000 : 100644;
1697 1698 1699
	} else {
		$self->{file_prop}->{$fb->{path}} ||= {};
		$self->{file_prop}->{$fb->{path}}->{$prop} = $value;
1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741
	}
	undef;
}

sub apply_textdelta {
	my ($self, $fb, $exp) = @_;
	my $fh = IO::File->new_tmpfile;
	$fh->autoflush(1);
	# $fh gets auto-closed() by SVN::TxDelta::apply(),
	# (but $base does not,) so dup() it for reading in close_file
	open my $dup, '<&', $fh or croak $!;
	my $base = IO::File->new_tmpfile;
	$base->autoflush(1);
	if ($fb->{blob}) {
		defined (my $pid = fork) or croak $!;
		if (!$pid) {
			open STDOUT, '>&', $base or croak $!;
			print STDOUT 'link ' if ($fb->{mode_a} == 120000);
			exec qw/git-cat-file blob/, $fb->{blob} or croak $!;
		}
		waitpid $pid, 0;
		croak $? if $?;

		if (defined $exp) {
			seek $base, 0, 0 or croak $!;
			my $md5 = Digest::MD5->new;
			$md5->addfile($base);
			my $got = $md5->hexdigest;
			die "Checksum mismatch: $fb->{path} $fb->{blob}\n",
			    "expected: $exp\n",
			    "     got: $got\n" if ($got ne $exp);
		}
	}
	seek $base, 0, 0 or croak $!;
	$fb->{fh} = $dup;
	$fb->{base} = $base;
	[ SVN::TxDelta::apply($base, $fh, undef, $fb->{path}, $fb->{pool}) ];
}

sub close_file {
	my ($self, $fb, $exp) = @_;
	my $hash;
1742
	my $path = $self->git_path($fb->{path});
1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769
	if (my $fh = $fb->{fh}) {
		seek($fh, 0, 0) or croak $!;
		my $md5 = Digest::MD5->new;
		$md5->addfile($fh);
		my $got = $md5->hexdigest;
		die "Checksum mismatch: $path\n",
		    "expected: $exp\n    got: $got\n" if ($got ne $exp);
		seek($fh, 0, 0) or croak $!;
		if ($fb->{mode_b} == 120000) {
			read($fh, my $buf, 5) == 5 or croak $!;
			$buf eq 'link ' or die "$path has mode 120000",
			                       "but is not a link\n";
		}
		defined(my $pid = open my $out,'-|') or die "Can't fork: $!\n";
		if (!$pid) {
			open STDIN, '<&', $fh or croak $!;
			exec qw/git-hash-object -w --stdin/ or croak $!;
		}
		chomp($hash = do { local $/; <$out> });
		close $out or croak $!;
		close $fh or croak $!;
		$hash =~ /^[a-f\d]{40}$/ or die "not a sha1: $hash\n";
		close $fb->{base} or croak $!;
	} else {
		$hash = $fb->{blob} or die "no blob information\n";
	}
	$fb->{pool}->clear;
1770
	$self->{gii}->update($fb->{mode_b}, $hash, $path) or croak $!;
1771
	print "\t$fb->{action}\t$path\n" if $fb->{action} && ! $self->{q};
1772 1773 1774 1775 1776
	undef;
}

sub abort_edit {
	my $self = shift;
1777 1778
	$self->{nr} = $self->{gii}->{nr};
	delete $self->{gii};
1779 1780 1781 1782 1783
	$self->SUPER::abort_edit(@_);
}

sub close_edit {
	my $self = shift;
1784
	$self->{git_commit_ok} = 1;
1785 1786
	$self->{nr} = $self->{gii}->{nr};
	delete $self->{gii};
1787 1788
	$self->SUPER::close_edit(@_);
}
1789

1790
package SVN::Git::Editor;
1791
use vars qw/@ISA $_rmdir $_cp_similarity $_find_copies_harder $_rename_limit/;
1792 1793 1794 1795
use strict;
use warnings;
use Carp qw/croak/;
use IO::File;
1796
use Digest::MD5;
1797 1798

sub new {
1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812
	my ($class, $opts) = @_;
	foreach (qw/svn_path r ra tree_a tree_b log editor_cb/) {
		die "$_ required!\n" unless (defined $opts->{$_});
	}

	my $pool = SVN::Pool->new;
	my $mods = generate_diff($opts->{tree_a}, $opts->{tree_b});
	my $types = check_diff_paths($opts->{ra}, $opts->{svn_path},
	                             $opts->{r}, $mods);

	# $opts->{ra} functions should not be used after this:
	my @ce  = $opts->{ra}->get_commit_editor($opts->{log},
	                                        $opts->{editor_cb}, $pool);
	my $self = SVN::Delta::Editor->new(@ce, $pool);
1813
	bless $self, $class;
1814 1815
	foreach (qw/svn_path r tree_a tree_b/) {
		$self->{$_} = $opts->{$_};
1816
	}
1817 1818 1819 1820
	$self->{url} = $opts->{ra}->{url};
	$self->{mods} = $mods;
	$self->{types} = $types;
	$self->{pool} = $pool;
1821 1822
	$self->{bat} = { '' => $self->open_root($self->{r}, $self->{pool}) };
	$self->{rm} = { };
1823 1824
	$self->{path_prefix} = length $self->{svn_path} ?
	                       "$self->{svn_path}/" : '';
1825 1826 1827
	return $self;
}

1828 1829 1830
sub generate_diff {
	my ($tree_a, $tree_b) = @_;
	my @diff_tree = qw(diff-tree -z -r);
1831 1832
	if ($_cp_similarity) {
		push @diff_tree, "-C$_cp_similarity";
1833 1834 1835
	} else {
		push @diff_tree, '-C';
	}
1836 1837
	push @diff_tree, '--find-copies-harder' if $_find_copies_harder;
	push @diff_tree, "-l$_rename_limit" if defined $_rename_limit;
1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910
	push @diff_tree, $tree_a, $tree_b;
	my ($diff_fh, $ctx) = command_output_pipe(@diff_tree);
	local $/ = "\0";
	my $state = 'meta';
	my @mods;
	while (<$diff_fh>) {
		chomp $_; # this gets rid of the trailing "\0"
		if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s
					$::sha1\s($::sha1)\s
					([MTCRAD])\d*$/xo) {
			push @mods, {	mode_a => $1, mode_b => $2,
					sha1_b => $3, chg => $4 };
			if ($4 =~ /^(?:C|R)$/) {
				$state = 'file_a';
			} else {
				$state = 'file_b';
			}
		} elsif ($state eq 'file_a') {
			my $x = $mods[$#mods] or croak "Empty array\n";
			if ($x->{chg} !~ /^(?:C|R)$/) {
				croak "Error parsing $_, $x->{chg}\n";
			}
			$x->{file_a} = $_;
			$state = 'file_b';
		} elsif ($state eq 'file_b') {
			my $x = $mods[$#mods] or croak "Empty array\n";
			if (exists $x->{file_a} && $x->{chg} !~ /^(?:C|R)$/) {
				croak "Error parsing $_, $x->{chg}\n";
			}
			if (!exists $x->{file_a} && $x->{chg} =~ /^(?:C|R)$/) {
				croak "Error parsing $_, $x->{chg}\n";
			}
			$x->{file_b} = $_;
			$state = 'meta';
		} else {
			croak "Error parsing $_\n";
		}
	}
	command_close_pipe($diff_fh, $ctx);
	\@mods;
}

sub check_diff_paths {
	my ($ra, $pfx, $rev, $mods) = @_;
	my %types;
	$pfx .= '/' if length $pfx;

	sub type_diff_paths {
		my ($ra, $types, $path, $rev) = @_;
		my @p = split m#/+#, $path;
		my $c = shift @p;
		unless (defined $types->{$c}) {
			$types->{$c} = $ra->check_path($c, $rev);
		}
		while (@p) {
			$c .= '/' . shift @p;
			next if defined $types->{$c};
			$types->{$c} = $ra->check_path($c, $rev);
		}
	}

	foreach my $m (@$mods) {
		foreach my $f (qw/file_a file_b/) {
			next unless defined $m->{$f};
			my ($dir) = ($m->{$f} =~ m#^(.*?)/?(?:[^/]+)$#);
			if (length $pfx.$dir && ! defined $types{$dir}) {
				type_diff_paths($ra, \%types, $pfx.$dir, $rev);
			}
		}
	}
	\%types;
}

1911 1912 1913 1914 1915
sub split_path {
	return ($_[0] =~ m#^(.*?)/?([^/]+)$#);
}

sub repo_path {
1916 1917
	my ($self, $path) = @_;
	$self->{path_prefix}.(defined $path ? $path : '');
1918 1919 1920 1921
}

sub url_path {
	my ($self, $path) = @_;
1922
	$self->{url} . '/' . $self->repo_path($path);
1923 1924 1925
}

sub rmdirs {
1926
	my ($self) = @_;
1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943
	my $rm = $self->{rm};
	delete $rm->{''}; # we never delete the url we're tracking
	return unless %$rm;

	foreach (keys %$rm) {
		my @d = split m#/#, $_;
		my $c = shift @d;
		$rm->{$c} = 1;
		while (@d) {
			$c .= '/' . shift @d;
			$rm->{$c} = 1;
		}
	}
	delete $rm->{$self->{svn_path}};
	delete $rm->{''}; # we never delete the url we're tracking
	return unless %$rm;

1944 1945
	my ($fh, $ctx) = command_output_pipe(qw/ls-tree --name-only -r -z/,
	                                     $self->{tree_b});
1946 1947 1948
	local $/ = "\0";
	while (<$fh>) {
		chomp;
1949
		my @dn = split m#/#, $_;
1950 1951 1952 1953
		while (pop @dn) {
			delete $rm->{join '/', @dn};
		}
		unless (%$rm) {
1954
			close $fh;
1955 1956
			return;
		}
1957
	}
E
Eric Wong 已提交
1958
	command_close_pipe($fh, $ctx);
1959

1960 1961 1962 1963
	my ($r, $p, $bat) = ($self->{r}, $self->{pool}, $self->{bat});
	foreach my $d (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$rm) {
		$self->close_directory($bat->{$d}, $p);
		my ($dn) = ($d =~ m#^(.*?)/?(?:[^/]+)$#);
1964
		print "\tD+\t$d/\n" unless $::_q;
1965 1966 1967 1968 1969 1970 1971
		$self->SUPER::delete_entry($d, $r, $bat->{$dn}, $p);
		delete $bat->{$d};
	}
}

sub open_or_add_dir {
	my ($self, $full_path, $baton) = @_;
1972 1973 1974 1975
	my $t = $self->{types}->{$full_path};
	if (!defined $t) {
		die "$full_path not known in r$self->{r} or we have a bug!\n";
	}
1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991
	if ($t == $SVN::Node::none) {
		return $self->add_directory($full_path, $baton,
						undef, -1, $self->{pool});
	} elsif ($t == $SVN::Node::dir) {
		return $self->open_directory($full_path, $baton,
						$self->{r}, $self->{pool});
	}
	print STDERR "$full_path already exists in repository at ",
		"r$self->{r} and it is not a directory (",
		($t == $SVN::Node::file ? 'file' : 'unknown'),"/$t)\n";
	exit 1;
}

sub ensure_path {
	my ($self, $path) = @_;
	my $bat = $self->{bat};
1992 1993 1994
	my $repo_path = $self->repo_path($path);
	return $bat->{''} unless (length $repo_path);
	my @p = split m#/+#, $repo_path;
1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005
	my $c = shift @p;
	$bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''});
	while (@p) {
		my $c0 = $c;
		$c .= '/' . shift @p;
		$bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0});
	}
	return $bat->{$c};
}

sub A {
2006
	my ($self, $m) = @_;
2007 2008 2009 2010
	my ($dir, $file) = split_path($m->{file_b});
	my $pbat = $self->ensure_path($dir);
	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
					undef, -1);
2011
	print "\tA\t$m->{file_b}\n" unless $::_q;
2012 2013 2014 2015 2016
	$self->chg_file($fbat, $m);
	$self->close_file($fbat,undef,$self->{pool});
}

sub C {
2017
	my ($self, $m) = @_;
2018 2019 2020 2021
	my ($dir, $file) = split_path($m->{file_b});
	my $pbat = $self->ensure_path($dir);
	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
				$self->url_path($m->{file_a}), $self->{r});
2022
	print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035
	$self->chg_file($fbat, $m);
	$self->close_file($fbat,undef,$self->{pool});
}

sub delete_entry {
	my ($self, $path, $pbat) = @_;
	my $rpath = $self->repo_path($path);
	my ($dir, $file) = split_path($rpath);
	$self->{rm}->{$dir} = 1;
	$self->SUPER::delete_entry($rpath, $self->{r}, $pbat, $self->{pool});
}

sub R {
2036
	my ($self, $m) = @_;
2037 2038 2039 2040
	my ($dir, $file) = split_path($m->{file_b});
	my $pbat = $self->ensure_path($dir);
	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
				$self->url_path($m->{file_a}), $self->{r});
2041
	print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
2042 2043 2044 2045 2046 2047 2048 2049 2050
	$self->chg_file($fbat, $m);
	$self->close_file($fbat,undef,$self->{pool});

	($dir, $file) = split_path($m->{file_a});
	$pbat = $self->ensure_path($dir);
	$self->delete_entry($m->{file_a}, $pbat);
}

sub M {
2051
	my ($self, $m) = @_;
2052 2053 2054 2055
	my ($dir, $file) = split_path($m->{file_b});
	my $pbat = $self->ensure_path($dir);
	my $fbat = $self->open_file($self->repo_path($m->{file_b}),
				$pbat,$self->{r},$self->{pool});
2056
	print "\t$m->{chg}\t$m->{file_b}\n" unless $::_q;
2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096
	$self->chg_file($fbat, $m);
	$self->close_file($fbat,undef,$self->{pool});
}

sub T { shift->M(@_) }

sub change_file_prop {
	my ($self, $fbat, $pname, $pval) = @_;
	$self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool});
}

sub chg_file {
	my ($self, $fbat, $m) = @_;
	if ($m->{mode_b} =~ /755$/ && $m->{mode_a} !~ /755$/) {
		$self->change_file_prop($fbat,'svn:executable','*');
	} elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
		$self->change_file_prop($fbat,'svn:executable',undef);
	}
	my $fh = IO::File->new_tmpfile or croak $!;
	if ($m->{mode_b} =~ /^120/) {
		print $fh 'link ' or croak $!;
		$self->change_file_prop($fbat,'svn:special','*');
	} elsif ($m->{mode_a} =~ /^120/ && $m->{mode_b} !~ /^120/) {
		$self->change_file_prop($fbat,'svn:special',undef);
	}
	defined(my $pid = fork) or croak $!;
	if (!$pid) {
		open STDOUT, '>&', $fh or croak $!;
		exec qw/git-cat-file blob/, $m->{sha1_b} or croak $!;
	}
	waitpid $pid, 0;
	croak $? if $?;
	$fh->flush == 0 or croak $!;
	seek $fh, 0, 0 or croak $!;

	my $md5 = Digest::MD5->new;
	$md5->addfile($fh) or croak $!;
	seek $fh, 0, 0 or croak $!;

	my $exp = $md5->hexdigest;
2097 2098 2099
	my $pool = SVN::Pool->new;
	my $atd = $self->apply_textdelta($fbat, undef, $pool);
	my $got = SVN::TxDelta::send_stream($fh, @$atd, $pool);
2100
	die "Checksum mismatch\nexpected: $exp\ngot: $got\n" if ($got ne $exp);
2101
	$pool->clear;
2102 2103 2104 2105 2106

	close $fh or croak $!;
}

sub D {
2107
	my ($self, $m) = @_;
2108 2109
	my ($dir, $file) = split_path($m->{file_b});
	my $pbat = $self->ensure_path($dir);
2110
	print "\tD\t$m->{file_b}\n" unless $::_q;
2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126
	$self->delete_entry($m->{file_b}, $pbat);
}

sub close_edit {
	my ($self) = @_;
	my ($p,$bat) = ($self->{pool}, $self->{bat});
	foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) {
		$self->close_directory($bat->{$_}, $p);
	}
	$self->SUPER::close_edit($p);
	$p->clear;
}

sub abort_edit {
	my ($self) = @_;
	$self->SUPER::abort_edit($self->{pool});
2127 2128 2129 2130 2131
}

sub DESTROY {
	my $self = shift;
	$self->SUPER::DESTROY(@_);
2132 2133 2134
	$self->{pool}->clear;
}

2135 2136
# this drives the editor
sub apply_diff {
2137 2138
	my ($self) = @_;
	my $mods = $self->{mods};
2139
	my %o = ( D => 1, R => 0, C => -1, A => 3, M => 3, T => 3 );
2140
	foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
2141 2142 2143 2144 2145 2146 2147
		my $f = $m->{chg};
		if (defined $o{$f}) {
			$self->$f($m);
		} else {
			fatal("Invalid change type: $f\n");
		}
	}
2148
	$self->rmdirs if $_rmdir;
2149
	if (@$mods == 0) {
2150 2151 2152 2153
		$self->abort_edit;
	} else {
		$self->close_edit;
	}
2154
	return scalar @$mods;
2155 2156
}

2157 2158 2159 2160 2161
package Git::SVN::Ra;
use vars qw/@ISA $config_dir/;
use strict;
use warnings;
my ($can_do_switch);
2162
my $RA;
2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180

BEGIN {
	# enforce temporary pool usage for some simple functions
	my $e;
	foreach (qw/get_latest_revnum rev_proplist get_file
	            check_path get_dir get_uuid get_repos_root/) {
		$e .= "sub $_ {
			my \$self = shift;
			my \$pool = SVN::Pool->new;
			my \@ret = \$self->SUPER::$_(\@_,\$pool);
			\$pool->clear;
			wantarray ? \@ret : \$ret[0]; }\n";
	}
	eval $e;
}

sub new {
	my ($class, $url) = @_;
2181
	$url =~ s!/+$!!;
2182
	return $RA if ($RA && $RA->{url} eq $url);
2183

2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207
	SVN::_Core::svn_config_ensure($config_dir, undef);
	my ($baton, $callbacks) = SVN::Core::auth_open_helper([
	    SVN::Client::get_simple_provider(),
	    SVN::Client::get_ssl_server_trust_file_provider(),
	    SVN::Client::get_simple_prompt_provider(
	      \&Git::SVN::Prompt::simple, 2),
	    SVN::Client::get_ssl_client_cert_prompt_provider(
	      \&Git::SVN::Prompt::ssl_client_cert, 2),
	    SVN::Client::get_ssl_client_cert_pw_prompt_provider(
	      \&Git::SVN::Prompt::ssl_client_cert_pw, 2),
	    SVN::Client::get_username_provider(),
	    SVN::Client::get_ssl_server_trust_prompt_provider(
	      \&Git::SVN::Prompt::ssl_server_trust),
	    SVN::Client::get_username_prompt_provider(
	      \&Git::SVN::Prompt::username, 2),
	  ]);
	my $config = SVN::Core::config_get_config($config_dir);
	my $self = SVN::Ra->new(url => $url, auth => $baton,
	                      config => $config,
			      pool => SVN::Pool->new,
	                      auth_provider_callbacks => $callbacks);
	$self->{svn_path} = $url;
	$self->{repos_root} = $self->get_repos_root;
	$self->{svn_path} =~ s#^\Q$self->{repos_root}\E/*##;
2208
	$RA = bless $self, $class;
2209 2210 2211
}

sub DESTROY {
2212
	# do not call the real DESTROY since we store ourselves in $RA
2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224
}

sub get_log {
	my ($self, @args) = @_;
	my $pool = SVN::Pool->new;
	splice(@args, 3, 1) if ($SVN::Core::VERSION le '1.2.0');
	my $ret = $self->SUPER::get_log(@args, $pool);
	$pool->clear;
	$ret;
}

sub get_commit_editor {
2225
	my ($self, $log, $cb, $pool) = @_;
2226
	my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef, 0) : ();
2227
	$self->SUPER::get_commit_editor($log, $cb, @lock, $pool);
2228 2229 2230 2231 2232 2233 2234 2235 2236 2237
}

sub uuid {
	my ($self) = @_;
	$self->{uuid} ||= $self->get_uuid;
}

sub gs_do_update {
	my ($self, $rev_a, $rev_b, $path, $recurse, $editor) = @_;
	my $pool = SVN::Pool->new;
2238
	$editor->set_path_strip($path);
2239 2240 2241
	my (@pc) = split m#/#, $path;
	my $reporter = $self->do_update($rev_b, (@pc ? shift @pc : ''),
	                                $recurse, $editor, $pool);
2242
	my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255

	# Since we can't rely on svn_ra_reparent being available, we'll
	# just have to do some magic with set_path to make it so
	# we only want a partial path.
	my $sp = '';
	my $final = join('/', @pc);
	while (@pc) {
		$reporter->set_path($sp, $rev_b, 0, @lock, $pool);
		$sp .= '/' if length $sp;
		$sp .= shift @pc;
	}
	die "BUG: '$sp' != '$final'\n" if ($sp ne $final);

2256
	my $new = ($rev_a == $rev_b);
2257 2258
	$reporter->set_path($sp, $rev_a, $new, @lock, $pool);

2259 2260 2261 2262 2263
	$reporter->finish_report($pool);
	$pool->clear;
	$editor->{git_commit_ok};
}

2264 2265
# this requires SVN 1.4.3 or later (do_switch didn't work before 1.4.3, and
# svn_ra_reparent didn't work before 1.4)
2266 2267 2268
sub gs_do_switch {
	my ($self, $rev_a, $rev_b, $path, $recurse, $url_b, $editor) = @_;
	my $pool = SVN::Pool->new;
2269 2270 2271 2272

	my $full_url = $self->{url};
	my $old_url = $full_url;
	$full_url .= "/$path" if length $path;
2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286
	my ($ra, $reparented);
	if ($old_url ne $full_url) {
		if ($old_url !~ m#^svn(\+ssh)?://#) {
			SVN::_Ra::svn_ra_reparent($self->{session}, $full_url,
			                          $pool);
			$self->{url} = $full_url;
			$reparented = 1;
		} else {
			$ra = Git::SVN::Ra->new($full_url);
		}
	}
	$ra ||= $self;
	my $reporter = $ra->do_switch($rev_b, '',
	                              $recurse, $url_b, $editor, $pool);
2287
	my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
2288
	$reporter->set_path('', $rev_a, 0, @lock, $pool);
2289
	$reporter->finish_report($pool);
2290

2291 2292 2293 2294
	if ($reparented) {
		SVN::_Ra::svn_ra_reparent($self->{session}, $old_url, $pool);
		$self->{url} = $old_url;
	}
2295

2296 2297 2298 2299
	$pool->clear;
	$editor->{git_commit_ok};
}

2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311
sub gs_fetch_loop_common {
	my ($self, $base, $head, @gs) = @_;
	my $inc = 1000;
	my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
	my @paths = @gs == 1 ? ($gs[0]->{path}) : ('');
	foreach my $gs (@gs) {
		if (my $last_commit = $gs->last_commit) {
			$gs->assert_index_clean($last_commit);
		}
	}
	while (1) {
		my @revs;
2312 2313 2314 2315 2316 2317
		my $err;
		my $err_handler = $SVN::Error::handler;
		$SVN::Error::handler = sub {
			($err) = @_;
			skip_unknown_revs($err);
		};
2318 2319
		$self->get_log(\@paths, $min, $max, 0, 1, 1,
		    sub { push @revs, [ dup_changed_paths($_[0]), $_[1] ]; });
2320 2321
		$SVN::Error::handler = $err_handler;

2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333
		if (! @revs && $err && $max >= $head) {
			print STDERR "Branch probably deleted:\n  ",
			             $err->expanded_message,
			             "\nWill attempt to follow revisions ",
			             "r$min .. r$max ",
			             "committed before the deletion\n";
			@revs = map { [ undef, $_ ] } ($min .. $max);
		}
		foreach (@revs) {
			my ($paths, $r) = @$_;
			foreach my $gs (@gs) {
				if ($paths) {
2334
					$gs->match_paths($paths) or next;
2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348
				}
				next if defined $gs->rev_db_get($r);
				if (my $log_entry = $gs->do_fetch($paths, $r)) {
					$gs->do_git_commit($log_entry);
				}
			}
		}
		last if $max >= $head;
		$min = $max + 1;
		$max += $inc;
		$max = $head if ($max > $head);
	}
}

2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361
sub minimize_url {
	my ($self) = @_;
	return $self->{url} if ($self->{url} eq $self->{repos_root});
	my $url = $self->{repos_root};
	my @components = split(m!/!, $self->{svn_path});
	my $c = '';
	do {
		$url .= "/$c" if length $c;
		eval { (ref $self)->new($url)->get_latest_revnum };
	} while ($@ && ($c = shift @components));
	$url;
}

2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380
sub can_do_switch {
	my $self = shift;
	unless (defined $can_do_switch) {
		my $pool = SVN::Pool->new;
		my $rep = eval {
			$self->do_switch(1, '', 0, $self->{url},
			                 SVN::Delta::Editor->new, $pool);
		};
		if ($@) {
			$can_do_switch = 0;
		} else {
			$rep->abort_report($pool);
			$can_do_switch = 1;
		}
		$pool->clear;
	}
	$can_do_switch;
}

2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416
sub skip_unknown_revs {
	my ($err) = @_;
	my $errno = $err->apr_err();
	# Maybe the branch we're tracking didn't
	# exist when the repo started, so it's
	# not an error if it doesn't, just continue
	#
	# Wonderfully consistent library, eh?
	# 160013 - svn:// and file://
	# 175002 - http(s)://
	# 175007 - http(s):// (this repo required authorization, too...)
	#   More codes may be discovered later...
	if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
		return;
	}
	die "Error from SVN, ($errno): ", $err->expanded_message,"\n";
}

# svn_log_changed_path_t objects passed to get_log are likely to be
# overwritten even if only the refs are copied to an external variable,
# so we should dup the structures in their entirety.  Using an externally
# passed pool (instead of our temporary and quickly cleared pool in
# Git::SVN::Ra) does not help matters at all...
sub dup_changed_paths {
	my ($paths) = @_;
	return undef unless $paths;
	my %ret;
	foreach my $p (keys %$paths) {
		my $i = $paths->{$p};
		my %s = map { $_ => $i->$_ }
		              qw/copyfrom_path copyfrom_rev action/;
		$ret{$p} = \%s;
	}
	\%ret;
}

2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429
package Git::SVN::Log;
use strict;
use warnings;
use POSIX qw/strftime/;
use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline
            %rusers $show_commit $incremental/;
my $l_fmt;

sub cmt_showable {
	my ($c) = @_;
	return 1 if defined $c->{r};
	if ($c->{l} && $c->{l}->[-1] eq "...\n" &&
				$c->{a_raw} =~ /\@([a-f\d\-]+)>$/) {
2430 2431 2432 2433
		my @log = command(qw/cat-file commit/, $c->{c});
		shift @log while ($log[0] ne "\n");
		shift @log;
		@{$c->{l}} = grep !/^git-svn-id: /, @log;
2434 2435

		(undef, $c->{r}, undef) = ::extract_metadata(
2436
				(grep(/^git-svn-id: /, @log))[-1]);
2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533
	}
	return defined $c->{r};
}

sub log_use_color {
	return 1 if $color;
	my ($dc, $dcvar);
	$dcvar = 'color.diff';
	$dc = `git-config --get $dcvar`;
	if ($dc eq '') {
		# nothing at all; fallback to "diff.color"
		$dcvar = 'diff.color';
		$dc = `git-config --get $dcvar`;
	}
	chomp($dc);
	if ($dc eq 'auto') {
		my $pc;
		$pc = `git-config --get color.pager`;
		if ($pc eq '') {
			# does not have it -- fallback to pager.color
			$pc = `git-config --bool --get pager.color`;
		}
		else {
			$pc = `git-config --bool --get color.pager`;
			if ($?) {
				$pc = 'false';
			}
		}
		chomp($pc);
		if (-t *STDOUT || (defined $pager && $pc eq 'true')) {
			return ($ENV{TERM} && $ENV{TERM} ne 'dumb');
		}
		return 0;
	}
	return 0 if $dc eq 'never';
	return 1 if $dc eq 'always';
	chomp($dc = `git-config --bool --get $dcvar`);
	return ($dc eq 'true');
}

sub git_svn_log_cmd {
	my ($r_min, $r_max) = @_;
	my $gs = Git::SVN->_new;
	my @cmd = (qw/log --abbrev-commit --pretty=raw --default/,
	           $gs->refname);
	push @cmd, '-r' unless $non_recursive;
	push @cmd, qw/--raw --name-status/ if $verbose;
	push @cmd, '--color' if log_use_color();
	return @cmd unless defined $r_max;
	if ($r_max == $r_min) {
		push @cmd, '--max-count=1';
		if (my $c = $gs->rev_db_get($r_max)) {
			push @cmd, $c;
		}
	} else {
		my ($c_min, $c_max);
		$c_max = $gs->rev_db_get($r_max);
		$c_min = $gs->rev_db_get($r_min);
		if (defined $c_min && defined $c_max) {
			if ($r_max > $r_max) {
				push @cmd, "$c_min..$c_max";
			} else {
				push @cmd, "$c_max..$c_min";
			}
		} elsif ($r_max > $r_min) {
			push @cmd, $c_max;
		} else {
			push @cmd, $c_min;
		}
	}
	return @cmd;
}

# adapted from pager.c
sub config_pager {
	$pager ||= $ENV{GIT_PAGER} || $ENV{PAGER};
	if (!defined $pager) {
		$pager = 'less';
	} elsif (length $pager == 0 || $pager eq 'cat') {
		$pager = undef;
	}
}

sub run_pager {
	return unless -t *STDOUT;
	pipe my $rfd, my $wfd or return;
	defined(my $pid = fork) or ::fatal "Can't fork: $!\n";
	if (!$pid) {
		open STDOUT, '>&', $wfd or
		                     ::fatal "Can't redirect to stdout: $!\n";
		return;
	}
	open STDIN, '<&', $rfd or ::fatal "Can't redirect stdin: $!\n";
	$ENV{LESS} ||= 'FRSX';
	exec $pager or ::fatal "Can't run pager: $! ($pager)\n";
}

2534 2535 2536 2537 2538 2539
sub tz_to_s_offset {
	my ($tz) = @_;
	$tz =~ s/(\d\d)$//;
	return ($1 * 60) + ($tz * 3600);
}

2540 2541 2542 2543 2544
sub get_author_info {
	my ($dest, $author, $t, $tz) = @_;
	$author =~ s/(?:^\s*|\s*$)//g;
	$dest->{a_raw} = $author;
	my $au;
2545
	if ($::_authors) {
2546 2547 2548 2549 2550 2551 2552 2553 2554 2555
		$au = $rusers{$author} || undef;
	}
	if (!$au) {
		($au) = ($author =~ /<([^>]+)\@[^>]+>$/);
	}
	$dest->{t} = $t;
	$dest->{tz} = $tz;
	$dest->{a} = $au;
	# Date::Parse isn't in the standard Perl distro :(
	if ($tz =~ s/^\+//) {
2556
		$t += tz_to_s_offset($tz);
2557
	} elsif ($tz =~ s/^\-//) {
2558
		$t -= tz_to_s_offset($tz);
2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719
	}
	$dest->{t_utc} = $t;
}

sub process_commit {
	my ($c, $r_min, $r_max, $defer) = @_;
	if (defined $r_min && defined $r_max) {
		if ($r_min == $c->{r} && $r_min == $r_max) {
			show_commit($c);
			return 0;
		}
		return 1 if $r_min == $r_max;
		if ($r_min < $r_max) {
			# we need to reverse the print order
			return 0 if (defined $limit && --$limit < 0);
			push @$defer, $c;
			return 1;
		}
		if ($r_min != $r_max) {
			return 1 if ($r_min < $c->{r});
			return 1 if ($r_max > $c->{r});
		}
	}
	return 0 if (defined $limit && --$limit < 0);
	show_commit($c);
	return 1;
}

sub show_commit {
	my $c = shift;
	if ($oneline) {
		my $x = "\n";
		if (my $l = $c->{l}) {
			while ($l->[0] =~ /^\s*$/) { shift @$l }
			$x = $l->[0];
		}
		$l_fmt ||= 'A' . length($c->{r});
		print 'r',pack($l_fmt, $c->{r}),' | ';
		print "$c->{c} | " if $show_commit;
		print $x;
	} else {
		show_commit_normal($c);
	}
}

sub show_commit_changed_paths {
	my ($c) = @_;
	return unless $c->{changed};
	print "Changed paths:\n", @{$c->{changed}};
}

sub show_commit_normal {
	my ($c) = @_;
	print '-' x72, "\nr$c->{r} | ";
	print "$c->{c} | " if $show_commit;
	print "$c->{a} | ", strftime("%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)",
				 localtime($c->{t_utc})), ' | ';
	my $nr_line = 0;

	if (my $l = $c->{l}) {
		while ($l->[$#$l] eq "\n" && $#$l > 0
		                          && $l->[($#$l - 1)] eq "\n") {
			pop @$l;
		}
		$nr_line = scalar @$l;
		if (!$nr_line) {
			print "1 line\n\n\n";
		} else {
			if ($nr_line == 1) {
				$nr_line = '1 line';
			} else {
				$nr_line .= ' lines';
			}
			print $nr_line, "\n";
			show_commit_changed_paths($c);
			print "\n";
			print $_ foreach @$l;
		}
	} else {
		print "1 line\n";
		show_commit_changed_paths($c);
		print "\n";

	}
	foreach my $x (qw/raw diff/) {
		if ($c->{$x}) {
			print "\n";
			print $_ foreach @{$c->{$x}}
		}
	}
}

sub cmd_show_log {
	my (@args) = @_;
	my ($r_min, $r_max);
	my $r_last = -1; # prevent dupes
	if (defined $TZ) {
		$ENV{TZ} = $TZ;
	} else {
		delete $ENV{TZ};
	}
	if (defined $::_revision) {
		if ($::_revision =~ /^(\d+):(\d+)$/) {
			($r_min, $r_max) = ($1, $2);
		} elsif ($::_revision =~ /^\d+$/) {
			$r_min = $r_max = $::_revision;
		} else {
			::fatal "-r$::_revision is not supported, use ",
				"standard \'git log\' arguments instead\n";
		}
	}

	config_pager();
	@args = (git_svn_log_cmd($r_min, $r_max), @args);
	my $log = command_output_pipe(@args);
	run_pager();
	my (@k, $c, $d);
	my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/;
	while (<$log>) {
		if (/^${esc_color}commit ($::sha1_short)/o) {
			my $cmt = $1;
			if ($c && cmt_showable($c) && $c->{r} != $r_last) {
				$r_last = $c->{r};
				process_commit($c, $r_min, $r_max, \@k) or
								goto out;
			}
			$d = undef;
			$c = { c => $cmt };
		} elsif (/^${esc_color}author (.+) (\d+) ([\-\+]?\d+)$/o) {
			get_author_info($c, $1, $2, $3);
		} elsif (/^${esc_color}(?:tree|parent|committer) /o) {
			# ignore
		} elsif (/^${esc_color}:\d{6} \d{6} $::sha1_short/o) {
			push @{$c->{raw}}, $_;
		} elsif (/^${esc_color}[ACRMDT]\t/) {
			# we could add $SVN->{svn_path} here, but that requires
			# remote access at the moment (repo_path_split)...
			s#^(${esc_color})([ACRMDT])\t#$1   $2 #o;
			push @{$c->{changed}}, $_;
		} elsif (/^${esc_color}diff /o) {
			$d = 1;
			push @{$c->{diff}}, $_;
		} elsif ($d) {
			push @{$c->{diff}}, $_;
		} elsif (/^${esc_color}    (git-svn-id:.+)$/o) {
			($c->{url}, $c->{r}, undef) = ::extract_metadata($1);
		} elsif (s/^${esc_color}    //o) {
			push @{$c->{l}}, $_;
		}
	}
	if ($c && defined $c->{r} && $c->{r} != $r_last) {
		$r_last = $c->{r};
		process_commit($c, $r_min, $r_max, \@k);
	}
	if (@k) {
		my $swap = $r_max;
		$r_max = $r_min;
		$r_min = $swap;
		process_commit($_, $r_min, $r_max) foreach reverse @k;
	}
out:
2720
	close $log;
2721 2722 2723
	print '-' x72,"\n" unless $incremental || $oneline;
}

2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748
package Git::SVN::Migration;
# these version numbers do NOT correspond to actual version numbers
# of git nor git-svn.  They are just relative.
#
# v0 layout: .git/$id/info/url, refs/heads/$id-HEAD
#
# v1 layout: .git/$id/info/url, refs/remotes/$id
#
# v2 layout: .git/svn/$id/info/url, refs/remotes/$id
#
# v3 layout: .git/svn/$id, refs/remotes/$id
#            - info/url may remain for backwards compatibility
#            - this is what we migrate up to this layout automatically,
#            - this will be used by git svn init on single branches
#
# v4 layout: .git/svn/$repo_id/$id, refs/remotes/$repo_id/$id
#            - this is only created for newly multi-init-ed
#              repositories.  Similar in spirit to the
#              --use-separate-remotes option in git-clone (now default)
#            - we do not automatically migrate to this (following
#              the example set by core git)
use strict;
use warnings;
use Carp qw/croak/;
use File::Path qw/mkpath/;
2749 2750
use File::Basename qw/dirname basename/;
use vars qw/$_minimize/;
2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859

sub migrate_from_v0 {
	my $git_dir = $ENV{GIT_DIR};
	return undef unless -d $git_dir;
	my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/);
	my $migrated = 0;
	while (<$fh>) {
		chomp;
		my ($id, $orig_ref) = ($_, $_);
		next unless $id =~ s#^refs/heads/(.+)-HEAD$#$1#;
		next unless -f "$git_dir/$id/info/url";
		my $new_ref = "refs/remotes/$id";
		if (::verify_ref("$new_ref^0")) {
			print STDERR "W: $orig_ref is probably an old ",
			             "branch used by an ancient version of ",
				     "git-svn.\n",
				     "However, $new_ref also exists.\n",
				     "We will not be able ",
				     "to use this branch until this ",
				     "ambiguity is resolved.\n";
			next;
		}
		print STDERR "Migrating from v0 layout...\n" if !$migrated;
		print STDERR "Renaming ref: $orig_ref => $new_ref\n";
		command_noisy('update-ref', $new_ref, $orig_ref);
		command_noisy('update-ref', '-d', $orig_ref, $orig_ref);
		$migrated++;
	}
	command_close_pipe($fh, $ctx);
	print STDERR "Done migrating from v0 layout...\n" if $migrated;
	$migrated;
}

sub migrate_from_v1 {
	my $git_dir = $ENV{GIT_DIR};
	my $migrated = 0;
	return $migrated unless -d $git_dir;
	my $svn_dir = "$git_dir/svn";

	# just in case somebody used 'svn' as their $id at some point...
	return $migrated if -d $svn_dir && ! -f "$svn_dir/info/url";

	print STDERR "Migrating from a git-svn v1 layout...\n";
	mkpath([$svn_dir]);
	print STDERR "Data from a previous version of git-svn exists, but\n\t",
	             "$svn_dir\n\t(required for this version ",
	             "($::VERSION) of git-svn) does not. exist\n";
	my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/);
	while (<$fh>) {
		my $x = $_;
		next unless $x =~ s#^refs/remotes/##;
		chomp $x;
		next unless -f "$git_dir/$x/info/url";
		my $u = eval { ::file_to_s("$git_dir/$x/info/url") };
		next unless $u;
		my $dn = dirname("$git_dir/svn/$x");
		mkpath([$dn]) unless -d $dn;
		if ($x eq 'svn') { # they used 'svn' as GIT_SVN_ID:
			mkpath(["$git_dir/svn/svn"]);
			print STDERR " - $git_dir/$x/info => ",
			                "$git_dir/svn/$x/info\n";
			rename "$git_dir/$x/info", "$git_dir/svn/$x/info" or
			       croak "$!: $x";
			# don't worry too much about these, they probably
			# don't exist with repos this old (save for index,
			# and we can easily regenerate that)
			foreach my $f (qw/unhandled.log index .rev_db/) {
				rename "$git_dir/$x/$f", "$git_dir/svn/$x/$f";
			}
		} else {
			print STDERR " - $git_dir/$x => $git_dir/svn/$x\n";
			rename "$git_dir/$x", "$git_dir/svn/$x" or
			       croak "$!: $x";
		}
		$migrated++;
	}
	command_close_pipe($fh, $ctx);
	print STDERR "Done migrating from a git-svn v1 layout\n";
	$migrated;
}

sub read_old_urls {
	my ($l_map, $pfx, $path) = @_;
	my @dir;
	foreach (<$path/*>) {
		if (-r "$_/info/url") {
			$pfx .= '/' if $pfx && $pfx !~ m!/$!;
			my $ref_id = $pfx . basename $_;
			my $url = ::file_to_s("$_/info/url");
			$l_map->{$ref_id} = $url;
		} elsif (-d $_) {
			push @dir, $_;
		}
	}
	foreach (@dir) {
		my $x = $_;
		$x =~ s!^\Q$ENV{GIT_DIR}\E/svn/!!o;
		read_old_urls($l_map, $x, $_);
	}
}

sub migrate_from_v2 {
	my @cfg = command(qw/config -l/);
	return if grep /^svn-remote\..+\.url=/, @cfg;
	my %l_map;
	read_old_urls(\%l_map, '', "$ENV{GIT_DIR}/svn");
	my $migrated = 0;

	foreach my $ref_id (sort keys %l_map) {
2860
		Git::SVN->init($l_map{$ref_id}, '', $ref_id, $ref_id);
2861 2862 2863 2864 2865
		$migrated++;
	}
	$migrated;
}

2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927
sub minimize_connections {
	my $r = Git::SVN::read_all_remotes();
	my $new_urls = {};
	my $root_repos = {};
	foreach my $repo_id (keys %$r) {
		my $url = $r->{$repo_id}->{url} or next;
		my $fetch = $r->{$repo_id}->{fetch} or next;
		my $ra = Git::SVN::Ra->new($url);

		# skip existing cases where we already connect to the root
		if (($ra->{url} eq $ra->{repos_root}) ||
		    (Git::SVN::sanitize_remote_name($ra->{repos_root}) eq
		     $repo_id)) {
			$root_repos->{$ra->{url}} = $repo_id;
			next;
		}

		my $root_ra = Git::SVN::Ra->new($ra->{repos_root});
		my $root_path = $ra->{url};
		$root_path =~ s#^\Q$ra->{repos_root}\E/*##;
		foreach my $path (keys %$fetch) {
			my $ref_id = $fetch->{$path};
			my $gs = Git::SVN->new($ref_id, $repo_id, $path);

			# make sure we can read when connecting to
			# a higher level of a repository
			my ($last_rev, undef) = $gs->last_rev_commit;
			if (!defined $last_rev) {
				$last_rev = eval {
					$root_ra->get_latest_revnum;
				};
				next if $@;
			}
			my $new = $root_path;
			$new .= length $path ? "/$path" : '';
			eval {
				$root_ra->get_log([$new], $last_rev, $last_rev,
			                          0, 0, 1, sub { });
			};
			next if $@;
			$new_urls->{$ra->{repos_root}}->{$new} =
			        { ref_id => $ref_id,
				  old_repo_id => $repo_id,
				  old_path => $path };
		}
	}

	my @emptied;
	foreach my $url (keys %$new_urls) {
		# see if we can re-use an existing [svn-remote "repo_id"]
		# instead of creating a(n ugly) new section:
		my $repo_id = $root_repos->{$url} ||
		              Git::SVN::sanitize_remote_name($url);

		my $fetch = $new_urls->{$url};
		foreach my $path (keys %$fetch) {
			my $x = $fetch->{$path};
			Git::SVN->init($url, $path, $repo_id, $x->{ref_id});
			my $pfx = "svn-remote.$x->{old_repo_id}";

			my $old_fetch = quotemeta("$x->{old_path}:".
			                          "refs/remotes/$x->{ref_id}");
2928
			command_noisy(qw/config --unset/,
2929 2930 2931 2932
			              "$pfx.fetch", '^'. $old_fetch . '$');
			delete $r->{$x->{old_repo_id}}->
			       {fetch}->{$x->{old_path}};
			if (!keys %{$r->{$x->{old_repo_id}}->{fetch}}) {
2933
				command_noisy(qw/config --unset/,
2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949
				              "$pfx.url");
				push @emptied, $x->{old_repo_id}
			}
		}
	}
	if (@emptied) {
		my $file = $ENV{GIT_CONFIG} || $ENV{GIT_CONFIG_LOCAL} ||
		           "$ENV{GIT_DIR}/config";
		print STDERR <<EOF;
The following [svn-remote] sections in your config file ($file) are empty
and can be safely removed:
EOF
		print STDERR "[svn-remote \"$_\"]\n" foreach @emptied;
	}
}

2950 2951 2952 2953
sub migration_check {
	migrate_from_v0();
	migrate_from_v1();
	migrate_from_v2();
2954
	minimize_connections() if $_minimize;
2955 2956
}

2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988
package Git::IndexInfo;
use strict;
use warnings;
use Git qw/command_input_pipe command_close_pipe/;

sub new {
	my ($class) = @_;
	my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/);
	bless { gui => $gui, ctx => $ctx, nr => 0}, $class;
}

sub remove {
	my ($self, $path) = @_;
	if (print { $self->{gui} } '0 ', 0 x 40, "\t", $path, "\0") {
		return ++$self->{nr};
	}
	undef;
}

sub update {
	my ($self, $mode, $hash, $path) = @_;
	if (print { $self->{gui} } $mode, ' ', $hash, "\t", $path, "\0") {
		return ++$self->{nr};
	}
	undef;
}

sub DESTROY {
	my ($self) = @_;
	command_close_pipe($self->{gui}, $self->{ctx});
}

E
Eric Wong 已提交
2989 2990 2991 2992
__END__

Data structures:

2993
$log_entry hashref as returned by libsvn_log_entry()
E
Eric Wong 已提交
2994
{
2995
	log => 'whitespace-formatted log entry
E
Eric Wong 已提交
2996 2997 2998 2999 3000 3001
',						# trailing newline is preserved
	revision => '8',			# integer
	date => '2004-02-24T17:01:44.108345Z',	# commit date
	author => 'committer name'
};

3002 3003

# this is generated by generate_diff();
E
Eric Wong 已提交
3004 3005 3006 3007 3008 3009 3010 3011
@mods = array of diff-index line hashes, each element represents one line
	of diff-index output

diff-index line ($m hash)
{
	mode_a => first column of diff-index output, no leading ':',
	mode_b => second column of diff-index output,
	sha1_b => sha1sum of the final blob,
3012
	chg => change type [MCRADT],
E
Eric Wong 已提交
3013 3014 3015 3016
	file_a => original file name of a file (iff chg is 'C' or 'R')
	file_b => new/current file name of a file (any chg)
}
;
3017

3018 3019 3020 3021 3022 3023 3024 3025 3026 3027
# retval of read_url_paths{,_all}();
$l_map = {
	# repository root url
	'https://svn.musicpd.org' => {
		# repository path 		# GIT_SVN_ID
		'mpd/trunk'		=>	'trunk',
		'mpd/tags/0.11.5'	=>	'tags/0.11.5',
	},
}

3028 3029 3030
Notes:
	I don't trust the each() function on unless I created %hash myself
	because the internal iterator may not have started at base.