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