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