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