9269d80a6d9a300e27571ae8560f76849ba5f700
1#!/usr/bin/perl
2# Copyright (C) 2006, Eric Wong <normalperson@yhbt.net>
3# License: GPL v2 or later
4use 5.008;
5use warnings;
6use strict;
7use vars qw/ $AUTHOR $VERSION
8 $sha1 $sha1_short $_revision $_repository
9 $_q $_authors $_authors_prog %users/;
10$AUTHOR = 'Eric Wong <normalperson@yhbt.net>';
11$VERSION = '@@GIT_VERSION@@';
12use Git::SVN;
14use Git::SVN::Utils qw(fatal can_compress);
15# From which subdir have we been invoked?
17my $cmd_dir_prefix = eval {
18 command_oneline([qw/rev-parse --show-prefix/], STDERR => 0)
19} || '';
20my $git_dir_user_set = 1 if defined $ENV{GIT_DIR};
22$ENV{GIT_DIR} ||= '.git';
23$Git::SVN::Ra::_log_window_size = 100;
24if (! exists $ENV{SVN_SSH} && exists $ENV{GIT_SSH}) {
26 $ENV{SVN_SSH} = $ENV{GIT_SSH};
27}
28if (exists $ENV{SVN_SSH} && $^O eq 'msys') {
30 $ENV{SVN_SSH} =~ s/\\/\\\\/g;
31 $ENV{SVN_SSH} =~ s/(.*)/"$1"/;
32}
33$Git::SVN::Log::TZ = $ENV{TZ};
35$ENV{TZ} = 'UTC';
36$| = 1; # unbuffer STDOUT
37# All SVN commands do it. Otherwise we may die on SIGPIPE when the remote
39# repository decides to close the connection which we expect to be kept alive.
40$SIG{PIPE} = 'IGNORE';
41# Given a dot separated version number, "subtract" it from
43# the SVN::Core::VERSION; non-negaitive return means the SVN::Core
44# is at least at the version the caller asked for.
45sub compare_svn_version {
46 my (@ours) = split(/\./, $SVN::Core::VERSION);
47 my (@theirs) = split(/\./, $_[0]);
48 my ($i, $diff);
49 for ($i = 0; $i < @ours && $i < @theirs; $i++) {
51 $diff = $ours[$i] - $theirs[$i];
52 return $diff if ($diff);
53 }
54 return 1 if ($i < @ours);
55 return -1 if ($i < @theirs);
56 return 0;
57}
58sub _req_svn {
60 require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
61 require SVN::Ra;
62 require SVN::Delta;
63 if (::compare_svn_version('1.1.0') < 0) {
64 fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)";
65 }
66}
67use Carp qw/croak/;
69use Digest::MD5;
70use IO::File qw//;
71use File::Basename qw/dirname basename/;
72use File::Path qw/mkpath/;
73use File::Spec;
74use File::Find;
75use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/;
76use IPC::Open3;
77use Git;
78use Git::SVN::Editor qw//;
79use Git::SVN::Fetcher qw//;
80use Git::SVN::Ra qw//;
81use Git::SVN::Prompt qw//;
82use Memoize; # core since 5.8.0, Jul 2002
83BEGIN {
85 # import functions from Git into our packages, en masse
86 no strict 'refs';
87 foreach (qw/command command_oneline command_noisy command_output_pipe
88 command_input_pipe command_close_pipe
89 command_bidi_pipe command_close_bidi_pipe/) {
90 for my $package ( qw(Git::SVN::Migration Git::SVN::Log),
91 __PACKAGE__) {
92 *{"${package}::$_"} = \&{"Git::$_"};
93 }
94 }
95 Memoize::memoize 'Git::config';
96 Memoize::memoize 'Git::config_bool';
97}
98my ($SVN);
100$sha1 = qr/[a-f\d]{40}/;
102$sha1_short = qr/[a-f\d]{4,40}/;
103my ($_stdin, $_help, $_edit,
104 $_message, $_file, $_branch_dest,
105 $_template, $_shared,
106 $_version, $_fetch_all, $_no_rebase, $_fetch_parent,
107 $_merge, $_strategy, $_preserve_merges, $_dry_run, $_local,
108 $_prefix, $_no_checkout, $_url, $_verbose,
109 $_git_format, $_commit_url, $_tag, $_merge_info, $_interactive);
110# This is a refactoring artifact so Git::SVN can get at this git-svn switch.
112sub opt_prefix { return $_prefix || '' }
113$Git::SVN::Fetcher::_placeholder_filename = ".gitignore";
115$_q ||= 0;
116my %remote_opts = ( 'username=s' => \$Git::SVN::Prompt::_username,
117 'config-dir=s' => \$Git::SVN::Ra::config_dir,
118 'no-auth-cache' => \$Git::SVN::Prompt::_no_auth_cache,
119 'ignore-paths=s' => \$Git::SVN::Fetcher::_ignore_regex,
120 'ignore-refs=s' => \$Git::SVN::Ra::_ignore_refs_regex );
121my %fc_opts = ( 'follow-parent|follow!' => \$Git::SVN::_follow_parent,
122 'authors-file|A=s' => \$_authors,
123 'authors-prog=s' => \$_authors_prog,
124 'repack:i' => \$Git::SVN::_repack,
125 'noMetadata' => \$Git::SVN::_no_metadata,
126 'useSvmProps' => \$Git::SVN::_use_svm_props,
127 'useSvnsyncProps' => \$Git::SVN::_use_svnsync_props,
128 'log-window-size=i' => \$Git::SVN::Ra::_log_window_size,
129 'no-checkout' => \$_no_checkout,
130 'quiet|q+' => \$_q,
131 'repack-flags|repack-args|repack-opts=s' =>
132 \$Git::SVN::_repack_flags,
133 'use-log-author' => \$Git::SVN::_use_log_author,
134 'add-author-from' => \$Git::SVN::_add_author_from,
135 'localtime' => \$Git::SVN::_localtime,
136 %remote_opts );
137my ($_trunk, @_tags, @_branches, $_stdlayout);
139my %icv;
140my %init_opts = ( 'template=s' => \$_template, 'shared:s' => \$_shared,
141 'trunk|T=s' => \$_trunk, 'tags|t=s@' => \@_tags,
142 'branches|b=s@' => \@_branches, 'prefix=s' => \$_prefix,
143 'stdlayout|s' => \$_stdlayout,
144 'minimize-url|m!' => \$Git::SVN::_minimize_url,
145 'no-metadata' => sub { $icv{noMetadata} = 1 },
146 'use-svm-props' => sub { $icv{useSvmProps} = 1 },
147 'use-svnsync-props' => sub { $icv{useSvnsyncProps} = 1 },
148 'rewrite-root=s' => sub { $icv{rewriteRoot} = $_[1] },
149 'rewrite-uuid=s' => sub { $icv{rewriteUUID} = $_[1] },
150 %remote_opts );
151my %cmt_opts = ( 'edit|e' => \$_edit,
152 'rmdir' => \$Git::SVN::Editor::_rmdir,
153 'find-copies-harder' => \$Git::SVN::Editor::_find_copies_harder,
154 'l=i' => \$Git::SVN::Editor::_rename_limit,
155 'copy-similarity|C=i'=> \$Git::SVN::Editor::_cp_similarity
156);
157my %cmd = (
159 fetch => [ \&cmd_fetch, "Download new revisions from SVN",
160 { 'revision|r=s' => \$_revision,
161 'fetch-all|all' => \$_fetch_all,
162 'parent|p' => \$_fetch_parent,
163 %fc_opts } ],
164 clone => [ \&cmd_clone, "Initialize and fetch revisions",
165 { 'revision|r=s' => \$_revision,
166 'preserve-empty-dirs' =>
167 \$Git::SVN::Fetcher::_preserve_empty_dirs,
168 'placeholder-filename=s' =>
169 \$Git::SVN::Fetcher::_placeholder_filename,
170 %fc_opts, %init_opts } ],
171 init => [ \&cmd_init, "Initialize a repo for tracking" .
172 " (requires URL argument)",
173 \%init_opts ],
174 'multi-init' => [ \&cmd_multi_init,
175 "Deprecated alias for ".
176 "'$0 init -T<trunk> -b<branches> -t<tags>'",
177 \%init_opts ],
178 dcommit => [ \&cmd_dcommit,
179 'Commit several diffs to merge with upstream',
180 { 'merge|m|M' => \$_merge,
181 'strategy|s=s' => \$_strategy,
182 'verbose|v' => \$_verbose,
183 'dry-run|n' => \$_dry_run,
184 'fetch-all|all' => \$_fetch_all,
185 'commit-url=s' => \$_commit_url,
186 'revision|r=i' => \$_revision,
187 'no-rebase' => \$_no_rebase,
188 'mergeinfo=s' => \$_merge_info,
189 'interactive|i' => \$_interactive,
190 %cmt_opts, %fc_opts } ],
191 branch => [ \&cmd_branch,
192 'Create a branch in the SVN repository',
193 { 'message|m=s' => \$_message,
194 'destination|d=s' => \$_branch_dest,
195 'dry-run|n' => \$_dry_run,
196 'tag|t' => \$_tag,
197 'username=s' => \$Git::SVN::Prompt::_username,
198 'commit-url=s' => \$_commit_url } ],
199 tag => [ sub { $_tag = 1; cmd_branch(@_) },
200 'Create a tag in the SVN repository',
201 { 'message|m=s' => \$_message,
202 'destination|d=s' => \$_branch_dest,
203 'dry-run|n' => \$_dry_run,
204 'username=s' => \$Git::SVN::Prompt::_username,
205 'commit-url=s' => \$_commit_url } ],
206 'set-tree' => [ \&cmd_set_tree,
207 "Set an SVN repository to a git tree-ish",
208 { 'stdin' => \$_stdin, %cmt_opts, %fc_opts, } ],
209 'create-ignore' => [ \&cmd_create_ignore,
210 'Create a .gitignore per svn:ignore',
211 { 'revision|r=i' => \$_revision
212 } ],
213 'mkdirs' => [ \&cmd_mkdirs ,
214 "recreate empty directories after a checkout",
215 { 'revision|r=i' => \$_revision } ],
216 'propget' => [ \&cmd_propget,
217 'Print the value of a property on a file or directory',
218 { 'revision|r=i' => \$_revision } ],
219 'proplist' => [ \&cmd_proplist,
220 'List all properties of a file or directory',
221 { 'revision|r=i' => \$_revision } ],
222 'show-ignore' => [ \&cmd_show_ignore, "Show svn:ignore listings",
223 { 'revision|r=i' => \$_revision
224 } ],
225 'show-externals' => [ \&cmd_show_externals, "Show svn:externals listings",
226 { 'revision|r=i' => \$_revision
227 } ],
228 'multi-fetch' => [ \&cmd_multi_fetch,
229 "Deprecated alias for $0 fetch --all",
230 { 'revision|r=s' => \$_revision, %fc_opts } ],
231 'migrate' => [ sub { },
232 # no-op, we automatically run this anyways,
233 'Migrate configuration/metadata/layout from
234 previous versions of git-svn',
235 { 'minimize' => \$Git::SVN::Migration::_minimize,
236 %remote_opts } ],
237 'log' => [ \&Git::SVN::Log::cmd_show_log, 'Show commit logs',
238 { 'limit=i' => \$Git::SVN::Log::limit,
239 'revision|r=s' => \$_revision,
240 'verbose|v' => \$Git::SVN::Log::verbose,
241 'incremental' => \$Git::SVN::Log::incremental,
242 'oneline' => \$Git::SVN::Log::oneline,
243 'show-commit' => \$Git::SVN::Log::show_commit,
244 'non-recursive' => \$Git::SVN::Log::non_recursive,
245 'authors-file|A=s' => \$_authors,
246 'color' => \$Git::SVN::Log::color,
247 'pager=s' => \$Git::SVN::Log::pager
248 } ],
249 'find-rev' => [ \&cmd_find_rev,
250 "Translate between SVN revision numbers and tree-ish",
251 {} ],
252 'rebase' => [ \&cmd_rebase, "Fetch and rebase your working directory",
253 { 'merge|m|M' => \$_merge,
254 'verbose|v' => \$_verbose,
255 'strategy|s=s' => \$_strategy,
256 'local|l' => \$_local,
257 'fetch-all|all' => \$_fetch_all,
258 'dry-run|n' => \$_dry_run,
259 'preserve-merges|p' => \$_preserve_merges,
260 %fc_opts } ],
261 'commit-diff' => [ \&cmd_commit_diff,
262 'Commit a diff between two trees',
263 { 'message|m=s' => \$_message,
264 'file|F=s' => \$_file,
265 'revision|r=s' => \$_revision,
266 %cmt_opts } ],
267 'info' => [ \&cmd_info,
268 "Show info about the latest SVN revision
269 on the current branch",
270 { 'url' => \$_url, } ],
271 'blame' => [ \&Git::SVN::Log::cmd_blame,
272 "Show what revision and author last modified each line of a file",
273 { 'git-format' => \$_git_format } ],
274 'reset' => [ \&cmd_reset,
275 "Undo fetches back to the specified SVN revision",
276 { 'revision|r=s' => \$_revision,
277 'parent|p' => \$_fetch_parent } ],
278 'gc' => [ \&cmd_gc,
279 "Compress unhandled.log files in .git/svn and remove " .
280 "index files in .git/svn",
281 {} ],
282);
283use Term::ReadLine;
285package FakeTerm;
286sub new {
287 my ($class, $reason) = @_;
288 return bless \$reason, shift;
289}
290sub readline {
291 my $self = shift;
292 die "Cannot use readline on FakeTerm: $$self";
293}
294package main;
295my $term = eval {
297 $ENV{"GIT_SVN_NOTTY"}
298 ? new Term::ReadLine 'git-svn', \*STDIN, \*STDOUT
299 : new Term::ReadLine 'git-svn';
300};
301if ($@) {
302 $term = new FakeTerm "$@: going non-interactive";
303}
304my $cmd;
306for (my $i = 0; $i < @ARGV; $i++) {
307 if (defined $cmd{$ARGV[$i]}) {
308 $cmd = $ARGV[$i];
309 splice @ARGV, $i, 1;
310 last;
311 } elsif ($ARGV[$i] eq 'help') {
312 $cmd = $ARGV[$i+1];
313 usage(0);
314 }
315};
316# make sure we're always running at the top-level working directory
318unless ($cmd && $cmd =~ /(?:clone|init|multi-init)$/) {
319 unless (-d $ENV{GIT_DIR}) {
320 if ($git_dir_user_set) {
321 die "GIT_DIR=$ENV{GIT_DIR} explicitly set, ",
322 "but it is not a directory\n";
323 }
324 my $git_dir = delete $ENV{GIT_DIR};
325 my $cdup = undef;
326 git_cmd_try {
327 $cdup = command_oneline(qw/rev-parse --show-cdup/);
328 $git_dir = '.' unless ($cdup);
329 chomp $cdup if ($cdup);
330 $cdup = "." unless ($cdup && length $cdup);
331 } "Already at toplevel, but $git_dir not found\n";
332 chdir $cdup or die "Unable to chdir up to '$cdup'\n";
333 unless (-d $git_dir) {
334 die "$git_dir still not found after going to ",
335 "'$cdup'\n";
336 }
337 $ENV{GIT_DIR} = $git_dir;
338 }
339 $_repository = Git->repository(Repository => $ENV{GIT_DIR});
340}
341my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
343read_git_config(\%opts);
345if ($cmd && ($cmd eq 'log' || $cmd eq 'blame')) {
346 Getopt::Long::Configure('pass_through');
347}
348my $rv = GetOptions(%opts, 'h|H' => \$_help, 'version|V' => \$_version,
349 'minimize-connections' => \$Git::SVN::Migration::_minimize,
350 'id|i=s' => \$Git::SVN::default_ref_id,
351 'svn-remote|remote|R=s' => sub {
352 $Git::SVN::no_reuse_existing = 1;
353 $Git::SVN::default_repo_id = $_[1] });
354exit 1 if (!$rv && $cmd && $cmd ne 'log');
355usage(0) if $_help;
357version() if $_version;
358usage(1) unless defined $cmd;
359load_authors() if $_authors;
360if (defined $_authors_prog) {
361 $_authors_prog = "'" . File::Spec->rel2abs($_authors_prog) . "'";
362}
363unless ($cmd =~ /^(?:clone|init|multi-init|commit-diff)$/) {
365 Git::SVN::Migration::migration_check();
366}
367Git::SVN::init_vars();
368eval {
369 Git::SVN::verify_remotes_sanity();
370 $cmd{$cmd}->[0]->(@ARGV);
371 post_fetch_checkout();
372};
373fatal $@ if $@;
374exit 0;
375####################### primary functions ######################
377sub usage {
378 my $exit = shift || 0;
379 my $fd = $exit ? \*STDERR : \*STDOUT;
380 print $fd <<"";
381git-svn - bidirectional operations between a single Subversion tree and git
382Usage: git svn <command> [options] [arguments]\n
383 print $fd "Available commands:\n" unless $cmd;
385 foreach (sort keys %cmd) {
387 next if $cmd && $cmd ne $_;
388 next if /^multi-/; # don't show deprecated commands
389 print $fd ' ',pack('A17',$_),$cmd{$_}->[1],"\n";
390 foreach (sort keys %{$cmd{$_}->[2]}) {
391 # mixed-case options are for .git/config only
392 next if /[A-Z]/ && /^[a-z]+$/i;
393 # prints out arguments as they should be passed:
394 my $x = s#[:=]s$## ? '<arg>' : s#[:=]i$## ? '<num>' : '';
395 print $fd ' ' x 21, join(', ', map { length $_ > 1 ?
396 "--$_" : "-$_" }
397 split /\|/,$_)," $x\n";
398 }
399 }
400 print $fd <<"";
401\nGIT_SVN_ID may be set in the environment or via the --id/-i switch to an
402arbitrary identifier if you're tracking multiple SVN branches/repositories in
403one git repository and want to keep them separate. See git-svn(1) for more
404information.
405 exit $exit;
407}
408sub version {
410 ::_req_svn();
411 print "git-svn version $VERSION (svn $SVN::Core::VERSION)\n";
412 exit 0;
413}
414sub ask {
416 my ($prompt, %arg) = @_;
417 my $valid_re = $arg{valid_re};
418 my $default = $arg{default};
419 my $resp;
420 my $i = 0;
421 if ( !( defined($term->IN)
423 && defined( fileno($term->IN) )
424 && defined( $term->OUT )
425 && defined( fileno($term->OUT) ) ) ){
426 return defined($default) ? $default : undef;
427 }
428 while ($i++ < 10) {
430 $resp = $term->readline($prompt);
431 if (!defined $resp) { # EOF
432 print "\n";
433 return defined $default ? $default : undef;
434 }
435 if ($resp eq '' and defined $default) {
436 return $default;
437 }
438 if (!defined $valid_re or $resp =~ /$valid_re/) {
439 return $resp;
440 }
441 }
442 return undef;
443}
444sub do_git_init_db {
446 unless (-d $ENV{GIT_DIR}) {
447 my @init_db = ('init');
448 push @init_db, "--template=$_template" if defined $_template;
449 if (defined $_shared) {
450 if ($_shared =~ /[a-z]/) {
451 push @init_db, "--shared=$_shared";
452 } else {
453 push @init_db, "--shared";
454 }
455 }
456 command_noisy(@init_db);
457 $_repository = Git->repository(Repository => ".git");
458 }
459 my $set;
460 my $pfx = "svn-remote.$Git::SVN::default_repo_id";
461 foreach my $i (keys %icv) {
462 die "'$set' and '$i' cannot both be set\n" if $set;
463 next unless defined $icv{$i};
464 command_noisy('config', "$pfx.$i", $icv{$i});
465 $set = $i;
466 }
467 my $ignore_paths_regex = \$Git::SVN::Fetcher::_ignore_regex;
468 command_noisy('config', "$pfx.ignore-paths", $$ignore_paths_regex)
469 if defined $$ignore_paths_regex;
470 my $ignore_refs_regex = \$Git::SVN::Ra::_ignore_refs_regex;
471 command_noisy('config', "$pfx.ignore-refs", $$ignore_refs_regex)
472 if defined $$ignore_refs_regex;
473 if (defined $Git::SVN::Fetcher::_preserve_empty_dirs) {
475 my $fname = \$Git::SVN::Fetcher::_placeholder_filename;
476 command_noisy('config', "$pfx.preserve-empty-dirs", 'true');
477 command_noisy('config', "$pfx.placeholder-filename", $$fname);
478 }
479}
480sub init_subdir {
482 my $repo_path = shift or return;
483 mkpath([$repo_path]) unless -d $repo_path;
484 chdir $repo_path or die "Couldn't chdir to $repo_path: $!\n";
485 $ENV{GIT_DIR} = '.git';
486 $_repository = Git->repository(Repository => $ENV{GIT_DIR});
487}
488sub cmd_clone {
490 my ($url, $path) = @_;
491 if (!defined $path &&
492 (defined $_trunk || @_branches || @_tags ||
493 defined $_stdlayout) &&
494 $url !~ m#^[a-z\+]+://#) {
495 $path = $url;
496 }
497 $path = basename($url) if !defined $path || !length $path;
498 my $authors_absolute = $_authors ? File::Spec->rel2abs($_authors) : "";
499 cmd_init($url, $path);
500 command_oneline('config', 'svn.authorsfile', $authors_absolute)
501 if $_authors;
502 Git::SVN::fetch_all($Git::SVN::default_repo_id);
503}
504sub cmd_init {
506 if (defined $_stdlayout) {
507 $_trunk = 'trunk' if (!defined $_trunk);
508 @_tags = 'tags' if (! @_tags);
509 @_branches = 'branches' if (! @_branches);
510 }
511 if (defined $_trunk || @_branches || @_tags) {
512 return cmd_multi_init(@_);
513 }
514 my $url = shift or die "SVN repository location required ",
515 "as a command-line argument\n";
516 $url = canonicalize_url($url);
517 init_subdir(@_);
518 do_git_init_db();
519 if ($Git::SVN::_minimize_url eq 'unset') {
521 $Git::SVN::_minimize_url = 0;
522 }
523 Git::SVN->init($url);
525}
526sub cmd_fetch {
528 if (grep /^\d+=./, @_) {
529 die "'<rev>=<commit>' fetch arguments are ",
530 "no longer supported.\n";
531 }
532 my ($remote) = @_;
533 if (@_ > 1) {
534 die "Usage: $0 fetch [--all] [--parent] [svn-remote]\n";
535 }
536 $Git::SVN::no_reuse_existing = undef;
537 if ($_fetch_parent) {
538 my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
539 unless ($gs) {
540 die "Unable to determine upstream SVN information from ",
541 "working tree history\n";
542 }
543 # just fetch, don't checkout.
544 $_no_checkout = 'true';
545 $_fetch_all ? $gs->fetch_all : $gs->fetch;
546 } elsif ($_fetch_all) {
547 cmd_multi_fetch();
548 } else {
549 $remote ||= $Git::SVN::default_repo_id;
550 Git::SVN::fetch_all($remote, Git::SVN::read_all_remotes());
551 }
552}
553sub cmd_set_tree {
555 my (@commits) = @_;
556 if ($_stdin || !@commits) {
557 print "Reading from stdin...\n";
558 @commits = ();
559 while (<STDIN>) {
560 if (/\b($sha1_short)\b/o) {
561 unshift @commits, $1;
562 }
563 }
564 }
565 my @revs;
566 foreach my $c (@commits) {
567 my @tmp = command('rev-parse',$c);
568 if (scalar @tmp == 1) {
569 push @revs, $tmp[0];
570 } elsif (scalar @tmp > 1) {
571 push @revs, reverse(command('rev-list',@tmp));
572 } else {
573 fatal "Failed to rev-parse $c";
574 }
575 }
576 my $gs = Git::SVN->new;
577 my ($r_last, $cmt_last) = $gs->last_rev_commit;
578 $gs->fetch;
579 if (defined $gs->{last_rev} && $r_last != $gs->{last_rev}) {
580 fatal "There are new revisions that were fetched ",
581 "and need to be merged (or acknowledged) ",
582 "before committing.\nlast rev: $r_last\n",
583 " current: $gs->{last_rev}";
584 }
585 $gs->set_tree($_) foreach @revs;
586 print "Done committing ",scalar @revs," revisions to SVN\n";
587 unlink $gs->{index};
588}
589sub split_merge_info_range {
591 my ($range) = @_;
592 if ($range =~ /(\d+)-(\d+)/) {
593 return (int($1), int($2));
594 } else {
595 return (int($range), int($range));
596 }
597}
598sub combine_ranges {
600 my ($in) = @_;
601 my @fnums = ();
603 my @arr = split(/,/, $in);
604 for my $element (@arr) {
605 my ($start, $end) = split_merge_info_range($element);
606 push @fnums, $start;
607 }
608 my @sorted = @arr [ sort {
610 $fnums[$a] <=> $fnums[$b]
611 } 0..$#arr ];
612 my @return = ();
614 my $last = -1;
615 my $first = -1;
616 for my $element (@sorted) {
617 my ($start, $end) = split_merge_info_range($element);
618 if ($last == -1) {
620 $first = $start;
621 $last = $end;
622 next;
623 }
624 if ($start <= $last+1) {
625 if ($end > $last) {
626 $last = $end;
627 }
628 next;
629 }
630 if ($first == $last) {
631 push @return, "$first";
632 } else {
633 push @return, "$first-$last";
634 }
635 $first = $start;
636 $last = $end;
637 }
638 if ($first != -1) {
640 if ($first == $last) {
641 push @return, "$first";
642 } else {
643 push @return, "$first-$last";
644 }
645 }
646 return join(',', @return);
648}
649sub merge_revs_into_hash {
651 my ($hash, $minfo) = @_;
652 my @lines = split(' ', $minfo);
653 for my $line (@lines) {
655 my ($branchpath, $revs) = split(/:/, $line);
656 if (exists($hash->{$branchpath})) {
658 # Merge the two revision sets
659 my $combined = "$hash->{$branchpath},$revs";
660 $hash->{$branchpath} = combine_ranges($combined);
661 } else {
662 # Just do range combining for consolidation
663 $hash->{$branchpath} = combine_ranges($revs);
664 }
665 }
666}
667sub merge_merge_info {
669 my ($mergeinfo_one, $mergeinfo_two) = @_;
670 my %result_hash = ();
671 merge_revs_into_hash(\%result_hash, $mergeinfo_one);
673 merge_revs_into_hash(\%result_hash, $mergeinfo_two);
674 my $result = '';
676 # Sort below is for consistency's sake
677 for my $branchname (sort keys(%result_hash)) {
678 my $revlist = $result_hash{$branchname};
679 $result .= "$branchname:$revlist\n"
680 }
681 return $result;
682}
683sub populate_merge_info {
685 my ($d, $gs, $uuid, $linear_refs, $rewritten_parent) = @_;
686 my %parentshash;
688 read_commit_parents(\%parentshash, $d);
689 my @parents = @{$parentshash{$d}};
690 if ($#parents > 0) {
691 # Merge commit
692 my $all_parents_ok = 1;
693 my $aggregate_mergeinfo = '';
694 my $rooturl = $gs->repos_root;
695 if (defined($rewritten_parent)) {
697 # Replace first parent with newly-rewritten version
698 shift @parents;
699 unshift @parents, $rewritten_parent;
700 }
701 foreach my $parent (@parents) {
703 my ($branchurl, $svnrev, $paruuid) =
704 cmt_metadata($parent);
705 unless (defined($svnrev)) {
707 # Should have been caught be preflight check
708 fatal "merge commit $d has ancestor $parent, but that change "
709 ."does not have git-svn metadata!";
710 }
711 unless ($branchurl =~ /^\Q$rooturl\E(.*)/) {
712 fatal "commit $parent git-svn metadata changed mid-run!";
713 }
714 my $branchpath = $1;
715 my $ra = Git::SVN::Ra->new($branchurl);
717 my (undef, undef, $props) =
718 $ra->get_dir(canonicalize_path("."), $svnrev);
719 my $par_mergeinfo = $props->{'svn:mergeinfo'};
720 unless (defined $par_mergeinfo) {
721 $par_mergeinfo = '';
722 }
723 # Merge previous mergeinfo values
724 $aggregate_mergeinfo =
725 merge_merge_info($aggregate_mergeinfo,
726 $par_mergeinfo, 0);
727 next if $parent eq $parents[0]; # Skip first parent
729 # Add new changes being placed in tree by merge
730 my @cmd = (qw/rev-list --reverse/,
731 $parent, qw/--not/);
732 foreach my $par (@parents) {
733 unless ($par eq $parent) {
734 push @cmd, $par;
735 }
736 }
737 my @revsin = ();
738 my ($revlist, $ctx) = command_output_pipe(@cmd);
739 while (<$revlist>) {
740 my $irev = $_;
741 chomp $irev;
742 my (undef, $csvnrev, undef) =
743 cmt_metadata($irev);
744 unless (defined $csvnrev) {
745 # A child is missing SVN annotations...
746 # this might be OK, or might not be.
747 warn "W:child $irev is merged into revision "
748 ."$d but does not have git-svn metadata. "
749 ."This means git-svn cannot determine the "
750 ."svn revision numbers to place into the "
751 ."svn:mergeinfo property. You must ensure "
752 ."a branch is entirely committed to "
753 ."SVN before merging it in order for "
754 ."svn:mergeinfo population to function "
755 ."properly";
756 }
757 push @revsin, $csvnrev;
758 }
759 command_close_pipe($revlist, $ctx);
760 last unless $all_parents_ok;
762 # We now have a list of all SVN revnos which are
764 # merged by this particular parent. Integrate them.
765 next if $#revsin == -1;
766 my $newmergeinfo = "$branchpath:" . join(',', @revsin);
767 $aggregate_mergeinfo =
768 merge_merge_info($aggregate_mergeinfo,
769 $newmergeinfo, 1);
770 }
771 if ($all_parents_ok and $aggregate_mergeinfo) {
772 return $aggregate_mergeinfo;
773 }
774 }
775 return undef;
777}
778sub cmd_dcommit {
780 my $head = shift;
781 command_noisy(qw/update-index --refresh/);
782 git_cmd_try { command_oneline(qw/diff-index --quiet HEAD/) }
783 'Cannot dcommit with a dirty index. Commit your changes first, '
784 . "or stash them with `git stash'.\n";
785 $head ||= 'HEAD';
786 my $old_head;
788 if ($head ne 'HEAD') {
789 $old_head = eval {
790 command_oneline([qw/symbolic-ref -q HEAD/])
791 };
792 if ($old_head) {
793 $old_head =~ s{^refs/heads/}{};
794 } else {
795 $old_head = eval { command_oneline(qw/rev-parse HEAD/) };
796 }
797 command(['checkout', $head], STDERR => 0);
798 }
799 my @refs;
801 my ($url, $rev, $uuid, $gs) = working_head_info('HEAD', \@refs);
802 unless ($gs) {
803 die "Unable to determine upstream SVN information from ",
804 "$head history.\nPerhaps the repository is empty.";
805 }
806 if (defined $_commit_url) {
808 $url = $_commit_url;
809 } else {
810 $url = eval { command_oneline('config', '--get',
811 "svn-remote.$gs->{repo_id}.commiturl") };
812 if (!$url) {
813 $url = $gs->full_pushurl
814 }
815 }
816 my $last_rev = $_revision if defined $_revision;
818 if ($url) {
819 print "Committing to $url ...\n";
820 }
821 my ($linear_refs, $parents) = linearize_history($gs, \@refs);
822 if ($_no_rebase && scalar(@$linear_refs) > 1) {
823 warn "Attempting to commit more than one change while ",
824 "--no-rebase is enabled.\n",
825 "If these changes depend on each other, re-running ",
826 "without --no-rebase may be required."
827 }
828 if (defined $_interactive){
830 my $ask_default = "y";
831 foreach my $d (@$linear_refs){
832 my ($fh, $ctx) = command_output_pipe(qw(show --summary), "$d");
833 while (<$fh>){
834 print $_;
835 }
836 command_close_pipe($fh, $ctx);
837 $_ = ask("Commit this patch to SVN? ([y]es (default)|[n]o|[q]uit|[a]ll): ",
838 valid_re => qr/^(?:yes|y|no|n|quit|q|all|a)/i,
839 default => $ask_default);
840 die "Commit this patch reply required" unless defined $_;
841 if (/^[nq]/i) {
842 exit(0);
843 } elsif (/^a/i) {
844 last;
845 }
846 }
847 }
848 my $expect_url = $url;
850 my $push_merge_info = eval {
852 command_oneline(qw/config --get svn.pushmergeinfo/)
853 };
854 if (not defined($push_merge_info)
855 or $push_merge_info eq "false"
856 or $push_merge_info eq "no"
857 or $push_merge_info eq "never") {
858 $push_merge_info = 0;
859 }
860 unless (defined($_merge_info) || ! $push_merge_info) {
862 # Preflight check of changes to ensure no issues with mergeinfo
863 # This includes check for uncommitted-to-SVN parents
864 # (other than the first parent, which we will handle),
865 # information from different SVN repos, and paths
866 # which are not underneath this repository root.
867 my $rooturl = $gs->repos_root;
868 foreach my $d (@$linear_refs) {
869 my %parentshash;
870 read_commit_parents(\%parentshash, $d);
871 my @realparents = @{$parentshash{$d}};
872 if ($#realparents > 0) {
873 # Merge commit
874 shift @realparents; # Remove/ignore first parent
875 foreach my $parent (@realparents) {
876 my ($branchurl, $svnrev, $paruuid) = cmt_metadata($parent);
877 unless (defined $paruuid) {
878 # A parent is missing SVN annotations...
879 # abort the whole operation.
880 fatal "$parent is merged into revision $d, "
881 ."but does not have git-svn metadata. "
882 ."Either dcommit the branch or use a "
883 ."local cherry-pick, FF merge, or rebase "
884 ."instead of an explicit merge commit.";
885 }
886 unless ($paruuid eq $uuid) {
888 # Parent has SVN metadata from different repository
889 fatal "merge parent $parent for change $d has "
890 ."git-svn uuid $paruuid, while current change "
891 ."has uuid $uuid!";
892 }
893 unless ($branchurl =~ /^\Q$rooturl\E(.*)/) {
895 # This branch is very strange indeed.
896 fatal "merge parent $parent for $d is on branch "
897 ."$branchurl, which is not under the "
898 ."git-svn root $rooturl!";
899 }
900 }
901 }
902 }
903 }
904 my $rewritten_parent;
906 Git::SVN::remove_username($expect_url);
907 if (defined($_merge_info)) {
908 $_merge_info =~ tr{ }{\n};
909 }
910 while (1) {
911 my $d = shift @$linear_refs or last;
912 unless (defined $last_rev) {
913 (undef, $last_rev, undef) = cmt_metadata("$d~1");
914 unless (defined $last_rev) {
915 fatal "Unable to extract revision information ",
916 "from commit $d~1";
917 }
918 }
919 if ($_dry_run) {
920 print "diff-tree $d~1 $d\n";
921 } else {
922 my $cmt_rev;
923 unless (defined($_merge_info) || ! $push_merge_info) {
925 $_merge_info = populate_merge_info($d, $gs,
926 $uuid,
927 $linear_refs,
928 $rewritten_parent);
929 }
930 my %ed_opts = ( r => $last_rev,
932 log => get_commit_entry($d)->{log},
933 ra => Git::SVN::Ra->new($url),
934 config => SVN::Core::config_get_config(
935 $Git::SVN::Ra::config_dir
936 ),
937 tree_a => "$d~1",
938 tree_b => $d,
939 editor_cb => sub {
940 print "Committed r$_[0]\n";
941 $cmt_rev = $_[0];
942 },
943 mergeinfo => $_merge_info,
944 svn_path => '');
945 if (!Git::SVN::Editor->new(\%ed_opts)->apply_diff) {
946 print "No changes\n$d~1 == $d\n";
947 } elsif ($parents->{$d} && @{$parents->{$d}}) {
948 $gs->{inject_parents_dcommit}->{$cmt_rev} =
949 $parents->{$d};
950 }
951 $_fetch_all ? $gs->fetch_all : $gs->fetch;
952 $last_rev = $cmt_rev;
953 next if $_no_rebase;
954 # we always want to rebase against the current HEAD,
956 # not any head that was passed to us
957 my @diff = command('diff-tree', $d,
958 $gs->refname, '--');
959 my @finish;
960 if (@diff) {
961 @finish = rebase_cmd();
962 print STDERR "W: $d and ", $gs->refname,
963 " differ, using @finish:\n",
964 join("\n", @diff), "\n";
965 } else {
966 print "No changes between current HEAD and ",
967 $gs->refname,
968 "\nResetting to the latest ",
969 $gs->refname, "\n";
970 @finish = qw/reset --mixed/;
971 }
972 command_noisy(@finish, $gs->refname);
973 $rewritten_parent = command_oneline(qw/rev-parse HEAD/);
975 if (@diff) {
977 @refs = ();
978 my ($url_, $rev_, $uuid_, $gs_) =
979 working_head_info('HEAD', \@refs);
980 my ($linear_refs_, $parents_) =
981 linearize_history($gs_, \@refs);
982 if (scalar(@$linear_refs) !=
983 scalar(@$linear_refs_)) {
984 fatal "# of revisions changed ",
985 "\nbefore:\n",
986 join("\n", @$linear_refs),
987 "\n\nafter:\n",
988 join("\n", @$linear_refs_), "\n",
989 'If you are attempting to commit ',
990 "merges, try running:\n\t",
991 'git rebase --interactive',
992 '--preserve-merges ',
993 $gs->refname,
994 "\nBefore dcommitting";
995 }
996 if ($url_ ne $expect_url) {
997 if ($url_ eq $gs->metadata_url) {
998 print
999 "Accepting rewritten URL:",
1000 " $url_\n";
1001 } else {
1002 fatal
1003 "URL mismatch after rebase:",
1004 " $url_ != $expect_url";
1005 }
1006 }
1007 if ($uuid_ ne $uuid) {
1008 fatal "uuid mismatch after rebase: ",
1009 "$uuid_ != $uuid";
1010 }
1011 # remap parents
1012 my (%p, @l, $i);
1013 for ($i = 0; $i < scalar @$linear_refs; $i++) {
1014 my $new = $linear_refs_->[$i] or next;
1015 $p{$new} =
1016 $parents->{$linear_refs->[$i]};
1017 push @l, $new;
1018 }
1019 $parents = \%p;
1020 $linear_refs = \@l;
1021 }
1022 }
1023 }
1024 if ($old_head) {
1026 my $new_head = command_oneline(qw/rev-parse HEAD/);
1027 my $new_is_symbolic = eval {
1028 command_oneline(qw/symbolic-ref -q HEAD/);
1029 };
1030 if ($new_is_symbolic) {
1031 print "dcommitted the branch ", $head, "\n";
1032 } else {
1033 print "dcommitted on a detached HEAD because you gave ",
1034 "a revision argument.\n",
1035 "The rewritten commit is: ", $new_head, "\n";
1036 }
1037 command(['checkout', $old_head], STDERR => 0);
1038 }
1039 unlink $gs->{index};
1041}
1042sub cmd_branch {
1044 my ($branch_name, $head) = @_;
1045 unless (defined $branch_name && length $branch_name) {
1047 die(($_tag ? "tag" : "branch") . " name required\n");
1048 }
1049 $head ||= 'HEAD';
1050 my (undef, $rev, undef, $gs) = working_head_info($head);
1052 my $src = $gs->full_pushurl;
1053 my $remote = Git::SVN::read_all_remotes()->{$gs->{repo_id}};
1055 my $allglobs = $remote->{ $_tag ? 'tags' : 'branches' };
1056 my $glob;
1057 if ($#{$allglobs} == 0) {
1058 $glob = $allglobs->[0];
1059 } else {
1060 unless(defined $_branch_dest) {
1061 die "Multiple ",
1062 $_tag ? "tag" : "branch",
1063 " paths defined for Subversion repository.\n",
1064 "You must specify where you want to create the ",
1065 $_tag ? "tag" : "branch",
1066 " with the --destination argument.\n";
1067 }
1068 foreach my $g (@{$allglobs}) {
1069 my $re = Git::SVN::Editor::glob2pat($g->{path}->{left});
1070 if ($_branch_dest =~ /$re/) {
1071 $glob = $g;
1072 last;
1073 }
1074 }
1075 unless (defined $glob) {
1076 my $dest_re = qr/\b\Q$_branch_dest\E\b/;
1077 foreach my $g (@{$allglobs}) {
1078 $g->{path}->{left} =~ /$dest_re/ or next;
1079 if (defined $glob) {
1080 die "Ambiguous destination: ",
1081 $_branch_dest, "\nmatches both '",
1082 $glob->{path}->{left}, "' and '",
1083 $g->{path}->{left}, "'\n";
1084 }
1085 $glob = $g;
1086 }
1087 unless (defined $glob) {
1088 die "Unknown ",
1089 $_tag ? "tag" : "branch",
1090 " destination $_branch_dest\n";
1091 }
1092 }
1093 }
1094 my ($lft, $rgt) = @{ $glob->{path} }{qw/left right/};
1095 my $url;
1096 if (defined $_commit_url) {
1097 $url = $_commit_url;
1098 } else {
1099 $url = eval { command_oneline('config', '--get',
1100 "svn-remote.$gs->{repo_id}.commiturl") };
1101 if (!$url) {
1102 $url = $remote->{pushurl} || $remote->{url};
1103 }
1104 }
1105 my $dst = join '/', $url, $lft, $branch_name, ($rgt || ());
1106 if ($dst =~ /^https:/ && $src =~ /^http:/) {
1108 $src=~s/^http:/https:/;
1109 }
1110 ::_req_svn();
1112 my $ctx = SVN::Client->new(
1114 auth => Git::SVN::Ra::_auth_providers(),
1115 log_msg => sub {
1116 ${ $_[0] } = defined $_message
1117 ? $_message
1118 : 'Create ' . ($_tag ? 'tag ' : 'branch ' )
1119 . $branch_name;
1120 },
1121 );
1122 eval {
1124 $ctx->ls($dst, 'HEAD', 0);
1125 } and die "branch ${branch_name} already exists\n";
1126 print "Copying ${src} at r${rev} to ${dst}...\n";
1128 $ctx->copy($src, $rev, $dst)
1129 unless $_dry_run;
1130 $gs->fetch_all;
1132}
1133sub cmd_find_rev {
1135 my $revision_or_hash = shift or die "SVN or git revision required ",
1136 "as a command-line argument\n";
1137 my $result;
1138 if ($revision_or_hash =~ /^r\d+$/) {
1139 my $head = shift;
1140 $head ||= 'HEAD';
1141 my @refs;
1142 my (undef, undef, $uuid, $gs) = working_head_info($head, \@refs);
1143 unless ($gs) {
1144 die "Unable to determine upstream SVN information from ",
1145 "$head history\n";
1146 }
1147 my $desired_revision = substr($revision_or_hash, 1);
1148 $result = $gs->rev_map_get($desired_revision, $uuid);
1149 } else {
1150 my (undef, $rev, undef) = cmt_metadata($revision_or_hash);
1151 $result = $rev;
1152 }
1153 print "$result\n" if $result;
1154}
1155sub auto_create_empty_directories {
1157 my ($gs) = @_;
1158 my $var = eval { command_oneline('config', '--get', '--bool',
1159 "svn-remote.$gs->{repo_id}.automkdirs") };
1160 # By default, create empty directories by consulting the unhandled log,
1161 # but allow setting it to 'false' to skip it.
1162 return !($var && $var eq 'false');
1163}
1164sub cmd_rebase {
1166 command_noisy(qw/update-index --refresh/);
1167 my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
1168 unless ($gs) {
1169 die "Unable to determine upstream SVN information from ",
1170 "working tree history\n";
1171 }
1172 if ($_dry_run) {
1173 print "Remote Branch: " . $gs->refname . "\n";
1174 print "SVN URL: " . $url . "\n";
1175 return;
1176 }
1177 if (command(qw/diff-index HEAD --/)) {
1178 print STDERR "Cannot rebase with uncommited changes:\n";
1179 command_noisy('status');
1180 exit 1;
1181 }
1182 unless ($_local) {
1183 # rebase will checkout for us, so no need to do it explicitly
1184 $_no_checkout = 'true';
1185 $_fetch_all ? $gs->fetch_all : $gs->fetch;
1186 }
1187 command_noisy(rebase_cmd(), $gs->refname);
1188 if (auto_create_empty_directories($gs)) {
1189 $gs->mkemptydirs;
1190 }
1191}
1192sub cmd_show_ignore {
1194 my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
1195 $gs ||= Git::SVN->new;
1196 my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
1197 $gs->prop_walk($gs->{path}, $r, sub {
1198 my ($gs, $path, $props) = @_;
1199 print STDOUT "\n# $path\n";
1200 my $s = $props->{'svn:ignore'} or return;
1201 $s =~ s/[\r\n]+/\n/g;
1202 $s =~ s/^\n+//;
1203 chomp $s;
1204 $s =~ s#^#$path#gm;
1205 print STDOUT "$s\n";
1206 });
1207}
1208sub cmd_show_externals {
1210 my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
1211 $gs ||= Git::SVN->new;
1212 my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
1213 $gs->prop_walk($gs->{path}, $r, sub {
1214 my ($gs, $path, $props) = @_;
1215 print STDOUT "\n# $path\n";
1216 my $s = $props->{'svn:externals'} or return;
1217 $s =~ s/[\r\n]+/\n/g;
1218 chomp $s;
1219 $s =~ s#^#$path#gm;
1220 print STDOUT "$s\n";
1221 });
1222}
1223sub cmd_create_ignore {
1225 my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
1226 $gs ||= Git::SVN->new;
1227 my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
1228 $gs->prop_walk($gs->{path}, $r, sub {
1229 my ($gs, $path, $props) = @_;
1230 # $path is of the form /path/to/dir/
1231 $path = '.' . $path;
1232 # SVN can have attributes on empty directories,
1233 # which git won't track
1234 mkpath([$path]) unless -d $path;
1235 my $ignore = $path . '.gitignore';
1236 my $s = $props->{'svn:ignore'} or return;
1237 open(GITIGNORE, '>', $ignore)
1238 or fatal("Failed to open `$ignore' for writing: $!");
1239 $s =~ s/[\r\n]+/\n/g;
1240 $s =~ s/^\n+//;
1241 chomp $s;
1242 # Prefix all patterns so that the ignore doesn't apply
1243 # to sub-directories.
1244 $s =~ s#^#/#gm;
1245 print GITIGNORE "$s\n";
1246 close(GITIGNORE)
1247 or fatal("Failed to close `$ignore': $!");
1248 command_noisy('add', '-f', $ignore);
1249 });
1250}
1251sub cmd_mkdirs {
1253 my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
1254 $gs ||= Git::SVN->new;
1255 $gs->mkemptydirs($_revision);
1256}
1257sub canonicalize_path {
1259 my ($path) = @_;
1260 my $dot_slash_added = 0;
1261 if (substr($path, 0, 1) ne "/") {
1262 $path = "./" . $path;
1263 $dot_slash_added = 1;
1264 }
1265 # File::Spec->canonpath doesn't collapse x/../y into y (for a
1266 # good reason), so let's do this manually.
1267 $path =~ s#/+#/#g;
1268 $path =~ s#/\.(?:/|$)#/#g;
1269 $path =~ s#/[^/]+/\.\.##g;
1270 $path =~ s#/$##g;
1271 $path =~ s#^\./## if $dot_slash_added;
1272 $path =~ s#^/##;
1273 $path =~ s#^\.$##;
1274 return $path;
1275}
1276sub canonicalize_url {
1278 my ($url) = @_;
1279 $url =~ s#^([^:]+://[^/]*/)(.*)$#$1 . canonicalize_path($2)#e;
1280 return $url;
1281}
1282# get_svnprops(PATH)
1284# ------------------
1285# Helper for cmd_propget and cmd_proplist below.
1286sub get_svnprops {
1287 my $path = shift;
1288 my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
1289 $gs ||= Git::SVN->new;
1290 # prefix THE PATH by the sub-directory from which the user
1292 # invoked us.
1293 $path = $cmd_dir_prefix . $path;
1294 fatal("No such file or directory: $path") unless -e $path;
1295 my $is_dir = -d $path ? 1 : 0;
1296 $path = $gs->{path} . '/' . $path;
1297 # canonicalize the path (otherwise libsvn will abort or fail to
1299 # find the file)
1300 $path = canonicalize_path($path);
1301 my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
1303 my $props;
1304 if ($is_dir) {
1305 (undef, undef, $props) = $gs->ra->get_dir($path, $r);
1306 }
1307 else {
1308 (undef, $props) = $gs->ra->get_file($path, $r, undef);
1309 }
1310 return $props;
1311}
1312# cmd_propget (PROP, PATH)
1314# ------------------------
1315# Print the SVN property PROP for PATH.
1316sub cmd_propget {
1317 my ($prop, $path) = @_;
1318 $path = '.' if not defined $path;
1319 usage(1) if not defined $prop;
1320 my $props = get_svnprops($path);
1321 if (not defined $props->{$prop}) {
1322 fatal("`$path' does not have a `$prop' SVN property.");
1323 }
1324 print $props->{$prop} . "\n";
1325}
1326# cmd_proplist (PATH)
1328# -------------------
1329# Print the list of SVN properties for PATH.
1330sub cmd_proplist {
1331 my $path = shift;
1332 $path = '.' if not defined $path;
1333 my $props = get_svnprops($path);
1334 print "Properties on '$path':\n";
1335 foreach (sort keys %{$props}) {
1336 print " $_\n";
1337 }
1338}
1339sub cmd_multi_init {
1341 my $url = shift;
1342 unless (defined $_trunk || @_branches || @_tags) {
1343 usage(1);
1344 }
1345 $_prefix = '' unless defined $_prefix;
1347 if (defined $url) {
1348 $url = canonicalize_url($url);
1349 init_subdir(@_);
1350 }
1351 do_git_init_db();
1352 if (defined $_trunk) {
1353 $_trunk =~ s#^/+##;
1354 my $trunk_ref = 'refs/remotes/' . $_prefix . 'trunk';
1355 # try both old-style and new-style lookups:
1356 my $gs_trunk = eval { Git::SVN->new($trunk_ref) };
1357 unless ($gs_trunk) {
1358 my ($trunk_url, $trunk_path) =
1359 complete_svn_url($url, $_trunk);
1360 $gs_trunk = Git::SVN->init($trunk_url, $trunk_path,
1361 undef, $trunk_ref);
1362 }
1363 }
1364 return unless @_branches || @_tags;
1365 my $ra = $url ? Git::SVN::Ra->new($url) : undef;
1366 foreach my $path (@_branches) {
1367 complete_url_ls_init($ra, $path, '--branches/-b', $_prefix);
1368 }
1369 foreach my $path (@_tags) {
1370 complete_url_ls_init($ra, $path, '--tags/-t', $_prefix.'tags/');
1371 }
1372}
1373sub cmd_multi_fetch {
1375 $Git::SVN::no_reuse_existing = undef;
1376 my $remotes = Git::SVN::read_all_remotes();
1377 foreach my $repo_id (sort keys %$remotes) {
1378 if ($remotes->{$repo_id}->{url}) {
1379 Git::SVN::fetch_all($repo_id, $remotes);
1380 }
1381 }
1382}
1383# this command is special because it requires no metadata
1385sub cmd_commit_diff {
1386 my ($ta, $tb, $url) = @_;
1387 my $usage = "Usage: $0 commit-diff -r<revision> ".
1388 "<tree-ish> <tree-ish> [<URL>]";
1389 fatal($usage) if (!defined $ta || !defined $tb);
1390 my $svn_path = '';
1391 if (!defined $url) {
1392 my $gs = eval { Git::SVN->new };
1393 if (!$gs) {
1394 fatal("Needed URL or usable git-svn --id in ",
1395 "the command-line\n", $usage);
1396 }
1397 $url = $gs->{url};
1398 $svn_path = $gs->{path};
1399 }
1400 unless (defined $_revision) {
1401 fatal("-r|--revision is a required argument\n", $usage);
1402 }
1403 if (defined $_message && defined $_file) {
1404 fatal("Both --message/-m and --file/-F specified ",
1405 "for the commit message.\n",
1406 "I have no idea what you mean");
1407 }
1408 if (defined $_file) {
1409 $_message = file_to_s($_file);
1410 } else {
1411 $_message ||= get_commit_entry($tb)->{log};
1412 }
1413 my $ra ||= Git::SVN::Ra->new($url);
1414 my $r = $_revision;
1415 if ($r eq 'HEAD') {
1416 $r = $ra->get_latest_revnum;
1417 } elsif ($r !~ /^\d+$/) {
1418 die "revision argument: $r not understood by git-svn\n";
1419 }
1420 my %ed_opts = ( r => $r,
1421 log => $_message,
1422 ra => $ra,
1423 tree_a => $ta,
1424 tree_b => $tb,
1425 editor_cb => sub { print "Committed r$_[0]\n" },
1426 svn_path => $svn_path );
1427 if (!Git::SVN::Editor->new(\%ed_opts)->apply_diff) {
1428 print "No changes\n$ta == $tb\n";
1429 }
1430}
1431sub escape_uri_only {
1433 my ($uri) = @_;
1434 my @tmp;
1435 foreach (split m{/}, $uri) {
1436 s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
1437 push @tmp, $_;
1438 }
1439 join('/', @tmp);
1440}
1441sub escape_url {
1443 my ($url) = @_;
1444 if ($url =~ m#^([^:]+)://([^/]*)(.*)$#) {
1445 my ($scheme, $domain, $uri) = ($1, $2, escape_uri_only($3));
1446 $url = "$scheme://$domain$uri";
1447 }
1448 $url;
1449}
1450sub cmd_info {
1452 my $path = canonicalize_path(defined($_[0]) ? $_[0] : ".");
1453 my $fullpath = canonicalize_path($cmd_dir_prefix . $path);
1454 if (exists $_[1]) {
1455 die "Too many arguments specified\n";
1456 }
1457 my ($file_type, $diff_status) = find_file_type_and_diff_status($path);
1459 if (!$file_type && !$diff_status) {
1461 print STDERR "svn: '$path' is not under version control\n";
1462 exit 1;
1463 }
1464 my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
1466 unless ($gs) {
1467 die "Unable to determine upstream SVN information from ",
1468 "working tree history\n";
1469 }
1470 # canonicalize_path() will return "" to make libsvn 1.5.x happy,
1472 $path = "." if $path eq "";
1473 my $full_url = $url . ($fullpath eq "" ? "" : "/$fullpath");
1475 if ($_url) {
1477 print escape_url($full_url), "\n";
1478 return;
1479 }
1480 my $result = "Path: $path\n";
1482 $result .= "Name: " . basename($path) . "\n" if $file_type ne "dir";
1483 $result .= "URL: " . escape_url($full_url) . "\n";
1484 eval {
1486 my $repos_root = $gs->repos_root;
1487 Git::SVN::remove_username($repos_root);
1488 $result .= "Repository Root: " . escape_url($repos_root) . "\n";
1489 };
1490 if ($@) {
1491 $result .= "Repository Root: (offline)\n";
1492 }
1493 ::_req_svn();
1494 $result .= "Repository UUID: $uuid\n" unless $diff_status eq "A" &&
1495 (::compare_svn_version('1.5.4') <= 0 || $file_type ne "dir");
1496 $result .= "Revision: " . ($diff_status eq "A" ? 0 : $rev) . "\n";
1497 $result .= "Node Kind: " .
1499 ($file_type eq "dir" ? "directory" : "file") . "\n";
1500 my $schedule = $diff_status eq "A"
1502 ? "add"
1503 : ($diff_status eq "D" ? "delete" : "normal");
1504 $result .= "Schedule: $schedule\n";
1505 if ($diff_status eq "A") {
1507 print $result, "\n";
1508 return;
1509 }
1510 my ($lc_author, $lc_rev, $lc_date_utc);
1512 my @args = Git::SVN::Log::git_svn_log_cmd($rev, $rev, "--", $fullpath);
1513 my $log = command_output_pipe(@args);
1514 my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/;
1515 while (<$log>) {
1516 if (/^${esc_color}author (.+) <[^>]+> (\d+) ([\-\+]?\d+)$/o) {
1517 $lc_author = $1;
1518 $lc_date_utc = Git::SVN::Log::parse_git_date($2, $3);
1519 } elsif (/^${esc_color} (git-svn-id:.+)$/o) {
1520 (undef, $lc_rev, undef) = ::extract_metadata($1);
1521 }
1522 }
1523 close $log;
1524 Git::SVN::Log::set_local_timezone();
1526 $result .= "Last Changed Author: $lc_author\n";
1528 $result .= "Last Changed Rev: $lc_rev\n";
1529 $result .= "Last Changed Date: " .
1530 Git::SVN::Log::format_svn_date($lc_date_utc) . "\n";
1531 if ($file_type ne "dir") {
1533 my $text_last_updated_date =
1534 ($diff_status eq "D" ? $lc_date_utc : (stat $path)[9]);
1535 $result .=
1536 "Text Last Updated: " .
1537 Git::SVN::Log::format_svn_date($text_last_updated_date) .
1538 "\n";
1539 my $checksum;
1540 if ($diff_status eq "D") {
1541 my ($fh, $ctx) =
1542 command_output_pipe(qw(cat-file blob), "HEAD:$path");
1543 if ($file_type eq "link") {
1544 my $file_name = <$fh>;
1545 $checksum = md5sum("link $file_name");
1546 } else {
1547 $checksum = md5sum($fh);
1548 }
1549 command_close_pipe($fh, $ctx);
1550 } elsif ($file_type eq "link") {
1551 my $file_name =
1552 command(qw(cat-file blob), "HEAD:$path");
1553 $checksum =
1554 md5sum("link " . $file_name);
1555 } else {
1556 open FILE, "<", $path or die $!;
1557 $checksum = md5sum(\*FILE);
1558 close FILE or die $!;
1559 }
1560 $result .= "Checksum: " . $checksum . "\n";
1561 }
1562 print $result, "\n";
1564}
1565sub cmd_reset {
1567 my $target = shift || $_revision or die "SVN revision required\n";
1568 $target = $1 if $target =~ /^r(\d+)$/;
1569 $target =~ /^\d+$/ or die "Numeric SVN revision expected\n";
1570 my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
1571 unless ($gs) {
1572 die "Unable to determine upstream SVN information from ".
1573 "history\n";
1574 }
1575 my ($r, $c) = $gs->find_rev_before($target, not $_fetch_parent);
1576 die "Cannot find SVN revision $target\n" unless defined($c);
1577 $gs->rev_map_set($r, $c, 'reset', $uuid);
1578 print "r$r = $c ($gs->{ref_id})\n";
1579}
1580sub cmd_gc {
1582 if (!can_compress()) {
1583 warn "Compress::Zlib could not be found; unhandled.log " .
1584 "files will not be compressed.\n";
1585 }
1586 find({ wanted => \&gc_directory, no_chdir => 1}, "$ENV{GIT_DIR}/svn");
1587}
1588########################### utility functions #########################
1590sub rebase_cmd {
1592 my @cmd = qw/rebase/;
1593 push @cmd, '-v' if $_verbose;
1594 push @cmd, qw/--merge/ if $_merge;
1595 push @cmd, "--strategy=$_strategy" if $_strategy;
1596 push @cmd, "--preserve-merges" if $_preserve_merges;
1597 @cmd;
1598}
1599sub post_fetch_checkout {
1601 return if $_no_checkout;
1602 return if verify_ref('HEAD^0');
1603 my $gs = $Git::SVN::_head or return;
1604 # look for "trunk" ref if it exists
1606 my $remote = Git::SVN::read_all_remotes()->{$gs->{repo_id}};
1607 my $fetch = $remote->{fetch};
1608 if ($fetch) {
1609 foreach my $p (keys %$fetch) {
1610 basename($fetch->{$p}) eq 'trunk' or next;
1611 $gs = Git::SVN->new($fetch->{$p}, $gs->{repo_id}, $p);
1612 last;
1613 }
1614 }
1615 command_noisy(qw(update-ref HEAD), $gs->refname);
1617 return unless verify_ref('HEAD^0');
1618 return if $ENV{GIT_DIR} !~ m#^(?:.*/)?\.git$#;
1620 my $index = $ENV{GIT_INDEX_FILE} || "$ENV{GIT_DIR}/index";
1621 return if -f $index;
1622 return if command_oneline(qw/rev-parse --is-inside-work-tree/) eq 'false';
1624 return if command_oneline(qw/rev-parse --is-inside-git-dir/) eq 'true';
1625 command_noisy(qw/read-tree -m -u -v HEAD HEAD/);
1626 print STDERR "Checked out HEAD:\n ",
1627 $gs->full_url, " r", $gs->last_rev, "\n";
1628 if (auto_create_empty_directories($gs)) {
1629 $gs->mkemptydirs($gs->last_rev);
1630 }
1631}
1632sub complete_svn_url {
1634 my ($url, $path) = @_;
1635 $path =~ s#/+$##;
1636 if ($path !~ m#^[a-z\+]+://#) {
1637 if (!defined $url || $url !~ m#^[a-z\+]+://#) {
1638 fatal("E: '$path' is not a complete URL ",
1639 "and a separate URL is not specified");
1640 }
1641 return ($url, $path);
1642 }
1643 return ($path, '');
1644}
1645sub complete_url_ls_init {
1647 my ($ra, $repo_path, $switch, $pfx) = @_;
1648 unless ($repo_path) {
1649 print STDERR "W: $switch not specified\n";
1650 return;
1651 }
1652 $repo_path =~ s#/+$##;
1653 if ($repo_path =~ m#^[a-z\+]+://#) {
1654 $ra = Git::SVN::Ra->new($repo_path);
1655 $repo_path = '';
1656 } else {
1657 $repo_path =~ s#^/+##;
1658 unless ($ra) {
1659 fatal("E: '$repo_path' is not a complete URL ",
1660 "and a separate URL is not specified");
1661 }
1662 }
1663 my $url = $ra->{url};
1664 my $gs = Git::SVN->init($url, undef, undef, undef, 1);
1665 my $k = "svn-remote.$gs->{repo_id}.url";
1666 my $orig_url = eval { command_oneline(qw/config --get/, $k) };
1667 if ($orig_url && ($orig_url ne $gs->{url})) {
1668 die "$k already set: $orig_url\n",
1669 "wanted to set to: $gs->{url}\n";
1670 }
1671 command_oneline('config', $k, $gs->{url}) unless $orig_url;
1672 my $remote_path = "$gs->{path}/$repo_path";
1673 $remote_path =~ s{%([0-9A-F]{2})}{chr hex($1)}ieg;
1674 $remote_path =~ s#/+#/#g;
1675 $remote_path =~ s#^/##g;
1676 $remote_path .= "/*" if $remote_path !~ /\*/;
1677 my ($n) = ($switch =~ /^--(\w+)/);
1678 if (length $pfx && $pfx !~ m#/$#) {
1679 die "--prefix='$pfx' must have a trailing slash '/'\n";
1680 }
1681 command_noisy('config',
1682 '--add',
1683 "svn-remote.$gs->{repo_id}.$n",
1684 "$remote_path:refs/remotes/$pfx*" .
1685 ('/*' x (($remote_path =~ tr/*/*/) - 1)) );
1686}
1687sub verify_ref {
1689 my ($ref) = @_;
1690 eval { command_oneline([ 'rev-parse', '--verify', $ref ],
1691 { STDERR => 0 }); };
1692}
1693sub get_tree_from_treeish {
1695 my ($treeish) = @_;
1696 # $treeish can be a symbolic ref, too:
1697 my $type = command_oneline(qw/cat-file -t/, $treeish);
1698 my $expected;
1699 while ($type eq 'tag') {
1700 ($treeish, $type) = command(qw/cat-file tag/, $treeish);
1701 }
1702 if ($type eq 'commit') {
1703 $expected = (grep /^tree /, command(qw/cat-file commit/,
1704 $treeish))[0];
1705 ($expected) = ($expected =~ /^tree ($sha1)$/o);
1706 die "Unable to get tree from $treeish\n" unless $expected;
1707 } elsif ($type eq 'tree') {
1708 $expected = $treeish;
1709 } else {
1710 die "$treeish is a $type, expected tree, tag or commit\n";
1711 }
1712 return $expected;
1713}
1714sub get_commit_entry {
1716 my ($treeish) = shift;
1717 my %log_entry = ( log => '', tree => get_tree_from_treeish($treeish) );
1718 my $commit_editmsg = "$ENV{GIT_DIR}/COMMIT_EDITMSG";
1719 my $commit_msg = "$ENV{GIT_DIR}/COMMIT_MSG";
1720 open my $log_fh, '>', $commit_editmsg or croak $!;
1721 my $type = command_oneline(qw/cat-file -t/, $treeish);
1723 if ($type eq 'commit' || $type eq 'tag') {
1724 my ($msg_fh, $ctx) = command_output_pipe('cat-file',
1725 $type, $treeish);
1726 my $in_msg = 0;
1727 my $author;
1728 my $saw_from = 0;
1729 my $msgbuf = "";
1730 while (<$msg_fh>) {
1731 if (!$in_msg) {
1732 $in_msg = 1 if (/^\s*$/);
1733 $author = $1 if (/^author (.*>)/);
1734 } elsif (/^git-svn-id: /) {
1735 # skip this for now, we regenerate the
1736 # correct one on re-fetch anyways
1737 # TODO: set *:merge properties or like...
1738 } else {
1739 if (/^From:/ || /^Signed-off-by:/) {
1740 $saw_from = 1;
1741 }
1742 $msgbuf .= $_;
1743 }
1744 }
1745 $msgbuf =~ s/\s+$//s;
1746 if ($Git::SVN::_add_author_from && defined($author)
1747 && !$saw_from) {
1748 $msgbuf .= "\n\nFrom: $author";
1749 }
1750 print $log_fh $msgbuf or croak $!;
1751 command_close_pipe($msg_fh, $ctx);
1752 }
1753 close $log_fh or croak $!;
1754 if ($_edit || ($type eq 'tree')) {
1756 chomp(my $editor = command_oneline(qw(var GIT_EDITOR)));
1757 system('sh', '-c', $editor.' "$@"', $editor, $commit_editmsg);
1758 }
1759 rename $commit_editmsg, $commit_msg or croak $!;
1760 {
1761 require Encode;
1762 # SVN requires messages to be UTF-8 when entering the repo
1763 local $/;
1764 open $log_fh, '<', $commit_msg or croak $!;
1765 binmode $log_fh;
1766 chomp($log_entry{log} = <$log_fh>);
1767 my $enc = Git::config('i18n.commitencoding') || 'UTF-8';
1769 my $msg = $log_entry{log};
1770 eval { $msg = Encode::decode($enc, $msg, 1) };
1772 if ($@) {
1773 die "Could not decode as $enc:\n", $msg,
1774 "\nPerhaps you need to set i18n.commitencoding\n";
1775 }
1776 eval { $msg = Encode::encode('UTF-8', $msg, 1) };
1778 die "Could not encode as UTF-8:\n$msg\n" if $@;
1779 $log_entry{log} = $msg;
1781 close $log_fh or croak $!;
1783 }
1784 unlink $commit_msg;
1785 \%log_entry;
1786}
1787sub s_to_file {
1789 my ($str, $file, $mode) = @_;
1790 open my $fd,'>',$file or croak $!;
1791 print $fd $str,"\n" or croak $!;
1792 close $fd or croak $!;
1793 chmod ($mode &~ umask, $file) if (defined $mode);
1794}
1795sub file_to_s {
1797 my $file = shift;
1798 open my $fd,'<',$file or croak "$!: file: $file\n";
1799 local $/;
1800 my $ret = <$fd>;
1801 close $fd or croak $!;
1802 $ret =~ s/\s*$//s;
1803 return $ret;
1804}
1805# '<svn username> = real-name <email address>' mapping based on git-svnimport:
1807sub load_authors {
1808 open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
1809 my $log = $cmd eq 'log';
1810 while (<$authors>) {
1811 chomp;
1812 next unless /^(.+?|\(no author\))\s*=\s*(.+?)\s*<(.+)>\s*$/;
1813 my ($user, $name, $email) = ($1, $2, $3);
1814 if ($log) {
1815 $Git::SVN::Log::rusers{"$name <$email>"} = $user;
1816 } else {
1817 $users{$user} = [$name, $email];
1818 }
1819 }
1820 close $authors or croak $!;
1821}
1822# convert GetOpt::Long specs for use by git-config
1824sub read_git_config {
1825 my $opts = shift;
1826 my @config_only;
1827 foreach my $o (keys %$opts) {
1828 # if we have mixedCase and a long option-only, then
1829 # it's a config-only variable that we don't need for
1830 # the command-line.
1831 push @config_only, $o if ($o =~ /[A-Z]/ && $o =~ /^[a-z]+$/i);
1832 my $v = $opts->{$o};
1833 my ($key) = ($o =~ /^([a-zA-Z\-]+)/);
1834 $key =~ s/-//g;
1835 my $arg = 'git config';
1836 $arg .= ' --int' if ($o =~ /[:=]i$/);
1837 $arg .= ' --bool' if ($o !~ /[:=][sfi]$/);
1838 if (ref $v eq 'ARRAY') {
1839 chomp(my @tmp = `$arg --get-all svn.$key`);
1840 @$v = @tmp if @tmp;
1841 } else {
1842 chomp(my $tmp = `$arg --get svn.$key`);
1843 if ($tmp && !($arg =~ / --bool/ && $tmp eq 'false')) {
1844 $$v = $tmp;
1845 }
1846 }
1847 }
1848 delete @$opts{@config_only} if @config_only;
1849}
1850sub extract_metadata {
1852 my $id = shift or return (undef, undef, undef);
1853 my ($url, $rev, $uuid) = ($id =~ /^\s*git-svn-id:\s+(.*)\@(\d+)
1854 \s([a-f\d\-]+)$/ix);
1855 if (!defined $rev || !$uuid || !$url) {
1856 # some of the original repositories I made had
1857 # identifiers like this:
1858 ($rev, $uuid) = ($id =~/^\s*git-svn-id:\s(\d+)\@([a-f\d\-]+)/i);
1859 }
1860 return ($url, $rev, $uuid);
1861}
1862sub cmt_metadata {
1864 return extract_metadata((grep(/^git-svn-id: /,
1865 command(qw/cat-file commit/, shift)))[-1]);
1866}
1867sub cmt_sha2rev_batch {
1869 my %s2r;
1870 my ($pid, $in, $out, $ctx) = command_bidi_pipe(qw/cat-file --batch/);
1871 my $list = shift;
1872 foreach my $sha (@{$list}) {
1874 my $first = 1;
1875 my $size = 0;
1876 print $out $sha, "\n";
1877 while (my $line = <$in>) {
1879 if ($first && $line =~ /^[[:xdigit:]]{40}\smissing$/) {
1880 last;
1881 } elsif ($first &&
1882 $line =~ /^[[:xdigit:]]{40}\scommit\s(\d+)$/) {
1883 $first = 0;
1884 $size = $1;
1885 next;
1886 } elsif ($line =~ /^(git-svn-id: )/) {
1887 my (undef, $rev, undef) =
1888 extract_metadata($line);
1889 $s2r{$sha} = $rev;
1890 }
1891 $size -= length($line);
1893 last if ($size == 0);
1894 }
1895 }
1896 command_close_bidi_pipe($pid, $in, $out, $ctx);
1898 return \%s2r;
1900}
1901sub working_head_info {
1903 my ($head, $refs) = @_;
1904 my @args = qw/rev-list --first-parent --pretty=medium/;
1905 my ($fh, $ctx) = command_output_pipe(@args, $head);
1906 my $hash;
1907 my %max;
1908 while (<$fh>) {
1909 if ( m{^commit ($::sha1)$} ) {
1910 unshift @$refs, $hash if $hash and $refs;
1911 $hash = $1;
1912 next;
1913 }
1914 next unless s{^\s*(git-svn-id:)}{$1};
1915 my ($url, $rev, $uuid) = extract_metadata($_);
1916 if (defined $url && defined $rev) {
1917 next if $max{$url} and $max{$url} < $rev;
1918 if (my $gs = Git::SVN->find_by_url($url)) {
1919 my $c = $gs->rev_map_get($rev, $uuid);
1920 if ($c && $c eq $hash) {
1921 close $fh; # break the pipe
1922 return ($url, $rev, $uuid, $gs);
1923 } else {
1924 $max{$url} ||= $gs->rev_map_max;
1925 }
1926 }
1927 }
1928 }
1929 command_close_pipe($fh, $ctx);
1930 (undef, undef, undef, undef);
1931}
1932sub read_commit_parents {
1934 my ($parents, $c) = @_;
1935 chomp(my $p = command_oneline(qw/rev-list --parents -1/, $c));
1936 $p =~ s/^($c)\s*// or die "rev-list --parents -1 $c failed!\n";
1937 @{$parents->{$c}} = split(/ /, $p);
1938}
1939sub linearize_history {
1941 my ($gs, $refs) = @_;
1942 my %parents;
1943 foreach my $c (@$refs) {
1944 read_commit_parents(\%parents, $c);
1945 }
1946 my @linear_refs;
1948 my %skip = ();
1949 my $last_svn_commit = $gs->last_commit;
1950 foreach my $c (reverse @$refs) {
1951 next if $c eq $last_svn_commit;
1952 last if $skip{$c};
1953 unshift @linear_refs, $c;
1955 $skip{$c} = 1;
1956 # we only want the first parent to diff against for linear
1958 # history, we save the rest to inject when we finalize the
1959 # svn commit
1960 my $fp_a = verify_ref("$c~1");
1961 my $fp_b = shift @{$parents{$c}} if $parents{$c};
1962 if (!$fp_a || !$fp_b) {
1963 die "Commit $c\n",
1964 "has no parent commit, and therefore ",
1965 "nothing to diff against.\n",
1966 "You should be working from a repository ",
1967 "originally created by git-svn\n";
1968 }
1969 if ($fp_a ne $fp_b) {
1970 die "$c~1 = $fp_a, however parsing commit $c ",
1971 "revealed that:\n$c~1 = $fp_b\nBUG!\n";
1972 }
1973 foreach my $p (@{$parents{$c}}) {
1975 $skip{$p} = 1;
1976 }
1977 }
1978 (\@linear_refs, \%parents);
1979}
1980sub find_file_type_and_diff_status {
1982 my ($path) = @_;
1983 return ('dir', '') if $path eq '';
1984 my $diff_output =
1986 command_oneline(qw(diff --cached --name-status --), $path) || "";
1987 my $diff_status = (split(' ', $diff_output))[0] || "";
1988 my $ls_tree = command_oneline(qw(ls-tree HEAD), $path) || "";
1990 return (undef, undef) if !$diff_status && !$ls_tree;
1992 if ($diff_status eq "A") {
1994 return ("link", $diff_status) if -l $path;
1995 return ("dir", $diff_status) if -d $path;
1996 return ("file", $diff_status);
1997 }
1998 my $mode = (split(' ', $ls_tree))[0] || "";
2000 return ("link", $diff_status) if $mode eq "120000";
2002 return ("dir", $diff_status) if $mode eq "040000";
2003 return ("file", $diff_status);
2004}
2005sub md5sum {
2007 my $arg = shift;
2008 my $ref = ref $arg;
2009 my $md5 = Digest::MD5->new();
2010 if ($ref eq 'GLOB' || $ref eq 'IO::File' || $ref eq 'File::Temp') {
2011 $md5->addfile($arg) or croak $!;
2012 } elsif ($ref eq 'SCALAR') {
2013 $md5->add($$arg) or croak $!;
2014 } elsif (!$ref) {
2015 $md5->add($arg) or croak $!;
2016 } else {
2017 fatal "Can't provide MD5 hash for unknown ref type: '", $ref, "'";
2018 }
2019 return $md5->hexdigest();
2020}
2021sub gc_directory {
2023 if (can_compress() && -f $_ && basename($_) eq "unhandled.log") {
2024 my $out_filename = $_ . ".gz";
2025 open my $in_fh, "<", $_ or die "Unable to open $_: $!\n";
2026 binmode $in_fh;
2027 my $gz = Compress::Zlib::gzopen($out_filename, "ab") or
2028 die "Unable to open $out_filename: $!\n";
2029 my $res;
2031 while ($res = sysread($in_fh, my $str, 1024)) {
2032 $gz->gzwrite($str) or
2033 die "Unable to write: ".$gz->gzerror()."!\n";
2034 }
2035 unlink $_ or die "unlink $File::Find::name: $!\n";
2036 } elsif (-f $_ && basename($_) eq "index") {
2037 unlink $_ or die "unlink $_: $!\n";
2038 }
2039}
2040package Git::SVN::Log;
2043use strict;
2044use warnings;
2045use Git::SVN::Utils qw(fatal);
2046use POSIX qw/strftime/;
2047use constant commit_log_separator => ('-' x 72) . "\n";
2048use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline
2049 %rusers $show_commit $incremental/;
2050my $l_fmt;
2051sub cmt_showable {
2053 my ($c) = @_;
2054 return 1 if defined $c->{r};
2055 # big commit message got truncated by the 16k pretty buffer in rev-list
2057 if ($c->{l} && $c->{l}->[-1] eq "...\n" &&
2058 $c->{a_raw} =~ /\@([a-f\d\-]+)>$/) {
2059 @{$c->{l}} = ();
2060 my @log = command(qw/cat-file commit/, $c->{c});
2061 # shift off the headers
2063 shift @log while ($log[0] ne '');
2064 shift @log;
2065 # TODO: make $c->{l} not have a trailing newline in the future
2067 @{$c->{l}} = map { "$_\n" } grep !/^git-svn-id: /, @log;
2068 (undef, $c->{r}, undef) = ::extract_metadata(
2070 (grep(/^git-svn-id: /, @log))[-1]);
2071 }
2072 return defined $c->{r};
2073}
2074sub log_use_color {
2076 return $color || Git->repository->get_colorbool('color.diff');
2077}
2078sub git_svn_log_cmd {
2080 my ($r_min, $r_max, @args) = @_;
2081 my $head = 'HEAD';
2082 my (@files, @log_opts);
2083 foreach my $x (@args) {
2084 if ($x eq '--' || @files) {
2085 push @files, $x;
2086 } else {
2087 if (::verify_ref("$x^0")) {
2088 $head = $x;
2089 } else {
2090 push @log_opts, $x;
2091 }
2092 }
2093 }
2094 my ($url, $rev, $uuid, $gs) = ::working_head_info($head);
2096 $gs ||= Git::SVN->_new;
2097 my @cmd = (qw/log --abbrev-commit --pretty=raw --default/,
2098 $gs->refname);
2099 push @cmd, '-r' unless $non_recursive;
2100 push @cmd, qw/--raw --name-status/ if $verbose;
2101 push @cmd, '--color' if log_use_color();
2102 push @cmd, @log_opts;
2103 if (defined $r_max && $r_max == $r_min) {
2104 push @cmd, '--max-count=1';
2105 if (my $c = $gs->rev_map_get($r_max)) {
2106 push @cmd, $c;
2107 }
2108 } elsif (defined $r_max) {
2109 if ($r_max < $r_min) {
2110 ($r_min, $r_max) = ($r_max, $r_min);
2111 }
2112 my (undef, $c_max) = $gs->find_rev_before($r_max, 1, $r_min);
2113 my (undef, $c_min) = $gs->find_rev_after($r_min, 1, $r_max);
2114 # If there are no commits in the range, both $c_max and $c_min
2115 # will be undefined. If there is at least 1 commit in the
2116 # range, both will be defined.
2117 return () if !defined $c_min || !defined $c_max;
2118 if ($c_min eq $c_max) {
2119 push @cmd, '--max-count=1', $c_min;
2120 } else {
2121 push @cmd, '--boundary', "$c_min..$c_max";
2122 }
2123 }
2124 return (@cmd, @files);
2125}
2126# adapted from pager.c
2128sub config_pager {
2129 if (! -t *STDOUT) {
2130 $ENV{GIT_PAGER_IN_USE} = 'false';
2131 $pager = undef;
2132 return;
2133 }
2134 chomp($pager = command_oneline(qw(var GIT_PAGER)));
2135 if ($pager eq 'cat') {
2136 $pager = undef;
2137 }
2138 $ENV{GIT_PAGER_IN_USE} = defined($pager);
2139}
2140sub run_pager {
2142 return unless defined $pager;
2143 pipe my ($rfd, $wfd) or return;
2144 defined(my $pid = fork) or fatal "Can't fork: $!";
2145 if (!$pid) {
2146 open STDOUT, '>&', $wfd or
2147 fatal "Can't redirect to stdout: $!";
2148 return;
2149 }
2150 open STDIN, '<&', $rfd or fatal "Can't redirect stdin: $!";
2151 $ENV{LESS} ||= 'FRSX';
2152 exec $pager or fatal "Can't run pager: $! ($pager)";
2153}
2154sub format_svn_date {
2156 my $t = shift || time;
2157 my $gmoff = Git::SVN::get_tz($t);
2158 return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t));
2159}
2160sub parse_git_date {
2162 my ($t, $tz) = @_;
2163 # Date::Parse isn't in the standard Perl distro :(
2164 if ($tz =~ s/^\+//) {
2165 $t += tz_to_s_offset($tz);
2166 } elsif ($tz =~ s/^\-//) {
2167 $t -= tz_to_s_offset($tz);
2168 }
2169 return $t;
2170}
2171sub set_local_timezone {
2173 if (defined $TZ) {
2174 $ENV{TZ} = $TZ;
2175 } else {
2176 delete $ENV{TZ};
2177 }
2178}
2179sub tz_to_s_offset {
2181 my ($tz) = @_;
2182 $tz =~ s/(\d\d)$//;
2183 return ($1 * 60) + ($tz * 3600);
2184}
2185sub get_author_info {
2187 my ($dest, $author, $t, $tz) = @_;
2188 $author =~ s/(?:^\s*|\s*$)//g;
2189 $dest->{a_raw} = $author;
2190 my $au;
2191 if ($::_authors) {
2192 $au = $rusers{$author} || undef;
2193 }
2194 if (!$au) {
2195 ($au) = ($author =~ /<([^>]+)\@[^>]+>$/);
2196 }
2197 $dest->{t} = $t;
2198 $dest->{tz} = $tz;
2199 $dest->{a} = $au;
2200 $dest->{t_utc} = parse_git_date($t, $tz);
2201}
2202sub process_commit {
2204 my ($c, $r_min, $r_max, $defer) = @_;
2205 if (defined $r_min && defined $r_max) {
2206 if ($r_min == $c->{r} && $r_min == $r_max) {
2207 show_commit($c);
2208 return 0;
2209 }
2210 return 1 if $r_min == $r_max;
2211 if ($r_min < $r_max) {
2212 # we need to reverse the print order
2213 return 0 if (defined $limit && --$limit < 0);
2214 push @$defer, $c;
2215 return 1;
2216 }
2217 if ($r_min != $r_max) {
2218 return 1 if ($r_min < $c->{r});
2219 return 1 if ($r_max > $c->{r});
2220 }
2221 }
2222 return 0 if (defined $limit && --$limit < 0);
2223 show_commit($c);
2224 return 1;
2225}
2226sub show_commit {
2228 my $c = shift;
2229 if ($oneline) {
2230 my $x = "\n";
2231 if (my $l = $c->{l}) {
2232 while ($l->[0] =~ /^\s*$/) { shift @$l }
2233 $x = $l->[0];
2234 }
2235 $l_fmt ||= 'A' . length($c->{r});
2236 print 'r',pack($l_fmt, $c->{r}),' | ';
2237 print "$c->{c} | " if $show_commit;
2238 print $x;
2239 } else {
2240 show_commit_normal($c);
2241 }
2242}
2243sub show_commit_changed_paths {
2245 my ($c) = @_;
2246 return unless $c->{changed};
2247 print "Changed paths:\n", @{$c->{changed}};
2248}
2249sub show_commit_normal {
2251 my ($c) = @_;
2252 print commit_log_separator, "r$c->{r} | ";
2253 print "$c->{c} | " if $show_commit;
2254 print "$c->{a} | ", format_svn_date($c->{t_utc}), ' | ';
2255 my $nr_line = 0;
2256 if (my $l = $c->{l}) {
2258 while ($l->[$#$l] eq "\n" && $#$l > 0
2259 && $l->[($#$l - 1)] eq "\n") {
2260 pop @$l;
2261 }
2262 $nr_line = scalar @$l;
2263 if (!$nr_line) {
2264 print "1 line\n\n\n";
2265 } else {
2266 if ($nr_line == 1) {
2267 $nr_line = '1 line';
2268 } else {
2269 $nr_line .= ' lines';
2270 }
2271 print $nr_line, "\n";
2272 show_commit_changed_paths($c);
2273 print "\n";
2274 print $_ foreach @$l;
2275 }
2276 } else {
2277 print "1 line\n";
2278 show_commit_changed_paths($c);
2279 print "\n";
2280 }
2282 foreach my $x (qw/raw stat diff/) {
2283 if ($c->{$x}) {
2284 print "\n";
2285 print $_ foreach @{$c->{$x}}
2286 }
2287 }
2288}
2289sub cmd_show_log {
2291 my (@args) = @_;
2292 my ($r_min, $r_max);
2293 my $r_last = -1; # prevent dupes
2294 set_local_timezone();
2295 if (defined $::_revision) {
2296 if ($::_revision =~ /^(\d+):(\d+)$/) {
2297 ($r_min, $r_max) = ($1, $2);
2298 } elsif ($::_revision =~ /^\d+$/) {
2299 $r_min = $r_max = $::_revision;
2300 } else {
2301 fatal "-r$::_revision is not supported, use ",
2302 "standard 'git log' arguments instead";
2303 }
2304 }
2305 config_pager();
2307 @args = git_svn_log_cmd($r_min, $r_max, @args);
2308 if (!@args) {
2309 print commit_log_separator unless $incremental || $oneline;
2310 return;
2311 }
2312 my $log = command_output_pipe(@args);
2313 run_pager();
2314 my (@k, $c, $d, $stat);
2315 my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/;
2316 while (<$log>) {
2317 if (/^${esc_color}commit (?:- )?($::sha1_short)/o) {
2318 my $cmt = $1;
2319 if ($c && cmt_showable($c) && $c->{r} != $r_last) {
2320 $r_last = $c->{r};
2321 process_commit($c, $r_min, $r_max, \@k) or
2322 goto out;
2323 }
2324 $d = undef;
2325 $c = { c => $cmt };
2326 } elsif (/^${esc_color}author (.+) (\d+) ([\-\+]?\d+)$/o) {
2327 get_author_info($c, $1, $2, $3);
2328 } elsif (/^${esc_color}(?:tree|parent|committer) /o) {
2329 # ignore
2330 } elsif (/^${esc_color}:\d{6} \d{6} $::sha1_short/o) {
2331 push @{$c->{raw}}, $_;
2332 } elsif (/^${esc_color}[ACRMDT]\t/) {
2333 # we could add $SVN->{svn_path} here, but that requires
2334 # remote access at the moment (repo_path_split)...
2335 s#^(${esc_color})([ACRMDT])\t#$1 $2 #o;
2336 push @{$c->{changed}}, $_;
2337 } elsif (/^${esc_color}diff /o) {
2338 $d = 1;
2339 push @{$c->{diff}}, $_;
2340 } elsif ($d) {
2341 push @{$c->{diff}}, $_;
2342 } elsif (/^\ .+\ \|\s*\d+\ $esc_color[\+\-]*
2343 $esc_color*[\+\-]*$esc_color$/x) {
2344 $stat = 1;
2345 push @{$c->{stat}}, $_;
2346 } elsif ($stat && /^ \d+ files changed, \d+ insertions/) {
2347 push @{$c->{stat}}, $_;
2348 $stat = undef;
2349 } elsif (/^${esc_color} (git-svn-id:.+)$/o) {
2350 ($c->{url}, $c->{r}, undef) = ::extract_metadata($1);
2351 } elsif (s/^${esc_color} //o) {
2352 push @{$c->{l}}, $_;
2353 }
2354 }
2355 if ($c && defined $c->{r} && $c->{r} != $r_last) {
2356 $r_last = $c->{r};
2357 process_commit($c, $r_min, $r_max, \@k);
2358 }
2359 if (@k) {
2360 ($r_min, $r_max) = ($r_max, $r_min);
2361 process_commit($_, $r_min, $r_max) foreach reverse @k;
2362 }
2363out:
2364 close $log;
2365 print commit_log_separator unless $incremental || $oneline;
2366}
2367sub cmd_blame {
2369 my $path = pop;
2370 config_pager();
2372 run_pager();
2373 my ($fh, $ctx, $rev);
2375 if ($_git_format) {
2377 ($fh, $ctx) = command_output_pipe('blame', @_, $path);
2378 while (my $line = <$fh>) {
2379 if ($line =~ /^\^?([[:xdigit:]]+)\s/) {
2380 # Uncommitted edits show up as a rev ID of
2381 # all zeros, which we can't look up with
2382 # cmt_metadata
2383 if ($1 !~ /^0+$/) {
2384 (undef, $rev, undef) =
2385 ::cmt_metadata($1);
2386 $rev = '0' if (!$rev);
2387 } else {
2388 $rev = '0';
2389 }
2390 $rev = sprintf('%-10s', $rev);
2391 $line =~ s/^\^?[[:xdigit:]]+(\s)/$rev$1/;
2392 }
2393 print $line;
2394 }
2395 } else {
2396 ($fh, $ctx) = command_output_pipe('blame', '-p', @_, 'HEAD',
2397 '--', $path);
2398 my ($sha1);
2399 my %authors;
2400 my @buffer;
2401 my %dsha; #distinct sha keys
2402 while (my $line = <$fh>) {
2404 push @buffer, $line;
2405 if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) {
2406 $dsha{$1} = 1;
2407 }
2408 }
2409 my $s2r = ::cmt_sha2rev_batch([keys %dsha]);
2411 foreach my $line (@buffer) {
2413 if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) {
2414 $rev = $s2r->{$1};
2415 $rev = '0' if (!$rev)
2416 }
2417 elsif ($line =~ /^author (.*)/) {
2418 $authors{$rev} = $1;
2419 $authors{$rev} =~ s/\s/_/g;
2420 }
2421 elsif ($line =~ /^\t(.*)$/) {
2422 printf("%6s %10s %s\n", $rev, $authors{$rev}, $1);
2423 }
2424 }
2425 }
2426 command_close_pipe($fh, $ctx);
2427}
2428package Git::SVN::Migration;
2430# these version numbers do NOT correspond to actual version numbers
2431# of git nor git-svn. They are just relative.
2432#
2433# v0 layout: .git/$id/info/url, refs/heads/$id-HEAD
2434#
2435# v1 layout: .git/$id/info/url, refs/remotes/$id
2436#
2437# v2 layout: .git/svn/$id/info/url, refs/remotes/$id
2438#
2439# v3 layout: .git/svn/$id, refs/remotes/$id
2440# - info/url may remain for backwards compatibility
2441# - this is what we migrate up to this layout automatically,
2442# - this will be used by git svn init on single branches
2443# v3.1 layout (auto migrated):
2444# - .rev_db => .rev_db.$UUID, .rev_db will remain as a symlink
2445# for backwards compatibility
2446#
2447# v4 layout: .git/svn/$repo_id/$id, refs/remotes/$repo_id/$id
2448# - this is only created for newly multi-init-ed
2449# repositories. Similar in spirit to the
2450# --use-separate-remotes option in git-clone (now default)
2451# - we do not automatically migrate to this (following
2452# the example set by core git)
2453#
2454# v5 layout: .rev_db.$UUID => .rev_map.$UUID
2455# - newer, more-efficient format that uses 24-bytes per record
2456# with no filler space.
2457# - use xxd -c24 < .rev_map.$UUID to view and debug
2458# - This is a one-way migration, repositories updated to the
2459# new format will not be able to use old git-svn without
2460# rebuilding the .rev_db. Rebuilding the rev_db is not
2461# possible if noMetadata or useSvmProps are set; but should
2462# be no problem for users that use the (sensible) defaults.
2463use strict;
2464use warnings;
2465use Carp qw/croak/;
2466use File::Path qw/mkpath/;
2467use File::Basename qw/dirname basename/;
2468use vars qw/$_minimize/;
2469sub migrate_from_v0 {
2471 my $git_dir = $ENV{GIT_DIR};
2472 return undef unless -d $git_dir;
2473 my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/);
2474 my $migrated = 0;
2475 while (<$fh>) {
2476 chomp;
2477 my ($id, $orig_ref) = ($_, $_);
2478 next unless $id =~ s#^refs/heads/(.+)-HEAD$#$1#;
2479 next unless -f "$git_dir/$id/info/url";
2480 my $new_ref = "refs/remotes/$id";
2481 if (::verify_ref("$new_ref^0")) {
2482 print STDERR "W: $orig_ref is probably an old ",
2483 "branch used by an ancient version of ",
2484 "git-svn.\n",
2485 "However, $new_ref also exists.\n",
2486 "We will not be able ",
2487 "to use this branch until this ",
2488 "ambiguity is resolved.\n";
2489 next;
2490 }
2491 print STDERR "Migrating from v0 layout...\n" if !$migrated;
2492 print STDERR "Renaming ref: $orig_ref => $new_ref\n";
2493 command_noisy('update-ref', $new_ref, $orig_ref);
2494 command_noisy('update-ref', '-d', $orig_ref, $orig_ref);
2495 $migrated++;
2496 }
2497 command_close_pipe($fh, $ctx);
2498 print STDERR "Done migrating from v0 layout...\n" if $migrated;
2499 $migrated;
2500}
2501sub migrate_from_v1 {
2503 my $git_dir = $ENV{GIT_DIR};
2504 my $migrated = 0;
2505 return $migrated unless -d $git_dir;
2506 my $svn_dir = "$git_dir/svn";
2507 # just in case somebody used 'svn' as their $id at some point...
2509 return $migrated if -d $svn_dir && ! -f "$svn_dir/info/url";
2510 print STDERR "Migrating from a git-svn v1 layout...\n";
2512 mkpath([$svn_dir]);
2513 print STDERR "Data from a previous version of git-svn exists, but\n\t",
2514 "$svn_dir\n\t(required for this version ",
2515 "($::VERSION) of git-svn) does not exist.\n";
2516 my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/);
2517 while (<$fh>) {
2518 my $x = $_;
2519 next unless $x =~ s#^refs/remotes/##;
2520 chomp $x;
2521 next unless -f "$git_dir/$x/info/url";
2522 my $u = eval { ::file_to_s("$git_dir/$x/info/url") };
2523 next unless $u;
2524 my $dn = dirname("$git_dir/svn/$x");
2525 mkpath([$dn]) unless -d $dn;
2526 if ($x eq 'svn') { # they used 'svn' as GIT_SVN_ID:
2527 mkpath(["$git_dir/svn/svn"]);
2528 print STDERR " - $git_dir/$x/info => ",
2529 "$git_dir/svn/$x/info\n";
2530 rename "$git_dir/$x/info", "$git_dir/svn/$x/info" or
2531 croak "$!: $x";
2532 # don't worry too much about these, they probably
2533 # don't exist with repos this old (save for index,
2534 # and we can easily regenerate that)
2535 foreach my $f (qw/unhandled.log index .rev_db/) {
2536 rename "$git_dir/$x/$f", "$git_dir/svn/$x/$f";
2537 }
2538 } else {
2539 print STDERR " - $git_dir/$x => $git_dir/svn/$x\n";
2540 rename "$git_dir/$x", "$git_dir/svn/$x" or
2541 croak "$!: $x";
2542 }
2543 $migrated++;
2544 }
2545 command_close_pipe($fh, $ctx);
2546 print STDERR "Done migrating from a git-svn v1 layout\n";
2547 $migrated;
2548}
2549sub read_old_urls {
2551 my ($l_map, $pfx, $path) = @_;
2552 my @dir;
2553 foreach (<$path/*>) {
2554 if (-r "$_/info/url") {
2555 $pfx .= '/' if $pfx && $pfx !~ m!/$!;
2556 my $ref_id = $pfx . basename $_;
2557 my $url = ::file_to_s("$_/info/url");
2558 $l_map->{$ref_id} = $url;
2559 } elsif (-d $_) {
2560 push @dir, $_;
2561 }
2562 }
2563 foreach (@dir) {
2564 my $x = $_;
2565 $x =~ s!^\Q$ENV{GIT_DIR}\E/svn/!!o;
2566 read_old_urls($l_map, $x, $_);
2567 }
2568}
2569sub migrate_from_v2 {
2571 my @cfg = command(qw/config -l/);
2572 return if grep /^svn-remote\..+\.url=/, @cfg;
2573 my %l_map;
2574 read_old_urls(\%l_map, '', "$ENV{GIT_DIR}/svn");
2575 my $migrated = 0;
2576 foreach my $ref_id (sort keys %l_map) {
2578 eval { Git::SVN->init($l_map{$ref_id}, '', undef, $ref_id) };
2579 if ($@) {
2580 Git::SVN->init($l_map{$ref_id}, '', $ref_id, $ref_id);
2581 }
2582 $migrated++;
2583 }
2584 $migrated;
2585}
2586sub minimize_connections {
2588 my $r = Git::SVN::read_all_remotes();
2589 my $new_urls = {};
2590 my $root_repos = {};
2591 foreach my $repo_id (keys %$r) {
2592 my $url = $r->{$repo_id}->{url} or next;
2593 my $fetch = $r->{$repo_id}->{fetch} or next;
2594 my $ra = Git::SVN::Ra->new($url);
2595 # skip existing cases where we already connect to the root
2597 if (($ra->{url} eq $ra->{repos_root}) ||
2598 ($ra->{repos_root} eq $repo_id)) {
2599 $root_repos->{$ra->{url}} = $repo_id;
2600 next;
2601 }
2602 my $root_ra = Git::SVN::Ra->new($ra->{repos_root});
2604 my $root_path = $ra->{url};
2605 $root_path =~ s#^\Q$ra->{repos_root}\E(/|$)##;
2606 foreach my $path (keys %$fetch) {
2607 my $ref_id = $fetch->{$path};
2608 my $gs = Git::SVN->new($ref_id, $repo_id, $path);
2609 # make sure we can read when connecting to
2611 # a higher level of a repository
2612 my ($last_rev, undef) = $gs->last_rev_commit;
2613 if (!defined $last_rev) {
2614 $last_rev = eval {
2615 $root_ra->get_latest_revnum;
2616 };
2617 next if $@;
2618 }
2619 my $new = $root_path;
2620 $new .= length $path ? "/$path" : '';
2621 eval {
2622 $root_ra->get_log([$new], $last_rev, $last_rev,
2623 0, 0, 1, sub { });
2624 };
2625 next if $@;
2626 $new_urls->{$ra->{repos_root}}->{$new} =
2627 { ref_id => $ref_id,
2628 old_repo_id => $repo_id,
2629 old_path => $path };
2630 }
2631 }
2632 my @emptied;
2634 foreach my $url (keys %$new_urls) {
2635 # see if we can re-use an existing [svn-remote "repo_id"]
2636 # instead of creating a(n ugly) new section:
2637 my $repo_id = $root_repos->{$url} || $url;
2638 my $fetch = $new_urls->{$url};
2640 foreach my $path (keys %$fetch) {
2641 my $x = $fetch->{$path};
2642 Git::SVN->init($url, $path, $repo_id, $x->{ref_id});
2643 my $pfx = "svn-remote.$x->{old_repo_id}";
2644 my $old_fetch = quotemeta("$x->{old_path}:".
2646 "$x->{ref_id}");
2647 command_noisy(qw/config --unset/,
2648 "$pfx.fetch", '^'. $old_fetch . '$');
2649 delete $r->{$x->{old_repo_id}}->
2650 {fetch}->{$x->{old_path}};
2651 if (!keys %{$r->{$x->{old_repo_id}}->{fetch}}) {
2652 command_noisy(qw/config --unset/,
2653 "$pfx.url");
2654 push @emptied, $x->{old_repo_id}
2655 }
2656 }
2657 }
2658 if (@emptied) {
2659 my $file = $ENV{GIT_CONFIG} || "$ENV{GIT_DIR}/config";
2660 print STDERR <<EOF;
2661The following [svn-remote] sections in your config file ($file) are empty
2662and can be safely removed:
2663EOF
2664 print STDERR "[svn-remote \"$_\"]\n" foreach @emptied;
2665 }
2666}
2667sub migration_check {
2669 migrate_from_v0();
2670 migrate_from_v1();
2671 migrate_from_v2();
2672 minimize_connections() if $_minimize;
2673}
2674package Git::IndexInfo;
2676use strict;
2677use warnings;
2678use Git qw/command_input_pipe command_close_pipe/;
2679sub new {
2681 my ($class) = @_;
2682 my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/);
2683 bless { gui => $gui, ctx => $ctx, nr => 0}, $class;
2684}
2685sub remove {
2687 my ($self, $path) = @_;
2688 if (print { $self->{gui} } '0 ', 0 x 40, "\t", $path, "\0") {
2689 return ++$self->{nr};
2690 }
2691 undef;
2692}
2693sub update {
2695 my ($self, $mode, $hash, $path) = @_;
2696 if (print { $self->{gui} } $mode, ' ', $hash, "\t", $path, "\0") {
2697 return ++$self->{nr};
2698 }
2699 undef;
2700}
2701sub DESTROY {
2703 my ($self) = @_;
2704 command_close_pipe($self->{gui}, $self->{ctx});
2705}
2706package Git::SVN::GlobSpec;
2708use strict;
2709use warnings;
2710sub new {
2712 my ($class, $glob, $pattern_ok) = @_;
2713 my $re = $glob;
2714 $re =~ s!/+$!!g; # no need for trailing slashes
2715 my (@left, @right, @patterns);
2716 my $state = "left";
2717 my $die_msg = "Only one set of wildcard directories " .
2718 "(e.g. '*' or '*/*/*') is supported: '$glob'\n";
2719 for my $part (split(m|/|, $glob)) {
2720 if ($part =~ /\*/ && $part ne "*") {
2721 die "Invalid pattern in '$glob': $part\n";
2722 } elsif ($pattern_ok && $part =~ /[{}]/ &&
2723 $part !~ /^\{[^{}]+\}/) {
2724 die "Invalid pattern in '$glob': $part\n";
2725 }
2726 if ($part eq "*") {
2727 die $die_msg if $state eq "right";
2728 $state = "pattern";
2729 push(@patterns, "[^/]*");
2730 } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) {
2731 die $die_msg if $state eq "right";
2732 $state = "pattern";
2733 my $p = quotemeta($1);
2734 $p =~ s/\\,/|/g;
2735 push(@patterns, "(?:$p)");
2736 } else {
2737 if ($state eq "left") {
2738 push(@left, $part);
2739 } else {
2740 push(@right, $part);
2741 $state = "right";
2742 }
2743 }
2744 }
2745 my $depth = @patterns;
2746 if ($depth == 0) {
2747 die "One '*' is needed in glob: '$glob'\n";
2748 }
2749 my $left = join('/', @left);
2750 my $right = join('/', @right);
2751 $re = join('/', @patterns);
2752 $re = join('\/',
2753 grep(length, quotemeta($left), "($re)", quotemeta($right)));
2754 my $left_re = qr/^\/\Q$left\E(\/|$)/;
2755 bless { left => $left, right => $right, left_regex => $left_re,
2756 regex => qr/$re/, glob => $glob, depth => $depth }, $class;
2757}
2758sub full_path {
2760 my ($self, $path) = @_;
2761 return (length $self->{left} ? "$self->{left}/" : '') .
2762 $path . (length $self->{right} ? "/$self->{right}" : '');
2763}
2764__END__
2766Data structures:
2768$remotes = { # returned by read_all_remotes()
2771 'svn' => {
2772 # svn-remote.svn.url=https://svn.musicpd.org
2773 url => 'https://svn.musicpd.org',
2774 # svn-remote.svn.fetch=mpd/trunk:trunk
2775 fetch => {
2776 'mpd/trunk' => 'trunk',
2777 },
2778 # svn-remote.svn.tags=mpd/tags/*:tags/*
2779 tags => {
2780 path => {
2781 left => 'mpd/tags',
2782 right => '',
2783 regex => qr!mpd/tags/([^/]+)$!,
2784 glob => 'tags/*',
2785 },
2786 ref => {
2787 left => 'tags',
2788 right => '',
2789 regex => qr!tags/([^/]+)$!,
2790 glob => 'tags/*',
2791 },
2792 }
2793 }
2794};
2795$log_entry hashref as returned by libsvn_log_entry()
2797{
2798 log => 'whitespace-formatted log entry
2799', # trailing newline is preserved
2800 revision => '8', # integer
2801 date => '2004-02-24T17:01:44.108345Z', # commit date
2802 author => 'committer name'
2803};
2804# this is generated by generate_diff();
2807@mods = array of diff-index line hashes, each element represents one line
2808 of diff-index output
2809diff-index line ($m hash)
2811{
2812 mode_a => first column of diff-index output, no leading ':',
2813 mode_b => second column of diff-index output,
2814 sha1_b => sha1sum of the final blob,
2815 chg => change type [MCRADT],
2816 file_a => original file name of a file (iff chg is 'C' or 'R')
2817 file_b => new/current file name of a file (any chg)
2818}
2819;
2820# retval of read_url_paths{,_all}();
2822$l_map = {
2823 # repository root url
2824 'https://svn.musicpd.org' => {
2825 # repository path # GIT_SVN_ID
2826 'mpd/trunk' => 'trunk',
2827 'mpd/tags/0.11.5' => 'tags/0.11.5',
2828 },
2829}
2830Notes:
2832 I don't trust the each() function on unless I created %hash myself
2833 because the internal iterator may not have started at base.