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