git-svn.perl

   1 #!/usr/bin/env perl
   2 # Copyright (C) 2006, Eric Wong <normalperson@yhbt.net>
   3 # License: GPL v2 or later
   4 use warnings;
   5 use strict;
   6 use vars qw/    $AUTHOR $VERSION
   7                 $SVN_URL $SVN_INFO $SVN_WC $SVN_UUID
   8                 $GIT_SVN_INDEX $GIT_SVN
   9                 $GIT_DIR $GIT_SVN_DIR $REVDB/;
  10 $AUTHOR = 'Eric Wong <normalperson@yhbt.net>';
  11 $VERSION = '@@GIT_VERSION@@';
  12
  13 use Cwd qw/abs_path/;
  14 $GIT_DIR = abs_path($ENV{GIT_DIR} || '.git');
  15 $ENV{GIT_DIR} = $GIT_DIR;
  16
  17 my $LC_ALL = $ENV{LC_ALL};
  18 my $TZ = $ENV{TZ};
  19 # make sure the svn binary gives consistent output between locales and TZs:
  20 $ENV{TZ} = 'UTC';
  21 $ENV{LC_ALL} = 'C';
  22 $| = 1; # unbuffer STDOUT
  23
  24 # properties that we do not log:
  25 my %SKIP = ( 'svn:wc:ra_dav:version-url' => 1,
  26              'svn:special' => 1,
  27              'svn:executable' => 1,
  28              'svn:entry:committed-rev' => 1,
  29              'svn:entry:last-author' => 1,
  30              'svn:entry:uuid' => 1,
  31              'svn:entry:committed-date' => 1,
  32 );
  33
  34 sub fatal (@) { print STDERR $@; exit 1 }
  35 # If SVN:: library support is added, please make the dependencies
  36 # optional and preserve the capability to use the command-line client.
  37 # use eval { require SVN::... } to make it lazy load
  38 # We don't use any modules not in the standard Perl distribution:
  39 use Carp qw/croak/;
  40 use IO::File qw//;
  41 use File::Basename qw/dirname basename/;
  42 use File::Path qw/mkpath/;
  43 use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev pass_through/;
  44 use File::Spec qw//;
  45 use File::Copy qw/copy/;
  46 use POSIX qw/strftime/;
  47 use IPC::Open3;
  48 use Memoize;
  49 memoize('revisions_eq');
  50 memoize('cmt_metadata');
  51 memoize('get_commit_time');
  52
  53 my ($SVN, $_use_lib);
  54
  55 sub nag_lib {
  56         print STDERR <<EOF;
  57 ! Please consider installing the SVN Perl libraries (version 1.1.0 or
  58 ! newer).  You will generally get better performance and fewer bugs,
  59 ! especially if you:
  60 ! 1) have a case-insensitive filesystem
  61 ! 2) replace symlinks with files (and vice-versa) in commits
  62
  63 EOF
  64 }
  65
  66 $_use_lib = 1 unless $ENV{GIT_SVN_NO_LIB};
  67 libsvn_load();
  68 nag_lib() unless $_use_lib;
  69
  70 my $_optimize_commits = 1 unless $ENV{GIT_SVN_NO_OPTIMIZE_COMMITS};
  71 my $sha1 = qr/[a-f\d]{40}/;
  72 my $sha1_short = qr/[a-f\d]{4,40}/;
  73 my $_esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/;
  74 my ($_revision,$_stdin,$_no_ignore_ext,$_no_stop_copy,$_help,$_rmdir,$_edit,
  75         $_find_copies_harder, $_l, $_cp_similarity, $_cp_remote,
  76         $_repack, $_repack_nr, $_repack_flags, $_q,
  77         $_message, $_file, $_follow_parent, $_no_metadata,
  78         $_template, $_shared, $_no_default_regex, $_no_graft_copy,
  79         $_limit, $_verbose, $_incremental, $_oneline, $_l_fmt, $_show_commit,
  80         $_version, $_upgrade, $_authors, $_branch_all_refs, @_opt_m,
  81         $_merge, $_strategy, $_dry_run, $_ignore_nodate, $_non_recursive,
  82         $_username, $_config_dir, $_no_auth_cache, $_xfer_delta,
  83         $_pager, $_color);
  84 my (@_branch_from, %tree_map, %users, %rusers, %equiv);
  85 my ($_svn_co_url_revs, $_svn_pg_peg_revs, $_svn_can_do_switch);
  86 my @repo_path_split_cache;
  87
  88 my %fc_opts = ( 'no-ignore-externals' => \$_no_ignore_ext,
  89                 'branch|b=s' => \@_branch_from,
  90                 'follow-parent|follow' => \$_follow_parent,
  91                 'branch-all-refs|B' => \$_branch_all_refs,
  92                 'authors-file|A=s' => \$_authors,
  93                 'repack:i' => \$_repack,
  94                 'no-metadata' => \$_no_metadata,
  95                 'quiet|q' => \$_q,
  96                 'username=s' => \$_username,
  97                 'config-dir=s' => \$_config_dir,
  98                 'no-auth-cache' => \$_no_auth_cache,
  99                 'ignore-nodate' => \$_ignore_nodate,
 100                 'repack-flags|repack-args|repack-opts=s' => \$_repack_flags);
 101
 102 my ($_trunk, $_tags, $_branches);
 103 my %multi_opts = ( 'trunk|T=s' => \$_trunk,
 104                 'tags|t=s' => \$_tags,
 105                 'branches|b=s' => \$_branches );
 106 my %init_opts = ( 'template=s' => \$_template, 'shared' => \$_shared );
 107 my %cmt_opts = ( 'edit|e' => \$_edit,
 108                 'rmdir' => \$_rmdir,
 109                 'find-copies-harder' => \$_find_copies_harder,
 110                 'l=i' => \$_l,
 111                 'copy-similarity|C=i'=> \$_cp_similarity
 112 );
 113
 114 my %cmd = (
 115         fetch => [ \&fetch, "Download new revisions from SVN",
 116                         { 'revision|r=s' => \$_revision, %fc_opts } ],
 117         init => [ \&init, "Initialize a repo for tracking" .
 118                           " (requires URL argument)",
 119                           \%init_opts ],
 120         commit => [ \&commit, "Commit git revisions to SVN",
 121                         {       'stdin|' => \$_stdin, %cmt_opts, %fc_opts, } ],
 122         'show-ignore' => [ \&show_ignore, "Show svn:ignore listings",
 123                         { 'revision|r=i' => \$_revision } ],
 124         rebuild => [ \&rebuild, "Rebuild git-svn metadata (after git clone)",
 125                         { 'no-ignore-externals' => \$_no_ignore_ext,
 126                           'copy-remote|remote=s' => \$_cp_remote,
 127                           'upgrade' => \$_upgrade } ],
 128         'graft-branches' => [ \&graft_branches,
 129                         'Detect merges/branches from already imported history',
 130                         { 'merge-rx|m' => \@_opt_m,
 131                           'branch|b=s' => \@_branch_from,
 132                           'branch-all-refs|B' => \$_branch_all_refs,
 133                           'no-default-regex' => \$_no_default_regex,
 134                           'no-graft-copy' => \$_no_graft_copy } ],
 135         'multi-init' => [ \&multi_init,
 136                         'Initialize multiple trees (like git-svnimport)',
 137                         { %multi_opts, %init_opts,
 138                          'revision|r=i' => \$_revision,
 139                          'username=s' => \$_username,
 140                          'config-dir=s' => \$_config_dir,
 141                          'no-auth-cache' => \$_no_auth_cache,
 142                         } ],
 143         'multi-fetch' => [ \&multi_fetch,
 144                         'Fetch multiple trees (like git-svnimport)',
 145                         \%fc_opts ],
 146         'log' => [ \&show_log, 'Show commit logs',
 147                         { 'limit=i' => \$_limit,
 148                           'revision|r=s' => \$_revision,
 149                           'verbose|v' => \$_verbose,
 150                           'incremental' => \$_incremental,
 151                           'oneline' => \$_oneline,
 152                           'show-commit' => \$_show_commit,
 153                           'non-recursive' => \$_non_recursive,
 154                           'authors-file|A=s' => \$_authors,
 155                           'color' => \$_color,
 156                           'pager=s' => \$_pager,
 157                         } ],
 158         'commit-diff' => [ \&commit_diff, 'Commit a diff between two trees',
 159                         { 'message|m=s' => \$_message,
 160                           'file|F=s' => \$_file,
 161                           'revision|r=s' => \$_revision,
 162                         %cmt_opts } ],
 163         dcommit => [ \&dcommit, 'Commit several diffs to merge with upstream',
 164                         { 'merge|m|M' => \$_merge,
 165                           'strategy|s=s' => \$_strategy,
 166                           'dry-run|n' => \$_dry_run,
 167                         %cmt_opts } ],
 168 );
 169
 170 my $cmd;
 171 for (my $i = 0; $i < @ARGV; $i++) {
 172         if (defined $cmd{$ARGV[$i]}) {
 173                 $cmd = $ARGV[$i];
 174                 splice @ARGV, $i, 1;
 175                 last;
 176         }
 177 };
 178
 179 my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
 180
 181 read_repo_config(\%opts);
 182 my $rv = GetOptions(%opts, 'help|H|h' => \$_help,
 183                                 'version|V' => \$_version,
 184                                 'id|i=s' => \$GIT_SVN);
 185 exit 1 if (!$rv && $cmd ne 'log');
 186
 187 set_default_vals();
 188 usage(0) if $_help;
 189 version() if $_version;
 190 usage(1) unless defined $cmd;
 191 init_vars();
 192 load_authors() if $_authors;
 193 load_all_refs() if $_branch_all_refs;
 194 svn_compat_check() unless $_use_lib;
 195 migration_check() unless $cmd =~ /^(?:init|rebuild|multi-init|commit-diff)$/;
 196 $cmd{$cmd}->[0]->(@ARGV);
 197 exit 0;
 198
 199 ####################### primary functions ######################
 200 sub usage {
 201         my $exit = shift || 0;
 202         my $fd = $exit ? \*STDERR : \*STDOUT;
 203         print $fd <<"";
 204 git-svn - bidirectional operations between a single Subversion tree and git
 205 Usage: $0 <command> [options] [arguments]\n
 206
 207         print $fd "Available commands:\n" unless $cmd;
 208
 209         foreach (sort keys %cmd) {
 210                 next if $cmd && $cmd ne $_;
 211                 print $fd '  ',pack('A17',$_),$cmd{$_}->[1],"\n";
 212                 foreach (keys %{$cmd{$_}->[2]}) {
 213                         # prints out arguments as they should be passed:
 214                         my $x = s#[:=]s$## ? '<arg>' : s#[:=]i$## ? '<num>' : '';
 215                         print $fd ' ' x 21, join(', ', map { length $_ > 1 ?
 216                                                         "--$_" : "-$_" }
 217                                                 split /\|/,$_)," $x\n";
 218                 }
 219         }
 220         print $fd <<"";
 221 \nGIT_SVN_ID may be set in the environment or via the --id/-i switch to an
 222 arbitrary identifier if you're tracking multiple SVN branches/repositories in
 223 one git repository and want to keep them separate.  See git-svn(1) for more
 224 information.
 225
 226         exit $exit;
 227 }
 228
 229 sub version {
 230         print "git-svn version $VERSION\n";
 231         exit 0;
 232 }
 233
 234 sub rebuild {
 235         if (quiet_run(qw/git-rev-parse --verify/,"refs/remotes/$GIT_SVN^0")) {
 236                 copy_remote_ref();
 237         }
 238         $SVN_URL = shift or undef;
 239         my $newest_rev = 0;
 240         if ($_upgrade) {
 241                 sys('git-update-ref',"refs/remotes/$GIT_SVN","$GIT_SVN-HEAD");
 242         } else {
 243                 check_upgrade_needed();
 244         }
 245
 246         my $pid = open(my $rev_list,'-|');
 247         defined $pid or croak $!;
 248         if ($pid == 0) {
 249                 exec("git-rev-list","refs/remotes/$GIT_SVN") or croak $!;
 250         }
 251         my $latest;
 252         while (<$rev_list>) {
 253                 chomp;
 254                 my $c = $_;
 255                 croak "Non-SHA1: $c\n" unless $c =~ /^$sha1$/o;
 256                 my @commit = grep(/^git-svn-id: /,`git-cat-file commit $c`);
 257                 next if (!@commit); # skip merges
 258                 my ($url, $rev, $uuid) = extract_metadata($commit[$#commit]);
 259                 if (!defined $rev || !$uuid) {
 260                         croak "Unable to extract revision or UUID from ",
 261                                 "$c, $commit[$#commit]\n";
 262                 }
 263
 264                 # if we merged or otherwise started elsewhere, this is
 265                 # how we break out of it
 266                 next if (defined $SVN_UUID && ($uuid ne $SVN_UUID));
 267                 next if (defined $SVN_URL && defined $url && ($url ne $SVN_URL));
 268
 269                 unless (defined $latest) {
 270                         if (!$SVN_URL && !$url) {
 271                                 croak "SVN repository location required: $url\n";
 272                         }
 273                         $SVN_URL ||= $url;
 274                         $SVN_UUID ||= $uuid;
 275                         setup_git_svn();
 276                         $latest = $rev;
 277                 }
 278                 revdb_set($REVDB, $rev, $c);
 279                 print "r$rev = $c\n";
 280                 $newest_rev = $rev if ($rev > $newest_rev);
 281         }
 282         close $rev_list or croak $?;
 283
 284         goto out if $_use_lib;
 285         if (!chdir $SVN_WC) {
 286                 svn_cmd_checkout($SVN_URL, $latest, $SVN_WC);
 287                 chdir $SVN_WC or croak $!;
 288         }
 289
 290         $pid = fork;
 291         defined $pid or croak $!;
 292         if ($pid == 0) {
 293                 my @svn_up = qw(svn up);
 294                 push @svn_up, '--ignore-externals' unless $_no_ignore_ext;
 295                 sys(@svn_up,"-r$newest_rev");
 296                 $ENV{GIT_INDEX_FILE} = $GIT_SVN_INDEX;
 297                 index_changes();
 298                 exec('git-write-tree') or croak $!;
 299         }
 300         waitpid $pid, 0;
 301         croak $? if $?;
 302 out:
 303         if ($_upgrade) {
 304                 print STDERR <<"";
 305 Keeping deprecated refs/head/$GIT_SVN-HEAD for now.  Please remove it
 306 when you have upgraded your tools and habits to use refs/remotes/$GIT_SVN
 307
 308         }
 309 }
 310
 311 sub init {
 312         my $url = shift or die "SVN repository location required " .
 313                                 "as a command-line argument\n";
 314         $url =~ s!/+$!!; # strip trailing slash
 315
 316         if (my $repo_path = shift) {
 317                 unless (-d $repo_path) {
 318                         mkpath([$repo_path]);
 319                 }
 320                 $GIT_DIR = $ENV{GIT_DIR} = $repo_path . "/.git";
 321                 init_vars();
 322         }
 323
 324         $SVN_URL = $url;
 325         unless (-d $GIT_DIR) {
 326                 my @init_db = ('git-init-db');
 327                 push @init_db, "--template=$_template" if defined $_template;
 328                 push @init_db, "--shared" if defined $_shared;
 329                 sys(@init_db);
 330         }
 331         setup_git_svn();
 332 }
 333
 334 sub fetch {
 335         check_upgrade_needed();
 336         $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
 337         my $ret = $_use_lib ? fetch_lib(@_) : fetch_cmd(@_);
 338         if ($ret->{commit} && quiet_run(qw(git-rev-parse --verify
 339                                                 refs/heads/master^0))) {
 340                 sys(qw(git-update-ref refs/heads/master),$ret->{commit});
 341         }
 342         return $ret;
 343 }
 344
 345 sub fetch_cmd {
 346         my (@parents) = @_;
 347         my @log_args = -d $SVN_WC ? ($SVN_WC) : ($SVN_URL);
 348         unless ($_revision) {
 349                 $_revision = -d $SVN_WC ? 'BASE:HEAD' : '0:HEAD';
 350         }
 351         push @log_args, "-r$_revision";
 352         push @log_args, '--stop-on-copy' unless $_no_stop_copy;
 353
 354         my $svn_log = svn_log_raw(@log_args);
 355
 356         my $base = next_log_entry($svn_log) or croak "No base revision!\n";
 357         # don't need last_revision from grab_base_rev() because
 358         # user could've specified a different revision to skip (they
 359         # didn't want to import certain revisions into git for whatever
 360         # reason, so trust $base->{revision} instead.
 361         my (undef, $last_commit) = svn_grab_base_rev();
 362         unless (-d $SVN_WC) {
 363                 svn_cmd_checkout($SVN_URL,$base->{revision},$SVN_WC);
 364                 chdir $SVN_WC or croak $!;
 365                 read_uuid();
 366                 $last_commit = git_commit($base, @parents);
 367                 assert_tree($last_commit);
 368         } else {
 369                 chdir $SVN_WC or croak $!;
 370                 read_uuid();
 371                 # looks like a user manually cp'd and svn switch'ed
 372                 unless ($last_commit) {
 373                         sys(qw/svn revert -R ./);
 374                         assert_svn_wc_clean($base->{revision});
 375                         $last_commit = git_commit($base, @parents);
 376                         assert_tree($last_commit);
 377                 }
 378         }
 379         my @svn_up = qw(svn up);
 380         push @svn_up, '--ignore-externals' unless $_no_ignore_ext;
 381         my $last = $base;
 382         while (my $log_msg = next_log_entry($svn_log)) {
 383                 if ($last->{revision} >= $log_msg->{revision}) {
 384                         croak "Out of order: last >= current: ",
 385                                 "$last->{revision} >= $log_msg->{revision}\n";
 386                 }
 387                 # Revert is needed for cases like:
 388                 # https://svn.musicpd.org/Jamming/trunk (r166:167), but
 389                 # I can't seem to reproduce something like that on a test...
 390                 sys(qw/svn revert -R ./);
 391                 assert_svn_wc_clean($last->{revision});
 392                 sys(@svn_up,"-r$log_msg->{revision}");
 393                 $last_commit = git_commit($log_msg, $last_commit, @parents);
 394                 $last = $log_msg;
 395         }
 396         close $svn_log->{fh};
 397         $last->{commit} = $last_commit;
 398         return $last;
 399 }
 400
 401 sub fetch_lib {
 402         my (@parents) = @_;
 403         $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
 404         $SVN ||= libsvn_connect($SVN_URL);
 405         my ($last_rev, $last_commit) = svn_grab_base_rev();
 406         my ($base, $head) = libsvn_parse_revision($last_rev);
 407         if ($base > $head) {
 408                 return { revision => $last_rev, commit => $last_commit }
 409         }
 410         my $index = set_index($GIT_SVN_INDEX);
 411
 412         # limit ourselves and also fork() since get_log won't release memory
 413         # after processing a revision and SVN stuff seems to leak
 414         my $inc = 1000;
 415         my ($min, $max) = ($base, $head < $base+$inc ? $head : $base+$inc);
 416         read_uuid();
 417         if (defined $last_commit) {
 418                 unless (-e $GIT_SVN_INDEX) {
 419                         sys(qw/git-read-tree/, $last_commit);
 420                 }
 421                 chomp (my $x = `git-write-tree`);
 422                 my ($y) = (`git-cat-file commit $last_commit`
 423                                                         =~ /^tree ($sha1)/m);
 424                 if ($y ne $x) {
 425                         unlink $GIT_SVN_INDEX or croak $!;
 426                         sys(qw/git-read-tree/, $last_commit);
 427                 }
 428                 chomp ($x = `git-write-tree`);
 429                 if ($y ne $x) {
 430                         print STDERR "trees ($last_commit) $y != $x\n",
 431                                  "Something is seriously wrong...\n";
 432                 }
 433         }
 434         while (1) {
 435                 # fork, because using SVN::Pool with get_log() still doesn't
 436                 # seem to help enough to keep memory usage down.
 437                 defined(my $pid = fork) or croak $!;
 438                 if (!$pid) {
 439                         $SVN::Error::handler = \&libsvn_skip_unknown_revs;
 440
 441                         # Yes I'm perfectly aware that the fourth argument
 442                         # below is the limit revisions number.  Unfortunately
 443                         # performance sucks with it enabled, so it's much
 444                         # faster to fetch revision ranges instead of relying
 445                         # on the limiter.
 446                         libsvn_get_log(libsvn_dup_ra($SVN), [''],
 447                                         $min, $max, 0, 1, 1,
 448                                 sub {
 449                                         my $log_msg;
 450                                         if ($last_commit) {
 451                                                 $log_msg = libsvn_fetch(
 452                                                         $last_commit, @_);
 453                                                 $last_commit = git_commit(
 454                                                         $log_msg,
 455                                                         $last_commit,
 456                                                         @parents);
 457                                         } else {
 458                                                 $log_msg = libsvn_new_tree(@_);
 459                                                 $last_commit = git_commit(
 460                                                         $log_msg, @parents);
 461                                         }
 462                                 });
 463                         exit 0;
 464                 }
 465                 waitpid $pid, 0;
 466                 croak $? if $?;
 467                 ($last_rev, $last_commit) = svn_grab_base_rev();
 468                 last if ($max >= $head);
 469                 $min = $max + 1;
 470                 $max += $inc;
 471                 $max = $head if ($max > $head);
 472                 $SVN = libsvn_connect($SVN_URL);
 473         }
 474         restore_index($index);
 475         return { revision => $last_rev, commit => $last_commit };
 476 }
 477
 478 sub commit {
 479         my (@commits) = @_;
 480         check_upgrade_needed();
 481         if ($_stdin || !@commits) {
 482                 print "Reading from stdin...\n";
 483                 @commits = ();
 484                 while (<STDIN>) {
 485                         if (/\b($sha1_short)\b/o) {
 486                                 unshift @commits, $1;
 487                         }
 488                 }
 489         }
 490         my @revs;
 491         foreach my $c (@commits) {
 492                 chomp(my @tmp = safe_qx('git-rev-parse',$c));
 493                 if (scalar @tmp == 1) {
 494                         push @revs, $tmp[0];
 495                 } elsif (scalar @tmp > 1) {
 496                         push @revs, reverse (safe_qx('git-rev-list',@tmp));
 497                 } else {
 498                         die "Failed to rev-parse $c\n";
 499                 }
 500         }
 501         chomp @revs;
 502         $_use_lib ? commit_lib(@revs) : commit_cmd(@revs);
 503         print "Done committing ",scalar @revs," revisions to SVN\n";
 504 }
 505
 506 sub commit_cmd {
 507         my (@revs) = @_;
 508
 509         chdir $SVN_WC or croak "Unable to chdir $SVN_WC: $!\n";
 510         my $info = svn_info('.');
 511         my $fetched = fetch();
 512         if ($info->{Revision} != $fetched->{revision}) {
 513                 print STDERR "There are new revisions that were fetched ",
 514                                 "and need to be merged (or acknowledged) ",
 515                                 "before committing.\n";
 516                 exit 1;
 517         }
 518         $info = svn_info('.');
 519         read_uuid($info);
 520         my $last = $fetched;
 521         foreach my $c (@revs) {
 522                 my $mods = svn_checkout_tree($last, $c);
 523                 if (scalar @$mods == 0) {
 524                         print "Skipping, no changes detected\n";
 525                         next;
 526                 }
 527                 $last = svn_commit_tree($last, $c);
 528         }
 529 }
 530
 531 sub commit_lib {
 532         my (@revs) = @_;
 533         my ($r_last, $cmt_last) = svn_grab_base_rev();
 534         defined $r_last or die "Must have an existing revision to commit\n";
 535         my $fetched = fetch();
 536         if ($r_last != $fetched->{revision}) {
 537                 print STDERR "There are new revisions that were fetched ",
 538                                 "and need to be merged (or acknowledged) ",
 539                                 "before committing.\n",
 540                                 "last rev: $r_last\n",
 541                                 " current: $fetched->{revision}\n";
 542                 exit 1;
 543         }
 544         read_uuid();
 545         my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef, 0) : ();
 546         my $commit_msg = "$GIT_SVN_DIR/.svn-commit.tmp.$$";
 547
 548         my $repo;
 549         set_svn_commit_env();
 550         foreach my $c (@revs) {
 551                 my $log_msg = get_commit_message($c, $commit_msg);
 552
 553                 # fork for each commit because there's a memory leak I
 554                 # can't track down... (it's probably in the SVN code)
 555                 defined(my $pid = open my $fh, '-|') or croak $!;
 556                 if (!$pid) {
 557                         my $ed = SVN::Git::Editor->new(
 558                                         {       r => $r_last,
 559                                                 ra => libsvn_dup_ra($SVN),
 560                                                 c => $c,
 561                                                 svn_path => $SVN->{svn_path},
 562                                         },
 563                                         $SVN->get_commit_editor(
 564                                                 $log_msg->{msg},
 565                                                 sub {
 566                                                         libsvn_commit_cb(
 567                                                                 @_, $c,
 568                                                                 $log_msg->{msg},
 569                                                                 $r_last,
 570                                                                 $cmt_last)
 571                                                 },
 572                                                 @lock)
 573                                         );
 574                         my $mods = libsvn_checkout_tree($cmt_last, $c, $ed);
 575                         if (@$mods == 0) {
 576                                 print "No changes\nr$r_last = $cmt_last\n";
 577                                 $ed->abort_edit;
 578                         } else {
 579                                 $ed->close_edit;
 580                         }
 581                         exit 0;
 582                 }
 583                 my ($r_new, $cmt_new, $no);
 584                 while (<$fh>) {
 585                         print $_;
 586                         chomp;
 587                         if (/^r(\d+) = ($sha1)$/o) {
 588                                 ($r_new, $cmt_new) = ($1, $2);
 589                         } elsif ($_ eq 'No changes') {
 590                                 $no = 1;
 591                         }
 592                 }
 593                 close $fh or exit 1;
 594                 if (! defined $r_new && ! defined $cmt_new) {
 595                         unless ($no) {
 596                                 die "Failed to parse revision information\n";
 597                         }
 598                 } else {
 599                         ($r_last, $cmt_last) = ($r_new, $cmt_new);
 600                 }
 601         }
 602         $ENV{LC_ALL} = 'C';
 603         unlink $commit_msg;
 604 }
 605
 606 sub dcommit {
 607         my $head = shift || 'HEAD';
 608         my $gs = "refs/remotes/$GIT_SVN";
 609         chomp(my @refs = safe_qx(qw/git-rev-list --no-merges/, "$gs..$head"));
 610         my $last_rev;
 611         foreach my $d (reverse @refs) {
 612                 if (quiet_run('git-rev-parse','--verify',"$d~1") != 0) {
 613                         die "Commit $d\n",
 614                             "has no parent commit, and therefore ",
 615                             "nothing to diff against.\n",
 616                             "You should be working from a repository ",
 617                             "originally created by git-svn\n";
 618                 }
 619                 unless (defined $last_rev) {
 620                         (undef, $last_rev, undef) = cmt_metadata("$d~1");
 621                         unless (defined $last_rev) {
 622                                 die "Unable to extract revision information ",
 623                                     "from commit $d~1\n";
 624                         }
 625                 }
 626                 if ($_dry_run) {
 627                         print "diff-tree $d~1 $d\n";
 628                 } else {
 629                         if (my $r = commit_diff("$d~1", $d, undef, $last_rev)) {
 630                                 $last_rev = $r;
 631                         } # else: no changes, same $last_rev
 632                 }
 633         }
 634         return if $_dry_run;
 635         fetch();
 636         my @diff = safe_qx('git-diff-tree', $head, $gs);
 637         my @finish;
 638         if (@diff) {
 639                 @finish = qw/rebase/;
 640                 push @finish, qw/--merge/ if $_merge;
 641                 push @finish, "--strategy=$_strategy" if $_strategy;
 642                 print STDERR "W: $head and $gs differ, using @finish:\n", @diff;
 643         } else {
 644                 print "No changes between current $head and $gs\n",
 645                       "Resetting to the latest $gs\n";
 646                 @finish = qw/reset --mixed/;
 647         }
 648         sys('git', @finish, $gs);
 649 }
 650
 651 sub show_ignore {
 652         $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
 653         $_use_lib ? show_ignore_lib() : show_ignore_cmd();
 654 }
 655
 656 sub show_ignore_cmd {
 657         require File::Find or die $!;
 658         if (defined $_revision) {
 659                 die "-r/--revision option doesn't work unless the Perl SVN ",
 660                         "libraries are used\n";
 661         }
 662         chdir $SVN_WC or croak $!;
 663         my %ign;
 664         File::Find::find({wanted=>sub{if(lstat $_ && -d _ && -d "$_/.svn"){
 665                 s#^\./##;
 666                 @{$ign{$_}} = svn_propget_base('svn:ignore', $_);
 667                 }}, no_chdir=>1},'.');
 668
 669         print "\n# /\n";
 670         foreach (@{$ign{'.'}}) { print '/',$_ if /\S/ }
 671         delete $ign{'.'};
 672         foreach my $i (sort keys %ign) {
 673                 print "\n# ",$i,"\n";
 674                 foreach (@{$ign{$i}}) { print '/',$i,'/',$_ if /\S/ }
 675         }
 676 }
 677
 678 sub show_ignore_lib {
 679         my $repo;
 680         $SVN ||= libsvn_connect($SVN_URL);
 681         my $r = defined $_revision ? $_revision : $SVN->get_latest_revnum;
 682         libsvn_traverse_ignore(\*STDOUT, $SVN->{svn_path}, $r);
 683 }
 684
 685 sub graft_branches {
 686         my $gr_file = "$GIT_DIR/info/grafts";
 687         my ($grafts, $comments) = read_grafts($gr_file);
 688         my $gr_sha1;
 689
 690         if (%$grafts) {
 691                 # temporarily disable our grafts file to make this idempotent
 692                 chomp($gr_sha1 = safe_qx(qw/git-hash-object -w/,$gr_file));
 693                 rename $gr_file, "$gr_file~$gr_sha1" or croak $!;
 694         }
 695
 696         my $l_map = read_url_paths();
 697         my @re = map { qr/$_/is } @_opt_m if @_opt_m;
 698         unless ($_no_default_regex) {
 699                 push @re, (qr/\b(?:merge|merging|merged)\s+with\s+([\w\.\-]+)/i,
 700                         qr/\b(?:merge|merging|merged)\s+([\w\.\-]+)/i,
 701                         qr/\b(?:from|of)\s+([\w\.\-]+)/i );
 702         }
 703         foreach my $u (keys %$l_map) {
 704                 if (@re) {
 705                         foreach my $p (keys %{$l_map->{$u}}) {
 706                                 graft_merge_msg($grafts,$l_map,$u,$p,@re);
 707                         }
 708                 }
 709                 unless ($_no_graft_copy) {
 710                         if ($_use_lib) {
 711                                 graft_file_copy_lib($grafts,$l_map,$u);
 712                         } else {
 713                                 graft_file_copy_cmd($grafts,$l_map,$u);
 714                         }
 715                 }
 716         }
 717         graft_tree_joins($grafts);
 718
 719         write_grafts($grafts, $comments, $gr_file);
 720         unlink "$gr_file~$gr_sha1" if $gr_sha1;
 721 }
 722
 723 sub multi_init {
 724         my $url = shift;
 725         $_trunk ||= 'trunk';
 726         $_trunk =~ s#/+$##;
 727         $url =~ s#/+$## if $url;
 728         if ($_trunk !~ m#^[a-z\+]+://#) {
 729                 $_trunk = '/' . $_trunk if ($_trunk !~ m#^/#);
 730                 unless ($url) {
 731                         print STDERR "E: '$_trunk' is not a complete URL ",
 732                                 "and a separate URL is not specified\n";
 733                         exit 1;
 734                 }
 735                 $_trunk = $url . $_trunk;
 736         }
 737         my $ch_id;
 738         if ($GIT_SVN eq 'git-svn') {
 739                 $ch_id = 1;
 740                 $GIT_SVN = $ENV{GIT_SVN_ID} = 'trunk';
 741         }
 742         init_vars();
 743         unless (-d $GIT_SVN_DIR) {
 744                 print "GIT_SVN_ID set to 'trunk' for $_trunk\n" if $ch_id;
 745                 init($_trunk);
 746                 sys('git-repo-config', 'svn.trunk', $_trunk);
 747         }
 748         complete_url_ls_init($url, $_branches, '--branches/-b', '');
 749         complete_url_ls_init($url, $_tags, '--tags/-t', 'tags/');
 750 }
 751
 752 sub multi_fetch {
 753         # try to do trunk first, since branches/tags
 754         # may be descended from it.
 755         if (-e "$GIT_DIR/svn/trunk/info/url") {
 756                 fetch_child_id('trunk', @_);
 757         }
 758         rec_fetch('', "$GIT_DIR/svn", @_);
 759 }
 760
 761 sub show_log {
 762         my (@args) = @_;
 763         my ($r_min, $r_max);
 764         my $r_last = -1; # prevent dupes
 765         rload_authors() if $_authors;
 766         if (defined $TZ) {
 767                 $ENV{TZ} = $TZ;
 768         } else {
 769                 delete $ENV{TZ};
 770         }
 771         if (defined $_revision) {
 772                 if ($_revision =~ /^(\d+):(\d+)$/) {
 773                         ($r_min, $r_max) = ($1, $2);
 774                 } elsif ($_revision =~ /^\d+$/) {
 775                         $r_min = $r_max = $_revision;
 776                 } else {
 777                         print STDERR "-r$_revision is not supported, use ",
 778                                 "standard \'git log\' arguments instead\n";
 779                         exit 1;
 780                 }
 781         }
 782
 783         config_pager();
 784         my $pid = open(my $log,'-|');
 785         defined $pid or croak $!;
 786         if (!$pid) {
 787                 exec(git_svn_log_cmd($r_min,$r_max), @args) or croak $!;
 788         }
 789         run_pager();
 790         my (@k, $c, $d);
 791
 792         while (<$log>) {
 793                 if (/^${_esc_color}commit ($sha1_short)/o) {
 794                         my $cmt = $1;
 795                         if ($c && cmt_showable($c) && $c->{r} != $r_last) {
 796                                 $r_last = $c->{r};
 797                                 process_commit($c, $r_min, $r_max, \@k) or
 798                                                                 goto out;
 799                         }
 800                         $d = undef;
 801                         $c = { c => $cmt };
 802                 } elsif (/^${_esc_color}author (.+) (\d+) ([\-\+]?\d+)$/) {
 803                         get_author_info($c, $1, $2, $3);
 804                 } elsif (/^${_esc_color}(?:tree|parent|committer) /) {
 805                         # ignore
 806                 } elsif (/^${_esc_color}:\d{6} \d{6} $sha1_short/o) {
 807                         push @{$c->{raw}}, $_;
 808                 } elsif (/^${_esc_color}[ACRMDT]\t/) {
 809                         # we could add $SVN->{svn_path} here, but that requires
 810                         # remote access at the moment (repo_path_split)...
 811                         s#^(${_esc_color})([ACRMDT])\t#$1   $2 #;
 812                         push @{$c->{changed}}, $_;
 813                 } elsif (/^${_esc_color}diff /) {
 814                         $d = 1;
 815                         push @{$c->{diff}}, $_;
 816                 } elsif ($d) {
 817                         push @{$c->{diff}}, $_;
 818                 } elsif (/^${_esc_color}    (git-svn-id:.+)$/) {
 819                         ($c->{url}, $c->{r}, undef) = extract_metadata($1);
 820                 } elsif (s/^${_esc_color}    //) {
 821                         push @{$c->{l}}, $_;
 822                 }
 823         }
 824         if ($c && defined $c->{r} && $c->{r} != $r_last) {
 825                 $r_last = $c->{r};
 826                 process_commit($c, $r_min, $r_max, \@k);
 827         }
 828         if (@k) {
 829                 my $swap = $r_max;
 830                 $r_max = $r_min;
 831                 $r_min = $swap;
 832                 process_commit($_, $r_min, $r_max) foreach reverse @k;
 833         }
 834 out:
 835         close $log;
 836         print '-' x72,"\n" unless $_incremental || $_oneline;
 837 }
 838
 839 sub commit_diff_usage {
 840         print STDERR "Usage: $0 commit-diff <tree-ish> <tree-ish> [<URL>]\n";
 841         exit 1
 842 }
 843
 844 sub commit_diff {
 845         if (!$_use_lib) {
 846                 print STDERR "commit-diff must be used with SVN libraries\n";
 847                 exit 1;
 848         }
 849         my $ta = shift or commit_diff_usage();
 850         my $tb = shift or commit_diff_usage();
 851         if (!eval { $SVN_URL = shift || file_to_s("$GIT_SVN_DIR/info/url") }) {
 852                 print STDERR "Needed URL or usable git-svn id command-line\n";
 853                 commit_diff_usage();
 854         }
 855         my $r = shift;
 856         unless (defined $r) {
 857                 if (defined $_revision) {
 858                         $r = $_revision
 859                 } else {
 860                         die "-r|--revision is a required argument\n";
 861                 }
 862         }
 863         if (defined $_message && defined $_file) {
 864                 print STDERR "Both --message/-m and --file/-F specified ",
 865                                 "for the commit message.\n",
 866                                 "I have no idea what you mean\n";
 867                 exit 1;
 868         }
 869         if (defined $_file) {
 870                 $_message = file_to_s($_file);
 871         } else {
 872                 $_message ||= get_commit_message($tb,
 873                                         "$GIT_DIR/.svn-commit.tmp.$$")->{msg};
 874         }
 875         $SVN ||= libsvn_connect($SVN_URL);
 876         if ($r eq 'HEAD') {
 877                 $r = $SVN->get_latest_revnum;
 878         } elsif ($r !~ /^\d+$/) {
 879                 die "revision argument: $r not understood by git-svn\n";
 880         }
 881         my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef, 0) : ();
 882         my $rev_committed;
 883         my $ed = SVN::Git::Editor->new({        r => $r,
 884                                                 ra => libsvn_dup_ra($SVN),
 885                                                 c => $tb,
 886                                                 svn_path => $SVN->{svn_path}
 887                                         },
 888                                 $SVN->get_commit_editor($_message,
 889                                         sub {
 890                                                 $rev_committed = $_[0];
 891                                                 print "Committed $_[0]\n";
 892                                         }, @lock)
 893                                 );
 894         eval {
 895                 my $mods = libsvn_checkout_tree($ta, $tb, $ed);
 896                 if (@$mods == 0) {
 897                         print "No changes\n$ta == $tb\n";
 898                         $ed->abort_edit;
 899                 } else {
 900                         $ed->close_edit;
 901                 }
 902         };
 903         fatal "$@\n" if $@;
 904         $_message = $_file = undef;
 905         return $rev_committed;
 906 }
 907
 908 ########################### utility functions #########################
 909
 910 sub cmt_showable {
 911         my ($c) = @_;
 912         return 1 if defined $c->{r};
 913         if ($c->{l} && $c->{l}->[-1] eq "...\n" &&
 914                                 $c->{a_raw} =~ /\@([a-f\d\-]+)>$/) {
 915                 my @msg = safe_qx(qw/git-cat-file commit/, $c->{c});
 916                 shift @msg while ($msg[0] ne "\n");
 917                 shift @msg;
 918                 @{$c->{l}} = grep !/^git-svn-id: /, @msg;
 919
 920                 (undef, $c->{r}, undef) = extract_metadata(
 921                                 (grep(/^git-svn-id: /, @msg))[-1]);
 922         }
 923         return defined $c->{r};
 924 }
 925
 926 sub log_use_color {
 927         return 1 if $_color;
 928         my $dc;
 929         chomp($dc = `git-repo-config --get diff.color`);
 930         if ($dc eq 'auto') {
 931                 if (-t *STDOUT || (defined $_pager &&
 932                     `git-repo-config --bool --get pager.color` !~ /^false/)) {
 933                         return ($ENV{TERM} && $ENV{TERM} ne 'dumb');
 934                 }
 935                 return 0;
 936         }
 937         return 0 if $dc eq 'never';
 938         return 1 if $dc eq 'always';
 939         chomp($dc = `git-repo-config --bool --get diff.color`);
 940         $dc eq 'true';
 941 }
 942
 943 sub git_svn_log_cmd {
 944         my ($r_min, $r_max) = @_;
 945         my @cmd = (qw/git-log --abbrev-commit --pretty=raw
 946                         --default/, "refs/remotes/$GIT_SVN");
 947         push @cmd, '-r' unless $_non_recursive;
 948         push @cmd, qw/--raw --name-status/ if $_verbose;
 949         push @cmd, '--color' if log_use_color();
 950         return @cmd unless defined $r_max;
 951         if ($r_max == $r_min) {
 952                 push @cmd, '--max-count=1';
 953                 if (my $c = revdb_get($REVDB, $r_max)) {
 954                         push @cmd, $c;
 955                 }
 956         } else {
 957                 my ($c_min, $c_max);
 958                 $c_max = revdb_get($REVDB, $r_max);
 959                 $c_min = revdb_get($REVDB, $r_min);
 960                 if (defined $c_min && defined $c_max) {
 961                         if ($r_max > $r_max) {
 962                                 push @cmd, "$c_min..$c_max";
 963                         } else {
 964                                 push @cmd, "$c_max..$c_min";
 965                         }
 966                 } elsif ($r_max > $r_min) {
 967                         push @cmd, $c_max;
 968                 } else {
 969                         push @cmd, $c_min;
 970                 }
 971         }
 972         return @cmd;
 973 }
 974
 975 sub fetch_child_id {
 976         my $id = shift;
 977         print "Fetching $id\n";
 978         my $ref = "$GIT_DIR/refs/remotes/$id";
 979         defined(my $pid = open my $fh, '-|') or croak $!;
 980         if (!$pid) {
 981                 $_repack = undef;
 982                 $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
 983                 init_vars();
 984                 fetch(@_);
 985                 exit 0;
 986         }
 987         while (<$fh>) {
 988                 print $_;
 989                 check_repack() if (/^r\d+ = $sha1/);
 990         }
 991         close $fh or croak $?;
 992 }
 993
 994 sub rec_fetch {
 995         my ($pfx, $p, @args) = @_;
 996         my @dir;
 997         foreach (sort <$p/*>) {
 998                 if (-r "$_/info/url") {
 999                         $pfx .= '/' if $pfx && $pfx !~ m!/$!;
1000                         my $id = $pfx . basename $_;
1001                         next if $id eq 'trunk';
1002                         fetch_child_id($id, @args);
1003                 } elsif (-d $_) {
1004                         push @dir, $_;
1005                 }
1006         }
1007         foreach (@dir) {
1008                 my $x = $_;
1009                 $x =~ s!^\Q$GIT_DIR\E/svn/!!;
1010                 rec_fetch($x, $_);
1011         }
1012 }
1013
1014 sub complete_url_ls_init {
1015         my ($url, $var, $switch, $pfx) = @_;
1016         unless ($var) {
1017                 print STDERR "W: $switch not specified\n";
1018                 return;
1019         }
1020         $var =~ s#/+$##;
1021         if ($var !~ m#^[a-z\+]+://#) {
1022                 $var = '/' . $var if ($var !~ m#^/#);
1023                 unless ($url) {
1024                         print STDERR "E: '$var' is not a complete URL ",
1025                                 "and a separate URL is not specified\n";
1026                         exit 1;
1027                 }
1028                 $var = $url . $var;
1029         }
1030         chomp(my @ls = $_use_lib ? libsvn_ls_fullurl($var)
1031                                 : safe_qx(qw/svn ls --non-interactive/, $var));
1032         my $old = $GIT_SVN;
1033         defined(my $pid = fork) or croak $!;
1034         if (!$pid) {
1035                 foreach my $u (map { "$var/$_" } (grep m!/$!, @ls)) {
1036                         $u =~ s#/+$##;
1037                         if ($u !~ m!\Q$var\E/(.+)$!) {
1038                                 print STDERR "W: Unrecognized URL: $u\n";
1039                                 die "This should never happen\n";
1040                         }
1041                         # don't try to init already existing refs
1042                         my $id = $pfx.$1;
1043                         $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
1044                         init_vars();
1045                         unless (-d $GIT_SVN_DIR) {
1046                                 print "init $u => $id\n";
1047                                 init($u);
1048                         }
1049                 }
1050                 exit 0;
1051         }
1052         waitpid $pid, 0;
1053         croak $? if $?;
1054         my ($n) = ($switch =~ /^--(\w+)/);
1055         sys('git-repo-config', "svn.$n", $var);
1056 }
1057
1058 sub common_prefix {
1059         my $paths = shift;
1060         my %common;
1061         foreach (@$paths) {
1062                 my @tmp = split m#/#, $_;
1063                 my $p = '';
1064                 while (my $x = shift @tmp) {
1065                         $p .= "/$x";
1066                         $common{$p} ||= 0;
1067                         $common{$p}++;
1068                 }
1069         }
1070         foreach (sort {length $b <=> length $a} keys %common) {
1071                 if ($common{$_} == @$paths) {
1072                         return $_;
1073                 }
1074         }
1075         return '';
1076 }
1077
1078 # grafts set here are 'stronger' in that they're based on actual tree
1079 # matches, and won't be deleted from merge-base checking in write_grafts()
1080 sub graft_tree_joins {
1081         my $grafts = shift;
1082         map_tree_joins() if (@_branch_from && !%tree_map);
1083         return unless %tree_map;
1084
1085         git_svn_each(sub {
1086                 my $i = shift;
1087                 defined(my $pid = open my $fh, '-|') or croak $!;
1088                 if (!$pid) {
1089                         exec qw/git-rev-list --pretty=raw/,
1090                                         "refs/remotes/$i" or croak $!;
1091                 }
1092                 while (<$fh>) {
1093                         next unless /^commit ($sha1)$/o;
1094                         my $c = $1;
1095                         my ($t) = (<$fh> =~ /^tree ($sha1)$/o);
1096                         next unless $tree_map{$t};
1097
1098                         my $l;
1099                         do {
1100                                 $l = readline $fh;
1101                         } until ($l =~ /^committer (?:.+) (\d+) ([\-\+]?\d+)$/);
1102
1103                         my ($s, $tz) = ($1, $2);
1104                         if ($tz =~ s/^\+//) {
1105                                 $s += tz_to_s_offset($tz);
1106                         } elsif ($tz =~ s/^\-//) {
1107                                 $s -= tz_to_s_offset($tz);
1108                         }
1109
1110                         my ($url_a, $r_a, $uuid_a) = cmt_metadata($c);
1111
1112                         foreach my $p (@{$tree_map{$t}}) {
1113                                 next if $p eq $c;
1114                                 my $mb = eval {
1115                                         safe_qx('git-merge-base', $c, $p)
1116                                 };
1117                                 next unless ($@ || $?);
1118                                 if (defined $r_a) {
1119                                         # see if SVN says it's a relative
1120                                         my ($url_b, $r_b, $uuid_b) =
1121                                                         cmt_metadata($p);
1122                                         next if (defined $url_b &&
1123                                                         defined $url_a &&
1124                                                         ($url_a eq $url_b) &&
1125                                                         ($uuid_a eq $uuid_b));
1126                                         if ($uuid_a eq $uuid_b) {
1127                                                 if ($r_b < $r_a) {
1128                                                         $grafts->{$c}->{$p} = 2;
1129                                                         next;
1130                                                 } elsif ($r_b > $r_a) {
1131                                                         $grafts->{$p}->{$c} = 2;
1132                                                         next;
1133                                                 }
1134                                         }
1135                                 }
1136                                 my $ct = get_commit_time($p);
1137                                 if ($ct < $s) {
1138                                         $grafts->{$c}->{$p} = 2;
1139                                 } elsif ($ct > $s) {
1140                                         $grafts->{$p}->{$c} = 2;
1141                                 }
1142                                 # what should we do when $ct == $s ?
1143                         }
1144                 }
1145                 close $fh or croak $?;
1146         });
1147 }
1148
1149 # this isn't funky-filename safe, but good enough for now...
1150 sub graft_file_copy_cmd {
1151         my ($grafts, $l_map, $u) = @_;
1152         my $paths = $l_map->{$u};
1153         my $pfx = common_prefix([keys %$paths]);
1154         $SVN_URL ||= $u.$pfx;
1155         my $pid = open my $fh, '-|';
1156         defined $pid or croak $!;
1157         unless ($pid) {
1158                 my @exec = qw/svn log -v/;
1159                 push @exec, "-r$_revision" if defined $_revision;
1160                 exec @exec, $u.$pfx or croak $!;
1161         }
1162         my ($r, $mp) = (undef, undef);
1163         while (<$fh>) {
1164                 chomp;
1165                 if (/^\-{72}$/) {
1166                         $mp = $r = undef;
1167                 } elsif (/^r(\d+) \| /) {
1168                         $r = $1 unless defined $r;
1169                 } elsif (/^Changed paths:/) {
1170                         $mp = 1;
1171                 } elsif ($mp && m#^   [AR] /(\S.*?) \(from /(\S+?):(\d+)\)$#) {
1172                         my ($p1, $p0, $r0) = ($1, $2, $3);
1173                         my $c = find_graft_path_commit($paths, $p1, $r);
1174                         next unless $c;
1175                         find_graft_path_parents($grafts, $paths, $c, $p0, $r0);
1176                 }
1177         }
1178 }
1179
1180 sub graft_file_copy_lib {
1181         my ($grafts, $l_map, $u) = @_;
1182         my $tree_paths = $l_map->{$u};
1183         my $pfx = common_prefix([keys %$tree_paths]);
1184         my ($repo, $path) = repo_path_split($u.$pfx);
1185         $SVN = libsvn_connect($repo);
1186
1187         my ($base, $head) = libsvn_parse_revision();
1188         my $inc = 1000;
1189         my ($min, $max) = ($base, $head < $base+$inc ? $head : $base+$inc);
1190         my $eh = $SVN::Error::handler;
1191         $SVN::Error::handler = \&libsvn_skip_unknown_revs;
1192         while (1) {
1193                 my $pool = SVN::Pool->new;
1194                 libsvn_get_log(libsvn_dup_ra($SVN), [$path],
1195                                $min, $max, 0, 2, 1,
1196                         sub {
1197                                 libsvn_graft_file_copies($grafts, $tree_paths,
1198                                                         $path, @_);
1199                         }, $pool);
1200                 $pool->clear;
1201                 last if ($max >= $head);
1202                 $min = $max + 1;
1203                 $max += $inc;
1204                 $max = $head if ($max > $head);
1205         }
1206         $SVN::Error::handler = $eh;
1207 }
1208
1209 sub process_merge_msg_matches {
1210         my ($grafts, $l_map, $u, $p, $c, @matches) = @_;
1211         my (@strong, @weak);
1212         foreach (@matches) {
1213                 # merging with ourselves is not interesting
1214                 next if $_ eq $p;
1215                 if ($l_map->{$u}->{$_}) {
1216                         push @strong, $_;
1217                 } else {
1218                         push @weak, $_;
1219                 }
1220         }
1221         foreach my $w (@weak) {
1222                 last if @strong;
1223                 # no exact match, use branch name as regexp.
1224                 my $re = qr/\Q$w\E/i;
1225                 foreach (keys %{$l_map->{$u}}) {
1226                         if (/$re/) {
1227                                 push @strong, $l_map->{$u}->{$_};
1228                                 last;
1229                         }
1230                 }
1231                 last if @strong;
1232                 $w = basename($w);
1233                 $re = qr/\Q$w\E/i;
1234                 foreach (keys %{$l_map->{$u}}) {
1235                         if (/$re/) {
1236                                 push @strong, $l_map->{$u}->{$_};
1237                                 last;
1238                         }
1239                 }
1240         }
1241         my ($rev) = ($c->{m} =~ /^git-svn-id:\s(?:\S+?)\@(\d+)
1242                                         \s(?:[a-f\d\-]+)$/xsm);
1243         unless (defined $rev) {
1244                 ($rev) = ($c->{m} =~/^git-svn-id:\s(\d+)
1245                                         \@(?:[a-f\d\-]+)/xsm);
1246                 return unless defined $rev;
1247         }
1248         foreach my $m (@strong) {
1249                 my ($r0, $s0) = find_rev_before($rev, $m, 1);
1250                 $grafts->{$c->{c}}->{$s0} = 1 if defined $s0;
1251         }
1252 }
1253
1254 sub graft_merge_msg {
1255         my ($grafts, $l_map, $u, $p, @re) = @_;
1256
1257         my $x = $l_map->{$u}->{$p};
1258         my $rl = rev_list_raw($x);
1259         while (my $c = next_rev_list_entry($rl)) {
1260                 foreach my $re (@re) {
1261                         my (@br) = ($c->{m} =~ /$re/g);
1262                         next unless @br;
1263                         process_merge_msg_matches($grafts,$l_map,$u,$p,$c,@br);
1264                 }
1265         }
1266 }
1267
1268 sub read_uuid {
1269         return if $SVN_UUID;
1270         if ($_use_lib) {
1271                 my $pool = SVN::Pool->new;
1272                 $SVN_UUID = $SVN->get_uuid($pool);
1273                 $pool->clear;
1274         } else {
1275                 my $info = shift || svn_info('.');
1276                 $SVN_UUID = $info->{'Repository UUID'} or
1277                                         croak "Repository UUID unreadable\n";
1278         }
1279 }
1280
1281 sub quiet_run {
1282         my $pid = fork;
1283         defined $pid or croak $!;
1284         if (!$pid) {
1285                 open my $null, '>', '/dev/null' or croak $!;
1286                 open STDERR, '>&', $null or croak $!;
1287                 open STDOUT, '>&', $null or croak $!;
1288                 exec @_ or croak $!;
1289         }
1290         waitpid $pid, 0;
1291         return $?;
1292 }
1293
1294 sub repo_path_split {
1295         my $full_url = shift;
1296         $full_url =~ s#/+$##;
1297
1298         foreach (@repo_path_split_cache) {
1299                 if ($full_url =~ s#$_##) {
1300                         my $u = $1;
1301                         $full_url =~ s#^/+##;
1302                         return ($u, $full_url);
1303                 }
1304         }
1305         if ($_use_lib) {
1306                 my $tmp = libsvn_connect($full_url);
1307                 return ($tmp->{repos_root}, $tmp->{svn_path});
1308         } else {
1309                 my ($url, $path) = ($full_url =~ m!^([a-z\+]+://[^/]*)(.*)$!i);
1310                 $path =~ s#^/+##;
1311                 my @paths = split(m#/+#, $path);
1312                 while (quiet_run(qw/svn ls --non-interactive/, $url)) {
1313                         my $n = shift @paths || last;
1314                         $url .= "/$n";
1315                 }
1316                 push @repo_path_split_cache, qr/^(\Q$url\E)/;
1317                 $path = join('/',@paths);
1318                 return ($url, $path);
1319         }
1320 }
1321
1322 sub setup_git_svn {
1323         defined $SVN_URL or croak "SVN repository location required\n";
1324         unless (-d $GIT_DIR) {
1325                 croak "GIT_DIR=$GIT_DIR does not exist!\n";
1326         }
1327         mkpath([$GIT_SVN_DIR]);
1328         mkpath(["$GIT_SVN_DIR/info"]);
1329         open my $fh, '>>',$REVDB or croak $!;
1330         close $fh;
1331         s_to_file($SVN_URL,"$GIT_SVN_DIR/info/url");
1332
1333 }
1334
1335 sub assert_svn_wc_clean {
1336         return if $_use_lib;
1337         my ($svn_rev) = @_;
1338         croak "$svn_rev is not an integer!\n" unless ($svn_rev =~ /^\d+$/);
1339         my $lcr = svn_info('.')->{'Last Changed Rev'};
1340         if ($svn_rev != $lcr) {
1341                 print STDERR "Checking for copy-tree ... ";
1342                 my @diff = grep(/^Index: /,(safe_qx(qw(svn diff),
1343                                                 "-r$lcr:$svn_rev")));
1344                 if (@diff) {
1345                         croak "Nope!  Expected r$svn_rev, got r$lcr\n";
1346                 } else {
1347                         print STDERR "OK!\n";
1348                 }
1349         }
1350         my @status = grep(!/^Performing status on external/,(`svn status`));
1351         @status = grep(!/^\s*$/,@status);
1352         @status = grep(!/^X/,@status) if $_no_ignore_ext;
1353         if (scalar @status) {
1354                 print STDERR "Tree ($SVN_WC) is not clean:\n";
1355                 print STDERR $_ foreach @status;
1356                 croak;
1357         }
1358 }
1359
1360 sub get_tree_from_treeish {
1361         my ($treeish) = @_;
1362         croak "Not a sha1: $treeish\n" unless $treeish =~ /^$sha1$/o;
1363         chomp(my $type = `git-cat-file -t $treeish`);
1364         my $expected;
1365         while ($type eq 'tag') {
1366                 chomp(($treeish, $type) = `git-cat-file tag $treeish`);
1367         }
1368         if ($type eq 'commit') {
1369                 $expected = (grep /^tree /,`git-cat-file commit $treeish`)[0];
1370                 ($expected) = ($expected =~ /^tree ($sha1)$/);
1371                 die "Unable to get tree from $treeish\n" unless $expected;
1372         } elsif ($type eq 'tree') {
1373                 $expected = $treeish;
1374         } else {
1375                 die "$treeish is a $type, expected tree, tag or commit\n";
1376         }
1377         return $expected;
1378 }
1379
1380 sub assert_tree {
1381         return if $_use_lib;
1382         my ($treeish) = @_;
1383         my $expected = get_tree_from_treeish($treeish);
1384
1385         my $tmpindex = $GIT_SVN_INDEX.'.assert-tmp';
1386         if (-e $tmpindex) {
1387                 unlink $tmpindex or croak $!;
1388         }
1389         my $old_index = set_index($tmpindex);
1390         index_changes(1);
1391         chomp(my $tree = `git-write-tree`);
1392         restore_index($old_index);
1393         if ($tree ne $expected) {
1394                 croak "Tree mismatch, Got: $tree, Expected: $expected\n";
1395         }
1396         unlink $tmpindex;
1397 }
1398
1399 sub parse_diff_tree {
1400         my $diff_fh = shift;
1401         local $/ = "\0";
1402         my $state = 'meta';
1403         my @mods;
1404         while (<$diff_fh>) {
1405                 chomp $_; # this gets rid of the trailing "\0"
1406                 if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s
1407                                         $sha1\s($sha1)\s([MTCRAD])\d*$/xo) {
1408                         push @mods, {   mode_a => $1, mode_b => $2,
1409                                         sha1_b => $3, chg => $4 };
1410                         if ($4 =~ /^(?:C|R)$/) {
1411                                 $state = 'file_a';
1412                         } else {
1413                                 $state = 'file_b';
1414                         }
1415                 } elsif ($state eq 'file_a') {
1416                         my $x = $mods[$#mods] or croak "Empty array\n";
1417                         if ($x->{chg} !~ /^(?:C|R)$/) {
1418                                 croak "Error parsing $_, $x->{chg}\n";
1419                         }
1420                         $x->{file_a} = $_;
1421                         $state = 'file_b';
1422                 } elsif ($state eq 'file_b') {
1423                         my $x = $mods[$#mods] or croak "Empty array\n";
1424                         if (exists $x->{file_a} && $x->{chg} !~ /^(?:C|R)$/) {
1425                                 croak "Error parsing $_, $x->{chg}\n";
1426                         }
1427                         if (!exists $x->{file_a} && $x->{chg} =~ /^(?:C|R)$/) {
1428                                 croak "Error parsing $_, $x->{chg}\n";
1429                         }
1430                         $x->{file_b} = $_;
1431                         $state = 'meta';
1432                 } else {
1433                         croak "Error parsing $_\n";
1434                 }
1435         }
1436         close $diff_fh or croak $?;
1437
1438         return \@mods;
1439 }
1440
1441 sub svn_check_prop_executable {
1442         my $m = shift;
1443         return if -l $m->{file_b};
1444         if ($m->{mode_b} =~ /755$/) {
1445                 chmod((0755 &~ umask),$m->{file_b}) or croak $!;
1446                 if ($m->{mode_a} !~ /755$/) {
1447                         sys(qw(svn propset svn:executable 1), $m->{file_b});
1448                 }
1449                 -x $m->{file_b} or croak "$m->{file_b} is not executable!\n";
1450         } elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
1451                 sys(qw(svn propdel svn:executable), $m->{file_b});
1452                 chmod((0644 &~ umask),$m->{file_b}) or croak $!;
1453                 -x $m->{file_b} and croak "$m->{file_b} is executable!\n";
1454         }
1455 }
1456
1457 sub svn_ensure_parent_path {
1458         my $dir_b = dirname(shift);
1459         svn_ensure_parent_path($dir_b) if ($dir_b ne File::Spec->curdir);
1460         mkpath([$dir_b]) unless (-d $dir_b);
1461         sys(qw(svn add -N), $dir_b) unless (-d "$dir_b/.svn");
1462 }
1463
1464 sub precommit_check {
1465         my $mods = shift;
1466         my (%rm_file, %rmdir_check, %added_check);
1467
1468         my %o = ( D => 0, R => 1, C => 2, A => 3, M => 3, T => 3 );
1469         foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
1470                 if ($m->{chg} eq 'R') {
1471                         if (-d $m->{file_b}) {
1472                                 err_dir_to_file("$m->{file_a} => $m->{file_b}");
1473                         }
1474                         # dir/$file => dir/file/$file
1475                         my $dirname = dirname($m->{file_b});
1476                         while ($dirname ne File::Spec->curdir) {
1477                                 if ($dirname ne $m->{file_a}) {
1478                                         $dirname = dirname($dirname);
1479                                         next;
1480                                 }
1481                                 err_file_to_dir("$m->{file_a} => $m->{file_b}");
1482                         }
1483                         # baz/zzz => baz (baz is a file)
1484                         $dirname = dirname($m->{file_a});
1485                         while ($dirname ne File::Spec->curdir) {
1486                                 if ($dirname ne $m->{file_b}) {
1487                                         $dirname = dirname($dirname);
1488                                         next;
1489                                 }
1490                                 err_dir_to_file("$m->{file_a} => $m->{file_b}");
1491                         }
1492                 }
1493                 if ($m->{chg} =~ /^(D|R)$/) {
1494                         my $t = $1 eq 'D' ? 'file_b' : 'file_a';
1495                         $rm_file{ $m->{$t} } = 1;
1496                         my $dirname = dirname( $m->{$t} );
1497                         my $basename = basename( $m->{$t} );
1498                         $rmdir_check{$dirname}->{$basename} = 1;
1499                 } elsif ($m->{chg} =~ /^(?:A|C)$/) {
1500                         if (-d $m->{file_b}) {
1501                                 err_dir_to_file($m->{file_b});
1502                         }
1503                         my $dirname = dirname( $m->{file_b} );
1504                         my $basename = basename( $m->{file_b} );
1505                         $added_check{$dirname}->{$basename} = 1;
1506                         while ($dirname ne File::Spec->curdir) {
1507                                 if ($rm_file{$dirname}) {
1508                                         err_file_to_dir($m->{file_b});
1509                                 }
1510                                 $dirname = dirname $dirname;
1511                         }
1512                 }
1513         }
1514         return (\%rmdir_check, \%added_check);
1515
1516         sub err_dir_to_file {
1517                 my $file = shift;
1518                 print STDERR "Node change from directory to file ",
1519                                 "is not supported by Subversion: ",$file,"\n";
1520                 exit 1;
1521         }
1522         sub err_file_to_dir {
1523                 my $file = shift;
1524                 print STDERR "Node change from file to directory ",
1525                                 "is not supported by Subversion: ",$file,"\n";
1526                 exit 1;
1527         }
1528 }
1529
1530
1531 sub get_diff {
1532         my ($from, $treeish) = @_;
1533         assert_tree($from);
1534         print "diff-tree $from $treeish\n";
1535         my $pid = open my $diff_fh, '-|';
1536         defined $pid or croak $!;
1537         if ($pid == 0) {
1538                 my @diff_tree = qw(git-diff-tree -z -r);
1539                 if ($_cp_similarity) {
1540                         push @diff_tree, "-C$_cp_similarity";
1541                 } else {
1542                         push @diff_tree, '-C';
1543                 }
1544                 push @diff_tree, '--find-copies-harder' if $_find_copies_harder;
1545                 push @diff_tree, "-l$_l" if defined $_l;
1546                 exec(@diff_tree, $from, $treeish) or croak $!;
1547         }
1548         return parse_diff_tree($diff_fh);
1549 }
1550
1551 sub svn_checkout_tree {
1552         my ($from, $treeish) = @_;
1553         my $mods = get_diff($from->{commit}, $treeish);
1554         return $mods unless (scalar @$mods);
1555         my ($rm, $add) = precommit_check($mods);
1556
1557         my %o = ( D => 1, R => 0, C => -1, A => 3, M => 3, T => 3 );
1558         foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
1559                 if ($m->{chg} eq 'C') {
1560                         svn_ensure_parent_path( $m->{file_b} );
1561                         sys(qw(svn cp),         $m->{file_a}, $m->{file_b});
1562                         apply_mod_line_blob($m);
1563                         svn_check_prop_executable($m);
1564                 } elsif ($m->{chg} eq 'D') {
1565                         sys(qw(svn rm --force), $m->{file_b});
1566                 } elsif ($m->{chg} eq 'R') {
1567                         svn_ensure_parent_path( $m->{file_b} );
1568                         sys(qw(svn mv --force), $m->{file_a}, $m->{file_b});
1569                         apply_mod_line_blob($m);
1570                         svn_check_prop_executable($m);
1571                 } elsif ($m->{chg} eq 'M') {
1572                         apply_mod_line_blob($m);
1573                         svn_check_prop_executable($m);
1574                 } elsif ($m->{chg} eq 'T') {
1575                         svn_check_prop_executable($m);
1576                         apply_mod_line_blob($m);
1577                         if ($m->{mode_a} =~ /^120/ && $m->{mode_b} !~ /^120/) {
1578                                 sys(qw(svn propdel svn:special), $m->{file_b});
1579                         } else {
1580                                 sys(qw(svn propset svn:special *),$m->{file_b});
1581                         }
1582                 } elsif ($m->{chg} eq 'A') {
1583                         svn_ensure_parent_path( $m->{file_b} );
1584                         apply_mod_line_blob($m);
1585                         sys(qw(svn add), $m->{file_b});
1586                         svn_check_prop_executable($m);
1587                 } else {
1588                         croak "Invalid chg: $m->{chg}\n";
1589                 }
1590         }
1591
1592         assert_tree($treeish);
1593         if ($_rmdir) { # remove empty directories
1594                 handle_rmdir($rm, $add);
1595         }
1596         assert_tree($treeish);
1597         return $mods;
1598 }
1599
1600 sub libsvn_checkout_tree {
1601         my ($from, $treeish, $ed) = @_;
1602         my $mods = get_diff($from, $treeish);
1603         return $mods unless (scalar @$mods);
1604         my %o = ( D => 1, R => 0, C => -1, A => 3, M => 3, T => 3 );
1605         foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
1606                 my $f = $m->{chg};
1607                 if (defined $o{$f}) {
1608                         $ed->$f($m, $_q);
1609                 } else {
1610                         croak "Invalid change type: $f\n";
1611                 }
1612         }
1613         $ed->rmdirs($_q) if $_rmdir;
1614         return $mods;
1615 }
1616
1617 # svn ls doesn't work with respect to the current working tree, but what's
1618 # in the repository.  There's not even an option for it... *sigh*
1619 # (added files don't show up and removed files remain in the ls listing)
1620 sub svn_ls_current {
1621         my ($dir, $rm, $add) = @_;
1622         chomp(my @ls = safe_qx('svn','ls',$dir));
1623         my @ret = ();
1624         foreach (@ls) {
1625                 s#/$##; # trailing slashes are evil
1626                 push @ret, $_ unless $rm->{$dir}->{$_};
1627         }
1628         if (exists $add->{$dir}) {
1629                 push @ret, keys %{$add->{$dir}};
1630         }
1631         return \@ret;
1632 }
1633
1634 sub handle_rmdir {
1635         my ($rm, $add) = @_;
1636
1637         foreach my $dir (sort {length $b <=> length $a} keys %$rm) {
1638                 my $ls = svn_ls_current($dir, $rm, $add);
1639                 next if (scalar @$ls);
1640                 sys(qw(svn rm --force),$dir);
1641
1642                 my $dn = dirname $dir;
1643                 $rm->{ $dn }->{ basename $dir } = 1;
1644                 $ls = svn_ls_current($dn, $rm, $add);
1645                 while (scalar @$ls == 0 && $dn ne File::Spec->curdir) {
1646                         sys(qw(svn rm --force),$dn);
1647                         $dir = basename $dn;
1648                         $dn = dirname $dn;
1649                         $rm->{ $dn }->{ $dir } = 1;
1650                         $ls = svn_ls_current($dn, $rm, $add);
1651                 }
1652         }
1653 }
1654
1655 sub get_commit_message {
1656         my ($commit, $commit_msg) = (@_);
1657         my %log_msg = ( msg => '' );
1658         open my $msg, '>', $commit_msg or croak $!;
1659
1660         chomp(my $type = `git-cat-file -t $commit`);
1661         if ($type eq 'commit' || $type eq 'tag') {
1662                 my $pid = open my $msg_fh, '-|';
1663                 defined $pid or croak $!;
1664
1665                 if ($pid == 0) {
1666                         exec('git-cat-file', $type, $commit) or croak $!;
1667                 }
1668                 my $in_msg = 0;
1669                 while (<$msg_fh>) {
1670                         if (!$in_msg) {
1671                                 $in_msg = 1 if (/^\s*$/);
1672                         } elsif (/^git-svn-id: /) {
1673                                 # skip this, we regenerate the correct one
1674                                 # on re-fetch anyways
1675                         } else {
1676                                 print $msg $_ or croak $!;
1677                         }
1678                 }
1679                 close $msg_fh or croak $?;
1680         }
1681         close $msg or croak $!;
1682
1683         if ($_edit || ($type eq 'tree')) {
1684                 my $editor = $ENV{VISUAL} || $ENV{EDITOR} || 'vi';
1685                 system($editor, $commit_msg);
1686         }
1687
1688         # file_to_s removes all trailing newlines, so just use chomp() here:
1689         open $msg, '<', $commit_msg or croak $!;
1690         { local $/; chomp($log_msg{msg} = <$msg>); }
1691         close $msg or croak $!;
1692
1693         return \%log_msg;
1694 }
1695
1696 sub set_svn_commit_env {
1697         if (defined $LC_ALL) {
1698                 $ENV{LC_ALL} = $LC_ALL;
1699         } else {
1700                 delete $ENV{LC_ALL};
1701         }
1702 }
1703
1704 sub svn_commit_tree {
1705         my ($last, $commit) = @_;
1706         my $commit_msg = "$GIT_SVN_DIR/.svn-commit.tmp.$$";
1707         my $log_msg = get_commit_message($commit, $commit_msg);
1708         my ($oneline) = ($log_msg->{msg} =~ /([^\n\r]+)/);
1709         print "Committing $commit: $oneline\n";
1710
1711         set_svn_commit_env();
1712         my @ci_output = safe_qx(qw(svn commit -F),$commit_msg);
1713         $ENV{LC_ALL} = 'C';
1714         unlink $commit_msg;
1715         my ($committed) = ($ci_output[$#ci_output] =~ /(\d+)/);
1716         if (!defined $committed) {
1717                 my $out = join("\n",@ci_output);
1718                 print STDERR "W: Trouble parsing \`svn commit' output:\n\n",
1719                                 $out, "\n\nAssuming English locale...";
1720                 ($committed) = ($out =~ /^Committed revision \d+\./sm);
1721                 defined $committed or die " FAILED!\n",
1722                         "Commit output failed to parse committed revision!\n",
1723                 print STDERR " OK\n";
1724         }
1725
1726         my @svn_up = qw(svn up);
1727         push @svn_up, '--ignore-externals' unless $_no_ignore_ext;
1728         if ($_optimize_commits && ($committed == ($last->{revision} + 1))) {
1729                 push @svn_up, "-r$committed";
1730                 sys(@svn_up);
1731                 my $info = svn_info('.');
1732                 my $date = $info->{'Last Changed Date'} or die "Missing date\n";
1733                 if ($info->{'Last Changed Rev'} != $committed) {
1734                         croak "$info->{'Last Changed Rev'} != $committed\n"
1735                 }
1736                 my ($Y,$m,$d,$H,$M,$S,$tz) = ($date =~
1737                                         /(\d{4})\-(\d\d)\-(\d\d)\s
1738                                          (\d\d)\:(\d\d)\:(\d\d)\s([\-\+]\d+)/x)
1739                                          or croak "Failed to parse date: $date\n";
1740                 $log_msg->{date} = "$tz $Y-$m-$d $H:$M:$S";
1741                 $log_msg->{author} = $info->{'Last Changed Author'};
1742                 $log_msg->{revision} = $committed;
1743                 $log_msg->{msg} .= "\n";
1744                 $log_msg->{parents} = [ $last->{commit} ];
1745                 $log_msg->{commit} = git_commit($log_msg, $commit);
1746                 return $log_msg;
1747         }
1748         # resync immediately
1749         push @svn_up, "-r$last->{revision}";
1750         sys(@svn_up);
1751         return fetch("$committed=$commit");
1752 }
1753
1754 sub rev_list_raw {
1755         my (@args) = @_;
1756         my $pid = open my $fh, '-|';
1757         defined $pid or croak $!;
1758         if (!$pid) {
1759                 exec(qw/git-rev-list --pretty=raw/, @args) or croak $!;
1760         }
1761         return { fh => $fh, t => { } };
1762 }
1763
1764 sub next_rev_list_entry {
1765         my $rl = shift;
1766         my $fh = $rl->{fh};
1767         my $x = $rl->{t};
1768         while (<$fh>) {
1769                 if (/^commit ($sha1)$/o) {
1770                         if ($x->{c}) {
1771                                 $rl->{t} = { c => $1 };
1772                                 return $x;
1773                         } else {
1774                                 $x->{c} = $1;
1775                         }
1776                 } elsif (/^parent ($sha1)$/o) {
1777                         $x->{p}->{$1} = 1;
1778                 } elsif (s/^    //) {
1779                         $x->{m} ||= '';
1780                         $x->{m} .= $_;
1781                 }
1782         }
1783         return ($x != $rl->{t}) ? $x : undef;
1784 }
1785
1786 # read the entire log into a temporary file (which is removed ASAP)
1787 # and store the file handle + parser state
1788 sub svn_log_raw {
1789         my (@log_args) = @_;
1790         my $log_fh = IO::File->new_tmpfile or croak $!;
1791         my $pid = fork;
1792         defined $pid or croak $!;
1793         if (!$pid) {
1794                 open STDOUT, '>&', $log_fh or croak $!;
1795                 exec (qw(svn log), @log_args) or croak $!
1796         }
1797         waitpid $pid, 0;
1798         croak $? if $?;
1799         seek $log_fh, 0, 0 or croak $!;
1800         return { state => 'sep', fh => $log_fh };
1801 }
1802
1803 sub next_log_entry {
1804         my $log = shift; # retval of svn_log_raw()
1805         my $ret = undef;
1806         my $fh = $log->{fh};
1807
1808         while (<$fh>) {
1809                 chomp;
1810                 if (/^\-{72}$/) {
1811                         if ($log->{state} eq 'msg') {
1812                                 if ($ret->{lines}) {
1813                                         $ret->{msg} .= $_."\n";
1814                                         unless(--$ret->{lines}) {
1815                                                 $log->{state} = 'sep';
1816                                         }
1817                                 } else {
1818                                         croak "Log parse error at: $_\n",
1819                                                 $ret->{revision},
1820                                                 "\n";
1821                                 }
1822                                 next;
1823                         }
1824                         if ($log->{state} ne 'sep') {
1825                                 croak "Log parse error at: $_\n",
1826                                         "state: $log->{state}\n",
1827                                         $ret->{revision},
1828                                         "\n";
1829                         }
1830                         $log->{state} = 'rev';
1831
1832                         # if we have an empty log message, put something there:
1833                         if ($ret) {
1834                                 $ret->{msg} ||= "\n";
1835                                 delete $ret->{lines};
1836                                 return $ret;
1837                         }
1838                         next;
1839                 }
1840                 if ($log->{state} eq 'rev' && s/^r(\d+)\s*\|\s*//) {
1841                         my $rev = $1;
1842                         my ($author, $date, $lines) = split(/\s*\|\s*/, $_, 3);
1843                         ($lines) = ($lines =~ /(\d+)/);
1844                         $date = '1970-01-01 00:00:00 +0000'
1845                                 if ($_ignore_nodate && $date eq '(no date)');
1846                         my ($Y,$m,$d,$H,$M,$S,$tz) = ($date =~
1847                                         /(\d{4})\-(\d\d)\-(\d\d)\s
1848                                          (\d\d)\:(\d\d)\:(\d\d)\s([\-\+]\d+)/x)
1849                                          or croak "Failed to parse date: $date\n";
1850                         $ret = {        revision => $rev,
1851                                         date => "$tz $Y-$m-$d $H:$M:$S",
1852                                         author => $author,
1853                                         lines => $lines,
1854                                         msg => '' };
1855                         if (defined $_authors && ! defined $users{$author}) {
1856                                 die "Author: $author not defined in ",
1857                                                 "$_authors file\n";
1858                         }
1859                         $log->{state} = 'msg_start';
1860                         next;
1861                 }
1862                 # skip the first blank line of the message:
1863                 if ($log->{state} eq 'msg_start' && /^$/) {
1864                         $log->{state} = 'msg';
1865                 } elsif ($log->{state} eq 'msg') {
1866                         if ($ret->{lines}) {
1867                                 $ret->{msg} .= $_."\n";
1868                                 unless (--$ret->{lines}) {
1869                                         $log->{state} = 'sep';
1870                                 }
1871                         } else {
1872                                 croak "Log parse error at: $_\n",
1873                                         $ret->{revision},"\n";
1874                         }
1875                 }
1876         }
1877         return $ret;
1878 }
1879
1880 sub svn_info {
1881         my $url = shift || $SVN_URL;
1882
1883         my $pid = open my $info_fh, '-|';
1884         defined $pid or croak $!;
1885
1886         if ($pid == 0) {
1887                 exec(qw(svn info),$url) or croak $!;
1888         }
1889
1890         my $ret = {};
1891         # only single-lines seem to exist in svn info output
1892         while (<$info_fh>) {
1893                 chomp $_;
1894                 if (m#^([^:]+)\s*:\s*(\S.*)$#) {
1895                         $ret->{$1} = $2;
1896                         push @{$ret->{-order}}, $1;
1897                 }
1898         }
1899         close $info_fh or croak $?;
1900         return $ret;
1901 }
1902
1903 sub sys { system(@_) == 0 or croak $? }
1904
1905 sub do_update_index {
1906         my ($z_cmd, $cmd, $no_text_base) = @_;
1907
1908         my $z = open my $p, '-|';
1909         defined $z or croak $!;
1910         unless ($z) { exec @$z_cmd or croak $! }
1911
1912         my $pid = open my $ui, '|-';
1913         defined $pid or croak $!;
1914         unless ($pid) {
1915                 exec('git-update-index',"--$cmd",'-z','--stdin') or croak $!;
1916         }
1917         local $/ = "\0";
1918         while (my $x = <$p>) {
1919                 chomp $x;
1920                 if (!$no_text_base && lstat $x && ! -l _ &&
1921                                 svn_propget_base('svn:keywords', $x)) {
1922                         my $mode = -x _ ? 0755 : 0644;
1923                         my ($v,$d,$f) = File::Spec->splitpath($x);
1924                         my $tb = File::Spec->catfile($d, '.svn', 'tmp',
1925                                                 'text-base',"$f.svn-base");
1926                         $tb =~ s#^/##;
1927                         unless (-f $tb) {
1928                                 $tb = File::Spec->catfile($d, '.svn',
1929                                                 'text-base',"$f.svn-base");
1930                                 $tb =~ s#^/##;
1931                         }
1932                         my @s = stat($x);
1933                         unlink $x or croak $!;
1934                         copy($tb, $x);
1935                         chmod(($mode &~ umask), $x) or croak $!;
1936                         utime $s[8], $s[9], $x;
1937                 }
1938                 print $ui $x,"\0";
1939         }
1940         close $ui or croak $?;
1941 }
1942
1943 sub index_changes {
1944         return if $_use_lib;
1945
1946         if (!-f "$GIT_SVN_DIR/info/exclude") {
1947                 open my $fd, '>>', "$GIT_SVN_DIR/info/exclude" or croak $!;
1948                 print $fd '.svn',"\n";
1949                 close $fd or croak $!;
1950         }
1951         my $no_text_base = shift;
1952         do_update_index([qw/git-diff-files --name-only -z/],
1953                         'remove',
1954                         $no_text_base);
1955         do_update_index([qw/git-ls-files -z --others/,
1956                                 "--exclude-from=$GIT_SVN_DIR/info/exclude"],
1957                         'add',
1958                         $no_text_base);
1959 }
1960
1961 sub s_to_file {
1962         my ($str, $file, $mode) = @_;
1963         open my $fd,'>',$file or croak $!;
1964         print $fd $str,"\n" or croak $!;
1965         close $fd or croak $!;
1966         chmod ($mode &~ umask, $file) if (defined $mode);
1967 }
1968
1969 sub file_to_s {
1970         my $file = shift;
1971         open my $fd,'<',$file or croak "$!: file: $file\n";
1972         local $/;
1973         my $ret = <$fd>;
1974         close $fd or croak $!;
1975         $ret =~ s/\s*$//s;
1976         return $ret;
1977 }
1978
1979 sub assert_revision_unknown {
1980         my $r = shift;
1981         if (my $c = revdb_get($REVDB, $r)) {
1982                 croak "$r = $c already exists! Why are we refetching it?";
1983         }
1984 }
1985
1986 sub trees_eq {
1987         my ($x, $y) = @_;
1988         my @x = safe_qx('git-cat-file','commit',$x);
1989         my @y = safe_qx('git-cat-file','commit',$y);
1990         if (($y[0] ne $x[0]) || $x[0] !~ /^tree $sha1\n$/
1991                                 || $y[0] !~ /^tree $sha1\n$/) {
1992                 print STDERR "Trees not equal: $y[0] != $x[0]\n";
1993                 return 0
1994         }
1995         return 1;
1996 }
1997
1998 sub git_commit {
1999         my ($log_msg, @parents) = @_;
2000         assert_revision_unknown($log_msg->{revision});
2001         map_tree_joins() if (@_branch_from && !%tree_map);
2002
2003         my (@tmp_parents, @exec_parents, %seen_parent);
2004         if (my $lparents = $log_msg->{parents}) {
2005                 @tmp_parents = @$lparents
2006         }
2007         # commit parents can be conditionally bound to a particular
2008         # svn revision via: "svn_revno=commit_sha1", filter them out here:
2009         foreach my $p (@parents) {
2010                 next unless defined $p;
2011                 if ($p =~ /^(\d+)=($sha1_short)$/o) {
2012                         if ($1 == $log_msg->{revision}) {
2013                                 push @tmp_parents, $2;
2014                         }
2015                 } else {
2016                         push @tmp_parents, $p if $p =~ /$sha1_short/o;
2017                 }
2018         }
2019         my $tree = $log_msg->{tree};
2020         if (!defined $tree) {
2021                 my $index = set_index($GIT_SVN_INDEX);
2022                 index_changes();
2023                 chomp($tree = `git-write-tree`);
2024                 croak $? if $?;
2025                 restore_index($index);
2026         }
2027
2028         # just in case we clobber the existing ref, we still want that ref
2029         # as our parent:
2030         if (my $cur = eval { file_to_s("$GIT_DIR/refs/remotes/$GIT_SVN") }) {
2031                 push @tmp_parents, $cur;
2032         }
2033
2034         if (exists $tree_map{$tree}) {
2035                 foreach my $p (@{$tree_map{$tree}}) {
2036                         my $skip;
2037                         foreach (@tmp_parents) {
2038                                 # see if a common parent is found
2039                                 my $mb = eval {
2040                                         safe_qx('git-merge-base', $_, $p)
2041                                 };
2042                                 next if ($@ || $?);
2043                                 $skip = 1;
2044                                 last;
2045                         }
2046                         next if $skip;
2047                         my ($url_p, $r_p, $uuid_p) = cmt_metadata($p);
2048                         next if (($SVN_UUID eq $uuid_p) &&
2049                                                 ($log_msg->{revision} > $r_p));
2050                         next if (defined $url_p && defined $SVN_URL &&
2051                                                 ($SVN_UUID eq $uuid_p) &&
2052                                                 ($url_p eq $SVN_URL));
2053                         push @tmp_parents, $p;
2054                 }
2055         }
2056         foreach (@tmp_parents) {
2057                 next if $seen_parent{$_};
2058                 $seen_parent{$_} = 1;
2059                 push @exec_parents, $_;
2060                 # MAXPARENT is defined to 16 in commit-tree.c:
2061                 last if @exec_parents > 16;
2062         }
2063
2064         set_commit_env($log_msg);
2065         my @exec = ('git-commit-tree', $tree);
2066         push @exec, '-p', $_  foreach @exec_parents;
2067         defined(my $pid = open3(my $msg_fh, my $out_fh, '>&STDERR', @exec))
2068                                                                 or croak $!;
2069         print $msg_fh $log_msg->{msg} or croak $!;
2070         unless ($_no_metadata) {
2071                 print $msg_fh "\ngit-svn-id: $SVN_URL\@$log_msg->{revision}",
2072                                         " $SVN_UUID\n" or croak $!;
2073         }
2074         $msg_fh->flush == 0 or croak $!;
2075         close $msg_fh or croak $!;
2076         chomp(my $commit = do { local $/; <$out_fh> });
2077         close $out_fh or croak $!;
2078         waitpid $pid, 0;
2079         croak $? if $?;
2080         if ($commit !~ /^$sha1$/o) {
2081                 die "Failed to commit, invalid sha1: $commit\n";
2082         }
2083         sys('git-update-ref',"refs/remotes/$GIT_SVN",$commit);
2084         revdb_set($REVDB, $log_msg->{revision}, $commit);
2085
2086         # this output is read via pipe, do not change:
2087         print "r$log_msg->{revision} = $commit\n";
2088         check_repack();
2089         return $commit;
2090 }
2091
2092 sub check_repack {
2093         if ($_repack && (--$_repack_nr == 0)) {
2094                 $_repack_nr = $_repack;
2095                 sys("git repack $_repack_flags");
2096         }
2097 }
2098
2099 sub set_commit_env {
2100         my ($log_msg) = @_;
2101         my $author = $log_msg->{author};
2102         if (!defined $author || length $author == 0) {
2103                 $author = '(no author)';
2104         }
2105         my ($name,$email) = defined $users{$author} ?  @{$users{$author}}
2106                                 : ($author,"$author\@$SVN_UUID");
2107         $ENV{GIT_AUTHOR_NAME} = $ENV{GIT_COMMITTER_NAME} = $name;
2108         $ENV{GIT_AUTHOR_EMAIL} = $ENV{GIT_COMMITTER_EMAIL} = $email;
2109         $ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_msg->{date};
2110 }
2111
2112 sub apply_mod_line_blob {
2113         my $m = shift;
2114         if ($m->{mode_b} =~ /^120/) {
2115                 blob_to_symlink($m->{sha1_b}, $m->{file_b});
2116         } else {
2117                 blob_to_file($m->{sha1_b}, $m->{file_b});
2118         }
2119 }
2120
2121 sub blob_to_symlink {
2122         my ($blob, $link) = @_;
2123         defined $link or croak "\$link not defined!\n";
2124         croak "Not a sha1: $blob\n" unless $blob =~ /^$sha1$/o;
2125         if (-l $link || -f _) {
2126                 unlink $link or croak $!;
2127         }
2128
2129         my $dest = `git-cat-file blob $blob`; # no newline, so no chomp
2130         symlink $dest, $link or croak $!;
2131 }
2132
2133 sub blob_to_file {
2134         my ($blob, $file) = @_;
2135         defined $file or croak "\$file not defined!\n";
2136         croak "Not a sha1: $blob\n" unless $blob =~ /^$sha1$/o;
2137         if (-l $file || -f _) {
2138                 unlink $file or croak $!;
2139         }
2140
2141         open my $blob_fh, '>', $file or croak "$!: $file\n";
2142         my $pid = fork;
2143         defined $pid or croak $!;
2144
2145         if ($pid == 0) {
2146                 open STDOUT, '>&', $blob_fh or croak $!;
2147                 exec('git-cat-file','blob',$blob) or croak $!;
2148         }
2149         waitpid $pid, 0;
2150         croak $? if $?;
2151
2152         close $blob_fh or croak $!;
2153 }
2154
2155 sub safe_qx {
2156         my $pid = open my $child, '-|';
2157         defined $pid or croak $!;
2158         if ($pid == 0) {
2159                 exec(@_) or croak $!;
2160         }
2161         my @ret = (<$child>);
2162         close $child or croak $?;
2163         die $? if $?; # just in case close didn't error out
2164         return wantarray ? @ret : join('',@ret);
2165 }
2166
2167 sub svn_compat_check {
2168         if ($_follow_parent) {
2169                 print STDERR 'E: --follow-parent functionality is only ',
2170                                 "available when SVN libraries are used\n";
2171                 exit 1;
2172         }
2173         my @co_help = safe_qx(qw(svn co -h));
2174         unless (grep /ignore-externals/,@co_help) {
2175                 print STDERR "W: Installed svn version does not support ",
2176                                 "--ignore-externals\n";
2177                 $_no_ignore_ext = 1;
2178         }
2179         if (grep /usage: checkout URL\[\@REV\]/,@co_help) {
2180                 $_svn_co_url_revs = 1;
2181         }
2182         if (grep /\[TARGET\[\@REV\]\.\.\.\]/, `svn propget -h`) {
2183                 $_svn_pg_peg_revs = 1;
2184         }
2185
2186         # I really, really hope nobody hits this...
2187         unless (grep /stop-on-copy/, (safe_qx(qw(svn log -h)))) {
2188                 print STDERR <<'';
2189 W: The installed svn version does not support the --stop-on-copy flag in
2190    the log command.
2191    Lets hope the directory you're tracking is not a branch or tag
2192    and was never moved within the repository...
2193
2194                 $_no_stop_copy = 1;
2195         }
2196 }
2197
2198 # *sigh*, new versions of svn won't honor -r<rev> without URL@<rev>,
2199 # (and they won't honor URL@<rev> without -r<rev>, too!)
2200 sub svn_cmd_checkout {
2201         my ($url, $rev, $dir) = @_;
2202         my @cmd = ('svn','co', "-r$rev");
2203         push @cmd, '--ignore-externals' unless $_no_ignore_ext;
2204         $url .= "\@$rev" if $_svn_co_url_revs;
2205         sys(@cmd, $url, $dir);
2206 }
2207
2208 sub check_upgrade_needed {
2209         if (!-r $REVDB) {
2210                 -d $GIT_SVN_DIR or mkpath([$GIT_SVN_DIR]);
2211                 open my $fh, '>>',$REVDB or croak $!;
2212                 close $fh;
2213         }
2214         my $old = eval {
2215                 my $pid = open my $child, '-|';
2216                 defined $pid or croak $!;
2217                 if ($pid == 0) {
2218                         close STDERR;
2219                         exec('git-rev-parse',"$GIT_SVN-HEAD") or croak $!;
2220                 }
2221                 my @ret = (<$child>);
2222                 close $child or croak $?;
2223                 die $? if $?; # just in case close didn't error out
2224                 return wantarray ? @ret : join('',@ret);
2225         };
2226         return unless $old;
2227         my $head = eval { safe_qx('git-rev-parse',"refs/remotes/$GIT_SVN") };
2228         if ($@ || !$head) {
2229                 print STDERR "Please run: $0 rebuild --upgrade\n";
2230                 exit 1;
2231         }
2232 }
2233
2234 # fills %tree_map with a reverse mapping of trees to commits.  Useful
2235 # for finding parents to commit on.
2236 sub map_tree_joins {
2237         my %seen;
2238         foreach my $br (@_branch_from) {
2239                 my $pid = open my $pipe, '-|';
2240                 defined $pid or croak $!;
2241                 if ($pid == 0) {
2242                         exec(qw(git-rev-list --topo-order --pretty=raw), $br)
2243                                                                 or croak $!;
2244                 }
2245                 while (<$pipe>) {
2246                         if (/^commit ($sha1)$/o) {
2247                                 my $commit = $1;
2248
2249                                 # if we've seen a commit,
2250                                 # we've seen its parents
2251                                 last if $seen{$commit};
2252                                 my ($tree) = (<$pipe> =~ /^tree ($sha1)$/o);
2253                                 unless (defined $tree) {
2254                                         die "Failed to parse commit $commit\n";
2255                                 }
2256                                 push @{$tree_map{$tree}}, $commit;
2257                                 $seen{$commit} = 1;
2258                         }
2259                 }
2260                 close $pipe; # we could be breaking the pipe early
2261         }
2262 }
2263
2264 sub load_all_refs {
2265         if (@_branch_from) {
2266                 print STDERR '--branch|-b parameters are ignored when ',
2267                         "--branch-all-refs|-B is passed\n";
2268         }
2269
2270         # don't worry about rev-list on non-commit objects/tags,
2271         # it shouldn't blow up if a ref is a blob or tree...
2272         chomp(@_branch_from = `git-rev-parse --symbolic --all`);
2273 }
2274
2275 # '<svn username> = real-name <email address>' mapping based on git-svnimport:
2276 sub load_authors {
2277         open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
2278         while (<$authors>) {
2279                 chomp;
2280                 next unless /^(\S+?|\(no author\))\s*=\s*(.+?)\s*<(.+)>\s*$/;
2281                 my ($user, $name, $email) = ($1, $2, $3);
2282                 $users{$user} = [$name, $email];
2283         }
2284         close $authors or croak $!;
2285 }
2286
2287 sub rload_authors {
2288         open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
2289         while (<$authors>) {
2290                 chomp;
2291                 next unless /^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*$/;
2292                 my ($user, $name, $email) = ($1, $2, $3);
2293                 $rusers{"$name <$email>"} = $user;
2294         }
2295         close $authors or croak $!;
2296 }
2297
2298 sub svn_propget_base {
2299         my ($p, $f) = @_;
2300         $f .= '@BASE' if $_svn_pg_peg_revs;
2301         return safe_qx(qw/svn propget/, $p, $f);
2302 }
2303
2304 sub git_svn_each {
2305         my $sub = shift;
2306         foreach (`git-rev-parse --symbolic --all`) {
2307                 next unless s#^refs/remotes/##;
2308                 chomp $_;
2309                 next unless -f "$GIT_DIR/svn/$_/info/url";
2310                 &$sub($_);
2311         }
2312 }
2313
2314 sub migrate_revdb {
2315         git_svn_each(sub {
2316                 my $id = shift;
2317                 defined(my $pid = fork) or croak $!;
2318                 if (!$pid) {
2319                         $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
2320                         init_vars();
2321                         exit 0 if -r $REVDB;
2322                         print "Upgrading svn => git mapping...\n";
2323                         -d $GIT_SVN_DIR or mkpath([$GIT_SVN_DIR]);
2324                         open my $fh, '>>',$REVDB or croak $!;
2325                         close $fh;
2326                         rebuild();
2327                         print "Done upgrading. You may now delete the ",
2328                                 "deprecated $GIT_SVN_DIR/revs directory\n";
2329                         exit 0;
2330                 }
2331                 waitpid $pid, 0;
2332                 croak $? if $?;
2333         });
2334 }
2335
2336 sub migration_check {
2337         migrate_revdb() unless (-e $REVDB);
2338         return if (-d "$GIT_DIR/svn" || !-d $GIT_DIR);
2339         print "Upgrading repository...\n";
2340         unless (-d "$GIT_DIR/svn") {
2341                 mkdir "$GIT_DIR/svn" or croak $!;
2342         }
2343         print "Data from a previous version of git-svn exists, but\n\t",
2344                                 "$GIT_SVN_DIR\n\t(required for this version ",
2345                                 "($VERSION) of git-svn) does not.\n";
2346
2347         foreach my $x (`git-rev-parse --symbolic --all`) {
2348                 next unless $x =~ s#^refs/remotes/##;
2349                 chomp $x;
2350                 next unless -f "$GIT_DIR/$x/info/url";
2351                 my $u = eval { file_to_s("$GIT_DIR/$x/info/url") };
2352                 next unless $u;
2353                 my $dn = dirname("$GIT_DIR/svn/$x");
2354                 mkpath([$dn]) unless -d $dn;
2355                 rename "$GIT_DIR/$x", "$GIT_DIR/svn/$x" or croak "$!: $x";
2356         }
2357         migrate_revdb() if (-d $GIT_SVN_DIR && !-w $REVDB);
2358         print "Done upgrading.\n";
2359 }
2360
2361 sub find_rev_before {
2362         my ($r, $id, $eq_ok) = @_;
2363         my $f = "$GIT_DIR/svn/$id/.rev_db";
2364         return (undef,undef) unless -r $f;
2365         --$r unless $eq_ok;
2366         while ($r > 0) {
2367                 if (my $c = revdb_get($f, $r)) {
2368                         return ($r, $c);
2369                 }
2370                 --$r;
2371         }
2372         return (undef, undef);
2373 }
2374
2375 sub init_vars {
2376         $GIT_SVN ||= $ENV{GIT_SVN_ID} || 'git-svn';
2377         $GIT_SVN_DIR = "$GIT_DIR/svn/$GIT_SVN";
2378         $REVDB = "$GIT_SVN_DIR/.rev_db";
2379         $GIT_SVN_INDEX = "$GIT_SVN_DIR/index";
2380         $SVN_URL = undef;
2381         $SVN_WC = "$GIT_SVN_DIR/tree";
2382         %tree_map = ();
2383 }
2384
2385 # convert GetOpt::Long specs for use by git-repo-config
2386 sub read_repo_config {
2387         return unless -d $GIT_DIR;
2388         my $opts = shift;
2389         foreach my $o (keys %$opts) {
2390                 my $v = $opts->{$o};
2391                 my ($key) = ($o =~ /^([a-z\-]+)/);
2392                 $key =~ s/-//g;
2393                 my $arg = 'git-repo-config';
2394                 $arg .= ' --int' if ($o =~ /[:=]i$/);
2395                 $arg .= ' --bool' if ($o !~ /[:=][sfi]$/);
2396                 if (ref $v eq 'ARRAY') {
2397                         chomp(my @tmp = `$arg --get-all svn.$key`);
2398                         @$v = @tmp if @tmp;
2399                 } else {
2400                         chomp(my $tmp = `$arg --get svn.$key`);
2401                         if ($tmp && !($arg =~ / --bool / && $tmp eq 'false')) {
2402                                 $$v = $tmp;
2403                         }
2404                 }
2405         }
2406 }
2407
2408 sub set_default_vals {
2409         if (defined $_repack) {
2410                 $_repack = 1000 if ($_repack <= 0);
2411                 $_repack_nr = $_repack;
2412                 $_repack_flags ||= '-d';
2413         }
2414 }
2415
2416 sub read_grafts {
2417         my $gr_file = shift;
2418         my ($grafts, $comments) = ({}, {});
2419         if (open my $fh, '<', $gr_file) {
2420                 my @tmp;
2421                 while (<$fh>) {
2422                         if (/^($sha1)\s+/) {
2423                                 my $c = $1;
2424                                 if (@tmp) {
2425                                         @{$comments->{$c}} = @tmp;
2426                                         @tmp = ();
2427                                 }
2428                                 foreach my $p (split /\s+/, $_) {
2429                                         $grafts->{$c}->{$p} = 1;
2430                                 }
2431                         } else {
2432                                 push @tmp, $_;
2433                         }
2434                 }
2435                 close $fh or croak $!;
2436                 @{$comments->{'END'}} = @tmp if @tmp;
2437         }
2438         return ($grafts, $comments);
2439 }
2440
2441 sub write_grafts {
2442         my ($grafts, $comments, $gr_file) = @_;
2443
2444         open my $fh, '>', $gr_file or croak $!;
2445         foreach my $c (sort keys %$grafts) {
2446                 if ($comments->{$c}) {
2447                         print $fh $_ foreach @{$comments->{$c}};
2448                 }
2449                 my $p = $grafts->{$c};
2450                 my %x; # real parents
2451                 delete $p->{$c}; # commits are not self-reproducing...
2452                 my $pid = open my $ch, '-|';
2453                 defined $pid or croak $!;
2454                 if (!$pid) {
2455                         exec(qw/git-cat-file commit/, $c) or croak $!;
2456                 }
2457                 while (<$ch>) {
2458                         if (/^parent ($sha1)/) {
2459                                 $x{$1} = $p->{$1} = 1;
2460                         } else {
2461                                 last unless /^\S/;
2462                         }
2463                 }
2464                 close $ch; # breaking the pipe
2465
2466                 # if real parents are the only ones in the grafts, drop it
2467                 next if join(' ',sort keys %$p) eq join(' ',sort keys %x);
2468
2469                 my (@ip, @jp, $mb);
2470                 my %del = %x;
2471                 @ip = @jp = keys %$p;
2472                 foreach my $i (@ip) {
2473                         next if $del{$i} || $p->{$i} == 2;
2474                         foreach my $j (@jp) {
2475                                 next if $i eq $j || $del{$j} || $p->{$j} == 2;
2476                                 $mb = eval { safe_qx('git-merge-base',$i,$j) };
2477                                 next unless $mb;
2478                                 chomp $mb;
2479                                 next if $x{$mb};
2480                                 if ($mb eq $j) {
2481                                         delete $p->{$i};
2482                                         $del{$i} = 1;
2483                                 } elsif ($mb eq $i) {
2484                                         delete $p->{$j};
2485                                         $del{$j} = 1;
2486                                 }
2487                         }
2488                 }
2489
2490                 # if real parents are the only ones in the grafts, drop it
2491                 next if join(' ',sort keys %$p) eq join(' ',sort keys %x);
2492
2493                 print $fh $c, ' ', join(' ', sort keys %$p),"\n";
2494         }
2495         if ($comments->{'END'}) {
2496                 print $fh $_ foreach @{$comments->{'END'}};
2497         }
2498         close $fh or croak $!;
2499 }
2500
2501 sub read_url_paths_all {
2502         my ($l_map, $pfx, $p) = @_;
2503         my @dir;
2504         foreach (<$p/*>) {
2505                 if (-r "$_/info/url") {
2506                         $pfx .= '/' if $pfx && $pfx !~ m!/$!;
2507                         my $id = $pfx . basename $_;
2508                         my $url = file_to_s("$_/info/url");
2509                         my ($u, $p) = repo_path_split($url);
2510                         $l_map->{$u}->{$p} = $id;
2511                 } elsif (-d $_) {
2512                         push @dir, $_;
2513                 }
2514         }
2515         foreach (@dir) {
2516                 my $x = $_;
2517                 $x =~ s!^\Q$GIT_DIR\E/svn/!!o;
2518                 read_url_paths_all($l_map, $x, $_);
2519         }
2520 }
2521
2522 # this one only gets ids that have been imported, not new ones
2523 sub read_url_paths {
2524         my $l_map = {};
2525         git_svn_each(sub { my $x = shift;
2526                         my $url = file_to_s("$GIT_DIR/svn/$x/info/url");
2527                         my ($u, $p) = repo_path_split($url);
2528                         $l_map->{$u}->{$p} = $x;
2529                         });
2530         return $l_map;
2531 }
2532
2533 sub extract_metadata {
2534         my $id = shift or return (undef, undef, undef);
2535         my ($url, $rev, $uuid) = ($id =~ /^git-svn-id:\s(\S+?)\@(\d+)
2536                                                         \s([a-f\d\-]+)$/x);
2537         if (!defined $rev || !$uuid || !$url) {
2538                 # some of the original repositories I made had
2539                 # identifiers like this:
2540                 ($rev, $uuid) = ($id =~/^git-svn-id:\s(\d+)\@([a-f\d\-]+)/);
2541         }
2542         return ($url, $rev, $uuid);
2543 }
2544
2545 sub cmt_metadata {
2546         return extract_metadata((grep(/^git-svn-id: /,
2547                 safe_qx(qw/git-cat-file commit/, shift)))[-1]);
2548 }
2549
2550 sub get_commit_time {
2551         my $cmt = shift;
2552         defined(my $pid = open my $fh, '-|') or croak $!;
2553         if (!$pid) {
2554                 exec qw/git-rev-list --pretty=raw -n1/, $cmt or croak $!;
2555         }
2556         while (<$fh>) {
2557                 /^committer\s(?:.+) (\d+) ([\-\+]?\d+)$/ or next;
2558                 my ($s, $tz) = ($1, $2);
2559                 if ($tz =~ s/^\+//) {
2560                         $s += tz_to_s_offset($tz);
2561                 } elsif ($tz =~ s/^\-//) {
2562                         $s -= tz_to_s_offset($tz);
2563                 }
2564                 close $fh;
2565                 return $s;
2566         }
2567         die "Can't get commit time for commit: $cmt\n";
2568 }
2569
2570 sub tz_to_s_offset {
2571         my ($tz) = @_;
2572         $tz =~ s/(\d\d)$//;
2573         return ($1 * 60) + ($tz * 3600);
2574 }
2575
2576 # adapted from pager.c
2577 sub config_pager {
2578         $_pager ||= $ENV{GIT_PAGER} || $ENV{PAGER};
2579         if (!defined $_pager) {
2580                 $_pager = 'less';
2581         } elsif (length $_pager == 0 || $_pager eq 'cat') {
2582                 $_pager = undef;
2583         }
2584 }
2585
2586 sub run_pager {
2587         return unless -t *STDOUT;
2588         pipe my $rfd, my $wfd or return;
2589         defined(my $pid = fork) or croak $!;
2590         if (!$pid) {
2591                 open STDOUT, '>&', $wfd or croak $!;
2592                 return;
2593         }
2594         open STDIN, '<&', $rfd or croak $!;
2595         $ENV{LESS} ||= 'FRSX';
2596         exec $_pager or croak "Can't run pager: $! ($_pager)\n";
2597 }
2598
2599 sub get_author_info {
2600         my ($dest, $author, $t, $tz) = @_;
2601         $author =~ s/(?:^\s*|\s*$)//g;
2602         $dest->{a_raw} = $author;
2603         my $_a;
2604         if ($_authors) {
2605                 $_a = $rusers{$author} || undef;
2606         }
2607         if (!$_a) {
2608                 ($_a) = ($author =~ /<([^>]+)\@[^>]+>$/);
2609         }
2610         $dest->{t} = $t;
2611         $dest->{tz} = $tz;
2612         $dest->{a} = $_a;
2613         # Date::Parse isn't in the standard Perl distro :(
2614         if ($tz =~ s/^\+//) {
2615                 $t += tz_to_s_offset($tz);
2616         } elsif ($tz =~ s/^\-//) {
2617                 $t -= tz_to_s_offset($tz);
2618         }
2619         $dest->{t_utc} = $t;
2620 }
2621
2622 sub process_commit {
2623         my ($c, $r_min, $r_max, $defer) = @_;
2624         if (defined $r_min && defined $r_max) {
2625                 if ($r_min == $c->{r} && $r_min == $r_max) {
2626                         show_commit($c);
2627                         return 0;
2628                 }
2629                 return 1 if $r_min == $r_max;
2630                 if ($r_min < $r_max) {
2631                         # we need to reverse the print order
2632                         return 0 if (defined $_limit && --$_limit < 0);
2633                         push @$defer, $c;
2634                         return 1;
2635                 }
2636                 if ($r_min != $r_max) {
2637                         return 1 if ($r_min < $c->{r});
2638                         return 1 if ($r_max > $c->{r});
2639                 }
2640         }
2641         return 0 if (defined $_limit && --$_limit < 0);
2642         show_commit($c);
2643         return 1;
2644 }
2645
2646 sub show_commit {
2647         my $c = shift;
2648         if ($_oneline) {
2649                 my $x = "\n";
2650                 if (my $l = $c->{l}) {
2651                         while ($l->[0] =~ /^\s*$/) { shift @$l }
2652                         $x = $l->[0];
2653                 }
2654                 $_l_fmt ||= 'A' . length($c->{r});
2655                 print 'r',pack($_l_fmt, $c->{r}),' | ';
2656                 print "$c->{c} | " if $_show_commit;
2657                 print $x;
2658         } else {
2659                 show_commit_normal($c);
2660         }
2661 }
2662
2663 sub show_commit_changed_paths {
2664         my ($c) = @_;
2665         return unless $c->{changed};
2666         print "Changed paths:\n", @{$c->{changed}};
2667 }
2668
2669 sub show_commit_normal {
2670         my ($c) = @_;
2671         print '-' x72, "\nr$c->{r} | ";
2672         print "$c->{c} | " if $_show_commit;
2673         print "$c->{a} | ", strftime("%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)",
2674                                  localtime($c->{t_utc})), ' | ';
2675         my $nr_line = 0;
2676
2677         if (my $l = $c->{l}) {
2678                 while ($l->[$#$l] eq "\n" && $#$l > 0
2679                                           && $l->[($#$l - 1)] eq "\n") {
2680                         pop @$l;
2681                 }
2682                 $nr_line = scalar @$l;
2683                 if (!$nr_line) {
2684                         print "1 line\n\n\n";
2685                 } else {
2686                         if ($nr_line == 1) {
2687                                 $nr_line = '1 line';
2688                         } else {
2689                                 $nr_line .= ' lines';
2690                         }
2691                         print $nr_line, "\n";
2692                         show_commit_changed_paths($c);
2693                         print "\n";
2694                         print $_ foreach @$l;
2695                 }
2696         } else {
2697                 print "1 line\n";
2698                 show_commit_changed_paths($c);
2699                 print "\n";
2700
2701         }
2702         foreach my $x (qw/raw diff/) {
2703                 if ($c->{$x}) {
2704                         print "\n";
2705                         print $_ foreach @{$c->{$x}}
2706                 }
2707         }
2708 }
2709
2710 sub libsvn_load {
2711         return unless $_use_lib;
2712         $_use_lib = eval {
2713                 require SVN::Core;
2714                 if ($SVN::Core::VERSION lt '1.1.0') {
2715                         die "Need SVN::Core 1.1.0 or better ",
2716                                         "(got $SVN::Core::VERSION) ",
2717                                         "Falling back to command-line svn\n";
2718                 }
2719                 require SVN::Ra;
2720                 require SVN::Delta;
2721                 push @SVN::Git::Editor::ISA, 'SVN::Delta::Editor';
2722                 push @SVN::Git::Fetcher::ISA, 'SVN::Delta::Editor';
2723                 *SVN::Git::Fetcher::process_rm = *process_rm;
2724                 *SVN::Git::Fetcher::safe_qx = *safe_qx;
2725                 my $kill_stupid_warnings = $SVN::Node::none.$SVN::Node::file.
2726                                         $SVN::Node::dir.$SVN::Node::unknown.
2727                                         $SVN::Node::none.$SVN::Node::file.
2728                                         $SVN::Node::dir.$SVN::Node::unknown.
2729                                         $SVN::Auth::SSL::CNMISMATCH.
2730                                         $SVN::Auth::SSL::NOTYETVALID.
2731                                         $SVN::Auth::SSL::EXPIRED.
2732                                         $SVN::Auth::SSL::UNKNOWNCA.
2733                                         $SVN::Auth::SSL::OTHER;
2734                 1;
2735         };
2736 }
2737
2738 sub _simple_prompt {
2739         my ($cred, $realm, $default_username, $may_save, $pool) = @_;
2740         $may_save = undef if $_no_auth_cache;
2741         $default_username = $_username if defined $_username;
2742         if (defined $default_username && length $default_username) {
2743                 if (defined $realm && length $realm) {
2744                         print "Authentication realm: $realm\n";
2745                 }
2746                 $cred->username($default_username);
2747         } else {
2748                 _username_prompt($cred, $realm, $may_save, $pool);
2749         }
2750         $cred->password(_read_password("Password for '" .
2751                                        $cred->username . "': ", $realm));
2752         $cred->may_save($may_save);
2753         $SVN::_Core::SVN_NO_ERROR;
2754 }
2755
2756 sub _ssl_server_trust_prompt {
2757         my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
2758         $may_save = undef if $_no_auth_cache;
2759         print "Error validating server certificate for '$realm':\n";
2760         if ($failures & $SVN::Auth::SSL::UNKNOWNCA) {
2761                 print " - The certificate is not issued by a trusted ",
2762                       "authority. Use the\n",
2763                       "   fingerprint to validate the certificate manually!\n";
2764         }
2765         if ($failures & $SVN::Auth::SSL::CNMISMATCH) {
2766                 print " - The certificate hostname does not match.\n";
2767         }
2768         if ($failures & $SVN::Auth::SSL::NOTYETVALID) {
2769                 print " - The certificate is not yet valid.\n";
2770         }
2771         if ($failures & $SVN::Auth::SSL::EXPIRED) {
2772                 print " - The certificate has expired.\n";
2773         }
2774         if ($failures & $SVN::Auth::SSL::OTHER) {
2775                 print " - The certificate has an unknown error.\n";
2776         }
2777         printf( "Certificate information:\n".
2778                 " - Hostname: %s\n".
2779                 " - Valid: from %s until %s\n".
2780                 " - Issuer: %s\n".
2781                 " - Fingerprint: %s\n",
2782                 map $cert_info->$_, qw(hostname valid_from valid_until
2783                                        issuer_dname fingerprint) );
2784         my $choice;
2785 prompt:
2786         print $may_save ?
2787               "(R)eject, accept (t)emporarily or accept (p)ermanently? " :
2788               "(R)eject or accept (t)emporarily? ";
2789         $choice = lc(substr(<STDIN> || 'R', 0, 1));
2790         if ($choice =~ /^t$/i) {
2791                 $cred->may_save(undef);
2792         } elsif ($choice =~ /^r$/i) {
2793                 return -1;
2794         } elsif ($may_save && $choice =~ /^p$/i) {
2795                 $cred->may_save($may_save);
2796         } else {
2797                 goto prompt;
2798         }
2799         $cred->accepted_failures($failures);
2800         $SVN::_Core::SVN_NO_ERROR;
2801 }
2802
2803 sub _ssl_client_cert_prompt {
2804         my ($cred, $realm, $may_save, $pool) = @_;
2805         $may_save = undef if $_no_auth_cache;
2806         print "Client certificate filename: ";
2807         chomp(my $filename = <STDIN>);
2808         $cred->cert_file($filename);
2809         $cred->may_save($may_save);
2810         $SVN::_Core::SVN_NO_ERROR;
2811 }
2812
2813 sub _ssl_client_cert_pw_prompt {
2814         my ($cred, $realm, $may_save, $pool) = @_;
2815         $may_save = undef if $_no_auth_cache;
2816         $cred->password(_read_password("Password: ", $realm));
2817         $cred->may_save($may_save);
2818         $SVN::_Core::SVN_NO_ERROR;
2819 }
2820
2821 sub _username_prompt {
2822         my ($cred, $realm, $may_save, $pool) = @_;
2823         $may_save = undef if $_no_auth_cache;
2824         if (defined $realm && length $realm) {
2825                 print "Authentication realm: $realm\n";
2826         }
2827         my $username;
2828         if (defined $_username) {
2829                 $username = $_username;
2830         } else {
2831                 print "Username: ";
2832                 chomp($username = <STDIN>);
2833         }
2834         $cred->username($username);
2835         $cred->may_save($may_save);
2836         $SVN::_Core::SVN_NO_ERROR;
2837 }
2838
2839 sub _read_password {
2840         my ($prompt, $realm) = @_;
2841         print $prompt;
2842         require Term::ReadKey;
2843         Term::ReadKey::ReadMode('noecho');
2844         my $password = '';
2845         while (defined(my $key = Term::ReadKey::ReadKey(0))) {
2846                 last if $key =~ /[\012\015]/; # \n\r
2847                 $password .= $key;
2848         }
2849         Term::ReadKey::ReadMode('restore');
2850         print "\n";
2851         $password;
2852 }
2853
2854 sub libsvn_connect {
2855         my ($url) = @_;
2856         SVN::_Core::svn_config_ensure($_config_dir, undef);
2857         my ($baton, $callbacks) = SVN::Core::auth_open_helper([
2858             SVN::Client::get_simple_provider(),
2859             SVN::Client::get_ssl_server_trust_file_provider(),
2860             SVN::Client::get_simple_prompt_provider(
2861               \&_simple_prompt, 2),
2862             SVN::Client::get_ssl_client_cert_prompt_provider(
2863               \&_ssl_client_cert_prompt, 2),
2864             SVN::Client::get_ssl_client_cert_pw_prompt_provider(
2865               \&_ssl_client_cert_pw_prompt, 2),
2866             SVN::Client::get_username_provider(),
2867             SVN::Client::get_ssl_server_trust_prompt_provider(
2868               \&_ssl_server_trust_prompt),
2869             SVN::Client::get_username_prompt_provider(
2870               \&_username_prompt, 2),
2871           ]);
2872         my $config = SVN::Core::config_get_config($_config_dir);
2873         my $ra = SVN::Ra->new(url => $url, auth => $baton,
2874                               config => $config,
2875                               pool => SVN::Pool->new,
2876                               auth_provider_callbacks => $callbacks);
2877
2878         my $df = $ENV{GIT_SVN_DELTA_FETCH};
2879         if (defined $df) {
2880                 $_xfer_delta = $df;
2881         } else {
2882                 $_xfer_delta = ($url =~ m#^file://#) ? undef : 1;
2883         }
2884         $ra->{svn_path} = $url;
2885         $ra->{repos_root} = $ra->get_repos_root;
2886         $ra->{svn_path} =~ s#^\Q$ra->{repos_root}\E/*##;
2887         push @repo_path_split_cache, qr/^(\Q$ra->{repos_root}\E)/;
2888         return $ra;
2889 }
2890
2891 sub libsvn_can_do_switch {
2892         unless (defined $_svn_can_do_switch) {
2893                 my $pool = SVN::Pool->new;
2894                 my $rep = eval {
2895                         $SVN->do_switch(1, '', 0, $SVN->{url},
2896                                         SVN::Delta::Editor->new, $pool);
2897                 };
2898                 if ($@) {
2899                         $_svn_can_do_switch = 0;
2900                 } else {
2901                         $rep->abort_report($pool);
2902                         $_svn_can_do_switch = 1;
2903                 }
2904                 $pool->clear;
2905         }
2906         $_svn_can_do_switch;
2907 }
2908
2909 sub libsvn_dup_ra {
2910         my ($ra) = @_;
2911         SVN::Ra->new(map { $_ => $ra->{$_} } qw/config url
2912                      auth auth_provider_callbacks repos_root svn_path/);
2913 }
2914
2915 sub libsvn_get_file {
2916         my ($gui, $f, $rev, $chg, $untracked) = @_;
2917         $f =~ s#^/##;
2918         print "\t$chg\t$f\n" unless $_q;
2919
2920         my ($hash, $pid, $in, $out);
2921         my $pool = SVN::Pool->new;
2922         defined($pid = open3($in, $out, '>&STDERR',
2923                                 qw/git-hash-object -w --stdin/)) or croak $!;
2924         # redirect STDOUT for SVN 1.1.x compatibility
2925         open my $stdout, '>&', \*STDOUT or croak $!;
2926         open STDOUT, '>&', $in or croak $!;
2927         my ($r, $props) = $SVN->get_file($f, $rev, \*STDOUT, $pool);
2928         $in->flush == 0 or croak $!;
2929         open STDOUT, '>&', $stdout or croak $!;
2930         close $in or croak $!;
2931         close $stdout or croak $!;
2932         $pool->clear;
2933         chomp($hash = do { local $/; <$out> });
2934         close $out or croak $!;
2935         waitpid $pid, 0;
2936         $hash =~ /^$sha1$/o or die "not a sha1: $hash\n";
2937
2938         my $mode = exists $props->{'svn:executable'} ? '100755' : '100644';
2939         if (exists $props->{'svn:special'}) {
2940                 $mode = '120000';
2941                 my $link = `git-cat-file blob $hash`;
2942                 $link =~ s/^link // or die "svn:special file with contents: <",
2943                                                 $link, "> is not understood\n";
2944                 defined($pid = open3($in, $out, '>&STDERR',
2945                                 qw/git-hash-object -w --stdin/)) or croak $!;
2946                 print $in $link;
2947                 $in->flush == 0 or croak $!;
2948                 close $in or croak $!;
2949                 chomp($hash = do { local $/; <$out> });
2950                 close $out or croak $!;
2951                 waitpid $pid, 0;
2952                 $hash =~ /^$sha1$/o or die "not a sha1: $hash\n";
2953         }
2954         %{$untracked->{file_prop}->{$f}} = %$props;
2955         print $gui $mode,' ',$hash,"\t",$f,"\0" or croak $!;
2956 }
2957
2958 sub uri_encode {
2959         my ($f) = @_;
2960         $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg;
2961         $f
2962 }
2963
2964 sub uri_decode {
2965         my ($f) = @_;
2966         $f =~ tr/+/ /;
2967         $f =~ s/%([A-F0-9]{2})/chr hex($1)/ge;
2968         $f
2969 }
2970
2971 sub libsvn_log_entry {
2972         my ($rev, $author, $date, $msg, $parents, $untracked) = @_;
2973         my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T
2974                                          (\d\d)\:(\d\d)\:(\d\d).\d+Z$/x)
2975                                 or die "Unable to parse date: $date\n";
2976         if (defined $_authors && ! defined $users{$author}) {
2977                 die "Author: $author not defined in $_authors file\n";
2978         }
2979         $msg = '' if ($rev == 0 && !defined $msg);
2980
2981         open my $un, '>>', "$GIT_SVN_DIR/unhandled.log" or croak $!;
2982         my $h;
2983         print $un "r$rev\n" or croak $!;
2984         $h = $untracked->{empty};
2985         foreach (sort keys %$h) {
2986                 my $act = $h->{$_} ? '+empty_dir' : '-empty_dir';
2987                 print $un "  $act: ", uri_encode($_), "\n" or croak $!;
2988                 warn "W: $act: $_\n";
2989         }
2990         foreach my $t (qw/dir_prop file_prop/) {
2991                 $h = $untracked->{$t} or next;
2992                 foreach my $path (sort keys %$h) {
2993                         my $ppath = $path eq '' ? '.' : $path;
2994                         foreach my $prop (sort keys %{$h->{$path}}) {
2995                                 next if $SKIP{$prop};
2996                                 my $v = $h->{$path}->{$prop};
2997                                 if (defined $v) {
2998                                         print $un "  +$t: ",
2999                                                   uri_encode($ppath), ' ',
3000                                                   uri_encode($prop), ' ',
3001                                                   uri_encode($v), "\n"
3002                                                   or croak $!;
3003                                 } else {
3004                                         print $un "  -$t: ",
3005                                                   uri_encode($ppath), ' ',
3006                                                   uri_encode($prop), "\n"
3007                                                   or croak $!;
3008                                 }
3009                         }
3010                 }
3011         }
3012         foreach my $t (qw/absent_file absent_directory/) {
3013                 $h = $untracked->{$t} or next;
3014                 foreach my $parent (sort keys %$h) {
3015                         foreach my $path (sort @{$h->{$parent}}) {
3016                                 print $un "  $t: ",
3017                                       uri_encode("$parent/$path"), "\n"
3018                                       or croak $!;
3019                                 warn "W: $t: $parent/$path ",
3020                                      "Insufficient permissions?\n";
3021                         }
3022                 }
3023         }
3024
3025         # revprops (make this optional? it's an extra network trip...)
3026         my $pool = SVN::Pool->new;
3027         my $rp = $SVN->rev_proplist($rev, $pool);
3028         foreach (sort keys %$rp) {
3029                 next if /^svn:(?:author|date|log)$/;
3030                 print $un "  rev_prop: ", uri_encode($_), ' ',
3031                           uri_encode($rp->{$_}), "\n";
3032         }
3033         $pool->clear;
3034         close $un or croak $!;
3035
3036         { revision => $rev, date => "+0000 $Y-$m-$d $H:$M:$S",
3037           author => $author, msg => $msg."\n", parents => $parents || [],
3038           revprops => $rp }
3039 }
3040
3041 sub process_rm {
3042         my ($gui, $last_commit, $f, $q) = @_;
3043         # remove entire directories.
3044         if (safe_qx('git-ls-tree',$last_commit,'--',$f) =~ /^040000 tree/) {
3045                 defined(my $pid = open my $ls, '-|') or croak $!;
3046                 if (!$pid) {
3047                         exec(qw/git-ls-tree -r --name-only -z/,
3048                                 $last_commit,'--',$f) or croak $!;
3049                 }
3050                 local $/ = "\0";
3051                 while (<$ls>) {
3052                         print $gui '0 ',0 x 40,"\t",$_ or croak $!;
3053                         print "\tD\t$_\n" unless $q;
3054                 }
3055                 print "\tD\t$f/\n" unless $q;
3056                 close $ls or croak $?;
3057                 return $SVN::Node::dir;
3058         } else {
3059                 print $gui '0 ',0 x 40,"\t",$f,"\0" or croak $!;
3060                 print "\tD\t$f\n" unless $q;
3061                 return $SVN::Node::file;
3062         }
3063 }
3064
3065 sub libsvn_fetch {
3066         $_xfer_delta ? libsvn_fetch_delta(@_) : libsvn_fetch_full(@_);
3067 }
3068
3069 sub libsvn_fetch_delta {
3070         my ($last_commit, $paths, $rev, $author, $date, $msg) = @_;
3071         my $pool = SVN::Pool->new;
3072         my $ed = SVN::Git::Fetcher->new({ c => $last_commit, q => $_q });
3073         my $reporter = $SVN->do_update($rev, '', 1, $ed, $pool);
3074         my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
3075         my (undef, $last_rev, undef) = cmt_metadata($last_commit);
3076         $reporter->set_path('', $last_rev, 0, @lock, $pool);
3077         $reporter->finish_report($pool);
3078         $pool->clear;
3079         unless ($ed->{git_commit_ok}) {
3080                 die "SVN connection failed somewhere...\n";
3081         }
3082         libsvn_log_entry($rev, $author, $date, $msg, [$last_commit], $ed);
3083 }
3084
3085 sub libsvn_fetch_full {
3086         my ($last_commit, $paths, $rev, $author, $date, $msg) = @_;
3087         open my $gui, '| git-update-index -z --index-info' or croak $!;
3088         my %amr;
3089         my $ut = { empty => {}, dir_prop => {}, file_prop => {} };
3090         my $p = $SVN->{svn_path};
3091         foreach my $f (keys %$paths) {
3092                 my $m = $paths->{$f}->action();
3093                 if (length $p) {
3094                         $f =~ s#^/\Q$p\E/##;
3095                         next if $f =~ m#^/#;
3096                 } else {
3097                         $f =~ s#^/##;
3098                 }
3099                 if ($m =~ /^[DR]$/) {
3100                         my $t = process_rm($gui, $last_commit, $f, $_q);
3101                         if ($m eq 'D') {
3102                                 $ut->{empty}->{$f} = 0 if $t == $SVN::Node::dir;
3103                                 next;
3104                         }
3105                         # 'R' can be file replacements, too, right?
3106                 }
3107                 my $pool = SVN::Pool->new;
3108                 my $t = $SVN->check_path($f, $rev, $pool);
3109                 if ($t == $SVN::Node::file) {
3110                         if ($m =~ /^[AMR]$/) {
3111                                 $amr{$f} = $m;
3112                         } else {
3113                                 die "Unrecognized action: $m, ($f r$rev)\n";
3114                         }
3115                 } elsif ($t == $SVN::Node::dir && $m =~ /^[AR]$/) {
3116                         my @traversed = ();
3117                         libsvn_traverse($gui, '', $f, $rev, \@traversed, $ut);
3118                         if (@traversed) {
3119                                 foreach (@traversed) {
3120                                         $amr{$_} = $m;
3121                                 }
3122                         } else {
3123                                 my ($dir, $file) = ($f =~ m#^(.*?)/?([^/]+)$#);
3124                                 delete $ut->{empty}->{$dir};
3125                                 $ut->{empty}->{$f} = 1;
3126                         }
3127                 }
3128                 $pool->clear;
3129         }
3130         foreach (keys %amr) {
3131                 libsvn_get_file($gui, $_, $rev, $amr{$_}, $ut);
3132                 my ($d) = ($_ =~ m#^(.*?)/?(?:[^/]+)$#);
3133                 delete $ut->{empty}->{$d};
3134         }
3135         unless (exists $ut->{dir_prop}->{''}) {
3136                 my $pool = SVN::Pool->new;
3137                 my (undef, undef, $props) = $SVN->get_dir('', $rev, $pool);
3138                 %{$ut->{dir_prop}->{''}} = %$props;
3139                 $pool->clear;
3140         }
3141         close $gui or croak $?;
3142         libsvn_log_entry($rev, $author, $date, $msg, [$last_commit], $ut);
3143 }
3144
3145 sub svn_grab_base_rev {
3146         defined(my $pid = open my $fh, '-|') or croak $!;
3147         if (!$pid) {
3148                 open my $null, '>', '/dev/null' or croak $!;
3149                 open STDERR, '>&', $null or croak $!;
3150                 exec qw/git-rev-parse --verify/,"refs/remotes/$GIT_SVN^0"
3151                                                                 or croak $!;
3152         }
3153         chomp(my $c = do { local $/; <$fh> });
3154         close $fh;
3155         if (defined $c && length $c) {
3156                 my ($url, $rev, $uuid) = cmt_metadata($c);
3157                 return ($rev, $c) if defined $rev;
3158         }
3159         if ($_no_metadata) {
3160                 my $offset = -41; # from tail
3161                 my $rl;
3162                 open my $fh, '<', $REVDB or
3163                         die "--no-metadata specified and $REVDB not readable\n";
3164                 seek $fh, $offset, 2;
3165                 $rl = readline $fh;
3166                 defined $rl or return (undef, undef);
3167                 chomp $rl;
3168                 while ($c ne $rl && tell $fh != 0) {
3169                         $offset -= 41;
3170                         seek $fh, $offset, 2;
3171                         $rl = readline $fh;
3172                         defined $rl or return (undef, undef);
3173                         chomp $rl;
3174                 }
3175                 my $rev = tell $fh;
3176                 croak $! if ($rev < -1);
3177                 $rev =  ($rev - 41) / 41;
3178                 close $fh or croak $!;
3179                 return ($rev, $c);
3180         }
3181         return (undef, undef);
3182 }
3183
3184 sub libsvn_parse_revision {
3185         my $base = shift;
3186         my $head = $SVN->get_latest_revnum();
3187         if (!defined $_revision || $_revision eq 'BASE:HEAD') {
3188                 return ($base + 1, $head) if (defined $base);
3189                 return (0, $head);
3190         }
3191         return ($1, $2) if ($_revision =~ /^(\d+):(\d+)$/);
3192         return ($_revision, $_revision) if ($_revision =~ /^\d+$/);
3193         if ($_revision =~ /^BASE:(\d+)$/) {
3194                 return ($base + 1, $1) if (defined $base);
3195                 return (0, $head);
3196         }
3197         return ($1, $head) if ($_revision =~ /^(\d+):HEAD$/);
3198         die "revision argument: $_revision not understood by git-svn\n",
3199                 "Try using the command-line svn client instead\n";
3200 }
3201
3202 sub libsvn_traverse {
3203         my ($gui, $pfx, $path, $rev, $files, $untracked) = @_;
3204         my $cwd = length $pfx ? "$pfx/$path" : $path;
3205         my $pool = SVN::Pool->new;
3206         $cwd =~ s#^\Q$SVN->{svn_path}\E##;
3207         my $nr = 0;
3208         my ($dirent, $r, $props) = $SVN->get_dir($cwd, $rev, $pool);
3209         %{$untracked->{dir_prop}->{$cwd}} = %$props;
3210         foreach my $d (keys %$dirent) {
3211                 my $t = $dirent->{$d}->kind;
3212                 if ($t == $SVN::Node::dir) {
3213                         my $i = libsvn_traverse($gui, $cwd, $d, $rev,
3214                                                 $files, $untracked);
3215                         if ($i) {
3216                                 $nr += $i;
3217                         } else {
3218                                 $untracked->{empty}->{"$cwd/$d"} = 1;
3219                         }
3220                 } elsif ($t == $SVN::Node::file) {
3221                         $nr++;
3222                         my $file = "$cwd/$d";
3223                         if (defined $files) {
3224                                 push @$files, $file;
3225                         } else {
3226                                 libsvn_get_file($gui, $file, $rev, 'A',
3227                                                 $untracked);
3228                                 my ($dir) = ($file =~ m#^(.*?)/?(?:[^/]+)$#);
3229                                 delete $untracked->{empty}->{$dir};
3230                         }
3231                 }
3232         }
3233         $pool->clear;
3234         $nr;
3235 }
3236
3237 sub libsvn_traverse_ignore {
3238         my ($fh, $path, $r) = @_;
3239         $path =~ s#^/+##g;
3240         my $pool = SVN::Pool->new;
3241         my ($dirent, undef, $props) = $SVN->get_dir($path, $r, $pool);
3242         my $p = $path;
3243         $p =~ s#^\Q$SVN->{svn_path}\E/##;
3244         print $fh length $p ? "\n# $p\n" : "\n# /\n";
3245         if (my $s = $props->{'svn:ignore'}) {
3246                 $s =~ s/[\r\n]+/\n/g;
3247                 chomp $s;
3248                 if (length $p == 0) {
3249                         $s =~ s#\n#\n/$p#g;
3250                         print $fh "/$s\n";
3251                 } else {
3252                         $s =~ s#\n#\n/$p/#g;
3253                         print $fh "/$p/$s\n";
3254                 }
3255         }
3256         foreach (sort keys %$dirent) {
3257                 next if $dirent->{$_}->kind != $SVN::Node::dir;
3258                 libsvn_traverse_ignore($fh, "$path/$_", $r);
3259         }
3260         $pool->clear;
3261 }
3262
3263 sub revisions_eq {
3264         my ($path, $r0, $r1) = @_;
3265         return 1 if $r0 == $r1;
3266         my $nr = 0;
3267         if ($_use_lib) {
3268                 # should be OK to use Pool here (r1 - r0) should be small
3269                 my $pool = SVN::Pool->new;
3270                 libsvn_get_log($SVN, [$path], $r0, $r1,
3271                                 0, 0, 1, sub {$nr++}, $pool);
3272                 $pool->clear;
3273         } else {
3274                 my ($url, undef) = repo_path_split($SVN_URL);
3275                 my $svn_log = svn_log_raw("$url/$path","-r$r0:$r1");
3276                 while (next_log_entry($svn_log)) { $nr++ }
3277                 close $svn_log->{fh};
3278         }
3279         return 0 if ($nr > 1);
3280         return 1;
3281 }
3282
3283 sub libsvn_find_parent_branch {
3284         my ($paths, $rev, $author, $date, $msg) = @_;
3285         my $svn_path = '/'.$SVN->{svn_path};
3286
3287         # look for a parent from another branch:
3288         my $i = $paths->{$svn_path} or return;
3289         my $branch_from = $i->copyfrom_path or return;
3290         my $r = $i->copyfrom_rev;
3291         print STDERR  "Found possible branch point: ",
3292                                 "$branch_from => $svn_path, $r\n";
3293         $branch_from =~ s#^/##;
3294         my $l_map = {};
3295         read_url_paths_all($l_map, '', "$GIT_DIR/svn");
3296         my $url = $SVN->{repos_root};
3297         defined $l_map->{$url} or return;
3298         my $id = $l_map->{$url}->{$branch_from};
3299         if (!defined $id && $_follow_parent) {
3300                 print STDERR "Following parent: $branch_from\@$r\n";
3301                 # auto create a new branch and follow it
3302                 $id = basename($branch_from);
3303                 $id .= '@'.$r if -r "$GIT_DIR/svn/$id";
3304                 while (-r "$GIT_DIR/svn/$id") {
3305                         # just grow a tail if we're not unique enough :x
3306                         $id .= '-';
3307                 }
3308         }
3309         return unless defined $id;
3310
3311         my ($r0, $parent) = find_rev_before($r,$id,1);
3312         if ($_follow_parent && (!defined $r0 || !defined $parent)) {
3313                 defined(my $pid = fork) or croak $!;
3314                 if (!$pid) {
3315                         $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
3316                         init_vars();
3317                         $SVN_URL = "$url/$branch_from";
3318                         $SVN = undef;
3319                         setup_git_svn();
3320                         # we can't assume SVN_URL exists at r+1:
3321                         $_revision = "0:$r";
3322                         fetch_lib();
3323                         exit 0;
3324                 }
3325                 waitpid $pid, 0;
3326                 croak $? if $?;
3327                 ($r0, $parent) = find_rev_before($r,$id,1);
3328         }
3329         return unless (defined $r0 && defined $parent);
3330         if (revisions_eq($branch_from, $r0, $r)) {
3331                 unlink $GIT_SVN_INDEX;
3332                 print STDERR "Found branch parent: ($GIT_SVN) $parent\n";
3333                 sys(qw/git-read-tree/, $parent);
3334                 unless (libsvn_can_do_switch()) {
3335                         return libsvn_fetch_full($parent, $paths, $rev,
3336                                                 $author, $date, $msg);
3337                 }
3338                 # do_switch works with svn/trunk >= r22312, but that is not
3339                 # included with SVN 1.4.2 (the latest version at the moment),
3340                 # so we can't rely on it.
3341                 my $ra = libsvn_connect("$url/$branch_from");
3342                 my $ed = SVN::Git::Fetcher->new({c => $parent, q => $_q});
3343                 my $pool = SVN::Pool->new;
3344                 my $reporter = $ra->do_switch($rev, '', 1, $SVN->{url},
3345                                               $ed, $pool);
3346                 my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
3347                 $reporter->set_path('', $r0, 0, @lock, $pool);
3348                 $reporter->finish_report($pool);
3349                 $pool->clear;
3350                 unless ($ed->{git_commit_ok}) {
3351                         die "SVN connection failed somewhere...\n";
3352                 }
3353                 return libsvn_log_entry($rev, $author, $date, $msg, [$parent]);
3354         }
3355         print STDERR "Nope, branch point not imported or unknown\n";
3356         return undef;
3357 }
3358
3359 sub libsvn_get_log {
3360         my ($ra, @args) = @_;
3361         $args[4]-- if $args[4] && $_xfer_delta && ! $_follow_parent;
3362         if ($SVN::Core::VERSION le '1.2.0') {
3363                 splice(@args, 3, 1);
3364         }
3365         $ra->get_log(@args);
3366 }
3367
3368 sub libsvn_new_tree {
3369         if (my $log_entry = libsvn_find_parent_branch(@_)) {
3370                 return $log_entry;
3371         }
3372         my ($paths, $rev, $author, $date, $msg) = @_;
3373         my $ut;
3374         if ($_xfer_delta) {
3375                 my $pool = SVN::Pool->new;
3376                 my $ed = SVN::Git::Fetcher->new({q => $_q});
3377                 my $reporter = $SVN->do_update($rev, '', 1, $ed, $pool);
3378                 my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
3379                 $reporter->set_path('', $rev, 1, @lock, $pool);
3380                 $reporter->finish_report($pool);
3381                 $pool->clear;
3382                 unless ($ed->{git_commit_ok}) {
3383                         die "SVN connection failed somewhere...\n";
3384                 }
3385                 $ut = $ed;
3386         } else {
3387                 $ut = { empty => {}, dir_prop => {}, file_prop => {} };
3388                 open my $gui, '| git-update-index -z --index-info' or croak $!;
3389                 libsvn_traverse($gui, '', $SVN->{svn_path}, $rev, undef, $ut);
3390                 close $gui or croak $?;
3391         }
3392         libsvn_log_entry($rev, $author, $date, $msg, [], $ut);
3393 }
3394
3395 sub find_graft_path_commit {
3396         my ($tree_paths, $p1, $r1) = @_;
3397         foreach my $x (keys %$tree_paths) {
3398                 next unless ($p1 =~ /^\Q$x\E/);
3399                 my $i = $tree_paths->{$x};
3400                 my ($r0, $parent) = find_rev_before($r1,$i,1);
3401                 return $parent if (defined $r0 && $r0 == $r1);
3402                 print STDERR "r$r1 of $i not imported\n";
3403                 next;
3404         }
3405         return undef;
3406 }
3407
3408 sub find_graft_path_parents {
3409         my ($grafts, $tree_paths, $c, $p0, $r0) = @_;
3410         foreach my $x (keys %$tree_paths) {
3411                 next unless ($p0 =~ /^\Q$x\E/);
3412                 my $i = $tree_paths->{$x};
3413                 my ($r, $parent) = find_rev_before($r0, $i, 1);
3414                 if (defined $r && defined $parent && revisions_eq($x,$r,$r0)) {
3415                         my ($url_b, undef, $uuid_b) = cmt_metadata($c);
3416                         my ($url_a, undef, $uuid_a) = cmt_metadata($parent);
3417                         next if ($url_a && $url_b && $url_a eq $url_b &&
3418                                                         $uuid_b eq $uuid_a);
3419                         $grafts->{$c}->{$parent} = 1;
3420                 }
3421         }
3422 }
3423
3424 sub libsvn_graft_file_copies {
3425         my ($grafts, $tree_paths, $path, $paths, $rev) = @_;
3426         foreach (keys %$paths) {
3427                 my $i = $paths->{$_};
3428                 my ($m, $p0, $r0) = ($i->action, $i->copyfrom_path,
3429                                         $i->copyfrom_rev);
3430                 next unless (defined $p0 && defined $r0);
3431
3432                 my $p1 = $_;
3433                 $p1 =~ s#^/##;
3434                 $p0 =~ s#^/##;
3435                 my $c = find_graft_path_commit($tree_paths, $p1, $rev);
3436                 next unless $c;
3437                 find_graft_path_parents($grafts, $tree_paths, $c, $p0, $r0);
3438         }
3439 }
3440
3441 sub set_index {
3442         my $old = $ENV{GIT_INDEX_FILE};
3443         $ENV{GIT_INDEX_FILE} = shift;
3444         return $old;
3445 }
3446
3447 sub restore_index {
3448         my ($old) = @_;
3449         if (defined $old) {
3450                 $ENV{GIT_INDEX_FILE} = $old;
3451         } else {
3452                 delete $ENV{GIT_INDEX_FILE};
3453         }
3454 }
3455
3456 sub libsvn_commit_cb {
3457         my ($rev, $date, $committer, $c, $msg, $r_last, $cmt_last) = @_;
3458         if ($_optimize_commits && $rev == ($r_last + 1)) {
3459                 my $log = libsvn_log_entry($rev,$committer,$date,$msg);
3460                 $log->{tree} = get_tree_from_treeish($c);
3461                 my $cmt = git_commit($log, $cmt_last, $c);
3462                 my @diff = safe_qx('git-diff-tree', $cmt, $c);
3463                 if (@diff) {
3464                         print STDERR "Trees differ: $cmt $c\n",
3465                                         join('',@diff),"\n";
3466                         exit 1;
3467                 }
3468         } else {
3469                 fetch("$rev=$c");
3470         }
3471 }
3472
3473 sub libsvn_ls_fullurl {
3474         my $fullurl = shift;
3475         my $ra = libsvn_connect($fullurl);
3476         my @ret;
3477         my $pool = SVN::Pool->new;
3478         my $r = defined $_revision ? $_revision : $ra->get_latest_revnum;
3479         my ($dirent, undef, undef) = $ra->get_dir('', $r, $pool);
3480         foreach my $d (keys %$dirent) {
3481                 if ($dirent->{$d}->kind == $SVN::Node::dir) {
3482                         push @ret, "$d/"; # add '/' for compat with cli svn
3483                 }
3484         }
3485         $pool->clear;
3486         return @ret;
3487 }
3488
3489
3490 sub libsvn_skip_unknown_revs {
3491         my $err = shift;
3492         my $errno = $err->apr_err();
3493         # Maybe the branch we're tracking didn't
3494         # exist when the repo started, so it's
3495         # not an error if it doesn't, just continue
3496         #
3497         # Wonderfully consistent library, eh?
3498         # 160013 - svn:// and file://
3499         # 175002 - http(s)://
3500         # 175007 - http(s):// (this repo required authorization, too...)
3501         #   More codes may be discovered later...
3502         if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
3503                 return;
3504         }
3505         croak "Error from SVN, ($errno): ", $err->expanded_message,"\n";
3506 };
3507
3508 # Tie::File seems to be prone to offset errors if revisions get sparse,
3509 # it's not that fast, either.  Tie::File is also not in Perl 5.6.  So
3510 # one of my favorite modules is out :<  Next up would be one of the DBM
3511 # modules, but I'm not sure which is most portable...  So I'll just
3512 # go with something that's plain-text, but still capable of
3513 # being randomly accessed.  So here's my ultra-simple fixed-width
3514 # database.  All records are 40 characters + "\n", so it's easy to seek
3515 # to a revision: (41 * rev) is the byte offset.
3516 # A record of 40 0s denotes an empty revision.
3517 # And yes, it's still pretty fast (faster than Tie::File).
3518 sub revdb_set {
3519         my ($file, $rev, $commit) = @_;
3520         length $commit == 40 or croak "arg3 must be a full SHA1 hexsum\n";
3521         open my $fh, '+<', $file or croak $!;
3522         my $offset = $rev * 41;
3523         # assume that append is the common case:
3524         seek $fh, 0, 2 or croak $!;
3525         my $pos = tell $fh;
3526         if ($pos < $offset) {
3527                 print $fh (('0' x 40),"\n") x (($offset - $pos) / 41);
3528         }
3529         seek $fh, $offset, 0 or croak $!;
3530         print $fh $commit,"\n";
3531         close $fh or croak $!;
3532 }
3533
3534 sub revdb_get {
3535         my ($file, $rev) = @_;
3536         my $ret;
3537         my $offset = $rev * 41;
3538         open my $fh, '<', $file or croak $!;
3539         seek $fh, $offset, 0;
3540         if (tell $fh == $offset) {
3541                 $ret = readline $fh;
3542                 if (defined $ret) {
3543                         chomp $ret;
3544                         $ret = undef if ($ret =~ /^0{40}$/);
3545                 }
3546         }
3547         close $fh or croak $!;
3548         return $ret;
3549 }
3550
3551 sub copy_remote_ref {
3552         my $origin = $_cp_remote ? $_cp_remote : 'origin';
3553         my $ref = "refs/remotes/$GIT_SVN";
3554         if (safe_qx('git-ls-remote', $origin, $ref)) {
3555                 sys(qw/git fetch/, $origin, "$ref:$ref");
3556         } elsif ($_cp_remote && !$_upgrade) {
3557                 die "Unable to find remote reference: ",
3558                                 "refs/remotes/$GIT_SVN on $origin\n";
3559         }
3560 }
3561 package SVN::Git::Fetcher;
3562 use vars qw/@ISA/;
3563 use strict;
3564 use warnings;
3565 use Carp qw/croak/;
3566 use IO::File qw//;
3567
3568 # file baton members: path, mode_a, mode_b, pool, fh, blob, base
3569 sub new {
3570         my ($class, $git_svn) = @_;
3571         my $self = SVN::Delta::Editor->new;
3572         bless $self, $class;
3573         open my $gui, '| git-update-index -z --index-info' or croak $!;
3574         $self->{gui} = $gui;
3575         $self->{c} = $git_svn->{c} if exists $git_svn->{c};
3576         $self->{q} = $git_svn->{q};
3577         $self->{empty} = {};
3578         $self->{dir_prop} = {};
3579         $self->{file_prop} = {};
3580         $self->{absent_dir} = {};
3581         $self->{absent_file} = {};
3582         require Digest::MD5;
3583         $self;
3584 }
3585
3586 sub open_root {
3587         { path => '' };
3588 }
3589
3590 sub open_directory {
3591         my ($self, $path, $pb, $rev) = @_;
3592         { path => $path };
3593 }
3594
3595 sub delete_entry {
3596         my ($self, $path, $rev, $pb) = @_;
3597         my $t = process_rm($self->{gui}, $self->{c}, $path, $self->{q});
3598         $self->{empty}->{$path} = 0 if $t == $SVN::Node::dir;
3599         undef;
3600 }
3601
3602 sub open_file {
3603         my ($self, $path, $pb, $rev) = @_;
3604         my ($mode, $blob) = (safe_qx('git-ls-tree',$self->{c},'--',$path)
3605                              =~ /^(\d{6}) blob ([a-f\d]{40})\t/);
3606         unless (defined $mode && defined $blob) {
3607                 die "$path was not found in commit $self->{c} (r$rev)\n";
3608         }
3609         { path => $path, mode_a => $mode, mode_b => $mode, blob => $blob,
3610           pool => SVN::Pool->new, action => 'M' };
3611 }
3612
3613 sub add_file {
3614         my ($self, $path, $pb, $cp_path, $cp_rev) = @_;
3615         my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
3616         delete $self->{empty}->{$dir};
3617         { path => $path, mode_a => 100644, mode_b => 100644,
3618           pool => SVN::Pool->new, action => 'A' };
3619 }
3620
3621 sub add_directory {
3622         my ($self, $path, $cp_path, $cp_rev) = @_;
3623         my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
3624         delete $self->{empty}->{$dir};
3625         $self->{empty}->{$path} = 1;
3626         { path => $path };
3627 }
3628
3629 sub change_dir_prop {
3630         my ($self, $db, $prop, $value) = @_;
3631         $self->{dir_prop}->{$db->{path}} ||= {};
3632         $self->{dir_prop}->{$db->{path}}->{$prop} = $value;
3633         undef;
3634 }
3635
3636 sub absent_directory {
3637         my ($self, $path, $pb) = @_;
3638         $self->{absent_dir}->{$pb->{path}} ||= [];
3639         push @{$self->{absent_dir}->{$pb->{path}}}, $path;
3640         undef;
3641 }
3642
3643 sub absent_file {
3644         my ($self, $path, $pb) = @_;
3645         $self->{absent_file}->{$pb->{path}} ||= [];
3646         push @{$self->{absent_file}->{$pb->{path}}}, $path;
3647         undef;
3648 }
3649
3650 sub change_file_prop {
3651         my ($self, $fb, $prop, $value) = @_;
3652         if ($prop eq 'svn:executable') {
3653                 if ($fb->{mode_b} != 120000) {
3654                         $fb->{mode_b} = defined $value ? 100755 : 100644;
3655                 }
3656         } elsif ($prop eq 'svn:special') {
3657                 $fb->{mode_b} = defined $value ? 120000 : 100644;
3658         } else {
3659                 $self->{file_prop}->{$fb->{path}} ||= {};
3660                 $self->{file_prop}->{$fb->{path}}->{$prop} = $value;
3661         }
3662         undef;
3663 }
3664
3665 sub apply_textdelta {
3666         my ($self, $fb, $exp) = @_;
3667         my $fh = IO::File->new_tmpfile;
3668         $fh->autoflush(1);
3669         # $fh gets auto-closed() by SVN::TxDelta::apply(),
3670         # (but $base does not,) so dup() it for reading in close_file
3671         open my $dup, '<&', $fh or croak $!;
3672         my $base = IO::File->new_tmpfile;
3673         $base->autoflush(1);
3674         if ($fb->{blob}) {
3675                 defined (my $pid = fork) or croak $!;
3676                 if (!$pid) {
3677                         open STDOUT, '>&', $base or croak $!;
3678                         print STDOUT 'link ' if ($fb->{mode_a} == 120000);
3679                         exec qw/git-cat-file blob/, $fb->{blob} or croak $!;
3680                 }
3681                 waitpid $pid, 0;
3682                 croak $? if $?;
3683
3684                 if (defined $exp) {
3685                         seek $base, 0, 0 or croak $!;
3686                         my $md5 = Digest::MD5->new;
3687                         $md5->addfile($base);
3688                         my $got = $md5->hexdigest;
3689                         die "Checksum mismatch: $fb->{path} $fb->{blob}\n",
3690                             "expected: $exp\n",
3691                             "     got: $got\n" if ($got ne $exp);
3692                 }
3693         }
3694         seek $base, 0, 0 or croak $!;
3695         $fb->{fh} = $dup;
3696         $fb->{base} = $base;
3697         [ SVN::TxDelta::apply($base, $fh, undef, $fb->{path}, $fb->{pool}) ];
3698 }
3699
3700 sub close_file {
3701         my ($self, $fb, $exp) = @_;
3702         my $hash;
3703         my $path = $fb->{path};
3704         if (my $fh = $fb->{fh}) {
3705                 seek($fh, 0, 0) or croak $!;
3706                 my $md5 = Digest::MD5->new;
3707                 $md5->addfile($fh);
3708                 my $got = $md5->hexdigest;
3709                 die "Checksum mismatch: $path\n",
3710                     "expected: $exp\n    got: $got\n" if ($got ne $exp);
3711                 seek($fh, 0, 0) or croak $!;
3712                 if ($fb->{mode_b} == 120000) {
3713                         read($fh, my $buf, 5) == 5 or croak $!;
3714                         $buf eq 'link ' or die "$path has mode 120000",
3715                                                "but is not a link\n";
3716                 }
3717                 defined(my $pid = open my $out,'-|') or die "Can't fork: $!\n";
3718                 if (!$pid) {
3719                         open STDIN, '<&', $fh or croak $!;
3720                         exec qw/git-hash-object -w --stdin/ or croak $!;
3721                 }
3722                 chomp($hash = do { local $/; <$out> });
3723                 close $out or croak $!;
3724                 close $fh or croak $!;
3725                 $hash =~ /^[a-f\d]{40}$/ or die "not a sha1: $hash\n";
3726                 close $fb->{base} or croak $!;
3727         } else {
3728                 $hash = $fb->{blob} or die "no blob information\n";
3729         }
3730         $fb->{pool}->clear;
3731         my $gui = $self->{gui};
3732         print $gui "$fb->{mode_b} $hash\t$path\0" or croak $!;
3733         print "\t$fb->{action}\t$path\n" if $fb->{action} && ! $self->{q};
3734         undef;
3735 }
3736
3737 sub abort_edit {
3738         my $self = shift;
3739         close $self->{gui};
3740         $self->SUPER::abort_edit(@_);
3741 }
3742
3743 sub close_edit {
3744         my $self = shift;
3745         close $self->{gui} or croak $!;
3746         $self->{git_commit_ok} = 1;
3747         $self->SUPER::close_edit(@_);
3748 }
3749
3750 package SVN::Git::Editor;
3751 use vars qw/@ISA/;
3752 use strict;
3753 use warnings;
3754 use Carp qw/croak/;
3755 use IO::File;
3756
3757 sub new {
3758         my $class = shift;
3759         my $git_svn = shift;
3760         my $self = SVN::Delta::Editor->new(@_);
3761         bless $self, $class;
3762         foreach (qw/svn_path c r ra /) {
3763                 die "$_ required!\n" unless (defined $git_svn->{$_});
3764                 $self->{$_} = $git_svn->{$_};
3765         }
3766         $self->{pool} = SVN::Pool->new;
3767         $self->{bat} = { '' => $self->open_root($self->{r}, $self->{pool}) };
3768         $self->{rm} = { };
3769         require Digest::MD5;
3770         return $self;
3771 }
3772
3773 sub split_path {
3774         return ($_[0] =~ m#^(.*?)/?([^/]+)$#);
3775 }
3776
3777 sub repo_path {
3778         (defined $_[1] && length $_[1]) ? $_[1] : ''
3779 }
3780
3781 sub url_path {
3782         my ($self, $path) = @_;
3783         $self->{ra}->{url} . '/' . $self->repo_path($path);
3784 }
3785
3786 sub rmdirs {
3787         my ($self, $q) = @_;
3788         my $rm = $self->{rm};
3789         delete $rm->{''}; # we never delete the url we're tracking
3790         return unless %$rm;
3791
3792         foreach (keys %$rm) {
3793                 my @d = split m#/#, $_;
3794                 my $c = shift @d;
3795                 $rm->{$c} = 1;
3796                 while (@d) {
3797                         $c .= '/' . shift @d;
3798                         $rm->{$c} = 1;
3799                 }
3800         }
3801         delete $rm->{$self->{svn_path}};
3802         delete $rm->{''}; # we never delete the url we're tracking
3803         return unless %$rm;
3804
3805         defined(my $pid = open my $fh,'-|') or croak $!;
3806         if (!$pid) {
3807                 exec qw/git-ls-tree --name-only -r -z/, $self->{c} or croak $!;
3808         }
3809         local $/ = "\0";
3810         while (<$fh>) {
3811                 chomp;
3812                 my @dn = split m#/#, $_;
3813                 while (pop @dn) {
3814                         delete $rm->{join '/', @dn};
3815                 }
3816                 unless (%$rm) {
3817                         close $fh;
3818                         return;
3819                 }
3820         }
3821         close $fh;
3822
3823         my ($r, $p, $bat) = ($self->{r}, $self->{pool}, $self->{bat});
3824         foreach my $d (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$rm) {
3825                 $self->close_directory($bat->{$d}, $p);
3826                 my ($dn) = ($d =~ m#^(.*?)/?(?:[^/]+)$#);
3827                 print "\tD+\t/$d/\n" unless $q;
3828                 $self->SUPER::delete_entry($d, $r, $bat->{$dn}, $p);
3829                 delete $bat->{$d};
3830         }
3831 }
3832
3833 sub open_or_add_dir {
3834         my ($self, $full_path, $baton) = @_;
3835         my $p = SVN::Pool->new;
3836         my $t = $self->{ra}->check_path($full_path, $self->{r}, $p);
3837         $p->clear;
3838         if ($t == $SVN::Node::none) {
3839                 return $self->add_directory($full_path, $baton,
3840                                                 undef, -1, $self->{pool});
3841         } elsif ($t == $SVN::Node::dir) {
3842                 return $self->open_directory($full_path, $baton,
3843                                                 $self->{r}, $self->{pool});
3844         }
3845         print STDERR "$full_path already exists in repository at ",
3846                 "r$self->{r} and it is not a directory (",
3847                 ($t == $SVN::Node::file ? 'file' : 'unknown'),"/$t)\n";
3848         exit 1;
3849 }
3850
3851 sub ensure_path {
3852         my ($self, $path) = @_;
3853         my $bat = $self->{bat};
3854         $path = $self->repo_path($path);
3855         return $bat->{''} unless (length $path);
3856         my @p = split m#/+#, $path;
3857         my $c = shift @p;
3858         $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''});
3859         while (@p) {
3860                 my $c0 = $c;
3861                 $c .= '/' . shift @p;
3862                 $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0});
3863         }
3864         return $bat->{$c};
3865 }
3866
3867 sub A {
3868         my ($self, $m, $q) = @_;
3869         my ($dir, $file) = split_path($m->{file_b});
3870         my $pbat = $self->ensure_path($dir);
3871         my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
3872                                         undef, -1);
3873         print "\tA\t$m->{file_b}\n" unless $q;
3874         $self->chg_file($fbat, $m);
3875         $self->close_file($fbat,undef,$self->{pool});
3876 }
3877
3878 sub C {
3879         my ($self, $m, $q) = @_;
3880         my ($dir, $file) = split_path($m->{file_b});
3881         my $pbat = $self->ensure_path($dir);
3882         my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
3883                                 $self->url_path($m->{file_a}), $self->{r});
3884         print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $q;
3885         $self->chg_file($fbat, $m);
3886         $self->close_file($fbat,undef,$self->{pool});
3887 }
3888
3889 sub delete_entry {
3890         my ($self, $path, $pbat) = @_;
3891         my $rpath = $self->repo_path($path);
3892         my ($dir, $file) = split_path($rpath);
3893         $self->{rm}->{$dir} = 1;
3894         $self->SUPER::delete_entry($rpath, $self->{r}, $pbat, $self->{pool});
3895 }
3896
3897 sub R {
3898         my ($self, $m, $q) = @_;
3899         my ($dir, $file) = split_path($m->{file_b});
3900         my $pbat = $self->ensure_path($dir);
3901         my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
3902                                 $self->url_path($m->{file_a}), $self->{r});
3903         print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $q;
3904         $self->chg_file($fbat, $m);
3905         $self->close_file($fbat,undef,$self->{pool});
3906
3907         ($dir, $file) = split_path($m->{file_a});
3908         $pbat = $self->ensure_path($dir);
3909         $self->delete_entry($m->{file_a}, $pbat);
3910 }
3911
3912 sub M {
3913         my ($self, $m, $q) = @_;
3914         my ($dir, $file) = split_path($m->{file_b});
3915         my $pbat = $self->ensure_path($dir);
3916         my $fbat = $self->open_file($self->repo_path($m->{file_b}),
3917                                 $pbat,$self->{r},$self->{pool});
3918         print "\t$m->{chg}\t$m->{file_b}\n" unless $q;
3919         $self->chg_file($fbat, $m);
3920         $self->close_file($fbat,undef,$self->{pool});
3921 }
3922
3923 sub T { shift->M(@_) }
3924
3925 sub change_file_prop {
3926         my ($self, $fbat, $pname, $pval) = @_;
3927         $self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool});
3928 }
3929
3930 sub chg_file {
3931         my ($self, $fbat, $m) = @_;
3932         if ($m->{mode_b} =~ /755$/ && $m->{mode_a} !~ /755$/) {
3933                 $self->change_file_prop($fbat,'svn:executable','*');
3934         } elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
3935                 $self->change_file_prop($fbat,'svn:executable',undef);
3936         }
3937         my $fh = IO::File->new_tmpfile or croak $!;
3938         if ($m->{mode_b} =~ /^120/) {
3939                 print $fh 'link ' or croak $!;
3940                 $self->change_file_prop($fbat,'svn:special','*');
3941         } elsif ($m->{mode_a} =~ /^120/ && $m->{mode_b} !~ /^120/) {
3942                 $self->change_file_prop($fbat,'svn:special',undef);
3943         }
3944         defined(my $pid = fork) or croak $!;
3945         if (!$pid) {
3946                 open STDOUT, '>&', $fh or croak $!;
3947                 exec qw/git-cat-file blob/, $m->{sha1_b} or croak $!;
3948         }
3949         waitpid $pid, 0;
3950         croak $? if $?;
3951         $fh->flush == 0 or croak $!;
3952         seek $fh, 0, 0 or croak $!;
3953
3954         my $md5 = Digest::MD5->new;
3955         $md5->addfile($fh) or croak $!;
3956         seek $fh, 0, 0 or croak $!;
3957
3958         my $exp = $md5->hexdigest;
3959         my $pool = SVN::Pool->new;
3960         my $atd = $self->apply_textdelta($fbat, undef, $pool);
3961         my $got = SVN::TxDelta::send_stream($fh, @$atd, $pool);
3962         die "Checksum mismatch\nexpected: $exp\ngot: $got\n" if ($got ne $exp);
3963         $pool->clear;
3964
3965         close $fh or croak $!;
3966 }
3967
3968 sub D {
3969         my ($self, $m, $q) = @_;
3970         my ($dir, $file) = split_path($m->{file_b});
3971         my $pbat = $self->ensure_path($dir);
3972         print "\tD\t$m->{file_b}\n" unless $q;
3973         $self->delete_entry($m->{file_b}, $pbat);
3974 }
3975
3976 sub close_edit {
3977         my ($self) = @_;
3978         my ($p,$bat) = ($self->{pool}, $self->{bat});
3979         foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) {
3980                 $self->close_directory($bat->{$_}, $p);
3981         }
3982         $self->SUPER::close_edit($p);
3983         $p->clear;
3984 }
3985
3986 sub abort_edit {
3987         my ($self) = @_;
3988         $self->SUPER::abort_edit($self->{pool});
3989         $self->{pool}->clear;
3990 }
3991
3992 __END__
3993
3994 Data structures:
3995
3996 $svn_log hashref (as returned by svn_log_raw)
3997 {
3998         fh => file handle of the log file,
3999         state => state of the log file parser (sep/msg/rev/msg_start...)
4000 }
4001
4002 $log_msg hashref as returned by next_log_entry($svn_log)
4003 {
4004         msg => 'whitespace-formatted log entry
4005 ',                                              # trailing newline is preserved
4006         revision => '8',                        # integer
4007         date => '2004-02-24T17:01:44.108345Z',  # commit date
4008         author => 'committer name'
4009 };
4010
4011
4012 @mods = array of diff-index line hashes, each element represents one line
4013         of diff-index output
4014
4015 diff-index line ($m hash)
4016 {
4017         mode_a => first column of diff-index output, no leading ':',
4018         mode_b => second column of diff-index output,
4019         sha1_b => sha1sum of the final blob,
4020         chg => change type [MCRADT],
4021         file_a => original file name of a file (iff chg is 'C' or 'R')
4022         file_b => new/current file name of a file (any chg)
4023 }
4024 ;
4025
4026 # retval of read_url_paths{,_all}();
4027 $l_map = {
4028         # repository root url
4029         'https://svn.musicpd.org' => {
4030                 # repository path               # GIT_SVN_ID
4031                 'mpd/trunk'             =>      'trunk',
4032                 'mpd/tags/0.11.5'       =>      'tags/0.11.5',
4033         },
4034 }
4035
4036 Notes:
4037         I don't trust the each() function on unless I created %hash myself
4038         because the internal iterator may not have started at base.