PageRenderTime 87ms CodeModel.GetById 19ms RepoModel.GetById 0ms app.codeStats 1ms

/git/git-svn.perl

https://review.tizen.org/git/
Perl | 6213 lines | 5519 code | 414 blank | 280 comment | 780 complexity | 674221d6d3d9cdf47333b1897f2da209 MD5 | raw file
Possible License(s): GPL-3.0, AGPL-3.0, GPL-2.0, MPL-2.0, JSON, WTFPL, CC-BY-SA-4.0, CC-BY-3.0, BSD-3-Clause, LGPL-2.0, MPL-2.0-no-copyleft-exception, AGPL-1.0, 0BSD, Zlib, Unlicense, BSD-2-Clause, Apache-2.0, LGPL-3.0, ISC, MIT, CC-BY-SA-3.0, CC0-1.0, LGPL-2.1 
    

  1. #!/usr/bin/env perl
    2. 

  2. # Copyright (C) 2006, Eric Wong <normalperson@yhbt.net>
    3. 

  3. # License: GPL v2 or later
    4. 

  4. use warnings;
    5. 

  5. use strict;
    6. 

  6. use vars qw/	$AUTHOR $VERSION
    7. 

  7. 		$sha1 $sha1_short $_revision $_repository
    8. 

  8. 		$_q $_authors $_authors_prog %users/;
    9. 

  9. $AUTHOR = 'Eric Wong <normalperson@yhbt.net>';
    10. 

  10. $VERSION = '@@GIT_VERSION@@';
    11. 

  11. 

  12. # From which subdir have we been invoked?
    13. 

  13. my $cmd_dir_prefix = eval {
    14. 

  14. 	command_oneline([qw/rev-parse --show-prefix/], STDERR => 0)
    15. 

  15. } || '';
    16. 

  16. 

  17. my $git_dir_user_set = 1 if defined $ENV{GIT_DIR};
    18. 

  18. $ENV{GIT_DIR} ||= '.git';
    19. 

  19. $Git::SVN::default_repo_id = 'svn';
    20. 

  20. $Git::SVN::default_ref_id = $ENV{GIT_SVN_ID} || 'git-svn';
    21. 

  21. $Git::SVN::Ra::_log_window_size = 100;
    22. 

  22. $Git::SVN::_minimize_url = 'unset';
    23. 

  23. 

  24. if (! exists $ENV{SVN_SSH}) {
    25. 

  25. 	if (exists $ENV{GIT_SSH}) {
    26. 

  26. 		$ENV{SVN_SSH} = $ENV{GIT_SSH};
    27. 

  27. 		if ($^O eq 'msys') {
    28. 

  28. 			$ENV{SVN_SSH} =~ s/\\/\\\\/g;
    29. 

  29. 			$ENV{SVN_SSH} =~ s/(.*)/"$1"/;
    30. 

  30. 		}
    31. 

  31. 	}
    32. 

  32. }
    33. 

  33. 

  34. $Git::SVN::Log::TZ = $ENV{TZ};
    35. 

  35. $ENV{TZ} = 'UTC';
    36. 

  36. $| = 1; # unbuffer STDOUT
    37. 

  37. 

  38. sub fatal (@) { print STDERR "@_\n"; exit 1 }
    39. 

  39. sub _req_svn {
    40. 

  40. 	require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
    41. 

  41. 	require SVN::Ra;
    42. 

  42. 	require SVN::Delta;
    43. 

  43. 	if ($SVN::Core::VERSION lt '1.1.0') {
    44. 

  44. 		fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)";
    45. 

  45. 	}
    46. 

  46. }
    47. 

  47. my $can_compress = eval { require Compress::Zlib; 1};
    48. 

  48. push @Git::SVN::Ra::ISA, 'SVN::Ra';
    49. 

  49. push @SVN::Git::Editor::ISA, 'SVN::Delta::Editor';
    50. 

  50. push @SVN::Git::Fetcher::ISA, 'SVN::Delta::Editor';
    51. 

  51. use Carp qw/croak/;
    52. 

  52. use Digest::MD5;
    53. 

  53. use IO::File qw//;
    54. 

  54. use File::Basename qw/dirname basename/;
    55. 

  55. use File::Path qw/mkpath/;
    56. 

  56. use File::Spec;
    57. 

  57. use File::Find;
    58. 

  58. use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/;
    59. 

  59. use IPC::Open3;
    60. 

  60. use Git;
    61. 

  61. 

  62. BEGIN {
    63. 

  63. 	# import functions from Git into our packages, en masse
    64. 

  64. 	no strict 'refs';
    65. 

  65. 	foreach (qw/command command_oneline command_noisy command_output_pipe
    66. 

  66. 	            command_input_pipe command_close_pipe
    67. 

  67. 	            command_bidi_pipe command_close_bidi_pipe/) {
    68. 

  68. 		for my $package ( qw(SVN::Git::Editor SVN::Git::Fetcher
    69. 

  69. 			Git::SVN::Migration Git::SVN::Log Git::SVN),
    70. 

  70. 			__PACKAGE__) {
    71. 

  71. 			*{"${package}::$_"} = \&{"Git::$_"};
    72. 

  72. 		}
    73. 

  73. 	}
    74. 

  74. }
    75. 

  75. 

  76. my ($SVN);
    77. 

  77. 

  78. $sha1 = qr/[a-f\d]{40}/;
    79. 

  79. $sha1_short = qr/[a-f\d]{4,40}/;
    80. 

  80. my ($_stdin, $_help, $_edit,
    81. 

  81. 	$_message, $_file, $_branch_dest,
    82. 

  82. 	$_template, $_shared,
    83. 

  83. 	$_version, $_fetch_all, $_no_rebase, $_fetch_parent,
    84. 

  84. 	$_merge, $_strategy, $_dry_run, $_local,
    85. 

  85. 	$_prefix, $_no_checkout, $_url, $_verbose,
    86. 

  86. 	$_git_format, $_commit_url, $_tag);
    87. 

  87. $Git::SVN::_follow_parent = 1;
    88. 

  88. $_q ||= 0;
    89. 

  89. my %remote_opts = ( 'username=s' => \$Git::SVN::Prompt::_username,
    90. 

  90.                     'config-dir=s' => \$Git::SVN::Ra::config_dir,
    91. 

  91.                     'no-auth-cache' => \$Git::SVN::Prompt::_no_auth_cache,
    92. 

  92.                     'ignore-paths=s' => \$SVN::Git::Fetcher::_ignore_regex );
    93. 

  93. my %fc_opts = ( 'follow-parent|follow!' => \$Git::SVN::_follow_parent,
    94. 

  94. 		'authors-file|A=s' => \$_authors,
    95. 

  95. 		'authors-prog=s' => \$_authors_prog,
    96. 

  96. 		'repack:i' => \$Git::SVN::_repack,
    97. 

  97. 		'noMetadata' => \$Git::SVN::_no_metadata,
    98. 

  98. 		'useSvmProps' => \$Git::SVN::_use_svm_props,
    99. 

  99. 		'useSvnsyncProps' => \$Git::SVN::_use_svnsync_props,
    100. 

  100. 		'log-window-size=i' => \$Git::SVN::Ra::_log_window_size,
    101. 

  101. 		'no-checkout' => \$_no_checkout,
    102. 

  102. 		'quiet|q+' => \$_q,
    103. 

  103. 		'repack-flags|repack-args|repack-opts=s' =>
    104. 

  104. 		   \$Git::SVN::_repack_flags,
    105. 

  105. 		'use-log-author' => \$Git::SVN::_use_log_author,
    106. 

  106. 		'add-author-from' => \$Git::SVN::_add_author_from,
    107. 

  107. 		'localtime' => \$Git::SVN::_localtime,
    108. 

  108. 		%remote_opts );
    109. 

  109. 

  110. my ($_trunk, @_tags, @_branches, $_stdlayout);
    111. 

  111. my %icv;
    112. 

  112. my %init_opts = ( 'template=s' => \$_template, 'shared:s' => \$_shared,
    113. 

  113.                   'trunk|T=s' => \$_trunk, 'tags|t=s@' => \@_tags,
    114. 

  114.                   'branches|b=s@' => \@_branches, 'prefix=s' => \$_prefix,
    115. 

  115.                   'stdlayout|s' => \$_stdlayout,
    116. 

  116.                   'minimize-url|m!' => \$Git::SVN::_minimize_url,
    117. 

  117. 		  'no-metadata' => sub { $icv{noMetadata} = 1 },
    118. 

  118. 		  'use-svm-props' => sub { $icv{useSvmProps} = 1 },
    119. 

  119. 		  'use-svnsync-props' => sub { $icv{useSvnsyncProps} = 1 },
    120. 

  120. 		  'rewrite-root=s' => sub { $icv{rewriteRoot} = $_[1] },
    121. 

  121. 		  'rewrite-uuid=s' => sub { $icv{rewriteUUID} = $_[1] },
    122. 

  122.                   %remote_opts );
    123. 

  123. my %cmt_opts = ( 'edit|e' => \$_edit,
    124. 

  124. 		'rmdir' => \$SVN::Git::Editor::_rmdir,
    125. 

  125. 		'find-copies-harder' => \$SVN::Git::Editor::_find_copies_harder,
    126. 

  126. 		'l=i' => \$SVN::Git::Editor::_rename_limit,
    127. 

  127. 		'copy-similarity|C=i'=> \$SVN::Git::Editor::_cp_similarity
    128. 

  128. );
    129. 

  129. 

  130. my %cmd = (
    131. 

  131. 	fetch => [ \&cmd_fetch, "Download new revisions from SVN",
    132. 

  132. 			{ 'revision|r=s' => \$_revision,
    133. 

  133. 			  'fetch-all|all' => \$_fetch_all,
    134. 

  134. 			  'parent|p' => \$_fetch_parent,
    135. 

  135. 			   %fc_opts } ],
    136. 

  136. 	clone => [ \&cmd_clone, "Initialize and fetch revisions",
    137. 

  137. 			{ 'revision|r=s' => \$_revision,
    138. 

  138. 			   %fc_opts, %init_opts } ],
    139. 

  139. 	init => [ \&cmd_init, "Initialize a repo for tracking" .
    140. 

  140. 			  " (requires URL argument)",
    141. 

  141. 			  \%init_opts ],
    142. 

  142. 	'multi-init' => [ \&cmd_multi_init,
    143. 

  143. 	                  "Deprecated alias for ".
    144. 

  144. 			  "'$0 init -T<trunk> -b<branches> -t<tags>'",
    145. 

  145. 			  \%init_opts ],
    146. 

  146. 	dcommit => [ \&cmd_dcommit,
    147. 

  147. 	             'Commit several diffs to merge with upstream',
    148. 

  148. 			{ 'merge|m|M' => \$_merge,
    149. 

  149. 			  'strategy|s=s' => \$_strategy,
    150. 

  150. 			  'verbose|v' => \$_verbose,
    151. 

  151. 			  'dry-run|n' => \$_dry_run,
    152. 

  152. 			  'fetch-all|all' => \$_fetch_all,
    153. 

  153. 			  'commit-url=s' => \$_commit_url,
    154. 

  154. 			  'revision|r=i' => \$_revision,
    155. 

  155. 			  'no-rebase' => \$_no_rebase,
    156. 

  156. 			%cmt_opts, %fc_opts } ],
    157. 

  157. 	branch => [ \&cmd_branch,
    158. 

  158. 	            'Create a branch in the SVN repository',
    159. 

  159. 	            { 'message|m=s' => \$_message,
    160. 

  160. 	              'destination|d=s' => \$_branch_dest,
    161. 

  161. 	              'dry-run|n' => \$_dry_run,
    162. 

  162. 	              'tag|t' => \$_tag,
    163. 

  163. 	              'username=s' => \$Git::SVN::Prompt::_username,
    164. 

  164. 	              'commit-url=s' => \$_commit_url } ],
    165. 

  165. 	tag => [ sub { $_tag = 1; cmd_branch(@_) },
    166. 

  166. 	         'Create a tag in the SVN repository',
    167. 

  167. 	         { 'message|m=s' => \$_message,
    168. 

  168. 	           'destination|d=s' => \$_branch_dest,
    169. 

  169. 	           'dry-run|n' => \$_dry_run,
    170. 

  170. 	           'username=s' => \$Git::SVN::Prompt::_username,
    171. 

  171. 	           'commit-url=s' => \$_commit_url } ],
    172. 

  172. 	'set-tree' => [ \&cmd_set_tree,
    173. 

  173. 	                "Set an SVN repository to a git tree-ish",
    174. 

  174. 			{ 'stdin' => \$_stdin, %cmt_opts, %fc_opts, } ],
    175. 

  175. 	'create-ignore' => [ \&cmd_create_ignore,
    176. 

  176. 			     'Create a .gitignore per svn:ignore',
    177. 

  177. 			     { 'revision|r=i' => \$_revision
    178. 

  178. 			     } ],
    179. 

  179. 	'mkdirs' => [ \&cmd_mkdirs ,
    180. 

  180. 	              "recreate empty directories after a checkout",
    181. 

  181. 	              { 'revision|r=i' => \$_revision } ],
    182. 

  182.         'propget' => [ \&cmd_propget,
    183. 

  183. 		       'Print the value of a property on a file or directory',
    184. 

  184. 		       { 'revision|r=i' => \$_revision } ],
    185. 

  185.         'proplist' => [ \&cmd_proplist,
    186. 

  186. 		       'List all properties of a file or directory',
    187. 

  187. 		       { 'revision|r=i' => \$_revision } ],
    188. 

  188. 	'show-ignore' => [ \&cmd_show_ignore, "Show svn:ignore listings",
    189. 

  189. 			{ 'revision|r=i' => \$_revision
    190. 

  190. 			} ],
    191. 

  191. 	'show-externals' => [ \&cmd_show_externals, "Show svn:externals listings",
    192. 

  192. 			{ 'revision|r=i' => \$_revision
    193. 

  193. 			} ],
    194. 

  194. 	'multi-fetch' => [ \&cmd_multi_fetch,
    195. 

  195. 	                   "Deprecated alias for $0 fetch --all",
    196. 

  196. 			   { 'revision|r=s' => \$_revision, %fc_opts } ],
    197. 

  197. 	'migrate' => [ sub { },
    198. 

  198. 	               # no-op, we automatically run this anyways,
    199. 

  199. 	               'Migrate configuration/metadata/layout from
    200. 

  200. 		        previous versions of git-svn',
    201. 

  201.                        { 'minimize' => \$Git::SVN::Migration::_minimize,
    202. 

  202. 			 %remote_opts } ],
    203. 

  203. 	'log' => [ \&Git::SVN::Log::cmd_show_log, 'Show commit logs',
    204. 

  204. 			{ 'limit=i' => \$Git::SVN::Log::limit,
    205. 

  205. 			  'revision|r=s' => \$_revision,
    206. 

  206. 			  'verbose|v' => \$Git::SVN::Log::verbose,
    207. 

  207. 			  'incremental' => \$Git::SVN::Log::incremental,
    208. 

  208. 			  'oneline' => \$Git::SVN::Log::oneline,
    209. 

  209. 			  'show-commit' => \$Git::SVN::Log::show_commit,
    210. 

  210. 			  'non-recursive' => \$Git::SVN::Log::non_recursive,
    211. 

  211. 			  'authors-file|A=s' => \$_authors,
    212. 

  212. 			  'color' => \$Git::SVN::Log::color,
    213. 

  213. 			  'pager=s' => \$Git::SVN::Log::pager
    214. 

  214. 			} ],
    215. 

  215. 	'find-rev' => [ \&cmd_find_rev,
    216. 

  216. 	                "Translate between SVN revision numbers and tree-ish",
    217. 

  217. 			{} ],
    218. 

  218. 	'rebase' => [ \&cmd_rebase, "Fetch and rebase your working directory",
    219. 

  219. 			{ 'merge|m|M' => \$_merge,
    220. 

  220. 			  'verbose|v' => \$_verbose,
    221. 

  221. 			  'strategy|s=s' => \$_strategy,
    222. 

  222. 			  'local|l' => \$_local,
    223. 

  223. 			  'fetch-all|all' => \$_fetch_all,
    224. 

  224. 			  'dry-run|n' => \$_dry_run,
    225. 

  225. 			  %fc_opts } ],
    226. 

  226. 	'commit-diff' => [ \&cmd_commit_diff,
    227. 

  227. 	                   'Commit a diff between two trees',
    228. 

  228. 			{ 'message|m=s' => \$_message,
    229. 

  229. 			  'file|F=s' => \$_file,
    230. 

  230. 			  'revision|r=s' => \$_revision,
    231. 

  231. 			%cmt_opts } ],
    232. 

  232. 	'info' => [ \&cmd_info,
    233. 

  233. 		    "Show info about the latest SVN revision
    234. 

  234. 		     on the current branch",
    235. 

  235. 		    { 'url' => \$_url, } ],
    236. 

  236. 	'blame' => [ \&Git::SVN::Log::cmd_blame,
    237. 

  237. 	            "Show what revision and author last modified each line of a file",
    238. 

  238. 		    { 'git-format' => \$_git_format } ],
    239. 

  239. 	'reset' => [ \&cmd_reset,
    240. 

  240. 		     "Undo fetches back to the specified SVN revision",
    241. 

  241. 		     { 'revision|r=s' => \$_revision,
    242. 

  242. 		       'parent|p' => \$_fetch_parent } ],
    243. 

  243. 	'gc' => [ \&cmd_gc,
    244. 

  244. 		  "Compress unhandled.log files in .git/svn and remove " .
    245. 

  245. 		  "index files in .git/svn",
    246. 

  246. 		{} ],
    247. 

  247. );
    248. 

  248. 

  249. my $cmd;
    250. 

  250. for (my $i = 0; $i < @ARGV; $i++) {
    251. 

  251. 	if (defined $cmd{$ARGV[$i]}) {
    252. 

  252. 		$cmd = $ARGV[$i];
    253. 

  253. 		splice @ARGV, $i, 1;
    254. 

  254. 		last;
    255. 

  255. 	} elsif ($ARGV[$i] eq 'help') {
    256. 

  256. 		$cmd = $ARGV[$i+1];
    257. 

  257. 		usage(0);
    258. 

  258. 	}
    259. 

  259. };
    260. 

  260. 

  261. # make sure we're always running at the top-level working directory
    262. 

  262. unless ($cmd && $cmd =~ /(?:clone|init|multi-init)$/) {
    263. 

  263. 	unless (-d $ENV{GIT_DIR}) {
    264. 

  264. 		if ($git_dir_user_set) {
    265. 

  265. 			die "GIT_DIR=$ENV{GIT_DIR} explicitly set, ",
    266. 

  266. 			    "but it is not a directory\n";
    267. 

  267. 		}
    268. 

  268. 		my $git_dir = delete $ENV{GIT_DIR};
    269. 

  269. 		my $cdup = undef;
    270. 

  270. 		git_cmd_try {
    271. 

  271. 			$cdup = command_oneline(qw/rev-parse --show-cdup/);
    272. 

  272. 			$git_dir = '.' unless ($cdup);
    273. 

  273. 			chomp $cdup if ($cdup);
    274. 

  274. 			$cdup = "." unless ($cdup && length $cdup);
    275. 

  275. 		} "Already at toplevel, but $git_dir not found\n";
    276. 

  276. 		chdir $cdup or die "Unable to chdir up to '$cdup'\n";
    277. 

  277. 		unless (-d $git_dir) {
    278. 

  278. 			die "$git_dir still not found after going to ",
    279. 

  279. 			    "'$cdup'\n";
    280. 

  280. 		}
    281. 

  281. 		$ENV{GIT_DIR} = $git_dir;
    282. 

  282. 	}
    283. 

  283. 	$_repository = Git->repository(Repository => $ENV{GIT_DIR});
    284. 

  284. }
    285. 

  285. 

  286. my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
    287. 

  287. 

  288. read_git_config(\%opts);
    289. 

  289. if ($cmd && ($cmd eq 'log' || $cmd eq 'blame')) {
    290. 

  290. 	Getopt::Long::Configure('pass_through');
    291. 

  291. }
    292. 

  292. my $rv = GetOptions(%opts, 'help|H|h' => \$_help, 'version|V' => \$_version,
    293. 

  293.                     'minimize-connections' => \$Git::SVN::Migration::_minimize,
    294. 

  294.                     'id|i=s' => \$Git::SVN::default_ref_id,
    295. 

  295.                     'svn-remote|remote|R=s' => sub {
    296. 

  296.                        $Git::SVN::no_reuse_existing = 1;
    297. 

  297.                        $Git::SVN::default_repo_id = $_[1] });
    298. 

  298. exit 1 if (!$rv && $cmd && $cmd ne 'log');
    299. 

  299. 

  300. usage(0) if $_help;
    301. 

  301. version() if $_version;
    302. 

  302. usage(1) unless defined $cmd;
    303. 

  303. load_authors() if $_authors;
    304. 

  304. if (defined $_authors_prog) {
    305. 

  305. 	$_authors_prog = "'" . File::Spec->rel2abs($_authors_prog) . "'";
    306. 

  306. }
    307. 

  307. 

  308. unless ($cmd =~ /^(?:clone|init|multi-init|commit-diff)$/) {
    309. 

  309. 	Git::SVN::Migration::migration_check();
    310. 

  310. }
    311. 

  311. Git::SVN::init_vars();
    312. 

  312. eval {
    313. 

  313. 	Git::SVN::verify_remotes_sanity();
    314. 

  314. 	$cmd{$cmd}->[0]->(@ARGV);
    315. 

  315. };
    316. 

  316. fatal $@ if $@;
    317. 

  317. post_fetch_checkout();
    318. 

  318. exit 0;
    319. 

  319. 

  320. ####################### primary functions ######################
    321. 

  321. sub usage {
    322. 

  322. 	my $exit = shift || 0;
    323. 

  323. 	my $fd = $exit ? \*STDERR : \*STDOUT;
    324. 

  324. 	print $fd <<"";
    325. 

  325. git-svn - bidirectional operations between a single Subversion tree and git
    326. 

  326. Usage: git svn <command> [options] [arguments]\n
    327. 

  327. 

  328. 	print $fd "Available commands:\n" unless $cmd;
    329. 

  329. 

  330. 	foreach (sort keys %cmd) {
    331. 

  331. 		next if $cmd && $cmd ne $_;
    332. 

  332. 		next if /^multi-/; # don't show deprecated commands
    333. 

  333. 		print $fd '  ',pack('A17',$_),$cmd{$_}->[1],"\n";
    334. 

  334. 		foreach (sort keys %{$cmd{$_}->[2]}) {
    335. 

  335. 			# mixed-case options are for .git/config only
    336. 

  336. 			next if /[A-Z]/ && /^[a-z]+$/i;
    337. 

  337. 			# prints out arguments as they should be passed:
    338. 

  338. 			my $x = s#[:=]s$## ? '<arg>' : s#[:=]i$## ? '<num>' : '';
    339. 

  339. 			print $fd ' ' x 21, join(', ', map { length $_ > 1 ?
    340. 

  340. 							"--$_" : "-$_" }
    341. 

  341. 						split /\|/,$_)," $x\n";
    342. 

  342. 		}
    343. 

  343. 	}
    344. 

  344. 	print $fd <<"";
    345. 

  345. \nGIT_SVN_ID may be set in the environment or via the --id/-i switch to an
    346. 

  346. arbitrary identifier if you're tracking multiple SVN branches/repositories in
    347. 

  347. one git repository and want to keep them separate.  See git-svn(1) for more
    348. 

  348. information.
    349. 

  349. 

  350. 	exit $exit;
    351. 

  351. }
    352. 

  352. 

  353. sub version {
    354. 

  354. 	::_req_svn();
    355. 

  355. 	print "git-svn version $VERSION (svn $SVN::Core::VERSION)\n";
    356. 

  356. 	exit 0;
    357. 

  357. }
    358. 

  358. 

  359. sub do_git_init_db {
    360. 

  360. 	unless (-d $ENV{GIT_DIR}) {
    361. 

  361. 		my @init_db = ('init');
    362. 

  362. 		push @init_db, "--template=$_template" if defined $_template;
    363. 

  363. 		if (defined $_shared) {
    364. 

  364. 			if ($_shared =~ /[a-z]/) {
    365. 

  365. 				push @init_db, "--shared=$_shared";
    366. 

  366. 			} else {
    367. 

  367. 				push @init_db, "--shared";
    368. 

  368. 			}
    369. 

  369. 		}
    370. 

  370. 		command_noisy(@init_db);
    371. 

  371. 		$_repository = Git->repository(Repository => ".git");
    372. 

  372. 	}
    373. 

  373. 	my $set;
    374. 

  374. 	my $pfx = "svn-remote.$Git::SVN::default_repo_id";
    375. 

  375. 	foreach my $i (keys %icv) {
    376. 

  376. 		die "'$set' and '$i' cannot both be set\n" if $set;
    377. 

  377. 		next unless defined $icv{$i};
    378. 

  378. 		command_noisy('config', "$pfx.$i", $icv{$i});
    379. 

  379. 		$set = $i;
    380. 

  380. 	}
    381. 

  381. 	my $ignore_regex = \$SVN::Git::Fetcher::_ignore_regex;
    382. 

  382. 	command_noisy('config', "$pfx.ignore-paths", $$ignore_regex)
    383. 

  383. 		if defined $$ignore_regex;
    384. 

  384. }
    385. 

  385. 

  386. sub init_subdir {
    387. 

  387. 	my $repo_path = shift or return;
    388. 

  388. 	mkpath([$repo_path]) unless -d $repo_path;
    389. 

  389. 	chdir $repo_path or die "Couldn't chdir to $repo_path: $!\n";
    390. 

  390. 	$ENV{GIT_DIR} = '.git';
    391. 

  391. 	$_repository = Git->repository(Repository => $ENV{GIT_DIR});
    392. 

  392. }
    393. 

  393. 

  394. sub cmd_clone {
    395. 

  395. 	my ($url, $path) = @_;
    396. 

  396. 	if (!defined $path &&
    397. 

  397. 	    (defined $_trunk || @_branches || @_tags ||
    398. 

  398. 	     defined $_stdlayout) &&
    399. 

  399. 	    $url !~ m#^[a-z\+]+://#) {
    400. 

  400. 		$path = $url;
    401. 

  401. 	}
    402. 

  402. 	$path = basename($url) if !defined $path || !length $path;
    403. 

  403. 	my $authors_absolute = $_authors ? File::Spec->rel2abs($_authors) : "";
    404. 

  404. 	cmd_init($url, $path);
    405. 

  405. 	command_oneline('config', 'svn.authorsfile', $authors_absolute)
    406. 

  406. 	    if $_authors;
    407. 

  407. 	Git::SVN::fetch_all($Git::SVN::default_repo_id);
    408. 

  408. }
    409. 

  409. 

  410. sub cmd_init {
    411. 

  411. 	if (defined $_stdlayout) {
    412. 

  412. 		$_trunk = 'trunk' if (!defined $_trunk);
    413. 

  413. 		@_tags = 'tags' if (! @_tags);
    414. 

  414. 		@_branches = 'branches' if (! @_branches);
    415. 

  415. 	}
    416. 

  416. 	if (defined $_trunk || @_branches || @_tags) {
    417. 

  417. 		return cmd_multi_init(@_);
    418. 

  418. 	}
    419. 

  419. 	my $url = shift or die "SVN repository location required ",
    420. 

  420. 	                       "as a command-line argument\n";
    421. 

  421. 	$url = canonicalize_url($url);
    422. 

  422. 	init_subdir(@_);
    423. 

  423. 	do_git_init_db();
    424. 

  424. 

  425. 	if ($Git::SVN::_minimize_url eq 'unset') {
    426. 

  426. 		$Git::SVN::_minimize_url = 0;
    427. 

  427. 	}
    428. 

  428. 

  429. 	Git::SVN->init($url);
    430. 

  430. }
    431. 

  431. 

  432. sub cmd_fetch {
    433. 

  433. 	if (grep /^\d+=./, @_) {
    434. 

  434. 		die "'<rev>=<commit>' fetch arguments are ",
    435. 

  435. 		    "no longer supported.\n";
    436. 

  436. 	}
    437. 

  437. 	my ($remote) = @_;
    438. 

  438. 	if (@_ > 1) {
    439. 

  439. 		die "Usage: $0 fetch [--all] [--parent] [svn-remote]\n";
    440. 

  440. 	}
    441. 

  441. 	$Git::SVN::no_reuse_existing = undef;
    442. 

  442. 	if ($_fetch_parent) {
    443. 

  443. 		my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
    444. 

  444. 		unless ($gs) {
    445. 

  445. 			die "Unable to determine upstream SVN information from ",
    446. 

  446. 			    "working tree history\n";
    447. 

  447. 		}
    448. 

  448. 	        # just fetch, don't checkout.
    449. 

  449. 		$_no_checkout = 'true';
    450. 

  450. 		$_fetch_all ? $gs->fetch_all : $gs->fetch;
    451. 

  451. 	} elsif ($_fetch_all) {
    452. 

  452. 		cmd_multi_fetch();
    453. 

  453. 	} else {
    454. 

  454. 		$remote ||= $Git::SVN::default_repo_id;
    455. 

  455. 		Git::SVN::fetch_all($remote, Git::SVN::read_all_remotes());
    456. 

  456. 	}
    457. 

  457. }
    458. 

  458. 

  459. sub cmd_set_tree {
    460. 

  460. 	my (@commits) = @_;
    461. 

  461. 	if ($_stdin || !@commits) {
    462. 

  462. 		print "Reading from stdin...\n";
    463. 

  463. 		@commits = ();
    464. 

  464. 		while (<STDIN>) {
    465. 

  465. 			if (/\b($sha1_short)\b/o) {
    466. 

  466. 				unshift @commits, $1;
    467. 

  467. 			}
    468. 

  468. 		}
    469. 

  469. 	}
    470. 

  470. 	my @revs;
    471. 

  471. 	foreach my $c (@commits) {
    472. 

  472. 		my @tmp = command('rev-parse',$c);
    473. 

  473. 		if (scalar @tmp == 1) {
    474. 

  474. 			push @revs, $tmp[0];
    475. 

  475. 		} elsif (scalar @tmp > 1) {
    476. 

  476. 			push @revs, reverse(command('rev-list',@tmp));
    477. 

  477. 		} else {
    478. 

  478. 			fatal "Failed to rev-parse $c";
    479. 

  479. 		}
    480. 

  480. 	}
    481. 

  481. 	my $gs = Git::SVN->new;
    482. 

  482. 	my ($r_last, $cmt_last) = $gs->last_rev_commit;
    483. 

  483. 	$gs->fetch;
    484. 

  484. 	if (defined $gs->{last_rev} && $r_last != $gs->{last_rev}) {
    485. 

  485. 		fatal "There are new revisions that were fetched ",
    486. 

  486. 		      "and need to be merged (or acknowledged) ",
    487. 

  487. 		      "before committing.\nlast rev: $r_last\n",
    488. 

  488. 		      " current: $gs->{last_rev}";
    489. 

  489. 	}
    490. 

  490. 	$gs->set_tree($_) foreach @revs;
    491. 

  491. 	print "Done committing ",scalar @revs," revisions to SVN\n";
    492. 

  492. 	unlink $gs->{index};
    493. 

  493. }
    494. 

  494. 

  495. sub cmd_dcommit {
    496. 

  496. 	my $head = shift;
    497. 

  497. 	git_cmd_try { command_oneline(qw/diff-index --quiet HEAD/) }
    498. 

  498. 		'Cannot dcommit with a dirty index.  Commit your changes first, '
    499. 

  499. 		. "or stash them with `git stash'.\n";
    500. 

  500. 	$head ||= 'HEAD';
    501. 

  501. 

  502. 	my $old_head;
    503. 

  503. 	if ($head ne 'HEAD') {
    504. 

  504. 		$old_head = eval {
    505. 

  505. 			command_oneline([qw/symbolic-ref -q HEAD/])
    506. 

  506. 		};
    507. 

  507. 		if ($old_head) {
    508. 

  508. 			$old_head =~ s{^refs/heads/}{};
    509. 

  509. 		} else {
    510. 

  510. 			$old_head = eval { command_oneline(qw/rev-parse HEAD/) };
    511. 

  511. 		}
    512. 

  512. 		command(['checkout', $head], STDERR => 0);
    513. 

  513. 	}
    514. 

  514. 

  515. 	my @refs;
    516. 

  516. 	my ($url, $rev, $uuid, $gs) = working_head_info('HEAD', \@refs);
    517. 

  517. 	unless ($gs) {
    518. 

  518. 		die "Unable to determine upstream SVN information from ",
    519. 

  519. 		    "$head history.\nPerhaps the repository is empty.";
    520. 

  520. 	}
    521. 

  521. 

  522. 	if (defined $_commit_url) {
    523. 

  523. 		$url = $_commit_url;
    524. 

  524. 	} else {
    525. 

  525. 		$url = eval { command_oneline('config', '--get',
    526. 

  526. 			      "svn-remote.$gs->{repo_id}.commiturl") };
    527. 

  527. 		if (!$url) {
    528. 

  528. 			$url = $gs->full_url
    529. 

  529. 		}
    530. 

  530. 	}
    531. 

  531. 

  532. 	my $last_rev = $_revision if defined $_revision;
    533. 

  533. 	if ($url) {
    534. 

  534. 		print "Committing to $url ...\n";
    535. 

  535. 	}
    536. 

  536. 	my ($linear_refs, $parents) = linearize_history($gs, \@refs);
    537. 

  537. 	if ($_no_rebase && scalar(@$linear_refs) > 1) {
    538. 

  538. 		warn "Attempting to commit more than one change while ",
    539. 

  539. 		     "--no-rebase is enabled.\n",
    540. 

  540. 		     "If these changes depend on each other, re-running ",
    541. 

  541. 		     "without --no-rebase may be required."
    542. 

  542. 	}
    543. 

  543. 	my $expect_url = $url;
    544. 

  544. 	Git::SVN::remove_username($expect_url);
    545. 

  545. 	while (1) {
    546. 

  546. 		my $d = shift @$linear_refs or last;
    547. 

  547. 		unless (defined $last_rev) {
    548. 

  548. 			(undef, $last_rev, undef) = cmt_metadata("$d~1");
    549. 

  549. 			unless (defined $last_rev) {
    550. 

  550. 				fatal "Unable to extract revision information ",
    551. 

  551. 				      "from commit $d~1";
    552. 

  552. 			}
    553. 

  553. 		}
    554. 

  554. 		if ($_dry_run) {
    555. 

  555. 			print "diff-tree $d~1 $d\n";
    556. 

  556. 		} else {
    557. 

  557. 			my $cmt_rev;
    558. 

  558. 			my %ed_opts = ( r => $last_rev,
    559. 

  559. 			                log => get_commit_entry($d)->{log},
    560. 

  560. 			                ra => Git::SVN::Ra->new($url),
    561. 

  561. 			                config => SVN::Core::config_get_config(
    562. 

  562. 			                        $Git::SVN::Ra::config_dir
    563. 

  563. 			                ),
    564. 

  564. 			                tree_a => "$d~1",
    565. 

  565. 			                tree_b => $d,
    566. 

  566. 			                editor_cb => sub {
    567. 

  567. 			                       print "Committed r$_[0]\n";
    568. 

  568. 			                       $cmt_rev = $_[0];
    569. 

  569. 			                },
    570. 

  570. 			                svn_path => '');
    571. 

  571. 			if (!SVN::Git::Editor->new(\%ed_opts)->apply_diff) {
    572. 

  572. 				print "No changes\n$d~1 == $d\n";
    573. 

  573. 			} elsif ($parents->{$d} && @{$parents->{$d}}) {
    574. 

  574. 				$gs->{inject_parents_dcommit}->{$cmt_rev} =
    575. 

  575. 				                               $parents->{$d};
    576. 

  576. 			}
    577. 

  577. 			$_fetch_all ? $gs->fetch_all : $gs->fetch;
    578. 

  578. 			$last_rev = $cmt_rev;
    579. 

  579. 			next if $_no_rebase;
    580. 

  580. 

  581. 			# we always want to rebase against the current HEAD,
    582. 

  582. 			# not any head that was passed to us
    583. 

  583. 			my @diff = command('diff-tree', $d,
    584. 

  584. 			                   $gs->refname, '--');
    585. 

  585. 			my @finish;
    586. 

  586. 			if (@diff) {
    587. 

  587. 				@finish = rebase_cmd();
    588. 

  588. 				print STDERR "W: $d and ", $gs->refname,
    589. 

  589. 				             " differ, using @finish:\n",
    590. 

  590. 				             join("\n", @diff), "\n";
    591. 

  591. 			} else {
    592. 

  592. 				print "No changes between current HEAD and ",
    593. 

  593. 				      $gs->refname,
    594. 

  594. 				      "\nResetting to the latest ",
    595. 

  595. 				      $gs->refname, "\n";
    596. 

  596. 				@finish = qw/reset --mixed/;
    597. 

  597. 			}
    598. 

  598. 			command_noisy(@finish, $gs->refname);
    599. 

  599. 			if (@diff) {
    600. 

  600. 				@refs = ();
    601. 

  601. 				my ($url_, $rev_, $uuid_, $gs_) =
    602. 

  602. 				              working_head_info('HEAD', \@refs);
    603. 

  603. 				my ($linear_refs_, $parents_) =
    604. 

  604. 				              linearize_history($gs_, \@refs);
    605. 

  605. 				if (scalar(@$linear_refs) !=
    606. 

  606. 				    scalar(@$linear_refs_)) {
    607. 

  607. 					fatal "# of revisions changed ",
    608. 

  608. 					  "\nbefore:\n",
    609. 

  609. 					  join("\n", @$linear_refs),
    610. 

  610. 					  "\n\nafter:\n",
    611. 

  611. 					  join("\n", @$linear_refs_), "\n",
    612. 

  612. 					  'If you are attempting to commit ',
    613. 

  613. 					  "merges, try running:\n\t",
    614. 

  614. 					  'git rebase --interactive',
    615. 

  615. 					  '--preserve-merges ',
    616. 

  616. 					  $gs->refname,
    617. 

  617. 					  "\nBefore dcommitting";
    618. 

  618. 				}
    619. 

  619. 				if ($url_ ne $expect_url) {
    620. 

  620. 					if ($url_ eq $gs->metadata_url) {
    621. 

  621. 						print
    622. 

  622. 						  "Accepting rewritten URL:",
    623. 

  623. 						  " $url_\n";
    624. 

  624. 					} else {
    625. 

  625. 						fatal
    626. 

  626. 						  "URL mismatch after rebase:",
    627. 

  627. 						  " $url_ != $expect_url";
    628. 

  628. 					}
    629. 

  629. 				}
    630. 

  630. 				if ($uuid_ ne $uuid) {
    631. 

  631. 					fatal "uuid mismatch after rebase: ",
    632. 

  632. 					      "$uuid_ != $uuid";
    633. 

  633. 				}
    634. 

  634. 				# remap parents
    635. 

  635. 				my (%p, @l, $i);
    636. 

  636. 				for ($i = 0; $i < scalar @$linear_refs; $i++) {
    637. 

  637. 					my $new = $linear_refs_->[$i] or next;
    638. 

  638. 					$p{$new} =
    639. 

  639. 						$parents->{$linear_refs->[$i]};
    640. 

  640. 					push @l, $new;
    641. 

  641. 				}
    642. 

  642. 				$parents = \%p;
    643. 

  643. 				$linear_refs = \@l;
    644. 

  644. 			}
    645. 

  645. 		}
    646. 

  646. 	}
    647. 

  647. 

  648. 	if ($old_head) {
    649. 

  649. 		my $new_head = command_oneline(qw/rev-parse HEAD/);
    650. 

  650. 		my $new_is_symbolic = eval {
    651. 

  651. 			command_oneline(qw/symbolic-ref -q HEAD/);
    652. 

  652. 		};
    653. 

  653. 		if ($new_is_symbolic) {
    654. 

  654. 			print "dcommitted the branch ", $head, "\n";
    655. 

  655. 		} else {
    656. 

  656. 			print "dcommitted on a detached HEAD because you gave ",
    657. 

  657. 			      "a revision argument.\n",
    658. 

  658. 			      "The rewritten commit is: ", $new_head, "\n";
    659. 

  659. 		}
    660. 

  660. 		command(['checkout', $old_head], STDERR => 0);
    661. 

  661. 	}
    662. 

  662. 

  663. 	unlink $gs->{index};
    664. 

  664. }
    665. 

  665. 

  666. sub cmd_branch {
    667. 

  667. 	my ($branch_name, $head) = @_;
    668. 

  668. 

  669. 	unless (defined $branch_name && length $branch_name) {
    670. 

  670. 		die(($_tag ? "tag" : "branch") . " name required\n");
    671. 

  671. 	}
    672. 

  672. 	$head ||= 'HEAD';
    673. 

  673. 

  674. 	my (undef, $rev, undef, $gs) = working_head_info($head);
    675. 

  675. 	my $src = $gs->full_url;
    676. 

  676. 

  677. 	my $remote = Git::SVN::read_all_remotes()->{$gs->{repo_id}};
    678. 

  678. 	my $allglobs = $remote->{ $_tag ? 'tags' : 'branches' };
    679. 

  679. 	my $glob;
    680. 

  680. 	if ($#{$allglobs} == 0) {
    681. 

  681. 		$glob = $allglobs->[0];
    682. 

  682. 	} else {
    683. 

  683. 		unless(defined $_branch_dest) {
    684. 

  684. 			die "Multiple ",
    685. 

  685. 			    $_tag ? "tag" : "branch",
    686. 

  686. 			    " paths defined for Subversion repository.\n",
    687. 

  687. 		            "You must specify where you want to create the ",
    688. 

  688. 		            $_tag ? "tag" : "branch",
    689. 

  689. 		            " with the --destination argument.\n";
    690. 

  690. 		}
    691. 

  691. 		foreach my $g (@{$allglobs}) {
    692. 

  692. 			# SVN::Git::Editor could probably be moved to Git.pm..
    693. 

  693. 			my $re = SVN::Git::Editor::glob2pat($g->{path}->{left});
    694. 

  694. 			if ($_branch_dest =~ /$re/) {
    695. 

  695. 				$glob = $g;
    696. 

  696. 				last;
    697. 

  697. 			}
    698. 

  698. 		}
    699. 

  699. 		unless (defined $glob) {
    700. 

  700. 			my $dest_re = qr/\b\Q$_branch_dest\E\b/;
    701. 

  701. 			foreach my $g (@{$allglobs}) {
    702. 

  702. 				$g->{path}->{left} =~ /$dest_re/ or next;
    703. 

  703. 				if (defined $glob) {
    704. 

  704. 					die "Ambiguous destination: ",
    705. 

  705. 					    $_branch_dest, "\nmatches both '",
    706. 

  706. 					    $glob->{path}->{left}, "' and '",
    707. 

  707. 					    $g->{path}->{left}, "'\n";
    708. 

  708. 				}
    709. 

  709. 				$glob = $g;
    710. 

  710. 			}
    711. 

  711. 			unless (defined $glob) {
    712. 

  712. 				die "Unknown ",
    713. 

  713. 				    $_tag ? "tag" : "branch",
    714. 

  714. 				    " destination $_branch_dest\n";
    715. 

  715. 			}
    716. 

  716. 		}
    717. 

  717. 	}
    718. 

  718. 	my ($lft, $rgt) = @{ $glob->{path} }{qw/left right/};
    719. 

  719. 	my $url;
    720. 

  720. 	if (defined $_commit_url) {
    721. 

  721. 		$url = $_commit_url;
    722. 

  722. 	} else {
    723. 

  723. 		$url = eval { command_oneline('config', '--get',
    724. 

  724. 			"svn-remote.$gs->{repo_id}.commiturl") };
    725. 

  725. 		if (!$url) {
    726. 

  726. 			$url = $remote->{url};
    727. 

  727. 		}
    728. 

  728. 	}
    729. 

  729. 	my $dst = join '/', $url, $lft, $branch_name, ($rgt || ());
    730. 

  730. 

  731. 	if ($dst =~ /^https:/ && $src =~ /^http:/) {
    732. 

  732. 		$src=~s/^http:/https:/;
    733. 

  733. 	}
    734. 

  734. 

  735. 	::_req_svn();
    736. 

  736. 

  737. 	my $ctx = SVN::Client->new(
    738. 

  738. 		auth    => Git::SVN::Ra::_auth_providers(),
    739. 

  739. 		log_msg => sub {
    740. 

  740. 			${ $_[0] } = defined $_message
    741. 

  741. 				? $_message
    742. 

  742. 				: 'Create ' . ($_tag ? 'tag ' : 'branch ' )
    743. 

  743. 				. $branch_name;
    744. 

  744. 		},
    745. 

  745. 	);
    746. 

  746. 

  747. 	eval {
    748. 

  748. 		$ctx->ls($dst, 'HEAD', 0);
    749. 

  749. 	} and die "branch ${branch_name} already exists\n";
    750. 

  750. 

  751. 	print "Copying ${src} at r${rev} to ${dst}...\n";
    752. 

  752. 	$ctx->copy($src, $rev, $dst)
    753. 

  753. 		unless $_dry_run;
    754. 

  754. 

  755. 	$gs->fetch_all;
    756. 

  756. }
    757. 

  757. 

  758. sub cmd_find_rev {
    759. 

  759. 	my $revision_or_hash = shift or die "SVN or git revision required ",
    760. 

  760. 	                                    "as a command-line argument\n";
    761. 

  761. 	my $result;
    762. 

  762. 	if ($revision_or_hash =~ /^r\d+$/) {
    763. 

  763. 		my $head = shift;
    764. 

  764. 		$head ||= 'HEAD';
    765. 

  765. 		my @refs;
    766. 

  766. 		my (undef, undef, $uuid, $gs) = working_head_info($head, \@refs);
    767. 

  767. 		unless ($gs) {
    768. 

  768. 			die "Unable to determine upstream SVN information from ",
    769. 

  769. 			    "$head history\n";
    770. 

  770. 		}
    771. 

  771. 		my $desired_revision = substr($revision_or_hash, 1);
    772. 

  772. 		$result = $gs->rev_map_get($desired_revision, $uuid);
    773. 

  773. 	} else {
    774. 

  774. 		my (undef, $rev, undef) = cmt_metadata($revision_or_hash);
    775. 

  775. 		$result = $rev;
    776. 

  776. 	}
    777. 

  777. 	print "$result\n" if $result;
    778. 

  778. }
    779. 

  779. 

  780. sub cmd_rebase {
    781. 

  781. 	command_noisy(qw/update-index --refresh/);
    782. 

  782. 	my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
    783. 

  783. 	unless ($gs) {
    784. 

  784. 		die "Unable to determine upstream SVN information from ",
    785. 

  785. 		    "working tree history\n";
    786. 

  786. 	}
    787. 

  787. 	if ($_dry_run) {
    788. 

  788. 		print "Remote Branch: " . $gs->refname . "\n";
    789. 

  789. 		print "SVN URL: " . $url . "\n";
    790. 

  790. 		return;
    791. 

  791. 	}
    792. 

  792. 	if (command(qw/diff-index HEAD --/)) {
    793. 

  793. 		print STDERR "Cannot rebase with uncommited changes:\n";
    794. 

  794. 		command_noisy('status');
    795. 

  795. 		exit 1;
    796. 

  796. 	}
    797. 

  797. 	unless ($_local) {
    798. 

  798. 		# rebase will checkout for us, so no need to do it explicitly
    799. 

  799. 		$_no_checkout = 'true';
    800. 

  800. 		$_fetch_all ? $gs->fetch_all : $gs->fetch;
    801. 

  801. 	}
    802. 

  802. 	command_noisy(rebase_cmd(), $gs->refname);
    803. 

  803. 	$gs->mkemptydirs;
    804. 

  804. }
    805. 

  805. 

  806. sub cmd_show_ignore {
    807. 

  807. 	my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
    808. 

  808. 	$gs ||= Git::SVN->new;
    809. 

  809. 	my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
    810. 

  810. 	$gs->prop_walk($gs->{path}, $r, sub {
    811. 

  811. 		my ($gs, $path, $props) = @_;
    812. 

  812. 		print STDOUT "\n# $path\n";
    813. 

  813. 		my $s = $props->{'svn:ignore'} or return;
    814. 

  814. 		$s =~ s/[\r\n]+/\n/g;
    815. 

  815. 		$s =~ s/^\n+//;
    816. 

  816. 		chomp $s;
    817. 

  817. 		$s =~ s#^#$path#gm;
    818. 

  818. 		print STDOUT "$s\n";
    819. 

  819. 	});
    820. 

  820. }
    821. 

  821. 

  822. sub cmd_show_externals {
    823. 

  823. 	my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
    824. 

  824. 	$gs ||= Git::SVN->new;
    825. 

  825. 	my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
    826. 

  826. 	$gs->prop_walk($gs->{path}, $r, sub {
    827. 

  827. 		my ($gs, $path, $props) = @_;
    828. 

  828. 		print STDOUT "\n# $path\n";
    829. 

  829. 		my $s = $props->{'svn:externals'} or return;
    830. 

  830. 		$s =~ s/[\r\n]+/\n/g;
    831. 

  831. 		chomp $s;
    832. 

  832. 		$s =~ s#^#$path#gm;
    833. 

  833. 		print STDOUT "$s\n";
    834. 

  834. 	});
    835. 

  835. }
    836. 

  836. 

  837. sub cmd_create_ignore {
    838. 

  838. 	my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
    839. 

  839. 	$gs ||= Git::SVN->new;
    840. 

  840. 	my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
    841. 

  841. 	$gs->prop_walk($gs->{path}, $r, sub {
    842. 

  842. 		my ($gs, $path, $props) = @_;
    843. 

  843. 		# $path is of the form /path/to/dir/
    844. 

  844. 		$path = '.' . $path;
    845. 

  845. 		# SVN can have attributes on empty directories,
    846. 

  846. 		# which git won't track
    847. 

  847. 		mkpath([$path]) unless -d $path;
    848. 

  848. 		my $ignore = $path . '.gitignore';
    849. 

  849. 		my $s = $props->{'svn:ignore'} or return;
    850. 

  850. 		open(GITIGNORE, '>', $ignore)
    851. 

  851. 		  or fatal("Failed to open `$ignore' for writing: $!");
    852. 

  852. 		$s =~ s/[\r\n]+/\n/g;
    853. 

  853. 		$s =~ s/^\n+//;
    854. 

  854. 		chomp $s;
    855. 

  855. 		# Prefix all patterns so that the ignore doesn't apply
    856. 

  856. 		# to sub-directories.
    857. 

  857. 		$s =~ s#^#/#gm;
    858. 

  858. 		print GITIGNORE "$s\n";
    859. 

  859. 		close(GITIGNORE)
    860. 

  860. 		  or fatal("Failed to close `$ignore': $!");
    861. 

  861. 		command_noisy('add', '-f', $ignore);
    862. 

  862. 	});
    863. 

  863. }
    864. 

  864. 

  865. sub cmd_mkdirs {
    866. 

  866. 	my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
    867. 

  867. 	$gs ||= Git::SVN->new;
    868. 

  868. 	$gs->mkemptydirs($_revision);
    869. 

  869. }
    870. 

  870. 

  871. sub canonicalize_path {
    872. 

  872. 	my ($path) = @_;
    873. 

  873. 	my $dot_slash_added = 0;
    874. 

  874. 	if (substr($path, 0, 1) ne "/") {
    875. 

  875. 		$path = "./" . $path;
    876. 

  876. 		$dot_slash_added = 1;
    877. 

  877. 	}
    878. 

  878. 	# File::Spec->canonpath doesn't collapse x/../y into y (for a
    879. 

  879. 	# good reason), so let's do this manually.
    880. 

  880. 	$path =~ s#/+#/#g;
    881. 

  881. 	$path =~ s#/\.(?:/|$)#/#g;
    882. 

  882. 	$path =~ s#/[^/]+/\.\.##g;
    883. 

  883. 	$path =~ s#/$##g;
    884. 

  884. 	$path =~ s#^\./## if $dot_slash_added;
    885. 

  885. 	$path =~ s#^/##;
    886. 

  886. 	$path =~ s#^\.$##;
    887. 

  887. 	return $path;
    888. 

  888. }
    889. 

  889. 

  890. sub canonicalize_url {
    891. 

  891. 	my ($url) = @_;
    892. 

  892. 	$url =~ s#^([^:]+://[^/]*/)(.*)$#$1 . canonicalize_path($2)#e;
    893. 

  893. 	return $url;
    894. 

  894. }
    895. 

  895. 

  896. # get_svnprops(PATH)
    897. 

  897. # ------------------
    898. 

  898. # Helper for cmd_propget and cmd_proplist below.
    899. 

  899. sub get_svnprops {
    900. 

  900. 	my $path = shift;
    901. 

  901. 	my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
    902. 

  902. 	$gs ||= Git::SVN->new;
    903. 

  903. 

  904. 	# prefix THE PATH by the sub-directory from which the user
    905. 

  905. 	# invoked us.
    906. 

  906. 	$path = $cmd_dir_prefix . $path;
    907. 

  907. 	fatal("No such file or directory: $path") unless -e $path;
    908. 

  908. 	my $is_dir = -d $path ? 1 : 0;
    909. 

  909. 	$path = $gs->{path} . '/' . $path;
    910. 

  910. 

  911. 	# canonicalize the path (otherwise libsvn will abort or fail to
    912. 

  912. 	# find the file)
    913. 

  913. 	$path = canonicalize_path($path);
    914. 

  914. 

  915. 	my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
    916. 

  916. 	my $props;
    917. 

  917. 	if ($is_dir) {
    918. 

  918. 		(undef, undef, $props) = $gs->ra->get_dir($path, $r);
    919. 

  919. 	}
    920. 

  920. 	else {
    921. 

  921. 		(undef, $props) = $gs->ra->get_file($path, $r, undef);
    922. 

  922. 	}
    923. 

  923. 	return $props;
    924. 

  924. }
    925. 

  925. 

  926. # cmd_propget (PROP, PATH)
    927. 

  927. # ------------------------
    928. 

  928. # Print the SVN property PROP for PATH.
    929. 

  929. sub cmd_propget {
    930. 

  930. 	my ($prop, $path) = @_;
    931. 

  931. 	$path = '.' if not defined $path;
    932. 

  932. 	usage(1) if not defined $prop;
    933. 

  933. 	my $props = get_svnprops($path);
    934. 

  934. 	if (not defined $props->{$prop}) {
    935. 

  935. 		fatal("`$path' does not have a `$prop' SVN property.");
    936. 

  936. 	}
    937. 

  937. 	print $props->{$prop} . "\n";
    938. 

  938. }
    939. 

  939. 

  940. # cmd_proplist (PATH)
    941. 

  941. # -------------------
    942. 

  942. # Print the list of SVN properties for PATH.
    943. 

  943. sub cmd_proplist {
    944. 

  944. 	my $path = shift;
    945. 

  945. 	$path = '.' if not defined $path;
    946. 

  946. 	my $props = get_svnprops($path);
    947. 

  947. 	print "Properties on '$path':\n";
    948. 

  948. 	foreach (sort keys %{$props}) {
    949. 

  949. 		print "  $_\n";
    950. 

  950. 	}
    951. 

  951. }
    952. 

  952. 

  953. sub cmd_multi_init {
    954. 

  954. 	my $url = shift;
    955. 

  955. 	unless (defined $_trunk || @_branches || @_tags) {
    956. 

  956. 		usage(1);
    957. 

  957. 	}
    958. 

  958. 

  959. 	$_prefix = '' unless defined $_prefix;
    960. 

  960. 	if (defined $url) {
    961. 

  961. 		$url = canonicalize_url($url);
    962. 

  962. 		init_subdir(@_);
    963. 

  963. 	}
    964. 

  964. 	do_git_init_db();
    965. 

  965. 	if (defined $_trunk) {
    966. 

  966. 		$_trunk =~ s#^/+##;
    967. 

  967. 		my $trunk_ref = 'refs/remotes/' . $_prefix . 'trunk';
    968. 

  968. 		# try both old-style and new-style lookups:
    969. 

  969. 		my $gs_trunk = eval { Git::SVN->new($trunk_ref) };
    970. 

  970. 		unless ($gs_trunk) {
    971. 

  971. 			my ($trunk_url, $trunk_path) =
    972. 

  972. 			                      complete_svn_url($url, $_trunk);
    973. 

  973. 			$gs_trunk = Git::SVN->init($trunk_url, $trunk_path,
    974. 

  974. 						   undef, $trunk_ref);
    975. 

  975. 		}
    976. 

  976. 	}
    977. 

  977. 	return unless @_branches || @_tags;
    978. 

  978. 	my $ra = $url ? Git::SVN::Ra->new($url) : undef;
    979. 

  979. 	foreach my $path (@_branches) {
    980. 

  980. 		complete_url_ls_init($ra, $path, '--branches/-b', $_prefix);
    981. 

  981. 	}
    982. 

  982. 	foreach my $path (@_tags) {
    983. 

  983. 		complete_url_ls_init($ra, $path, '--tags/-t', $_prefix.'tags/');
    984. 

  984. 	}
    985. 

  985. }
    986. 

  986. 

  987. sub cmd_multi_fetch {
    988. 

  988. 	$Git::SVN::no_reuse_existing = undef;
    989. 

  989. 	my $remotes = Git::SVN::read_all_remotes();
    990. 

  990. 	foreach my $repo_id (sort keys %$remotes) {
    991. 

  991. 		if ($remotes->{$repo_id}->{url}) {
    992. 

  992. 			Git::SVN::fetch_all($repo_id, $remotes);
    993. 

  993. 		}
    994. 

  994. 	}
    995. 

  995. }
    996. 

  996. 

  997. # this command is special because it requires no metadata
    998. 

  998. sub cmd_commit_diff {
    999. 

  999. 	my ($ta, $tb, $url) = @_;
    1000. 

  1000. 	my $usage = "Usage: $0 commit-diff -r<revision> ".
    1001. 

  1001. 	            "<tree-ish> <tree-ish> [<URL>]";
    1002. 

  1002. 	fatal($usage) if (!defined $ta || !defined $tb);
    1003. 

  1003. 	my $svn_path = '';
    1004. 

  1004. 	if (!defined $url) {
    1005. 

  1005. 		my $gs = eval { Git::SVN->new };
    1006. 

  1006. 		if (!$gs) {
    1007. 

  1007. 			fatal("Needed URL or usable git-svn --id in ",
    1008. 

  1008. 			      "the command-line\n", $usage);
    1009. 

  1009. 		}
    1010. 

  1010. 		$url = $gs->{url};
    1011. 

  1011. 		$svn_path = $gs->{path};
    1012. 

  1012. 	}
    1013. 

  1013. 	unless (defined $_revision) {
    1014. 

  1014. 		fatal("-r|--revision is a required argument\n", $usage);
    1015. 

  1015. 	}
    1016. 

  1016. 	if (defined $_message && defined $_file) {
    1017. 

  1017. 		fatal("Both --message/-m and --file/-F specified ",
    1018. 

  1018. 		      "for the commit message.\n",
    1019. 

  1019. 		      "I have no idea what you mean");
    1020. 

  1020. 	}
    1021. 

  1021. 	if (defined $_file) {
    1022. 

  1022. 		$_message = file_to_s($_file);
    1023. 

  1023. 	} else {
    1024. 

  1024. 		$_message ||= get_commit_entry($tb)->{log};
    1025. 

  1025. 	}
    1026. 

  1026. 	my $ra ||= Git::SVN::Ra->new($url);
    1027. 

  1027. 	my $r = $_revision;
    1028. 

  1028. 	if ($r eq 'HEAD') {
    1029. 

  1029. 		$r = $ra->get_latest_revnum;
    1030. 

  1030. 	} elsif ($r !~ /^\d+$/) {
    1031. 

  1031. 		die "revision argument: $r not understood by git-svn\n";
    1032. 

  1032. 	}
    1033. 

  1033. 	my %ed_opts = ( r => $r,
    1034. 

  1034. 	                log => $_message,
    1035. 

  1035. 	                ra => $ra,
    1036. 

  1036. 	                tree_a => $ta,
    1037. 

  1037. 	                tree_b => $tb,
    1038. 

  1038. 	                editor_cb => sub { print "Committed r$_[0]\n" },
    1039. 

  1039. 	                svn_path => $svn_path );
    1040. 

  1040. 	if (!SVN::Git::Editor->new(\%ed_opts)->apply_diff) {
    1041. 

  1041. 		print "No changes\n$ta == $tb\n";
    1042. 

  1042. 	}
    1043. 

  1043. }
    1044. 

  1044. 

  1045. sub escape_uri_only {
    1046. 

  1046. 	my ($uri) = @_;
    1047. 

  1047. 	my @tmp;
    1048. 

  1048. 	foreach (split m{/}, $uri) {
    1049. 

  1049. 		s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
    1050. 

  1050. 		push @tmp, $_;
    1051. 

  1051. 	}
    1052. 

  1052. 	join('/', @tmp);
    1053. 

  1053. }
    1054. 

  1054. 

  1055. sub escape_url {
    1056. 

  1056. 	my ($url) = @_;
    1057. 

  1057. 	if ($url =~ m#^([^:]+)://([^/]*)(.*)$#) {
    1058. 

  1058. 		my ($scheme, $domain, $uri) = ($1, $2, escape_uri_only($3));
    1059. 

  1059. 		$url = "$scheme://$domain$uri";
    1060. 

  1060. 	}
    1061. 

  1061. 	$url;
    1062. 

  1062. }
    1063. 

  1063. 

  1064. sub cmd_info {
    1065. 

  1065. 	my $path = canonicalize_path(defined($_[0]) ? $_[0] : ".");
    1066. 

  1066. 	my $fullpath = canonicalize_path($cmd_dir_prefix . $path);
    1067. 

  1067. 	if (exists $_[1]) {
    1068. 

  1068. 		die "Too many arguments specified\n";
    1069. 

  1069. 	}
    1070. 

  1070. 

  1071. 	my ($file_type, $diff_status) = find_file_type_and_diff_status($path);
    1072. 

  1072. 

  1073. 	if (!$file_type && !$diff_status) {
    1074. 

  1074. 		print STDERR "svn: '$path' is not under version control\n";
    1075. 

  1075. 		exit 1;
    1076. 

  1076. 	}
    1077. 

  1077. 

  1078. 	my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
    1079. 

  1079. 	unless ($gs) {
    1080. 

  1080. 		die "Unable to determine upstream SVN information from ",
    1081. 

  1081. 		    "working tree history\n";
    1082. 

  1082. 	}
    1083. 

  1083. 

  1084. 	# canonicalize_path() will return "" to make libsvn 1.5.x happy,
    1085. 

  1085. 	$path = "." if $path eq "";
    1086. 

  1086. 

  1087. 	my $full_url = $url . ($fullpath eq "" ? "" : "/$fullpath");
    1088. 

  1088. 

  1089. 	if ($_url) {
    1090. 

  1090. 		print escape_url($full_url), "\n";
    1091. 

  1091. 		return;
    1092. 

  1092. 	}
    1093. 

  1093. 

  1094. 	my $result = "Path: $path\n";
    1095. 

  1095. 	$result .= "Name: " . basename($path) . "\n" if $file_type ne "dir";
    1096. 

  1096. 	$result .= "URL: " . escape_url($full_url) . "\n";
    1097. 

  1097. 

  1098. 	eval {
    1099. 

  1099. 		my $repos_root = $gs->repos_root;
    1100. 

  1100. 		Git::SVN::remove_username($repos_root);
    1101. 

  1101. 		$result .= "Repository Root: " . escape_url($repos_root) . "\n";
    1102. 

  1102. 	};
    1103. 

  1103. 	if ($@) {
    1104. 

  1104. 		$result .= "Repository Root: (offline)\n";
    1105. 

  1105. 	}
    1106. 

  1106. 	::_req_svn();
    1107. 

  1107. 	$result .= "Repository UUID: $uuid\n" unless $diff_status eq "A" &&
    1108. 

  1108. 		($SVN::Core::VERSION le '1.5.4' || $file_type ne "dir");
    1109. 

  1109. 	$result .= "Revision: " . ($diff_status eq "A" ? 0 : $rev) . "\n";
    1110. 

  1110. 

  1111. 	$result .= "Node Kind: " .
    1112. 

  1112. 		   ($file_type eq "dir" ? "directory" : "file") . "\n";
    1113. 

  1113. 

  1114. 	my $schedule = $diff_status eq "A"
    1115. 

  1115. 		       ? "add"
    1116. 

  1116. 		       : ($diff_status eq "D" ? "delete" : "normal");
    1117. 

  1117. 	$result .= "Schedule: $schedule\n";
    1118. 

  1118. 

  1119. 	if ($diff_status eq "A") {
    1120. 

  1120. 		print $result, "\n";
    1121. 

  1121. 		return;
    1122. 

  1122. 	}
    1123. 

  1123. 

  1124. 	my ($lc_author, $lc_rev, $lc_date_utc);
    1125. 

  1125. 	my @args = Git::SVN::Log::git_svn_log_cmd($rev, $rev, "--", $fullpath);
    1126. 

  1126. 	my $log = command_output_pipe(@args);
    1127. 

  1127. 	my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/;
    1128. 

  1128. 	while (<$log>) {
    1129. 

  1129. 		if (/^${esc_color}author (.+) <[^>]+> (\d+) ([\-\+]?\d+)$/o) {
    1130. 

  1130. 			$lc_author = $1;
    1131. 

  1131. 			$lc_date_utc = Git::SVN::Log::parse_git_date($2, $3);
    1132. 

  1132. 		} elsif (/^${esc_color}    (git-svn-id:.+)$/o) {
    1133. 

  1133. 			(undef, $lc_rev, undef) = ::extract_metadata($1);
    1134. 

  1134. 		}
    1135. 

  1135. 	}
    1136. 

  1136. 	close $log;
    1137. 

  1137. 

  1138. 	Git::SVN::Log::set_local_timezone();
    1139. 

  1139. 

  1140. 	$result .= "Last Changed Author: $lc_author\n";
    1141. 

  1141. 	$result .= "Last Changed Rev: $lc_rev\n";
    1142. 

  1142. 	$result .= "Last Changed Date: " .
    1143. 

  1143. 		   Git::SVN::Log::format_svn_date($lc_date_utc) . "\n";
    1144. 

  1144. 

  1145. 	if ($file_type ne "dir") {
    1146. 

  1146. 		my $text_last_updated_date =
    1147. 

  1147. 		    ($diff_status eq "D" ? $lc_date_utc : (stat $path)[9]);
    1148. 

  1148. 		$result .=
    1149. 

  1149. 		    "Text Last Updated: " .
    1150. 

  1150. 		    Git::SVN::Log::format_svn_date($text_last_updated_date) .
    1151. 

  1151. 		    "\n";
    1152. 

  1152. 		my $checksum;
    1153. 

  1153. 		if ($diff_status eq "D") {
    1154. 

  1154. 			my ($fh, $ctx) =
    1155. 

  1155. 			    command_output_pipe(qw(cat-file blob), "HEAD:$path");
    1156. 

  1156. 			if ($file_type eq "link") {
    1157. 

  1157. 				my $file_name = <$fh>;
    1158. 

  1158. 				$checksum = md5sum("link $file_name");
    1159. 

  1159. 			} else {
    1160. 

  1160. 				$checksum = md5sum($fh);
    1161. 

  1161. 			}
    1162. 

  1162. 			command_close_pipe($fh, $ctx);
    1163. 

  1163. 		} elsif ($file_type eq "link") {
    1164. 

  1164. 			my $file_name =
    1165. 

  1165. 			    command(qw(cat-file blob), "HEAD:$path");
    1166. 

  1166. 			$checksum =
    1167. 

  1167. 			    md5sum("link " . $file_name);
    1168. 

  1168. 		} else {
    1169. 

  1169. 			open FILE, "<", $path or die $!;
    1170. 

  1170. 			$checksum = md5sum(\*FILE);
    1171. 

  1171. 			close FILE or die $!;
    1172. 

  1172. 		}
    1173. 

  1173. 		$result .= "Checksum: " . $checksum . "\n";
    1174. 

  1174. 	}
    1175. 

  1175. 

  1176. 	print $result, "\n";
    1177. 

  1177. }
    1178. 

  1178. 

  1179. sub cmd_reset {
    1180. 

  1180. 	my $target = shift || $_revision or die "SVN revision required\n";
    1181. 

  1181. 	$target = $1 if $target =~ /^r(\d+)$/;
    1182. 

  1182. 	$target =~ /^\d+$/ or die "Numeric SVN revision expected\n";
    1183. 

  1183. 	my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
    1184. 

  1184. 	unless ($gs) {
    1185. 

  1185. 		die "Unable to determine upstream SVN information from ".
    1186. 

  1186. 		    "history\n";
    1187. 

  1187. 	}
    1188. 

  1188. 	my ($r, $c) = $gs->find_rev_before($target, not $_fetch_parent);
    1189. 

  1189. 	die "Cannot find SVN revision $target\n" unless defined($c);
    1190. 

  1190. 	$gs->rev_map_set($r, $c, 'reset', $uuid);
    1191. 

  1191. 	print "r$r = $c ($gs->{ref_id})\n";
    1192. 

  1192. }
    1193. 

  1193. 

  1194. sub cmd_gc {
    1195. 

  1195. 	if (!$can_compress) {
    1196. 

  1196. 		warn "Compress::Zlib could not be found; unhandled.log " .
    1197. 

  1197. 		     "files will not be compressed.\n";
    1198. 

  1198. 	}
    1199. 

  1199. 	find({ wanted => \&gc_directory, no_chdir => 1}, "$ENV{GIT_DIR}/svn");
    1200. 

  1200. }
    1201. 

  1201. 

  1202. ########################### utility functions #########################
    1203. 

  1203. 

  1204. sub rebase_cmd {
    1205. 

  1205. 	my @cmd = qw/rebase/;
    1206. 

  1206. 	push @cmd, '-v' if $_verbose;
    1207. 

  1207. 	push @cmd, qw/--merge/ if $_merge;
    1208. 

  1208. 	push @cmd, "--strategy=$_strategy" if $_strategy;
    1209. 

  1209. 	@cmd;
    1210. 

  1210. }
    1211. 

  1211. 

  1212. sub post_fetch_checkout {
    1213. 

  1213. 	return if $_no_checkout;
    1214. 

  1214. 	my $gs = $Git::SVN::_head or return;
    1215. 

  1215. 	return if verify_ref('refs/heads/master^0');
    1216. 

  1216. 

  1217. 	# look for "trunk" ref if it exists
    1218. 

  1218. 	my $remote = Git::SVN::read_all_remotes()->{$gs->{repo_id}};
    1219. 

  1219. 	my $fetch = $remote->{fetch};
    1220. 

  1220. 	if ($fetch) {
    1221. 

  1221. 		foreach my $p (keys %$fetch) {
    1222. 

  1222. 			basename($fetch->{$p}) eq 'trunk' or next;
    1223. 

  1223. 			$gs = Git::SVN->new($fetch->{$p}, $gs->{repo_id}, $p);
    1224. 

  1224. 			last;
    1225. 

  1225. 		}
    1226. 

  1226. 	}
    1227. 

  1227. 

  1228. 	my $valid_head = verify_ref('HEAD^0');
    1229. 

  1229. 	command_noisy(qw(update-ref refs/heads/master), $gs->refname);
    1230. 

  1230. 	return if ($valid_head || !verify_ref('HEAD^0'));
    1231. 

  1231. 

  1232. 	return if $ENV{GIT_DIR} !~ m#^(?:.*/)?\.git$#;
    1233. 

  1233. 	my $index = $ENV{GIT_INDEX_FILE} || "$ENV{GIT_DIR}/index";
    1234. 

  1234. 	return if -f $index;
    1235. 

  1235. 

  1236. 	return if command_oneline(qw/rev-parse --is-inside-work-tree/) eq 'false';
    1237. 

  1237. 	return if command_oneline(qw/rev-parse --is-inside-git-dir/) eq 'true';
    1238. 

  1238. 	command_noisy(qw/read-tree -m -u -v HEAD HEAD/);
    1239. 

  1239. 	print STDERR "Checked out HEAD:\n  ",
    1240. 

  1240. 	             $gs->full_url, " r", $gs->last_rev, "\n";
    1241. 

  1241. 	$gs->mkemptydirs($gs->last_rev);
    1242. 

  1242. }
    1243. 

  1243. 

  1244. sub complete_svn_url {
    1245. 

  1245. 	my ($url, $path) = @_;
    1246. 

  1246. 	$path =~ s#/+$##;
    1247. 

  1247. 	if ($path !~ m#^[a-z\+]+://#) {
    1248. 

  1248. 		if (!defined $url || $url !~ m#^[a-z\+]+://#) {
    1249. 

  1249. 			fatal("E: '$path' is not a complete URL ",
    1250. 

  1250. 			      "and a separate URL is not specified");
    1251. 

  1251. 		}
    1252. 

  1252. 		return ($url, $path);
    1253. 

  1253. 	}
    1254. 

  1254. 	return ($path, '');
    1255. 

  1255. }
    1256. 

  1256. 

  1257. sub complete_url_ls_init {
    1258. 

  1258. 	my ($ra, $repo_path, $switch, $pfx) = @_;
    1259. 

  1259. 	unless ($repo_path) {
    1260. 

  1260. 		print STDERR "W: $switch not specified\n";
    1261. 

  1261. 		return;
    1262. 

  1262. 	}
    1263. 

  1263. 	$repo_path =~ s#/+$##;
    1264. 

  1264. 	if ($repo_path =~ m#^[a-z\+]+://#) {
    1265. 

  1265. 		$ra = Git::SVN::Ra->new($repo_path);
    1266. 

  1266. 		$repo_path = '';
    1267. 

  1267. 	} else {
    1268. 

  1268. 		$repo_path =~ s#^/+##;
    1269. 

  1269. 		unless ($ra) {
    1270. 

  1270. 			fatal("E: '$repo_path' is not a complete URL ",
    1271. 

  1271. 			      "and a separate URL is not specified");
    1272. 

  1272. 		}
    1273. 

  1273. 	}
    1274. 

  1274. 	my $url = $ra->{url};
    1275. 

  1275. 	my $gs = Git::SVN->init($url, undef, undef, undef, 1);
    1276. 

  1276. 	my $k = "svn-remote.$gs->{repo_id}.url";
    1277. 

  1277. 	my $orig_url = eval { command_oneline(qw/config --get/, $k) };
    1278. 

  1278. 	if ($orig_url && ($orig_url ne $gs->{url})) {
    1279. 

  1279. 		die "$k already set: $orig_url\n",
    1280. 

  1280. 		    "wanted to set to: $gs->{url}\n";
    1281. 

  1281. 	}
    1282. 

  1282. 	command_oneline('config', $k, $gs->{url}) unless $orig_url;
    1283. 

  1283. 	my $remote_path = "$gs->{path}/$repo_path";
    1284. 

  1284. 	$remote_path =~ s{%([0-9A-F]{2})}{chr hex($1)}ieg;
    1285. 

  1285. 	$remote_path =~ s#/+#/#g;
    1286. 

  1286. 	$remote_path =~ s#^/##g;
    1287. 

  1287. 	$remote_path .= "/*" if $remote_path !~ /\*/;
    1288. 

  1288. 	my ($n) = ($switch =~ /^--(\w+)/);
    1289. 

  1289. 	if (length $pfx && $pfx !~ m#/$#) {
    1290. 

  1290. 		die "--prefix='$pfx' must have a trailing slash '/'\n";
    1291. 

  1291. 	}
    1292. 

  1292. 	command_noisy('config',
    1293. 

  1293. 		      '--add',
    1294. 

  1294. 	              "svn-remote.$gs->{repo_id}.$n",
    1295. 

  1295. 	              "$remote_path:refs/remotes/$pfx*" .
    1296. 

  1296. 	                ('/*' x (($remote_path =~ tr/*/*/) - 1)) );
    1297. 

  1297. }
    1298. 

  1298. 

  1299. sub verify_ref {
    1300. 

  1300. 	my ($ref) = @_;
    1301. 

  1301. 	eval { command_oneline([ 'rev-parse', '--verify', $ref ],
    1302. 

  1302. 	                       { STDERR => 0 }); };
    1303. 

  1303. }
    1304. 

  1304. 

  1305. sub get_tree_from_treeish {
    1306. 

  1306. 	my ($treeish) = @_;
    1307. 

  1307. 	# $treeish can be a symbolic ref, too:
    1308. 

  1308. 	my $type = command_oneline(qw/cat-file -t/, $treeish);
    1309. 

  1309. 	my $expected;
    1310. 

  1310. 	while ($type eq 'tag') {
    1311. 

  1311. 		($treeish, $type) = command(qw/cat-file tag/, $treeish);
    1312. 

  1312. 	}
    1313. 

  1313. 	if ($type eq 'commit') {
    1314. 

  1314. 		$expected = (grep /^tree /, command(qw/cat-file commit/,
    1315. 

  1315. 		                                    $treeish))[0];
    1316. 

  1316. 		($expected) = ($expected =~ /^tree ($sha1)$/o);
    1317. 

  1317. 		die "Unable to get tree from $treeish\n" unless $expected;
    1318. 

  1318. 	} elsif ($type eq 'tree') {
    1319. 

  1319. 		$expected = $treeish;
    1320. 

  1320. 	} else {
    1321. 

  1321. 		die "$treeish is a $type, expected tree, tag or commit\n";
    1322. 

  1322. 	}
    1323. 

  1323. 	return $expected;
    1324. 

  1324. }
    1325. 

  1325. 

  1326. sub get_commit_entry {
    1327. 

  1327. 	my ($treeish) = shift;
    1328. 

  1328. 	my %log_entry = ( log => '', tree => get_tree_from_treeish($treeish) );
    1329. 

  1329. 	my $commit_editmsg = "$ENV{GIT_DIR}/COMMIT_EDITMSG";
    1330. 

  1330. 	my $commit_msg = "$ENV{GIT_DIR}/COMMIT_MSG";
    1331. 

  1331. 	open my $log_fh, '>', $commit_editmsg or croak $!;
    1332. 

  1332. 

  1333. 	my $type = command_oneline(qw/cat-file -t/, $treeish);
    1334. 

  1334. 	if ($type eq 'commit' || $type eq 'tag') {
    1335. 

  1335. 		my ($msg_fh, $ctx) = command_output_pipe('cat-file',
    1336. 

  1336. 		                                         $type, $treeish);
    1337. 

  1337. 		my $in_msg = 0;
    1338. 

  1338. 		my $author;
    1339. 

  1339. 		my $saw_from = 0;
    1340. 

  1340. 		my $msgbuf = "";
    1341. 

  1341. 		while (<$msg_fh>) {
    1342. 

  1342. 			if (!$in_msg) {
    1343. 

  1343. 				$in_msg = 1 if (/^\s*$/);
    1344. 

  1344. 				$author = $1 if (/^author (.*>)/);
    1345. 

  1345. 			} elsif (/^git-svn-id: /) {
    1346. 

  1346. 				# skip this for now, we regenerate the
    1347. 

  1347. 				# correct one on re-fetch anyways
    1348. 

  1348. 				# TODO: set *:merge properties or like...
    1349. 

  1349. 			} else {
    1350. 

  1350. 				if (/^From:/ || /^Signed-off-by:/) {
    1351. 

  1351. 					$saw_from = 1;
    1352. 

  1352. 				}
    1353. 

  1353. 				$msgbuf .= $_;
    1354. 

  1354. 			}
    1355. 

  1355. 		}
    1356. 

  1356. 		$msgbuf =~ s/\s+$//s;
    1357. 

  1357. 		if ($Git::SVN::_add_author_from && defined($author)
    1358. 

  1358. 		    && !$saw_from) {
    1359. 

  1359. 			$msgbuf .= "\n\nFrom: $author";
    1360. 

  1360. 		}
    1361. 

  1361. 		print $log_fh $msgbuf or croak $!;
    1362. 

  1362. 		command_close_pipe($msg_fh, $ctx);
    1363. 

  1363. 	}
    1364. 

  1364. 	close $log_fh or croak $!;
    1365. 

  1365. 

  1366. 	if ($_edit || ($type eq 'tree')) {
    1367. 

  1367. 		chomp(my $editor = command_oneline(qw(var GIT_EDITOR)));
    1368. 

  1368. 		system('sh', '-c', $editor.' "$@"', $editor, $commit_editmsg);
    1369. 

  1369. 	}
    1370. 

  1370. 	rename $commit_editmsg, $commit_msg or croak $!;
    1371. 

  1371. 	{
    1372. 

  1372. 		require Encode;
    1373. 

  1373. 		# SVN requires messages to be UTF-8 when entering the repo
    1374. 

  1374. 		local $/;
    1375. 

  1375. 		open $log_fh, '<', $commit_msg or croak $!;
    1376. 

  1376. 		binmode $log_fh;
    1377. 

  1377. 		chomp($log_entry{log} = <$log_fh>);
    1378. 

  1378. 

  1379. 		my $enc = Git::config('i18n.commitencoding') || 'UTF-8';
    1380. 

  1380. 		my $msg = $log_entry{log};
    1381. 

  1381. 

  1382. 		eval { $msg = Encode::decode($enc, $msg, 1) };
    1383. 

  1383. 		if ($@) {
    1384. 

  1384. 			die "Could not decode as $enc:\n", $msg,
    1385. 

  1385. 			    "\nPerhaps you need to set i18n.commitencoding\n";
    1386. 

  1386. 		}
    1387. 

  1387. 

  1388. 		eval { $msg = Encode::encode('UTF-8', $msg, 1) };
    1389. 

  1389. 		die "Could not encode as UTF-8:\n$msg\n" if $@;
    1390. 

  1390. 

  1391. 		$log_entry{log} = $msg;
    1392. 

  1392. 

  1393. 		close $log_fh or croak $!;
    1394. 

  1394. 	}
    1395. 

  1395. 	unlink $commit_msg;
    1396. 

  1396. 	\%log_entry;
    1397. 

  1397. }
    1398. 

  1398. 

  1399. sub s_to_file {
    1400. 

  1400. 	my ($str, $file, $mode) = @_;
    1401. 

  1401. 	open my $fd,'>',$file or croak $!;
    1402. 

  1402. 	print $fd $str,"\n" or croak $!;
    1403. 

  1403. 	close $fd or croak $!;
    1404. 

  1404. 	chmod ($mode &~ umask, $file) if (defined $mode);
    1405. 

  1405. }
    1406. 

  1406. 

  1407. sub file_to_s {
    1408. 

  1408. 	my $file = shift;
    1409. 

  1409. 	open my $fd,'<',$file or croak "$!: file: $file\n";
    1410. 

  1410. 	local $/;
    1411. 

  1411. 	my $ret = <$fd>;
    1412. 

  1412. 	close $fd or croak $!;
    1413. 

  1413. 	$ret =~ s/\s*$//s;
    1414. 

  1414. 	return $ret;
    1415. 

  1415. }
    1416. 

  1416. 

  1417. # '<svn username> = real-name <email address>' mapping based on git-svnimport:
    1418. 

  1418. sub load_authors {
    1419. 

  1419. 	open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
    1420. 

  1420. 	my $log = $cmd eq 'log';
    1421. 

  1421. 	while (<$authors>) {
    1422. 

  1422. 		chomp;
    1423. 

  1423. 		next unless /^(.+?|\(no author\))\s*=\s*(.+?)\s*<(.+)>\s*$/;
    1424. 

  1424. 		my ($user, $name, $email) = ($1, $2, $3);
    1425. 

  1425. 		if ($log) {
    1426. 

  1426. 			$Git::SVN::Log::rusers{"$name <$email>"} = $user;
    1427. 

  1427. 		} else {
    1428. 

  1428. 			$users{$user} = [$name, $email];
    1429. 

  1429. 		}
    1430. 

  1430. 	}
    1431. 

  1431. 	close $authors or croak $!;
    1432. 

  1432. }
    1433. 

  1433. 

  1434. # convert GetOpt::Long specs for use by git-config
    1435. 

  1435. sub read_git_config {
    1436. 

  1436. 	my $opts = shift;
    1437. 

  1437. 	my @config_only;
    1438. 

  1438. 	foreach my $o (keys %$opts) {
    1439. 

  1439. 		# if we have mixedCase and a long option-only, then
    1440. 

  1440. 		# it's a config-only variable that we don't need for
    1441. 

  1441. 		# the command-line.
    1442. 

  1442. 		push @config_only, $o if ($o =~ /[A-Z]/ && $o =~ /^[a-z]+$/i);
    1443. 

  1443. 		my $v = $opts->{$o};
    1444. 

  1444. 		my ($key) = ($o =~ /^([a-zA-Z\-]+)/);
    1445. 

  1445. 		$key =~ s/-//g;
    1446. 

  1446. 		my $arg = 'git config';
    1447. 

  1447. 		$arg .= ' --int' if ($o =~ /[:=]i$/);
    1448. 

  1448. 		$arg .= ' --bool' if ($o !~ /[:=][sfi]$/);
    1449. 

  1449. 		if (ref $v eq 'ARRAY') {
    1450. 

  1450. 			chomp(my @tmp = `$arg --get-all svn.$key`);
    1451. 

  1451. 			@$v = @tmp if @tmp;
    1452. 

  1452. 		} else {
    1453. 

  1453. 			chomp(my $tmp = `$arg --get svn.$key`);
    1454. 

  1454. 			if ($tmp && !($arg =~ / --bool/ && $tmp eq 'false')) {
    1455. 

  1455. 				$$v = $tmp;
    1456. 

  1456. 			}
    1457. 

  1457. 		}
    1458. 

  1458. 	}
    1459. 

  1459. 	delete @$opts{@config_only} if @config_only;
    1460. 

  1460. }
    1461. 

  1461. 

  1462. sub extract_metadata {
    1463. 

  1463. 	my $id = shift or return (undef, undef, undef);
    1464. 

  1464. 	my ($url, $rev, $uuid) = ($id =~ /^\s*git-svn-id:\s+(.*)\@(\d+)
    1465. 

  1465. 							\s([a-f\d\-]+)$/ix);
    1466. 

  1466. 	if (!defined $rev || !$uuid || !$url) {
    1467. 

  1467. 		# some of the original repositories I made had
    1468. 

  1468. 		# identifiers like this:
    1469. 

  1469. 		($rev, $uuid) = ($id =~/^\s*git-svn-id:\s(\d+)\@([a-f\d\-]+)/i);
    1470. 

  1470. 	}
    1471. 

  1471. 	return ($url, $rev, $uuid);
    1472. 

  1472. }
    1473. 

  1473. 

  1474. sub cmt_metadata {
    1475. 

  1475. 	return extract_metadata((grep(/^git-svn-id: /,
    1476. 

  1476. 		command(qw/cat-file commit/, shift)))[-1]);
    1477. 

  1477. }
    1478. 

  1478. 

  1479. sub cmt_sha2rev_batch {
    1480. 

  1480. 	my %s2r;
    1481. 

  1481. 	my ($pid, $in, $out, $ctx) = command_bidi_pipe(qw/cat-file --batch/);
    1482. 

  1482. 	my $list = shift;
    1483. 

  1483. 

  1484. 	foreach my $sha (@{$list}) {
    1485. 

  1485. 		my $first = 1;
    1486. 

  1486. 		my $size = 0;
    1487. 

  1487. 		print $out $sha, "\n";
    1488. 

  1488. 

  1489. 		while (my $line = <$in>) {
    1490. 

  1490. 			if ($first && $line =~ /^[[:xdigit:]]{40}\smissing$/) {
    1491. 

  1491. 				last;
    1492. 

  1492. 			} elsif ($first &&
    1493. 

  1493. 			       $line =~ /^[[:xdigit:]]{40}\scommit\s(\d+)$/) {
    1494. 

  1494. 				$first = 0;
    1495. 

  1495. 				$size = $1;
    1496. 

  1496. 				next;
    1497. 

  1497. 			} elsif ($line =~ /^(git-svn-id: )/) {
    1498. 

  1498. 				my (undef, $rev, undef) =
    1499. 

  1499. 				                      extract_metadata($line);
    1500. 

  1500. 				$s2r{$sha} = $rev;
    1501. 

  1501. 			}
    1502. 

  1502. 

  1503. 			$size -= length($line);
    1504. 

  1504. 			last if ($size == 0);
    1505. 

  1505. 		}
    1506. 

  1506. 	}
    1507. 

  1507. 

  1508. 	command_close_bidi_pipe($pid, $in, $out, $ctx);
    1509. 

  1509. 

  1510. 	return \%s2r;
    1511. 

  1511. }
    1512. 

  1512. 

  1513. sub working_head_info {
    1514. 

  1514. 	my ($head, $refs) = @_;
    1515. 

  1515. 	my @args = ('log', '--no-color', '--first-parent', '--pretty=medium');
    1516. 

  1516. 	my ($fh, $ctx) = command_output_pipe(@args, $head);
    1517. 

  1517. 	my $hash;
    1518. 

  1518. 	my %max;
    1519. 

  1519. 	while (<$fh>) {
    1520. 

  1520. 		if ( m{^commit ($::sha1)$} ) {
    1521. 

  1521. 			unshift @$refs, $hash if $hash and $refs;
    1522. 

  1522. 			$hash = $1;
    1523. 

  1523. 			next;
    1524. 

  1524. 		}
    1525. 

  1525. 		next unless s{^\s*(git-svn-id:)}{$1};
    1526. 

  1526. 		my ($url, $rev, $uuid) = extract_metadata($_);
    1527. 

  1527. 		if (defined $url && defined $rev) {
    1528. 

  1528. 			next if $max{$url} and $max{$url} < $rev;
    1529. 

  1529. 			if (my $gs = Git::SVN->find_by_url($url)) {
    1530. 

  1530. 				my $c = $gs->rev_map_get($rev, $uuid);
    1531. 

  1531. 				if ($c && $c eq $hash) {
    1532. 

  1532. 					close $fh; # break the pipe
    1533. 

  1533. 					return ($url, $rev, $uuid, $gs);
    1534. 

  1534. 				} else {
    1535. 

  1535. 					$max{$url} ||= $gs->rev_map_max;
    1536. 

  1536. 				}
    1537. 

  1537. 			}
    1538. 

  1538. 		}
    1539. 

  1539. 	}
    1540. 

  1540. 	command_close_pipe($fh, $ctx);
    1541. 

  1541. 	(undef, undef, undef, undef);
    1542. 

  1542. }
    1543. 

  1543. 

  1544. sub read_commit_parents {
    1545. 

  1545. 	my ($parents, $c) = @_;
    1546. 

  1546. 	chomp(my $p = command_oneline(qw/rev-list --parents -1/, $c));
    1547. 

  1547. 	$p =~ s/^($c)\s*// or die "rev-list --parents -1 $c failed!\n";
    1548. 

  1548. 	@{$parents->{$c}} = split(/ /, $p);
    1549. 

  1549. }
    1550. 

  1550. 

  1551. sub linearize_history {
    1552. 

  1552. 	my ($gs, $refs) = @_;
    1553. 

  1553. 	my %parents;
    1554. 

  1554. 	foreach my $c (@$refs) {
    1555. 

  1555. 		read_commit_parents(\%parents, $c);
    1556. 

  1556. 	}
    1557. 

  1557. 

  1558. 	my @linear_refs;
    1559. 

  1559. 	my %skip = ();
    1560. 

  1560. 	my $last_svn_commit = $gs->last_commit;
    1561. 

  1561. 	foreach my $c (reverse @$refs) {
    1562. 

  1562. 		next if $c eq $last_svn_commit;
    1563. 

  1563. 		last if $skip{$c};
    1564. 

  1564. 

  1565. 		unshift @linear_refs, $c;
    1566. 

  1566. 		$skip{$c} = 1;
    1567. 

  1567. 

  1568. 		# we only want the first parent to diff against for linear
    1569. 

  1569. 		# history, we save the rest to inject when we finalize the
    1570. 

  1570. 		# svn commit
    1571. 

  1571. 		my $fp_a = verify_ref("$c~1");
    1572. 

  1572. 		my $fp_b = shift @{$parents{$c}} if $parents{$c};
    1573. 

  1573. 		if (!$fp_a || !$fp_b) {
    1574. 

  1574. 			die "Commit $c\n",
    1575. 

  1575. 			    "has no parent commit, and therefore ",
    1576. 

  1576. 			    "nothing to diff against.\n",
    1577. 

  1577. 			    "You should be working from a repository ",
    1578. 

  1578. 			    "originally created by git-svn\n";
    1579. 

  1579. 		}
    1580. 

  1580. 		if ($fp_a ne $fp_b) {
    1581. 

  1581. 			die "$c~1 = $fp_a, however parsing commit $c ",
    1582. 

  1582. 			    "revealed that:\n$c~1 = $fp_b\nBUG!\n";
    1583. 

  1583. 		}
    1584. 

  1584. 

  1585. 		foreach my $p (@{$parents{$c}}) {
    1586. 

  1586. 			$skip{$p} = 1;
    1587. 

  1587. 		}
    1588. 

  1588. 	}
    1589. 

  1589. 	(\@linear_refs, \%parents);
    1590. 

  1590. }
    1591. 

  1591. 

  1592. sub find_file_type_and_diff_status {
    1593. 

  1593. 	my ($path) = @_;
    1594. 

  1594. 	return ('dir', '') if $path eq '';
    1595. 

  1595. 

  1596. 	my $diff_output =
    1597. 

  1597. 	    command_oneline(qw(diff --cached --name-status --), $path) || "";
    1598. 

  1598. 	my $diff_status = (split(' ', $diff_output))[0] || "";
    1599. 

  1599. 

  1600. 	my $ls_tree = command_oneline(qw(ls-tree HEAD), $path) || "";
    1601. 

  1601. 

  1602. 	return (undef, undef) if !$diff_status && !$ls_tree;
    1603. 

  1603. 

  1604. 	if ($diff_status eq "A") {
    1605. 

  1605. 		return ("link", $diff_status) if -l $path;
    1606. 

  1606. 		return ("dir", $diff_status) if -d $path;
    1607. 

  1607. 		return ("file", $diff_status);
    1608. 

  1608. 	}
    1609. 

  1609. 

  1610. 	my $mode = (split(' ', $ls_tree))[0] || "";
    1611. 

  1611. 

  1612. 	return ("link", $diff_status) if $mode eq "120000";
    1613. 

  1613. 	return ("dir", $diff_status) if $mode eq "040000";
    1614. 

  1614. 	return ("file", $diff_status);
    1615. 

  1615. }
    1616. 

  1616. 

  1617. sub md5sum {
    1618. 

  1618. 	my $arg = shift;
    1619. 

  1619. 	my $ref = ref $arg;
    1620. 

  1620. 	my $md5 = Digest::MD5->new();
    1621. 

  1621.         if ($ref eq 'GLOB' || $ref eq 'IO::File' || $ref eq 'File::Temp') {
    1622. 

  1622. 		$md5->addfile($arg) or croak $!;
    1623. 

  1623. 	} elsif ($ref eq 'SCALAR') {
    1624. 

  1624. 		$md5->add($$arg) or croak $!;
    1625. 

  1625. 	} elsif (!$ref) {
    1626. 

  1626. 		$md5->add($arg) or croak $!;
    1627. 

  1627. 	} else {
    1628. 

  1628. 		::fatal "Can't provide MD5 hash for unknown ref type: '", $ref, "'";
    1629. 

  1629. 	}
    1630. 

  1630. 	return $md5->hexdigest();
    1631. 

  1631. }
    1632. 

  1632. 

  1633. sub gc_directory {
    1634. 

  1634. 	if ($can_compress && -f $_ && basename($_) eq "unhandled.log") {
    1635. 

  1635. 		my $out_filename = $_ . ".gz";
    1636. 

  1636. 		open my $in_fh, "<", $_ or die "Unable to open $_: $!\n";
    1637. 

  1637. 		binmode $in_fh;
    1638. 

  1638. 		my $gz = Compress::Zlib::gzopen($out_filename, "ab") or
    1639. 

  1639. 				die "Unable to open $out_filename: $!\n";
    1640. 

  1640. 

  1641. 		my $res;
    1642. 

  1642. 		while ($res = sysread($in_fh, my $str, 1024)) {
    1643. 

  1643. 			$gz->gzwrite($str) or
    1644. 

  1644. 				die "Unable to write: ".$gz->gzerror()."!\n";
    1645. 

  1645. 		}
    1646. 

  1646. 		unlink $_ or die "unlink $File::Find::name: $!\n";
    1647. 

  1647. 	} elsif (-f $_ && basename($_) eq "index") {
    1648. 

  1648. 		unlink $_ or die "unlink $_: $!\n";
    1649. 

  1649. 	}
    1650. 

  1650. }
    1651. 

  1651. 

  1652. package Git::SVN;
    1653. 

  1653. use strict;
    1654. 

  1654. use warnings;
    1655. 

  1655. use Fcntl qw/:DEFAULT :seek/;
    1656. 

  1656. use constant rev_map_fmt => 'NH40';
    1657. 

  1657. use vars qw/$default_repo_id $default_ref_id $_no_metadata $_follow_parent
    1658. 

  1658.             $_repack $_repack_flags $_use_svm_props $_head
    1659. 

  1659.             $_use_svnsync_props $no_reuse_existing $_minimize_url
    1660. 

  1660. 	    $_use_log_author $_add_author_from $_localtime/;
    1661. 

  1661. use Carp qw/croak/;
    1662. 

  1662. use File::Path qw/mkpath/;
    1663. 

  1663. use File::Copy qw/copy/;
    1664. 

  1664. use IPC::Open3;
    1665. 

  1665. use Memoize;  # core since 5.8.0, Jul 2002
    1666. 

  1666. use Memoize::Storable;
    1667. 

  1667. 

  1668. my ($_gc_nr, $_gc_period);
    1669. 

  1669. 

  1670. # properties that we do not log:
    1671. 

  1671. my %SKIP_PROP;
    1672. 

  1672. BEGIN {
    1673. 

  1673. 	%SKIP_PROP = map { $_ => 1 } qw/svn:wc:ra_dav:version-url
    1674. 

  1674. 	                                svn:special svn:executable
    1675. 

  1675. 	                                svn:entry:committed-rev
    1676. 

  1676. 	                                svn:entry:last-author
    1677. 

  1677. 	                                svn:entry:uuid
    1678. 

  1678. 	                                svn:entry:committed-date/;
    1679. 

  1679. 

  1680. 	# some options are read globally, but can be overridden locally
    1681. 

  1681. 	# per [svn-remote "..."] section.  Command-line options will *NOT*
    1682. 

  1682. 	# override options set in an [svn-remote "..."] section
    1683. 

  1683. 	no strict 'refs';
    1684. 

  1684. 	for my $option (qw/follow_parent no_metadata use_svm_props
    1685. 

  1685. 			   use_svnsync_props/) {
    1686. 

  1686. 		my $key = $option;
    1687. 

  1687. 		$key =~ tr/_//d;
    1688. 

  1688. 		my $prop = "-$option";
    1689. 

  1689. 		*$option = sub {
    1690. 

  1690. 			my ($self) = @_;
    1691. 

  1691. 			return $self->{$prop} if exists $self->{$prop};
    1692. 

  1692. 			my $k = "svn-remote.$self->{repo_id}.$key";
    1693. 

  1693. 			eval { command_oneline(qw/config --get/, $k) };
    1694. 

  1694. 			if ($@) {
    1695. 

  1695. 				$self->{$prop} = ${"Git::SVN::_$option"};
    1696. 

  1696. 			} else {
    1697. 

  1697. 				my $v = command_oneline(qw/config --bool/,$k);
    1698. 

  1698. 				$self->{$prop} = $v eq 'false' ? 0 : 1;
    1699. 

  1699. 			}
    1700. 

  1700. 			return $self->{$prop};
    1701. 

  1701. 		}
    1702. 

  1702. 	}
    1703. 

  1703. }
    1704. 

  1704. 

  1705. 

  1706. my (%LOCKFILES, %INDEX_FILES);
    1707. 

  1707. END {
    1708. 

  1708. 	unlink keys %LOCKFILES if %LOCKFILES;
    1709. 

  1709. 	unlink keys %INDEX_FILES if %INDEX_FILES;
    1710. 

  1710. }
    1711. 

  1711. 

  1712. sub resolve_local_globs {
    1713. 

  1713. 	my ($url, $fetch, $glob_spec) = @_;
    1714. 

  1714. 	return unless defined $glob_spec;
    1715. 

  1715. 	my $ref = $glob_spec->{ref};
    1716. 

  1716. 	my $path = $glob_spec->{path};
    1717. 

  1717. 	foreach (command(qw#for-each-ref --format=%(refname) refs/#)) {
    1718. 

  1718. 		next unless m#^$ref->{regex}$#;
    1719. 

  1719. 		my $p = $1;
    1720. 

  1720. 		my $pathname = desanitize_refname($path->full_path($p));
    1721. 

  1721. 		my $refname = desanitize_refname($ref->full_path($p));
    1722. 

  1722. 		if (my $existing = $fetch->{$pathname}) {
    1723. 

  1723. 			if ($existing ne $refname) {
    1724. 

  1724. 				die "Refspec conflict:\n",
    1725. 

  1725. 				    "existing: $existing\n",
    1726. 

  1726. 				    " globbed: $refname\n";
    1727. 

  1727. 			}
    1728. 

  1728. 			my $u = (::cmt_metadata("$refname"))[0];
    1729. 

  1729. 			$u =~ s!^\Q$url\E(/|$)!! or die
    1730. 

  1730. 			  "$refname: '$url' not found in '$u'\n";
    1731. 

  1731. 			if ($pathname ne $u) {
    1732. 

  1732. 				warn "W: Refspec glob conflict ",
    1733. 

  1733. 				     "(ref: $refname):\n",
    1734. 

  1734. 				     "expected path: $pathname\n",
    1735. 

  1735. 				     "    real path: $u\n",
    1736. 

  1736. 				     "Continuing ahead with $u\n";
    1737. 

  1737. 				next;
    1738. 

  1738. 			}
    1739. 

  1739. 		} else {
    1740. 

  1740. 			$fetch->{$pathname} = $refname;
    1741. 

  1741. 		}
    1742. 

  1742. 	}
    1743. 

  1743. }
    1744. 

  1744. 

  1745. sub parse_revision_argument {
    1746. 

  1746. 	my ($base, $head) = @_;
    1747. 

  1747. 	if (!defined $::_revision || $::_revision eq 'BASE:HEAD') {
    1748. 

  1748. 		return ($base, $head);
    1749. 

  1749. 	}
    1750. 

  1750. 	return ($1, $2) if ($::_revision =~ /^(\d+):(\d+)$/);
    1751. 

  1751. 	return ($::_revision, $::_revision) if ($::_revision =~ /^\d+$/);
    1752. 

  1752. 	return ($head, $head) if ($::_revision eq 'HEAD');
    1753. 

  1753. 	return ($base, $1) if ($::_revision =~ /^BASE:(\d+)$/);
    1754. 

  1754. 	return ($1, $head) if ($::_revision =~ /^(\d+):HEAD$/);
    1755. 

  1755. 	die "revision argument: $::_revision not understood by git-svn\n";
    1756. 

  1756. }
    1757. 

  1757. 

  1758. sub fetch_all {
    1759. 

  1759. 	my ($repo_id, $remotes) = @_;
    1760. 

  1760. 	if (ref $repo_id) {
    1761. 

  1761. 		my $gs = $repo_id;
    1762. 

  1762. 		$repo_id = undef;
    1763. 

  1763. 		$repo_id = $gs->{repo_id};
    1764. 

  1764. 	}
    1765. 

  1765. 	$remotes ||= read_all_remotes();
    1766. 

  1766. 	my $remote = $remotes->{$repo_id} or
    1767. 

  1767. 	             die "[svn-remote \"$repo_id\"] unknown\n";
    1768. 

  1768. 	my $fetch = $remote->{fetch};
    1769. 

  1769. 	my $url = $remote->{url} or die "svn-remote.$repo_id.url not defined\n";
    1770. 

  1770. 	my (@gs, @globs);
    1771. 

  1771. 	my $ra = Git::SVN::Ra->new($url);
    1772. 

  1772. 	my $uuid = $ra->get_uuid;
    1773. 

  1773. 	my $head = $ra->get_latest_revnum;
    1774. 

  1774. 

  1775. 	# ignore errors, $head revision may not even exist anymore
    1776. 

  1776. 	eval { $ra->get_log("", $head, 0, 1, 0, 1, sub { $head = $_[1] }) };
    1777. 

  1777. 	warn "W: $@\n" if $@;
    1778. 

  1778. 

  1779. 	my $base = defined $fetch ? $head : 0;
    1780. 

  1780. 

  1781. 	# read the max revs for wildcard expansion (branches/*, tags/*)
    1782. 

  1782. 	foreach my $t (qw/branches tags/) {
    1783. 

  1783. 		defined $remote->{$t} or next;
    1784. 

  1784. 		push @globs, @{$remote->{$t}};
    1785. 

    1786. 

  1786. 		my $max_rev = eval { tmp_config(qw/--int --get/,
    1787. 

  1787. 		                         "svn-remote.$repo_id.${t}-maxRev") };
    1788. 

  1788. 		if (defined $max_rev && ($max_rev < $base)) {
    1789. 

  1789. 			$base = $max_rev;
    1790. 

  1790. 		} elsif (!defined $max_rev) {
    1791. 

  1791. 			$base = 0;
    1792. 

  1792. 		}
    1793. 

  1793. 	}
    1794. 

    1795. 

  1795. 	if ($fetch) {
    1796. 

  1796. 		foreach my $p (sort keys %$fetch) {
    1797. 

  1797. 			my $gs = Git::SVN->new($fetch->{$p}, $repo_id, $p);
    1798. 

  1798. 			my $lr = $gs->rev_map_max;
    1799. 

  1799. 			if (defined $lr) {
    1800. 

  1800. 				$base = $lr if ($lr < $base);
    1801. 

  1801. 			}
    1802. 

  1802. 			push @gs, $gs;
    1803. 

  1803. 		}
    1804. 

  1804. 	}
    1805. 

    1806. 

  1806. 	($base, $head) = parse_revision_argument($base, $head);
    1807. 

  1807. 	$ra->gs_fetch_loop_common($base, $head, \@gs, \@globs);
    1808. 

  1808. }
    1809. 

    1810. 

  1810. sub read_all_remotes {
    1811. 

  1811. 	my $r = {};
    1812. 

  1812. 	my $use_svm_props = eval { command_oneline(qw/config --bool
    1813. 

  1813. 	    svn.useSvmProps/) };
    1814. 

  1814. 	$use_svm_props = $use_svm_props eq 'true' if $use_svm_props;
    1815. 

  1815. 	my $svn_refspec = qr{\s*(.*?)\s*:\s*(.+?)\s*};
    1816. 

  1816. 	foreach (grep { s/^svn-remote\.// } command(qw/config -l/)) {
    1817. 

  1817. 		if (m!^(.+)\.fetch=$svn_refspec$!) {
    1818. 

  1818. 			my ($remote, $local_ref, $remote_ref) = ($1, $2, $3);
    1819. 

  1819. 			die("svn-remote.$remote: remote ref '$remote_ref' "
    1820. 

  1820. 			    . "must start with 'refs/'\n")
    1821. 

  1821. 				unless $remote_ref =~ m{^refs/};
    1822. 

  1822. 			$r->{$remote}->{fetch}->{$local_ref} = $remote_ref;
    1823. 

  1823. 			$r->{$remote}->{svm} = {} if $use_svm_props;
    1824. 

  1824. 		} elsif (m!^(.+)\.usesvmprops=\s*(.*)\s*$!) {
    1825. 

  1825. 			$r->{$1}->{svm} = {};
    1826. 

  1826. 		} elsif (m!^(.+)\.url=\s*(.*)\s*$!) {
    1827. 

  1827. 			$r->{$1}->{url} = $2;
    1828. 

  1828. 		} elsif (m!^(.+)\.(branches|tags)=$svn_refspec$!) {
    1829. 

  1829. 			my ($remote, $t, $local_ref, $remote_ref) =
    1830. 

  1830. 			                                     ($1, $2, $3, $4);
    1831. 

  1831. 			die("svn-remote.$remote: remote ref '$remote_ref' ($t) "
    1832. 

  1832. 			    . "must start with 'refs/'\n")
    1833. 

  1833. 				unless $remote_ref =~ m{^refs/};
    1834. 

  1834. 			my $rs = {
    1835. 

  1835. 			    t => $t,
    1836. 

  1836. 			    remote => $remote,
    1837. 

  1837. 			    path => Git::SVN::GlobSpec->new($local_ref, 1),
    1838. 

  1838. 			    ref => Git::SVN::GlobSpec->new($remote_ref, 0) };
    1839. 

  1839. 			if (length($rs->{ref}->{right}) != 0) {
    1840. 

  1840. 				die "The '*' glob character must be the last ",
    1841. 

  1841. 				    "character of '$remote_ref'\n";
    1842. 

  1842. 			}
    1843. 

  1843. 			push @{ $r->{$remote}->{$t} }, $rs;
    1844. 

  1844. 		}
    1845. 

  1845. 	}
    1846. 

    1847. 

  1847. 	map {
    1848. 

  1848. 		if (defined $r->{$_}->{svm}) {
    1849. 

  1849. 			my $svm;
    1850. 

  1850. 			eval {
    1851. 

  1851. 				my $section = "svn-remote.$_";
    1852. 

  1852. 				$svm = {
    1853. 

  1853. 					source => tmp_config('--get',
    1854. 

  1854. 					    "$section.svm-source"),
    1855. 

  1855. 					replace => tmp_config('--get',
    1856. 

  1856. 					    "$section.svm-replace"),
    1857. 

  1857. 				}
    1858. 

  1858. 			};
    1859. 

  1859. 			$r->{$_}->{svm} = $svm;
    1860. 

  1860. 		}
    1861. 

  1861. 	} keys %$r;
    1862. 

    1863. 

  1863. 	$r;
    1864. 

  1864. }
    1865. 

    1866. 

  1866. sub init_vars {
    1867. 

  1867. 	$_gc_nr = $_gc_period = 1000;
    1868. 

  1868. 	if (defined $_repack || defined $_repack_flags) {
    1869. 

  1869. 	       warn "Repack options are obsolete; they have no effect.\n";
    1870. 

  1870. 	}
    1871. 

  1871. }
    1872. 

    1873. 

  1873. sub verify_remotes_sanity {
    1874. 

  1874. 	return unless -d $ENV{GIT_DIR};
    1875. 

  1875. 	my %seen;
    1876. 

  1876. 	foreach (command(qw/config -l/)) {
    1877. 

  1877. 		if (m!^svn-remote\.(?:.+)\.fetch=.*:refs/remotes/(\S+)\s*$!) {
    1878. 

  1878. 			if ($seen{$1}) {
    1879. 

  1879. 				die "Remote ref refs/remote/$1 is tracked by",
    1880. 

  1880. 				    "\n  \"$_\"\nand\n  \"$seen{$1}\"\n",
    1881. 

  1881. 				    "Please resolve this ambiguity in ",
    1882. 

  1882. 				    "your git configuration file before ",
    1883. 

  1883. 				    "continuing\n";
    1884. 

  1884. 			}
    1885. 

  1885. 			$seen{$1} = $_;
    1886. 

  1886. 		}
    1887. 

  1887. 	}
    1888. 

  1888. }
    1889. 

    1890. 

  1890. sub find_existing_remote {
    1891. 

  1891. 	my ($url, $remotes) = @_;
    1892. 

  1892. 	return undef if $no_reuse_existing;
    1893. 

  1893. 	my $existing;
    1894. 

  1894. 	foreach my $repo_id (keys %$remotes) {
    1895. 

  1895. 		my $u = $remotes->{$repo_id}->{url} or next;
    1896. 

  1896. 		next if $u ne $url;
    1897. 

  1897. 		$existing = $repo_id;
    1898. 

  1898. 		last;
    1899. 

  1899. 	}
    1900. 

  1900. 	$existing;
    1901. 

  1901. }
    1902. 

    1903. 

  1903. sub init_remote_config {
    1904. 

  1904. 	my ($self, $url, $no_write) = @_;
    1905. 

  1905. 	$url =~ s!/+$!!; # strip trailing slash
    1906. 

  1906. 	my $r = read_all_remotes();
    1907. 

  1907. 	my $existing = find_existing_remote($url, $r);
    1908. 

  1908. 	if ($existing) {
    1909. 

  1909. 		unless ($no_write) {
    1910. 

  1910. 			print STDERR "Using existing ",
    1911. 

  1911. 				     "[svn-remote \"$existing\"]\n";
    1912. 

  1912. 		}
    1913. 

  1913. 		$self->{repo_id} = $existing;
    1914. 

  1914. 	} elsif ($_minimize_url) {
    1915. 

  1915. 		my $min_url = Git::SVN::Ra->new($url)->minimize_url;
    1916. 

  1916. 		$existing = find_existing_remote($min_url, $r);
    1917. 

  1917. 		if ($existing) {
    1918. 

  1918. 			unless ($no_write) {
    1919. 

  1919. 				print STDERR "Using existing ",
    1920. 

  1920. 					     "[svn-remote \"$existing\"]\n";
    1921. 

  1921. 			}
    1922. 

  1922. 			$self->{repo_id} = $existing;
    1923. 

  1923. 		}
    1924. 

  1924. 		if ($min_url ne $url) {
    1925. 

  1925. 			unless ($no_write) {
    1926. 

  1926. 				print STDERR "Using higher level of URL: ",
    1927. 

  1927. 					     "$url => $min_url\n";
    1928. 

  1928. 			}
    1929. 

  1929. 			my $old_path = $self->{path};
    1930. 

  1930. 			$self->{path} = $url;
    1931. 

  1931. 			$self->{path} =~ s!^\Q$min_url\E(/|$)!!;
    1932. 

  1932. 			if (length $old_path) {
    1933. 

  1933. 				$self->{path} .= "/$old_path";
    1934. 

  1934. 			}
    1935. 

  1935. 			$url = $min_url;
    1936. 

  1936. 		}
    1937. 

  1937. 	}
    1938. 

  1938. 	my $orig_url;
    1939. 

  1939. 	if (!$existing) {
    1940. 

  1940. 		# verify that we aren't overwriting anything:
    1941. 

  1941. 		$orig_url = eval {
    1942. 

  1942. 			command_oneline('config', '--get',
    1943. 

  1943. 					"svn-remote.$self->{repo_id}.url")
    1944. 

  1944. 		};
    1945. 

  1945. 		if ($orig_url && ($orig_url ne $url)) {
    1946. 

  1946. 			die "svn-remote.$self->{repo_id}.url already set: ",
    1947. 

  1947. 			    "$orig_url\nwanted to set to: $url\n";
    1948. 

  1948. 		}
    1949. 

  1949. 	}
    1950. 

  1950. 	my ($xrepo_id, $xpath) = find_ref($self->refname);
    1951. 

  1951. 	if (!$no_write && defined $xpath) {
    1952. 

  1952. 		die "svn-remote.$xrepo_id.fetch already set to track ",
    1953. 

  1953. 		    "$xpath:", $self->refname, "\n";
    1954. 

  1954. 	}
    1955. 

  1955. 	unless ($no_write) {
    1956. 

  1956. 		command_noisy('config',
    1957. 

  1957. 			      "svn-remote.$self->{repo_id}.url", $url);
    1958. 

  1958. 		$self->{path} =~ s{^/}{};
    1959. 

  1959. 		$self->{path} =~ s{%([0-9A-F]{2})}{chr hex($1)}ieg;
    1960. 

  1960. 		command_noisy('config', '--add',
    1961. 

  1961. 			      "svn-remote.$self->{repo_id}.fetch",
    1962. 

  1962. 			      "$self->{path}:".$self->refname);
    1963. 

  1963. 	}
    1964. 

  1964. 	$self->{url} = $url;
    1965. 

  1965. }
    1966. 

    1967. 

  1967. sub find_by_url { # repos_root and, path are optional
    1968. 

  1968. 	my ($class, $full_url, $repos_root, $path) = @_;
    1969. 

    1970. 

  1970. 	return undef unless defined $full_url;
    1971. 

  1971. 	remove_username($full_url);
    1972. 

  1972. 	remove_username($repos_root) if defined $repos_root;
    1973. 

  1973. 	my $remotes = read_all_remotes();
    1974. 

  1974. 	if (defined $full_url && defined $repos_root && !defined $path) {
    1975. 

  1975. 		$path = $full_url;
    1976. 

  1976. 		$path =~ s#^\Q$repos_root\E(?:/|$)##;
    1977. 

  1977. 	}
    1978. 

  1978. 	foreach my $repo_id (keys %$remotes) {
    1979. 

  1979. 		my $u = $remotes->{$repo_id}->{url} or next;
    1980. 

  1980. 		remove_username($u);
    1981. 

  1981. 		next if defined $repos_root && $repos_root ne $u;
    1982. 

    1983. 

  1983. 		my $fetch = $remotes->{$repo_id}->{fetch} || {};
    1984. 

  1984. 		foreach my $t (qw/branches tags/) {
    1985. 

  1985. 			foreach my $globspec (@{$remotes->{$repo_id}->{$t}}) {
    1986. 

  1986. 				resolve_local_globs($u, $fetch, $globspec);
    1987. 

  1987. 			}
    1988. 

  1988. 		}
    1989. 

  1989. 		my $p = $path;
    1990. 

  1990. 		my $rwr = rewrite_root({repo_id => $repo_id});
    1991. 

  1991. 		my $svm = $remotes->{$repo_id}->{svm}
    1992. 

  1992. 			if defined $remotes->{$repo_id}->{svm};
    1993. 

  1993. 		unless (defined $p) {
    1994. 

  1994. 			$p = $full_url;
    1995. 

  1995. 			my $z = $u;
    1996. 

  1996. 			my $prefix = '';
    1997. 

  1997. 			if ($rwr) {
    1998. 

  1998. 				$z = $rwr;
    1999. 

  1999. 				remove_username($z);
    2000. 

  2000. 			} elsif (defined $svm) {
    2001. 

  2001. 				$z = $svm->{source};
    2002. 

  2002. 				$prefix = $svm->{replace};
    2003. 

  2003. 				$prefix =~ s#^\Q$u\E(?:/|$)##;
    2004. 

  2004. 				$prefix =~ s#/$##;
    2005. 

  2005. 			}
    2006. 

  2006. 			$p =~ s#^\Q$z\E(?:/|$)#$prefix# or next;
    2007. 

  2007. 		}
    2008. 

  2008. 		foreach my $f (keys %$fetch) {
    2009. 

  2009. 			next if $f ne $p;
    2010. 

  2010. 			return Git::SVN->new($fetch->{$f}, $repo_id, $f);
    2011. 

  2011. 		}
    2012. 

  2012. 	}
    2013. 

  2013. 	undef;
    2014. 

  2014. }
    2015. 

    2016. 

  2016. sub init {
    2017. 

  2017. 	my ($class, $url, $path, $repo_id, $ref_id, $no_write) = @_;
    2018. 

  2018. 	my $self = _new($class, $repo_id, $ref_id, $path);
    2019. 

  2019. 	if (defined $url) {
    2020. 

  2020. 		$self->init_remote_config($url, $no_write);
    2021. 

  2021. 	}
    2022. 

  2022. 	$self;
    2023. 

  2023. }
    2024. 

    2025. 

  2025. sub find_ref {
    2026. 

  2026. 	my ($ref_id) = @_;
    2027. 

  2027. 	foreach (command(qw/config -l/)) {
    2028. 

  2028. 		next unless m!^svn-remote\.(.+)\.fetch=
    2029. 

  2029. 		              \s*(.*?)\s*:\s*(.+?)\s*$!x;
    2030. 

  2030. 		my ($repo_id, $path, $ref) = ($1, $2, $3);
    2031. 

  2031. 		if ($ref eq $ref_id) {
    2032. 

  2032. 			$path = '' if ($path =~ m#^\./?#);
    2033. 

  2033. 			return ($repo_id, $path);
    2034. 

  2034. 		}
    2035. 

  2035. 	}
    2036. 

  2036. 	(undef, undef, undef);
    2037. 

  2037. }
    2038. 

    2039. 

  2039. sub new {
    2040. 

  2040. 	my ($class, $ref_id, $repo_id, $path) = @_;
    2041. 

  2041. 	if (defined $ref_id && !defined $repo_id && !defined $path) {
    2042. 

  2042. 		($repo_id, $path) = find_ref($ref_id);
    2043. 

  2043. 		if (!defined $repo_id) {
    2044. 

  2044. 			die "Could not find a \"svn-remote.*.fetch\" key ",
    2045. 

  2045. 			    "in the repository configuration matching: ",
    2046. 

  2046. 			    "$ref_id\n";
    2047. 

  2047. 		}
    2048. 

  2048. 	}
    2049. 

  2049. 	my $self = _new($class, $repo_id, $ref_id, $path);
    2050. 

  2050. 	if (!defined $self->{path} || !length $self->{path}) {
    2051. 

  2051. 		my $fetch = command_oneline('config', '--get',
    2052. 

  2052. 		                            "svn-remote.$repo_id.fetch",
    2053. 

  2053. 		                            ":$ref_id\$") or
    2054. 

  2054. 		     die "Failed to read \"svn-remote.$repo_id.fetch\" ",
    2055. 

  2055. 		         "\":$ref_id\$\" in config\n";
    2056. 

  2056. 		($self->{path}, undef) = split(/\s*:\s*/, $fetch);
    2057. 

  2057. 	}
    2058. 

  2058. 	$self->{path} =~ s{/+}{/}g;
    2059. 

  2059. 	$self->{path} =~ s{\A/}{};
    2060. 

  2060. 	$self->{path} =~ s{/\z}{};
    2061. 

  2061. 	$self->{url} = command_oneline('config', '--get',
    2062. 

  2062. 	                               "svn-remote.$repo_id.url") or
    2063. 

  2063.                   die "Failed to read \"svn-remote.$repo_id.url\" in config\n";
    2064. 

  2064. 	$self->rebuild;
    2065. 

  2065. 	$self;
    2066. 

  2066. }
    2067. 

  2067. 

  2068. sub refname {
    2069. 

  2069. 	my ($refname) = $_[0]->{ref_id} ;
    2070. 

  2070. 

  2071. 	# It cannot end with a slash /, we'll throw up on this because
    2072. 

  2072. 	# SVN can't have directories with a slash in their name, either:
    2073. 

  2073. 	if ($refname =~ m{/$}) {
    2074. 

  2074. 		die "ref: '$refname' ends with a trailing slash, this is ",
    2075. 

  2075. 		    "not permitted by git nor Subversion\n";
    2076. 

  2076. 	}
    2077. 

  2077. 

  2078. 	# It cannot have ASCII control character space, tilde ~, caret ^,
    2079. 

  2079. 	# colon :, question-mark ?, asterisk *, space, or open bracket [
    2080. 

  2080. 	# anywhere.
    2081. 

  2081. 	#
    2082. 

  2082. 	# Additionally, % must be escaped because it is used for escaping
    2083. 

  2083. 	# and we want our escaped refname to be reversible
    2084. 

  2084. 	$refname =~ s{([ \%~\^:\?\*\[\t])}{uc sprintf('%%%02x',ord($1))}eg;
    2085. 

  2085. 

  2086. 	# no slash-separated component can begin with a dot .
    2087. 

  2087. 	# /.* becomes /%2E*
    2088. 

  2088. 	$refname =~ s{/\.}{/%2E}g;
    2089. 

  2089. 

  2090. 	# It cannot have two consecutive dots .. anywhere
    2091. 

  2091. 	# .. becomes %2E%2E
    2092. 

  2092. 	$refname =~ s{\.\.}{%2E%2E}g;
    2093. 

  2093. 

  2094. 	# trailing dots and .lock are not allowed
    2095. 

  2095. 	# .$ becomes %2E and .lock becomes %2Elock
    2096. 

  2096. 	$refname =~ s{\.(?=$|lock$)}{%2E};
    2097. 

  2097. 

  2098. 	# the sequence @{ is used to access the reflog
    2099. 

  2099. 	# @{ becomes %40{
    2100. 

  2100. 	$refname =~ s{\@\{}{%40\{}g;
    2101. 

  2101. 

  2102. 	return $refname;
    2103. 

  2103. }
    2104. 

  2104. 

  2105. sub desanitize_refname {
    2106. 

  2106. 	my ($refname) = @_;
    2107. 

  2107. 	$refname =~ s{%(?:([0-9A-F]{2}))}{chr hex($1)}eg;
    2108. 

  2108. 	return $refname;
    2109. 

  2109. }
    2110. 

  2110. 

  2111. sub svm_uuid {
    2112. 

  2112. 	my ($self) = @_;
    2113. 

  2113. 	return $self->{svm}->{uuid} if $self->svm;
    2114. 

  2114. 	$self->ra;
    2115. 

  2115. 	unless ($self->{svm}) {
    2116. 

  2116. 		die "SVM UUID not cached, and reading remotely failed\n";
    2117. 

  2117. 	}
    2118. 

  2118. 	$self->{svm}->{uuid};
    2119. 

  2119. }
    2120. 

  2120. 

  2121. sub svm {
    2122. 

  2122. 	my ($self) = @_;
    2123. 

  2123. 	return $self->{svm} if $self->{svm};
    2124. 

  2124. 	my $svm;
    2125. 

  2125. 	# see if we have it in our config, first:
    2126. 

  2126. 	eval {
    2127. 

  2127. 		my $section = "svn-remote.$self->{repo_id}";
    2128. 

  2128. 		$svm = {
    2129. 

  2129. 		  source => tmp_config('--get', "$section.svm-source"),
    2130. 

  2130. 		  uuid => tmp_config('--get', "$section.svm-uuid"),
    2131. 

  2131. 		  replace => tmp_config('--get', "$section.svm-replace"),
    2132. 

  2132. 		}
    2133. 

  2133. 	};
    2134. 

  2134. 	if ($svm && $svm->{source} && $svm->{uuid} && $svm->{replace}) {
    2135. 

  2135. 		$self->{svm} = $svm;
    2136. 

  2136. 	}
    2137. 

  2137. 	$self->{svm};
    2138. 

  2138. }
    2139. 

  2139. 

  2140. sub _set_svm_vars {
    2141. 

  2141. 	my ($self, $ra) = @_;
    2142. 

  2142. 	return $ra if $self->svm;
    2143. 

  2143. 

  2144. 	my @err = ( "useSvmProps set, but failed to read SVM properties\n",
    2145. 

  2145. 		    "(svm:source, svm:uuid) ",
    2146. 

  2146. 		    "from the following URLs:\n" );
    2147. 

  2147. 	sub read_svm_props {
    2148. 

  2148. 		my ($self, $ra, $path, $r) = @_;
    2149. 

  2149. 		my $props = ($ra->get_dir($path, $r))[2];
    2150. 

  2150. 		my $src = $props->{'svm:source'};
    2151. 

  2151. 		my $uuid = $props->{'svm:uuid'};
    2152. 

  2152. 		return undef if (!$src || !$uuid);
    2153. 

  2153. 

  2154. 		chomp($src, $uuid);
    2155. 

  2155. 

  2156. 		$uuid =~ m{^[0-9a-f\-]{30,}$}i
    2157. 

  2157. 		    or die "doesn't look right - svm:uuid is '$uuid'\n";
    2158. 

  2158. 

  2159. 		# the '!' is used to mark the repos_root!/relative/path
    2160. 

  2160. 		$src =~ s{/?!/?}{/};
    2161. 

  2161. 		$src =~ s{/+$}{}; # no trailing slashes please
    2162. 

  2162. 		# username is of no interest
    2163. 

  2163. 		$src =~ s{(^[a-z\+]*://)[^/@]*@}{$1};
    2164. 

  2164. 

  2165. 		my $replace = $ra->{url};
    2166. 

  2166. 		$replace .= "/$path" if length $path;
    2167. 

  2167. 

  2168. 		my $section = "svn-remote.$self->{repo_id}";
    2169. 

  2169. 		tmp_config("$section.svm-source", $src);
    2170. 

  2170. 		tmp_config("$section.svm-replace", $replace);
    2171. 

  2171. 		tmp_config("$section.svm-uuid", $uuid);
    2172. 

  2172. 		$self->{svm} = {
    2173. 

  2173. 			source => $src,
    2174. 

  2174. 			uuid => $uuid,
    2175. 

  2175. 			replace => $replace
    2176. 

  2176. 		};
    2177. 

  2177. 	}
    2178. 

  2178. 

  2179. 	my $r = $ra->get_latest_revnum;
    2180. 

  2180. 	my $path = $self->{path};
    2181. 

  2181. 	my %tried;
    2182. 

  2182. 	while (length $path) {
    2183. 

  2183. 		unless ($tried{"$self->{url}/$path"}) {
    2184. 

  2184. 			return $ra if $self->read_svm_props($ra, $path, $r);
    2185. 

  2185. 			$tried{"$self->{url}/$path"} = 1;
    2186. 

  2186. 		}
    2187. 

  2187. 		$path =~ s#/?[^/]+$##;
    2188. 

  2188. 	}
    2189. 

  2189. 	die "Path: '$path' should be ''\n" if $path ne '';
    2190. 

  2190. 	return $ra if $self->read_svm_props($ra, $path, $r);
    2191. 

  2191. 	$tried{"$self->{url}/$path"} = 1;
    2192. 

  2192. 

  2193. 	if ($ra->{repos_root} eq $self->{url}) {
    2194. 

  2194. 		die @err, (map { "  $_\n" } keys %tried), "\n";
    2195. 

  2195. 	}
    2196. 

  2196. 

  2197. 	# nope, make sure we're connected to the repository root:
    2198. 

  2198. 	my $ok;
    2199. 

  2199. 	my @tried_b;
    2200. 

  2200. 	$path = $ra->{svn_path};
    2201. 

  2201. 	$ra = Git::SVN::Ra->new($ra->{repos_root});
    2202. 

  2202. 	while (length $path) {
    2203. 

  2203. 		unless ($tried{"$ra->{url}/$path"}) {
    2204. 

  2204. 			$ok = $self->read_svm_props($ra, $path, $r);
    2205. 

  2205. 			last if $ok;
    2206. 

  2206. 			$tried{"$ra->{url}/$path"} = 1;
    2207. 

  2207. 		}
    2208. 

  2208. 		$path =~ s#/?[^/]+$##;
    2209. 

  2209. 	}
    2210. 

  2210. 	die "Path: '$path' should be ''\n" if $path ne '';
    2211. 

  2211. 	$ok ||= $self->read_svm_props($ra, $path, $r);
    2212. 

  2212. 	$tried{"$ra->{url}/$path"} = 1;
    2213. 

  2213. 	if (!$ok) {
    2214. 

  2214. 		die @err, (map { "  $_\n" } keys %tried), "\n";
    2215. 

  2215. 	}
    2216. 

  2216. 	Git::SVN::Ra->new($self->{url});
    2217. 

  2217. }
    2218. 

  2218. 

  2219. sub svnsync {
    2220. 

  2220. 	my ($self) = @_;
    2221. 

  2221. 	return $self->{svnsync} if $self->{svnsync};
    2222. 

  2222. 

  2223. 	if ($self->no_metadata) {
    2224. 

  2224. 		die "Can't have both 'noMetadata' and ",
    2225. 

  2225. 		    "'useSvnsyncProps' options set!\n";
    2226. 

  2226. 	}
    2227. 

  2227. 	if ($self->rewrite_root) {
    2228. 

  2228. 		die "Can't have both 'useSvnsyncProps' and 'rewriteRoot' ",
    2229. 

  2229. 		    "options set!\n";
    2230. 

  2230. 	}
    2231. 

  2231. 	if ($self->rewrite_uuid) {
    2232. 

  2232. 		die "Can't have both 'useSvnsyncProps' and 'rewriteUUID' ",
    2233. 

  2233. 		    "options set!\n";
    2234. 

  2234. 	}
    2235. 

  2235. 

  2236. 	my $svnsync;
    2237. 

  2237. 	# see if we have it in our config, first:
    2238. 

  2238. 	eval {
    2239. 

  2239. 		my $section = "svn-remote.$self->{repo_id}";
    2240. 

  2240. 

  2241. 		my $url = tmp_config('--get', "$section.svnsync-url");
    2242. 

  2242. 		($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or
    2243. 

  2243. 		   die "doesn't look right - svn:sync-from-url is '$url'\n";
    2244. 

  2244. 

  2245. 		my $uuid = tmp_config('--get', "$section.svnsync-uuid");
    2246. 

  2246. 		($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}i) or
    2247. 

  2247. 		   die "doesn't look right - svn:sync-from-uuid is '$uuid'\n";
    2248. 

  2248. 

  2249. 		$svnsync = { url => $url, uuid => $uuid }
    2250. 

  2250. 	};
    2251. 

  2251. 	if ($svnsync && $svnsync->{url} && $svnsync->{uuid}) {
    2252. 

  2252. 		return $self->{svnsync} = $svnsync;
    2253. 

  2253. 	}
    2254. 

  2254. 

  2255. 	my $err = "useSvnsyncProps set, but failed to read " .
    2256. 

  2256. 	          "svnsync property: svn:sync-from-";
    2257. 

  2257. 	my $rp = $self->ra->rev_proplist(0);
    2258. 

  2258. 

  2259. 	my $url = $rp->{'svn:sync-from-url'} or die $err . "url\n";
    2260. 

  2260. 	($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or
    2261. 

  2261. 	           die "doesn't look right - svn:sync-from-url is '$url'\n";
    2262. 

  2262. 

  2263. 	my $uuid = $rp->{'svn:sync-from-uuid'} or die $err . "uuid\n";
    2264. 

  2264. 	($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}i) or
    2265. 

  2265. 	           die "doesn't look right - svn:sync-from-uuid is '$uuid'\n";
    2266. 

  2266. 

  2267. 	my $section = "svn-remote.$self->{repo_id}";
    2268. 

  2268. 	tmp_config('--add', "$section.svnsync-uuid", $uuid);
    2269. 

  2269. 	tmp_config('--add', "$section.svnsync-url", $url);
    2270. 

  2270. 	return $self->{svnsync} = { url => $url, uuid => $uuid };
    2271. 

  2271. }
    2272. 

  2272. 

  2273. # this allows us to memoize our SVN::Ra UUID locally and avoid a
    2274. 

  2274. # remote lookup (useful for 'git svn log').
    2275. 

  2275. sub ra_uuid {
    2276. 

  2276. 	my ($self) = @_;
    2277. 

  2277. 	unless ($self->{ra_uuid}) {
    2278. 

  2278. 		my $key = "svn-remote.$self->{repo_id}.uuid";
    2279. 

  2279. 		my $uuid = eval { tmp_config('--get', $key) };
    2280. 

  2280. 		if (!$@ && $uuid && $uuid =~ /^([a-f\d\-]{30,})$/i) {
    2281. 

  2281. 			$self->{ra_uuid} = $uuid;
    2282. 

  2282. 		} else {
    2283. 

  2283. 			die "ra_uuid called without URL\n" unless $self->{url};
    2284. 

  2284. 			$self->{ra_uuid} = $self->ra->get_uuid;
    2285. 

  2285. 			tmp_config('--add', $key, $self->{ra_uuid});
    2286. 

  2286. 		}
    2287. 

  2287. 	}
    2288. 

  2288. 	$self->{ra_uuid};
    2289. 

  2289. }
    2290. 

  2290. 

  2291. sub _set_repos_root {
    2292. 

  2292. 	my ($self, $repos_root) = @_;
    2293. 

  2293. 	my $k = "svn-remote.$self->{repo_id}.reposRoot";
    2294. 

  2294. 	$repos_root ||= $self->ra->{repos_root};
    2295. 

  2295. 	tmp_config($k, $repos_root);
    2296. 

  2296. 	$repos_root;
    2297. 

  2297. }
    2298. 

  2298. 

  2299. sub repos_root {
    2300. 

  2300. 	my ($self) = @_;
    2301. 

  2301. 	my $k = "svn-remote.$self->{repo_id}.reposRoot";
    2302. 

  2302. 	eval { tmp_config('--get', $k) } || $self->_set_repos_root;
    2303. 

  2303. }
    2304. 

  2304. 

  2305. sub ra {
    2306. 

  2306. 	my ($self) = shift;
    2307. 

  2307. 	my $ra = Git::SVN::Ra->new($self->{url});
    2308. 

  2308. 	$self->_set_repos_root($ra->{repos_root});
    2309. 

  2309. 	if ($self->use_svm_props && !$self->{svm}) {
    2310. 

  2310. 		if ($self->no_metadata) {
    2311. 

  2311. 			die "Can't have both 'noMetadata' and ",
    2312. 

  2312. 			    "'useSvmProps' options set!\n";
    2313. 

  2313. 		} elsif ($self->use_svnsync_props) {
    2314. 

  2314. 			die "Can't have both 'useSvnsyncProps' and ",
    2315. 

  2315. 			    "'useSvmProps' options set!\n";
    2316. 

  2316. 		}
    2317. 

  2317. 		$ra = $self->_set_svm_vars($ra);
    2318. 

  2318. 		$self->{-want_revprops} = 1;
    2319. 

  2319. 	}
    2320. 

  2320. 	$ra;
    2321. 

  2321. }
    2322. 

  2322. 

  2323. # prop_walk(PATH, REV, SUB)
    2324. 

  2324. # -------------------------
    2325. 

  2325. # Recursively traverse PATH at revision REV and invoke SUB for each
    2326. 

  2326. # directory that contains a SVN property.  SUB will be invoked as
    2327. 

  2327. # follows:  &SUB(gs, path, props);  where `gs' is this instance of
    2328. 

  2328. # Git::SVN, `path' the path to the directory where the properties
    2329. 

  2329. # `props' were found.  The `path' will be relative to point of checkout,
    2330. 

  2330. # that is, if url://repo/trunk is the current Git branch, and that
    2331. 

  2331. # directory contains a sub-directory `d', SUB will be invoked with `/d/'
    2332. 

  2332. # as `path' (note the trailing `/').
    2333. 

  2333. sub prop_walk {
    2334. 

  2334. 	my ($self, $path, $rev, $sub) = @_;
    2335. 

  2335. 

  2336. 	$path =~ s#^/##;
    2337. 

  2337. 	my ($dirent, undef, $props) = $self->ra->get_dir($path, $rev);
    2338. 

  2338. 	$path =~ s#^/*#/#g;
    2339. 

  2339. 	my $p = $path;
    2340. 

  2340. 	# Strip the irrelevant part of the path.
    2341. 

  2341. 	$p =~ s#^/+\Q$self->{path}\E(/|$)#/#;
    2342. 

  2342. 	# Ensure the path is terminated by a `/'.
    2343. 

  2343. 	$p =~ s#/*$#/#;
    2344. 

    2345. 

  2345. 	# The properties contain all the internal SVN stuff nobody
    2346. 

  2346. 	# (usually) cares about.
    2347. 

  2347. 	my $interesting_props = 0;
    2348. 

  2348. 	foreach (keys %{$props}) {
    2349. 

  2349. 		# If it doesn't start with `svn:', it must be a
    2350. 

  2350. 		# user-defined property.
    2351. 

  2351. 		++$interesting_props and next if $_ !~ /^svn:/;
    2352. 

  2352. 		# FIXME: Fragile, if SVN adds new public properties,
    2353. 

  2353. 		# this needs to be updated.
    2354. 

  2354. 		++$interesting_props if /^svn:(?:ignore|keywords|executable
    2355. 

  2355. 		                                 |eol-style|mime-type
    2356. 

  2356. 						 |externals|needs-lock)$/x;
    2357. 

  2357. 	}
    2358. 

  2358. 	&$sub($self, $p, $props) if $interesting_props;
    2359. 

    2360. 

  2360. 	foreach (sort keys %$dirent) {
    2361. 

  2361. 		next if $dirent->{$_}->{kind} != $SVN::Node::dir;
    2362. 

  2362. 		$self->prop_walk($self->{path} . $p . $_, $rev, $sub);
    2363. 

  2363. 	}
    2364. 

  2364. }
    2365. 

    2366. 

  2366. sub last_rev { ($_[0]->last_rev_commit)[0] }
    2367. 

  2367. sub last_commit { ($_[0]->last_rev_commit)[1] }
    2368. 

    2369. 

  2369. # returns the newest SVN revision number and newest commit SHA1
    2370. 

  2370. sub last_rev_commit {
    2371. 

  2371. 	my ($self) = @_;
    2372. 

  2372. 	if (defined $self->{last_rev} && defined $self->{last_commit}) {
    2373. 

  2373. 		return ($self->{last_rev}, $self->{last_commit});
    2374. 

  2374. 	}
    2375. 

  2375. 	my $c = ::verify_ref($self->refname.'^0');
    2376. 

  2376. 	if ($c && !$self->use_svm_props && !$self->no_metadata) {
    2377. 

  2377. 		my $rev = (::cmt_metadata($c))[1];
    2378. 

  2378. 		if (defined $rev) {
    2379. 

  2379. 			($self->{last_rev}, $self->{last_commit}) = ($rev, $c);
    2380. 

  2380. 			return ($rev, $c);
    2381. 

  2381. 		}
    2382. 

  2382. 	}
    2383. 

  2383. 	my $map_path = $self->map_path;
    2384. 

  2384. 	unless (-e $map_path) {
    2385. 

  2385. 		($self->{last_rev}, $self->{last_commit}) = (undef, undef);
    2386. 

  2386. 		return (undef, undef);
    2387. 

  2387. 	}
    2388. 

  2388. 	my ($rev, $commit) = $self->rev_map_max(1);
    2389. 

  2389. 	($self->{last_rev}, $self->{last_commit}) = ($rev, $commit);
    2390. 

  2390. 	return ($rev, $commit);
    2391. 

  2391. }
    2392. 

    2393. 

  2393. sub get_fetch_range {
    2394. 

  2394. 	my ($self, $min, $max) = @_;
    2395. 

  2395. 	$max ||= $self->ra->get_latest_revnum;
    2396. 

  2396. 	$min ||= $self->rev_map_max;
    2397. 

  2397. 	(++$min, $max);
    2398. 

  2398. }
    2399. 

    2400. 

  2400. sub tmp_config {
    2401. 

  2401. 	my (@args) = @_;
    2402. 

  2402. 	my $old_def_config = "$ENV{GIT_DIR}/svn/config";
    2403. 

  2403. 	my $config = "$ENV{GIT_DIR}/svn/.metadata";
    2404. 

  2404. 	if (! -f $config && -f $old_def_config) {
    2405. 

  2405. 		rename $old_def_config, $config or
    2406. 

  2406. 		       die "Failed rename $old_def_config => $config: $!\n";
    2407. 

  2407. 	}
    2408. 

  2408. 	my $old_config = $ENV{GIT_CONFIG};
    2409. 

  2409. 	$ENV{GIT_CONFIG} = $config;
    2410. 

  2410. 	$@ = undef;
    2411. 

  2411. 	my @ret = eval {
    2412. 

  2412. 		unless (-f $config) {
    2413. 

  2413. 			mkfile($config);
    2414. 

  2414. 			open my $fh, '>', $config or
    2415. 

  2415. 			    die "Can't open $config: $!\n";
    2416. 

  2416. 			print $fh "; This file is used internally by ",
    2417. 

  2417. 			          "git-svn\n" or die
    2418. 

  2418. 				  "Couldn't write to $config: $!\n";
    2419. 

  2419. 			print $fh "; You should not have to edit it\n" or
    2420. 

  2420. 			      die "Couldn't write to $config: $!\n";
    2421. 

  2421. 			close $fh or die "Couldn't close $config: $!\n";
    2422. 

  2422. 		}
    2423. 

  2423. 		command('config', @args);
    2424. 

  2424. 	};
    2425. 

  2425. 	my $err = $@;
    2426. 

  2426. 	if (defined $old_config) {
    2427. 

  2427. 		$ENV{GIT_CONFIG} = $old_config;
    2428. 

  2428. 	} else {
    2429. 

  2429. 		delete $ENV{GIT_CONFIG};
    2430. 

  2430. 	}
    2431. 

  2431. 	die $err if $err;
    2432. 

  2432. 	wantarray ? @ret : $ret[0];
    2433. 

  2433. }
    2434. 

    2435. 

  2435. sub tmp_index_do {
    2436. 

  2436. 	my ($self, $sub) = @_;
    2437. 

  2437. 	my $old_index = $ENV{GIT_INDEX_FILE};
    2438. 

  2438. 	$ENV{GIT_INDEX_FILE} = $self->{index};
    2439. 

  2439. 	$@ = undef;
    2440. 

  2440. 	my @ret = eval {
    2441. 

  2441. 		my ($dir, $base) = ($self->{index} =~ m#^(.*?)/?([^/]+)$#);
    2442. 

  2442. 		mkpath([$dir]) unless -d $dir;
    2443. 

  2443. 		&$sub;
    2444. 

  2444. 	};
    2445. 

  2445. 	my $err = $@;
    2446. 

  2446. 	if (defined $old_index) {
    2447. 

  2447. 		$ENV{GIT_INDEX_FILE} = $old_index;
    2448. 

  2448. 	} else {
    2449. 

  2449. 		delete $ENV{GIT_INDEX_FILE};
    2450. 

  2450. 	}
    2451. 

  2451. 	die $err if $err;
    2452. 

  2452. 	wantarray ? @ret : $ret[0];
    2453. 

  2453. }
    2454. 

    2455. 

  2455. sub assert_index_clean {
    2456. 

  2456. 	my ($self, $treeish) = @_;
    2457. 

    2458. 

  2458. 	$self->tmp_index_do(sub {
    2459. 

  2459. 		command_noisy('read-tree', $treeish) unless -e $self->{index};
    2460. 

  2460. 		my $x = command_oneline('write-tree');
    2461. 

  2461. 		my ($y) = (command(qw/cat-file commit/, $treeish) =~
    2462. 

  2462. 		           /^tree ($::sha1)/mo);
    2463. 

  2463. 		return if $y eq $x;
    2464. 

    2465. 

  2465. 		warn "Index mismatch: $y != $x\nrereading $treeish\n";
    2466. 

  2466. 		unlink $self->{index} or die "unlink $self->{index}: $!\n";
    2467. 

  2467. 		command_noisy('read-tree', $treeish);
    2468. 

  2468. 		$x = command_oneline('write-tree');
    2469. 

  2469. 		if ($y ne $x) {
    2470. 

  2470. 			::fatal "trees ($treeish) $y != $x\n",
    2471. 

  2471. 			        "Something is seriously wrong...";
    2472. 

  2472. 		}
    2473. 

  2473. 	});
    2474. 

  2474. }
    2475. 

    2476. 

  2476. sub get_commit_parents {
    2477. 

  2477. 	my ($self, $log_entry) = @_;
    2478. 

  2478. 	my (%seen, @ret, @tmp);
    2479. 

  2479. 	# legacy support for 'set-tree'; this is only used by set_tree_cb:
    2480. 

  2480. 	if (my $ip = $self->{inject_parents}) {
    2481. 

  2481. 		if (my $commit = delete $ip->{$log_entry->{revision}}) {
    2482. 

  2482. 			push @tmp, $commit;
    2483. 

  2483. 		}
    2484. 

  2484. 	}
    2485. 

  2485. 	if (my $cur = ::verify_ref($self->refname.'^0')) {
    2486. 

  2486. 		push @tmp, $cur;
    2487. 

  2487. 	}
    2488. 

  2488. 	if (my $ipd = $self->{inject_parents_dcommit}) {
    2489. 

  2489. 		if (my $commit = delete $ipd->{$log_entry->{revision}}) {
    2490. 

  2490. 			push @tmp, @$commit;
    2491. 

  2491. 		}
    2492. 

  2492. 	}
    2493. 

  2493. 	push @tmp, $_ foreach (@{$log_entry->{parents}}, @tmp);
    2494. 

  2494. 	while (my $p = shift @tmp) {
    2495. 

  2495. 		next if $seen{$p};
    2496. 

  2496. 		$seen{$p} = 1;
    2497. 

  2497. 		push @ret, $p;
    2498. 

  2498. 	}
    2499. 

  2499. 	@ret;
    2500. 

  2500. }
    2501. 

    2502. 

  2502. sub rewrite_root {
    2503. 

  2503. 	my ($self) = @_;
    2504. 

  2504. 	return $self->{-rewrite_root} if exists $self->{-rewrite_root};
    2505. 

  2505. 	my $k = "svn-remote.$self->{repo_id}.rewriteRoot";
    2506. 

  2506. 	my $rwr = eval { command_oneline(qw/config --get/, $k) };
    2507. 

  2507. 	if ($rwr) {
    2508. 

  2508. 		$rwr =~ s#/+$##;
    2509. 

  2509. 		if ($rwr !~ m#^[a-z\+]+://#) {
    2510. 

  2510. 			die "$rwr is not a valid URL (key: $k)\n";
    2511. 

  2511. 		}
    2512. 

  2512. 	}
    2513. 

  2513. 	$self->{-rewrite_root} = $rwr;
    2514. 

  2514. }
    2515. 

    2516. 

  2516. sub rewrite_uuid {
    2517. 

  2517. 	my ($self) = @_;
    2518. 

  2518. 	return $self->{-rewrite_uuid} if exists $self->{-rewrite_uuid};
    2519. 

  2519. 	my $k = "svn-remote.$self->{repo_id}.rewriteUUID";
    2520. 

  2520. 	my $rwid = eval { command_oneline(qw/config --get/, $k) };
    2521. 

  2521. 	if ($rwid) {
    2522. 

  2522. 		$rwid =~ s#/+$##;
    2523. 

  2523. 		if ($rwid !~ m#^[a-f0-9]{8}-(?:[a-f0-9]{4}-){3}[a-f0-9]{12}$#) {
    2524. 

  2524. 			die "$rwid is not a valid UUID (key: $k)\n";
    2525. 

  2525. 		}
    2526. 

  2526. 	}
    2527. 

  2527. 	$self->{-rewrite_uuid} = $rwid;
    2528. 

  2528. }
    2529. 

    2530. 

  2530. sub metadata_url {
    2531. 

  2531. 	my ($self) = @_;
    2532. 

  2532. 	($self->rewrite_root || $self->{url}) .
    2533. 

  2533. 	   (length $self->{path} ? '/' . $self->{path} : '');
    2534. 

  2534. }
    2535. 

    2536. 

  2536. sub full_url {
    2537. 

  2537. 	my ($self) = @_;
    2538. 

  2538. 	$self->{url} . (length $self->{path} ? '/' . $self->{path} : '');
    2539. 

  2539. }
    2540. 

    2541. 

    2542. 

  2542. sub set_commit_header_env {
    2543. 

  2543. 	my ($log_entry) = @_;
    2544. 

  2544. 	my %env;
    2545. 

  2545. 	foreach my $ned (qw/NAME EMAIL DATE/) {
    2546. 

  2546. 		foreach my $ac (qw/AUTHOR COMMITTER/) {
    2547. 

  2547. 			$env{"GIT_${ac}_${ned}"} = $ENV{"GIT_${ac}_${ned}"};
    2548. 

  2548. 		}
    2549. 

  2549. 	}
    2550. 

    2551. 

  2551. 	$ENV{GIT_AUTHOR_NAME} = $log_entry->{name};
    2552. 

  2552. 	$ENV{GIT_AUTHOR_EMAIL} = $log_entry->{email};
    2553. 

  2553. 	$ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_entry->{date};
    2554. 

    2555. 

  2555. 	$ENV{GIT_COMMITTER_NAME} = (defined $log_entry->{commit_name})
    2556. 

  2556. 						? $log_entry->{commit_name}
    2557. 

  2557. 						: $log_entry->{name};
    2558. 

  2558. 	$ENV{GIT_COMMITTER_EMAIL} = (defined $log_entry->{commit_email})
    2559. 

  2559. 						? $log_entry->{commit_email}
    2560. 

  2560. 						: $log_entry->{email};
    2561. 

  2561. 	\%env;
    2562. 

  2562. }
    2563. 

    2564. 

  2564. sub restore_commit_header_env {
    2565. 

  2565. 	my ($env) = @_;
    2566. 

  2566. 	foreach my $ned (qw/NAME EMAIL DATE/) {
    2567. 

  2567. 		foreach my $ac (qw/AUTHOR COMMITTER/) {
    2568. 

  2568. 			my $k = "GIT_${ac}_${ned}";
    2569. 

  2569. 			if (defined $env->{$k}) {
    2570. 

  2570. 				$ENV{$k} = $env->{$k};
    2571. 

  2571. 			} else {
    2572. 

  2572. 				delete $ENV{$k};
    2573. 

  2573. 			}
    2574. 

  2574. 		}
    2575. 

  2575. 	}
    2576. 

  2576. }
    2577. 

    2578. 

  2578. sub gc {
    2579. 

  2579. 	command_noisy('gc', '--auto');
    2580. 

  2580. };
    2581. 

    2582. 

  2582. sub do_git_commit {
    2583. 

  2583. 	my ($self, $log_entry) = @_;
    2584. 

  2584. 	my $lr = $self->last_rev;
    2585. 

  2585. 	if (defined $lr && $lr >= $log_entry->{revision}) {
    2586. 

  2586. 		die "Last fetched revision of ", $self->refname,
    2587. 

  2587. 		    " was r$lr, but we are about to fetch: ",
    2588. 

  2588. 		    "r$log_entry->{revision}!\n";
    2589. 

  2589. 	}
    2590. 

  2590. 	if (my $c = $self->rev_map_get($log_entry->{revision})) {
    2591. 

  2591. 		croak "$log_entry->{revision} = $c already exists! ",
    2592. 

  2592. 		      "Why are we refetching it?\n";
    2593. 

  2593. 	}
    2594. 

  2594. 	my $old_env = set_commit_header_env($log_entry);
    2595. 

  2595. 	my $tree = $log_entry->{tree};
    2596. 

  2596. 	if (!defined $tree) {
    2597. 

  2597. 		$tree = $self->tmp_index_do(sub {
    2598. 

  2598. 		                            command_oneline('write-tree') });
    2599. 

  2599. 	}
    2600. 

  2600. 	die "Tree is not a valid sha1: $tree\n" if $tree !~ /^$::sha1$/o;
    2601. 

    2602. 

  2602. 	my @exec = ('git', 'commit-tree', $tree);
    2603. 

  2603. 	foreach ($self->get_commit_parents($log_entry)) {
    2604. 

  2604. 		push @exec, '-p', $_;
    2605. 

  2605. 	}
    2606. 

  2606. 	defined(my $pid = open3(my $msg_fh, my $out_fh, '>&STDERR', @exec))
    2607. 

  2607. 	                                                           or croak $!;
    2608. 

  2608. 	binmode $msg_fh;
    2609. 

    2610. 

  2610. 	# we always get UTF-8 from SVN, but we may want our commits in
    2611. 

  2611. 	# a different encoding.
    2612. 

  2612. 	if (my $enc = Git::config('i18n.commitencoding')) {
    2613. 

  2613. 		require Encode;
    2614. 

  2614. 		Encode::from_to($log_entry->{log}, 'UTF-8', $enc);
    2615. 

  2615. 	}
    2616. 

  2616. 	print $msg_fh $log_entry->{log} or croak $!;
    2617. 

  2617. 	restore_commit_header_env($old_env);
    2618. 

  2618. 	unless ($self->no_metadata) {
    2619. 

  2619. 		print $msg_fh "\ngit-svn-id: $log_entry->{metadata}\n"
    2620. 

  2620. 		              or croak $!;
    2621. 

  2621. 	}
    2622. 

  2622. 	$msg_fh->flush == 0 or croak $!;
    2623. 

  2623. 	close $msg_fh or croak $!;
    2624. 

  2624. 	chomp(my $commit = do { local $/; <$out_fh> });
    2625. 

  2625. 	close $out_fh or croak $!;
    2626. 

  2626. 	waitpid $pid, 0;
    2627. 

  2627. 	croak $? if $?;
    2628. 

  2628. 	if ($commit !~ /^$::sha1$/o) {
    2629. 

  2629. 		die "Failed to commit, invalid sha1: $commit\n";
    2630. 

  2630. 	}
    2631. 

    2632. 

  2632. 	$self->rev_map_set($log_entry->{revision}, $commit, 1);
    2633. 

    2634. 

  2634. 	$self->{last_rev} = $log_entry->{revision};
    2635. 

  2635. 	$self->{last_commit} = $commit;
    2636. 

  2636. 	print "r$log_entry->{revision}" unless $::_q > 1;
    2637. 

  2637. 	if (defined $log_entry->{svm_revision}) {
    2638. 

  2638. 		 print " (\@$log_entry->{svm_revision})" unless $::_q > 1;
    2639. 

  2639. 		 $self->rev_map_set($log_entry->{svm_revision}, $commit,
    2640. 

  2640. 		                   0, $self->svm_uuid);
    2641. 

  2641. 	}
    2642. 

  2642. 	print " = $commit ($self->{ref_id})\n" unless $::_q > 1;
    2643. 

  2643. 	if (--$_gc_nr == 0) {
    2644. 

  2644. 		$_gc_nr = $_gc_period;
    2645. 

  2645. 		gc();
    2646. 

  2646. 	}
    2647. 

  2647. 	return $commit;
    2648. 

  2648. }
    2649. 

    2650. 

  2650. sub match_paths {
    2651. 

  2651. 	my ($self, $paths, $r) = @_;
    2652. 

  2652. 	return 1 if $self->{path} eq '';
    2653. 

  2653. 	if (my $path = $paths->{"/$self->{path}"}) {
    2654. 

  2654. 		return ($path->{action} eq 'D') ? 0 : 1;
    2655. 

  2655. 	}
    2656. 

  2656. 	$self->{path_regex} ||= qr/^\/\Q$self->{path}\E\//;
    2657. 

  2657. 	if (grep /$self->{path_regex}/, keys %$paths) {
    2658. 

  2658. 		return 1;
    2659. 

  2659. 	}
    2660. 

  2660. 	my $c = '';
    2661. 

  2661. 	foreach (split m#/#, $self->{path}) {
    2662. 

  2662. 		$c .= "/$_";
    2663. 

  2663. 		next unless ($paths->{$c} &&
    2664. 

  2664. 		             ($paths->{$c}->{action} =~ /^[AR]$/));
    2665. 

  2665. 		if ($self->ra->check_path($self->{path}, $r) ==
    2666. 

  2666. 		    $SVN::Node::dir) {
    2667. 

  2667. 			return 1;
    2668. 

  2668. 		}
    2669. 

  2669. 	}
    2670. 

  2670. 	return 0;
    2671. 

  2671. }
    2672. 

    2673. 

  2673. sub find_parent_branch {
    2674. 

  2674. 	my ($self, $paths, $rev) = @_;
    2675. 

  2675. 	return undef unless $self->follow_parent;
    2676. 

  2676. 	unless (defined $paths) {
    2677. 

  2677. 		my $err_handler = $SVN::Error::handler;
    2678. 

  2678. 		$SVN::Error::handler = \&Git::SVN::Ra::skip_unknown_revs;
    2679. 

  2679. 		$self->ra->get_log([$self->{path}], $rev, $rev, 0, 1, 1,
    2680. 

  2680. 				   sub { $paths = $_[0] });
    2681. 

  2681. 		$SVN::Error::handler = $err_handler;
    2682. 

  2682. 	}
    2683. 

  2683. 	return undef unless defined $paths;
    2684. 

    2685. 

  2685. 	# look for a parent from another branch:
    2686. 

  2686. 	my @b_path_components = split m#/#, $self->{path};
    2687. 

  2687. 	my @a_path_components;
    2688. 

  2688. 	my $i;
    2689. 

  2689. 	while (@b_path_components) {
    2690. 

  2690. 		$i = $paths->{'/'.join('/', @b_path_components)};
    2691. 

  2691. 		last if $i && defined $i->{copyfrom_path};
    2692. 

  2692. 		unshift(@a_path_components, pop(@b_path_components));
    2693. 

  2693. 	}
    2694. 

  2694. 	return undef unless defined $i && defined $i->{copyfrom_path};
    2695. 

  2695. 	my $branch_from = $i->{copyfrom_path};
    2696. 

  2696. 	if (@a_path_components) {
    2697. 

  2697. 		print STDERR "branch_from: $branch_from => ";
    2698. 

  2698. 		$branch_from .= '/'.join('/', @a_path_components);
    2699. 

  2699. 		print STDERR $branch_from, "\n";
    2700. 

  2700. 	}
    2701. 

  2701. 	my $r = $i->{copyfrom_rev};
    2702. 

  2702. 	my $repos_root = $self->ra->{repos_root};
    2703. 

  2703. 	my $url = $self->ra->{url};
    2704. 

  2704. 	my $new_url = $url . $branch_from;
    2705. 

  2705. 	print STDERR  "Found possible branch point: ",
    2706. 

  2706. 	              "$new_url => ", $self->full_url, ", $r\n"
    2707. 

  2707. 	              unless $::_q > 1;
    2708. 

  2708. 	$branch_from =~ s#^/##;
    2709. 

  2709. 	my $gs = $self->other_gs($new_url, $url,
    2710. 

  2710. 		                 $branch_from, $r, $self->{ref_id});
    2711. 

  2711. 	my ($r0, $parent) = $gs->find_rev_before($r, 1);
    2712. 

  2712. 	{
    2713. 

  2713. 		my ($base, $head);
    2714. 

  2714. 		if (!defined $r0 || !defined $parent) {
    2715. 

  2715. 			($base, $head) = parse_revision_argument(0, $r);
    2716. 

  2716. 		} else {
    2717. 

  2717. 			if ($r0 < $r) {
    2718. 

  2718. 				$gs->ra->get_log([$gs->{path}], $r0 + 1, $r, 1,
    2719. 

  2719. 					0, 1, sub { $base = $_[1] - 1 });
    2720. 

  2720. 			}
    2721. 

  2721. 		}
    2722. 

  2722. 		if (defined $base && $base <= $r) {
    2723. 

  2723. 			$gs->fetch($base, $r);
    2724. 

  2724. 		}
    2725. 

  2725. 		($r0, $parent) = $gs->find_rev_before($r, 1);
    2726. 

  2726. 	}
    2727. 

  2727. 	if (defined $r0 && defined $parent) {
    2728. 

  2728. 		print STDERR "Found branch parent: ($self->{ref_id}) $parent\n"
    2729. 

  2729. 		             unless $::_q > 1;
    2730. 

  2730. 		my $ed;
    2731. 

  2731. 		if ($self->ra->can_do_switch) {
    2732. 

  2732. 			$self->assert_index_clean($parent);
    2733. 

  2733. 			print STDERR "Following parent with do_switch\n"
    2734. 

  2734. 			             unless $::_q > 1;
    2735. 

  2735. 			# do_switch works with svn/trunk >= r22312, but that
    2736. 

  2736. 			# is not included with SVN 1.4.3 (the latest version
    2737. 

  2737. 			# at the moment), so we can't rely on it
    2738. 

  2738. 			$self->{last_rev} = $r0;
    2739. 

  2739. 			$self->{last_commit} = $parent;
    2740. 

  2740. 			$ed = SVN::Git::Fetcher->new($self, $gs->{path});
    2741. 

  2741. 			$gs->ra->gs_do_switch($r0, $rev, $gs,
    2742. 

  2742. 					      $self->full_url, $ed)
    2743. 

  2743. 			  or die "SVN connection failed somewhere...\n";
    2744. 

  2744. 		} elsif ($self->ra->trees_match($new_url, $r0,
    2745. 

  2745. 			                        $self->full_url, $rev)) {
    2746. 

  2746. 			print STDERR "Trees match:\n",
    2747. 

  2747. 			             "  $new_url\@$r0\n",
    2748. 

  2748. 			             "  ${\$self->full_url}\@$rev\n",
    2749. 

  2749. 			             "Following parent with no changes\n"
    2750. 

  2750. 			             unless $::_q > 1;
    2751. 

  2751. 			$self->tmp_index_do(sub {
    2752. 

  2752. 			    command_noisy('read-tree', $parent);
    2753. 

  2753. 			});
    2754. 

  2754. 			$self->{last_commit} = $parent;
    2755. 

  2755. 		} else {
    2756. 

  2756. 			print STDERR "Following parent with do_update\n"
    2757. 

  2757. 			             unless $::_q > 1;
    2758. 

  2758. 			$ed = SVN::Git::Fetcher->new($self);
    2759. 

  2759. 			$self->ra->gs_do_update($rev, $rev, $self, $ed)
    2760. 

  2760. 			  or die "SVN connection failed somewhere...\n";
    2761. 

  2761. 		}
    2762. 

  2762. 		print STDERR "Successfully followed parent\n" unless $::_q > 1;
    2763. 

  2763. 		return $self->make_log_entry($rev, [$parent], $ed);
    2764. 

  2764. 	}
    2765. 

  2765. 	return undef;
    2766. 

  2766. }
    2767. 

    2768. 

  2768. sub do_fetch {
    2769. 

  2769. 	my ($self, $paths, $rev) = @_;
    2770. 

  2770. 	my $ed;
    2771. 

  2771. 	my ($last_rev, @parents);
    2772. 

  2772. 	if (my $lc = $self->last_commit) {
    2773. 

  2773. 		# we can have a branch that was deleted, then re-added
    2774. 

  2774. 		# under the same name but copied from another path, in
    2775. 

  2775. 		# which case we'll have multiple parents (we don't
    2776. 

  2776. 		# want to break the original ref, nor lose copypath info):
    2777. 

  2777. 		if (my $log_entry = $self->find_parent_branch($paths, $rev)) {
    2778. 

  2778. 			push @{$log_entry->{parents}}, $lc;
    2779. 

  2779. 			return $log_entry;
    2780. 

  2780. 		}
    2781. 

  2781. 		$ed = SVN::Git::Fetcher->new($self);
    2782. 

  2782. 		$last_rev = $self->{last_rev};
    2783. 

  2783. 		$ed->{c} = $lc;
    2784. 

  2784. 		@parents = ($lc);
    2785. 

  2785. 	} else {
    2786. 

  2786. 		$last_rev = $rev;
    2787. 

  2787. 		if (my $log_entry = $self->find_parent_branch($paths, $rev)) {
    2788. 

  2788. 			return $log_entry;
    2789. 

  2789. 		}
    2790. 

  2790. 		$ed = SVN::Git::Fetcher->new($self);
    2791. 

  2791. 	}
    2792. 

  2792. 	unless ($self->ra->gs_do_update($last_rev, $rev, $self, $ed)) {
    2793. 

  2793. 		die "SVN connection failed somewhere...\n";
    2794. 

  2794. 	}
    2795. 

  2795. 	$self->make_log_entry($rev, \@parents, $ed);
    2796. 

  2796. }
    2797. 

    2798. 

  2798. sub mkemptydirs {
    2799. 

  2799. 	my ($self, $r) = @_;
    2800. 

    2801. 

  2801. 	sub scan {
    2802. 

  2802. 		my ($r, $empty_dirs, $line) = @_;
    2803. 

  2803. 		if (defined $r && $line =~ /^r(\d+)$/) {
    2804. 

  2804. 			return 0 if $1 > $r;
    2805. 

  2805. 		} elsif ($line =~ /^  \+empty_dir: (.+)$/) {
    2806. 

  2806. 			$empty_dirs->{$1} = 1;
    2807. 

  2807. 		} elsif ($line =~ /^  \-empty_dir: (.+)$/) {
    2808. 

  2808. 			my @d = grep {m[^\Q$1\E(/|$)]} (keys %$empty_dirs);
    2809. 

  2809. 			delete @$empty_dirs{@d};
    2810. 

  2810. 		}
    2811. 

  2811. 		1; # continue
    2812. 

  2812. 	};
    2813. 

    2814. 

  2814. 	my %empty_dirs = ();
    2815. 

  2815. 	my $gz_file = "$self->{dir}/unhandled.log.gz";
    2816. 

  2816. 	if (-f $gz_file) {
    2817. 

  2817. 		if (!$can_compress) {
    2818. 

  2818. 			warn "Compress::Zlib could not be found; ",
    2819. 

  2819. 			     "empty directories in $gz_file will not be read\n";
    2820. 

  2820. 		} else {
    2821. 

  2821. 			my $gz = Compress::Zlib::gzopen($gz_file, "rb") or
    2822. 

  2822. 				die "Unable to open $gz_file: $!\n";
    2823. 

  2823. 			my $line;
    2824. 

  2824. 			while ($gz->gzreadline($line) > 0) {
    2825. 

  2825. 				scan($r, \%empty_dirs, $line) or last;
    2826. 

  2826. 			}
    2827. 

  2827. 			$gz->gzclose;
    2828. 

  2828. 		}
    2829. 

  2829. 	}
    2830. 

    2831. 

  2831. 	if (open my $fh, '<', "$self->{dir}/unhandled.log") {
    2832. 

  2832. 		binmode $fh or croak "binmode: $!";
    2833. 

  2833. 		while (<$fh>) {
    2834. 

  2834. 			scan($r, \%empty_dirs, $_) or last;
    2835. 

  2835. 		}
    2836. 

  2836. 		close $fh;
    2837. 

  2837. 	}
    2838. 

    2839. 

  2839. 	my $strip = qr/\A\Q$self->{path}\E(?:\/|$)/;
    2840. 

  2840. 	foreach my $d (sort keys %empty_dirs) {
    2841. 

  2841. 		$d = uri_decode($d);
    2842. 

  2842. 		$d =~ s/$strip//;
    2843. 

  2843. 		next unless length($d);
    2844. 

  2844. 		next if -d $d;
    2845. 

  2845. 		if (-e $d) {
    2846. 

  2846. 			warn "$d exists but is not a directory\n";
    2847. 

  2847. 		} else {
    2848. 

  2848. 			print "creating empty directory: $d\n";
    2849. 

  2849. 			mkpath([$d]);
    2850. 

  2850. 		}
    2851. 

  2851. 	}
    2852. 

  2852. }
    2853. 

    2854. 

  2854. sub get_untracked {
    2855. 

  2855. 	my ($self, $ed) = @_;
    2856. 

  2856. 	my @out;
    2857. 

  2857. 	my $h = $ed->{empty};
    2858. 

  2858. 	foreach (sort keys %$h) {
    2859. 

  2859. 		my $act = $h->{$_} ? '+empty_dir' : '-empty_dir';
    2860. 

  2860. 		push @out, "  $act: " . uri_encode($_);
    2861. 

  2861. 		warn "W: $act: $_\n";
    2862. 

  2862. 	}
    2863. 

  2863. 	foreach my $t (qw/dir_prop file_prop/) {
    2864. 

  2864. 		$h = $ed->{$t} or next;
    2865. 

  2865. 		foreach my $path (sort keys %$h) {
    2866. 

  2866. 			my $ppath = $path eq '' ? '.' : $path;
    2867. 

  2867. 			foreach my $prop (sort keys %{$h->{$path}}) {
    2868. 

  2868. 				next if $SKIP_PROP{$prop};
    2869. 

  2869. 				my $v = $h->{$path}->{$prop};
    2870. 

  2870. 				my $t_ppath_prop = "$t: " .
    2871. 

  2871. 				                    uri_encode($ppath) . ' ' .
    2872. 

  2872. 				                    uri_encode($prop);
    2873. 

  2873. 				if (defined $v) {
    2874. 

  2874. 					push @out, "  +$t_ppath_prop " .
    2875. 

  2875. 					           uri_encode($v);
    2876. 

  2876. 				} else {
    2877. 

  2877. 					push @out, "  -$t_ppath_prop";
    2878. 

  2878. 				}
    2879. 

  2879. 			}
    2880. 

  2880. 		}
    2881. 

  2881. 	}
    2882. 

  2882. 	foreach my $t (qw/absent_file absent_directory/) {
    2883. 

  2883. 		$h = $ed->{$t} or next;
    2884. 

  2884. 		foreach my $parent (sort keys %$h) {
    2885. 

  2885. 			foreach my $path (sort @{$h->{$parent}}) {
    2886. 

  2886. 				push @out, "  $t: " .
    2887. 

  2887. 				           uri_encode("$parent/$path");
    2888. 

  2888. 				warn "W: $t: $parent/$path ",
    2889. 

  2889. 				     "Insufficient permissions?\n";
    2890. 

  2890. 			}
    2891. 

  2891. 		}
    2892. 

  2892. 	}
    2893. 

  2893. 	\@out;
    2894. 

  2894. }
    2895. 

    2896. 

  2896. # parse_svn_date(DATE)
    2897. 

  2897. # --------------------
    2898. 

  2898. # Given a date (in UTC) from Subversion, return a string in the format
    2899. 

  2899. # "<TZ Offset> <local date/time>" that Git will use.
    2900. 

  2900. #
    2901. 

  2901. # By default the parsed date will be in UTC; if $Git::SVN::_localtime
    2902. 

  2902. # is true we'll convert it to the local timezone instead.
    2903. 

  2903. sub parse_svn_date {
    2904. 

  2904. 	my $date = shift || return '+0000 1970-01-01 00:00:00';
    2905. 

  2905. 	my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T
    2906. 

  2906. 	                                    (\d\d)\:(\d\d)\:(\d\d)\.\d*Z$/x) or
    2907. 

  2907. 	                                 croak "Unable to parse date: $date\n";
    2908. 

  2908. 	my $parsed_date;    # Set next.
    2909. 

    2910. 

  2910. 	if ($Git::SVN::_localtime) {
    2911. 

  2911. 		# Translate the Subversion datetime to an epoch time.
    2912. 

  2912. 		# Begin by switching ourselves to $date's timezone, UTC.
    2913. 

  2913. 		my $old_env_TZ = $ENV{TZ};
    2914. 

  2914. 		$ENV{TZ} = 'UTC';
    2915. 

    2916. 

  2916. 		my $epoch_in_UTC =
    2917. 

  2917. 		    POSIX::strftime('%s', $S, $M, $H, $d, $m - 1, $Y - 1900);
    2918. 

    2919. 

  2919. 		# Determine our local timezone (including DST) at the
    2920. 

  2920. 		# time of $epoch_in_UTC.  $Git::SVN::Log::TZ stored the
    2921. 

  2921. 		# value of TZ, if any, at the time we were run.
    2922. 

  2922. 		if (defined $Git::SVN::Log::TZ) {
    2923. 

  2923. 			$ENV{TZ} = $Git::SVN::Log::TZ;
    2924. 

  2924. 		} else {
    2925. 

  2925. 			delete $ENV{TZ};
    2926. 

  2926. 		}
    2927. 

    2928. 

  2928. 		my $our_TZ =
    2929. 

  2929. 		    POSIX::strftime('%Z', $S, $M, $H, $d, $m - 1, $Y - 1900);
    2930. 

    2931. 

  2931. 		# This converts $epoch_in_UTC into our local timezone.
    2932. 

  2932. 		my ($sec, $min, $hour, $mday, $mon, $year,
    2933. 

  2933. 		    $wday, $yday, $isdst) = localtime($epoch_in_UTC);
    2934. 

    2935. 

  2935. 		$parsed_date = sprintf('%s %04d-%02d-%02d %02d:%02d:%02d',
    2936. 

  2936. 				       $our_TZ, $year + 1900, $mon + 1,
    2937. 

  2937. 				       $mday, $hour, $min, $sec);
    2938. 

    2939. 

  2939. 		# Reset us to the timezone in effect when we entered
    2940. 

  2940. 		# this routine.
    2941. 

  2941. 		if (defined $old_env_TZ) {
    2942. 

  2942. 			$ENV{TZ} = $old_env_TZ;
    2943. 

  2943. 		} else {
    2944. 

  2944. 			delete $ENV{TZ};
    2945. 

  2945. 		}
    2946. 

  2946. 	} else {
    2947. 

  2947. 		$parsed_date = "+0000 $Y-$m-$d $H:$M:$S";
    2948. 

  2948. 	}
    2949. 

    2950. 

  2950. 	return $parsed_date;
    2951. 

  2951. }
    2952. 

    2953. 

  2953. sub other_gs {
    2954. 

  2954. 	my ($self, $new_url, $url,
    2955. 

  2955. 	    $branch_from, $r, $old_ref_id) = @_;
    2956. 

  2956. 	my $gs = Git::SVN->find_by_url($new_url, $url, $branch_from);
    2957. 

  2957. 	unless ($gs) {
    2958. 

  2958. 		my $ref_id = $old_ref_id;
    2959. 

  2959. 		$ref_id =~ s/\@\d+$//;
    2960. 

  2960. 		$ref_id .= "\@$r";
    2961. 

  2961. 		# just grow a tail if we're not unique enough :x
    2962. 

  2962. 		$ref_id .= '-' while find_ref($ref_id);
    2963. 

  2963. 		print STDERR "Initializing parent: $ref_id\n" unless $::_q > 1;
    2964. 

  2964. 		my ($u, $p, $repo_id) = ($new_url, '', $ref_id);
    2965. 

  2965. 		if ($u =~ s#^\Q$url\E(/|$)##) {
    2966. 

  2966. 			$p = $u;
    2967. 

  2967. 			$u = $url;
    2968. 

  2968. 			$repo_id = $self->{repo_id};
    2969. 

  2969. 		}
    2970. 

  2970. 		$gs = Git::SVN->init($u, $p, $repo_id, $ref_id, 1);
    2971. 

  2971. 	}
    2972. 

  2972. 	$gs
    2973. 

  2973. }
    2974. 

    2975. 

  2975. sub call_authors_prog {
    2976. 

  2976. 	my ($orig_author) = @_;
    2977. 

  2977. 	$orig_author = command_oneline('rev-parse', '--sq-quote', $orig_author);
    2978. 

  2978. 	my $author = `$::_authors_prog $orig_author`;
    2979. 

  2979. 	if ($? != 0) {
    2980. 

  2980. 		die "$::_authors_prog failed with exit code $?\n"
    2981. 

  2981. 	}
    2982. 

  2982. 	if ($author =~ /^\s*(.+?)\s*<(.*)>\s*$/) {
    2983. 

  2983. 		my ($name, $email) = ($1, $2);
    2984. 

  2984. 		$email = undef if length $2 == 0;
    2985. 

  2985. 		return [$name, $email];
    2986. 

  2986. 	} else {
    2987. 

  2987. 		die "Author: $orig_author: $::_authors_prog returned "
    2988. 

  2988. 			. "invalid author format: $author\n";
    2989. 

  2989. 	}
    2990. 

  2990. }
    2991. 

    2992. 

  2992. sub check_author {
    2993. 

  2993. 	my ($author) = @_;
    2994. 

  2994. 	if (!defined $author || length $author == 0) {
    2995. 

  2995. 		$author = '(no author)';
    2996. 

  2996. 	}
    2997. 

  2997. 	if (!defined $::users{$author}) {
    2998. 

  2998. 		if (defined $::_authors_prog) {
    2999. 

  2999. 			$::users{$author} = call_authors_prog($author);
    3000. 

  3000. 		} elsif (defined $::_authors) {
    3001. 

  3001. 			die "Author: $author not defined in $::_authors file\n";
    3002. 

  3002. 		}
    3003. 

  3003. 	}
    3004. 

  3004. 	$author;
    3005. 

  3005. }
    3006. 

    3007. 

  3007. sub find_extra_svk_parents {
    3008. 

  3008. 	my ($self, $ed, $tickets, $parents) = @_;
    3009. 

  3009. 	# aha!  svk:merge property changed...
    3010. 

  3010. 	my @tickets = split "\n", $tickets;
    3011. 

  3011. 	my @known_parents;
    3012. 

  3012. 	for my $ticket ( @tickets ) {
    3013. 

  3013. 		my ($uuid, $path, $rev) = split /:/, $ticket;
    3014. 

  3014. 		if ( $uuid eq $self->ra_uuid ) {
    3015. 

  3015. 			my $url = $self->{url};
    3016. 

  3016. 			my $repos_root = $url;
    3017. 

  3017. 			my $branch_from = $path;
    3018. 

  3018. 			$branch_from =~ s{^/}{};
    3019. 

  3019. 			my $gs = $self->other_gs($repos_root."/".$branch_from,
    3020. 

  3020. 			                         $url,
    3021. 

  3021. 			                         $branch_from,
    3022. 

  3022. 			                         $rev,
    3023. 

  3023. 			                         $self->{ref_id});
    3024. 

  3024. 			if ( my $commit = $gs->rev_map_get($rev, $uuid) ) {
    3025. 

  3025. 				# wahey!  we found it, but it might be
    3026. 

  3026. 				# an old one (!)
    3027. 

  3027. 				push @known_parents, [ $rev, $commit ];
    3028. 

  3028. 			}
    3029. 

  3029. 		}
    3030. 

  3030. 	}
    3031. 

  3031. 	# Ordering matters; highest-numbered commit merge tickets
    3032. 

  3032. 	# first, as they may account for later merge ticket additions
    3033. 

  3033. 	# or changes.
    3034. 

  3034. 	@known_parents = map {$_->[1]} sort {$b->[0] <=> $a->[0]} @known_parents;
    3035. 

  3035. 	for my $parent ( @known_parents ) {
    3036. 

  3036. 		my @cmd = ('rev-list', $parent, map { "^$_" } @$parents );
    3037. 

  3037. 		my ($msg_fh, $ctx) = command_output_pipe(@cmd);
    3038. 

  3038. 		my $new;
    3039. 

  3039. 		while ( <$msg_fh> ) {
    3040. 

  3040. 			$new=1;last;
    3041. 

  3041. 		}
    3042. 

  3042. 		command_close_pipe($msg_fh, $ctx);
    3043. 

  3043. 		if ( $new ) {
    3044. 

  3044. 			print STDERR
    3045. 

  3045. 			    "Found merge parent (svk:merge ticket): $parent\n";
    3046. 

  3046. 			push @$parents, $parent;
    3047. 

  3047. 		}
    3048. 

  3048. 	}
    3049. 

  3049. }
    3050. 

    3051. 

  3051. sub lookup_svn_merge {
    3052. 

  3052. 	my $uuid = shift;
    3053. 

  3053. 	my $url = shift;
    3054. 

  3054. 	my $merge = shift;
    3055. 

    3056. 

  3056. 	my ($source, $revs) = split ":", $merge;
    3057. 

  3057. 	my $path = $source;
    3058. 

  3058. 	$path =~ s{^/}{};
    3059. 

  3059. 	my $gs = Git::SVN->find_by_url($url.$source, $url, $path);
    3060. 

  3060. 	if ( !$gs ) {
    3061. 

  3061. 		warn "Couldn't find revmap for $url$source\n";
    3062. 

  3062. 		return;
    3063. 

  3063. 	}
    3064. 

  3064. 	my @ranges = split ",", $revs;
    3065. 

  3065. 	my ($tip, $tip_commit);
    3066. 

  3066. 	my @merged_commit_ranges;
    3067. 

  3067. 	# find the tip
    3068. 

  3068. 	for my $range ( @ranges ) {
    3069. 

  3069. 		my ($bottom, $top) = split "-", $range;
    3070. 

  3070. 		$top ||= $bottom;
    3071. 

  3071. 		my $bottom_commit = $gs->find_rev_after( $bottom, 1, $top );
    3072. 

  3072. 		my $top_commit = $gs->find_rev_before( $top, 1, $bottom );
    3073. 

    3074. 

  3074. 		unless ($top_commit and $bottom_commit) {
    3075. 

  3075. 			warn "W:unknown path/rev in svn:mergeinfo "
    3076. 

  3076. 				."dirprop: $source:$range\n";
    3077. 

  3077. 			next;
    3078. 

  3078. 		}
    3079. 

    3080. 

  3080. 		push @merged_commit_ranges,
    3081. 

  3081. 			"$bottom_commit^..$top_commit";
    3082. 

    3083. 

  3083. 		if ( !defined $tip or $top > $tip ) {
    3084. 

  3084. 			$tip = $top;
    3085. 

  3085. 			$tip_commit = $top_commit;
    3086. 

  3086. 		}
    3087. 

  3087. 	}
    3088. 

  3088. 	return ($tip_commit, @merged_commit_ranges);
    3089. 

  3089. }
    3090. 

    3091. 

  3091. sub _rev_list {
    3092. 

  3092. 	my ($msg_fh, $ctx) = command_output_pipe(
    3093. 

  3093. 		"rev-list", @_,
    3094. 

  3094. 	       );
    3095. 

  3095. 	my @rv;
    3096. 

  3096. 	while ( <$msg_fh> ) {
    3097. 

  3097. 		chomp;
    3098. 

  3098. 		push @rv, $_;
    3099. 

  3099. 	}
    3100. 

  3100. 	command_close_pipe($msg_fh, $ctx);
    3101. 

  3101. 	@rv;
    3102. 

  3102. }
    3103. 

    3104. 

  3104. sub check_cherry_pick {
    3105. 

  3105. 	my $base = shift;
    3106. 

  3106. 	my $tip = shift;
    3107. 

  3107. 	my @ranges = @_;
    3108. 

  3108. 	my %commits = map { $_ => 1 }
    3109. 

  3109. 		_rev_list("--no-merges", $tip, "--not", $base);
    3110. 

  3110. 	for my $range ( @ranges ) {
    3111. 

  3111. 		delete @commits{_rev_list($range)};
    3112. 

  3112. 	}
    3113. 

  3113. 	for my $commit (keys %commits) {
    3114. 

  3114. 		if (has_no_changes($commit)) {
    3115. 

  3115. 			delete $commits{$commit};
    3116. 

  3116. 		}
    3117. 

  3117. 	}
    3118. 

  3118. 	return (keys %commits);
    3119. 

  3119. }
    3120. 

    3121. 

  3121. sub has_no_changes {
    3122. 

  3122. 	my $commit = shift;
    3123. 

    3124. 

  3124. 	my @revs = split / /, command_oneline(
    3125. 

  3125. 		qw(rev-list --parents -1 -m), $commit);
    3126. 

    3127. 

  3127. 	# Commits with no parents, e.g. the start of a partial branch,
    3128. 

  3128. 	# have changes by definition.
    3129. 

  3129. 	return 1 if (@revs < 2);
    3130. 

    3131. 

  3131. 	# Commits with multiple parents, e.g a merge, have no changes
    3132. 

  3132. 	# by definition.
    3133. 

  3133. 	return 0 if (@revs > 2);
    3134. 

    3135. 

  3135. 	return (command_oneline("rev-parse", "$commit^{tree}") eq
    3136. 

  3136. 		command_oneline("rev-parse", "$commit~1^{tree}"));
    3137. 

  3137. }
    3138. 

    3139. 

  3139. # The GIT_DIR environment variable is not always set until after the command
    3140. 

  3140. # line arguments are processed, so we can't memoize in a BEGIN block.
    3141. 

  3141. {
    3142. 

  3142. 	my $memoized = 0;
    3143. 

    3144. 

  3144. 	sub memoize_svn_mergeinfo_functions {
    3145. 

  3145. 		return if $memoized;
    3146. 

  3146. 		$memoized = 1;
    3147. 

    3148. 

  3148. 		my $cache_path = "$ENV{GIT_DIR}/svn/.caches/";
    3149. 

  3149. 		mkpath([$cache_path]) unless -d $cache_path;
    3150. 

    3151. 

  3151. 		tie my %lookup_svn_merge_cache => 'Memoize::Storable',
    3152. 

  3152. 		    "$cache_path/lookup_svn_merge.db", 'nstore';
    3153. 

  3153. 		memoize 'lookup_svn_merge',
    3154. 

  3154. 			SCALAR_CACHE => 'FAULT',
    3155. 

  3155. 			LIST_CACHE => ['HASH' => \%lookup_svn_merge_cache],
    3156. 

  3156. 		;
    3157. 

    3158. 

  3158. 		tie my %check_cherry_pick_cache => 'Memoize::Storable',
    3159. 

  3159. 		    "$cache_path/check_cherry_pick.db", 'nstore';
    3160. 

  3160. 		memoize 'check_cherry_pick',
    3161. 

  3161. 			SCALAR_CACHE => 'FAULT',
    3162. 

  3162. 			LIST_CACHE => ['HASH' => \%check_cherry_pick_cache],
    3163. 

  3163. 		;
    3164. 

    3165. 

  3165. 		tie my %has_no_changes_cache => 'Memoize::Storable',
    3166. 

  3166. 		    "$cache_path/has_no_changes.db", 'nstore';
    3167. 

  3167. 		memoize 'has_no_changes',
    3168. 

  3168. 			SCALAR_CACHE => ['HASH' => \%has_no_changes_cache],
    3169. 

  3169. 			LIST_CACHE => 'FAULT',
    3170. 

  3170. 		;
    3171. 

  3171. 	}
    3172. 

    3173. 

  3173. 	sub unmemoize_svn_mergeinfo_functions {
    3174. 

  3174. 		return if not $memoized;
    3175. 

  3175. 		$memoized = 0;
    3176. 

    3177. 

  3177. 		Memoize::unmemoize 'lookup_svn_merge';
    3178. 

  3178. 		Memoize::unmemoize 'check_cherry_pick';
    3179. 

  3179. 		Memoize::unmemoize 'has_no_changes';
    3180. 

  3180. 	}
    3181. 

  3181. }
    3182. 

    3183. 

  3183. END {
    3184. 

  3184. 	# Force cache writeout explicitly instead of waiting for
    3185. 

  3185. 	# global destruction to avoid segfault in Storable:
    3186. 

  3186. 	# http://rt.cpan.org/Public/Bug/Display.html?id=36087
    3187. 

  3187. 	unmemoize_svn_mergeinfo_functions();
    3188. 

  3188. }
    3189. 

    3190. 

  3190. sub parents_exclude {
    3191. 

  3191. 	my $parents = shift;
    3192. 

  3192. 	my @commits = @_;
    3193. 

  3193. 	return unless @commits;
    3194. 

    3195. 

  3195. 	my @excluded;
    3196. 

  3196. 	my $excluded;
    3197. 

  3197. 	do {
    3198. 

  3198. 		my @cmd = ('rev-list', "-1", @commits, "--not", @$parents );
    3199. 

  3199. 		$excluded = command_oneline(@cmd);
    3200. 

  3200. 		if ( $excluded ) {
    3201. 

  3201. 			my @new;
    3202. 

  3202. 			my $found;
    3203. 

  3203. 			for my $commit ( @commits ) {
    3204. 

  3204. 				if ( $commit eq $excluded ) {
    3205. 

  3205. 					push @excluded, $commit;
    3206. 

  3206. 					$found++;
    3207. 

  3207. 					last;
    3208. 

  3208. 				}
    3209. 

  3209. 				else {
    3210. 

  3210. 					push @new, $commit;
    3211. 

  3211. 				}
    3212. 

  3212. 			}
    3213. 

  3213. 			die "saw commit '$excluded' in rev-list output, "
    3214. 

  3214. 				."but we didn't ask for that commit (wanted: @commits --not @$parents)"
    3215. 

  3215. 					unless $found;
    3216. 

  3216. 			@commits = @new;
    3217. 

  3217. 		}
    3218. 

  3218. 	}
    3219. 

  3219. 		while ($excluded and @commits);
    3220. 

    3221. 

  3221. 	return @excluded;
    3222. 

  3222. }
    3223. 

    3224. 

    3225. 

  3225. # note: this function should only be called if the various dirprops
    3226. 

  3226. # have actually changed
    3227. 

  3227. sub find_extra_svn_parents {
    3228. 

  3228. 	my ($self, $ed, $mergeinfo, $parents) = @_;
    3229. 

  3229. 	# aha!  svk:merge property changed...
    3230. 

    3231. 

  3231. 	memoize_svn_mergeinfo_functions();
    3232. 

    3233. 

  3233. 	# We first search for merged tips which are not in our
    3234. 

  3234. 	# history.  Then, we figure out which git revisions are in
    3235. 

  3235. 	# that tip, but not this revision.  If all of those revisions
    3236. 

  3236. 	# are now marked as merge, we can add the tip as a parent.
    3237. 

  3237. 	my @merges = split "\n", $mergeinfo;
    3238. 

  3238. 	my @merge_tips;
    3239. 

  3239. 	my $url = $self->{url};
    3240. 

  3240. 	my $uuid = $self->ra_uuid;
    3241. 

  3241. 	my %ranges;
    3242. 

  3242. 	for my $merge ( @merges ) {
    3243. 

  3243. 		my ($tip_commit, @ranges) =
    3244. 

  3244. 			lookup_svn_merge( $uuid, $url, $merge );
    3245. 

  3245. 		unless (!$tip_commit or
    3246. 

  3246. 				grep { $_ eq $tip_commit } @$parents ) {
    3247. 

  3247. 			push @merge_tips, $tip_commit;
    3248. 

  3248. 			$ranges{$tip_commit} = \@ranges;
    3249. 

  3249. 		} else {
    3250. 

  3250. 			push @merge_tips, undef;
    3251. 

  3251. 		}
    3252. 

  3252. 	}
    3253. 

    3254. 

  3254. 	my %excluded = map { $_ => 1 }
    3255. 

  3255. 		parents_exclude($parents, grep { defined } @merge_tips);
    3256. 

    3257. 

  3257. 	# check merge tips for new parents
    3258. 

  3258. 	my @new_parents;
    3259. 

  3259. 	for my $merge_tip ( @merge_tips ) {
    3260. 

  3260. 		my $spec = shift @merges;
    3261. 

  3261. 		next unless $merge_tip and $excluded{$merge_tip};
    3262. 

    3263. 

  3263. 		my $ranges = $ranges{$merge_tip};
    3264. 

    3265. 

  3265. 		# check out 'new' tips
    3266. 

  3266. 		my $merge_base;
    3267. 

  3267. 		eval {
    3268. 

  3268. 			$merge_base = command_oneline(
    3269. 

  3269. 				"merge-base",
    3270. 

  3270. 				@$parents, $merge_tip,
    3271. 

  3271. 			);
    3272. 

  3272. 		};
    3273. 

  3273. 		if ($@) {
    3274. 

  3274. 			die "An error occurred during merge-base"
    3275. 

  3275. 				unless $@->isa("Git::Error::Command");
    3276. 

    3277. 

  3277. 			warn "W: Cannot find common ancestor between ".
    3278. 

  3278. 			     "@$parents and $merge_tip. Ignoring merge info.\n";
    3279. 

  3279. 			next;
    3280. 

  3280. 		}
    3281. 

    3282. 

  3282. 		# double check that there are no missing non-merge commits
    3283. 

  3283. 		my (@incomplete) = check_cherry_pick(
    3284. 

  3284. 			$merge_base, $merge_tip,
    3285. 

  3285. 			@$ranges,
    3286. 

  3286. 		       );
    3287. 

    3288. 

  3288. 		if ( @incomplete ) {
    3289. 

  3289. 			warn "W:svn cherry-pick ignored ($spec) - missing "
    3290. 

  3290. 				.@incomplete." commit(s) (eg $incomplete[0])\n";
    3291. 

  3291. 		} else {
    3292. 

  3292. 			warn
    3293. 

  3293. 				"Found merge parent (svn:mergeinfo prop): ",
    3294. 

  3294. 					$merge_tip, "\n";
    3295. 

  3295. 			push @new_parents, $merge_tip;
    3296. 

  3296. 		}
    3297. 

  3297. 	}
    3298. 

    3299. 

  3299. 	# cater for merges which merge commits from multiple branches
    3300. 

  3300. 	if ( @new_parents > 1 ) {
    3301. 

  3301. 		for ( my $i = 0; $i <= $#new_parents; $i++ ) {
    3302. 

  3302. 			for ( my $j = 0; $j <= $#new_parents; $j++ ) {
    3303. 

  3303. 				next if $i == $j;
    3304. 

  3304. 				next unless $new_parents[$i];
    3305. 

  3305. 				next unless $new_parents[$j];
    3306. 

  3306. 				my $revs = command_oneline(
    3307. 

  3307. 					"rev-list", "-1",
    3308. 

  3308. 					"$new_parents[$i]..$new_parents[$j]",
    3309. 

  3309. 				       );
    3310. 

  3310. 				if ( !$revs ) {
    3311. 

  3311. 					undef($new_parents[$j]);
    3312. 

  3312. 				}
    3313. 

  3313. 			}
    3314. 

  3314. 		}
    3315. 

  3315. 	}
    3316. 

  3316. 	push @$parents, grep { defined } @new_parents;
    3317. 

  3317. }
    3318. 

    3319. 

  3319. sub make_log_entry {
    3320. 

  3320. 	my ($self, $rev, $parents, $ed) = @_;
    3321. 

  3321. 	my $untracked = $self->get_untracked($ed);
    3322. 

    3323. 

  3323. 	my @parents = @$parents;
    3324. 

  3324. 	my $ps = $ed->{path_strip} || "";
    3325. 

  3325. 	for my $path ( grep { m/$ps/ } %{$ed->{dir_prop}} ) {
    3326. 

  3326. 		my $props = $ed->{dir_prop}{$path};
    3327. 

  3327. 		if ( $props->{"svk:merge"} ) {
    3328. 

  3328. 			$self->find_extra_svk_parents
    3329. 

  3329. 				($ed, $props->{"svk:merge"}, \@parents);
    3330. 

  3330. 		}
    3331. 

  3331. 		if ( $props->{"svn:mergeinfo"} ) {
    3332. 

  3332. 			$self->find_extra_svn_parents
    3333. 

  3333. 				($ed,
    3334. 

  3334. 				 $props->{"svn:mergeinfo"},
    3335. 

  3335. 				 \@parents);
    3336. 

  3336. 		}
    3337. 

  3337. 	}
    3338. 

    3339. 

  3339. 	open my $un, '>>', "$self->{dir}/unhandled.log" or croak $!;
    3340. 

  3340. 	print $un "r$rev\n" or croak $!;
    3341. 

  3341. 	print $un $_, "\n" foreach @$untracked;
    3342. 

  3342. 	my %log_entry = ( parents => \@parents, revision => $rev,
    3343. 

  3343. 	                  log => '');
    3344. 

    3345. 

  3345. 	my $headrev;
    3346. 

  3346. 	my $logged = delete $self->{logged_rev_props};
    3347. 

  3347. 	if (!$logged || $self->{-want_revprops}) {
    3348. 

  3348. 		my $rp = $self->ra->rev_proplist($rev);
    3349. 

  3349. 		foreach (sort keys %$rp) {
    3350. 

  3350. 			my $v = $rp->{$_};
    3351. 

  3351. 			if (/^svn:(author|date|log)$/) {
    3352. 

  3352. 				$log_entry{$1} = $v;
    3353. 

  3353. 			} elsif ($_ eq 'svm:headrev') {
    3354. 

  3354. 				$headrev = $v;
    3355. 

  3355. 			} else {
    3356. 

  3356. 				print $un "  rev_prop: ", uri_encode($_), ' ',
    3357. 

  3357. 					  uri_encode($v), "\n";
    3358. 

  3358. 			}
    3359. 

  3359. 		}
    3360. 

  3360. 	} else {
    3361. 

  3361. 		map { $log_entry{$_} = $logged->{$_} } keys %$logged;
    3362. 

  3362. 	}
    3363. 

  3363. 	close $un or croak $!;
    3364. 

    3365. 

  3365. 	$log_entry{date} = parse_svn_date($log_entry{date});
    3366. 

  3366. 	$log_entry{log} .= "\n";
    3367. 

  3367. 	my $author = $log_entry{author} = check_author($log_entry{author});
    3368. 

  3368. 	my ($name, $email) = defined $::users{$author} ? @{$::users{$author}}
    3369. 

  3369. 						       : ($author, undef);
    3370. 

    3371. 

  3371. 	my ($commit_name, $commit_email) = ($name, $email);
    3372. 

  3372. 	if ($_use_log_author) {
    3373. 

  3373. 		my $name_field;
    3374. 

  3374. 		if ($log_entry{log} =~ /From:\s+(.*\S)\s*\n/i) {
    3375. 

  3375. 			$name_field = $1;
    3376. 

  3376. 		} elsif ($log_entry{log} =~ /Signed-off-by:\s+(.*\S)\s*\n/i) {
    3377. 

  3377. 			$name_field = $1;
    3378. 

  3378. 		}
    3379. 

  3379. 		if (!defined $name_field) {
    3380. 

  3380. 			if (!defined $email) {
    3381. 

  3381. 				$email = $name;
    3382. 

  3382. 			}
    3383. 

  3383. 		} elsif ($name_field =~ /(.*?)\s+<(.*)>/) {
    3384. 

  3384. 			($name, $email) = ($1, $2);
    3385. 

  3385. 		} elsif ($name_field =~ /(.*)@/) {
    3386. 

  3386. 			($name, $email) = ($1, $name_field);
    3387. 

  3387. 		} else {
    3388. 

  3388. 			($name, $email) = ($name_field, $name_field);
    3389. 

  3389. 		}
    3390. 

  3390. 	}
    3391. 

  3391. 	if (defined $headrev && $self->use_svm_props) {
    3392. 

  3392. 		if ($self->rewrite_root) {
    3393. 

  3393. 			die "Can't have both 'useSvmProps' and 'rewriteRoot' ",
    3394. 

  3394. 			    "options set!\n";
    3395. 

  3395. 		}
    3396. 

  3396. 		if ($self->rewrite_uuid) {
    3397. 

  3397. 			die "Can't have both 'useSvmProps' and 'rewriteUUID' ",
    3398. 

  3398. 			    "options set!\n";
    3399. 

  3399. 		}
    3400. 

  3400. 		my ($uuid, $r) = $headrev =~ m{^([a-f\d\-]{30,}):(\d+)$}i;
    3401. 

  3401. 		# we don't want "SVM: initializing mirror for junk" ...
    3402. 

  3402. 		return undef if $r == 0;
    3403. 

  3403. 		my $svm = $self->svm;
    3404. 

  3404. 		if ($uuid ne $svm->{uuid}) {
    3405. 

  3405. 			die "UUID mismatch on SVM path:\n",
    3406. 

  3406. 			    "expected: $svm->{uuid}\n",
    3407. 

  3407. 			    "     got: $uuid\n";
    3408. 

  3408. 		}
    3409. 

  3409. 		my $full_url = $self->full_url;
    3410. 

  3410. 		$full_url =~ s#^\Q$svm->{replace}\E(/|$)#$svm->{source}$1# or
    3411. 

  3411. 		             die "Failed to replace '$svm->{replace}' with ",
    3412. 

  3412. 		                 "'$svm->{source}' in $full_url\n";
    3413. 

  3413. 		# throw away username for storing in records
    3414. 

  3414. 		remove_username($full_url);
    3415. 

  3415. 		$log_entry{metadata} = "$full_url\@$r $uuid";
    3416. 

  3416. 		$log_entry{svm_revision} = $r;
    3417. 

  3417. 		$email ||= "$author\@$uuid";
    3418. 

  3418. 		$commit_email ||= "$author\@$uuid";
    3419. 

  3419. 	} elsif ($self->use_svnsync_props) {
    3420. 

  3420. 		my $full_url = $self->svnsync->{url};
    3421. 

  3421. 		$full_url .= "/$self->{path}" if length $self->{path};
    3422. 

  3422. 		remove_username($full_url);
    3423. 

  3423. 		my $uuid = $self->svnsync->{uuid};
    3424. 

  3424. 		$log_entry{metadata} = "$full_url\@$rev $uuid";
    3425. 

  3425. 		$email ||= "$author\@$uuid";
    3426. 

  3426. 		$commit_email ||= "$author\@$uuid";
    3427. 

  3427. 	} else {
    3428. 

  3428. 		my $url = $self->metadata_url;
    3429. 

  3429. 		remove_username($url);
    3430. 

  3430. 		my $uuid = $self->rewrite_uuid || $self->ra->get_uuid;
    3431. 

  3431. 		$log_entry{metadata} = "$url\@$rev " . $uuid;
    3432. 

  3432. 		$email ||= "$author\@" . $uuid;
    3433. 

  3433. 		$commit_email ||= "$author\@" . $uuid;
    3434. 

  3434. 	}
    3435. 

  3435. 	$log_entry{name} = $name;
    3436. 

  3436. 	$log_entry{email} = $email;
    3437. 

  3437. 	$log_entry{commit_name} = $commit_name;
    3438. 

  3438. 	$log_entry{commit_email} = $commit_email;
    3439. 

  3439. 	\%log_entry;
    3440. 

  3440. }
    3441. 

    3442. 

  3442. sub fetch {
    3443. 

  3443. 	my ($self, $min_rev, $max_rev, @parents) = @_;
    3444. 

  3444. 	my ($last_rev, $last_commit) = $self->last_rev_commit;
    3445. 

  3445. 	my ($base, $head) = $self->get_fetch_range($min_rev, $max_rev);
    3446. 

  3446. 	$self->ra->gs_fetch_loop_common($base, $head, [$self]);
    3447. 

  3447. }
    3448. 

    3449. 

  3449. sub set_tree_cb {
    3450. 

  3450. 	my ($self, $log_entry, $tree, $rev, $date, $author) = @_;
    3451. 

  3451. 	$self->{inject_parents} = { $rev => $tree };
    3452. 

  3452. 	$self->fetch(undef, undef);
    3453. 

  3453. }
    3454. 

    3455. 

  3455. sub set_tree {
    3456. 

  3456. 	my ($self, $tree) = (shift, shift);
    3457. 

  3457. 	my $log_entry = ::get_commit_entry($tree);
    3458. 

  3458. 	unless ($self->{last_rev}) {
    3459. 

  3459. 		::fatal("Must have an existing revision to commit");
    3460. 

  3460. 	}
    3461. 

  3461. 	my %ed_opts = ( r => $self->{last_rev},
    3462. 

  3462. 	                log => $log_entry->{log},
    3463. 

  3463. 	                ra => $self->ra,
    3464. 

  3464. 	                tree_a => $self->{last_commit},
    3465. 

  3465. 	                tree_b => $tree,
    3466. 

  3466. 	                editor_cb => sub {
    3467. 

  3467. 			       $self->set_tree_cb($log_entry, $tree, @_) },
    3468. 

  3468. 	                svn_path => $self->{path} );
    3469. 

  3469. 	if (!SVN::Git::Editor->new(\%ed_opts)->apply_diff) {
    3470. 

  3470. 		print "No changes\nr$self->{last_rev} = $tree\n";
    3471. 

  3471. 	}
    3472. 

  3472. }
    3473. 

    3474. 

  3474. sub rebuild_from_rev_db {
    3475. 

  3475. 	my ($self, $path) = @_;
    3476. 

  3476. 	my $r = -1;
    3477. 

  3477. 	open my $fh, '<', $path or croak "open: $!";
    3478. 

  3478. 	binmode $fh or croak "binmode: $!";
    3479. 

  3479. 	while (<$fh>) {
    3480. 

  3480. 		length($_) == 41 or croak "inconsistent size in ($_) != 41";
    3481. 

  3481. 		chomp($_);
    3482. 

  3482. 		++$r;
    3483. 

  3483. 		next if $_ eq ('0' x 40);
    3484. 

  3484. 		$self->rev_map_set($r, $_);
    3485. 

  3485. 		print "r$r = $_\n";
    3486. 

  3486. 	}
    3487. 

  3487. 	close $fh or croak "close: $!";
    3488. 

  3488. 	unlink $path or croak "unlink: $!";
    3489. 

  3489. }
    3490. 

    3491. 

  3491. sub rebuild {
    3492. 

  3492. 	my ($self) = @_;
    3493. 

  3493. 	my $map_path = $self->map_path;
    3494. 

  3494. 	my $partial = (-e $map_path && ! -z $map_path);
    3495. 

  3495. 	return unless ::verify_ref($self->refname.'^0');
    3496. 

  3496. 	if (!$partial && ($self->use_svm_props || $self->no_metadata)) {
    3497. 

  3497. 		my $rev_db = $self->rev_db_path;
    3498. 

  3498. 		$self->rebuild_from_rev_db($rev_db);
    3499. 

  3499. 		if ($self->use_svm_props) {
    3500. 

  3500. 			my $svm_rev_db = $self->rev_db_path($self->svm_uuid);
    3501. 

  3501. 			$self->rebuild_from_rev_db($svm_rev_db);
    3502. 

  3502. 		}
    3503. 

  3503. 		$self->unlink_rev_db_symlink;
    3504. 

  3504. 		return;
    3505. 

  3505. 	}
    3506. 

  3506. 	print "Rebuilding $map_path ...\n" if (!$partial);
    3507. 

  3507. 	my ($base_rev, $head) = ($partial ? $self->rev_map_max_norebuild(1) :
    3508. 

  3508. 		(undef, undef));
    3509. 

  3509. 	my ($log, $ctx) =
    3510. 

  3510. 	    command_output_pipe(qw/rev-list --pretty=raw --no-color --reverse/,
    3511. 

  3511. 				($head ? "$head.." : "") . $self->refname,
    3512. 

  3512. 				'--');
    3513. 

  3513. 	my $metadata_url = $self->metadata_url;
    3514. 

  3514. 	remove_username($metadata_url);
    3515. 

  3515. 	my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid;
    3516. 

  3516. 	my $c;
    3517. 

  3517. 	while (<$log>) {
    3518. 

  3518. 		if ( m{^commit ($::sha1)$} ) {
    3519. 

  3519. 			$c = $1;
    3520. 

  3520. 			next;
    3521. 

  3521. 		}
    3522. 

  3522. 		next unless s{^\s*(git-svn-id:)}{$1};
    3523. 

  3523. 		my ($url, $rev, $uuid) = ::extract_metadata($_);
    3524. 

  3524. 		remove_username($url);
    3525. 

    3526. 

  3526. 		# ignore merges (from set-tree)
    3527. 

  3527. 		next if (!defined $rev || !$uuid);
    3528. 

    3529. 

  3529. 		# if we merged or otherwise started elsewhere, this is
    3530. 

  3530. 		# how we break out of it
    3531. 

  3531. 		if (($uuid ne $svn_uuid) ||
    3532. 

  3532. 		    ($metadata_url && $url && ($url ne $metadata_url))) {
    3533. 

  3533. 			next;
    3534. 

  3534. 		}
    3535. 

  3535. 		if ($partial && $head) {
    3536. 

  3536. 			print "Partial-rebuilding $map_path ...\n";
    3537. 

  3537. 			print "Currently at $base_rev = $head\n";
    3538. 

  3538. 			$head = undef;
    3539. 

  3539. 		}
    3540. 

    3541. 

  3541. 		$self->rev_map_set($rev, $c);
    3542. 

  3542. 		print "r$rev = $c\n";
    3543. 

  3543. 	}
    3544. 

  3544. 	command_close_pipe($log, $ctx);
    3545. 

  3545. 	print "Done rebuilding $map_path\n" if (!$partial || !$head);
    3546. 

  3546. 	my $rev_db_path = $self->rev_db_path;
    3547. 

  3547. 	if (-f $self->rev_db_path) {
    3548. 

  3548. 		unlink $self->rev_db_path or croak "unlink: $!";
    3549. 

  3549. 	}
    3550. 

  3550. 	$self->unlink_rev_db_symlink;
    3551. 

  3551. }
    3552. 

    3553. 

  3553. # rev_map:
    3554. 

  3554. # Tie::File seems to be prone to offset errors if revisions get sparse,
    3555. 

  3555. # it's not that fast, either.  Tie::File is also not in Perl 5.6.  So
    3556. 

  3556. # one of my favorite modules is out :<  Next up would be one of the DBM
    3557. 

  3557. # modules, but I'm not sure which is most portable...
    3558. 

  3558. #
    3559. 

  3559. # This is the replacement for the rev_db format, which was too big
    3560. 

  3560. # and inefficient for large repositories with a lot of sparse history
    3561. 

  3561. # (mainly tags)
    3562. 

  3562. #
    3563. 

  3563. # The format is this:
    3564. 

  3564. #   - 24 bytes for every record,
    3565. 

  3565. #     * 4 bytes for the integer representing an SVN revision number
    3566. 

  3566. #     * 20 bytes representing the sha1 of a git commit
    3567. 

  3567. #   - No empty padding records like the old format
    3568. 

  3568. #     (except the last record, which can be overwritten)
    3569. 

  3569. #   - new records are written append-only since SVN revision numbers
    3570. 

  3570. #     increase monotonically
    3571. 

  3571. #   - lookups on SVN revision number are done via a binary search
    3572. 

  3572. #   - Piping the file to xxd -c24 is a good way of dumping it for
    3573. 

  3573. #     viewing or editing (piped back through xxd -r), should the need
    3574. 

  3574. #     ever arise.
    3575. 

  3575. #   - The last record can be padding revision with an all-zero sha1
    3576. 

  3576. #     This is used to optimize fetch performance when using multiple
    3577. 

  3577. #     "fetch" directives in .git/config
    3578. 

  3578. #
    3579. 

  3579. # These files are disposable unless noMetadata or useSvmProps is set
    3580. 

    3581. 

  3581. sub _rev_map_set {
    3582. 

  3582. 	my ($fh, $rev, $commit) = @_;
    3583. 

    3584. 

  3584. 	binmode $fh or croak "binmode: $!";
    3585. 

  3585. 	my $size = (stat($fh))[7];
    3586. 

  3586. 	($size % 24) == 0 or croak "inconsistent size: $size";
    3587. 

    3588. 

  3588. 	my $wr_offset = 0;
    3589. 

  3589. 	if ($size > 0) {
    3590. 

  3590. 		sysseek($fh, -24, SEEK_END) or croak "seek: $!";
    3591. 

  3591. 		my $read = sysread($fh, my $buf, 24) or croak "read: $!";
    3592. 

  3592. 		$read == 24 or croak "read only $read bytes (!= 24)";
    3593. 

  3593. 		my ($last_rev, $last_commit) = unpack(rev_map_fmt, $buf);
    3594. 

  3594. 		if ($last_commit eq ('0' x40)) {
    3595. 

  3595. 			if ($size >= 48) {
    3596. 

  3596. 				sysseek($fh, -48, SEEK_END) or croak "seek: $!";
    3597. 

  3597. 				$read = sysread($fh, $buf, 24) or
    3598. 

  3598. 				    croak "read: $!";
    3599. 

  3599. 				$read == 24 or
    3600. 

  3600. 				    croak "read only $read bytes (!= 24)";
    3601. 

  3601. 				($last_rev, $last_commit) =
    3602. 

  3602. 				    unpack(rev_map_fmt, $buf);
    3603. 

  3603. 				if ($last_commit eq ('0' x40)) {
    3604. 

  3604. 					croak "inconsistent .rev_map\n";
    3605. 

  3605. 				}
    3606. 

  3606. 			}
    3607. 

  3607. 			if ($last_rev >= $rev) {
    3608. 

  3608. 				croak "last_rev is higher!: $last_rev >= $rev";
    3609. 

  3609. 			}
    3610. 

  3610. 			$wr_offset = -24;
    3611. 

  3611. 		}
    3612. 

  3612. 	}
    3613. 

  3613. 	sysseek($fh, $wr_offset, SEEK_END) or croak "seek: $!";
    3614. 

  3614. 	syswrite($fh, pack(rev_map_fmt, $rev, $commit), 24) == 24 or
    3615. 

  3615. 	  croak "write: $!";
    3616. 

  3616. }
    3617. 

    3618. 

  3618. sub _rev_map_reset {
    3619. 

  3619. 	my ($fh, $rev, $commit) = @_;
    3620. 

  3620. 	my $c = _rev_map_get($fh, $rev);
    3621. 

  3621. 	$c eq $commit or die "_rev_map_reset(@_) commit $c does not match!\n";
    3622. 

  3622. 	my $offset = sysseek($fh, 0, SEEK_CUR) or croak "seek: $!";
    3623. 

  3623. 	truncate $fh, $offset or croak "truncate: $!";
    3624. 

  3624. }
    3625. 

    3626. 

  3626. sub mkfile {
    3627. 

  3627. 	my ($path) = @_;
    3628. 

  3628. 	unless (-e $path) {
    3629. 

  3629. 		my ($dir, $base) = ($path =~ m#^(.*?)/?([^/]+)$#);
    3630. 

  3630. 		mkpath([$dir]) unless -d $dir;
    3631. 

  3631. 		open my $fh, '>>', $path or die "Couldn't create $path: $!\n";
    3632. 

  3632. 		close $fh or die "Couldn't close (create) $path: $!\n";
    3633. 

  3633. 	}
    3634. 

  3634. }
    3635. 

    3636. 

  3636. sub rev_map_set {
    3637. 

  3637. 	my ($self, $rev, $commit, $update_ref, $uuid) = @_;
    3638. 

  3638. 	defined $commit or die "missing arg3\n";
    3639. 

  3639. 	length $commit == 40 or die "arg3 must be a full SHA1 hexsum\n";
    3640. 

  3640. 	my $db = $self->map_path($uuid);
    3641. 

  3641. 	my $db_lock = "$db.lock";
    3642. 

  3642. 	my $sig;
    3643. 

  3643. 	$update_ref ||= 0;
    3644. 

  3644. 	if ($update_ref) {
    3645. 

  3645. 		$SIG{INT} = $SIG{HUP} = $SIG{TERM} = $SIG{ALRM} = $SIG{PIPE} =
    3646. 

  3646. 		            $SIG{USR1} = $SIG{USR2} = sub { $sig = $_[0] };
    3647. 

  3647. 	}
    3648. 

  3648. 	mkfile($db);
    3649. 

    3650. 

  3650. 	$LOCKFILES{$db_lock} = 1;
    3651. 

  3651. 	my $sync;
    3652. 

  3652. 	# both of these options make our .rev_db file very, very important
    3653. 

  3653. 	# and we can't afford to lose it because rebuild() won't work
    3654. 

  3654. 	if ($self->use_svm_props || $self->no_metadata) {
    3655. 

  3655. 		$sync = 1;
    3656. 

  3656. 		copy($db, $db_lock) or die "rev_map_set(@_): ",
    3657. 

  3657. 					   "Failed to copy: ",
    3658. 

  3658. 					   "$db => $db_lock ($!)\n";
    3659. 

  3659. 	} else {
    3660. 

  3660. 		rename $db, $db_lock or die "rev_map_set(@_): ",
    3661. 

  3661. 					    "Failed to rename: ",
    3662. 

  3662. 					    "$db => $db_lock ($!)\n";
    3663. 

  3663. 	}
    3664. 

    3665. 

  3665. 	sysopen(my $fh, $db_lock, O_RDWR | O_CREAT)
    3666. 

  3666. 	     or croak "Couldn't open $db_lock: $!\n";
    3667. 

  3667. 	$update_ref eq 'reset' ? _rev_map_reset($fh, $rev, $commit) :
    3668. 

  3668. 				 _rev_map_set($fh, $rev, $commit);
    3669. 

  3669. 	if ($sync) {
    3670. 

  3670. 		$fh->flush or die "Couldn't flush $db_lock: $!\n";
    3671. 

  3671. 		$fh->sync or die "Couldn't sync $db_lock: $!\n";
    3672. 

  3672. 	}
    3673. 

  3673. 	close $fh or croak $!;
    3674. 

  3674. 	if ($update_ref) {
    3675. 

  3675. 		$_head = $self;
    3676. 

  3676. 		my $note = "";
    3677. 

  3677. 		$note = " ($update_ref)" if ($update_ref !~ /^\d*$/);
    3678. 

  3678. 		command_noisy('update-ref', '-m', "r$rev$note",
    3679. 

  3679. 		              $self->refname, $commit);
    3680. 

  3680. 	}
    3681. 

  3681. 	rename $db_lock, $db or die "rev_map_set(@_): ", "Failed to rename: ",
    3682. 

  3682. 	                            "$db_lock => $db ($!)\n";
    3683. 

  3683. 	delete $LOCKFILES{$db_lock};
    3684. 

  3684. 	if ($update_ref) {
    3685. 

  3685. 		$SIG{INT} = $SIG{HUP} = $SIG{TERM} = $SIG{ALRM} = $SIG{PIPE} =
    3686. 

  3686. 		            $SIG{USR1} = $SIG{USR2} = 'DEFAULT';
    3687. 

  3687. 		kill $sig, $$ if defined $sig;
    3688. 

  3688. 	}
    3689. 

  3689. }
    3690. 

    3691. 

  3691. # If want_commit, this will return an array of (rev, commit) where
    3692. 

  3692. # commit _must_ be a valid commit in the archive.
    3693. 

  3693. # Otherwise, it'll return the max revision (whether or not the
    3694. 

  3694. # commit is valid or just a 0x40 placeholder).
    3695. 

  3695. sub rev_map_max {
    3696. 

  3696. 	my ($self, $want_commit) = @_;
    3697. 

  3697. 	$self->rebuild;
    3698. 

  3698. 	my ($r, $c) = $self->rev_map_max_norebuild($want_commit);
    3699. 

  3699. 	$want_commit ? ($r, $c) : $r;
    3700. 

  3700. }
    3701. 

    3702. 

  3702. sub rev_map_max_norebuild {
    3703. 

  3703. 	my ($self, $want_commit) = @_;
    3704. 

  3704. 	my $map_path = $self->map_path;
    3705. 

  3705. 	stat $map_path or return $want_commit ? (0, undef) : 0;
    3706. 

  3706. 	sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!";
    3707. 

  3707. 	binmode $fh or croak "binmode: $!";
    3708. 

  3708. 	my $size = (stat($fh))[7];
    3709. 

  3709. 	($size % 24) == 0 or croak "inconsistent size: $size";
    3710. 

    3711. 

  3711. 	if ($size == 0) {
    3712. 

  3712. 		close $fh or croak "close: $!";
    3713. 

  3713. 		return $want_commit ? (0, undef) : 0;
    3714. 

  3714. 	}
    3715. 

    3716. 

  3716. 	sysseek($fh, -24, SEEK_END) or croak "seek: $!";
    3717. 

  3717. 	sysread($fh, my $buf, 24) == 24 or croak "read: $!";
    3718. 

  3718. 	my ($r, $c) = unpack(rev_map_fmt, $buf);
    3719. 

  3719. 	if ($want_commit && $c eq ('0' x40)) {
    3720. 

  3720. 		if ($size < 48) {
    3721. 

  3721. 			return $want_commit ? (0, undef) : 0;
    3722. 

  3722. 		}
    3723. 

  3723. 		sysseek($fh, -48, SEEK_END) or croak "seek: $!";
    3724. 

  3724. 		sysread($fh, $buf, 24) == 24 or croak "read: $!";
    3725. 

  3725. 		($r, $c) = unpack(rev_map_fmt, $buf);
    3726. 

  3726. 		if ($c eq ('0'x40)) {
    3727. 

  3727. 			croak "Penultimate record is all-zeroes in $map_path";
    3728. 

  3728. 		}
    3729. 

  3729. 	}
    3730. 

  3730. 	close $fh or croak "close: $!";
    3731. 

  3731. 	$want_commit ? ($r, $c) : $r;
    3732. 

  3732. }
    3733. 

    3734. 

  3734. sub rev_map_get {
    3735. 

  3735. 	my ($self, $rev, $uuid) = @_;
    3736. 

  3736. 	my $map_path = $self->map_path($uuid);
    3737. 

  3737. 	return undef unless -e $map_path;
    3738. 

    3739. 

  3739. 	sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!";
    3740. 

  3740. 	my $c = _rev_map_get($fh, $rev);
    3741. 

  3741. 	close($fh) or croak "close: $!";
    3742. 

  3742. 	$c
    3743. 

  3743. }
    3744. 

    3745. 

  3745. sub _rev_map_get {
    3746. 

  3746. 	my ($fh, $rev) = @_;
    3747. 

    3748. 

  3748. 	binmode $fh or croak "binmode: $!";
    3749. 

  3749. 	my $size = (stat($fh))[7];
    3750. 

  3750. 	($size % 24) == 0 or croak "inconsistent size: $size";
    3751. 

    3752. 

  3752. 	if ($size == 0) {
    3753. 

  3753. 		return undef;
    3754. 

  3754. 	}
    3755. 

    3756. 

  3756. 	my ($l, $u) = (0, $size - 24);
    3757. 

  3757. 	my ($r, $c, $buf);
    3758. 

    3759. 

  3759. 	while ($l <= $u) {
    3760. 

  3760. 		my $i = int(($l/24 + $u/24) / 2) * 24;
    3761. 

  3761. 		sysseek($fh, $i, SEEK_SET) or croak "seek: $!";
    3762. 

  3762. 		sysread($fh, my $buf, 24) == 24 or croak "read: $!";
    3763. 

  3763. 		my ($r, $c) = unpack(rev_map_fmt, $buf);
    3764. 

    3765. 

  3765. 		if ($r < $rev) {
    3766. 

  3766. 			$l = $i + 24;
    3767. 

  3767. 		} elsif ($r > $rev) {
    3768. 

  3768. 			$u = $i - 24;
    3769. 

  3769. 		} else { # $r == $rev
    3770. 

  3770. 			return $c eq ('0' x 40) ? undef : $c;
    3771. 

  3771. 		}
    3772. 

  3772. 	}
    3773. 

  3773. 	undef;
    3774. 

  3774. }
    3775. 

    3776. 

  3776. # Finds the first svn revision that exists on (if $eq_ok is true) or
    3777. 

  3777. # before $rev for the current branch.  It will not search any lower
    3778. 

  3778. # than $min_rev.  Returns the git commit hash and svn revision number
    3779. 

  3779. # if found, else (undef, undef).
    3780. 

  3780. sub find_rev_before {
    3781. 

  3781. 	my ($self, $rev, $eq_ok, $min_rev) = @_;
    3782. 

  3782. 	--$rev unless $eq_ok;
    3783. 

  3783. 	$min_rev ||= 1;
    3784. 

  3784. 	my $max_rev = $self->rev_map_max;
    3785. 

  3785. 	$rev = $max_rev if ($rev > $max_rev);
    3786. 

  3786. 	while ($rev >= $min_rev) {
    3787. 

  3787. 		if (my $c = $self->rev_map_get($rev)) {
    3788. 

  3788. 			return ($rev, $c);
    3789. 

  3789. 		}
    3790. 

  3790. 		--$rev;
    3791. 

  3791. 	}
    3792. 

  3792. 	return (undef, undef);
    3793. 

  3793. }
    3794. 

    3795. 

  3795. # Finds the first svn revision that exists on (if $eq_ok is true) or
    3796. 

  3796. # after $rev for the current branch.  It will not search any higher
    3797. 

  3797. # than $max_rev.  Returns the git commit hash and svn revision number
    3798. 

  3798. # if found, else (undef, undef).
    3799. 

  3799. sub find_rev_after {
    3800. 

  3800. 	my ($self, $rev, $eq_ok, $max_rev) = @_;
    3801. 

  3801. 	++$rev unless $eq_ok;
    3802. 

  3802. 	$max_rev ||= $self->rev_map_max;
    3803. 

  3803. 	while ($rev <= $max_rev) {
    3804. 

  3804. 		if (my $c = $self->rev_map_get($rev)) {
    3805. 

  3805. 			return ($rev, $c);
    3806. 

  3806. 		}
    3807. 

  3807. 		++$rev;
    3808. 

  3808. 	}
    3809. 

  3809. 	return (undef, undef);
    3810. 

  3810. }
    3811. 

    3812. 

  3812. sub _new {
    3813. 

  3813. 	my ($class, $repo_id, $ref_id, $path) = @_;
    3814. 

  3814. 	unless (defined $repo_id && length $repo_id) {
    3815. 

  3815. 		$repo_id = $Git::SVN::default_repo_id;
    3816. 

  3816. 	}
    3817. 

  3817. 	unless (defined $ref_id && length $ref_id) {
    3818. 

  3818. 		$_prefix = '' unless defined($_prefix);
    3819. 

  3819. 		$_[2] = $ref_id =
    3820. 

  3820. 		             "refs/remotes/$_prefix$Git::SVN::default_ref_id";
    3821. 

  3821. 	}
    3822. 

  3822. 	$_[1] = $repo_id;
    3823. 

  3823. 	my $dir = "$ENV{GIT_DIR}/svn/$ref_id";
    3824. 

    3825. 

  3825. 	# Older repos imported by us used $GIT_DIR/svn/foo instead of
    3826. 

  3826. 	# $GIT_DIR/svn/refs/remotes/foo when tracking refs/remotes/foo
    3827. 

  3827. 	if ($ref_id =~ m{^refs/remotes/(.*)}) {
    3828. 

  3828. 		my $old_dir = "$ENV{GIT_DIR}/svn/$1";
    3829. 

  3829. 		if (-d $old_dir && ! -d $dir) {
    3830. 

  3830. 			$dir = $old_dir;
    3831. 

  3831. 		}
    3832. 

  3832. 	}
    3833. 

    3834. 

  3834. 	$_[3] = $path = '' unless (defined $path);
    3835. 

  3835. 	mkpath([$dir]);
    3836. 

  3836. 	bless {
    3837. 

  3837. 		ref_id => $ref_id, dir => $dir, index => "$dir/index",
    3838. 

  3838. 	        path => $path, config => "$ENV{GIT_DIR}/svn/config",
    3839. 

  3839. 	        map_root => "$dir/.rev_map", repo_id => $repo_id }, $class;
    3840. 

  3840. }
    3841. 

    3842. 

  3842. # for read-only access of old .rev_db formats
    3843. 

  3843. sub unlink_rev_db_symlink {
    3844. 

  3844. 	my ($self) = @_;
    3845. 

  3845. 	my $link = $self->rev_db_path;
    3846. 

  3846. 	$link =~ s/\.[\w-]+$// or croak "missing UUID at the end of $link";
    3847. 

  3847. 	if (-l $link) {
    3848. 

  3848. 		unlink $link or croak "unlink: $link failed!";
    3849. 

  3849. 	}
    3850. 

  3850. }
    3851. 

    3852. 

  3852. sub rev_db_path {
    3853. 

  3853. 	my ($self, $uuid) = @_;
    3854. 

  3854. 	my $db_path = $self->map_path($uuid);
    3855. 

  3855. 	$db_path =~ s{/\.rev_map\.}{/\.rev_db\.}
    3856. 

  3856. 	    or croak "map_path: $db_path does not contain '/.rev_map.' !";
    3857. 

  3857. 	$db_path;
    3858. 

  3858. }
    3859. 

    3860. 

  3860. # the new replacement for .rev_db
    3861. 

  3861. sub map_path {
    3862. 

  3862. 	my ($self, $uuid) = @_;
    3863. 

  3863. 	$uuid ||= $self->ra_uuid;
    3864. 

  3864. 	"$self->{map_root}.$uuid";
    3865. 

  3865. }
    3866. 

    3867. 

  3867. sub uri_encode {
    3868. 

  3868. 	my ($f) = @_;
    3869. 

  3869. 	$f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg;
    3870. 

  3870. 	$f
    3871. 

  3871. }
    3872. 

    3873. 

  3873. sub uri_decode {
    3874. 

  3874. 	my ($f) = @_;
    3875. 

  3875. 	$f =~ s#%([0-9a-fA-F]{2})#chr(hex($1))#eg;
    3876. 

  3876. 	$f
    3877. 

  3877. }
    3878. 

    3879. 

  3879. sub remove_username {
    3880. 

  3880. 	$_[0] =~ s{^([^:]*://)[^@]+@}{$1};
    3881. 

  3881. }
    3882. 

    3883. 

  3883. package Git::SVN::Prompt;
    3884. 

  3884. use strict;
    3885. 

  3885. use warnings;
    3886. 

  3886. require SVN::Core;
    3887. 

  3887. use vars qw/$_no_auth_cache $_username/;
    3888. 

    3889. 

  3889. sub simple {
    3890. 

  3890. 	my ($cred, $realm, $default_username, $may_save, $pool) = @_;
    3891. 

  3891. 	$may_save = undef if $_no_auth_cache;
    3892. 

  3892. 	$default_username = $_username if defined $_username;
    3893. 

  3893. 	if (defined $default_username && length $default_username) {
    3894. 

  3894. 		if (defined $realm && length $realm) {
    3895. 

  3895. 			print STDERR "Authentication realm: $realm\n";
    3896. 

  3896. 			STDERR->flush;
    3897. 

  3897. 		}
    3898. 

  3898. 		$cred->username($default_username);
    3899. 

  3899. 	} else {
    3900. 

  3900. 		username($cred, $realm, $may_save, $pool);
    3901. 

  3901. 	}
    3902. 

  3902. 	$cred->password(_read_password("Password for '" .
    3903. 

  3903. 	                               $cred->username . "': ", $realm));
    3904. 

  3904. 	$cred->may_save($may_save);
    3905. 

  3905. 	$SVN::_Core::SVN_NO_ERROR;
    3906. 

  3906. }
    3907. 

    3908. 

  3908. sub ssl_server_trust {
    3909. 

  3909. 	my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
    3910. 

  3910. 	$may_save = undef if $_no_auth_cache;
    3911. 

  3911. 	print STDERR "Error validating server certificate for '$realm':\n";
    3912. 

  3912. 	{
    3913. 

  3913. 		no warnings 'once';
    3914. 

  3914. 		# All variables SVN::Auth::SSL::* are used only once,
    3915. 

  3915. 		# so we're shutting up Perl warnings about this.
    3916. 

  3916. 		if ($failures & $SVN::Auth::SSL::UNKNOWNCA) {
    3917. 

  3917. 			print STDERR " - The certificate is not issued ",
    3918. 

  3918. 			    "by a trusted authority. Use the\n",
    3919. 

  3919. 			    "   fingerprint to validate ",
    3920. 

  3920. 			    "the certificate manually!\n";
    3921. 

  3921. 		}
    3922. 

  3922. 		if ($failures & $SVN::Auth::SSL::CNMISMATCH) {
    3923. 

  3923. 			print STDERR " - The certificate hostname ",
    3924. 

  3924. 			    "does not match.\n";
    3925. 

  3925. 		}
    3926. 

  3926. 		if ($failures & $SVN::Auth::SSL::NOTYETVALID) {
    3927. 

  3927. 			print STDERR " - The certificate is not yet valid.\n";
    3928. 

  3928. 		}
    3929. 

  3929. 		if ($failures & $SVN::Auth::SSL::EXPIRED) {
    3930. 

  3930. 			print STDERR " - The certificate has expired.\n";
    3931. 

  3931. 		}
    3932. 

  3932. 		if ($failures & $SVN::Auth::SSL::OTHER) {
    3933. 

  3933. 			print STDERR " - The certificate has ",
    3934. 

  3934. 			    "an unknown error.\n";
    3935. 

  3935. 		}
    3936. 

  3936. 	} # no warnings 'once'
    3937. 

  3937. 	printf STDERR
    3938. 

  3938. 	        "Certificate information:\n".
    3939. 

  3939. 	        " - Hostname: %s\n".
    3940. 

  3940. 	        " - Valid: from %s until %s\n".
    3941. 

  3941. 	        " - Issuer: %s\n".
    3942. 

  3942. 	        " - Fingerprint: %s\n",
    3943. 

  3943. 	        map $cert_info->$_, qw(hostname valid_from valid_until
    3944. 

  3944. 	                               issuer_dname fingerprint);
    3945. 

  3945. 	my $choice;
    3946. 

  3946. prompt:
    3947. 

  3947. 	print STDERR $may_save ?
    3948. 

  3948. 	      "(R)eject, accept (t)emporarily or accept (p)ermanently? " :
    3949. 

  3949. 	      "(R)eject or accept (t)emporarily? ";
    3950. 

  3950. 	STDERR->flush;
    3951. 

  3951. 	$choice = lc(substr(<STDIN> || 'R', 0, 1));
    3952. 

  3952. 	if ($choice =~ /^t$/i) {
    3953. 

  3953. 		$cred->may_save(undef);
    3954. 

  3954. 	} elsif ($choice =~ /^r$/i) {
    3955. 

  3955. 		return -1;
    3956. 

  3956. 	} elsif ($may_save && $choice =~ /^p$/i) {
    3957. 

  3957. 		$cred->may_save($may_save);
    3958. 

  3958. 	} else {
    3959. 

  3959. 		goto prompt;
    3960. 

  3960. 	}
    3961. 

  3961. 	$cred->accepted_failures($failures);
    3962. 

  3962. 	$SVN::_Core::SVN_NO_ERROR;
    3963. 

  3963. }
    3964. 

    3965. 

  3965. sub ssl_client_cert {
    3966. 

  3966. 	my ($cred, $realm, $may_save, $pool) = @_;
    3967. 

  3967. 	$may_save = undef if $_no_auth_cache;
    3968. 

  3968. 	print STDERR "Client certificate filename: ";
    3969. 

  3969. 	STDERR->flush;
    3970. 

  3970. 	chomp(my $filename = <STDIN>);
    3971. 

  3971. 	$cred->cert_file($filename);
    3972. 

  3972. 	$cred->may_save($may_save);
    3973. 

  3973. 	$SVN::_Core::SVN_NO_ERROR;
    3974. 

  3974. }
    3975. 

    3976. 

  3976. sub ssl_client_cert_pw {
    3977. 

  3977. 	my ($cred, $realm, $may_save, $pool) = @_;
    3978. 

  3978. 	$may_save = undef if $_no_auth_cache;
    3979. 

  3979. 	$cred->password(_read_password("Password: ", $realm));
    3980. 

  3980. 	$cred->may_save($may_save);
    3981. 

  3981. 	$SVN::_Core::SVN_NO_ERROR;
    3982. 

  3982. }
    3983. 

    3984. 

  3984. sub username {
    3985. 

  3985. 	my ($cred, $realm, $may_save, $pool) = @_;
    3986. 

  3986. 	$may_save = undef if $_no_auth_cache;
    3987. 

  3987. 	if (defined $realm && length $realm) {
    3988. 

  3988. 		print STDERR "Authentication realm: $realm\n";
    3989. 

  3989. 	}
    3990. 

  3990. 	my $username;
    3991. 

  3991. 	if (defined $_username) {
    3992. 

  3992. 		$username = $_username;
    3993. 

  3993. 	} else {
    3994. 

  3994. 		print STDERR "Username: ";
    3995. 

  3995. 		STDERR->flush;
    3996. 

  3996. 		chomp($username = <STDIN>);
    3997. 

  3997. 	}
    3998. 

  3998. 	$cred->username($username);
    3999. 

  3999. 	$cred->may_save($may_save);
    4000. 

  4000. 	$SVN::_Core::SVN_NO_ERROR;
    4001. 

  4001. }
    4002. 

    4003. 

  4003. sub _read_password {
    4004. 

  4004. 	my ($prompt, $realm) = @_;
    4005. 

  4005. 	my $password = '';
    4006. 

  4006. 	if (exists $ENV{GIT_ASKPASS}) {
    4007. 

  4007. 		open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt);
    4008. 

  4008. 		$password = <PH>;
    4009. 

  4009. 		$password =~ s/[\012\015]//; # \n\r
    4010. 

  4010. 		close(PH);
    4011. 

  4011. 	} else {
    4012. 

  4012. 		print STDERR $prompt;
    4013. 

  4013. 		STDERR->flush;
    4014. 

  4014. 		require Term::ReadKey;
    4015. 

  4015. 		Term::ReadKey::ReadMode('noecho');
    4016. 

  4016. 		while (defined(my $key = Term::ReadKey::ReadKey(0))) {
    4017. 

  4017. 			last if $key =~ /[\012\015]/; # \n\r
    4018. 

  4018. 			$password .= $key;
    4019. 

  4019. 		}
    4020. 

  4020. 		Term::ReadKey::ReadMode('restore');
    4021. 

  4021. 		print STDERR "\n";
    4022. 

  4022. 		STDERR->flush;
    4023. 

  4023. 	}
    4024. 

  4024. 	$password;
    4025. 

  4025. }
    4026. 

    4027. 

  4027. package SVN::Git::Fetcher;
    4028. 

  4028. use vars qw/@ISA/;
    4029. 

  4029. use strict;
    4030. 

  4030. use warnings;
    4031. 

  4031. use Carp qw/croak/;
    4032. 

  4032. use IO::File qw//;
    4033. 

  4033. use vars qw/$_ignore_regex/;
    4034. 

    4035. 

  4035. # file baton members: path, mode_a, mode_b, pool, fh, blob, base
    4036. 

  4036. sub new {
    4037. 

  4037. 	my ($class, $git_svn, $switch_path) = @_;
    4038. 

  4038. 	my $self = SVN::Delta::Editor->new;
    4039. 

  4039. 	bless $self, $class;
    4040. 

  4040. 	if (exists $git_svn->{last_commit}) {
    4041. 

  4041. 		$self->{c} = $git_svn->{last_commit};
    4042. 

  4042. 		$self->{empty_symlinks} =
    4043. 

  4043. 		                  _mark_empty_symlinks($git_svn, $switch_path);
    4044. 

  4044. 	}
    4045. 

  4045. 	$self->{ignore_regex} = eval { command_oneline('config', '--get',
    4046. 

  4046. 			     "svn-remote.$git_svn->{repo_id}.ignore-paths") };
    4047. 

  4047. 	$self->{empty} = {};
    4048. 

  4048. 	$self->{dir_prop} = {};
    4049. 

  4049. 	$self->{file_prop} = {};
    4050. 

  4050. 	$self->{absent_dir} = {};
    4051. 

  4051. 	$self->{absent_file} = {};
    4052. 

  4052. 	$self->{gii} = $git_svn->tmp_index_do(sub { Git::IndexInfo->new });
    4053. 

  4053. 	$self;
    4054. 

  4054. }
    4055. 

    4056. 

  4056. # this uses the Ra object, so it must be called before do_{switch,update},
    4057. 

  4057. # not inside them (when the Git::SVN::Fetcher object is passed) to
    4058. 

  4058. # do_{switch,update}
    4059. 

  4059. sub _mark_empty_symlinks {
    4060. 

  4060. 	my ($git_svn, $switch_path) = @_;
    4061. 

  4061. 	my $bool = Git::config_bool('svn.brokenSymlinkWorkaround');
    4062. 

  4062. 	return {} if (!defined($bool)) || (defined($bool) && ! $bool);
    4063. 

    4064. 

  4064. 	my %ret;
    4065. 

  4065. 	my ($rev, $cmt) = $git_svn->last_rev_commit;
    4066. 

  4066. 	return {} unless ($rev && $cmt);
    4067. 

    4068. 

  4068. 	# allow the warning to be printed for each revision we fetch to
    4069. 

  4069. 	# ensure the user sees it.  The user can also disable the workaround
    4070. 

  4070. 	# on the repository even while git svn is running and the next
    4071. 

  4071. 	# revision fetched will skip this expensive function.
    4072. 

  4072. 	my $printed_warning;
    4073. 

  4073. 	chomp(my $empty_blob = `git hash-object -t blob --stdin < /dev/null`);
    4074. 

  4074. 	my ($ls, $ctx) = command_output_pipe(qw/ls-tree -r -z/, $cmt);
    4075. 

  4075. 	local $/ = "\0";
    4076. 

  4076. 	my $pfx = defined($switch_path) ? $switch_path : $git_svn->{path};
    4077. 

  4077. 	$pfx .= '/' if length($pfx);
    4078. 

  4078. 	while (<$ls>) {
    4079. 

  4079. 		chomp;
    4080. 

  4080. 		s/\A100644 blob $empty_blob\t//o or next;
    4081. 

  4081. 		unless ($printed_warning) {
    4082. 

  4082. 			print STDERR "Scanning for empty symlinks, ",
    4083. 

  4083. 			             "this may take a while if you have ",
    4084. 

  4084. 				     "many empty files\n",
    4085. 

  4085. 				     "You may disable this with `",
    4086. 

  4086. 				     "git config svn.brokenSymlinkWorkaround ",
    4087. 

  4087. 				     "false'.\n",
    4088. 

  4088. 				     "This may be done in a different ",
    4089. 

  4089. 				     "terminal without restarting ",
    4090. 

  4090. 				     "git svn\n";
    4091. 

  4091. 			$printed_warning = 1;
    4092. 

  4092. 		}
    4093. 

  4093. 		my $path = $_;
    4094. 

  4094. 		my (undef, $props) =
    4095. 

  4095. 		               $git_svn->ra->get_file($pfx.$path, $rev, undef);
    4096. 

  4096. 		if ($props->{'svn:special'}) {
    4097. 

  4097. 			$ret{$path} = 1;
    4098. 

  4098. 		}
    4099. 

  4099. 	}
    4100. 

  4100. 	command_close_pipe($ls, $ctx);
    4101. 

  4101. 	\%ret;
    4102. 

  4102. }
    4103. 

    4104. 

  4104. # returns true if a given path is inside a ".git" directory
    4105. 

  4105. sub in_dot_git {
    4106. 

  4106. 	$_[0] =~ m{(?:^|/)\.git(?:/|$)};
    4107. 

  4107. }
    4108. 

    4109. 

  4109. # return value: 0 -- don't ignore, 1 -- ignore
    4110. 

  4110. sub is_path_ignored {
    4111. 

  4111. 	my ($self, $path) = @_;
    4112. 

  4112. 	return 1 if in_dot_git($path);
    4113. 

  4113. 	return 1 if defined($self->{ignore_regex}) &&
    4114. 

  4114. 	            $path =~ m!$self->{ignore_regex}!;
    4115. 

  4115. 	return 0 unless defined($_ignore_regex);
    4116. 

  4116. 	return 1 if $path =~ m!$_ignore_regex!o;
    4117. 

  4117. 	return 0;
    4118. 

  4118. }
    4119. 

    4120. 

  4120. sub set_path_strip {
    4121. 

  4121. 	my ($self, $path) = @_;
    4122. 

  4122. 	$self->{path_strip} = qr/^\Q$path\E(\/|$)/ if length $path;
    4123. 

  4123. }
    4124. 

    4125. 

  4125. sub open_root {
    4126. 

  4126. 	{ path => '' };
    4127. 

  4127. }
    4128. 

    4129. 

  4129. sub open_directory {
    4130. 

  4130. 	my ($self, $path, $pb, $rev) = @_;
    4131. 

  4131. 	{ path => $path };
    4132. 

  4132. }
    4133. 

    4134. 

  4134. sub git_path {
    4135. 

  4135. 	my ($self, $path) = @_;
    4136. 

  4136. 	if ($self->{path_strip}) {
    4137. 

  4137. 		$path =~ s!$self->{path_strip}!! or
    4138. 

  4138. 		  die "Failed to strip path '$path' ($self->{path_strip})\n";
    4139. 

  4139. 	}
    4140. 

  4140. 	$path;
    4141. 

  4141. }
    4142. 

    4143. 

  4143. sub delete_entry {
    4144. 

  4144. 	my ($self, $path, $rev, $pb) = @_;
    4145. 

  4145. 	return undef if $self->is_path_ignored($path);
    4146. 

    4147. 

  4147. 	my $gpath = $self->git_path($path);
    4148. 

  4148. 	return undef if ($gpath eq '');
    4149. 

    4150. 

  4150. 	# remove entire directories.
    4151. 

  4151. 	my ($tree) = (command('ls-tree', '-z', $self->{c}, "./$gpath")
    4152. 

  4152. 	                 =~ /\A040000 tree ([a-f\d]{40})\t\Q$gpath\E\0/);
    4153. 

  4153. 	if ($tree) {
    4154. 

  4154. 		my ($ls, $ctx) = command_output_pipe(qw/ls-tree
    4155. 

  4155. 		                                     -r --name-only -z/,
    4156. 

  4156. 				                     $tree);
    4157. 

  4157. 		local $/ = "\0";
    4158. 

  4158. 		while (<$ls>) {
    4159. 

  4159. 			chomp;
    4160. 

  4160. 			my $rmpath = "$gpath/$_";
    4161. 

  4161. 			$self->{gii}->remove($rmpath);
    4162. 

  4162. 			print "\tD\t$rmpath\n" unless $::_q;
    4163. 

  4163. 		}
    4164. 

  4164. 		print "\tD\t$gpath/\n" unless $::_q;
    4165. 

  4165. 		command_close_pipe($ls, $ctx);
    4166. 

  4166. 	} else {
    4167. 

  4167. 		$self->{gii}->remove($gpath);
    4168. 

  4168. 		print "\tD\t$gpath\n" unless $::_q;
    4169. 

  4169. 	}
    4170. 

  4170. 	$self->{empty}->{$path} = 0;
    4171. 

  4171. 	undef;
    4172. 

  4172. }
    4173. 

    4174. 

  4174. sub open_file {
    4175. 

  4175. 	my ($self, $path, $pb, $rev) = @_;
    4176. 

  4176. 	my ($mode, $blob);
    4177. 

    4178. 

  4178. 	goto out if $self->is_path_ignored($path);
    4179. 

    4180. 

  4180. 	my $gpath = $self->git_path($path);
    4181. 

  4181. 	($mode, $blob) = (command('ls-tree', '-z', $self->{c}, "./$gpath")
    4182. 

  4182. 	                     =~ /\A(\d{6}) blob ([a-f\d]{40})\t\Q$gpath\E\0/);
    4183. 

  4183. 	unless (defined $mode && defined $blob) {
    4184. 

  4184. 		die "$path was not found in commit $self->{c} (r$rev)\n";
    4185. 

  4185. 	}
    4186. 

  4186. 	if ($mode eq '100644' && $self->{empty_symlinks}->{$path}) {
    4187. 

  4187. 		$mode = '120000';
    4188. 

  4188. 	}
    4189. 

  4189. out:
    4190. 

  4190. 	{ path => $path, mode_a => $mode, mode_b => $mode, blob => $blob,
    4191. 

  4191. 	  pool => SVN::Pool->new, action => 'M' };
    4192. 

  4192. }
    4193. 

    4194. 

  4194. sub add_file {
    4195. 

  4195. 	my ($self, $path, $pb, $cp_path, $cp_rev) = @_;
    4196. 

  4196. 	my $mode;
    4197. 

    4198. 

  4198. 	if (!$self->is_path_ignored($path)) {
    4199. 

  4199. 		my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
    4200. 

  4200. 		delete $self->{empty}->{$dir};
    4201. 

  4201. 		$mode = '100644';
    4202. 

  4202. 	}
    4203. 

  4203. 	{ path => $path, mode_a => $mode, mode_b => $mode,
    4204. 

  4204. 	  pool => SVN::Pool->new, action => 'A' };
    4205. 

  4205. }
    4206. 

    4207. 

  4207. sub add_directory {
    4208. 

  4208. 	my ($self, $path, $cp_path, $cp_rev) = @_;
    4209. 

  4209. 	goto out if $self->is_path_ignored($path);
    4210. 

  4210. 	my $gpath = $self->git_path($path);
    4211. 

  4211. 	if ($gpath eq '') {
    4212. 

  4212. 		my ($ls, $ctx) = command_output_pipe(qw/ls-tree
    4213. 

  4213. 		                                     -r --name-only -z/,
    4214. 

  4214. 				                     $self->{c});
    4215. 

  4215. 		local $/ = "\0";
    4216. 

  4216. 		while (<$ls>) {
    4217. 

  4217. 			chomp;
    4218. 

  4218. 			$self->{gii}->remove($_);
    4219. 

  4219. 			print "\tD\t$_\n" unless $::_q;
    4220. 

  4220. 		}
    4221. 

  4221. 		command_close_pipe($ls, $ctx);
    4222. 

  4222. 		$self->{empty}->{$path} = 0;
    4223. 

  4223. 	}
    4224. 

  4224. 	my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
    4225. 

  4225. 	delete $self->{empty}->{$dir};
    4226. 

  4226. 	$self->{empty}->{$path} = 1;
    4227. 

  4227. out:
    4228. 

  4228. 	{ path => $path };
    4229. 

  4229. }
    4230. 

    4231. 

  4231. sub change_dir_prop {
    4232. 

  4232. 	my ($self, $db, $prop, $value) = @_;
    4233. 

  4233. 	return undef if $self->is_path_ignored($db->{path});
    4234. 

  4234. 	$self->{dir_prop}->{$db->{path}} ||= {};
    4235. 

  4235. 	$self->{dir_prop}->{$db->{path}}->{$prop} = $value;
    4236. 

  4236. 	undef;
    4237. 

  4237. }
    4238. 

    4239. 

  4239. sub absent_directory {
    4240. 

  4240. 	my ($self, $path, $pb) = @_;
    4241. 

  4241. 	return undef if $self->is_path_ignored($path);
    4242. 

  4242. 	$self->{absent_dir}->{$pb->{path}} ||= [];
    4243. 

  4243. 	push @{$self->{absent_dir}->{$pb->{path}}}, $path;
    4244. 

  4244. 	undef;
    4245. 

  4245. }
    4246. 

    4247. 

  4247. sub absent_file {
    4248. 

  4248. 	my ($self, $path, $pb) = @_;
    4249. 

  4249. 	return undef if $self->is_path_ignored($path);
    4250. 

  4250. 	$self->{absent_file}->{$pb->{path}} ||= [];
    4251. 

  4251. 	push @{$self->{absent_file}->{$pb->{path}}}, $path;
    4252. 

  4252. 	undef;
    4253. 

  4253. }
    4254. 

    4255. 

  4255. sub change_file_prop {
    4256. 

  4256. 	my ($self, $fb, $prop, $value) = @_;
    4257. 

  4257. 	return undef if $self->is_path_ignored($fb->{path});
    4258. 

  4258. 	if ($prop eq 'svn:executable') {
    4259. 

  4259. 		if ($fb->{mode_b} != 120000) {
    4260. 

  4260. 			$fb->{mode_b} = defined $value ? 100755 : 100644;
    4261. 

  4261. 		}
    4262. 

  4262. 	} elsif ($prop eq 'svn:special') {
    4263. 

  4263. 		$fb->{mode_b} = defined $value ? 120000 : 100644;
    4264. 

  4264. 	} else {
    4265. 

  4265. 		$self->{file_prop}->{$fb->{path}} ||= {};
    4266. 

  4266. 		$self->{file_prop}->{$fb->{path}}->{$prop} = $value;
    4267. 

  4267. 	}
    4268. 

  4268. 	undef;
    4269. 

  4269. }
    4270. 

    4271. 

  4271. sub apply_textdelta {
    4272. 

  4272. 	my ($self, $fb, $exp) = @_;
    4273. 

  4273. 	return undef if $self->is_path_ignored($fb->{path});
    4274. 

  4274. 	my $fh = $::_repository->temp_acquire('svn_delta');
    4275. 

  4275. 	# $fh gets auto-closed() by SVN::TxDelta::apply(),
    4276. 

  4276. 	# (but $base does not,) so dup() it for reading in close_file
    4277. 

  4277. 	open my $dup, '<&', $fh or croak $!;
    4278. 

  4278. 	my $base = $::_repository->temp_acquire('git_blob');
    4279. 

    4280. 

  4280. 	if ($fb->{blob}) {
    4281. 

  4281. 		my ($base_is_link, $size);
    4282. 

    4283. 

  4283. 		if ($fb->{mode_a} eq '120000' &&
    4284. 

  4284. 		    ! $self->{empty_symlinks}->{$fb->{path}}) {
    4285. 

  4285. 			print $base 'link ' or die "print $!\n";
    4286. 

  4286. 			$base_is_link = 1;
    4287. 

  4287. 		}
    4288. 

  4288. 	retry:
    4289. 

  4289. 		$size = $::_repository->cat_blob($fb->{blob}, $base);
    4290. 

  4290. 		die "Failed to read object $fb->{blob}" if ($size < 0);
    4291. 

    4292. 

  4292. 		if (defined $exp) {
    4293. 

  4293. 			seek $base, 0, 0 or croak $!;
    4294. 

  4294. 			my $got = ::md5sum($base);
    4295. 

  4295. 			if ($got ne $exp) {
    4296. 

  4296. 				my $err = "Checksum mismatch: ".
    4297. 

  4297. 				       "$fb->{path} $fb->{blob}\n" .
    4298. 

  4298. 				       "expected: $exp\n" .
    4299. 

  4299. 				       "     got: $got\n";
    4300. 

  4300. 				if ($base_is_link) {
    4301. 

  4301. 					warn $err,
    4302. 

  4302. 					     "Retrying... (possibly ",
    4303. 

  4303. 					     "a bad symlink from SVN)\n";
    4304. 

  4304. 					$::_repository->temp_reset($base);
    4305. 

  4305. 					$base_is_link = 0;
    4306. 

  4306. 					goto retry;
    4307. 

  4307. 				}
    4308. 

  4308. 				die $err;
    4309. 

  4309. 			}
    4310. 

  4310. 		}
    4311. 

  4311. 	}
    4312. 

  4312. 	seek $base, 0, 0 or croak $!;
    4313. 

  4313. 	$fb->{fh} = $fh;
    4314. 

  4314. 	$fb->{base} = $base;
    4315. 

  4315. 	[ SVN::TxDelta::apply($base, $dup, undef, $fb->{path}, $fb->{pool}) ];
    4316. 

  4316. }
    4317. 

    4318. 

  4318. sub close_file {
    4319. 

  4319. 	my ($self, $fb, $exp) = @_;
    4320. 

  4320. 	return undef if $self->is_path_ignored($fb->{path});
    4321. 

    4322. 

  4322. 	my $hash;
    4323. 

  4323. 	my $path = $self->git_path($fb->{path});
    4324. 

  4324. 	if (my $fh = $fb->{fh}) {
    4325. 

  4325. 		if (defined $exp) {
    4326. 

  4326. 			seek($fh, 0, 0) or croak $!;
    4327. 

  4327. 			my $got = ::md5sum($fh);
    4328. 

  4328. 			if ($got ne $exp) {
    4329. 

  4329. 				die "Checksum mismatch: $path\n",
    4330. 

  4330. 				    "expected: $exp\n    got: $got\n";
    4331. 

  4331. 			}
    4332. 

  4332. 		}
    4333. 

  4333. 		if ($fb->{mode_b} == 120000) {
    4334. 

  4334. 			sysseek($fh, 0, 0) or croak $!;
    4335. 

  4335. 			my $rd = sysread($fh, my $buf, 5);
    4336. 

    4337. 

  4337. 			if (!defined $rd) {
    4338. 

  4338. 				croak "sysread: $!\n";
    4339. 

  4339. 			} elsif ($rd == 0) {
    4340. 

  4340. 				warn "$path has mode 120000",
    4341. 

  4341. 				     " but it points to nothing\n",
    4342. 

  4342. 				     "converting to an empty file with mode",
    4343. 

  4343. 				     " 100644\n";
    4344. 

  4344. 				$fb->{mode_b} = '100644';
    4345. 

  4345. 			} elsif ($buf ne 'link ') {
    4346. 

  4346. 				warn "$path has mode 120000",
    4347. 

  4347. 				     " but is not a link\n";
    4348. 

  4348. 			} else {
    4349. 

  4349. 				my $tmp_fh = $::_repository->temp_acquire(
    4350. 

  4350. 					'svn_hash');
    4351. 

  4351. 				my $res;
    4352. 

  4352. 				while ($res = sysread($fh, my $str, 1024)) {
    4353. 

  4353. 					my $out = syswrite($tmp_fh, $str, $res);
    4354. 

  4354. 					defined($out) && $out == $res
    4355. 

  4355. 						or croak("write ",
    4356. 

  4356. 							Git::temp_path($tmp_fh),
    4357. 

  4357. 							": $!\n");
    4358. 

  4358. 				}
    4359. 

  4359. 				defined $res or croak $!;
    4360. 

    4361. 

  4361. 				($fh, $tmp_fh) = ($tmp_fh, $fh);
    4362. 

  4362. 				Git::temp_release($tmp_fh, 1);
    4363. 

  4363. 			}
    4364. 

  4364. 		}
    4365. 

    4366. 

  4366. 		$hash = $::_repository->hash_and_insert_object(
    4367. 

  4367. 				Git::temp_path($fh));
    4368. 

  4368. 		$hash =~ /^[a-f\d]{40}$/ or die "not a sha1: $hash\n";
    4369. 

    4370. 

  4370. 		Git::temp_release($fb->{base}, 1);
    4371. 

  4371. 		Git::temp_release($fh, 1);
    4372. 

  4372. 	} else {
    4373. 

  4373. 		$hash = $fb->{blob} or die "no blob information\n";
    4374. 

  4374. 	}
    4375. 

  4375. 	$fb->{pool}->clear;
    4376. 

  4376. 	$self->{gii}->update($fb->{mode_b}, $hash, $path) or croak $!;
    4377. 

  4377. 	print "\t$fb->{action}\t$path\n" if $fb->{action} && ! $::_q;
    4378. 

  4378. 	undef;
    4379. 

  4379. }
    4380. 

    4381. 

  4381. sub abort_edit {
    4382. 

  4382. 	my $self = shift;
    4383. 

  4383. 	$self->{nr} = $self->{gii}->{nr};
    4384. 

  4384. 	delete $self->{gii};
    4385. 

  4385. 	$self->SUPER::abort_edit(@_);
    4386. 

  4386. }
    4387. 

    4388. 

  4388. sub close_edit {
    4389. 

  4389. 	my $self = shift;
    4390. 

  4390. 	$self->{git_commit_ok} = 1;
    4391. 

  4391. 	$self->{nr} = $self->{gii}->{nr};
    4392. 

  4392. 	delete $self->{gii};
    4393. 

  4393. 	$self->SUPER::close_edit(@_);
    4394. 

  4394. }
    4395. 

    4396. 

  4396. package SVN::Git::Editor;
    4397. 

  4397. use vars qw/@ISA $_rmdir $_cp_similarity $_find_copies_harder $_rename_limit/;
    4398. 

  4398. use strict;
    4399. 

  4399. use warnings;
    4400. 

  4400. use Carp qw/croak/;
    4401. 

  4401. use IO::File;
    4402. 

    4403. 

  4403. sub new {
    4404. 

  4404. 	my ($class, $opts) = @_;
    4405. 

  4405. 	foreach (qw/svn_path r ra tree_a tree_b log editor_cb/) {
    4406. 

  4406. 		die "$_ required!\n" unless (defined $opts->{$_});
    4407. 

  4407. 	}
    4408. 

    4409. 

  4409. 	my $pool = SVN::Pool->new;
    4410. 

  4410. 	my $mods = generate_diff($opts->{tree_a}, $opts->{tree_b});
    4411. 

  4411. 	my $types = check_diff_paths($opts->{ra}, $opts->{svn_path},
    4412. 

  4412. 	                             $opts->{r}, $mods);
    4413. 

    4414. 

  4414. 	# $opts->{ra} functions should not be used after this:
    4415. 

  4415. 	my @ce  = $opts->{ra}->get_commit_editor($opts->{log},
    4416. 

  4416. 	                                        $opts->{editor_cb}, $pool);
    4417. 

  4417. 	my $self = SVN::Delta::Editor->new(@ce, $pool);
    4418. 

  4418. 	bless $self, $class;
    4419. 

  4419. 	foreach (qw/svn_path r tree_a tree_b/) {
    4420. 

  4420. 		$self->{$_} = $opts->{$_};
    4421. 

  4421. 	}
    4422. 

  4422. 	$self->{url} = $opts->{ra}->{url};
    4423. 

  4423. 	$self->{mods} = $mods;
    4424. 

  4424. 	$self->{types} = $types;
    4425. 

  4425. 	$self->{pool} = $pool;
    4426. 

  4426. 	$self->{bat} = { '' => $self->open_root($self->{r}, $self->{pool}) };
    4427. 

  4427. 	$self->{rm} = { };
    4428. 

  4428. 	$self->{path_prefix} = length $self->{svn_path} ?
    4429. 

  4429. 	                       "$self->{svn_path}/" : '';
    4430. 

  4430. 	$self->{config} = $opts->{config};
    4431. 

  4431. 	return $self;
    4432. 

  4432. }
    4433. 

    4434. 

  4434. sub generate_diff {
    4435. 

  4435. 	my ($tree_a, $tree_b) = @_;
    4436. 

  4436. 	my @diff_tree = qw(diff-tree -z -r);
    4437. 

  4437. 	if ($_cp_similarity) {
    4438. 

  4438. 		push @diff_tree, "-C$_cp_similarity";
    4439. 

  4439. 	} else {
    4440. 

  4440. 		push @diff_tree, '-C';
    4441. 

  4441. 	}
    4442. 

  4442. 	push @diff_tree, '--find-copies-harder' if $_find_copies_harder;
    4443. 

  4443. 	push @diff_tree, "-l$_rename_limit" if defined $_rename_limit;
    4444. 

  4444. 	push @diff_tree, $tree_a, $tree_b;
    4445. 

  4445. 	my ($diff_fh, $ctx) = command_output_pipe(@diff_tree);
    4446. 

  4446. 	local $/ = "\0";
    4447. 

  4447. 	my $state = 'meta';
    4448. 

  4448. 	my @mods;
    4449. 

  4449. 	while (<$diff_fh>) {
    4450. 

  4450. 		chomp $_; # this gets rid of the trailing "\0"
    4451. 

  4451. 		if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s
    4452. 

  4452. 					($::sha1)\s($::sha1)\s
    4453. 

  4453. 					([MTCRAD])\d*$/xo) {
    4454. 

  4454. 			push @mods, {	mode_a => $1, mode_b => $2,
    4455. 

  4455. 					sha1_a => $3, sha1_b => $4,
    4456. 

  4456. 					chg => $5 };
    4457. 

  4457. 			if ($5 =~ /^(?:C|R)$/) {
    4458. 

  4458. 				$state = 'file_a';
    4459. 

  4459. 			} else {
    4460. 

  4460. 				$state = 'file_b';
    4461. 

  4461. 			}
    4462. 

  4462. 		} elsif ($state eq 'file_a') {
    4463. 

  4463. 			my $x = $mods[$#mods] or croak "Empty array\n";
    4464. 

  4464. 			if ($x->{chg} !~ /^(?:C|R)$/) {
    4465. 

  4465. 				croak "Error parsing $_, $x->{chg}\n";
    4466. 

  4466. 			}
    4467. 

  4467. 			$x->{file_a} = $_;
    4468. 

  4468. 			$state = 'file_b';
    4469. 

  4469. 		} elsif ($state eq 'file_b') {
    4470. 

  4470. 			my $x = $mods[$#mods] or croak "Empty array\n";
    4471. 

  4471. 			if (exists $x->{file_a} && $x->{chg} !~ /^(?:C|R)$/) {
    4472. 

  4472. 				croak "Error parsing $_, $x->{chg}\n";
    4473. 

  4473. 			}
    4474. 

  4474. 			if (!exists $x->{file_a} && $x->{chg} =~ /^(?:C|R)$/) {
    4475. 

  4475. 				croak "Error parsing $_, $x->{chg}\n";
    4476. 

  4476. 			}
    4477. 

  4477. 			$x->{file_b} = $_;
    4478. 

  4478. 			$state = 'meta';
    4479. 

  4479. 		} else {
    4480. 

  4480. 			croak "Error parsing $_\n";
    4481. 

  4481. 		}
    4482. 

  4482. 	}
    4483. 

  4483. 	command_close_pipe($diff_fh, $ctx);
    4484. 

  4484. 	\@mods;
    4485. 

  4485. }
    4486. 

    4487. 

  4487. sub check_diff_paths {
    4488. 

  4488. 	my ($ra, $pfx, $rev, $mods) = @_;
    4489. 

  4489. 	my %types;
    4490. 

  4490. 	$pfx .= '/' if length $pfx;
    4491. 

    4492. 

  4492. 	sub type_diff_paths {
    4493. 

  4493. 		my ($ra, $types, $path, $rev) = @_;
    4494. 

  4494. 		my @p = split m#/+#, $path;
    4495. 

  4495. 		my $c = shift @p;
    4496. 

  4496. 		unless (defined $types->{$c}) {
    4497. 

  4497. 			$types->{$c} = $ra->check_path($c, $rev);
    4498. 

  4498. 		}
    4499. 

  4499. 		while (@p) {
    4500. 

  4500. 			$c .= '/' . shift @p;
    4501. 

  4501. 			next if defined $types->{$c};
    4502. 

  4502. 			$types->{$c} = $ra->check_path($c, $rev);
    4503. 

  4503. 		}
    4504. 

  4504. 	}
    4505. 

    4506. 

  4506. 	foreach my $m (@$mods) {
    4507. 

  4507. 		foreach my $f (qw/file_a file_b/) {
    4508. 

  4508. 			next unless defined $m->{$f};
    4509. 

  4509. 			my ($dir) = ($m->{$f} =~ m#^(.*?)/?(?:[^/]+)$#);
    4510. 

  4510. 			if (length $pfx.$dir && ! defined $types{$dir}) {
    4511. 

  4511. 				type_diff_paths($ra, \%types, $pfx.$dir, $rev);
    4512. 

  4512. 			}
    4513. 

  4513. 		}
    4514. 

  4514. 	}
    4515. 

  4515. 	\%types;
    4516. 

  4516. }
    4517. 

    4518. 

  4518. sub split_path {
    4519. 

  4519. 	return ($_[0] =~ m#^(.*?)/?([^/]+)$#);
    4520. 

  4520. }
    4521. 

    4522. 

  4522. sub repo_path {
    4523. 

  4523. 	my ($self, $path) = @_;
    4524. 

  4524. 	$self->{path_prefix}.(defined $path ? $path : '');
    4525. 

  4525. }
    4526. 

    4527. 

  4527. sub url_path {
    4528. 

  4528. 	my ($self, $path) = @_;
    4529. 

  4529. 	if ($self->{url} =~ m#^https?://#) {
    4530. 

  4530. 		$path =~ s!([^~a-zA-Z0-9_./-])!uc sprintf("%%%02x",ord($1))!eg;
    4531. 

  4531. 	}
    4532. 

  4532. 	$self->{url} . '/' . $self->repo_path($path);
    4533. 

  4533. }
    4534. 

    4535. 

  4535. sub rmdirs {
    4536. 

  4536. 	my ($self) = @_;
    4537. 

  4537. 	my $rm = $self->{rm};
    4538. 

  4538. 	delete $rm->{''}; # we never delete the url we're tracking
    4539. 

  4539. 	return unless %$rm;
    4540. 

    4541. 

  4541. 	foreach (keys %$rm) {
    4542. 

  4542. 		my @d = split m#/#, $_;
    4543. 

  4543. 		my $c = shift @d;
    4544. 

  4544. 		$rm->{$c} = 1;
    4545. 

  4545. 		while (@d) {
    4546. 

  4546. 			$c .= '/' . shift @d;
    4547. 

  4547. 			$rm->{$c} = 1;
    4548. 

  4548. 		}
    4549. 

  4549. 	}
    4550. 

  4550. 	delete $rm->{$self->{svn_path}};
    4551. 

  4551. 	delete $rm->{''}; # we never delete the url we're tracking
    4552. 

  4552. 	return unless %$rm;
    4553. 

    4554. 

  4554. 	my ($fh, $ctx) = command_output_pipe(qw/ls-tree --name-only -r -z/,
    4555. 

  4555. 	                                     $self->{tree_b});
    4556. 

  4556. 	local $/ = "\0";
    4557. 

  4557. 	while (<$fh>) {
    4558. 

  4558. 		chomp;
    4559. 

  4559. 		my @dn = split m#/#, $_;
    4560. 

  4560. 		while (pop @dn) {
    4561. 

  4561. 			delete $rm->{join '/', @dn};
    4562. 

  4562. 		}
    4563. 

  4563. 		unless (%$rm) {
    4564. 

  4564. 			close $fh;
    4565. 

  4565. 			return;
    4566. 

  4566. 		}
    4567. 

  4567. 	}
    4568. 

  4568. 	command_close_pipe($fh, $ctx);
    4569. 

    4570. 

  4570. 	my ($r, $p, $bat) = ($self->{r}, $self->{pool}, $self->{bat});
    4571. 

  4571. 	foreach my $d (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$rm) {
    4572. 

  4572. 		$self->close_directory($bat->{$d}, $p);
    4573. 

  4573. 		my ($dn) = ($d =~ m#^(.*?)/?(?:[^/]+)$#);
    4574. 

  4574. 		print "\tD+\t$d/\n" unless $::_q;
    4575. 

  4575. 		$self->SUPER::delete_entry($d, $r, $bat->{$dn}, $p);
    4576. 

  4576. 		delete $bat->{$d};
    4577. 

  4577. 	}
    4578. 

  4578. }
    4579. 

    4580. 

  4580. sub open_or_add_dir {
    4581. 

  4581. 	my ($self, $full_path, $baton) = @_;
    4582. 

  4582. 	my $t = $self->{types}->{$full_path};
    4583. 

  4583. 	if (!defined $t) {
    4584. 

  4584. 		die "$full_path not known in r$self->{r} or we have a bug!\n";
    4585. 

  4585. 	}
    4586. 

  4586. 	{
    4587. 

  4587. 		no warnings 'once';
    4588. 

  4588. 		# SVN::Node::none and SVN::Node::file are used only once,
    4589. 

  4589. 		# so we're shutting up Perl's warnings about them.
    4590. 

  4590. 		if ($t == $SVN::Node::none) {
    4591. 

  4591. 			return $self->add_directory($full_path, $baton,
    4592. 

  4592. 			    undef, -1, $self->{pool});
    4593. 

  4593. 		} elsif ($t == $SVN::Node::dir) {
    4594. 

  4594. 			return $self->open_directory($full_path, $baton,
    4595. 

  4595. 			    $self->{r}, $self->{pool});
    4596. 

  4596. 		} # no warnings 'once'
    4597. 

  4597. 		print STDERR "$full_path already exists in repository at ",
    4598. 

  4598. 		    "r$self->{r} and it is not a directory (",
    4599. 

  4599. 		    ($t == $SVN::Node::file ? 'file' : 'unknown'),"/$t)\n";
    4600. 

  4600. 	} # no warnings 'once'
    4601. 

  4601. 	exit 1;
    4602. 

  4602. }
    4603. 

    4604. 

  4604. sub ensure_path {
    4605. 

  4605. 	my ($self, $path) = @_;
    4606. 

  4606. 	my $bat = $self->{bat};
    4607. 

  4607. 	my $repo_path = $self->repo_path($path);
    4608. 

  4608. 	return $bat->{''} unless (length $repo_path);
    4609. 

  4609. 	my @p = split m#/+#, $repo_path;
    4610. 

  4610. 	my $c = shift @p;
    4611. 

  4611. 	$bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''});
    4612. 

  4612. 	while (@p) {
    4613. 

  4613. 		my $c0 = $c;
    4614. 

  4614. 		$c .= '/' . shift @p;
    4615. 

  4615. 		$bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0});
    4616. 

  4616. 	}
    4617. 

  4617. 	return $bat->{$c};
    4618. 

  4618. }
    4619. 

    4620. 

  4620. # Subroutine to convert a globbing pattern to a regular expression.
    4621. 

  4621. # From perl cookbook.
    4622. 

  4622. sub glob2pat {
    4623. 

  4623. 	my $globstr = shift;
    4624. 

  4624. 	my %patmap = ('*' => '.*', '?' => '.', '[' => '[', ']' => ']');
    4625. 

  4625. 	$globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;
    4626. 

  4626. 	return '^' . $globstr . '$';
    4627. 

  4627. }
    4628. 

    4629. 

  4629. sub check_autoprop {
    4630. 

  4630. 	my ($self, $pattern, $properties, $file, $fbat) = @_;
    4631. 

  4631. 	# Convert the globbing pattern to a regular expression.
    4632. 

  4632. 	my $regex = glob2pat($pattern);
    4633. 

  4633. 	# Check if the pattern matches the file name.
    4634. 

  4634. 	if($file =~ m/($regex)/) {
    4635. 

  4635. 		# Parse the list of properties to set.
    4636. 

  4636. 		my @props = split(/;/, $properties);
    4637. 

  4637. 		foreach my $prop (@props) {
    4638. 

  4638. 			# Parse 'name=value' syntax and set the property.
    4639. 

  4639. 			if ($prop =~ /([^=]+)=(.*)/) {
    4640. 

  4640. 				my ($n,$v) = ($1,$2);
    4641. 

  4641. 				for ($n, $v) {
    4642. 

  4642. 					s/^\s+//; s/\s+$//;
    4643. 

  4643. 				}
    4644. 

  4644. 				$self->change_file_prop($fbat, $n, $v);
    4645. 

  4645. 			}
    4646. 

  4646. 		}
    4647. 

  4647. 	}
    4648. 

  4648. }
    4649. 

    4650. 

  4650. sub apply_autoprops {
    4651. 

  4651. 	my ($self, $file, $fbat) = @_;
    4652. 

  4652. 	my $conf_t = ${$self->{config}}{'config'};
    4653. 

  4653. 	no warnings 'once';
    4654. 

  4654. 	# Check [miscellany]/enable-auto-props in svn configuration.
    4655. 

  4655. 	if (SVN::_Core::svn_config_get_bool(
    4656. 

  4656. 		$conf_t,
    4657. 

  4657. 		$SVN::_Core::SVN_CONFIG_SECTION_MISCELLANY,
    4658. 

  4658. 		$SVN::_Core::SVN_CONFIG_OPTION_ENABLE_AUTO_PROPS,
    4659. 

  4659. 		0)) {
    4660. 

  4660. 		# Auto-props are enabled.  Enumerate them to look for matches.
    4661. 

  4661. 		my $callback = sub {
    4662. 

  4662. 			$self->check_autoprop($_[0], $_[1], $file, $fbat);
    4663. 

  4663. 		};
    4664. 

  4664. 		SVN::_Core::svn_config_enumerate(
    4665. 

  4665. 			$conf_t,
    4666. 

  4666. 			$SVN::_Core::SVN_CONFIG_SECTION_AUTO_PROPS,
    4667. 

  4667. 			$callback);
    4668. 

  4668. 	}
    4669. 

  4669. }
    4670. 

    4671. 

  4671. sub A {
    4672. 

  4672. 	my ($self, $m) = @_;
    4673. 

  4673. 	my ($dir, $file) = split_path($m->{file_b});
    4674. 

  4674. 	my $pbat = $self->ensure_path($dir);
    4675. 

  4675. 	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
    4676. 

  4676. 					undef, -1);
    4677. 

  4677. 	print "\tA\t$m->{file_b}\n" unless $::_q;
    4678. 

  4678. 	$self->apply_autoprops($file, $fbat);
    4679. 

  4679. 	$self->chg_file($fbat, $m);
    4680. 

  4680. 	$self->close_file($fbat,undef,$self->{pool});
    4681. 

  4681. }
    4682. 

    4683. 

  4683. sub C {
    4684. 

  4684. 	my ($self, $m) = @_;
    4685. 

  4685. 	my ($dir, $file) = split_path($m->{file_b});
    4686. 

  4686. 	my $pbat = $self->ensure_path($dir);
    4687. 

  4687. 	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
    4688. 

  4688. 				$self->url_path($m->{file_a}), $self->{r});
    4689. 

  4689. 	print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
    4690. 

  4690. 	$self->chg_file($fbat, $m);
    4691. 

  4691. 	$self->close_file($fbat,undef,$self->{pool});
    4692. 

  4692. }
    4693. 

    4694. 

  4694. sub delete_entry {
    4695. 

  4695. 	my ($self, $path, $pbat) = @_;
    4696. 

  4696. 	my $rpath = $self->repo_path($path);
    4697. 

  4697. 	my ($dir, $file) = split_path($rpath);
    4698. 

  4698. 	$self->{rm}->{$dir} = 1;
    4699. 

  4699. 	$self->SUPER::delete_entry($rpath, $self->{r}, $pbat, $self->{pool});
    4700. 

  4700. }
    4701. 

    4702. 

  4702. sub R {
    4703. 

  4703. 	my ($self, $m) = @_;
    4704. 

  4704. 	my ($dir, $file) = split_path($m->{file_b});
    4705. 

  4705. 	my $pbat = $self->ensure_path($dir);
    4706. 

  4706. 	my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
    4707. 

  4707. 				$self->url_path($m->{file_a}), $self->{r});
    4708. 

  4708. 	print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
    4709. 

  4709. 	$self->apply_autoprops($file, $fbat);
    4710. 

  4710. 	$self->chg_file($fbat, $m);
    4711. 

  4711. 	$self->close_file($fbat,undef,$self->{pool});
    4712. 

    4713. 

  4713. 	($dir, $file) = split_path($m->{file_a});
    4714. 

  4714. 	$pbat = $self->ensure_path($dir);
    4715. 

  4715. 	$self->delete_entry($m->{file_a}, $pbat);
    4716. 

  4716. }
    4717. 

    4718. 

  4718. sub M {
    4719. 

  4719. 	my ($self, $m) = @_;
    4720. 

  4720. 	my ($dir, $file) = split_path($m->{file_b});
    4721. 

  4721. 	my $pbat = $self->ensure_path($dir);
    4722. 

  4722. 	my $fbat = $self->open_file($self->repo_path($m->{file_b}),
    4723. 

  4723. 				$pbat,$self->{r},$self->{pool});
    4724. 

  4724. 	print "\t$m->{chg}\t$m->{file_b}\n" unless $::_q;
    4725. 

  4725. 	$self->chg_file($fbat, $m);
    4726. 

  4726. 	$self->close_file($fbat,undef,$self->{pool});
    4727. 

  4727. }
    4728. 

    4729. 

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

    4731. 

  4731. sub change_file_prop {
    4732. 

  4732. 	my ($self, $fbat, $pname, $pval) = @_;
    4733. 

  4733. 	$self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool});
    4734. 

  4734. }
    4735. 

    4736. 

  4736. sub _chg_file_get_blob ($$$$) {
    4737. 

  4737. 	my ($self, $fbat, $m, $which) = @_;
    4738. 

  4738. 	my $fh = $::_repository->temp_acquire("git_blob_$which");
    4739. 

  4739. 	if ($m->{"mode_$which"} =~ /^120/) {
    4740. 

  4740. 		print $fh 'link ' or croak $!;
    4741. 

  4741. 		$self->change_file_prop($fbat,'svn:special','*');
    4742. 

  4742. 	} elsif ($m->{mode_a} =~ /^120/ && $m->{"mode_$which"} !~ /^120/) {
    4743. 

  4743. 		$self->change_file_prop($fbat,'svn:special',undef);
    4744. 

  4744. 	}
    4745. 

  4745. 	my $blob = $m->{"sha1_$which"};
    4746. 

  4746. 	return ($fh,) if ($blob =~ /^0{40}$/);
    4747. 

  4747. 	my $size = $::_repository->cat_blob($blob, $fh);
    4748. 

  4748. 	croak "Failed to read object $blob" if ($size < 0);
    4749. 

  4749. 	$fh->flush == 0 or croak $!;
    4750. 

  4750. 	seek $fh, 0, 0 or croak $!;
    4751. 

    4752. 

  4752. 	my $exp = ::md5sum($fh);
    4753. 

  4753. 	seek $fh, 0, 0 or croak $!;
    4754. 

  4754. 	return ($fh, $exp);
    4755. 

  4755. }
    4756. 

    4757. 

  4757. sub chg_file {
    4758. 

  4758. 	my ($self, $fbat, $m) = @_;
    4759. 

  4759. 	if ($m->{mode_b} =~ /755$/ && $m->{mode_a} !~ /755$/) {
    4760. 

  4760. 		$self->change_file_prop($fbat,'svn:executable','*');
    4761. 

  4761. 	} elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
    4762. 

  4762. 		$self->change_file_prop($fbat,'svn:executable',undef);
    4763. 

  4763. 	}
    4764. 

  4764. 	my ($fh_a, $exp_a) = _chg_file_get_blob $self, $fbat, $m, 'a';
    4765. 

  4765. 	my ($fh_b, $exp_b) = _chg_file_get_blob $self, $fbat, $m, 'b';
    4766. 

  4766. 	my $pool = SVN::Pool->new;
    4767. 

  4767. 	my $atd = $self->apply_textdelta($fbat, $exp_a, $pool);
    4768. 

  4768. 	if (-s $fh_a) {
    4769. 

  4769. 		my $txstream = SVN::TxDelta::new ($fh_a, $fh_b, $pool);
    4770. 

  4770. 		my $res = SVN::TxDelta::send_txstream($txstream, @$atd, $pool);
    4771. 

  4771. 		if (defined $res) {
    4772. 

  4772. 			die "Unexpected result from send_txstream: $res\n",
    4773. 

  4773. 			    "(SVN::Core::VERSION: $SVN::Core::VERSION)\n";
    4774. 

  4774. 		}
    4775. 

  4775. 	} else {
    4776. 

  4776. 		my $got = SVN::TxDelta::send_stream($fh_b, @$atd, $pool);
    4777. 

  4777. 		die "Checksum mismatch\nexpected: $exp_b\ngot: $got\n"
    4778. 

  4778. 		    if ($got ne $exp_b);
    4779. 

  4779. 	}
    4780. 

  4780. 	Git::temp_release($fh_b, 1);
    4781. 

  4781. 	Git::temp_release($fh_a, 1);
    4782. 

  4782. 	$pool->clear;
    4783. 

  4783. }
    4784. 

    4785. 

  4785. sub D {
    4786. 

  4786. 	my ($self, $m) = @_;
    4787. 

  4787. 	my ($dir, $file) = split_path($m->{file_b});
    4788. 

  4788. 	my $pbat = $self->ensure_path($dir);
    4789. 

  4789. 	print "\tD\t$m->{file_b}\n" unless $::_q;
    4790. 

  4790. 	$self->delete_entry($m->{file_b}, $pbat);
    4791. 

  4791. }
    4792. 

    4793. 

  4793. sub close_edit {
    4794. 

  4794. 	my ($self) = @_;
    4795. 

  4795. 	my ($p,$bat) = ($self->{pool}, $self->{bat});
    4796. 

  4796. 	foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) {
    4797. 

  4797. 		next if $_ eq '';
    4798. 

  4798. 		$self->close_directory($bat->{$_}, $p);
    4799. 

  4799. 	}
    4800. 

  4800. 	$self->close_directory($bat->{''}, $p);
    4801. 

  4801. 	$self->SUPER::close_edit($p);
    4802. 

  4802. 	$p->clear;
    4803. 

  4803. }
    4804. 

    4805. 

  4805. sub abort_edit {
    4806. 

  4806. 	my ($self) = @_;
    4807. 

  4807. 	$self->SUPER::abort_edit($self->{pool});
    4808. 

  4808. }
    4809. 

    4810. 

  4810. sub DESTROY {
    4811. 

  4811. 	my $self = shift;
    4812. 

  4812. 	$self->SUPER::DESTROY(@_);
    4813. 

  4813. 	$self->{pool}->clear;
    4814. 

  4814. }
    4815. 

    4816. 

  4816. # this drives the editor
    4817. 

  4817. sub apply_diff {
    4818. 

  4818. 	my ($self) = @_;
    4819. 

  4819. 	my $mods = $self->{mods};
    4820. 

  4820. 	my %o = ( D => 1, R => 0, C => -1, A => 3, M => 3, T => 3 );
    4821. 

  4821. 	foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
    4822. 

  4822. 		my $f = $m->{chg};
    4823. 

  4823. 		if (defined $o{$f}) {
    4824. 

  4824. 			$self->$f($m);
    4825. 

  4825. 		} else {
    4826. 

  4826. 			fatal("Invalid change type: $f");
    4827. 

  4827. 		}
    4828. 

  4828. 	}
    4829. 

  4829. 	$self->rmdirs if $_rmdir;
    4830. 

  4830. 	if (@$mods == 0) {
    4831. 

  4831. 		$self->abort_edit;
    4832. 

  4832. 	} else {
    4833. 

  4833. 		$self->close_edit;
    4834. 

  4834. 	}
    4835. 

  4835. 	return scalar @$mods;
    4836. 

  4836. }
    4837. 

    4838. 

  4838. package Git::SVN::Ra;
    4839. 

  4839. use vars qw/@ISA $config_dir $_log_window_size/;
    4840. 

  4840. use strict;
    4841. 

  4841. use warnings;
    4842. 

  4842. my ($ra_invalid, $can_do_switch, %ignored_err, $RA);
    4843. 

    4844. 

  4844. BEGIN {
    4845. 

  4845. 	# enforce temporary pool usage for some simple functions
    4846. 

  4846. 	no strict 'refs';
    4847. 

  4847. 	for my $f (qw/rev_proplist get_latest_revnum get_uuid get_repos_root
    4848. 

  4848. 	              get_file/) {
    4849. 

  4849. 		my $SUPER = "SUPER::$f";
    4850. 

  4850. 		*$f = sub {
    4851. 

  4851. 			my $self = shift;
    4852. 

  4852. 			my $pool = SVN::Pool->new;
    4853. 

  4853. 			my @ret = $self->$SUPER(@_,$pool);
    4854. 

  4854. 			$pool->clear;
    4855. 

  4855. 			wantarray ? @ret : $ret[0];
    4856. 

  4856. 		};
    4857. 

  4857. 	}
    4858. 

  4858. }
    4859. 

    4860. 

  4860. sub _auth_providers () {
    4861. 

  4861. 	[
    4862. 

  4862. 	  SVN::Client::get_simple_provider(),
    4863. 

  4863. 	  SVN::Client::get_ssl_server_trust_file_provider(),
    4864. 

  4864. 	  SVN::Client::get_simple_prompt_provider(
    4865. 

  4865. 	    \&Git::SVN::Prompt::simple, 2),
    4866. 

  4866. 	  SVN::Client::get_ssl_client_cert_file_provider(),
    4867. 

  4867. 	  SVN::Client::get_ssl_client_cert_prompt_provider(
    4868. 

  4868. 	    \&Git::SVN::Prompt::ssl_client_cert, 2),
    4869. 

  4869. 	  SVN::Client::get_ssl_client_cert_pw_file_provider(),
    4870. 

  4870. 	  SVN::Client::get_ssl_client_cert_pw_prompt_provider(
    4871. 

  4871. 	    \&Git::SVN::Prompt::ssl_client_cert_pw, 2),
    4872. 

  4872. 	  SVN::Client::get_username_provider(),
    4873. 

  4873. 	  SVN::Client::get_ssl_server_trust_prompt_provider(
    4874. 

  4874. 	    \&Git::SVN::Prompt::ssl_server_trust),
    4875. 

  4875. 	  SVN::Client::get_username_prompt_provider(
    4876. 

  4876. 	    \&Git::SVN::Prompt::username, 2)
    4877. 

  4877. 	]
    4878. 

  4878. }
    4879. 

    4880. 

  4880. sub escape_uri_only {
    4881. 

  4881. 	my ($uri) = @_;
    4882. 

  4882. 	my @tmp;
    4883. 

  4883. 	foreach (split m{/}, $uri) {
    4884. 

  4884. 		s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
    4885. 

  4885. 		push @tmp, $_;
    4886. 

  4886. 	}
    4887. 

  4887. 	join('/', @tmp);
    4888. 

  4888. }
    4889. 

    4890. 

  4890. sub escape_url {
    4891. 

  4891. 	my ($url) = @_;
    4892. 

  4892. 	if ($url =~ m#^(https?)://([^/]+)(.*)$#) {
    4893. 

  4893. 		my ($scheme, $domain, $uri) = ($1, $2, escape_uri_only($3));
    4894. 

  4894. 		$url = "$scheme://$domain$uri";
    4895. 

  4895. 	}
    4896. 

  4896. 	$url;
    4897. 

  4897. }
    4898. 

    4899. 

  4899. sub new {
    4900. 

  4900. 	my ($class, $url) = @_;
    4901. 

  4901. 	$url =~ s!/+$!!;
    4902. 

  4902. 	return $RA if ($RA && $RA->{url} eq $url);
    4903. 

    4904. 

  4904. 	::_req_svn();
    4905. 

    4906. 

  4906. 	SVN::_Core::svn_config_ensure($config_dir, undef);
    4907. 

  4907. 	my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers);
    4908. 

  4908. 	my $config = SVN::Core::config_get_config($config_dir);
    4909. 

  4909. 	$RA = undef;
    4910. 

  4910. 	my $dont_store_passwords = 1;
    4911. 

  4911. 	my $conf_t = ${$config}{'config'};
    4912. 

  4912. 	{
    4913. 

  4913. 		no warnings 'once';
    4914. 

  4914. 		# The usage of $SVN::_Core::SVN_CONFIG_* variables
    4915. 

  4915. 		# produces warnings that variables are used only once.
    4916. 

  4916. 		# I had not found the better way to shut them up, so
    4917. 

  4917. 		# the warnings of type 'once' are disabled in this block.
    4918. 

  4918. 		if (SVN::_Core::svn_config_get_bool($conf_t,
    4919. 

  4919. 		    $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
    4920. 

  4920. 		    $SVN::_Core::SVN_CONFIG_OPTION_STORE_PASSWORDS,
    4921. 

  4921. 		    1) == 0) {
    4922. 

  4922. 			SVN::_Core::svn_auth_set_parameter($baton,
    4923. 

  4923. 			    $SVN::_Core::SVN_AUTH_PARAM_DONT_STORE_PASSWORDS,
    4924. 

  4924. 			    bless (\$dont_store_passwords, "_p_void"));
    4925. 

  4925. 		}
    4926. 

  4926. 		if (SVN::_Core::svn_config_get_bool($conf_t,
    4927. 

  4927. 		    $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
    4928. 

  4928. 		    $SVN::_Core::SVN_CONFIG_OPTION_STORE_AUTH_CREDS,
    4929. 

  4929. 		    1) == 0) {
    4930. 

  4930. 			$Git::SVN::Prompt::_no_auth_cache = 1;
    4931. 

  4931. 		}
    4932. 

  4932. 	} # no warnings 'once'
    4933. 

  4933. 	my $self = SVN::Ra->new(url => escape_url($url), auth => $baton,
    4934. 

  4934. 	                      config => $config,
    4935. 

  4935. 			      pool => SVN::Pool->new,
    4936. 

  4936. 	                      auth_provider_callbacks => $callbacks);
    4937. 

  4937. 	$self->{url} = $url;
    4938. 

  4938. 	$self->{svn_path} = $url;
    4939. 

  4939. 	$self->{repos_root} = $self->get_repos_root;
    4940. 

  4940. 	$self->{svn_path} =~ s#^\Q$self->{repos_root}\E(/|$)##;
    4941. 

  4941. 	$self->{cache} = { check_path => { r => 0, data => {} },
    4942. 

  4942. 	                   get_dir => { r => 0, data => {} } };
    4943. 

  4943. 	$RA = bless $self, $class;
    4944. 

  4944. }
    4945. 

    4946. 

  4946. sub check_path {
    4947. 

  4947. 	my ($self, $path, $r) = @_;
    4948. 

  4948. 	my $cache = $self->{cache}->{check_path};
    4949. 

  4949. 	if ($r == $cache->{r} && exists $cache->{data}->{$path}) {
    4950. 

  4950. 		return $cache->{data}->{$path};
    4951. 

  4951. 	}
    4952. 

  4952. 	my $pool = SVN::Pool->new;
    4953. 

  4953. 	my $t = $self->SUPER::check_path($path, $r, $pool);
    4954. 

  4954. 	$pool->clear;
    4955. 

  4955. 	if ($r != $cache->{r}) {
    4956. 

  4956. 		%{$cache->{data}} = ();
    4957. 

  4957. 		$cache->{r} = $r;
    4958. 

  4958. 	}
    4959. 

  4959. 	$cache->{data}->{$path} = $t;
    4960. 

  4960. }
    4961. 

    4962. 

  4962. sub get_dir {
    4963. 

  4963. 	my ($self, $dir, $r) = @_;
    4964. 

  4964. 	my $cache = $self->{cache}->{get_dir};
    4965. 

  4965. 	if ($r == $cache->{r}) {
    4966. 

  4966. 		if (my $x = $cache->{data}->{$dir}) {
    4967. 

  4967. 			return wantarray ? @$x : $x->[0];
    4968. 

  4968. 		}
    4969. 

  4969. 	}
    4970. 

  4970. 	my $pool = SVN::Pool->new;
    4971. 

  4971. 	my ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
    4972. 

  4972. 	my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d;
    4973. 

  4973. 	$pool->clear;
    4974. 

  4974. 	if ($r != $cache->{r}) {
    4975. 

  4975. 		%{$cache->{data}} = ();
    4976. 

  4976. 		$cache->{r} = $r;
    4977. 

  4977. 	}
    4978. 

  4978. 	$cache->{data}->{$dir} = [ \%dirents, $r, $props ];
    4979. 

  4979. 	wantarray ? (\%dirents, $r, $props) : \%dirents;
    4980. 

  4980. }
    4981. 

    4982. 

  4982. sub DESTROY {
    4983. 

  4983. 	# do not call the real DESTROY since we store ourselves in $RA
    4984. 

  4984. }
    4985. 

    4986. 

  4986. # get_log(paths, start, end, limit,
    4987. 

  4987. #         discover_changed_paths, strict_node_history, receiver)
    4988. 

  4988. sub get_log {
    4989. 

  4989. 	my ($self, @args) = @_;
    4990. 

  4990. 	my $pool = SVN::Pool->new;
    4991. 

    4992. 

  4992. 	# svn_log_changed_path_t objects passed to get_log are likely to be
    4993. 

  4993. 	# overwritten even if only the refs are copied to an external variable,
    4994. 

  4994. 	# so we should dup the structures in their entirety.  Using an
    4995. 

  4995. 	# externally passed pool (instead of our temporary and quickly cleared
    4996. 

  4996. 	# pool in Git::SVN::Ra) does not help matters at all...
    4997. 

  4997. 	my $receiver = pop @args;
    4998. 

  4998. 	my $prefix = "/".$self->{svn_path};
    4999. 

  4999. 	$prefix =~ s#/+($)##;
    5000. 

  5000. 	my $prefix_regex = qr#^\Q$prefix\E#;
    5001. 

  5001. 	push(@args, sub {
    5002. 

  5002. 		my ($paths) = $_[0];
    5003. 

  5003. 		return &$receiver(@_) unless $paths;
    5004. 

  5004. 		$_[0] = ();
    5005. 

  5005. 		foreach my $p (keys %$paths) {
    5006. 

  5006. 			my $i = $paths->{$p};
    5007. 

  5007. 			# Make path relative to our url, not repos_root
    5008. 

  5008. 			$p =~ s/$prefix_regex//;
    5009. 

  5009. 			my %s = map { $_ => $i->$_; }
    5010. 

  5010. 				qw/copyfrom_path copyfrom_rev action/;
    5011. 

  5011. 			if ($s{'copyfrom_path'}) {
    5012. 

  5012. 				$s{'copyfrom_path'} =~ s/$prefix_regex//;
    5013. 

  5013. 			}
    5014. 

  5014. 			$_[0]{$p} = \%s;
    5015. 

  5015. 		}
    5016. 

  5016. 		&$receiver(@_);
    5017. 

  5017. 	});
    5018. 

    5019. 

    5020. 

  5020. 	# the limit parameter was not supported in SVN 1.1.x, so we
    5021. 

  5021. 	# drop it.  Therefore, the receiver callback passed to it
    5022. 

  5022. 	# is made aware of this limitation by being wrapped if
    5023. 

  5023. 	# the limit passed to is being wrapped.
    5024. 

  5024. 	if ($SVN::Core::VERSION le '1.2.0') {
    5025. 

  5025. 		my $limit = splice(@args, 3, 1);
    5026. 

  5026. 		if ($limit > 0) {
    5027. 

  5027. 			my $receiver = pop @args;
    5028. 

  5028. 			push(@args, sub { &$receiver(@_) if (--$limit >= 0) });
    5029. 

  5029. 		}
    5030. 

  5030. 	}
    5031. 

  5031. 	my $ret = $self->SUPER::get_log(@args, $pool);
    5032. 

  5032. 	$pool->clear;
    5033. 

  5033. 	$ret;
    5034. 

  5034. }
    5035. 

    5036. 

  5036. sub trees_match {
    5037. 

  5037. 	my ($self, $url1, $rev1, $url2, $rev2) = @_;
    5038. 

  5038. 	my $ctx = SVN::Client->new(auth => _auth_providers);
    5039. 

  5039. 	my $out = IO::File->new_tmpfile;
    5040. 

    5041. 

  5041. 	# older SVN (1.1.x) doesn't take $pool as the last parameter for
    5042. 

  5042. 	# $ctx->diff(), so we'll create a default one
    5043. 

  5043. 	my $pool = SVN::Pool->new_default_sub;
    5044. 

    5045. 

  5045. 	$ra_invalid = 1; # this will open a new SVN::Ra connection to $url1
    5046. 

  5046. 	$ctx->diff([], $url1, $rev1, $url2, $rev2, 1, 1, 0, $out, $out);
    5047. 

  5047. 	$out->flush;
    5048. 

  5048. 	my $ret = (($out->stat)[7] == 0);
    5049. 

  5049. 	close $out or croak $!;
    5050. 

    5051. 

  5051. 	$ret;
    5052. 

  5052. }
    5053. 

    5054. 

  5054. sub get_commit_editor {
    5055. 

  5055. 	my ($self, $log, $cb, $pool) = @_;
    5056. 

  5056. 	my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef, 0) : ();
    5057. 

  5057. 	$self->SUPER::get_commit_editor($log, $cb, @lock, $pool);
    5058. 

  5058. }
    5059. 

    5060. 

  5060. sub gs_do_update {
    5061. 

  5061. 	my ($self, $rev_a, $rev_b, $gs, $editor) = @_;
    5062. 

  5062. 	my $new = ($rev_a == $rev_b);
    5063. 

  5063. 	my $path = $gs->{path};
    5064. 

    5065. 

  5065. 	if ($new && -e $gs->{index}) {
    5066. 

  5066. 		unlink $gs->{index} or die
    5067. 

  5067. 		  "Couldn't unlink index: $gs->{index}: $!\n";
    5068. 

  5068. 	}
    5069. 

  5069. 	my $pool = SVN::Pool->new;
    5070. 

  5070. 	$editor->set_path_strip($path);
    5071. 

  5071. 	my (@pc) = split m#/#, $path;
    5072. 

  5072. 	my $reporter = $self->do_update($rev_b, (@pc ? shift @pc : ''),
    5073. 

  5073. 	                                1, $editor, $pool);
    5074. 

  5074. 	my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
    5075. 

    5076. 

  5076. 	# Since we can't rely on svn_ra_reparent being available, we'll
    5077. 

  5077. 	# just have to do some magic with set_path to make it so
    5078. 

  5078. 	# we only want a partial path.
    5079. 

  5079. 	my $sp = '';
    5080. 

  5080. 	my $final = join('/', @pc);
    5081. 

  5081. 	while (@pc) {
    5082. 

  5082. 		$reporter->set_path($sp, $rev_b, 0, @lock, $pool);
    5083. 

  5083. 		$sp .= '/' if length $sp;
    5084. 

  5084. 		$sp .= shift @pc;
    5085. 

  5085. 	}
    5086. 

  5086. 	die "BUG: '$sp' != '$final'\n" if ($sp ne $final);
    5087. 

    5088. 

  5088. 	$reporter->set_path($sp, $rev_a, $new, @lock, $pool);
    5089. 

    5090. 

  5090. 	$reporter->finish_report($pool);
    5091. 

  5091. 	$pool->clear;
    5092. 

  5092. 	$editor->{git_commit_ok};
    5093. 

  5093. }
    5094. 

    5095. 

  5095. # this requires SVN 1.4.3 or later (do_switch didn't work before 1.4.3, and
    5096. 

  5096. # svn_ra_reparent didn't work before 1.4)
    5097. 

  5097. sub gs_do_switch {
    5098. 

  5098. 	my ($self, $rev_a, $rev_b, $gs, $url_b, $editor) = @_;
    5099. 

  5099. 	my $path = $gs->{path};
    5100. 

  5100. 	my $pool = SVN::Pool->new;
    5101. 

    5102. 

  5102. 	my $full_url = $self->{url};
    5103. 

  5103. 	my $old_url = $full_url;
    5104. 

  5104. 	$full_url .= '/' . $path if length $path;
    5105. 

  5105. 	my ($ra, $reparented);
    5106. 

    5107. 

  5107. 	if ($old_url =~ m#^svn(\+ssh)?://# ||
    5108. 

  5108. 	    ($full_url =~ m#^https?://# &&
    5109. 

  5109. 	     escape_url($full_url) ne $full_url)) {
    5110. 

  5110. 		$_[0] = undef;
    5111. 

  5111. 		$self = undef;
    5112. 

  5112. 		$RA = undef;
    5113. 

  5113. 		$ra = Git::SVN::Ra->new($full_url);
    5114. 

  5114. 		$ra_invalid = 1;
    5115. 

  5115. 	} elsif ($old_url ne $full_url) {
    5116. 

  5116. 		SVN::_Ra::svn_ra_reparent($self->{session}, $full_url, $pool);
    5117. 

  5117. 		$self->{url} = $full_url;
    5118. 

  5118. 		$reparented = 1;
    5119. 

  5119. 	}
    5120. 

    5121. 

  5121. 	$ra ||= $self;
    5122. 

  5122. 	$url_b = escape_url($url_b);
    5123. 

  5123. 	my $reporter = $ra->do_switch($rev_b, '', 1, $url_b, $editor, $pool);
    5124. 

  5124. 	my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
    5125. 

  5125. 	$reporter->set_path('', $rev_a, 0, @lock, $pool);
    5126. 

  5126. 	$reporter->finish_report($pool);
    5127. 

    5128. 

  5128. 	if ($reparented) {
    5129. 

  5129. 		SVN::_Ra::svn_ra_reparent($self->{session}, $old_url, $pool);
    5130. 

  5130. 		$self->{url} = $old_url;
    5131. 

  5131. 	}
    5132. 

    5133. 

  5133. 	$pool->clear;
    5134. 

  5134. 	$editor->{git_commit_ok};
    5135. 

  5135. }
    5136. 

    5137. 

  5137. sub longest_common_path {
    5138. 

  5138. 	my ($gsv, $globs) = @_;
    5139. 

  5139. 	my %common;
    5140. 

  5140. 	my $common_max = scalar @$gsv;
    5141. 

    5142. 

  5142. 	foreach my $gs (@$gsv) {
    5143. 

  5143. 		my @tmp = split m#/#, $gs->{path};
    5144. 

  5144. 		my $p = '';
    5145. 

  5145. 		foreach (@tmp) {
    5146. 

  5146. 			$p .= length($p) ? "/$_" : $_;
    5147. 

  5147. 			$common{$p} ||= 0;
    5148. 

  5148. 			$common{$p}++;
    5149. 

  5149. 		}
    5150. 

  5150. 	}
    5151. 

  5151. 	$globs ||= [];
    5152. 

  5152. 	$common_max += scalar @$globs;
    5153. 

  5153. 	foreach my $glob (@$globs) {
    5154. 

  5154. 		my @tmp = split m#/#, $glob->{path}->{left};
    5155. 

  5155. 		my $p = '';
    5156. 

  5156. 		foreach (@tmp) {
    5157. 

  5157. 			$p .= length($p) ? "/$_" : $_;
    5158. 

  5158. 			$common{$p} ||= 0;
    5159. 

  5159. 			$common{$p}++;
    5160. 

  5160. 		}
    5161. 

  5161. 	}
    5162. 

    5163. 

  5163. 	my $longest_path = '';
    5164. 

  5164. 	foreach (sort {length $b <=> length $a} keys %common) {
    5165. 

  5165. 		if ($common{$_} == $common_max) {
    5166. 

  5166. 			$longest_path = $_;
    5167. 

  5167. 			last;
    5168. 

  5168. 		}
    5169. 

  5169. 	}
    5170. 

  5170. 	$longest_path;
    5171. 

  5171. }
    5172. 

    5173. 

  5173. sub gs_fetch_loop_common {
    5174. 

  5174. 	my ($self, $base, $head, $gsv, $globs) = @_;
    5175. 

  5175. 	return if ($base > $head);
    5176. 

  5176. 	my $inc = $_log_window_size;
    5177. 

  5177. 	my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
    5178. 

  5178. 	my $longest_path = longest_common_path($gsv, $globs);
    5179. 

  5179. 	my $ra_url = $self->{url};
    5180. 

  5180. 	my $find_trailing_edge;
    5181. 

  5181. 	while (1) {
    5182. 

  5182. 		my %revs;
    5183. 

  5183. 		my $err;
    5184. 

  5184. 		my $err_handler = $SVN::Error::handler;
    5185. 

  5185. 		$SVN::Error::handler = sub {
    5186. 

  5186. 			($err) = @_;
    5187. 

  5187. 			skip_unknown_revs($err);
    5188. 

  5188. 		};
    5189. 

  5189. 		sub _cb {
    5190. 

  5190. 			my ($paths, $r, $author, $date, $log) = @_;
    5191. 

  5191. 			[ $paths,
    5192. 

  5192. 			  { author => $author, date => $date, log => $log } ];
    5193. 

  5193. 		}
    5194. 

  5194. 		$self->get_log([$longest_path], $min, $max, 0, 1, 1,
    5195. 

  5195. 		               sub { $revs{$_[1]} = _cb(@_) });
    5196. 

  5196. 		if ($err) {
    5197. 

  5197. 			print "Checked through r$max\r";
    5198. 

  5198. 		} else {
    5199. 

  5199. 			$find_trailing_edge = 1;
    5200. 

  5200. 		}
    5201. 

  5201. 		if ($err and $find_trailing_edge) {
    5202. 

  5202. 			print STDERR "Path '$longest_path' ",
    5203. 

  5203. 				     "was probably deleted:\n",
    5204. 

  5204. 				     $err->expanded_message,
    5205. 

  5205. 				     "\nWill attempt to follow ",
    5206. 

  5206. 				     "revisions r$min .. r$max ",
    5207. 

  5207. 				     "committed before the deletion\n";
    5208. 

  5208. 			my $hi = $max;
    5209. 

  5209. 			while (--$hi >= $min) {
    5210. 

  5210. 				my $ok;
    5211. 

  5211. 				$self->get_log([$longest_path], $min, $hi,
    5212. 

  5212. 				               0, 1, 1, sub {
    5213. 

  5213. 				               $ok = $_[1];
    5214. 

  5214. 				               $revs{$_[1]} = _cb(@_) });
    5215. 

  5215. 				if ($ok) {
    5216. 

  5216. 					print STDERR "r$min .. r$ok OK\n";
    5217. 

  5217. 					last;
    5218. 

  5218. 				}
    5219. 

  5219. 			}
    5220. 

  5220. 			$find_trailing_edge = 0;
    5221. 

  5221. 		}
    5222. 

  5222. 		$SVN::Error::handler = $err_handler;
    5223. 

    5224. 

  5224. 		my %exists = map { $_->{path} => $_ } @$gsv;
    5225. 

  5225. 		foreach my $r (sort {$a <=> $b} keys %revs) {
    5226. 

  5226. 			my ($paths, $logged) = @{$revs{$r}};
    5227. 

    5228. 

  5228. 			foreach my $gs ($self->match_globs(\%exists, $paths,
    5229. 

  5229. 			                                   $globs, $r)) {
    5230. 

  5230. 				if ($gs->rev_map_max >= $r) {
    5231. 

  5231. 					next;
    5232. 

  5232. 				}
    5233. 

  5233. 				next unless $gs->match_paths($paths, $r);
    5234. 

  5234. 				$gs->{logged_rev_props} = $logged;
    5235. 

  5235. 				if (my $last_commit = $gs->last_commit) {
    5236. 

  5236. 					$gs->assert_index_clean($last_commit);
    5237. 

  5237. 				}
    5238. 

  5238. 				my $log_entry = $gs->do_fetch($paths, $r);
    5239. 

  5239. 				if ($log_entry) {
    5240. 

  5240. 					$gs->do_git_commit($log_entry);
    5241. 

  5241. 				}
    5242. 

  5242. 				$INDEX_FILES{$gs->{index}} = 1;
    5243. 

  5243. 			}
    5244. 

  5244. 			foreach my $g (@$globs) {
    5245. 

  5245. 				my $k = "svn-remote.$g->{remote}." .
    5246. 

  5246. 				        "$g->{t}-maxRev";
    5247. 

  5247. 				Git::SVN::tmp_config($k, $r);
    5248. 

  5248. 			}
    5249. 

  5249. 			if ($ra_invalid) {
    5250. 

  5250. 				$_[0] = undef;
    5251. 

  5251. 				$self = undef;
    5252. 

  5252. 				$RA = undef;
    5253. 

  5253. 				$self = Git::SVN::Ra->new($ra_url);
    5254. 

  5254. 				$ra_invalid = undef;
    5255. 

  5255. 			}
    5256. 

  5256. 		}
    5257. 

  5257. 		# pre-fill the .rev_db since it'll eventually get filled in
    5258. 

  5258. 		# with '0' x40 if something new gets committed
    5259. 

  5259. 		foreach my $gs (@$gsv) {
    5260. 

  5260. 			next if $gs->rev_map_max >= $max;
    5261. 

  5261. 			next if defined $gs->rev_map_get($max);
    5262. 

  5262. 			$gs->rev_map_set($max, 0 x40);
    5263. 

  5263. 		}
    5264. 

  5264. 		foreach my $g (@$globs) {
    5265. 

  5265. 			my $k = "svn-remote.$g->{remote}.$g->{t}-maxRev";
    5266. 

  5266. 			Git::SVN::tmp_config($k, $max);
    5267. 

  5267. 		}
    5268. 

  5268. 		last if $max >= $head;
    5269. 

  5269. 		$min = $max + 1;
    5270. 

  5270. 		$max += $inc;
    5271. 

  5271. 		$max = $head if ($max > $head);
    5272. 

  5272. 	}
    5273. 

  5273. 	Git::SVN::gc();
    5274. 

  5274. }
    5275. 

    5276. 

  5276. sub get_dir_globbed {
    5277. 

  5277. 	my ($self, $left, $depth, $r) = @_;
    5278. 

    5279. 

  5279. 	my @x = eval { $self->get_dir($left, $r) };
    5280. 

  5280. 	return unless scalar @x == 3;
    5281. 

  5281. 	my $dirents = $x[0];
    5282. 

  5282. 	my @finalents;
    5283. 

  5283. 	foreach my $de (keys %$dirents) {
    5284. 

  5284. 		next if $dirents->{$de}->{kind} != $SVN::Node::dir;
    5285. 

  5285. 		if ($depth > 1) {
    5286. 

  5286. 			my @args = ("$left/$de", $depth - 1, $r);
    5287. 

  5287. 			foreach my $dir ($self->get_dir_globbed(@args)) {
    5288. 

  5288. 				push @finalents, "$de/$dir";
    5289. 

  5289. 			}
    5290. 

  5290. 		} else {
    5291. 

  5291. 			push @finalents, $de;
    5292. 

  5292. 		}
    5293. 

  5293. 	}
    5294. 

  5294. 	@finalents;
    5295. 

  5295. }
    5296. 

    5297. 

  5297. sub match_globs {
    5298. 

  5298. 	my ($self, $exists, $paths, $globs, $r) = @_;
    5299. 

    5300. 

  5300. 	sub get_dir_check {
    5301. 

  5301. 		my ($self, $exists, $g, $r) = @_;
    5302. 

    5303. 

  5303. 		my @dirs = $self->get_dir_globbed($g->{path}->{left},
    5304. 

  5304. 		                                  $g->{path}->{depth},
    5305. 

  5305. 		                                  $r);
    5306. 

    5307. 

  5307. 		foreach my $de (@dirs) {
    5308. 

  5308. 			my $p = $g->{path}->full_path($de);
    5309. 

  5309. 			next if $exists->{$p};
    5310. 

  5310. 			next if (length $g->{path}->{right} &&
    5311. 

  5311. 				 ($self->check_path($p, $r) !=
    5312. 

  5312. 				  $SVN::Node::dir));
    5313. 

  5313. 			next unless $p =~ /$g->{path}->{regex}/;
    5314. 

  5314. 			$exists->{$p} = Git::SVN->init($self->{url}, $p, undef,
    5315. 

  5315. 					 $g->{ref}->full_path($de), 1);
    5316. 

  5316. 		}
    5317. 

  5317. 	}
    5318. 

  5318. 	foreach my $g (@$globs) {
    5319. 

  5319. 		if (my $path = $paths->{"/$g->{path}->{left}"}) {
    5320. 

  5320. 			if ($path->{action} =~ /^[AR]$/) {
    5321. 

  5321. 				get_dir_check($self, $exists, $g, $r);
    5322. 

  5322. 			}
    5323. 

  5323. 		}
    5324. 

  5324. 		foreach (keys %$paths) {
    5325. 

  5325. 			if (/$g->{path}->{left_regex}/ &&
    5326. 

  5326. 			    !/$g->{path}->{regex}/) {
    5327. 

  5327. 				next if $paths->{$_}->{action} !~ /^[AR]$/;
    5328. 

  5328. 				get_dir_check($self, $exists, $g, $r);
    5329. 

  5329. 			}
    5330. 

  5330. 			next unless /$g->{path}->{regex}/;
    5331. 

  5331. 			my $p = $1;
    5332. 

  5332. 			my $pathname = $g->{path}->full_path($p);
    5333. 

  5333. 			next if $exists->{$pathname};
    5334. 

  5334. 			next if ($self->check_path($pathname, $r) !=
    5335. 

  5335. 			         $SVN::Node::dir);
    5336. 

  5336. 			$exists->{$pathname} = Git::SVN->init(
    5337. 

  5337. 			                      $self->{url}, $pathname, undef,
    5338. 

  5338. 			                      $g->{ref}->full_path($p), 1);
    5339. 

  5339. 		}
    5340. 

  5340. 		my $c = '';
    5341. 

  5341. 		foreach (split m#/#, $g->{path}->{left}) {
    5342. 

  5342. 			$c .= "/$_";
    5343. 

  5343. 			next unless ($paths->{$c} &&
    5344. 

  5344. 			             ($paths->{$c}->{action} =~ /^[AR]$/));
    5345. 

  5345. 			get_dir_check($self, $exists, $g, $r);
    5346. 

  5346. 		}
    5347. 

  5347. 	}
    5348. 

  5348. 	values %$exists;
    5349. 

  5349. }
    5350. 

    5351. 

  5351. sub minimize_url {
    5352. 

  5352. 	my ($self) = @_;
    5353. 

  5353. 	return $self->{url} if ($self->{url} eq $self->{repos_root});
    5354. 

  5354. 	my $url = $self->{repos_root};
    5355. 

  5355. 	my @components = split(m!/!, $self->{svn_path});
    5356. 

  5356. 	my $c = '';
    5357. 

  5357. 	do {
    5358. 

  5358. 		$url .= "/$c" if length $c;
    5359. 

  5359. 		eval {
    5360. 

  5360. 			my $ra = (ref $self)->new($url);
    5361. 

  5361. 			my $latest = $ra->get_latest_revnum;
    5362. 

  5362. 			$ra->get_log("", $latest, 0, 1, 0, 1, sub {});
    5363. 

  5363. 		};
    5364. 

  5364. 	} while ($@ && ($c = shift @components));
    5365. 

  5365. 	$url;
    5366. 

  5366. }
    5367. 

    5368. 

  5368. sub can_do_switch {
    5369. 

  5369. 	my $self = shift;
    5370. 

  5370. 	unless (defined $can_do_switch) {
    5371. 

  5371. 		my $pool = SVN::Pool->new;
    5372. 

  5372. 		my $rep = eval {
    5373. 

  5373. 			$self->do_switch(1, '', 0, $self->{url},
    5374. 

  5374. 			                 SVN::Delta::Editor->new, $pool);
    5375. 

  5375. 		};
    5376. 

  5376. 		if ($@) {
    5377. 

  5377. 			$can_do_switch = 0;
    5378. 

  5378. 		} else {
    5379. 

  5379. 			$rep->abort_report($pool);
    5380. 

  5380. 			$can_do_switch = 1;
    5381. 

  5381. 		}
    5382. 

  5382. 		$pool->clear;
    5383. 

  5383. 	}
    5384. 

  5384. 	$can_do_switch;
    5385. 

  5385. }
    5386. 

    5387. 

  5387. sub skip_unknown_revs {
    5388. 

  5388. 	my ($err) = @_;
    5389. 

  5389. 	my $errno = $err->apr_err();
    5390. 

  5390. 	# Maybe the branch we're tracking didn't
    5391. 

  5391. 	# exist when the repo started, so it's
    5392. 

  5392. 	# not an error if it doesn't, just continue
    5393. 

  5393. 	#
    5394. 

  5394. 	# Wonderfully consistent library, eh?
    5395. 

  5395. 	# 160013 - svn:// and file://
    5396. 

  5396. 	# 175002 - http(s)://
    5397. 

  5397. 	# 175007 - http(s):// (this repo required authorization, too...)
    5398. 

  5398. 	#   More codes may be discovered later...
    5399. 

  5399. 	if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
    5400. 

  5400. 		my $err_key = $err->expanded_message;
    5401. 

  5401. 		# revision numbers change every time, filter them out
    5402. 

  5402. 		$err_key =~ s/\d+/\0/g;
    5403. 

  5403. 		$err_key = "$errno\0$err_key";
    5404. 

  5404. 		unless ($ignored_err{$err_key}) {
    5405. 

  5405. 			warn "W: Ignoring error from SVN, path probably ",
    5406. 

  5406. 			     "does not exist: ($errno): ",
    5407. 

  5407. 			     $err->expanded_message,"\n";
    5408. 

  5408. 			warn "W: Do not be alarmed at the above message ",
    5409. 

  5409. 			     "git-svn is just searching aggressively for ",
    5410. 

  5410. 			     "old history.\n",
    5411. 

  5411. 			     "This may take a while on large repositories\n";
    5412. 

  5412. 			$ignored_err{$err_key} = 1;
    5413. 

  5413. 		}
    5414. 

  5414. 		return;
    5415. 

  5415. 	}
    5416. 

  5416. 	die "Error from SVN, ($errno): ", $err->expanded_message,"\n";
    5417. 

  5417. }
    5418. 

    5419. 

  5419. package Git::SVN::Log;
    5420. 

  5420. use strict;
    5421. 

  5421. use warnings;
    5422. 

  5422. use POSIX qw/strftime/;
    5423. 

  5423. use Time::Local;
    5424. 

  5424. use constant commit_log_separator => ('-' x 72) . "\n";
    5425. 

  5425. use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline
    5426. 

  5426.             %rusers $show_commit $incremental/;
    5427. 

  5427. my $l_fmt;
    5428. 

    5429. 

  5429. sub cmt_showable {
    5430. 

  5430. 	my ($c) = @_;
    5431. 

  5431. 	return 1 if defined $c->{r};
    5432. 

    5433. 

  5433. 	# big commit message got truncated by the 16k pretty buffer in rev-list
    5434. 

  5434. 	if ($c->{l} && $c->{l}->[-1] eq "...\n" &&
    5435. 

  5435. 				$c->{a_raw} =~ /\@([a-f\d\-]+)>$/) {
    5436. 

  5436. 		@{$c->{l}} = ();
    5437. 

  5437. 		my @log = command(qw/cat-file commit/, $c->{c});
    5438. 

    5439. 

  5439. 		# shift off the headers
    5440. 

  5440. 		shift @log while ($log[0] ne '');
    5441. 

  5441. 		shift @log;
    5442. 

    5443. 

  5443. 		# TODO: make $c->{l} not have a trailing newline in the future
    5444. 

  5444. 		@{$c->{l}} = map { "$_\n" } grep !/^git-svn-id: /, @log;
    5445. 

    5446. 

  5446. 		(undef, $c->{r}, undef) = ::extract_metadata(
    5447. 

  5447. 				(grep(/^git-svn-id: /, @log))[-1]);
    5448. 

  5448. 	}
    5449. 

  5449. 	return defined $c->{r};
    5450. 

  5450. }
    5451. 

    5452. 

  5452. sub log_use_color {
    5453. 

  5453. 	return $color || Git->repository->get_colorbool('color.diff');
    5454. 

  5454. }
    5455. 

    5456. 

  5456. sub git_svn_log_cmd {
    5457. 

  5457. 	my ($r_min, $r_max, @args) = @_;
    5458. 

  5458. 	my $head = 'HEAD';
    5459. 

  5459. 	my (@files, @log_opts);
    5460. 

  5460. 	foreach my $x (@args) {
    5461. 

  5461. 		if ($x eq '--' || @files) {
    5462. 

  5462. 			push @files, $x;
    5463. 

  5463. 		} else {
    5464. 

  5464. 			if (::verify_ref("$x^0")) {
    5465. 

  5465. 				$head = $x;
    5466. 

  5466. 			} else {
    5467. 

  5467. 				push @log_opts, $x;
    5468. 

  5468. 			}
    5469. 

  5469. 		}
    5470. 

  5470. 	}
    5471. 

    5472. 

  5472. 	my ($url, $rev, $uuid, $gs) = ::working_head_info($head);
    5473. 

  5473. 	$gs ||= Git::SVN->_new;
    5474. 

  5474. 	my @cmd = (qw/log --abbrev-commit --pretty=raw --default/,
    5475. 

  5475. 	           $gs->refname);
    5476. 

  5476. 	push @cmd, '-r' unless $non_recursive;
    5477. 

  5477. 	push @cmd, qw/--raw --name-status/ if $verbose;
    5478. 

  5478. 	push @cmd, '--color' if log_use_color();
    5479. 

  5479. 	push @cmd, @log_opts;
    5480. 

  5480. 	if (defined $r_max && $r_max == $r_min) {
    5481. 

  5481. 		push @cmd, '--max-count=1';
    5482. 

  5482. 		if (my $c = $gs->rev_map_get($r_max)) {
    5483. 

  5483. 			push @cmd, $c;
    5484. 

  5484. 		}
    5485. 

  5485. 	} elsif (defined $r_max) {
    5486. 

  5486. 		if ($r_max < $r_min) {
    5487. 

  5487. 			($r_min, $r_max) = ($r_max, $r_min);
    5488. 

  5488. 		}
    5489. 

  5489. 		my (undef, $c_max) = $gs->find_rev_before($r_max, 1, $r_min);
    5490. 

  5490. 		my (undef, $c_min) = $gs->find_rev_after($r_min, 1, $r_max);
    5491. 

  5491. 		# If there are no commits in the range, both $c_max and $c_min
    5492. 

  5492. 		# will be undefined.  If there is at least 1 commit in the
    5493. 

  5493. 		# range, both will be defined.
    5494. 

  5494. 		return () if !defined $c_min || !defined $c_max;
    5495. 

  5495. 		if ($c_min eq $c_max) {
    5496. 

  5496. 			push @cmd, '--max-count=1', $c_min;
    5497. 

  5497. 		} else {
    5498. 

  5498. 			push @cmd, '--boundary', "$c_min..$c_max";
    5499. 

  5499. 		}
    5500. 

  5500. 	}
    5501. 

  5501. 	return (@cmd, @files);
    5502. 

  5502. }
    5503. 

    5504. 

  5504. # adapted from pager.c
    5505. 

  5505. sub config_pager {
    5506. 

  5506. 	if (! -t *STDOUT) {
    5507. 

  5507. 		$ENV{GIT_PAGER_IN_USE} = 'false';
    5508. 

  5508. 		$pager = undef;
    5509. 

  5509. 		return;
    5510. 

  5510. 	}
    5511. 

  5511. 	chomp($pager = command_oneline(qw(var GIT_PAGER)));
    5512. 

  5512. 	if ($pager eq 'cat') {
    5513. 

  5513. 		$pager = undef;
    5514. 

  5514. 	}
    5515. 

  5515. 	$ENV{GIT_PAGER_IN_USE} = defined($pager);
    5516. 

  5516. }
    5517. 

    5518. 

  5518. sub run_pager {
    5519. 

  5519. 	return unless defined $pager;
    5520. 

  5520. 	pipe my ($rfd, $wfd) or return;
    5521. 

  5521. 	defined(my $pid = fork) or ::fatal "Can't fork: $!";
    5522. 

  5522. 	if (!$pid) {
    5523. 

  5523. 		open STDOUT, '>&', $wfd or
    5524. 

  5524. 		                     ::fatal "Can't redirect to stdout: $!";
    5525. 

  5525. 		return;
    5526. 

  5526. 	}
    5527. 

  5527. 	open STDIN, '<&', $rfd or ::fatal "Can't redirect stdin: $!";
    5528. 

  5528. 	$ENV{LESS} ||= 'FRSX';
    5529. 

  5529. 	exec $pager or ::fatal "Can't run pager: $! ($pager)";
    5530. 

  5530. }
    5531. 

    5532. 

  5532. sub format_svn_date {
    5533. 

  5533. 	# some systmes don't handle or mishandle %z, so be creative.
    5534. 

  5534. 	my $t = shift || time;
    5535. 

  5535. 	my $gm = timelocal(gmtime($t));
    5536. 

  5536. 	my $sign = qw( + + - )[ $t <=> $gm ];
    5537. 

  5537. 	my $gmoff = sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]);
    5538. 

  5538. 	return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t));
    5539. 

  5539. }
    5540. 

    5541. 

  5541. sub parse_git_date {
    5542. 

  5542. 	my ($t, $tz) = @_;
    5543. 

  5543. 	# Date::Parse isn't in the standard Perl distro :(
    5544. 

  5544. 	if ($tz =~ s/^\+//) {
    5545. 

  5545. 		$t += tz_to_s_offset($tz);
    5546. 

  5546. 	} elsif ($tz =~ s/^\-//) {
    5547. 

  5547. 		$t -= tz_to_s_offset($tz);
    5548. 

  5548. 	}
    5549. 

  5549. 	return $t;
    5550. 

  5550. }
    5551. 

    5552. 

  5552. sub set_local_timezone {
    5553. 

  5553. 	if (defined $TZ) {
    5554. 

  5554. 		$ENV{TZ} = $TZ;
    5555. 

  5555. 	} else {
    5556. 

  5556. 		delete $ENV{TZ};
    5557. 

  5557. 	}
    5558. 

  5558. }
    5559. 

    5560. 

  5560. sub tz_to_s_offset {
    5561. 

  5561. 	my ($tz) = @_;
    5562. 

  5562. 	$tz =~ s/(\d\d)$//;
    5563. 

  5563. 	return ($1 * 60) + ($tz * 3600);
    5564. 

  5564. }
    5565. 

    5566. 

  5566. sub get_author_info {
    5567. 

  5567. 	my ($dest, $author, $t, $tz) = @_;
    5568. 

  5568. 	$author =~ s/(?:^\s*|\s*$)//g;
    5569. 

  5569. 	$dest->{a_raw} = $author;
    5570. 

  5570. 	my $au;
    5571. 

  5571. 	if ($::_authors) {
    5572. 

  5572. 		$au = $rusers{$author} || undef;
    5573. 

  5573. 	}
    5574. 

  5574. 	if (!$au) {
    5575. 

  5575. 		($au) = ($author =~ /<([^>]+)\@[^>]+>$/);
    5576. 

  5576. 	}
    5577. 

  5577. 	$dest->{t} = $t;
    5578. 

  5578. 	$dest->{tz} = $tz;
    5579. 

  5579. 	$dest->{a} = $au;
    5580. 

  5580. 	$dest->{t_utc} = parse_git_date($t, $tz);
    5581. 

  5581. }
    5582. 

    5583. 

  5583. sub process_commit {
    5584. 

  5584. 	my ($c, $r_min, $r_max, $defer) = @_;
    5585. 

  5585. 	if (defined $r_min && defined $r_max) {
    5586. 

  5586. 		if ($r_min == $c->{r} && $r_min == $r_max) {
    5587. 

  5587. 			show_commit($c);
    5588. 

  5588. 			return 0;
    5589. 

  5589. 		}
    5590. 

  5590. 		return 1 if $r_min == $r_max;
    5591. 

  5591. 		if ($r_min < $r_max) {
    5592. 

  5592. 			# we need to reverse the print order
    5593. 

  5593. 			return 0 if (defined $limit && --$limit < 0);
    5594. 

  5594. 			push @$defer, $c;
    5595. 

  5595. 			return 1;
    5596. 

  5596. 		}
    5597. 

  5597. 		if ($r_min != $r_max) {
    5598. 

  5598. 			return 1 if ($r_min < $c->{r});
    5599. 

  5599. 			return 1 if ($r_max > $c->{r});
    5600. 

  5600. 		}
    5601. 

  5601. 	}
    5602. 

  5602. 	return 0 if (defined $limit && --$limit < 0);
    5603. 

  5603. 	show_commit($c);
    5604. 

  5604. 	return 1;
    5605. 

  5605. }
    5606. 

    5607. 

  5607. sub show_commit {
    5608. 

  5608. 	my $c = shift;
    5609. 

  5609. 	if ($oneline) {
    5610. 

  5610. 		my $x = "\n";
    5611. 

  5611. 		if (my $l = $c->{l}) {
    5612. 

  5612. 			while ($l->[0] =~ /^\s*$/) { shift @$l }
    5613. 

  5613. 			$x = $l->[0];
    5614. 

  5614. 		}
    5615. 

  5615. 		$l_fmt ||= 'A' . length($c->{r});
    5616. 

  5616. 		print 'r',pack($l_fmt, $c->{r}),' | ';
    5617. 

  5617. 		print "$c->{c} | " if $show_commit;
    5618. 

  5618. 		print $x;
    5619. 

  5619. 	} else {
    5620. 

  5620. 		show_commit_normal($c);
    5621. 

  5621. 	}
    5622. 

  5622. }
    5623. 

    5624. 

  5624. sub show_commit_changed_paths {
    5625. 

  5625. 	my ($c) = @_;
    5626. 

  5626. 	return unless $c->{changed};
    5627. 

  5627. 	print "Changed paths:\n", @{$c->{changed}};
    5628. 

  5628. }
    5629. 

    5630. 

  5630. sub show_commit_normal {
    5631. 

  5631. 	my ($c) = @_;
    5632. 

  5632. 	print commit_log_separator, "r$c->{r} | ";
    5633. 

  5633. 	print "$c->{c} | " if $show_commit;
    5634. 

  5634. 	print "$c->{a} | ", format_svn_date($c->{t_utc}), ' | ';
    5635. 

  5635. 	my $nr_line = 0;
    5636. 

    5637. 

  5637. 	if (my $l = $c->{l}) {
    5638. 

  5638. 		while ($l->[$#$l] eq "\n" && $#$l > 0
    5639. 

  5639. 		                          && $l->[($#$l - 1)] eq "\n") {
    5640. 

  5640. 			pop @$l;
    5641. 

  5641. 		}
    5642. 

  5642. 		$nr_line = scalar @$l;
    5643. 

  5643. 		if (!$nr_line) {
    5644. 

  5644. 			print "1 line\n\n\n";
    5645. 

  5645. 		} else {
    5646. 

  5646. 			if ($nr_line == 1) {
    5647. 

  5647. 				$nr_line = '1 line';
    5648. 

  5648. 			} else {
    5649. 

  5649. 				$nr_line .= ' lines';
    5650. 

  5650. 			}
    5651. 

  5651. 			print $nr_line, "\n";
    5652. 

  5652. 			show_commit_changed_paths($c);
    5653. 

  5653. 			print "\n";
    5654. 

  5654. 			print $_ foreach @$l;
    5655. 

  5655. 		}
    5656. 

  5656. 	} else {
    5657. 

  5657. 		print "1 line\n";
    5658. 

  5658. 		show_commit_changed_paths($c);
    5659. 

  5659. 		print "\n";
    5660. 

    5661. 

  5661. 	}
    5662. 

  5662. 	foreach my $x (qw/raw stat diff/) {
    5663. 

  5663. 		if ($c->{$x}) {
    5664. 

  5664. 			print "\n";
    5665. 

  5665. 			print $_ foreach @{$c->{$x}}
    5666. 

  5666. 		}
    5667. 

  5667. 	}
    5668. 

  5668. }
    5669. 

    5670. 

  5670. sub cmd_show_log {
    5671. 

  5671. 	my (@args) = @_;
    5672. 

  5672. 	my ($r_min, $r_max);
    5673. 

  5673. 	my $r_last = -1; # prevent dupes
    5674. 

  5674. 	set_local_timezone();
    5675. 

  5675. 	if (defined $::_revision) {
    5676. 

  5676. 		if ($::_revision =~ /^(\d+):(\d+)$/) {
    5677. 

  5677. 			($r_min, $r_max) = ($1, $2);
    5678. 

  5678. 		} elsif ($::_revision =~ /^\d+$/) {
    5679. 

  5679. 			$r_min = $r_max = $::_revision;
    5680. 

  5680. 		} else {
    5681. 

  5681. 			::fatal "-r$::_revision is not supported, use ",
    5682. 

  5682. 				"standard 'git log' arguments instead";
    5683. 

  5683. 		}
    5684. 

  5684. 	}
    5685. 

    5686. 

  5686. 	config_pager();
    5687. 

  5687. 	@args = git_svn_log_cmd($r_min, $r_max, @args);
    5688. 

  5688. 	if (!@args) {
    5689. 

  5689. 		print commit_log_separator unless $incremental || $oneline;
    5690. 

  5690. 		return;
    5691. 

  5691. 	}
    5692. 

  5692. 	my $log = command_output_pipe(@args);
    5693. 

  5693. 	run_pager();
    5694. 

  5694. 	my (@k, $c, $d, $stat);
    5695. 

  5695. 	my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/;
    5696. 

  5696. 	while (<$log>) {
    5697. 

  5697. 		if (/^${esc_color}commit -?($::sha1_short)/o) {
    5698. 

  5698. 			my $cmt = $1;
    5699. 

  5699. 			if ($c && cmt_showable($c) && $c->{r} != $r_last) {
    5700. 

  5700. 				$r_last = $c->{r};
    5701. 

  5701. 				process_commit($c, $r_min, $r_max, \@k) or
    5702. 

  5702. 								goto out;
    5703. 

  5703. 			}
    5704. 

  5704. 			$d = undef;
    5705. 

  5705. 			$c = { c => $cmt };
    5706. 

  5706. 		} elsif (/^${esc_color}author (.+) (\d+) ([\-\+]?\d+)$/o) {
    5707. 

  5707. 			get_author_info($c, $1, $2, $3);
    5708. 

  5708. 		} elsif (/^${esc_color}(?:tree|parent|committer) /o) {
    5709. 

  5709. 			# ignore
    5710. 

  5710. 		} elsif (/^${esc_color}:\d{6} \d{6} $::sha1_short/o) {
    5711. 

  5711. 			push @{$c->{raw}}, $_;
    5712. 

  5712. 		} elsif (/^${esc_color}[ACRMDT]\t/) {
    5713. 

  5713. 			# we could add $SVN->{svn_path} here, but that requires
    5714. 

  5714. 			# remote access at the moment (repo_path_split)...
    5715. 

  5715. 			s#^(${esc_color})([ACRMDT])\t#$1   $2 #o;
    5716. 

  5716. 			push @{$c->{changed}}, $_;
    5717. 

  5717. 		} elsif (/^${esc_color}diff /o) {
    5718. 

  5718. 			$d = 1;
    5719. 

  5719. 			push @{$c->{diff}}, $_;
    5720. 

  5720. 		} elsif ($d) {
    5721. 

  5721. 			push @{$c->{diff}}, $_;
    5722. 

  5722. 		} elsif (/^\ .+\ \|\s*\d+\ $esc_color[\+\-]*
    5723. 

  5723. 		          $esc_color*[\+\-]*$esc_color$/x) {
    5724. 

  5724. 			$stat = 1;
    5725. 

  5725. 			push @{$c->{stat}}, $_;
    5726. 

  5726. 		} elsif ($stat && /^ \d+ files changed, \d+ insertions/) {
    5727. 

  5727. 			push @{$c->{stat}}, $_;
    5728. 

  5728. 			$stat = undef;
    5729. 

  5729. 		} elsif (/^${esc_color}    (git-svn-id:.+)$/o) {
    5730. 

  5730. 			($c->{url}, $c->{r}, undef) = ::extract_metadata($1);
    5731. 

  5731. 		} elsif (s/^${esc_color}    //o) {
    5732. 

  5732. 			push @{$c->{l}}, $_;
    5733. 

  5733. 		}
    5734. 

  5734. 	}
    5735. 

  5735. 	if ($c && defined $c->{r} && $c->{r} != $r_last) {
    5736. 

  5736. 		$r_last = $c->{r};
    5737. 

  5737. 		process_commit($c, $r_min, $r_max, \@k);
    5738. 

  5738. 	}
    5739. 

  5739. 	if (@k) {
    5740. 

  5740. 		($r_min, $r_max) = ($r_max, $r_min);
    5741. 

  5741. 		process_commit($_, $r_min, $r_max) foreach reverse @k;
    5742. 

  5742. 	}
    5743. 

  5743. out:
    5744. 

  5744. 	close $log;
    5745. 

  5745. 	print commit_log_separator unless $incremental || $oneline;
    5746. 

  5746. }
    5747. 

  5747. 

  5748. sub cmd_blame {
    5749. 

  5749. 	my $path = pop;
    5750. 

  5750. 

  5751. 	config_pager();
    5752. 

  5752. 	run_pager();
    5753. 

  5753. 

  5754. 	my ($fh, $ctx, $rev);
    5755. 

  5755. 

  5756. 	if ($_git_format) {
    5757. 

  5757. 		($fh, $ctx) = command_output_pipe('blame', @_, $path);
    5758. 

  5758. 		while (my $line = <$fh>) {
    5759. 

  5759. 			if ($line =~ /^\^?([[:xdigit:]]+)\s/) {
    5760. 

  5760. 				# Uncommitted edits show up as a rev ID of
    5761. 

  5761. 				# all zeros, which we can't look up with
    5762. 

  5762. 				# cmt_metadata
    5763. 

  5763. 				if ($1 !~ /^0+$/) {
    5764. 

  5764. 					(undef, $rev, undef) =
    5765. 

  5765. 						::cmt_metadata($1);
    5766. 

  5766. 					$rev = '0' if (!$rev);
    5767. 

  5767. 				} else {
    5768. 

  5768. 					$rev = '0';
    5769. 

  5769. 				}
    5770. 

  5770. 				$rev = sprintf('%-10s', $rev);
    5771. 

  5771. 				$line =~ s/^\^?[[:xdigit:]]+(\s)/$rev$1/;
    5772. 

  5772. 			}
    5773. 

  5773. 			print $line;
    5774. 

  5774. 		}
    5775. 

  5775. 	} else {
    5776. 

  5776. 		($fh, $ctx) = command_output_pipe('blame', '-p', @_, 'HEAD',
    5777. 

  5777. 						  '--', $path);
    5778. 

  5778. 		my ($sha1);
    5779. 

  5779. 		my %authors;
    5780. 

  5780. 		my @buffer;
    5781. 

  5781. 		my %dsha; #distinct sha keys
    5782. 

  5782. 

  5783. 		while (my $line = <$fh>) {
    5784. 

  5784. 			push @buffer, $line;
    5785. 

  5785. 			if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) {
    5786. 

  5786. 				$dsha{$1} = 1;
    5787. 

  5787. 			}
    5788. 

  5788. 		}
    5789. 

  5789. 

  5790. 		my $s2r = ::cmt_sha2rev_batch([keys %dsha]);
    5791. 

  5791. 

  5792. 		foreach my $line (@buffer) {
    5793. 

  5793. 			if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) {
    5794. 

  5794. 				$rev = $s2r->{$1};
    5795. 

  5795. 				$rev = '0' if (!$rev)
    5796. 

  5796. 			}
    5797. 

  5797. 			elsif ($line =~ /^author (.*)/) {
    5798. 

  5798. 				$authors{$rev} = $1;
    5799. 

  5799. 				$authors{$rev} =~ s/\s/_/g;
    5800. 

  5800. 			}
    5801. 

  5801. 			elsif ($line =~ /^\t(.*)$/) {
    5802. 

  5802. 				printf("%6s %10s %s\n", $rev, $authors{$rev}, $1);
    5803. 

  5803. 			}
    5804. 

  5804. 		}
    5805. 

  5805. 	}
    5806. 

  5806. 	command_close_pipe($fh, $ctx);
    5807. 

  5807. }
    5808. 

  5808. 

  5809. package Git::SVN::Migration;
    5810. 

  5810. # these version numbers do NOT correspond to actual version numbers
    5811. 

  5811. # of git nor git-svn.  They are just relative.
    5812. 

  5812. #
    5813. 

  5813. # v0 layout: .git/$id/info/url, refs/heads/$id-HEAD
    5814. 

  5814. #
    5815. 

  5815. # v1 layout: .git/$id/info/url, refs/remotes/$id
    5816. 

  5816. #
    5817. 

  5817. # v2 layout: .git/svn/$id/info/url, refs/remotes/$id
    5818. 

  5818. #
    5819. 

  5819. # v3 layout: .git/svn/$id, refs/remotes/$id
    5820. 

  5820. #            - info/url may remain for backwards compatibility
    5821. 

  5821. #            - this is what we migrate up to this layout automatically,
    5822. 

  5822. #            - this will be used by git svn init on single branches
    5823. 

  5823. # v3.1 layout (auto migrated):
    5824. 

  5824. #            - .rev_db => .rev_db.$UUID, .rev_db will remain as a symlink
    5825. 

  5825. #              for backwards compatibility
    5826. 

  5826. #
    5827. 

  5827. # v4 layout: .git/svn/$repo_id/$id, refs/remotes/$repo_id/$id
    5828. 

  5828. #            - this is only created for newly multi-init-ed
    5829. 

  5829. #              repositories.  Similar in spirit to the
    5830. 

  5830. #              --use-separate-remotes option in git-clone (now default)
    5831. 

  5831. #            - we do not automatically migrate to this (following
    5832. 

  5832. #              the example set by core git)
    5833. 

  5833. #
    5834. 

  5834. # v5 layout: .rev_db.$UUID => .rev_map.$UUID
    5835. 

  5835. #            - newer, more-efficient format that uses 24-bytes per record
    5836. 

  5836. #              with no filler space.
    5837. 

  5837. #            - use xxd -c24 < .rev_map.$UUID to view and debug
    5838. 

  5838. #            - This is a one-way migration, repositories updated to the
    5839. 

  5839. #              new format will not be able to use old git-svn without
    5840. 

  5840. #              rebuilding the .rev_db.  Rebuilding the rev_db is not
    5841. 

  5841. #              possible if noMetadata or useSvmProps are set; but should
    5842. 

  5842. #              be no problem for users that use the (sensible) defaults.
    5843. 

  5843. use strict;
    5844. 

  5844. use warnings;
    5845. 

  5845. use Carp qw/croak/;
    5846. 

  5846. use File::Path qw/mkpath/;
    5847. 

  5847. use File::Basename qw/dirname basename/;
    5848. 

  5848. use vars qw/$_minimize/;
    5849. 

  5849. 

  5850. sub migrate_from_v0 {
    5851. 

  5851. 	my $git_dir = $ENV{GIT_DIR};
    5852. 

  5852. 	return undef unless -d $git_dir;
    5853. 

  5853. 	my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/);
    5854. 

  5854. 	my $migrated = 0;
    5855. 

  5855. 	while (<$fh>) {
    5856. 

  5856. 		chomp;
    5857. 

  5857. 		my ($id, $orig_ref) = ($_, $_);
    5858. 

  5858. 		next unless $id =~ s#^refs/heads/(.+)-HEAD$#$1#;
    5859. 

  5859. 		next unless -f "$git_dir/$id/info/url";
    5860. 

  5860. 		my $new_ref = "refs/remotes/$id";
    5861. 

  5861. 		if (::verify_ref("$new_ref^0")) {
    5862. 

  5862. 			print STDERR "W: $orig_ref is probably an old ",
    5863. 

  5863. 			             "branch used by an ancient version of ",
    5864. 

  5864. 				     "git-svn.\n",
    5865. 

  5865. 				     "However, $new_ref also exists.\n",
    5866. 

  5866. 				     "We will not be able ",
    5867. 

  5867. 				     "to use this branch until this ",
    5868. 

  5868. 				     "ambiguity is resolved.\n";
    5869. 

  5869. 			next;
    5870. 

  5870. 		}
    5871. 

  5871. 		print STDERR "Migrating from v0 layout...\n" if !$migrated;
    5872. 

  5872. 		print STDERR "Renaming ref: $orig_ref => $new_ref\n";
    5873. 

  5873. 		command_noisy('update-ref', $new_ref, $orig_ref);
    5874. 

  5874. 		command_noisy('update-ref', '-d', $orig_ref, $orig_ref);
    5875. 

  5875. 		$migrated++;
    5876. 

  5876. 	}
    5877. 

  5877. 	command_close_pipe($fh, $ctx);
    5878. 

  5878. 	print STDERR "Done migrating from v0 layout...\n" if $migrated;
    5879. 

  5879. 	$migrated;
    5880. 

  5880. }
    5881. 

  5881. 

  5882. sub migrate_from_v1 {
    5883. 

  5883. 	my $git_dir = $ENV{GIT_DIR};
    5884. 

  5884. 	my $migrated = 0;
    5885. 

  5885. 	return $migrated unless -d $git_dir;
    5886. 

  5886. 	my $svn_dir = "$git_dir/svn";
    5887. 

  5887. 

  5888. 	# just in case somebody used 'svn' as their $id at some point...
    5889. 

  5889. 	return $migrated if -d $svn_dir && ! -f "$svn_dir/info/url";
    5890. 

  5890. 

  5891. 	print STDERR "Migrating from a git-svn v1 layout...\n";
    5892. 

  5892. 	mkpath([$svn_dir]);
    5893. 

  5893. 	print STDERR "Data from a previous version of git-svn exists, but\n\t",
    5894. 

  5894. 	             "$svn_dir\n\t(required for this version ",
    5895. 

  5895. 	             "($::VERSION) of git-svn) does not exist.\n";
    5896. 

  5896. 	my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/);
    5897. 

  5897. 	while (<$fh>) {
    5898. 

  5898. 		my $x = $_;
    5899. 

  5899. 		next unless $x =~ s#^refs/remotes/##;
    5900. 

  5900. 		chomp $x;
    5901. 

  5901. 		next unless -f "$git_dir/$x/info/url";
    5902. 

  5902. 		my $u = eval { ::file_to_s("$git_dir/$x/info/url") };
    5903. 

  5903. 		next unless $u;
    5904. 

  5904. 		my $dn = dirname("$git_dir/svn/$x");
    5905. 

  5905. 		mkpath([$dn]) unless -d $dn;
    5906. 

  5906. 		if ($x eq 'svn') { # they used 'svn' as GIT_SVN_ID:
    5907. 

  5907. 			mkpath(["$git_dir/svn/svn"]);
    5908. 

  5908. 			print STDERR " - $git_dir/$x/info => ",
    5909. 

  5909. 			                "$git_dir/svn/$x/info\n";
    5910. 

  5910. 			rename "$git_dir/$x/info", "$git_dir/svn/$x/info" or
    5911. 

  5911. 			       croak "$!: $x";
    5912. 

  5912. 			# don't worry too much about these, they probably
    5913. 

  5913. 			# don't exist with repos this old (save for index,
    5914. 

  5914. 			# and we can easily regenerate that)
    5915. 

  5915. 			foreach my $f (qw/unhandled.log index .rev_db/) {
    5916. 

  5916. 				rename "$git_dir/$x/$f", "$git_dir/svn/$x/$f";
    5917. 

  5917. 			}
    5918. 

  5918. 		} else {
    5919. 

  5919. 			print STDERR " - $git_dir/$x => $git_dir/svn/$x\n";
    5920. 

  5920. 			rename "$git_dir/$x", "$git_dir/svn/$x" or
    5921. 

  5921. 			       croak "$!: $x";
    5922. 

  5922. 		}
    5923. 

  5923. 		$migrated++;
    5924. 

  5924. 	}
    5925. 

  5925. 	command_close_pipe($fh, $ctx);
    5926. 

  5926. 	print STDERR "Done migrating from a git-svn v1 layout\n";
    5927. 

  5927. 	$migrated;
    5928. 

  5928. }
    5929. 

  5929. 

  5930. sub read_old_urls {
    5931. 

  5931. 	my ($l_map, $pfx, $path) = @_;
    5932. 

  5932. 	my @dir;
    5933. 

  5933. 	foreach (<$path/*>) {
    5934. 

  5934. 		if (-r "$_/info/url") {
    5935. 

  5935. 			$pfx .= '/' if $pfx && $pfx !~ m!/$!;
    5936. 

  5936. 			my $ref_id = $pfx . basename $_;
    5937. 

  5937. 			my $url = ::file_to_s("$_/info/url");
    5938. 

  5938. 			$l_map->{$ref_id} = $url;
    5939. 

  5939. 		} elsif (-d $_) {
    5940. 

  5940. 			push @dir, $_;
    5941. 

  5941. 		}
    5942. 

  5942. 	}
    5943. 

  5943. 	foreach (@dir) {
    5944. 

  5944. 		my $x = $_;
    5945. 

  5945. 		$x =~ s!^\Q$ENV{GIT_DIR}\E/svn/!!o;
    5946. 

  5946. 		read_old_urls($l_map, $x, $_);
    5947. 

  5947. 	}
    5948. 

  5948. }
    5949. 

    5950. 

  5950. sub migrate_from_v2 {
    5951. 

  5951. 	my @cfg = command(qw/config -l/);
    5952. 

  5952. 	return if grep /^svn-remote\..+\.url=/, @cfg;
    5953. 

  5953. 	my %l_map;
    5954. 

  5954. 	read_old_urls(\%l_map, '', "$ENV{GIT_DIR}/svn");
    5955. 

  5955. 	my $migrated = 0;
    5956. 

    5957. 

  5957. 	foreach my $ref_id (sort keys %l_map) {
    5958. 

  5958. 		eval { Git::SVN->init($l_map{$ref_id}, '', undef, $ref_id) };
    5959. 

  5959. 		if ($@) {
    5960. 

  5960. 			Git::SVN->init($l_map{$ref_id}, '', $ref_id, $ref_id);
    5961. 

  5961. 		}
    5962. 

  5962. 		$migrated++;
    5963. 

  5963. 	}
    5964. 

  5964. 	$migrated;
    5965. 

  5965. }
    5966. 

    5967. 

  5967. sub minimize_connections {
    5968. 

  5968. 	my $r = Git::SVN::read_all_remotes();
    5969. 

  5969. 	my $new_urls = {};
    5970. 

  5970. 	my $root_repos = {};
    5971. 

  5971. 	foreach my $repo_id (keys %$r) {
    5972. 

  5972. 		my $url = $r->{$repo_id}->{url} or next;
    5973. 

  5973. 		my $fetch = $r->{$repo_id}->{fetch} or next;
    5974. 

  5974. 		my $ra = Git::SVN::Ra->new($url);
    5975. 

    5976. 

  5976. 		# skip existing cases where we already connect to the root
    5977. 

  5977. 		if (($ra->{url} eq $ra->{repos_root}) ||
    5978. 

  5978. 		    ($ra->{repos_root} eq $repo_id)) {
    5979. 

  5979. 			$root_repos->{$ra->{url}} = $repo_id;
    5980. 

  5980. 			next;
    5981. 

  5981. 		}
    5982. 

    5983. 

  5983. 		my $root_ra = Git::SVN::Ra->new($ra->{repos_root});
    5984. 

  5984. 		my $root_path = $ra->{url};
    5985. 

  5985. 		$root_path =~ s#^\Q$ra->{repos_root}\E(/|$)##;
    5986. 

  5986. 		foreach my $path (keys %$fetch) {
    5987. 

  5987. 			my $ref_id = $fetch->{$path};
    5988. 

  5988. 			my $gs = Git::SVN->new($ref_id, $repo_id, $path);
    5989. 

    5990. 

  5990. 			# make sure we can read when connecting to
    5991. 

  5991. 			# a higher level of a repository
    5992. 

  5992. 			my ($last_rev, undef) = $gs->last_rev_commit;
    5993. 

  5993. 			if (!defined $last_rev) {
    5994. 

  5994. 				$last_rev = eval {
    5995. 

  5995. 					$root_ra->get_latest_revnum;
    5996. 

  5996. 				};
    5997. 

  5997. 				next if $@;
    5998. 

  5998. 			}
    5999. 

  5999. 			my $new = $root_path;
    6000. 

  6000. 			$new .= length $path ? "/$path" : '';
    6001. 

  6001. 			eval {
    6002. 

  6002. 				$root_ra->get_log([$new], $last_rev, $last_rev,
    6003. 

  6003. 			                          0, 0, 1, sub { });
    6004. 

  6004. 			};
    6005. 

  6005. 			next if $@;
    6006. 

  6006. 			$new_urls->{$ra->{repos_root}}->{$new} =
    6007. 

  6007. 			        { ref_id => $ref_id,
    6008. 

  6008. 				  old_repo_id => $repo_id,
    6009. 

  6009. 				  old_path => $path };
    6010. 

  6010. 		}
    6011. 

  6011. 	}
    6012. 

    6013. 

  6013. 	my @emptied;
    6014. 

  6014. 	foreach my $url (keys %$new_urls) {
    6015. 

  6015. 		# see if we can re-use an existing [svn-remote "repo_id"]
    6016. 

  6016. 		# instead of creating a(n ugly) new section:
    6017. 

  6017. 		my $repo_id = $root_repos->{$url} || $url;
    6018. 

    6019. 

  6019. 		my $fetch = $new_urls->{$url};
    6020. 

  6020. 		foreach my $path (keys %$fetch) {
    6021. 

  6021. 			my $x = $fetch->{$path};
    6022. 

  6022. 			Git::SVN->init($url, $path, $repo_id, $x->{ref_id});
    6023. 

  6023. 			my $pfx = "svn-remote.$x->{old_repo_id}";
    6024. 

    6025. 

  6025. 			my $old_fetch = quotemeta("$x->{old_path}:".
    6026. 

  6026. 			                          "$x->{ref_id}");
    6027. 

  6027. 			command_noisy(qw/config --unset/,
    6028. 

  6028. 			              "$pfx.fetch", '^'. $old_fetch . '$');
    6029. 

  6029. 			delete $r->{$x->{old_repo_id}}->
    6030. 

  6030. 			       {fetch}->{$x->{old_path}};
    6031. 

  6031. 			if (!keys %{$r->{$x->{old_repo_id}}->{fetch}}) {
    6032. 

  6032. 				command_noisy(qw/config --unset/,
    6033. 

  6033. 				              "$pfx.url");
    6034. 

  6034. 				push @emptied, $x->{old_repo_id}
    6035. 

  6035. 			}
    6036. 

  6036. 		}
    6037. 

  6037. 	}
    6038. 

  6038. 	if (@emptied) {
    6039. 

  6039. 		my $file = $ENV{GIT_CONFIG} || "$ENV{GIT_DIR}/config";
    6040. 

  6040. 		print STDERR <<EOF;
    6041. 

  6041. The following [svn-remote] sections in your config file ($file) are empty
    6042. 

  6042. and can be safely removed:
    6043. 

  6043. EOF
    6044. 

  6044. 		print STDERR "[svn-remote \"$_\"]\n" foreach @emptied;
    6045. 

  6045. 	}
    6046. 

  6046. }
    6047. 

    6048. 

  6048. sub migration_check {
    6049. 

  6049. 	migrate_from_v0();
    6050. 

  6050. 	migrate_from_v1();
    6051. 

  6051. 	migrate_from_v2();
    6052. 

  6052. 	minimize_connections() if $_minimize;
    6053. 

  6053. }
    6054. 

    6055. 

  6055. package Git::IndexInfo;
    6056. 

  6056. use strict;
    6057. 

  6057. use warnings;
    6058. 

  6058. use Git qw/command_input_pipe command_close_pipe/;
    6059. 

    6060. 

  6060. sub new {
    6061. 

  6061. 	my ($class) = @_;
    6062. 

  6062. 	my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/);
    6063. 

  6063. 	bless { gui => $gui, ctx => $ctx, nr => 0}, $class;
    6064. 

  6064. }
    6065. 

    6066. 

  6066. sub remove {
    6067. 

  6067. 	my ($self, $path) = @_;
    6068. 

  6068. 	if (print { $self->{gui} } '0 ', 0 x 40, "\t", $path, "\0") {
    6069. 

  6069. 		return ++$self->{nr};
    6070. 

  6070. 	}
    6071. 

  6071. 	undef;
    6072. 

  6072. }
    6073. 

    6074. 

  6074. sub update {
    6075. 

  6075. 	my ($self, $mode, $hash, $path) = @_;
    6076. 

  6076. 	if (print { $self->{gui} } $mode, ' ', $hash, "\t", $path, "\0") {
    6077. 

  6077. 		return ++$self->{nr};
    6078. 

  6078. 	}
    6079. 

  6079. 	undef;
    6080. 

  6080. }
    6081. 

    6082. 

  6082. sub DESTROY {
    6083. 

  6083. 	my ($self) = @_;
    6084. 

  6084. 	command_close_pipe($self->{gui}, $self->{ctx});
    6085. 

  6085. }
    6086. 

    6087. 

  6087. package Git::SVN::GlobSpec;
    6088. 

  6088. use strict;
    6089. 

  6089. use warnings;
    6090. 

    6091. 

  6091. sub new {
    6092. 

  6092. 	my ($class, $glob, $pattern_ok) = @_;
    6093. 

  6093. 	my $re = $glob;
    6094. 

  6094. 	$re =~ s!/+$!!g; # no need for trailing slashes
    6095. 

  6095. 	my (@left, @right, @patterns);
    6096. 

  6096. 	my $state = "left";
    6097. 

  6097. 	my $die_msg = "Only one set of wildcard directories " .
    6098. 

  6098. 				"(e.g. '*' or '*/*/*') is supported: '$glob'\n";
    6099. 

  6099. 	for my $part (split(m|/|, $glob)) {
    6100. 

  6100. 		if ($part =~ /\*/ && $part ne "*") {
    6101. 

  6101. 			die "Invalid pattern in '$glob': $part\n";
    6102. 

  6102. 		} elsif ($pattern_ok && $part =~ /[{}]/ &&
    6103. 

  6103. 			 $part !~ /^\{[^{}]+\}/) {
    6104. 

  6104. 			die "Invalid pattern in '$glob': $part\n";
    6105. 

  6105. 		}
    6106. 

  6106. 		if ($part eq "*") {
    6107. 

  6107. 			die $die_msg if $state eq "right";
    6108. 

  6108. 			$state = "pattern";
    6109. 

  6109. 			push(@patterns, "[^/]*");
    6110. 

  6110. 		} elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) {
    6111. 

  6111. 			die $die_msg if $state eq "right";
    6112. 

  6112. 			$state = "pattern";
    6113. 

  6113. 			my $p = quotemeta($1);
    6114. 

  6114. 			$p =~ s/\\,/|/g;
    6115. 

  6115. 			push(@patterns, "(?:$p)");
    6116. 

  6116. 		} else {
    6117. 

  6117. 			if ($state eq "left") {
    6118. 

  6118. 				push(@left, $part);
    6119. 

  6119. 			} else {
    6120. 

  6120. 				push(@right, $part);
    6121. 

  6121. 				$state = "right";
    6122. 

  6122. 			}
    6123. 

  6123. 		}
    6124. 

  6124. 	}
    6125. 

  6125. 	my $depth = @patterns;
    6126. 

  6126. 	if ($depth == 0) {
    6127. 

  6127. 		die "One '*' is needed in glob: '$glob'\n";
    6128. 

  6128. 	}
    6129. 

  6129. 	my $left = join('/', @left);
    6130. 

  6130. 	my $right = join('/', @right);
    6131. 

  6131. 	$re = join('/', @patterns);
    6132. 

  6132. 	$re = join('\/',
    6133. 

  6133. 		   grep(length, quotemeta($left), "($re)", quotemeta($right)));
    6134. 

  6134. 	my $left_re = qr/^\/\Q$left\E(\/|$)/;
    6135. 

  6135. 	bless { left => $left, right => $right, left_regex => $left_re,
    6136. 

  6136. 	        regex => qr/$re/, glob => $glob, depth => $depth }, $class;
    6137. 

  6137. }
    6138. 

  6138. 

  6139. sub full_path {
    6140. 

  6140. 	my ($self, $path) = @_;
    6141. 

  6141. 	return (length $self->{left} ? "$self->{left}/" : '') .
    6142. 

  6142. 	       $path . (length $self->{right} ? "/$self->{right}" : '');
    6143. 

  6143. }
    6144. 

  6144. 

  6145. __END__
    6146. 

  6146. 

  6147. Data structures:
    6148. 

  6148. 

  6149. 

  6150. $remotes = { # returned by read_all_remotes()
    6151. 

  6151. 	'svn' => {
    6152. 

  6152. 		# svn-remote.svn.url=https://svn.musicpd.org
    6153. 

  6153. 		url => 'https://svn.musicpd.org',
    6154. 

  6154. 		# svn-remote.svn.fetch=mpd/trunk:trunk
    6155. 

  6155. 		fetch => {
    6156. 

  6156. 			'mpd/trunk' => 'trunk',
    6157. 

  6157. 		},
    6158. 

  6158. 		# svn-remote.svn.tags=mpd/tags/*:tags/*
    6159. 

  6159. 		tags => {
    6160. 

  6160. 			path => {
    6161. 

  6161. 				left => 'mpd/tags',
    6162. 

  6162. 				right => '',
    6163. 

  6163. 				regex => qr!mpd/tags/([^/]+)$!,
    6164. 

  6164. 				glob => 'tags/*',
    6165. 

  6165. 			},
    6166. 

  6166. 			ref => {
    6167. 

  6167. 				left => 'tags',
    6168. 

  6168. 				right => '',
    6169. 

  6169. 				regex => qr!tags/([^/]+)$!,
    6170. 

  6170. 				glob => 'tags/*',
    6171. 

  6171. 			},
    6172. 

  6172. 		}
    6173. 

  6173. 	}
    6174. 

  6174. };
    6175. 

    6176. 

  6176. $log_entry hashref as returned by libsvn_log_entry()
    6177. 

  6177. {
    6178. 

  6178. 	log => 'whitespace-formatted log entry
    6179. 

  6179. ',						# trailing newline is preserved
    6180. 

  6180. 	revision => '8',			# integer
    6181. 

  6181. 	date => '2004-02-24T17:01:44.108345Z',	# commit date
    6182. 

  6182. 	author => 'committer name'
    6183. 

  6183. };
    6184. 

    6185. 

    6186. 

  6186. # this is generated by generate_diff();
    6187. 

  6187. @mods = array of diff-index line hashes, each element represents one line
    6188. 

  6188. 	of diff-index output
    6189. 

    6190. 

  6190. diff-index line ($m hash)
    6191. 

  6191. {
    6192. 

  6192. 	mode_a => first column of diff-index output, no leading ':',
    6193. 

  6193. 	mode_b => second column of diff-index output,
    6194. 

  6194. 	sha1_b => sha1sum of the final blob,
    6195. 

  6195. 	chg => change type [MCRADT],
    6196. 

  6196. 	file_a => original file name of a file (iff chg is 'C' or 'R')
    6197. 

  6197. 	file_b => new/current file name of a file (any chg)
    6198. 

  6198. }
    6199. 

  6199. ;
    6200. 

    6201. 

  6201. # retval of read_url_paths{,_all}();
    6202. 

  6202. $l_map = {
    6203. 

  6203. 	# repository root url
    6204. 

  6204. 	'https://svn.musicpd.org' => {
    6205. 

  6205. 		# repository path 		# GIT_SVN_ID
    6206. 

  6206. 		'mpd/trunk'		=>	'trunk',
    6207. 

  6207. 		'mpd/tags/0.11.5'	=>	'tags/0.11.5',
    6208. 

  6208. 	},
    6209. 

  6209. }
    6210. 

    6211. 

  6211. Notes:
    6212. 

  6212. 	I don't trust the each() function on unless I created %hash myself
    6213. 

  6213. 	because the internal iterator may not have started at base.
    6214. 

    6215.