Andrew's git - gitweb.git/blob

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