git-svn.perlon commit git-svn: add support for metadata in .git/config (706587f)
   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
   8                $GIT_SVN_INDEX $GIT_SVN
   9                $GIT_DIR $GIT_SVN_DIR $REVDB
  10                $_follow_parent $sha1 $sha1_short $_revision
  11                $_cp_remote $_upgrade $_rmdir $_q $_cp_similarity
  12                $_find_copies_harder $_l $_authors %users/;
  13$AUTHOR = 'Eric Wong <normalperson@yhbt.net>';
  14$VERSION = '@@GIT_VERSION@@';
  15
  16$ENV{GIT_DIR} ||= '.git';
  17$Git::SVN::default_repo_id = $ENV{GIT_SVN_ID} || 'git-svn';
  18
  19my $LC_ALL = $ENV{LC_ALL};
  20$Git::SVN::Log::TZ = $ENV{TZ};
  21# make sure the svn binary gives consistent output between locales and TZs:
  22$ENV{TZ} = 'UTC';
  23$ENV{LC_ALL} = 'C';
  24$| = 1; # unbuffer STDOUT
  25
  26sub fatal (@) { print STDERR @_; exit 1 }
  27require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
  28require SVN::Ra;
  29require SVN::Delta;
  30if ($SVN::Core::VERSION lt '1.1.0') {
  31        fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)\n";
  32}
  33push @Git::SVN::Ra::ISA, 'SVN::Ra';
  34push @SVN::Git::Editor::ISA, 'SVN::Delta::Editor';
  35push @SVN::Git::Fetcher::ISA, 'SVN::Delta::Editor';
  36use Carp qw/croak/;
  37use IO::File qw//;
  38use File::Basename qw/dirname basename/;
  39use File::Path qw/mkpath/;
  40use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev pass_through/;
  41use IPC::Open3;
  42use Git;
  43
  44BEGIN {
  45        my $s;
  46        foreach (qw/command command_oneline command_noisy command_output_pipe
  47                    command_input_pipe command_close_pipe/) {
  48                $s .= "*SVN::Git::Editor::$_ = *SVN::Git::Fetcher::$_ = ".
  49                      "*Git::SVN::Migration::$_ = ".
  50                      "*Git::SVN::Log::$_ = *Git::SVN::$_ = *$_ = *Git::$_; ";
  51        }
  52        eval $s;
  53}
  54
  55my ($SVN);
  56
  57my $_optimize_commits = 1 unless $ENV{GIT_SVN_NO_OPTIMIZE_COMMITS};
  58$sha1 = qr/[a-f\d]{40}/;
  59$sha1_short = qr/[a-f\d]{4,40}/;
  60my ($_stdin, $_help, $_edit,
  61        $_repack, $_repack_nr, $_repack_flags,
  62        $_message, $_file, $_no_metadata,
  63        $_template, $_shared,
  64        $_version, $_upgrade,
  65        $_merge, $_strategy, $_dry_run,
  66        $_prefix);
  67
  68my %remote_opts = ( 'username=s' => \$Git::SVN::Prompt::_username,
  69                    'config-dir=s' => \$Git::SVN::Ra::config_dir,
  70                    'no-auth-cache' => \$Git::SVN::Prompt::_no_auth_cache );
  71my %fc_opts = ( 'follow-parent|follow' => \$_follow_parent,
  72                'authors-file|A=s' => \$_authors,
  73                'repack:i' => \$_repack,
  74                'no-metadata' => \$_no_metadata,
  75                'quiet|q' => \$_q,
  76                'repack-flags|repack-args|repack-opts=s' => \$_repack_flags,
  77                %remote_opts );
  78
  79my ($_trunk, $_tags, $_branches);
  80my %multi_opts = ( 'trunk|T=s' => \$_trunk,
  81                'tags|t=s' => \$_tags,
  82                'branches|b=s' => \$_branches );
  83my %init_opts = ( 'template=s' => \$_template, 'shared' => \$_shared );
  84my %cmt_opts = ( 'edit|e' => \$_edit,
  85                'rmdir' => \$_rmdir,
  86                'find-copies-harder' => \$_find_copies_harder,
  87                'l=i' => \$_l,
  88                'copy-similarity|C=i'=> \$_cp_similarity
  89);
  90
  91my %cmd = (
  92        fetch => [ \&cmd_fetch, "Download new revisions from SVN",
  93                        { 'revision|r=s' => \$_revision, %fc_opts } ],
  94        init => [ \&cmd_init, "Initialize a repo for tracking" .
  95                          " (requires URL argument)",
  96                          \%init_opts ],
  97        dcommit => [ \&cmd_dcommit,
  98                     'Commit several diffs to merge with upstream',
  99                        { 'merge|m|M' => \$_merge,
 100                          'strategy|s=s' => \$_strategy,
 101                          'dry-run|n' => \$_dry_run,
 102                        %cmt_opts, %fc_opts } ],
 103        'set-tree' => [ \&cmd_set_tree,
 104                        "Set an SVN repository to a git tree-ish",
 105                        { 'stdin|' => \$_stdin, %cmt_opts, %fc_opts, } ],
 106        'show-ignore' => [ \&cmd_show_ignore, "Show svn:ignore listings",
 107                        { 'revision|r=i' => \$_revision } ],
 108        rebuild => [ \&cmd_rebuild, "Rebuild git-svn metadata (after git clone)",
 109                        { 'copy-remote|remote=s' => \$_cp_remote,
 110                          'upgrade' => \$_upgrade } ],
 111        'multi-init' => [ \&cmd_multi_init,
 112                        'Initialize multiple trees (like git-svnimport)',
 113                        { %multi_opts, %init_opts, %remote_opts,
 114                         'revision|r=i' => \$_revision,
 115                         'prefix=s' => \$_prefix,
 116                        } ],
 117        'multi-fetch' => [ \&cmd_multi_fetch,
 118                        'Fetch multiple trees (like git-svnimport)',
 119                        \%fc_opts ],
 120        'migrate' => [ sub { },
 121                       # no-op, we automatically run this anyways,
 122                       # we may add a flag to automatically optimize the
 123                       # configuration to avoid reconnects in the future
 124                       'Migrate configuration/metadata/layout from
 125                        previous versions of git-svn',
 126                        \%remote_opts ],
 127        'log' => [ \&Git::SVN::Log::cmd_show_log, 'Show commit logs',
 128                        { 'limit=i' => \$Git::SVN::Log::limit,
 129                          'revision|r=s' => \$_revision,
 130                          'verbose|v' => \$Git::SVN::Log::verbose,
 131                          'incremental' => \$Git::SVN::Log::incremental,
 132                          'oneline' => \$Git::SVN::Log::oneline,
 133                          'show-commit' => \$Git::SVN::Log::show_commit,
 134                          'non-recursive' => \$Git::SVN::Log::non_recursive,
 135                          'authors-file|A=s' => \$_authors,
 136                          'color' => \$Git::SVN::Log::color,
 137                          'pager=s' => \$Git::SVN::Log::pager,
 138                        } ],
 139        'commit-diff' => [ \&cmd_commit_diff,
 140                           'Commit a diff between two trees',
 141                        { 'message|m=s' => \$_message,
 142                          'file|F=s' => \$_file,
 143                          'revision|r=s' => \$_revision,
 144                        %cmt_opts } ],
 145);
 146
 147my $cmd;
 148for (my $i = 0; $i < @ARGV; $i++) {
 149        if (defined $cmd{$ARGV[$i]}) {
 150                $cmd = $ARGV[$i];
 151                splice @ARGV, $i, 1;
 152                last;
 153        }
 154};
 155
 156my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
 157
 158read_repo_config(\%opts);
 159my $rv = GetOptions(%opts, 'help|H|h' => \$_help,
 160                                'version|V' => \$_version,
 161                                'id|i=s' => \$Git::SVN::default_repo_id);
 162exit 1 if (!$rv && $cmd ne 'log');
 163
 164usage(0) if $_help;
 165version() if $_version;
 166usage(1) unless defined $cmd;
 167load_authors() if $_authors;
 168unless ($cmd =~ /^(?:init|rebuild|multi-init|commit-diff)$/) {
 169        Git::SVN::Migration::migration_check();
 170}
 171$cmd{$cmd}->[0]->(@ARGV);
 172exit 0;
 173
 174####################### primary functions ######################
 175sub usage {
 176        my $exit = shift || 0;
 177        my $fd = $exit ? \*STDERR : \*STDOUT;
 178        print $fd <<"";
 179git-svn - bidirectional operations between a single Subversion tree and git
 180Usage: $0 <command> [options] [arguments]\n
 181
 182        print $fd "Available commands:\n" unless $cmd;
 183
 184        foreach (sort keys %cmd) {
 185                next if $cmd && $cmd ne $_;
 186                print $fd '  ',pack('A17',$_),$cmd{$_}->[1],"\n";
 187                foreach (keys %{$cmd{$_}->[2]}) {
 188                        # prints out arguments as they should be passed:
 189                        my $x = s#[:=]s$## ? '<arg>' : s#[:=]i$## ? '<num>' : '';
 190                        print $fd ' ' x 21, join(', ', map { length $_ > 1 ?
 191                                                        "--$_" : "-$_" }
 192                                                split /\|/,$_)," $x\n";
 193                }
 194        }
 195        print $fd <<"";
 196\nGIT_SVN_ID may be set in the environment or via the --id/-i switch to an
 197arbitrary identifier if you're tracking multiple SVN branches/repositories in
 198one git repository and want to keep them separate.  See git-svn(1) for more
 199information.
 200
 201        exit $exit;
 202}
 203
 204sub version {
 205        print "git-svn version $VERSION (svn $SVN::Core::VERSION)\n";
 206        exit 0;
 207}
 208
 209sub cmd_rebuild {
 210        my $url = shift;
 211        my $gs = $url ? Git::SVN->init($url)
 212                      : eval { Git::SVN->new };
 213        $gs ||= Git::SVN->_new;
 214        if (!verify_ref($gs->refname.'^0')) {
 215                $gs->copy_remote_ref;
 216        }
 217
 218        my ($rev_list, $ctx) = command_output_pipe("rev-list", $gs->refname);
 219        my $latest;
 220        my $svn_uuid;
 221        while (<$rev_list>) {
 222                chomp;
 223                my $c = $_;
 224                fatal "Non-SHA1: $c\n" unless $c =~ /^$sha1$/o;
 225                my ($url, $rev, $uuid) = cmt_metadata($c);
 226
 227                # ignore merges (from set-tree)
 228                next if (!defined $rev || !$uuid);
 229
 230                # if we merged or otherwise started elsewhere, this is
 231                # how we break out of it
 232                if ((defined $svn_uuid && ($uuid ne $svn_uuid)) ||
 233                    ($gs->{url} && $url && ($url ne $gs->{url}))) {
 234                        next;
 235                }
 236
 237                unless (defined $latest) {
 238                        if (!$gs->{url} && !$url) {
 239                                fatal "SVN repository location required\n";
 240                        }
 241                        $gs = Git::SVN->init($url);
 242                        $latest = $rev;
 243                }
 244                $gs->rev_db_set($rev, $c);
 245                print "r$rev = $c\n";
 246        }
 247        command_close_pipe($rev_list, $ctx);
 248}
 249
 250sub do_git_init_db {
 251        unless (-d $ENV{GIT_DIR}) {
 252                my @init_db = ('init');
 253                push @init_db, "--template=$_template" if defined $_template;
 254                push @init_db, "--shared" if defined $_shared;
 255                command_noisy(@init_db);
 256        }
 257}
 258
 259sub cmd_init {
 260        my $url = shift or die "SVN repository location required " .
 261                                "as a command-line argument\n";
 262        if (my $repo_path = shift) {
 263                unless (-d $repo_path) {
 264                        mkpath([$repo_path]);
 265                }
 266                chdir $repo_path or croak $!;
 267                $ENV{GIT_DIR} = $repo_path . "/.git";
 268        }
 269        do_git_init_db();
 270
 271        Git::SVN->init($url);
 272}
 273
 274sub cmd_fetch {
 275        my $gs = Git::SVN->new;
 276        $gs->fetch(@_);
 277        if ($gs->{last_commit} && !verify_ref('refs/heads/master^0')) {
 278                command_noisy(qw(update-ref refs/heads/master),
 279                              $gs->{last_commit});
 280        }
 281}
 282
 283sub cmd_set_tree {
 284        my (@commits) = @_;
 285        if ($_stdin || !@commits) {
 286                print "Reading from stdin...\n";
 287                @commits = ();
 288                while (<STDIN>) {
 289                        if (/\b($sha1_short)\b/o) {
 290                                unshift @commits, $1;
 291                        }
 292                }
 293        }
 294        my @revs;
 295        foreach my $c (@commits) {
 296                my @tmp = command('rev-parse',$c);
 297                if (scalar @tmp == 1) {
 298                        push @revs, $tmp[0];
 299                } elsif (scalar @tmp > 1) {
 300                        push @revs, reverse(command('rev-list',@tmp));
 301                } else {
 302                        fatal "Failed to rev-parse $c\n";
 303                }
 304        }
 305        my $gs = Git::SVN->new;
 306        my ($r_last, $cmt_last) = $gs->last_rev_commit;
 307        $gs->fetch;
 308        if ($r_last != $gs->{last_rev}) {
 309                fatal "There are new revisions that were fetched ",
 310                      "and need to be merged (or acknowledged) ",
 311                      "before committing.\nlast rev: $r_last\n",
 312                      " current: $gs->{last_rev}\n";
 313        }
 314        $gs->set_tree($_) foreach @revs;
 315        print "Done committing ",scalar @revs," revisions to SVN\n";
 316}
 317
 318sub cmd_dcommit {
 319        my $head = shift;
 320        my $gs = Git::SVN->new;
 321        $head ||= 'HEAD';
 322        my @refs = command(qw/rev-list --no-merges/, $gs->refname."..$head");
 323        my $last_rev;
 324        foreach my $d (reverse @refs) {
 325                if (!verify_ref("$d~1")) {
 326                        fatal "Commit $d\n",
 327                              "has no parent commit, and therefore ",
 328                              "nothing to diff against.\n",
 329                              "You should be working from a repository ",
 330                              "originally created by git-svn\n";
 331                }
 332                unless (defined $last_rev) {
 333                        (undef, $last_rev, undef) = cmt_metadata("$d~1");
 334                        unless (defined $last_rev) {
 335                                fatal "Unable to extract revision information ",
 336                                      "from commit $d~1\n";
 337                        }
 338                }
 339                if ($_dry_run) {
 340                        print "diff-tree $d~1 $d\n";
 341                } else {
 342                        my $ra = $gs->ra;
 343                        my $pool = SVN::Pool->new;
 344                        my %ed_opts = ( r => $last_rev,
 345                                        ra => $ra->dup,
 346                                        svn_path => $ra->{svn_path} );
 347                        my $ed = SVN::Git::Editor->new(\%ed_opts,
 348                                         $ra->get_commit_editor($::_message,
 349                                         sub { print "Committed r$_[0]\n";
 350                                               $last_rev = $_[0]; }),
 351                                         $pool);
 352                        my $mods = $ed->apply_diff("$d~1", $d);
 353                        if (@$mods == 0) {
 354                                print "No changes\n$d~1 == $d\n";
 355                        }
 356                }
 357        }
 358        return if $_dry_run;
 359        $gs->fetch;
 360        # we always want to rebase against the current HEAD, not any
 361        # head that was passed to us
 362        my @diff = command('diff-tree', 'HEAD', $gs->refname, '--');
 363        my @finish;
 364        if (@diff) {
 365                @finish = qw/rebase/;
 366                push @finish, qw/--merge/ if $_merge;
 367                push @finish, "--strategy=$_strategy" if $_strategy;
 368                print STDERR "W: HEAD and ", $gs->refname, " differ, ",
 369                             "using @finish:\n", "@diff";
 370        } else {
 371                print "No changes between current HEAD and ",
 372                      $gs->refname, "\nResetting to the latest ",
 373                      $gs->refname, "\n";
 374                @finish = qw/reset --mixed/;
 375        }
 376        command_noisy(@finish, $gs->refname);
 377}
 378
 379sub cmd_show_ignore {
 380        my $gs = Git::SVN->new;
 381        my $r = (defined $_revision ? $_revision : $gs->ra->get_latest_revnum);
 382        $gs->traverse_ignore(\*STDOUT, '', $r);
 383}
 384
 385sub cmd_multi_init {
 386        my $url = shift;
 387        unless (defined $_trunk || defined $_branches || defined $_tags) {
 388                usage(1);
 389        }
 390        do_git_init_db();
 391        $_prefix = '' unless defined $_prefix;
 392        $url =~ s#/+$## if defined $url;
 393        if (defined $_trunk) {
 394                my $trunk_ref = $_prefix . 'trunk';
 395                # try both old-style and new-style lookups:
 396                my $gs_trunk = eval { Git::SVN->new($trunk_ref) };
 397                unless ($gs_trunk) {
 398                        my ($trunk_url, $trunk_path) =
 399                                              complete_svn_url($url, $_trunk);
 400                        $gs_trunk = Git::SVN->init($trunk_url, $trunk_path,
 401                                                   undef, $trunk_ref);
 402                }
 403        }
 404        return unless defined $_branches || defined $_tags;
 405        my $ra = $url ? Git::SVN::Ra->new($url) : undef;
 406        complete_url_ls_init($ra, $_branches, '--branches/-b', $_prefix);
 407        complete_url_ls_init($ra, $_tags, '--tags/-t', $_prefix . 'tags/');
 408}
 409
 410sub cmd_multi_fetch {
 411        my @gs;
 412        foreach (command(qw/config -l/)) {
 413                next unless m!^svn-remote\.(.+)\.fetch=
 414                              \s*(.*)\s*:\s*refs/remotes/(.+)\s*$!x;
 415                my ($repo_id, $path, $ref_id) = ($1, $2, $3);
 416                push @gs, Git::SVN->new($ref_id, $repo_id, $path);
 417        }
 418        foreach (@gs) {
 419                $_->fetch;
 420        }
 421}
 422
 423# this command is special because it requires no metadata
 424sub cmd_commit_diff {
 425        my ($ta, $tb, $url) = @_;
 426        my $usage = "Usage: $0 commit-diff -r<revision> ".
 427                    "<tree-ish> <tree-ish> [<URL>]\n";
 428        fatal($usage) if (!defined $ta || !defined $tb);
 429        if (!defined $url) {
 430                my $gs = eval { Git::SVN->new };
 431                if (!$gs) {
 432                        fatal("Needed URL or usable git-svn --id in ",
 433                              "the command-line\n", $usage);
 434                }
 435                $url = $gs->{url};
 436        }
 437        unless (defined $_revision) {
 438                fatal("-r|--revision is a required argument\n", $usage);
 439        }
 440        if (defined $_message && defined $_file) {
 441                fatal("Both --message/-m and --file/-F specified ",
 442                      "for the commit message.\n",
 443                      "I have no idea what you mean\n");
 444        }
 445        if (defined $_file) {
 446                $_message = file_to_s($_file);
 447        } else {
 448                $_message ||= get_commit_entry($tb)->{log};
 449        }
 450        my $ra ||= Git::SVN::Ra->new($url);
 451        my $r = $_revision;
 452        if ($r eq 'HEAD') {
 453                $r = $ra->get_latest_revnum;
 454        } elsif ($r !~ /^\d+$/) {
 455                die "revision argument: $r not understood by git-svn\n";
 456        }
 457        my $pool = SVN::Pool->new;
 458        my %ed_opts = ( r => $r,
 459                        ra => $ra->dup,
 460                        svn_path => $ra->{svn_path} );
 461        my $ed = SVN::Git::Editor->new(\%ed_opts,
 462                                       $ra->get_commit_editor($_message,
 463                                         sub { print "Committed r$_[0]\n" }),
 464                                       $pool);
 465        my $mods = $ed->apply_diff($ta, $tb);
 466        if (@$mods == 0) {
 467                print "No changes\n$ta == $tb\n";
 468        }
 469        $pool->clear;
 470}
 471
 472########################### utility functions #########################
 473
 474sub complete_svn_url {
 475        my ($url, $path) = @_;
 476        $path =~ s#/+$##;
 477        if ($path !~ m#^[a-z\+]+://#) {
 478                if (!defined $url || $url !~ m#^[a-z\+]+://#) {
 479                        fatal("E: '$path' is not a complete URL ",
 480                              "and a separate URL is not specified\n");
 481                }
 482                return ($url, $path);
 483        }
 484        return ($path, '');
 485}
 486
 487sub complete_url_ls_init {
 488        my ($ra, $repo_path, $switch, $pfx) = @_;
 489        unless ($repo_path) {
 490                print STDERR "W: $switch not specified\n";
 491                return;
 492        }
 493        $repo_path =~ s#/+$##;
 494        if ($repo_path =~ m#^[a-z\+]+://#) {
 495                $ra = Git::SVN::Ra->new($repo_path);
 496                $repo_path = '';
 497        } else {
 498                $repo_path =~ s#^/+##;
 499                unless ($ra) {
 500                        fatal("E: '$repo_path' is not a complete URL ",
 501                              "and a separate URL is not specified\n");
 502                }
 503        }
 504        my $r = defined $_revision ? $_revision : $ra->get_latest_revnum;
 505        my ($dirent, undef, undef) = $ra->get_dir($repo_path, $r);
 506        my $url = $ra->{url};
 507        foreach my $d (sort keys %$dirent) {
 508                next if ($dirent->{$d}->kind != $SVN::Node::dir);
 509                my $path =  "$repo_path/$d";
 510                my $ref = "$pfx$d";
 511                my $gs = eval { Git::SVN->new($ref) };
 512                # don't try to init already existing refs
 513                unless ($gs) {
 514                        print "init $url/$path => $ref\n";
 515                        Git::SVN->init($url, $path, undef, $ref);
 516                }
 517        }
 518}
 519
 520sub verify_ref {
 521        my ($ref) = @_;
 522        eval { command_oneline([ 'rev-parse', '--verify', $ref ],
 523                               { STDERR => 0 }); };
 524}
 525
 526sub get_tree_from_treeish {
 527        my ($treeish) = @_;
 528        # $treeish can be a symbolic ref, too:
 529        my $type = command_oneline(qw/cat-file -t/, $treeish);
 530        my $expected;
 531        while ($type eq 'tag') {
 532                ($treeish, $type) = command(qw/cat-file tag/, $treeish);
 533        }
 534        if ($type eq 'commit') {
 535                $expected = (grep /^tree /, command(qw/cat-file commit/,
 536                                                    $treeish))[0];
 537                ($expected) = ($expected =~ /^tree ($sha1)$/o);
 538                die "Unable to get tree from $treeish\n" unless $expected;
 539        } elsif ($type eq 'tree') {
 540                $expected = $treeish;
 541        } else {
 542                die "$treeish is a $type, expected tree, tag or commit\n";
 543        }
 544        return $expected;
 545}
 546
 547sub get_commit_entry {
 548        my ($treeish) = shift;
 549        my %log_entry = ( log => '', tree => get_tree_from_treeish($treeish) );
 550        my $commit_editmsg = "$ENV{GIT_DIR}/COMMIT_EDITMSG";
 551        my $commit_msg = "$ENV{GIT_DIR}/COMMIT_MSG";
 552        open my $log_fh, '>', $commit_editmsg or croak $!;
 553
 554        my $type = command_oneline(qw/cat-file -t/, $treeish);
 555        if ($type eq 'commit' || $type eq 'tag') {
 556                my ($msg_fh, $ctx) = command_output_pipe('cat-file',
 557                                                         $type, $treeish);
 558                my $in_msg = 0;
 559                while (<$msg_fh>) {
 560                        if (!$in_msg) {
 561                                $in_msg = 1 if (/^\s*$/);
 562                        } elsif (/^git-svn-id: /) {
 563                                # skip this for now, we regenerate the
 564                                # correct one on re-fetch anyways
 565                                # TODO: set *:merge properties or like...
 566                        } else {
 567                                print $log_fh $_ or croak $!;
 568                        }
 569                }
 570                command_close_pipe($msg_fh, $ctx);
 571        }
 572        close $log_fh or croak $!;
 573
 574        if ($_edit || ($type eq 'tree')) {
 575                my $editor = $ENV{VISUAL} || $ENV{EDITOR} || 'vi';
 576                # TODO: strip out spaces, comments, like git-commit.sh
 577                system($editor, $commit_editmsg);
 578        }
 579        rename $commit_editmsg, $commit_msg or croak $!;
 580        open $log_fh, '<', $commit_msg or croak $!;
 581        { local $/; chomp($log_entry{log} = <$log_fh>); }
 582        close $log_fh or croak $!;
 583        unlink $commit_msg;
 584        \%log_entry;
 585}
 586
 587sub s_to_file {
 588        my ($str, $file, $mode) = @_;
 589        open my $fd,'>',$file or croak $!;
 590        print $fd $str,"\n" or croak $!;
 591        close $fd or croak $!;
 592        chmod ($mode &~ umask, $file) if (defined $mode);
 593}
 594
 595sub file_to_s {
 596        my $file = shift;
 597        open my $fd,'<',$file or croak "$!: file: $file\n";
 598        local $/;
 599        my $ret = <$fd>;
 600        close $fd or croak $!;
 601        $ret =~ s/\s*$//s;
 602        return $ret;
 603}
 604
 605# '<svn username> = real-name <email address>' mapping based on git-svnimport:
 606sub load_authors {
 607        open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
 608        my $log = $cmd eq 'log';
 609        while (<$authors>) {
 610                chomp;
 611                next unless /^(\S+?|\(no author\))\s*=\s*(.+?)\s*<(.+)>\s*$/;
 612                my ($user, $name, $email) = ($1, $2, $3);
 613                if ($log) {
 614                        $Git::SVN::Log::rusers{"$name <$email>"} = $user;
 615                } else {
 616                        $users{$user} = [$name, $email];
 617                }
 618        }
 619        close $authors or croak $!;
 620}
 621
 622# convert GetOpt::Long specs for use by git-config
 623sub read_repo_config {
 624        return unless -d $ENV{GIT_DIR};
 625        my $opts = shift;
 626        foreach my $o (keys %$opts) {
 627                my $v = $opts->{$o};
 628                my ($key) = ($o =~ /^([a-z\-]+)/);
 629                $key =~ s/-//g;
 630                my $arg = 'git-config';
 631                $arg .= ' --int' if ($o =~ /[:=]i$/);
 632                $arg .= ' --bool' if ($o !~ /[:=][sfi]$/);
 633                if (ref $v eq 'ARRAY') {
 634                        chomp(my @tmp = `$arg --get-all svn.$key`);
 635                        @$v = @tmp if @tmp;
 636                } else {
 637                        chomp(my $tmp = `$arg --get svn.$key`);
 638                        if ($tmp && !($arg =~ / --bool/ && $tmp eq 'false')) {
 639                                $$v = $tmp;
 640                        }
 641                }
 642        }
 643}
 644
 645sub extract_metadata {
 646        my $id = shift or return (undef, undef, undef);
 647        my ($url, $rev, $uuid) = ($id =~ /^git-svn-id:\s(\S+?)\@(\d+)
 648                                                        \s([a-f\d\-]+)$/x);
 649        if (!defined $rev || !$uuid || !$url) {
 650                # some of the original repositories I made had
 651                # identifiers like this:
 652                ($rev, $uuid) = ($id =~/^git-svn-id:\s(\d+)\@([a-f\d\-]+)/);
 653        }
 654        return ($url, $rev, $uuid);
 655}
 656
 657sub cmt_metadata {
 658        return extract_metadata((grep(/^git-svn-id: /,
 659                command(qw/cat-file commit/, shift)))[-1]);
 660}
 661
 662sub get_commit_time {
 663        my $cmt = shift;
 664        my $fh = command_output_pipe(qw/rev-list --pretty=raw -n1/, $cmt);
 665        while (<$fh>) {
 666                /^committer\s(?:.+) (\d+) ([\-\+]?\d+)$/ or next;
 667                my ($s, $tz) = ($1, $2);
 668                if ($tz =~ s/^\+//) {
 669                        $s += tz_to_s_offset($tz);
 670                } elsif ($tz =~ s/^\-//) {
 671                        $s -= tz_to_s_offset($tz);
 672                }
 673                close $fh;
 674                return $s;
 675        }
 676        die "Can't get commit time for commit: $cmt\n";
 677}
 678
 679sub tz_to_s_offset {
 680        my ($tz) = @_;
 681        $tz =~ s/(\d\d)$//;
 682        return ($1 * 60) + ($tz * 3600);
 683}
 684
 685package Git::SVN;
 686use strict;
 687use warnings;
 688use vars qw/$default_repo_id/;
 689use Carp qw/croak/;
 690use File::Path qw/mkpath/;
 691use IPC::Open3;
 692
 693# properties that we do not log:
 694my %SKIP_PROP;
 695BEGIN {
 696        %SKIP_PROP = map { $_ => 1 } qw/svn:wc:ra_dav:version-url
 697                                        svn:special svn:executable
 698                                        svn:entry:committed-rev
 699                                        svn:entry:last-author
 700                                        svn:entry:uuid
 701                                        svn:entry:committed-date/;
 702}
 703
 704# we allow dashes, unlike remotes2config.sh
 705sub sanitize_remote_name {
 706        my ($name) = @_;
 707        $name =~ tr/A-Za-z0-9-/./c;
 708        $name;
 709}
 710
 711sub init {
 712        my ($class, $url, $path, $repo_id, $ref_id) = @_;
 713        my $self = _new($class, $repo_id, $ref_id, $path);
 714        mkpath([$self->{dir}]);
 715        if (defined $url) {
 716                $url =~ s!/+$!!; # strip trailing slash
 717                my $orig_url = eval {
 718                        command_oneline('config', '--get',
 719                                        "svn-remote.$repo_id.url")
 720                };
 721                if ($orig_url) {
 722                        if ($orig_url ne $url) {
 723                                die "svn-remote.$repo_id.url already set: ",
 724                                    "$orig_url\nwanted to set to: $url\n";
 725                        }
 726                } else {
 727                        command_noisy('config',
 728                                      "svn-remote.$repo_id.url", $url);
 729                }
 730                command_noisy('config', '--add',
 731                              "svn-remote.$repo_id.fetch",
 732                              "$path:".$self->refname);
 733        }
 734        $self->{url} = $url;
 735        unless (-f $self->{db_path}) {
 736                open my $fh, '>>', $self->{db_path} or croak $!;
 737                close $fh or croak $!;
 738        }
 739        $self;
 740}
 741
 742sub find_ref {
 743        my ($ref_id) = @_;
 744        foreach (command(qw/config -l/)) {
 745                next unless m!^svn-remote\.(.+)\.fetch=
 746                              \s*(.*)\s*:\s*refs/remotes/(.+)\s*$!x;
 747                my ($repo_id, $path, $ref) = ($1, $2, $3);
 748                if ($ref eq $ref_id) {
 749                        $path = '' if ($path =~ m#^\./?#);
 750                        return ($repo_id, $path);
 751                }
 752        }
 753        (undef, undef, undef);
 754}
 755
 756sub new {
 757        my ($class, $ref_id, $repo_id, $path) = @_;
 758        if (defined $ref_id && !defined $repo_id && !defined $path) {
 759                ($repo_id, $path) = find_ref($ref_id);
 760                if (!defined $repo_id) {
 761                        die "Could not find a \"svn-remote.*.fetch\" key ",
 762                            "in the repository configuration matching: ",
 763                            "refs/remotes/$ref_id\n";
 764                }
 765        }
 766        my $self = _new($class, $repo_id, $ref_id, $path);
 767        $self->{url} = command_oneline('config', '--get',
 768                                       "svn-remote.$repo_id.url") or
 769                  die "Failed to read \"svn-remote.$repo_id.url\" in config\n";
 770        $self;
 771}
 772
 773sub refname { "refs/remotes/$_[0]->{ref_id}" }
 774
 775sub ra {
 776        my ($self) = shift;
 777        $self->{ra} ||= Git::SVN::Ra->new($self->{url});
 778}
 779
 780sub copy_remote_ref {
 781        my ($self) = @_;
 782        my $origin = $::_cp_remote ? $::_cp_remote : 'origin';
 783        my $ref = $self->refname;
 784        if (command('ls-remote', $origin, $ref)) {
 785                command_noisy('fetch', $origin, "$ref:$ref");
 786        } elsif ($::_cp_remote && !$::_upgrade) {
 787                die "Unable to find remote reference: $ref on $origin\n";
 788        }
 789}
 790
 791sub traverse_ignore {
 792        my ($self, $fh, $path, $r) = @_;
 793        $path =~ s#^/+##g;
 794        my ($dirent, undef, $props) = $self->ra->get_dir($path, $r);
 795        my $p = $path;
 796        $p =~ s#^\Q$self->{ra}->{svn_path}\E/##;
 797        print $fh length $p ? "\n# $p\n" : "\n# /\n";
 798        if (my $s = $props->{'svn:ignore'}) {
 799                $s =~ s/[\r\n]+/\n/g;
 800                chomp $s;
 801                if (length $p == 0) {
 802                        $s =~ s#\n#\n/$p#g;
 803                        print $fh "/$s\n";
 804                } else {
 805                        $s =~ s#\n#\n/$p/#g;
 806                        print $fh "/$p/$s\n";
 807                }
 808        }
 809        foreach (sort keys %$dirent) {
 810                next if $dirent->{$_}->kind != $SVN::Node::dir;
 811                $self->traverse_ignore($fh, "$path/$_", $r);
 812        }
 813}
 814
 815# returns the newest SVN revision number and newest commit SHA1
 816sub last_rev_commit {
 817        my ($self) = @_;
 818        if (defined $self->{last_rev} && defined $self->{last_commit}) {
 819                return ($self->{last_rev}, $self->{last_commit});
 820        }
 821        my $c = ::verify_ref($self->refname.'^0');
 822        if ($c) {
 823                my $rev = (::cmt_metadata($c))[1];
 824                if (defined $rev) {
 825                        ($self->{last_rev}, $self->{last_commit}) = ($rev, $c);
 826                        return ($rev, $c);
 827                }
 828        }
 829        my $offset = -41; # from tail
 830        my $rl;
 831        open my $fh, '<', $self->{db_path} or
 832                                 croak "$self->{db_path} not readable: $!\n";
 833        seek $fh, $offset, 2;
 834        $rl = readline $fh;
 835        defined $rl or return (undef, undef);
 836        chomp $rl;
 837        while ($c ne $rl && tell $fh != 0) {
 838                $offset -= 41;
 839                seek $fh, $offset, 2;
 840                $rl = readline $fh;
 841                defined $rl or return (undef, undef);
 842                chomp $rl;
 843        }
 844        my $rev = tell $fh;
 845        croak $! if ($rev < 0);
 846        $rev =  ($rev - 41) / 41;
 847        close $fh or croak $!;
 848        ($self->{last_rev}, $self->{last_commit}) = ($rev, $c);
 849        return ($rev, $c);
 850}
 851
 852sub parse_revision {
 853        my ($self, $base) = @_;
 854        my $head = $self->ra->get_latest_revnum;
 855        if (!defined $::_revision || $::_revision eq 'BASE:HEAD') {
 856                return ($base + 1, $head) if (defined $base);
 857                return (0, $head);
 858        }
 859        return ($1, $2) if ($::_revision =~ /^(\d+):(\d+)$/);
 860        return ($::_revision, $::_revision) if ($::_revision =~ /^\d+$/);
 861        if ($::_revision =~ /^BASE:(\d+)$/) {
 862                return ($base + 1, $1) if (defined $base);
 863                return (0, $head);
 864        }
 865        return ($1, $head) if ($::_revision =~ /^(\d+):HEAD$/);
 866        die "revision argument: $::_revision not understood by git-svn\n",
 867                "Try using the command-line svn client instead\n";
 868}
 869
 870sub tmp_index_do {
 871        my ($self, $sub) = @_;
 872        my $old_index = $ENV{GIT_INDEX_FILE};
 873        $ENV{GIT_INDEX_FILE} = $self->{index};
 874        my @ret = &$sub;
 875        if ($old_index) {
 876                $ENV{GIT_INDEX_FILE} = $old_index;
 877        } else {
 878                delete $ENV{GIT_INDEX_FILE};
 879        }
 880        wantarray ? @ret : $ret[0];
 881}
 882
 883sub assert_index_clean {
 884        my ($self, $treeish) = @_;
 885
 886        $self->tmp_index_do(sub {
 887                command_noisy('read-tree', $treeish) unless -e $self->{index};
 888                my $x = command_oneline('write-tree');
 889                my ($y) = (command(qw/cat-file commit/, $treeish) =~
 890                           /^tree ($::sha1)/mo);
 891                if ($y ne $x) {
 892                        unlink $self->{index} or croak $!;
 893                        command_noisy('read-tree', $treeish);
 894                }
 895                $x = command_oneline('write-tree');
 896                if ($y ne $x) {
 897                        ::fatal "trees ($treeish) $y != $x\n",
 898                                "Something is seriously wrong...\n";
 899                }
 900        });
 901}
 902
 903sub get_commit_parents {
 904        my ($self, $log_entry, @parents) = @_;
 905        my (%seen, @ret, @tmp);
 906        # commit parents can be conditionally bound to a particular
 907        # svn revision via: "svn_revno=commit_sha1", filter them out here:
 908        foreach my $p (@parents) {
 909                next unless defined $p;
 910                if ($p =~ /^(\d+)=($::sha1_short)$/o) {
 911                        push @tmp, $2 if $1 == $log_entry->{revision};
 912                } else {
 913                        push @tmp, $p if $p =~ /^$::sha1_short$/o;
 914                }
 915        }
 916        if (my $cur = ::verify_ref($self->refname.'^0')) {
 917                push @tmp, $cur;
 918        }
 919        push @tmp, $_ foreach (@{$log_entry->{parents}}, @tmp);
 920        while (my $p = shift @tmp) {
 921                next if $seen{$p};
 922                $seen{$p} = 1;
 923                push @ret, $p;
 924                # MAXPARENT is defined to 16 in commit-tree.c:
 925                last if @ret >= 16;
 926        }
 927        if (@tmp) {
 928                die "r$log_entry->{revision}: No room for parents:\n\t",
 929                    join("\n\t", @tmp), "\n";
 930        }
 931        @ret;
 932}
 933
 934sub full_url {
 935        my ($self) = @_;
 936        $self->ra->{url} . (length $self->{path} ? '/' . $self->{path} : '');
 937}
 938
 939sub do_git_commit {
 940        my ($self, $log_entry, @parents) = @_;
 941        if (my $c = $self->rev_db_get($log_entry->{revision})) {
 942                croak "$log_entry->{revision} = $c already exists! ",
 943                      "Why are we refetching it?\n";
 944        }
 945        my $author = $log_entry->{author};
 946        my ($name, $email) = (defined $::users{$author} ? @{$::users{$author}}
 947                           : ($author, "$author\@".$self->ra->uuid));
 948        $ENV{GIT_AUTHOR_NAME} = $ENV{GIT_COMMITTER_NAME} = $name;
 949        $ENV{GIT_AUTHOR_EMAIL} = $ENV{GIT_COMMITTER_EMAIL} = $email;
 950        $ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_entry->{date};
 951
 952        my $tree = $log_entry->{tree};
 953        if (!defined $tree) {
 954                $tree = $self->tmp_index_do(sub {
 955                                            command_oneline('write-tree') });
 956        }
 957        die "Tree is not a valid sha1: $tree\n" if $tree !~ /^$::sha1$/o;
 958
 959        my @exec = ('git-commit-tree', $tree);
 960        foreach ($self->get_commit_parents($log_entry, @parents)) {
 961                push @exec, '-p', $_;
 962        }
 963        defined(my $pid = open3(my $msg_fh, my $out_fh, '>&STDERR', @exec))
 964                                                                   or croak $!;
 965        print $msg_fh $log_entry->{log} or croak $!;
 966        print $msg_fh "\ngit-svn-id: ", $self->full_url, '@',
 967                      $log_entry->{revision}, ' ',
 968                      $self->ra->uuid, "\n" or croak $!;
 969        $msg_fh->flush == 0 or croak $!;
 970        close $msg_fh or croak $!;
 971        chomp(my $commit = do { local $/; <$out_fh> });
 972        close $out_fh or croak $!;
 973        waitpid $pid, 0;
 974        croak $? if $?;
 975        if ($commit !~ /^$::sha1$/o) {
 976                die "Failed to commit, invalid sha1: $commit\n";
 977        }
 978
 979        command_noisy('update-ref',$self->refname, $commit);
 980        $self->rev_db_set($log_entry->{revision}, $commit);
 981
 982        $self->{last_rev} = $log_entry->{revision};
 983        $self->{last_commit} = $commit;
 984        print "r$log_entry->{revision} = $commit\n";
 985        return $commit;
 986}
 987
 988sub do_fetch {
 989        my ($self, $paths, $rev) = @_;
 990        my $ed = SVN::Git::Fetcher->new($self);
 991        my ($last_rev, @parents);
 992        if ($self->{last_commit}) {
 993                $last_rev = $self->{last_rev};
 994                $ed->{c} = $self->{last_commit};
 995                @parents = ($self->{last_commit});
 996        } else {
 997                $last_rev = $rev;
 998        }
 999        unless ($self->ra->gs_do_update($last_rev, $rev,
1000                                        $self->{path}, 1, $ed)) {
1001                die "SVN connection failed somewhere...\n";
1002        }
1003        $self->make_log_entry($rev, \@parents, $ed);
1004}
1005
1006sub write_untracked {
1007        my ($self, $rev, $fh, $untracked) = @_;
1008        my $h;
1009        print $fh "r$rev\n" or croak $!;
1010        $h = $untracked->{empty};
1011        foreach (sort keys %$h) {
1012                my $act = $h->{$_} ? '+empty_dir' : '-empty_dir';
1013                print $fh "  $act: ", uri_encode($_), "\n" or croak $!;
1014                warn "W: $act: $_\n";
1015        }
1016        foreach my $t (qw/dir_prop file_prop/) {
1017                $h = $untracked->{$t} or next;
1018                foreach my $path (sort keys %$h) {
1019                        my $ppath = $path eq '' ? '.' : $path;
1020                        foreach my $prop (sort keys %{$h->{$path}}) {
1021                                next if $SKIP_PROP{$prop};
1022                                my $v = $h->{$path}->{$prop};
1023                                if (defined $v) {
1024                                        print $fh "  +$t: ",
1025                                                  uri_encode($ppath), ' ',
1026                                                  uri_encode($prop), ' ',
1027                                                  uri_encode($v), "\n"
1028                                                  or croak $!;
1029                                } else {
1030                                        print $fh "  -$t: ",
1031                                                  uri_encode($ppath), ' ',
1032                                                  uri_encode($prop), "\n"
1033                                                  or croak $!;
1034                                }
1035                        }
1036                }
1037        }
1038        foreach my $t (qw/absent_file absent_directory/) {
1039                $h = $untracked->{$t} or next;
1040                foreach my $parent (sort keys %$h) {
1041                        foreach my $path (sort @{$h->{$parent}}) {
1042                                print $fh "  $t: ",
1043                                      uri_encode("$parent/$path"), "\n"
1044                                      or croak $!;
1045                                warn "W: $t: $parent/$path ",
1046                                     "Insufficient permissions?\n";
1047                        }
1048                }
1049        }
1050}
1051
1052sub parse_svn_date {
1053        my $date = shift || return '+0000 1970-01-01 00:00:00';
1054        my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T
1055                                            (\d\d)\:(\d\d)\:(\d\d).\d+Z$/x) or
1056                                         croak "Unable to parse date: $date\n";
1057        "+0000 $Y-$m-$d $H:$M:$S";
1058}
1059
1060sub check_author {
1061        my ($author) = @_;
1062        if (!defined $author || length $author == 0) {
1063                $author = '(no author)';
1064        }
1065        if (defined $::_authors && ! defined $::users{$author}) {
1066                die "Author: $author not defined in $::_authors file\n";
1067        }
1068        $author;
1069}
1070
1071sub make_log_entry {
1072        my ($self, $rev, $parents, $untracked) = @_;
1073        my $rp = $self->ra->rev_proplist($rev);
1074        my %log_entry = ( parents => $parents || [], revision => $rev,
1075                          revprops => $rp, log => '');
1076        open my $un, '>>', "$self->{dir}/unhandled.log" or croak $!;
1077        $self->write_untracked($rev, $un, $untracked);
1078        foreach (sort keys %$rp) {
1079                my $v = $rp->{$_};
1080                if (/^svn:(author|date|log)$/) {
1081                        $log_entry{$1} = $v;
1082                } else {
1083                        print $un "  rev_prop: ", uri_encode($_), ' ',
1084                                  uri_encode($v), "\n";
1085                }
1086        }
1087        close $un or croak $!;
1088        $log_entry{date} = parse_svn_date($log_entry{date});
1089        $log_entry{author} = check_author($log_entry{author});
1090        $log_entry{log} .= "\n";
1091        \%log_entry;
1092}
1093
1094sub fetch {
1095        my ($self, @parents) = @_;
1096        my ($last_rev, $last_commit) = $self->last_rev_commit;
1097        my ($base, $head) = $self->parse_revision($last_rev);
1098        return if ($base > $head);
1099        if (defined $last_commit) {
1100                $self->assert_index_clean($last_commit);
1101        }
1102        my $inc = 1000;
1103        my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
1104        my $err_handler = $SVN::Error::handler;
1105        $SVN::Error::handler = \&skip_unknown_revs;
1106        while (1) {
1107                my @revs;
1108                $self->ra->get_log([''], $min, $max, 0, 1, 1, sub {
1109                        my ($paths, $rev, $author, $date, $log) = @_;
1110                        push @revs, $rev });
1111                foreach (@revs) {
1112                        my $log_entry = $self->do_fetch(undef, $_);
1113                        $self->do_git_commit($log_entry, @parents);
1114                }
1115                last if $max >= $head;
1116                $min = $max + 1;
1117                $max += $inc;
1118                $max = $head if ($max > $head);
1119        }
1120        $SVN::Error::handler = $err_handler;
1121}
1122
1123sub set_tree_cb {
1124        my ($self, $log_entry, $tree, $rev, $date, $author) = @_;
1125        # TODO: enable and test optimized commits:
1126        if (0 && $rev == ($self->{last_rev} + 1)) {
1127                $log_entry->{revision} = $rev;
1128                $log_entry->{author} = $author;
1129                $self->do_git_commit($log_entry, "$rev=$tree");
1130        } else {
1131                $self->fetch("$rev=$tree");
1132        }
1133}
1134
1135sub set_tree {
1136        my ($self, $tree) = (shift, shift);
1137        my $log_entry = ::get_commit_entry($tree);
1138        unless ($self->{last_rev}) {
1139                fatal("Must have an existing revision to commit\n");
1140        }
1141        my $pool = SVN::Pool->new;
1142        my $ed = SVN::Git::Editor->new({ r => $self->{last_rev},
1143                                         ra => $self->ra->dup,
1144                                         svn_path => $self->ra->{svn_path}
1145                                       },
1146                                       $self->ra->get_commit_editor(
1147                                         $log_entry->{log}, sub {
1148                                           $self->set_tree_cb($log_entry,
1149                                                              $tree, @_);
1150                                       }),
1151                                       $pool);
1152        my $mods = $ed->apply_diff($self->{last_commit}, $tree);
1153        if (@$mods == 0) {
1154                print "No changes\nr$self->{last_rev} = $tree\n";
1155        }
1156        $pool->clear;
1157}
1158
1159sub skip_unknown_revs {
1160        my ($err) = @_;
1161        my $errno = $err->apr_err();
1162        # Maybe the branch we're tracking didn't
1163        # exist when the repo started, so it's
1164        # not an error if it doesn't, just continue
1165        #
1166        # Wonderfully consistent library, eh?
1167        # 160013 - svn:// and file://
1168        # 175002 - http(s)://
1169        # 175007 - http(s):// (this repo required authorization, too...)
1170        #   More codes may be discovered later...
1171        if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
1172                return;
1173        }
1174        croak "Error from SVN, ($errno): ", $err->expanded_message,"\n";
1175}
1176
1177# rev_db:
1178# Tie::File seems to be prone to offset errors if revisions get sparse,
1179# it's not that fast, either.  Tie::File is also not in Perl 5.6.  So
1180# one of my favorite modules is out :<  Next up would be one of the DBM
1181# modules, but I'm not sure which is most portable...  So I'll just
1182# go with something that's plain-text, but still capable of
1183# being randomly accessed.  So here's my ultra-simple fixed-width
1184# database.  All records are 40 characters + "\n", so it's easy to seek
1185# to a revision: (41 * rev) is the byte offset.
1186# A record of 40 0s denotes an empty revision.
1187# And yes, it's still pretty fast (faster than Tie::File).
1188
1189sub rev_db_set {
1190        my ($self, $rev, $commit) = @_;
1191        length $commit == 40 or croak "arg3 must be a full SHA1 hexsum\n";
1192        open my $fh, '+<', $self->{db_path} or croak $!;
1193        my $offset = $rev * 41;
1194        # assume that append is the common case:
1195        seek $fh, 0, 2 or croak $!;
1196        my $pos = tell $fh;
1197        if ($pos < $offset) {
1198                print $fh (('0' x 40),"\n") x (($offset - $pos) / 41)
1199                  or croak $!;
1200        }
1201        seek $fh, $offset, 0 or croak $!;
1202        print $fh $commit,"\n" or croak $!;
1203        close $fh or croak $!;
1204}
1205
1206sub rev_db_get {
1207        my ($self, $rev) = @_;
1208        my $ret;
1209        my $offset = $rev * 41;
1210        open my $fh, '<', $self->{db_path} or croak $!;
1211        if (seek $fh, $offset, 0) {
1212                $ret = readline $fh;
1213                if (defined $ret) {
1214                        chomp $ret;
1215                        $ret = undef if ($ret =~ /^0{40}$/);
1216                }
1217        }
1218        close $fh or croak $!;
1219        $ret;
1220}
1221
1222sub _new {
1223        my ($class, $repo_id, $ref_id, $path) = @_;
1224        unless (defined $repo_id && length $repo_id) {
1225                $repo_id = $Git::SVN::default_repo_id;
1226        }
1227        unless (defined $ref_id && length $ref_id) {
1228                $_[2] = $ref_id = $repo_id;
1229        }
1230        $_[1] = $repo_id = sanitize_remote_name($repo_id);
1231        my $dir = "$ENV{GIT_DIR}/svn/$ref_id";
1232        $_[3] = $path = '' unless (defined $path);
1233        bless { ref_id => $ref_id, dir => $dir, index => "$dir/index",
1234                path => $path,
1235                db_path => "$dir/.rev_db", repo_id => $repo_id }, $class;
1236}
1237
1238sub uri_encode {
1239        my ($f) = @_;
1240        $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg;
1241        $f
1242}
1243
1244package Git::SVN::Prompt;
1245use strict;
1246use warnings;
1247require SVN::Core;
1248use vars qw/$_no_auth_cache $_username/;
1249
1250sub simple {
1251        my ($cred, $realm, $default_username, $may_save, $pool) = @_;
1252        $may_save = undef if $_no_auth_cache;
1253        $default_username = $_username if defined $_username;
1254        if (defined $default_username && length $default_username) {
1255                if (defined $realm && length $realm) {
1256                        print STDERR "Authentication realm: $realm\n";
1257                        STDERR->flush;
1258                }
1259                $cred->username($default_username);
1260        } else {
1261                username($cred, $realm, $may_save, $pool);
1262        }
1263        $cred->password(_read_password("Password for '" .
1264                                       $cred->username . "': ", $realm));
1265        $cred->may_save($may_save);
1266        $SVN::_Core::SVN_NO_ERROR;
1267}
1268
1269sub ssl_server_trust {
1270        my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
1271        $may_save = undef if $_no_auth_cache;
1272        print STDERR "Error validating server certificate for '$realm':\n";
1273        if ($failures & $SVN::Auth::SSL::UNKNOWNCA) {
1274                print STDERR " - The certificate is not issued by a trusted ",
1275                      "authority. Use the\n",
1276                      "   fingerprint to validate the certificate manually!\n";
1277        }
1278        if ($failures & $SVN::Auth::SSL::CNMISMATCH) {
1279                print STDERR " - The certificate hostname does not match.\n";
1280        }
1281        if ($failures & $SVN::Auth::SSL::NOTYETVALID) {
1282                print STDERR " - The certificate is not yet valid.\n";
1283        }
1284        if ($failures & $SVN::Auth::SSL::EXPIRED) {
1285                print STDERR " - The certificate has expired.\n";
1286        }
1287        if ($failures & $SVN::Auth::SSL::OTHER) {
1288                print STDERR " - The certificate has an unknown error.\n";
1289        }
1290        printf STDERR
1291                "Certificate information:\n".
1292                " - Hostname: %s\n".
1293                " - Valid: from %s until %s\n".
1294                " - Issuer: %s\n".
1295                " - Fingerprint: %s\n",
1296                map $cert_info->$_, qw(hostname valid_from valid_until
1297                                       issuer_dname fingerprint);
1298        my $choice;
1299prompt:
1300        print STDERR $may_save ?
1301              "(R)eject, accept (t)emporarily or accept (p)ermanently? " :
1302              "(R)eject or accept (t)emporarily? ";
1303        STDERR->flush;
1304        $choice = lc(substr(<STDIN> || 'R', 0, 1));
1305        if ($choice =~ /^t$/i) {
1306                $cred->may_save(undef);
1307        } elsif ($choice =~ /^r$/i) {
1308                return -1;
1309        } elsif ($may_save && $choice =~ /^p$/i) {
1310                $cred->may_save($may_save);
1311        } else {
1312                goto prompt;
1313        }
1314        $cred->accepted_failures($failures);
1315        $SVN::_Core::SVN_NO_ERROR;
1316}
1317
1318sub ssl_client_cert {
1319        my ($cred, $realm, $may_save, $pool) = @_;
1320        $may_save = undef if $_no_auth_cache;
1321        print STDERR "Client certificate filename: ";
1322        STDERR->flush;
1323        chomp(my $filename = <STDIN>);
1324        $cred->cert_file($filename);
1325        $cred->may_save($may_save);
1326        $SVN::_Core::SVN_NO_ERROR;
1327}
1328
1329sub ssl_client_cert_pw {
1330        my ($cred, $realm, $may_save, $pool) = @_;
1331        $may_save = undef if $_no_auth_cache;
1332        $cred->password(_read_password("Password: ", $realm));
1333        $cred->may_save($may_save);
1334        $SVN::_Core::SVN_NO_ERROR;
1335}
1336
1337sub username {
1338        my ($cred, $realm, $may_save, $pool) = @_;
1339        $may_save = undef if $_no_auth_cache;
1340        if (defined $realm && length $realm) {
1341                print STDERR "Authentication realm: $realm\n";
1342        }
1343        my $username;
1344        if (defined $_username) {
1345                $username = $_username;
1346        } else {
1347                print STDERR "Username: ";
1348                STDERR->flush;
1349                chomp($username = <STDIN>);
1350        }
1351        $cred->username($username);
1352        $cred->may_save($may_save);
1353        $SVN::_Core::SVN_NO_ERROR;
1354}
1355
1356sub _read_password {
1357        my ($prompt, $realm) = @_;
1358        print STDERR $prompt;
1359        STDERR->flush;
1360        require Term::ReadKey;
1361        Term::ReadKey::ReadMode('noecho');
1362        my $password = '';
1363        while (defined(my $key = Term::ReadKey::ReadKey(0))) {
1364                last if $key =~ /[\012\015]/; # \n\r
1365                $password .= $key;
1366        }
1367        Term::ReadKey::ReadMode('restore');
1368        print STDERR "\n";
1369        STDERR->flush;
1370        $password;
1371}
1372
1373package main;
1374
1375sub uri_encode {
1376        my ($f) = @_;
1377        $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg;
1378        $f
1379}
1380
1381sub uri_decode {
1382        my ($f) = @_;
1383        $f =~ tr/+/ /;
1384        $f =~ s/%([A-F0-9]{2})/chr hex($1)/ge;
1385        $f
1386}
1387
1388sub revisions_eq {
1389        my ($path, $r0, $r1) = @_;
1390        return 1 if $r0 == $r1;
1391        my $nr = 0;
1392        # should be OK to use Pool here (r1 - r0) should be small
1393        $SVN->get_log([$path], $r0, $r1, 0, 0, 1, sub {$nr++});
1394        return 0 if ($nr > 1);
1395        return 1;
1396}
1397
1398sub libsvn_find_parent_branch {
1399        my ($paths, $rev, $author, $date, $log) = @_;
1400        my $svn_path = '/'.$SVN->{svn_path};
1401
1402        # look for a parent from another branch:
1403        my $i = $paths->{$svn_path} or return;
1404        my $branch_from = $i->copyfrom_path or return;
1405        my $r = $i->copyfrom_rev;
1406        print STDERR  "Found possible branch point: ",
1407                                "$branch_from => $svn_path, $r\n";
1408        $branch_from =~ s#^/##;
1409        my $l_map = {};
1410        read_url_paths_all($l_map, '', "$GIT_DIR/svn");
1411        my $url = $SVN->{repos_root};
1412        defined $l_map->{$url} or return;
1413        my $id = $l_map->{$url}->{$branch_from};
1414        if (!defined $id && $_follow_parent) {
1415                print STDERR "Following parent: $branch_from\@$r\n";
1416                # auto create a new branch and follow it
1417                $id = basename($branch_from);
1418                $id .= '@'.$r if -r "$GIT_DIR/svn/$id";
1419                while (-r "$GIT_DIR/svn/$id") {
1420                        # just grow a tail if we're not unique enough :x
1421                        $id .= '-';
1422                }
1423        }
1424        return unless defined $id;
1425
1426        my ($r0, $parent) = find_rev_before($r,$id,1);
1427        if ($_follow_parent && (!defined $r0 || !defined $parent)) {
1428                defined(my $pid = fork) or croak $!;
1429                if (!$pid) {
1430                        $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
1431                        init_vars();
1432                        $SVN_URL = "$url/$branch_from";
1433                        $SVN = undef;
1434                        setup_git_svn();
1435                        # we can't assume SVN_URL exists at r+1:
1436                        $_revision = "0:$r";
1437                        fetch_lib();
1438                        exit 0;
1439                }
1440                waitpid $pid, 0;
1441                croak $? if $?;
1442                ($r0, $parent) = find_rev_before($r,$id,1);
1443        }
1444        return unless (defined $r0 && defined $parent);
1445        if (revisions_eq($branch_from, $r0, $r)) {
1446                unlink $GIT_SVN_INDEX;
1447                print STDERR "Found branch parent: ($GIT_SVN) $parent\n";
1448                command_noisy('read-tree', $parent);
1449                unless ($SVN->can_do_switch) {
1450                        return _libsvn_new_tree($paths, $rev, $author, $date,
1451                                                $log, [$parent]);
1452                }
1453                # do_switch works with svn/trunk >= r22312, but that is not
1454                # included with SVN 1.4.2 (the latest version at the moment),
1455                # so we can't rely on it.
1456                my $ra = Git::SVN::Ra->new("$url/$branch_from");
1457                my $ed = SVN::Git::Fetcher->new({c => $parent, q => $_q });
1458                $ra->gs_do_switch($r0, $rev, '', 1, $SVN->{url}, $ed) or
1459                                   die "SVN connection failed somewhere...\n";
1460                return libsvn_log_entry($rev, $author, $date, $log, [$parent]);
1461        }
1462        print STDERR "Nope, branch point not imported or unknown\n";
1463        return undef;
1464}
1465
1466sub _libsvn_new_tree {
1467        my ($paths, $rev, $author, $date, $log, $parents) = @_;
1468        my $ed = SVN::Git::Fetcher->new({q => $_q});
1469        unless ($SVN->gs_do_update($rev, $rev, '', 1, $ed)) {
1470                die "SVN connection failed somewhere...\n";
1471        }
1472        libsvn_log_entry($rev, $author, $date, $log, $parents, $ed);
1473}
1474
1475{
1476        my $kill_stupid_warnings = $SVN::Node::none.$SVN::Node::file.
1477                                $SVN::Node::dir.$SVN::Node::unknown.
1478                                $SVN::Node::none.$SVN::Node::file.
1479                                $SVN::Node::dir.$SVN::Node::unknown.
1480                                $SVN::Auth::SSL::CNMISMATCH.
1481                                $SVN::Auth::SSL::NOTYETVALID.
1482                                $SVN::Auth::SSL::EXPIRED.
1483                                $SVN::Auth::SSL::UNKNOWNCA.
1484                                $SVN::Auth::SSL::OTHER;
1485}
1486
1487package SVN::Git::Fetcher;
1488use vars qw/@ISA/;
1489use strict;
1490use warnings;
1491use Carp qw/croak/;
1492use IO::File qw//;
1493
1494# file baton members: path, mode_a, mode_b, pool, fh, blob, base
1495sub new {
1496        my ($class, $git_svn) = @_;
1497        my $self = SVN::Delta::Editor->new;
1498        bless $self, $class;
1499        $self->{c} = $git_svn->{last_commit} if exists $git_svn->{last_commit};
1500        if (length $git_svn->{path}) {
1501                $self->{path_strip} = qr/\Q$git_svn->{path}\E\/?/;
1502        }
1503        $self->{empty} = {};
1504        $self->{dir_prop} = {};
1505        $self->{file_prop} = {};
1506        $self->{absent_dir} = {};
1507        $self->{absent_file} = {};
1508        ($self->{gui}, $self->{ctx}) = $git_svn->tmp_index_do(
1509               sub { command_input_pipe(qw/update-index -z --index-info/) } );
1510        require Digest::MD5;
1511        $self;
1512}
1513
1514sub open_root {
1515        { path => '' };
1516}
1517
1518sub open_directory {
1519        my ($self, $path, $pb, $rev) = @_;
1520        { path => $path };
1521}
1522
1523sub git_path {
1524        my ($self, $path) = @_;
1525        $path =~ s!$self->{path_strip}!! if $self->{path_strip};
1526        $path;
1527}
1528
1529sub delete_entry {
1530        my ($self, $path, $rev, $pb) = @_;
1531        my $gui = $self->{gui};
1532
1533        my $gpath = $self->git_path($path);
1534        # remove entire directories.
1535        if (command('ls-tree', $self->{c}, '--', $gpath) =~ /^040000 tree/) {
1536                my ($ls, $ctx) = command_output_pipe(qw/ls-tree
1537                                                     -r --name-only -z/,
1538                                                     $self->{c}, '--', $gpath);
1539                local $/ = "\0";
1540                while (<$ls>) {
1541                        print $gui '0 ',0 x 40,"\t",$_ or croak $!;
1542                        print "\tD\t$_\n" unless $self->{q};
1543                }
1544                print "\tD\t$gpath/\n" unless $self->{q};
1545                command_close_pipe($ls, $ctx);
1546                $self->{empty}->{$path} = 0
1547        } else {
1548                print $gui '0 ',0 x 40,"\t",$gpath,"\0" or croak $!;
1549                print "\tD\t$gpath\n" unless $self->{q};
1550        }
1551        undef;
1552}
1553
1554sub open_file {
1555        my ($self, $path, $pb, $rev) = @_;
1556        my $gpath = $self->git_path($path);
1557        my ($mode, $blob) = (command('ls-tree', $self->{c}, '--', $gpath)
1558                             =~ /^(\d{6}) blob ([a-f\d]{40})\t/);
1559        unless (defined $mode && defined $blob) {
1560                die "$path was not found in commit $self->{c} (r$rev)\n";
1561        }
1562        { path => $path, mode_a => $mode, mode_b => $mode, blob => $blob,
1563          pool => SVN::Pool->new, action => 'M' };
1564}
1565
1566sub add_file {
1567        my ($self, $path, $pb, $cp_path, $cp_rev) = @_;
1568        my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
1569        delete $self->{empty}->{$dir};
1570        { path => $path, mode_a => 100644, mode_b => 100644,
1571          pool => SVN::Pool->new, action => 'A' };
1572}
1573
1574sub add_directory {
1575        my ($self, $path, $cp_path, $cp_rev) = @_;
1576        my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
1577        delete $self->{empty}->{$dir};
1578        $self->{empty}->{$path} = 1;
1579        { path => $path };
1580}
1581
1582sub change_dir_prop {
1583        my ($self, $db, $prop, $value) = @_;
1584        $self->{dir_prop}->{$db->{path}} ||= {};
1585        $self->{dir_prop}->{$db->{path}}->{$prop} = $value;
1586        undef;
1587}
1588
1589sub absent_directory {
1590        my ($self, $path, $pb) = @_;
1591        $self->{absent_dir}->{$pb->{path}} ||= [];
1592        push @{$self->{absent_dir}->{$pb->{path}}}, $path;
1593        undef;
1594}
1595
1596sub absent_file {
1597        my ($self, $path, $pb) = @_;
1598        $self->{absent_file}->{$pb->{path}} ||= [];
1599        push @{$self->{absent_file}->{$pb->{path}}}, $path;
1600        undef;
1601}
1602
1603sub change_file_prop {
1604        my ($self, $fb, $prop, $value) = @_;
1605        if ($prop eq 'svn:executable') {
1606                if ($fb->{mode_b} != 120000) {
1607                        $fb->{mode_b} = defined $value ? 100755 : 100644;
1608                }
1609        } elsif ($prop eq 'svn:special') {
1610                $fb->{mode_b} = defined $value ? 120000 : 100644;
1611        } else {
1612                $self->{file_prop}->{$fb->{path}} ||= {};
1613                $self->{file_prop}->{$fb->{path}}->{$prop} = $value;
1614        }
1615        undef;
1616}
1617
1618sub apply_textdelta {
1619        my ($self, $fb, $exp) = @_;
1620        my $fh = IO::File->new_tmpfile;
1621        $fh->autoflush(1);
1622        # $fh gets auto-closed() by SVN::TxDelta::apply(),
1623        # (but $base does not,) so dup() it for reading in close_file
1624        open my $dup, '<&', $fh or croak $!;
1625        my $base = IO::File->new_tmpfile;
1626        $base->autoflush(1);
1627        if ($fb->{blob}) {
1628                defined (my $pid = fork) or croak $!;
1629                if (!$pid) {
1630                        open STDOUT, '>&', $base or croak $!;
1631                        print STDOUT 'link ' if ($fb->{mode_a} == 120000);
1632                        exec qw/git-cat-file blob/, $fb->{blob} or croak $!;
1633                }
1634                waitpid $pid, 0;
1635                croak $? if $?;
1636
1637                if (defined $exp) {
1638                        seek $base, 0, 0 or croak $!;
1639                        my $md5 = Digest::MD5->new;
1640                        $md5->addfile($base);
1641                        my $got = $md5->hexdigest;
1642                        die "Checksum mismatch: $fb->{path} $fb->{blob}\n",
1643                            "expected: $exp\n",
1644                            "     got: $got\n" if ($got ne $exp);
1645                }
1646        }
1647        seek $base, 0, 0 or croak $!;
1648        $fb->{fh} = $dup;
1649        $fb->{base} = $base;
1650        [ SVN::TxDelta::apply($base, $fh, undef, $fb->{path}, $fb->{pool}) ];
1651}
1652
1653sub close_file {
1654        my ($self, $fb, $exp) = @_;
1655        my $hash;
1656        my $path = $self->git_path($fb->{path});
1657        if (my $fh = $fb->{fh}) {
1658                seek($fh, 0, 0) or croak $!;
1659                my $md5 = Digest::MD5->new;
1660                $md5->addfile($fh);
1661                my $got = $md5->hexdigest;
1662                die "Checksum mismatch: $path\n",
1663                    "expected: $exp\n    got: $got\n" if ($got ne $exp);
1664                seek($fh, 0, 0) or croak $!;
1665                if ($fb->{mode_b} == 120000) {
1666                        read($fh, my $buf, 5) == 5 or croak $!;
1667                        $buf eq 'link ' or die "$path has mode 120000",
1668                                               "but is not a link\n";
1669                }
1670                defined(my $pid = open my $out,'-|') or die "Can't fork: $!\n";
1671                if (!$pid) {
1672                        open STDIN, '<&', $fh or croak $!;
1673                        exec qw/git-hash-object -w --stdin/ or croak $!;
1674                }
1675                chomp($hash = do { local $/; <$out> });
1676                close $out or croak $!;
1677                close $fh or croak $!;
1678                $hash =~ /^[a-f\d]{40}$/ or die "not a sha1: $hash\n";
1679                close $fb->{base} or croak $!;
1680        } else {
1681                $hash = $fb->{blob} or die "no blob information\n";
1682        }
1683        $fb->{pool}->clear;
1684        my $gui = $self->{gui};
1685        print $gui "$fb->{mode_b} $hash\t$path\0" or croak $!;
1686        print "\t$fb->{action}\t$path\n" if $fb->{action} && ! $self->{q};
1687        undef;
1688}
1689
1690sub abort_edit {
1691        my $self = shift;
1692        eval { command_close_pipe($self->{gui}, $self->{ctx}) };
1693        $self->SUPER::abort_edit(@_);
1694}
1695
1696sub close_edit {
1697        my $self = shift;
1698        command_close_pipe($self->{gui}, $self->{ctx});
1699        $self->{git_commit_ok} = 1;
1700        $self->SUPER::close_edit(@_);
1701}
1702
1703package SVN::Git::Editor;
1704use vars qw/@ISA/;
1705use strict;
1706use warnings;
1707use Carp qw/croak/;
1708use IO::File;
1709
1710sub new {
1711        my $class = shift;
1712        my $git_svn = shift;
1713        my $self = SVN::Delta::Editor->new(@_);
1714        bless $self, $class;
1715        foreach (qw/svn_path r ra/) {
1716                die "$_ required!\n" unless (defined $git_svn->{$_});
1717                $self->{$_} = $git_svn->{$_};
1718        }
1719        $self->{pool} = SVN::Pool->new;
1720        $self->{bat} = { '' => $self->open_root($self->{r}, $self->{pool}) };
1721        $self->{rm} = { };
1722        require Digest::MD5;
1723        return $self;
1724}
1725
1726sub split_path {
1727        return ($_[0] =~ m#^(.*?)/?([^/]+)$#);
1728}
1729
1730sub repo_path {
1731        (defined $_[1] && length $_[1]) ? $_[1] : ''
1732}
1733
1734sub url_path {
1735        my ($self, $path) = @_;
1736        $self->{ra}->{url} . '/' . $self->repo_path($path);
1737}
1738
1739sub rmdirs {
1740        my ($self, $tree_b) = @_;
1741        my $rm = $self->{rm};
1742        delete $rm->{''}; # we never delete the url we're tracking
1743        return unless %$rm;
1744
1745        foreach (keys %$rm) {
1746                my @d = split m#/#, $_;
1747                my $c = shift @d;
1748                $rm->{$c} = 1;
1749                while (@d) {
1750                        $c .= '/' . shift @d;
1751                        $rm->{$c} = 1;
1752                }
1753        }
1754        delete $rm->{$self->{svn_path}};
1755        delete $rm->{''}; # we never delete the url we're tracking
1756        return unless %$rm;
1757
1758        my ($fh, $ctx) = command_output_pipe(
1759                                   qw/ls-tree --name-only -r -z/, $tree_b);
1760        local $/ = "\0";
1761        while (<$fh>) {
1762                chomp;
1763                my @dn = split m#/#, $_;
1764                while (pop @dn) {
1765                        delete $rm->{join '/', @dn};
1766                }
1767                unless (%$rm) {
1768                        close $fh;
1769                        return;
1770                }
1771        }
1772        command_close_pipe($fh, $ctx);
1773
1774        my ($r, $p, $bat) = ($self->{r}, $self->{pool}, $self->{bat});
1775        foreach my $d (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$rm) {
1776                $self->close_directory($bat->{$d}, $p);
1777                my ($dn) = ($d =~ m#^(.*?)/?(?:[^/]+)$#);
1778                print "\tD+\t$d/\n" unless $::_q;
1779                $self->SUPER::delete_entry($d, $r, $bat->{$dn}, $p);
1780                delete $bat->{$d};
1781        }
1782}
1783
1784sub open_or_add_dir {
1785        my ($self, $full_path, $baton) = @_;
1786        my $t = $self->{ra}->check_path($full_path, $self->{r});
1787        if ($t == $SVN::Node::none) {
1788                return $self->add_directory($full_path, $baton,
1789                                                undef, -1, $self->{pool});
1790        } elsif ($t == $SVN::Node::dir) {
1791                return $self->open_directory($full_path, $baton,
1792                                                $self->{r}, $self->{pool});
1793        }
1794        print STDERR "$full_path already exists in repository at ",
1795                "r$self->{r} and it is not a directory (",
1796                ($t == $SVN::Node::file ? 'file' : 'unknown'),"/$t)\n";
1797        exit 1;
1798}
1799
1800sub ensure_path {
1801        my ($self, $path) = @_;
1802        my $bat = $self->{bat};
1803        $path = $self->repo_path($path);
1804        return $bat->{''} unless (length $path);
1805        my @p = split m#/+#, $path;
1806        my $c = shift @p;
1807        $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''});
1808        while (@p) {
1809                my $c0 = $c;
1810                $c .= '/' . shift @p;
1811                $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0});
1812        }
1813        return $bat->{$c};
1814}
1815
1816sub A {
1817        my ($self, $m) = @_;
1818        my ($dir, $file) = split_path($m->{file_b});
1819        my $pbat = $self->ensure_path($dir);
1820        my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
1821                                        undef, -1);
1822        print "\tA\t$m->{file_b}\n" unless $::_q;
1823        $self->chg_file($fbat, $m);
1824        $self->close_file($fbat,undef,$self->{pool});
1825}
1826
1827sub C {
1828        my ($self, $m) = @_;
1829        my ($dir, $file) = split_path($m->{file_b});
1830        my $pbat = $self->ensure_path($dir);
1831        my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
1832                                $self->url_path($m->{file_a}), $self->{r});
1833        print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
1834        $self->chg_file($fbat, $m);
1835        $self->close_file($fbat,undef,$self->{pool});
1836}
1837
1838sub delete_entry {
1839        my ($self, $path, $pbat) = @_;
1840        my $rpath = $self->repo_path($path);
1841        my ($dir, $file) = split_path($rpath);
1842        $self->{rm}->{$dir} = 1;
1843        $self->SUPER::delete_entry($rpath, $self->{r}, $pbat, $self->{pool});
1844}
1845
1846sub R {
1847        my ($self, $m) = @_;
1848        my ($dir, $file) = split_path($m->{file_b});
1849        my $pbat = $self->ensure_path($dir);
1850        my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
1851                                $self->url_path($m->{file_a}), $self->{r});
1852        print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
1853        $self->chg_file($fbat, $m);
1854        $self->close_file($fbat,undef,$self->{pool});
1855
1856        ($dir, $file) = split_path($m->{file_a});
1857        $pbat = $self->ensure_path($dir);
1858        $self->delete_entry($m->{file_a}, $pbat);
1859}
1860
1861sub M {
1862        my ($self, $m) = @_;
1863        my ($dir, $file) = split_path($m->{file_b});
1864        my $pbat = $self->ensure_path($dir);
1865        my $fbat = $self->open_file($self->repo_path($m->{file_b}),
1866                                $pbat,$self->{r},$self->{pool});
1867        print "\t$m->{chg}\t$m->{file_b}\n" unless $::_q;
1868        $self->chg_file($fbat, $m);
1869        $self->close_file($fbat,undef,$self->{pool});
1870}
1871
1872sub T { shift->M(@_) }
1873
1874sub change_file_prop {
1875        my ($self, $fbat, $pname, $pval) = @_;
1876        $self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool});
1877}
1878
1879sub chg_file {
1880        my ($self, $fbat, $m) = @_;
1881        if ($m->{mode_b} =~ /755$/ && $m->{mode_a} !~ /755$/) {
1882                $self->change_file_prop($fbat,'svn:executable','*');
1883        } elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
1884                $self->change_file_prop($fbat,'svn:executable',undef);
1885        }
1886        my $fh = IO::File->new_tmpfile or croak $!;
1887        if ($m->{mode_b} =~ /^120/) {
1888                print $fh 'link ' or croak $!;
1889                $self->change_file_prop($fbat,'svn:special','*');
1890        } elsif ($m->{mode_a} =~ /^120/ && $m->{mode_b} !~ /^120/) {
1891                $self->change_file_prop($fbat,'svn:special',undef);
1892        }
1893        defined(my $pid = fork) or croak $!;
1894        if (!$pid) {
1895                open STDOUT, '>&', $fh or croak $!;
1896                exec qw/git-cat-file blob/, $m->{sha1_b} or croak $!;
1897        }
1898        waitpid $pid, 0;
1899        croak $? if $?;
1900        $fh->flush == 0 or croak $!;
1901        seek $fh, 0, 0 or croak $!;
1902
1903        my $md5 = Digest::MD5->new;
1904        $md5->addfile($fh) or croak $!;
1905        seek $fh, 0, 0 or croak $!;
1906
1907        my $exp = $md5->hexdigest;
1908        my $pool = SVN::Pool->new;
1909        my $atd = $self->apply_textdelta($fbat, undef, $pool);
1910        my $got = SVN::TxDelta::send_stream($fh, @$atd, $pool);
1911        die "Checksum mismatch\nexpected: $exp\ngot: $got\n" if ($got ne $exp);
1912        $pool->clear;
1913
1914        close $fh or croak $!;
1915}
1916
1917sub D {
1918        my ($self, $m) = @_;
1919        my ($dir, $file) = split_path($m->{file_b});
1920        my $pbat = $self->ensure_path($dir);
1921        print "\tD\t$m->{file_b}\n" unless $::_q;
1922        $self->delete_entry($m->{file_b}, $pbat);
1923}
1924
1925sub close_edit {
1926        my ($self) = @_;
1927        my ($p,$bat) = ($self->{pool}, $self->{bat});
1928        foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) {
1929                $self->close_directory($bat->{$_}, $p);
1930        }
1931        $self->SUPER::close_edit($p);
1932        $p->clear;
1933}
1934
1935sub abort_edit {
1936        my ($self) = @_;
1937        $self->SUPER::abort_edit($self->{pool});
1938        $self->{pool}->clear;
1939}
1940
1941# this drives the editor
1942sub apply_diff {
1943        my ($self, $tree_a, $tree_b) = @_;
1944        my @diff_tree = qw(diff-tree -z -r);
1945        if ($::_cp_similarity) {
1946                push @diff_tree, "-C$::_cp_similarity";
1947        } else {
1948                push @diff_tree, '-C';
1949        }
1950        push @diff_tree, '--find-copies-harder' if $::_find_copies_harder;
1951        push @diff_tree, "-l$::_l" if defined $::_l;
1952        push @diff_tree, $tree_a, $tree_b;
1953        my ($diff_fh, $ctx) = command_output_pipe(@diff_tree);
1954        my $nl = $/;
1955        local $/ = "\0";
1956        my $state = 'meta';
1957        my @mods;
1958        while (<$diff_fh>) {
1959                chomp $_; # this gets rid of the trailing "\0"
1960                if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s
1961                                        $::sha1\s($::sha1)\s
1962                                        ([MTCRAD])\d*$/xo) {
1963                        push @mods, {   mode_a => $1, mode_b => $2,
1964                                        sha1_b => $3, chg => $4 };
1965                        if ($4 =~ /^(?:C|R)$/) {
1966                                $state = 'file_a';
1967                        } else {
1968                                $state = 'file_b';
1969                        }
1970                } elsif ($state eq 'file_a') {
1971                        my $x = $mods[$#mods] or croak "Empty array\n";
1972                        if ($x->{chg} !~ /^(?:C|R)$/) {
1973                                croak "Error parsing $_, $x->{chg}\n";
1974                        }
1975                        $x->{file_a} = $_;
1976                        $state = 'file_b';
1977                } elsif ($state eq 'file_b') {
1978                        my $x = $mods[$#mods] or croak "Empty array\n";
1979                        if (exists $x->{file_a} && $x->{chg} !~ /^(?:C|R)$/) {
1980                                croak "Error parsing $_, $x->{chg}\n";
1981                        }
1982                        if (!exists $x->{file_a} && $x->{chg} =~ /^(?:C|R)$/) {
1983                                croak "Error parsing $_, $x->{chg}\n";
1984                        }
1985                        $x->{file_b} = $_;
1986                        $state = 'meta';
1987                } else {
1988                        croak "Error parsing $_\n";
1989                }
1990        }
1991        command_close_pipe($diff_fh, $ctx);
1992        $/ = $nl;
1993
1994        my %o = ( D => 1, R => 0, C => -1, A => 3, M => 3, T => 3 );
1995        foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @mods) {
1996                my $f = $m->{chg};
1997                if (defined $o{$f}) {
1998                        $self->$f($m);
1999                } else {
2000                        fatal("Invalid change type: $f\n");
2001                }
2002        }
2003        $self->rmdirs($tree_b) if $::_rmdir;
2004        if (@mods == 0) {
2005                $self->abort_edit;
2006        } else {
2007                $self->close_edit;
2008        }
2009        \@mods;
2010}
2011
2012package Git::SVN::Ra;
2013use vars qw/@ISA $config_dir/;
2014use strict;
2015use warnings;
2016my ($can_do_switch);
2017
2018BEGIN {
2019        # enforce temporary pool usage for some simple functions
2020        my $e;
2021        foreach (qw/get_latest_revnum rev_proplist get_file
2022                    check_path get_dir get_uuid get_repos_root/) {
2023                $e .= "sub $_ {
2024                        my \$self = shift;
2025                        my \$pool = SVN::Pool->new;
2026                        my \@ret = \$self->SUPER::$_(\@_,\$pool);
2027                        \$pool->clear;
2028                        wantarray ? \@ret : \$ret[0]; }\n";
2029        }
2030        eval $e;
2031}
2032
2033sub new {
2034        my ($class, $url) = @_;
2035        SVN::_Core::svn_config_ensure($config_dir, undef);
2036        my ($baton, $callbacks) = SVN::Core::auth_open_helper([
2037            SVN::Client::get_simple_provider(),
2038            SVN::Client::get_ssl_server_trust_file_provider(),
2039            SVN::Client::get_simple_prompt_provider(
2040              \&Git::SVN::Prompt::simple, 2),
2041            SVN::Client::get_ssl_client_cert_prompt_provider(
2042              \&Git::SVN::Prompt::ssl_client_cert, 2),
2043            SVN::Client::get_ssl_client_cert_pw_prompt_provider(
2044              \&Git::SVN::Prompt::ssl_client_cert_pw, 2),
2045            SVN::Client::get_username_provider(),
2046            SVN::Client::get_ssl_server_trust_prompt_provider(
2047              \&Git::SVN::Prompt::ssl_server_trust),
2048            SVN::Client::get_username_prompt_provider(
2049              \&Git::SVN::Prompt::username, 2),
2050          ]);
2051        my $config = SVN::Core::config_get_config($config_dir);
2052        my $self = SVN::Ra->new(url => $url, auth => $baton,
2053                              config => $config,
2054                              pool => SVN::Pool->new,
2055                              auth_provider_callbacks => $callbacks);
2056        $self->{svn_path} = $url;
2057        $self->{repos_root} = $self->get_repos_root;
2058        $self->{svn_path} =~ s#^\Q$self->{repos_root}\E/*##;
2059        bless $self, $class;
2060}
2061
2062sub DESTROY {
2063        my $self = shift;
2064        $self->{pool}->clear if $self->{pool};
2065        $self->SUPER::DESTROY(@_);
2066}
2067
2068sub dup {
2069        my ($self) = @_;
2070        my $dup = SVN::Ra->new(pool => SVN::Pool->new,
2071                                map { $_ => $self->{$_} } qw/config url
2072                     auth auth_provider_callbacks repos_root svn_path/);
2073        bless $dup, ref $self;
2074}
2075
2076sub get_log {
2077        my ($self, @args) = @_;
2078        my $pool = SVN::Pool->new;
2079        $args[4]-- if $args[4] && ! $::_follow_parent;
2080        splice(@args, 3, 1) if ($SVN::Core::VERSION le '1.2.0');
2081        my $ret = $self->SUPER::get_log(@args, $pool);
2082        $pool->clear;
2083        $ret;
2084}
2085
2086sub get_commit_editor {
2087        my ($self, $log, $cb, $pool) = @_;
2088        my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef, 0) : ();
2089        $self->SUPER::get_commit_editor($log, $cb, @lock, $pool);
2090}
2091
2092sub uuid {
2093        my ($self) = @_;
2094        $self->{uuid} ||= $self->get_uuid;
2095}
2096
2097sub gs_do_update {
2098        my ($self, $rev_a, $rev_b, $path, $recurse, $editor) = @_;
2099        my $pool = SVN::Pool->new;
2100        my $reporter = $self->do_update($rev_b, $path, $recurse,
2101                                        $editor, $pool);
2102        my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
2103        my $new = ($rev_a == $rev_b);
2104        $reporter->set_path('', $rev_a, $new, @lock, $pool);
2105        $reporter->finish_report($pool);
2106        $pool->clear;
2107        $editor->{git_commit_ok};
2108}
2109
2110sub gs_do_switch {
2111        my ($self, $rev_a, $rev_b, $path, $recurse, $url_b, $editor) = @_;
2112        my $pool = SVN::Pool->new;
2113        my $reporter = $self->do_switch($rev_b, $path, $recurse,
2114                                        $url_b, $editor, $pool);
2115        my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
2116        $reporter->set_path($path, $rev_a, 0, @lock, $pool);
2117        $reporter->finish_report($pool);
2118        $pool->clear;
2119        $editor->{git_commit_ok};
2120}
2121
2122sub can_do_switch {
2123        my $self = shift;
2124        unless (defined $can_do_switch) {
2125                my $pool = SVN::Pool->new;
2126                my $rep = eval {
2127                        $self->do_switch(1, '', 0, $self->{url},
2128                                         SVN::Delta::Editor->new, $pool);
2129                };
2130                if ($@) {
2131                        $can_do_switch = 0;
2132                } else {
2133                        $rep->abort_report($pool);
2134                        $can_do_switch = 1;
2135                }
2136                $pool->clear;
2137        }
2138        $can_do_switch;
2139}
2140
2141package Git::SVN::Log;
2142use strict;
2143use warnings;
2144use POSIX qw/strftime/;
2145use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline
2146            %rusers $show_commit $incremental/;
2147my $l_fmt;
2148
2149sub cmt_showable {
2150        my ($c) = @_;
2151        return 1 if defined $c->{r};
2152        if ($c->{l} && $c->{l}->[-1] eq "...\n" &&
2153                                $c->{a_raw} =~ /\@([a-f\d\-]+)>$/) {
2154                my @log = command(qw/cat-file commit/, $c->{c});
2155                shift @log while ($log[0] ne "\n");
2156                shift @log;
2157                @{$c->{l}} = grep !/^git-svn-id: /, @log;
2158
2159                (undef, $c->{r}, undef) = ::extract_metadata(
2160                                (grep(/^git-svn-id: /, @log))[-1]);
2161        }
2162        return defined $c->{r};
2163}
2164
2165sub log_use_color {
2166        return 1 if $color;
2167        my ($dc, $dcvar);
2168        $dcvar = 'color.diff';
2169        $dc = `git-config --get $dcvar`;
2170        if ($dc eq '') {
2171                # nothing at all; fallback to "diff.color"
2172                $dcvar = 'diff.color';
2173                $dc = `git-config --get $dcvar`;
2174        }
2175        chomp($dc);
2176        if ($dc eq 'auto') {
2177                my $pc;
2178                $pc = `git-config --get color.pager`;
2179                if ($pc eq '') {
2180                        # does not have it -- fallback to pager.color
2181                        $pc = `git-config --bool --get pager.color`;
2182                }
2183                else {
2184                        $pc = `git-config --bool --get color.pager`;
2185                        if ($?) {
2186                                $pc = 'false';
2187                        }
2188                }
2189                chomp($pc);
2190                if (-t *STDOUT || (defined $pager && $pc eq 'true')) {
2191                        return ($ENV{TERM} && $ENV{TERM} ne 'dumb');
2192                }
2193                return 0;
2194        }
2195        return 0 if $dc eq 'never';
2196        return 1 if $dc eq 'always';
2197        chomp($dc = `git-config --bool --get $dcvar`);
2198        return ($dc eq 'true');
2199}
2200
2201sub git_svn_log_cmd {
2202        my ($r_min, $r_max) = @_;
2203        my $gs = Git::SVN->_new;
2204        my @cmd = (qw/log --abbrev-commit --pretty=raw --default/,
2205                   $gs->refname);
2206        push @cmd, '-r' unless $non_recursive;
2207        push @cmd, qw/--raw --name-status/ if $verbose;
2208        push @cmd, '--color' if log_use_color();
2209        return @cmd unless defined $r_max;
2210        if ($r_max == $r_min) {
2211                push @cmd, '--max-count=1';
2212                if (my $c = $gs->rev_db_get($r_max)) {
2213                        push @cmd, $c;
2214                }
2215        } else {
2216                my ($c_min, $c_max);
2217                $c_max = $gs->rev_db_get($r_max);
2218                $c_min = $gs->rev_db_get($r_min);
2219                if (defined $c_min && defined $c_max) {
2220                        if ($r_max > $r_max) {
2221                                push @cmd, "$c_min..$c_max";
2222                        } else {
2223                                push @cmd, "$c_max..$c_min";
2224                        }
2225                } elsif ($r_max > $r_min) {
2226                        push @cmd, $c_max;
2227                } else {
2228                        push @cmd, $c_min;
2229                }
2230        }
2231        return @cmd;
2232}
2233
2234# adapted from pager.c
2235sub config_pager {
2236        $pager ||= $ENV{GIT_PAGER} || $ENV{PAGER};
2237        if (!defined $pager) {
2238                $pager = 'less';
2239        } elsif (length $pager == 0 || $pager eq 'cat') {
2240                $pager = undef;
2241        }
2242}
2243
2244sub run_pager {
2245        return unless -t *STDOUT;
2246        pipe my $rfd, my $wfd or return;
2247        defined(my $pid = fork) or ::fatal "Can't fork: $!\n";
2248        if (!$pid) {
2249                open STDOUT, '>&', $wfd or
2250                                     ::fatal "Can't redirect to stdout: $!\n";
2251                return;
2252        }
2253        open STDIN, '<&', $rfd or ::fatal "Can't redirect stdin: $!\n";
2254        $ENV{LESS} ||= 'FRSX';
2255        exec $pager or ::fatal "Can't run pager: $! ($pager)\n";
2256}
2257
2258sub get_author_info {
2259        my ($dest, $author, $t, $tz) = @_;
2260        $author =~ s/(?:^\s*|\s*$)//g;
2261        $dest->{a_raw} = $author;
2262        my $au;
2263        if ($::_authors) {
2264                $au = $rusers{$author} || undef;
2265        }
2266        if (!$au) {
2267                ($au) = ($author =~ /<([^>]+)\@[^>]+>$/);
2268        }
2269        $dest->{t} = $t;
2270        $dest->{tz} = $tz;
2271        $dest->{a} = $au;
2272        # Date::Parse isn't in the standard Perl distro :(
2273        if ($tz =~ s/^\+//) {
2274                $t += ::tz_to_s_offset($tz);
2275        } elsif ($tz =~ s/^\-//) {
2276                $t -= ::tz_to_s_offset($tz);
2277        }
2278        $dest->{t_utc} = $t;
2279}
2280
2281sub process_commit {
2282        my ($c, $r_min, $r_max, $defer) = @_;
2283        if (defined $r_min && defined $r_max) {
2284                if ($r_min == $c->{r} && $r_min == $r_max) {
2285                        show_commit($c);
2286                        return 0;
2287                }
2288                return 1 if $r_min == $r_max;
2289                if ($r_min < $r_max) {
2290                        # we need to reverse the print order
2291                        return 0 if (defined $limit && --$limit < 0);
2292                        push @$defer, $c;
2293                        return 1;
2294                }
2295                if ($r_min != $r_max) {
2296                        return 1 if ($r_min < $c->{r});
2297                        return 1 if ($r_max > $c->{r});
2298                }
2299        }
2300        return 0 if (defined $limit && --$limit < 0);
2301        show_commit($c);
2302        return 1;
2303}
2304
2305sub show_commit {
2306        my $c = shift;
2307        if ($oneline) {
2308                my $x = "\n";
2309                if (my $l = $c->{l}) {
2310                        while ($l->[0] =~ /^\s*$/) { shift @$l }
2311                        $x = $l->[0];
2312                }
2313                $l_fmt ||= 'A' . length($c->{r});
2314                print 'r',pack($l_fmt, $c->{r}),' | ';
2315                print "$c->{c} | " if $show_commit;
2316                print $x;
2317        } else {
2318                show_commit_normal($c);
2319        }
2320}
2321
2322sub show_commit_changed_paths {
2323        my ($c) = @_;
2324        return unless $c->{changed};
2325        print "Changed paths:\n", @{$c->{changed}};
2326}
2327
2328sub show_commit_normal {
2329        my ($c) = @_;
2330        print '-' x72, "\nr$c->{r} | ";
2331        print "$c->{c} | " if $show_commit;
2332        print "$c->{a} | ", strftime("%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)",
2333                                 localtime($c->{t_utc})), ' | ';
2334        my $nr_line = 0;
2335
2336        if (my $l = $c->{l}) {
2337                while ($l->[$#$l] eq "\n" && $#$l > 0
2338                                          && $l->[($#$l - 1)] eq "\n") {
2339                        pop @$l;
2340                }
2341                $nr_line = scalar @$l;
2342                if (!$nr_line) {
2343                        print "1 line\n\n\n";
2344                } else {
2345                        if ($nr_line == 1) {
2346                                $nr_line = '1 line';
2347                        } else {
2348                                $nr_line .= ' lines';
2349                        }
2350                        print $nr_line, "\n";
2351                        show_commit_changed_paths($c);
2352                        print "\n";
2353                        print $_ foreach @$l;
2354                }
2355        } else {
2356                print "1 line\n";
2357                show_commit_changed_paths($c);
2358                print "\n";
2359
2360        }
2361        foreach my $x (qw/raw diff/) {
2362                if ($c->{$x}) {
2363                        print "\n";
2364                        print $_ foreach @{$c->{$x}}
2365                }
2366        }
2367}
2368
2369sub cmd_show_log {
2370        my (@args) = @_;
2371        my ($r_min, $r_max);
2372        my $r_last = -1; # prevent dupes
2373        if (defined $TZ) {
2374                $ENV{TZ} = $TZ;
2375        } else {
2376                delete $ENV{TZ};
2377        }
2378        if (defined $::_revision) {
2379                if ($::_revision =~ /^(\d+):(\d+)$/) {
2380                        ($r_min, $r_max) = ($1, $2);
2381                } elsif ($::_revision =~ /^\d+$/) {
2382                        $r_min = $r_max = $::_revision;
2383                } else {
2384                        ::fatal "-r$::_revision is not supported, use ",
2385                                "standard \'git log\' arguments instead\n";
2386                }
2387        }
2388
2389        config_pager();
2390        @args = (git_svn_log_cmd($r_min, $r_max), @args);
2391        my $log = command_output_pipe(@args);
2392        run_pager();
2393        my (@k, $c, $d);
2394        my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/;
2395        while (<$log>) {
2396                if (/^${esc_color}commit ($::sha1_short)/o) {
2397                        my $cmt = $1;
2398                        if ($c && cmt_showable($c) && $c->{r} != $r_last) {
2399                                $r_last = $c->{r};
2400                                process_commit($c, $r_min, $r_max, \@k) or
2401                                                                goto out;
2402                        }
2403                        $d = undef;
2404                        $c = { c => $cmt };
2405                } elsif (/^${esc_color}author (.+) (\d+) ([\-\+]?\d+)$/o) {
2406                        get_author_info($c, $1, $2, $3);
2407                } elsif (/^${esc_color}(?:tree|parent|committer) /o) {
2408                        # ignore
2409                } elsif (/^${esc_color}:\d{6} \d{6} $::sha1_short/o) {
2410                        push @{$c->{raw}}, $_;
2411                } elsif (/^${esc_color}[ACRMDT]\t/) {
2412                        # we could add $SVN->{svn_path} here, but that requires
2413                        # remote access at the moment (repo_path_split)...
2414                        s#^(${esc_color})([ACRMDT])\t#$1   $2 #o;
2415                        push @{$c->{changed}}, $_;
2416                } elsif (/^${esc_color}diff /o) {
2417                        $d = 1;
2418                        push @{$c->{diff}}, $_;
2419                } elsif ($d) {
2420                        push @{$c->{diff}}, $_;
2421                } elsif (/^${esc_color}    (git-svn-id:.+)$/o) {
2422                        ($c->{url}, $c->{r}, undef) = ::extract_metadata($1);
2423                } elsif (s/^${esc_color}    //o) {
2424                        push @{$c->{l}}, $_;
2425                }
2426        }
2427        if ($c && defined $c->{r} && $c->{r} != $r_last) {
2428                $r_last = $c->{r};
2429                process_commit($c, $r_min, $r_max, \@k);
2430        }
2431        if (@k) {
2432                my $swap = $r_max;
2433                $r_max = $r_min;
2434                $r_min = $swap;
2435                process_commit($_, $r_min, $r_max) foreach reverse @k;
2436        }
2437out:
2438        close $log;
2439        print '-' x72,"\n" unless $incremental || $oneline;
2440}
2441
2442package Git::SVN::Migration;
2443# these version numbers do NOT correspond to actual version numbers
2444# of git nor git-svn.  They are just relative.
2445#
2446# v0 layout: .git/$id/info/url, refs/heads/$id-HEAD
2447#
2448# v1 layout: .git/$id/info/url, refs/remotes/$id
2449#
2450# v2 layout: .git/svn/$id/info/url, refs/remotes/$id
2451#
2452# v3 layout: .git/svn/$id, refs/remotes/$id
2453#            - info/url may remain for backwards compatibility
2454#            - this is what we migrate up to this layout automatically,
2455#            - this will be used by git svn init on single branches
2456#
2457# v4 layout: .git/svn/$repo_id/$id, refs/remotes/$repo_id/$id
2458#            - this is only created for newly multi-init-ed
2459#              repositories.  Similar in spirit to the
2460#              --use-separate-remotes option in git-clone (now default)
2461#            - we do not automatically migrate to this (following
2462#              the example set by core git)
2463use strict;
2464use warnings;
2465use Carp qw/croak/;
2466use File::Path qw/mkpath/;
2467use File::Basename qw/dirname/;
2468
2469sub migrate_from_v0 {
2470        my $git_dir = $ENV{GIT_DIR};
2471        return undef unless -d $git_dir;
2472        my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/);
2473        my $migrated = 0;
2474        while (<$fh>) {
2475                chomp;
2476                my ($id, $orig_ref) = ($_, $_);
2477                next unless $id =~ s#^refs/heads/(.+)-HEAD$#$1#;
2478                next unless -f "$git_dir/$id/info/url";
2479                my $new_ref = "refs/remotes/$id";
2480                if (::verify_ref("$new_ref^0")) {
2481                        print STDERR "W: $orig_ref is probably an old ",
2482                                     "branch used by an ancient version of ",
2483                                     "git-svn.\n",
2484                                     "However, $new_ref also exists.\n",
2485                                     "We will not be able ",
2486                                     "to use this branch until this ",
2487                                     "ambiguity is resolved.\n";
2488                        next;
2489                }
2490                print STDERR "Migrating from v0 layout...\n" if !$migrated;
2491                print STDERR "Renaming ref: $orig_ref => $new_ref\n";
2492                command_noisy('update-ref', $new_ref, $orig_ref);
2493                command_noisy('update-ref', '-d', $orig_ref, $orig_ref);
2494                $migrated++;
2495        }
2496        command_close_pipe($fh, $ctx);
2497        print STDERR "Done migrating from v0 layout...\n" if $migrated;
2498        $migrated;
2499}
2500
2501sub migrate_from_v1 {
2502        my $git_dir = $ENV{GIT_DIR};
2503        my $migrated = 0;
2504        return $migrated unless -d $git_dir;
2505        my $svn_dir = "$git_dir/svn";
2506
2507        # just in case somebody used 'svn' as their $id at some point...
2508        return $migrated if -d $svn_dir && ! -f "$svn_dir/info/url";
2509
2510        print STDERR "Migrating from a git-svn v1 layout...\n";
2511        mkpath([$svn_dir]);
2512        print STDERR "Data from a previous version of git-svn exists, but\n\t",
2513                     "$svn_dir\n\t(required for this version ",
2514                     "($::VERSION) of git-svn) does not. exist\n";
2515        my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/);
2516        while (<$fh>) {
2517                my $x = $_;
2518                next unless $x =~ s#^refs/remotes/##;
2519                chomp $x;
2520                next unless -f "$git_dir/$x/info/url";
2521                my $u = eval { ::file_to_s("$git_dir/$x/info/url") };
2522                next unless $u;
2523                my $dn = dirname("$git_dir/svn/$x");
2524                mkpath([$dn]) unless -d $dn;
2525                if ($x eq 'svn') { # they used 'svn' as GIT_SVN_ID:
2526                        mkpath(["$git_dir/svn/svn"]);
2527                        print STDERR " - $git_dir/$x/info => ",
2528                                        "$git_dir/svn/$x/info\n";
2529                        rename "$git_dir/$x/info", "$git_dir/svn/$x/info" or
2530                               croak "$!: $x";
2531                        # don't worry too much about these, they probably
2532                        # don't exist with repos this old (save for index,
2533                        # and we can easily regenerate that)
2534                        foreach my $f (qw/unhandled.log index .rev_db/) {
2535                                rename "$git_dir/$x/$f", "$git_dir/svn/$x/$f";
2536                        }
2537                } else {
2538                        print STDERR " - $git_dir/$x => $git_dir/svn/$x\n";
2539                        rename "$git_dir/$x", "$git_dir/svn/$x" or
2540                               croak "$!: $x";
2541                }
2542                $migrated++;
2543        }
2544        command_close_pipe($fh, $ctx);
2545        print STDERR "Done migrating from a git-svn v1 layout\n";
2546        $migrated;
2547}
2548
2549sub read_old_urls {
2550        my ($l_map, $pfx, $path) = @_;
2551        my @dir;
2552        foreach (<$path/*>) {
2553                if (-r "$_/info/url") {
2554                        $pfx .= '/' if $pfx && $pfx !~ m!/$!;
2555                        my $ref_id = $pfx . basename $_;
2556                        my $url = ::file_to_s("$_/info/url");
2557                        $l_map->{$ref_id} = $url;
2558                } elsif (-d $_) {
2559                        push @dir, $_;
2560                }
2561        }
2562        foreach (@dir) {
2563                my $x = $_;
2564                $x =~ s!^\Q$ENV{GIT_DIR}\E/svn/!!o;
2565                read_old_urls($l_map, $x, $_);
2566        }
2567}
2568
2569sub migrate_from_v2 {
2570        my @cfg = command(qw/config -l/);
2571        return if grep /^svn-remote\..+\.url=/, @cfg;
2572        my %l_map;
2573        read_old_urls(\%l_map, '', "$ENV{GIT_DIR}/svn");
2574        my $migrated = 0;
2575
2576        foreach my $ref_id (sort keys %l_map) {
2577                Git::SVN->init($l_map{$ref_id}, $ref_id);
2578                $migrated++;
2579        }
2580        $migrated;
2581}
2582
2583sub migration_check {
2584        migrate_from_v0();
2585        migrate_from_v1();
2586        migrate_from_v2();
2587}
2588
2589__END__
2590
2591Data structures:
2592
2593$log_entry hashref as returned by libsvn_log_entry()
2594{
2595        log => 'whitespace-formatted log entry
2596',                                              # trailing newline is preserved
2597        revision => '8',                        # integer
2598        date => '2004-02-24T17:01:44.108345Z',  # commit date
2599        author => 'committer name'
2600};
2601
2602@mods = array of diff-index line hashes, each element represents one line
2603        of diff-index output
2604
2605diff-index line ($m hash)
2606{
2607        mode_a => first column of diff-index output, no leading ':',
2608        mode_b => second column of diff-index output,
2609        sha1_b => sha1sum of the final blob,
2610        chg => change type [MCRADT],
2611        file_a => original file name of a file (iff chg is 'C' or 'R')
2612        file_b => new/current file name of a file (any chg)
2613}
2614;
2615
2616# retval of read_url_paths{,_all}();
2617$l_map = {
2618        # repository root url
2619        'https://svn.musicpd.org' => {
2620                # repository path               # GIT_SVN_ID
2621                'mpd/trunk'             =>      'trunk',
2622                'mpd/tags/0.11.5'       =>      'tags/0.11.5',
2623        },
2624}
2625
2626Notes:
2627        I don't trust the each() function on unless I created %hash myself
2628        because the internal iterator may not have started at base.