Andrew's git / gitweb.git / git-svnimport.perl
?
git-svnimport.perlon commit Merge branch 'jc/blame' into next (dd4bca3)
   1#!/usr/bin/perl -w
   2
   3# This tool is copyright (c) 2005, Matthias Urlichs.
   4# It is released under the Gnu Public License, version 2.
   5#
   6# The basic idea is to pull and analyze SVN changes.
   7#
   8# Checking out the files is done by a single long-running SVN connection.
   9#
  10# The head revision is on branch "origin" by default.
  11# You can change that with the '-o' option.
  12
  13use strict;
  14use warnings;
  15use Getopt::Std;
  16use File::Copy;
  17use File::Spec;
  18use File::Temp qw(tempfile);
  19use File::Path qw(mkpath);
  20use File::Basename qw(basename dirname);
  21use Time::Local;
  22use IO::Pipe;
  23use POSIX qw(strftime dup2);
  24use IPC::Open2;
  25use SVN::Core;
  26use SVN::Ra;
  27
  28die "Need SVN:Core 1.2.1 or better" if $SVN::Core::VERSION lt "1.2.1";
  29
  30$SIG{'PIPE'}="IGNORE";
  31$ENV{'TZ'}="UTC";
  32
  33our($opt_h,$opt_o,$opt_v,$opt_u,$opt_C,$opt_i,$opt_m,$opt_M,$opt_t,$opt_T,
  34    $opt_b,$opt_r,$opt_I,$opt_A,$opt_s,$opt_l,$opt_d,$opt_D);
  35
  36sub usage() {
  37        print STDERR <<END;
  38Usage: ${\basename $0}     # fetch/update GIT from SVN
  39       [-o branch-for-HEAD] [-h] [-v] [-l max_rev]
  40       [-C GIT_repository] [-t tagname] [-T trunkname] [-b branchname]
  41       [-d|-D] [-i] [-u] [-r] [-I ignorefilename] [-s start_chg]
  42       [-m] [-M regex] [-A author_file] [SVN_URL]
  43END
  44        exit(1);
  45}
  46
  47getopts("A:b:C:dDhiI:l:mM:o:rs:t:T:uv") or usage();
  48usage if $opt_h;
  49
  50my $tag_name = $opt_t || "tags";
  51my $trunk_name = $opt_T || "trunk";
  52my $branch_name = $opt_b || "branches";
  53
  54@ARGV == 1 or @ARGV == 2 or usage();
  55
  56$opt_o ||= "origin";
  57$opt_s ||= 1;
  58my $git_tree = $opt_C;
  59$git_tree ||= ".";
  60
  61my $svn_url = $ARGV[0];
  62my $svn_dir = $ARGV[1];
  63
  64our @mergerx = ();
  65if ($opt_m) {
  66        @mergerx = ( qr/\W(?:from|of|merge|merging|merged) (\w+)/i );
  67}
  68if ($opt_M) {
  69        push (@mergerx, qr/$opt_M/);
  70}
  71
  72# Absolutize filename now, since we will have chdir'ed by the time we
  73# get around to opening it.
  74$opt_A = File::Spec->rel2abs($opt_A) if $opt_A;
  75
  76our %users = ();
  77our $users_file = undef;
  78sub read_users($) {
  79        $users_file = File::Spec->rel2abs(@_);
  80        die "Cannot open $users_file\n" unless -f $users_file;
  81        open(my $authors,$users_file);
  82        while(<$authors>) {
  83                chomp;
  84                next unless /^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*$/;
  85                (my $user,my $name,my $email) = ($1,$2,$3);
  86                $users{$user} = [$name,$email];
  87        }
  88        close($authors);
  89}
  90
  91select(STDERR); $|=1; select(STDOUT);
  92
  93
  94package SVNconn;
  95# Basic SVN connection.
  96# We're only interested in connecting and downloading, so ...
  97
  98use File::Spec;
  99use File::Temp qw(tempfile);
 100use POSIX qw(strftime dup2);
 101
 102sub new {
 103        my($what,$repo) = @_;
 104        $what=ref($what) if ref($what);
 105
 106        my $self = {};
 107        $self->{'buffer'} = "";
 108        bless($self,$what);
 109
 110        $repo =~ s#/+$##;
 111        $self->{'fullrep'} = $repo;
 112        $self->conn();
 113
 114        return $self;
 115}
 116
 117sub conn {
 118        my $self = shift;
 119        my $repo = $self->{'fullrep'};
 120        my $auth = SVN::Core::auth_open ([SVN::Client::get_simple_provider,
 121                          SVN::Client::get_ssl_server_trust_file_provider,
 122                          SVN::Client::get_username_provider]);
 123        my $s = SVN::Ra->new(url => $repo, auth => $auth);
 124        die "SVN connection to $repo: $!\n" unless defined $s;
 125        $self->{'svn'} = $s;
 126        $self->{'repo'} = $repo;
 127        $self->{'maxrev'} = $s->get_latest_revnum();
 128}
 129
 130sub file {
 131        my($self,$path,$rev) = @_;
 132
 133        my ($fh, $name) = tempfile('gitsvn.XXXXXX',
 134                    DIR => File::Spec->tmpdir(), UNLINK => 1);
 135
 136        print "... $rev $path ...\n" if $opt_v;
 137        my (undef, $properties);
 138        eval { (undef, $properties)
 139                   = $self->{'svn'}->get_file($path,$rev,$fh); };
 140        if($@) {
 141                return undef if $@ =~ /Attempted to get checksum/;
 142                die $@;
 143        }
 144        my $mode;
 145        if (exists $properties->{'svn:executable'}) {
 146                $mode = '0755';
 147        } else {
 148                $mode = '0644';
 149        }
 150        close ($fh);
 151
 152        return ($name, $mode);
 153}
 154
 155sub ignore {
 156        my($self,$path,$rev) = @_;
 157
 158        print "... $rev $path ...\n" if $opt_v;
 159        my (undef,undef,$properties)
 160            = $self->{'svn'}->get_dir($path,$rev,undef);
 161        if (exists $properties->{'svn:ignore'}) {
 162                my ($fh, $name) = tempfile('gitsvn.XXXXXX',
 163                                           DIR => File::Spec->tmpdir(),
 164                                           UNLINK => 1);
 165                print $fh $properties->{'svn:ignore'};
 166                close($fh);
 167                return $name;
 168        } else {
 169                return undef;
 170        }
 171}
 172
 173package main;
 174use URI;
 175
 176our $svn = $svn_url;
 177$svn .= "/$svn_dir" if defined $svn_dir;
 178my $svn2 = SVNconn->new($svn);
 179$svn = SVNconn->new($svn);
 180
 181my $lwp_ua;
 182if($opt_d or $opt_D) {
 183        $svn_url = URI->new($svn_url)->canonical;
 184        if($opt_D) {
 185                $svn_dir =~ s#/*$#/#;
 186        } else {
 187                $svn_dir = "";
 188        }
 189        if ($svn_url->scheme eq "http") {
 190                use LWP::UserAgent;
 191                $lwp_ua = LWP::UserAgent->new(keep_alive => 1, requests_redirectable => []);
 192        } else {
 193                print STDERR "Warning: not HTTP; turning off direct file access\n";
 194                $opt_d=0;
 195        }
 196}
 197
 198sub pdate($) {
 199        my($d) = @_;
 200        $d =~ m#(\d\d\d\d)-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)#
 201                or die "Unparseable date: $d\n";
 202        my $y=$1; $y-=1900 if $y>1900;
 203        return timegm($6||0,$5,$4,$3,$2-1,$y);
 204}
 205
 206sub getwd() {
 207        my $pwd = `pwd`;
 208        chomp $pwd;
 209        return $pwd;
 210}
 211
 212
 213sub get_headref($$) {
 214    my $name    = shift;
 215    my $git_dir = shift;
 216    my $sha;
 217
 218    if (open(C,"$git_dir/refs/heads/$name")) {
 219        chomp($sha = <C>);
 220        close(C);
 221        length($sha) == 40
 222            or die "Cannot get head id for $name ($sha): $!\n";
 223    }
 224    return $sha;
 225}
 226
 227
 228-d $git_tree
 229        or mkdir($git_tree,0777)
 230        or die "Could not create $git_tree: $!";
 231chdir($git_tree);
 232
 233my $orig_branch = "";
 234my $forward_master = 0;
 235my %branches;
 236
 237my $git_dir = $ENV{"GIT_DIR"} || ".git";
 238$git_dir = getwd()."/".$git_dir unless $git_dir =~ m#^/#;
 239$ENV{"GIT_DIR"} = $git_dir;
 240my $orig_git_index;
 241$orig_git_index = $ENV{GIT_INDEX_FILE} if exists $ENV{GIT_INDEX_FILE};
 242my ($git_ih, $git_index) = tempfile('gitXXXXXX', SUFFIX => '.idx',
 243                                    DIR => File::Spec->tmpdir());
 244close ($git_ih);
 245$ENV{GIT_INDEX_FILE} = $git_index;
 246my $maxnum = 0;
 247my $last_rev = "";
 248my $last_branch;
 249my $current_rev = $opt_s || 1;
 250unless(-d $git_dir) {
 251        system("git-init-db");
 252        die "Cannot init the GIT db at $git_tree: $?\n" if $?;
 253        system("git-read-tree");
 254        die "Cannot init an empty tree: $?\n" if $?;
 255
 256        $last_branch = $opt_o;
 257        $orig_branch = "";
 258} else {
 259        -f "$git_dir/refs/heads/$opt_o"
 260                or die "Branch '$opt_o' does not exist.\n".
 261                       "Either use the correct '-o branch' option,\n".
 262                       "or import to a new repository.\n";
 263
 264        -f "$git_dir/svn2git"
 265                or die "'$git_dir/svn2git' does not exist.\n".
 266                       "You need that file for incremental imports.\n";
 267        open(F, "git-symbolic-ref HEAD |") or
 268                die "Cannot run git-symbolic-ref: $!\n";
 269        chomp ($last_branch = <F>);
 270        $last_branch = basename($last_branch);
 271        close(F);
 272        unless($last_branch) {
 273                warn "Cannot read the last branch name: $! -- assuming 'master'\n";
 274                $last_branch = "master";
 275        }
 276        $orig_branch = $last_branch;
 277        $last_rev = get_headref($orig_branch, $git_dir);
 278        if (-f "$git_dir/SVN2GIT_HEAD") {
 279                die <<EOM;
 280SVN2GIT_HEAD exists.
 281Make sure your working directory corresponds to HEAD and remove SVN2GIT_HEAD.
 282You may need to run
 283
 284    git-read-tree -m -u SVN2GIT_HEAD HEAD
 285EOM
 286        }
 287        system('cp', "$git_dir/HEAD", "$git_dir/SVN2GIT_HEAD");
 288
 289        $forward_master =
 290            $opt_o ne 'master' && -f "$git_dir/refs/heads/master" &&
 291            system('cmp', '-s', "$git_dir/refs/heads/master",
 292                                "$git_dir/refs/heads/$opt_o") == 0;
 293
 294        # populate index
 295        system('git-read-tree', $last_rev);
 296        die "read-tree failed: $?\n" if $?;
 297
 298        # Get the last import timestamps
 299        open my $B,"<", "$git_dir/svn2git";
 300        while(<$B>) {
 301                chomp;
 302                my($num,$branch,$ref) = split;
 303                $branches{$branch}{$num} = $ref;
 304                $branches{$branch}{"LAST"} = $ref;
 305                $current_rev = $num+1 if $current_rev <= $num;
 306        }
 307        close($B);
 308}
 309-d $git_dir
 310        or die "Could not create git subdir ($git_dir).\n";
 311
 312my $default_authors = "$git_dir/svn-authors";
 313if ($opt_A) {
 314        read_users($opt_A);
 315        copy($opt_A,$default_authors) or die "Copy failed: $!";
 316} else {
 317        read_users($default_authors) if -f $default_authors;
 318}
 319
 320open BRANCHES,">>", "$git_dir/svn2git";
 321
 322sub node_kind($$$) {
 323        my ($branch, $path, $revision) = @_;
 324        my $pool=SVN::Pool->new;
 325        my $kind = $svn->{'svn'}->check_path(revert_split_path($branch,$path),$revision,$pool);
 326        $pool->clear;
 327        return $kind;
 328}
 329
 330sub revert_split_path($$) {
 331        my($branch,$path) = @_;
 332
 333        my $svnpath;
 334        $path = "" if $path eq "/"; # this should not happen, but ...
 335        if($branch eq "/") {
 336                $svnpath = "$trunk_name/$path";
 337        } elsif($branch =~ m#^/#) {
 338                $svnpath = "$tag_name$branch/$path";
 339        } else {
 340                $svnpath = "$branch_name/$branch/$path";
 341        }
 342
 343        $svnpath =~ s#/+$##;
 344        return $svnpath;
 345}
 346
 347sub get_file($$$) {
 348        my($rev,$branch,$path) = @_;
 349
 350        my $svnpath = revert_split_path($branch,$path);
 351
 352        # now get it
 353        my ($name,$mode);
 354        if($opt_d) {
 355                my($req,$res);
 356
 357                # /svn/!svn/bc/2/django/trunk/django-docs/build.py
 358                my $url=$svn_url->clone();
 359                $url->path($url->path."/!svn/bc/$rev/$svn_dir$svnpath");
 360                print "... $path...\n" if $opt_v;
 361                $req = HTTP::Request->new(GET => $url);
 362                $res = $lwp_ua->request($req);
 363                if ($res->is_success) {
 364                        my $fh;
 365                        ($fh, $name) = tempfile('gitsvn.XXXXXX',
 366                        DIR => File::Spec->tmpdir(), UNLINK => 1);
 367                        print $fh $res->content;
 368                        close($fh) or die "Could not write $name: $!\n";
 369                } else {
 370                        return undef if $res->code == 301; # directory?
 371                        die $res->status_line." at $url\n";
 372                }
 373                $mode = '0644'; # can't obtain mode via direct http request?
 374        } else {
 375                ($name,$mode) = $svn->file("$svnpath",$rev);
 376                return undef unless defined $name;
 377        }
 378
 379        my $pid = open(my $F, '-|');
 380        die $! unless defined $pid;
 381        if (!$pid) {
 382            exec("git-hash-object", "-w", $name)
 383                or die "Cannot create object: $!\n";
 384        }
 385        my $sha = <$F>;
 386        chomp $sha;
 387        close $F;
 388        unlink $name;
 389        return [$mode, $sha, $path];
 390}
 391
 392sub get_ignore($$$$$) {
 393        my($new,$old,$rev,$branch,$path) = @_;
 394
 395        return unless $opt_I;
 396        my $svnpath = revert_split_path($branch,$path);
 397        my $name = $svn->ignore("$svnpath",$rev);
 398        if ($path eq '/') {
 399                $path = $opt_I;
 400        } else {
 401                $path = File::Spec->catfile($path,$opt_I);
 402        }
 403        if (defined $name) {
 404                my $pid = open(my $F, '-|');
 405                die $! unless defined $pid;
 406                if (!$pid) {
 407                        exec("git-hash-object", "-w", $name)
 408                            or die "Cannot create object: $!\n";
 409                }
 410                my $sha = <$F>;
 411                chomp $sha;
 412                close $F;
 413                unlink $name;
 414                push(@$new,['0644',$sha,$path]);
 415        } else {
 416                push(@$old,$path);
 417        }
 418}
 419
 420sub split_path($$) {
 421        my($rev,$path) = @_;
 422        my $branch;
 423
 424        if($path =~ s#^/\Q$tag_name\E/([^/]+)/?##) {
 425                $branch = "/$1";
 426        } elsif($path =~ s#^/\Q$trunk_name\E/?##) {
 427                $branch = "/";
 428        } elsif($path =~ s#^/\Q$branch_name\E/([^/]+)/?##) {
 429                $branch = $1;
 430        } else {
 431                my %no_error = (
 432                        "/" => 1,
 433                        "/$tag_name" => 1,
 434                        "/$branch_name" => 1
 435                );
 436                print STDERR "$rev: Unrecognized path: $path\n" unless (defined $no_error{$path});
 437                return ()
 438        }
 439        $path = "/" if $path eq "";
 440        return ($branch,$path);
 441}
 442
 443sub branch_rev($$) {
 444
 445        my ($srcbranch,$uptorev) = @_;
 446
 447        my $bbranches = $branches{$srcbranch};
 448        my @revs = reverse sort { ($a eq 'LAST' ? 0 : $a) <=> ($b eq 'LAST' ? 0 : $b) } keys %$bbranches;
 449        my $therev;
 450        foreach my $arev(@revs) {
 451                next if  ($arev eq 'LAST');
 452                if ($arev <= $uptorev) {
 453                        $therev = $arev;
 454                        last;
 455                }
 456        }
 457        return $therev;
 458}
 459
 460sub copy_path($$$$$$$$) {
 461        # Somebody copied a whole subdirectory.
 462        # We need to find the index entries from the old version which the
 463        # SVN log entry points to, and add them to the new place.
 464
 465        my($newrev,$newbranch,$path,$oldpath,$rev,$node_kind,$new,$parents) = @_;
 466
 467        my($srcbranch,$srcpath) = split_path($rev,$oldpath);
 468        unless(defined $srcbranch) {
 469                print "Path not found when copying from $oldpath @ $rev\n";
 470                return;
 471        }
 472        my $therev = branch_rev($srcbranch, $rev);
 473        my $gitrev = $branches{$srcbranch}{$therev};
 474        unless($gitrev) {
 475                print STDERR "$newrev:$newbranch: could not find $oldpath \@ $rev\n";
 476                return;
 477        }
 478        if ($srcbranch ne $newbranch) {
 479                push(@$parents, $branches{$srcbranch}{'LAST'});
 480        }
 481        print "$newrev:$newbranch:$path: copying from $srcbranch:$srcpath @ $rev\n" if $opt_v;
 482        if ($node_kind eq $SVN::Node::dir) {
 483                        $srcpath =~ s#/*$#/#;
 484        }
 485        
 486        my $pid = open my $f,'-|';
 487        die $! unless defined $pid;
 488        if (!$pid) {
 489                exec("git-ls-tree","-r","-z",$gitrev,$srcpath)
 490                        or die $!;
 491        }
 492        local $/ = "\0";
 493        while(<$f>) {
 494                chomp;
 495                my($m,$p) = split(/\t/,$_,2);
 496                my($mode,$type,$sha1) = split(/ /,$m);
 497                next if $type ne "blob";
 498                if ($node_kind eq $SVN::Node::dir) {
 499                        $p = $path . substr($p,length($srcpath)-1);
 500                } else {
 501                        $p = $path;
 502                }
 503                push(@$new,[$mode,$sha1,$p]);   
 504        }
 505        close($f) or
 506                print STDERR "$newrev:$newbranch: could not list files in $oldpath \@ $rev\n";
 507}
 508
 509sub commit {
 510        my($branch, $changed_paths, $revision, $author, $date, $message) = @_;
 511        my($author_name,$author_email,$dest);
 512        my(@old,@new,@parents);
 513
 514        if (not defined $author) {
 515                $author_name = $author_email = "unknown";
 516        } elsif (defined $users_file) {
 517                die "User $author is not listed in $users_file\n"
 518                    unless exists $users{$author};
 519                ($author_name,$author_email) = @{$users{$author}};
 520        } elsif ($author =~ /^(.*?)\s+<(.*)>$/) {
 521                ($author_name, $author_email) = ($1, $2);
 522        } else {
 523                $author =~ s/^<(.*)>$/$1/;
 524                $author_name = $author_email = $author;
 525        }
 526        $date = pdate($date);
 527
 528        my $tag;
 529        my $parent;
 530        if($branch eq "/") { # trunk
 531                $parent = $opt_o;
 532        } elsif($branch =~ m#^/(.+)#) { # tag
 533                $tag = 1;
 534                $parent = $1;
 535        } else { # "normal" branch
 536                # nothing to do
 537                $parent = $branch;
 538        }
 539        $dest = $parent;
 540
 541        my $prev = $changed_paths->{"/"};
 542        if($prev and $prev->[0] eq "A") {
 543                delete $changed_paths->{"/"};
 544                my $oldpath = $prev->[1];
 545                my $rev;
 546                if(defined $oldpath) {
 547                        my $p;
 548                        ($parent,$p) = split_path($revision,$oldpath);
 549                        if($parent eq "/") {
 550                                $parent = $opt_o;
 551                        } else {
 552                                $parent =~ s#^/##; # if it's a tag
 553                        }
 554                } else {
 555                        $parent = undef;
 556                }
 557        }
 558
 559        my $rev;
 560        if($revision > $opt_s and defined $parent) {
 561                open(H,"git-rev-parse --verify $parent |");
 562                $rev = <H>;
 563                close(H) or do {
 564                        print STDERR "$revision: cannot find commit '$parent'!\n";
 565                        return;
 566                };
 567                chop $rev;
 568                if(length($rev) != 40) {
 569                        print STDERR "$revision: cannot find commit '$parent'!\n";
 570                        return;
 571                }
 572                $rev = $branches{($parent eq $opt_o) ? "/" : $parent}{"LAST"};
 573                if($revision != $opt_s and not $rev) {
 574                        print STDERR "$revision: do not know ancestor for '$parent'!\n";
 575                        return;
 576                }
 577        } else {
 578                $rev = undef;
 579        }
 580
 581#       if($prev and $prev->[0] eq "A") {
 582#               if(not $tag) {
 583#                       unless(open(H,"> $git_dir/refs/heads/$branch")) {
 584#                               print STDERR "$revision: Could not create branch $branch: $!\n";
 585#                               $state=11;
 586#                               next;
 587#                       }
 588#                       print H "$rev\n"
 589#                               or die "Could not write branch $branch: $!";
 590#                       close(H)
 591#                               or die "Could not write branch $branch: $!";
 592#               }
 593#       }
 594        if(not defined $rev) {
 595                unlink($git_index);
 596        } elsif ($rev ne $last_rev) {
 597                print "Switching from $last_rev to $rev ($branch)\n" if $opt_v;
 598                system("git-read-tree", $rev);
 599                die "read-tree failed for $rev: $?\n" if $?;
 600                $last_rev = $rev;
 601        }
 602
 603        push (@parents, $rev) if defined $rev;
 604
 605        my $cid;
 606        if($tag and not %$changed_paths) {
 607                $cid = $rev;
 608        } else {
 609                my @paths = sort keys %$changed_paths;
 610                foreach my $path(@paths) {
 611                        my $action = $changed_paths->{$path};
 612
 613                        if ($action->[0] eq "R") {
 614                                # refer to a file/tree in an earlier commit
 615                                push(@old,$path); # remove any old stuff
 616                        }
 617                        if(($action->[0] eq "A") || ($action->[0] eq "R")) {
 618                                my $node_kind = node_kind($branch,$path,$revision);
 619                                if ($node_kind eq $SVN::Node::file) {
 620                                        my $f = get_file($revision,$branch,$path);
 621                                        if ($f) {
 622                                                push(@new,$f) if $f;
 623                                        } else {
 624                                                my $opath = $action->[3];
 625                                                print STDERR "$revision: $branch: could not fetch '$opath'\n";
 626                                        }
 627                                } elsif ($node_kind eq $SVN::Node::dir) {
 628                                        if($action->[1]) {
 629                                                copy_path($revision, $branch,
 630                                                          $path, $action->[1],
 631                                                          $action->[2], $node_kind,
 632                                                          \@new, \@parents);
 633                                        } else {
 634                                                get_ignore(\@new, \@old, $revision,
 635                                                           $branch, $path);
 636                                        }
 637                                }
 638                        } elsif ($action->[0] eq "D") {
 639                                push(@old,$path);
 640                        } elsif ($action->[0] eq "M") {
 641                                my $node_kind = node_kind($branch,$path,$revision);
 642                                if ($node_kind eq $SVN::Node::file) {
 643                                        my $f = get_file($revision,$branch,$path);
 644                                        push(@new,$f) if $f;
 645                                } elsif ($node_kind eq $SVN::Node::dir) {
 646                                        get_ignore(\@new, \@old, $revision,
 647                                                   $branch,$path);
 648                                }
 649                        } else {
 650                                die "$revision: unknown action '".$action->[0]."' for $path\n";
 651                        }
 652                }
 653
 654                while(@old) {
 655                        my @o1;
 656                        if(@old > 55) {
 657                                @o1 = splice(@old,0,50);
 658                        } else {
 659                                @o1 = @old;
 660                                @old = ();
 661                        }
 662                        my $pid = open my $F, "-|";
 663                        die "$!" unless defined $pid;
 664                        if (!$pid) {
 665                                exec("git-ls-files", "-z", @o1) or die $!;
 666                        }
 667                        @o1 = ();
 668                        local $/ = "\0";
 669                        while(<$F>) {
 670                                chomp;
 671                                push(@o1,$_);
 672                        }
 673                        close($F);
 674
 675                        while(@o1) {
 676                                my @o2;
 677                                if(@o1 > 55) {
 678                                        @o2 = splice(@o1,0,50);
 679                                } else {
 680                                        @o2 = @o1;
 681                                        @o1 = ();
 682                                }
 683                                system("git-update-index","--force-remove","--",@o2);
 684                                die "Cannot remove files: $?\n" if $?;
 685                        }
 686                }
 687                while(@new) {
 688                        my @n2;
 689                        if(@new > 12) {
 690                                @n2 = splice(@new,0,10);
 691                        } else {
 692                                @n2 = @new;
 693                                @new = ();
 694                        }
 695                        system("git-update-index","--add",
 696                                (map { ('--cacheinfo', @$_) } @n2));
 697                        die "Cannot add files: $?\n" if $?;
 698                }
 699
 700                my $pid = open(C,"-|");
 701                die "Cannot fork: $!" unless defined $pid;
 702                unless($pid) {
 703                        exec("git-write-tree");
 704                        die "Cannot exec git-write-tree: $!\n";
 705                }
 706                chomp(my $tree = <C>);
 707                length($tree) == 40
 708                        or die "Cannot get tree id ($tree): $!\n";
 709                close(C)
 710                        or die "Error running git-write-tree: $?\n";
 711                print "Tree ID $tree\n" if $opt_v;
 712
 713                my $pr = IO::Pipe->new() or die "Cannot open pipe: $!\n";
 714                my $pw = IO::Pipe->new() or die "Cannot open pipe: $!\n";
 715                $pid = fork();
 716                die "Fork: $!\n" unless defined $pid;
 717                unless($pid) {
 718                        $pr->writer();
 719                        $pw->reader();
 720                        open(OUT,">&STDOUT");
 721                        dup2($pw->fileno(),0);
 722                        dup2($pr->fileno(),1);
 723                        $pr->close();
 724                        $pw->close();
 725
 726                        my @par = ();
 727
 728                        # loose detection of merges
 729                        # based on the commit msg
 730                        foreach my $rx (@mergerx) {
 731                                if ($message =~ $rx) {
 732                                        my $mparent = $1;
 733                                        if ($mparent eq 'HEAD') { $mparent = $opt_o };
 734                                        if ( -e "$git_dir/refs/heads/$mparent") {
 735                                                $mparent = get_headref($mparent, $git_dir);
 736                                                push (@parents, $mparent);
 737                                                print OUT "Merge parent branch: $mparent\n" if $opt_v;
 738                                        }
 739                                }
 740                        }
 741                        my %seen_parents = ();
 742                        my @unique_parents = grep { ! $seen_parents{$_} ++ } @parents;
 743                        foreach my $bparent (@unique_parents) {
 744                                push @par, '-p', $bparent;
 745                                print OUT "Merge parent branch: $bparent\n" if $opt_v;
 746                        }
 747
 748                        exec("env",
 749                                "GIT_AUTHOR_NAME=$author_name",
 750                                "GIT_AUTHOR_EMAIL=$author_email",
 751                                "GIT_AUTHOR_DATE=".strftime("+0000 %Y-%m-%d %H:%M:%S",gmtime($date)),
 752                                "GIT_COMMITTER_NAME=$author_name",
 753                                "GIT_COMMITTER_EMAIL=$author_email",
 754                                "GIT_COMMITTER_DATE=".strftime("+0000 %Y-%m-%d %H:%M:%S",gmtime($date)),
 755                                "git-commit-tree", $tree,@par);
 756                        die "Cannot exec git-commit-tree: $!\n";
 757                }
 758                $pw->writer();
 759                $pr->reader();
 760
 761                $message =~ s/[\s\n]+\z//;
 762                $message = "r$revision: $message" if $opt_r;
 763
 764                print $pw "$message\n"
 765                        or die "Error writing to git-commit-tree: $!\n";
 766                $pw->close();
 767
 768                print "Committed change $revision:$branch ".strftime("%Y-%m-%d %H:%M:%S",gmtime($date)).")\n" if $opt_v;
 769                chomp($cid = <$pr>);
 770                length($cid) == 40
 771                        or die "Cannot get commit id ($cid): $!\n";
 772                print "Commit ID $cid\n" if $opt_v;
 773                $pr->close();
 774
 775                waitpid($pid,0);
 776                die "Error running git-commit-tree: $?\n" if $?;
 777        }
 778
 779        if (not defined $cid) {
 780                $cid = $branches{"/"}{"LAST"};
 781        }
 782
 783        if(not defined $dest) {
 784                print "... no known parent\n" if $opt_v;
 785        } elsif(not $tag) {
 786                print "Writing to refs/heads/$dest\n" if $opt_v;
 787                open(C,">$git_dir/refs/heads/$dest") and
 788                print C ("$cid\n") and
 789                close(C)
 790                        or die "Cannot write branch $dest for update: $!\n";
 791        }
 792
 793        if($tag) {
 794                my($in, $out) = ('','');
 795                $last_rev = "-" if %$changed_paths;
 796                # the tag was 'complex', i.e. did not refer to a "real" revision
 797
 798                $dest =~ tr/_/\./ if $opt_u;
 799                $branch = $dest;
 800
 801                my $pid = open2($in, $out, 'git-mktag');
 802                print $out ("object $cid\n".
 803                    "type commit\n".
 804                    "tag $dest\n".
 805                    "tagger $author_name <$author_email>\n") and
 806                close($out)
 807                    or die "Cannot create tag object $dest: $!\n";
 808
 809                my $tagobj = <$in>;
 810                chomp $tagobj;
 811
 812                if ( !close($in) or waitpid($pid, 0) != $pid or
 813                                $? != 0 or $tagobj !~ /^[0123456789abcdef]{40}$/ ) {
 814                        die "Cannot create tag object $dest: $!\n";
 815                }
 816
 817                open(C,">$git_dir/refs/tags/$dest") and
 818                print C ("$tagobj\n") and
 819                close(C)
 820                        or die "Cannot create tag $branch: $!\n";
 821
 822                print "Created tag '$dest' on '$branch'\n" if $opt_v;
 823        }
 824        $branches{$branch}{"LAST"} = $cid;
 825        $branches{$branch}{$revision} = $cid;
 826        $last_rev = $cid;
 827        print BRANCHES "$revision $branch $cid\n";
 828        print "DONE: $revision $dest $cid\n" if $opt_v;
 829}
 830
 831sub commit_all {
 832        # Recursive use of the SVN connection does not work
 833        local $svn = $svn2;
 834
 835        my ($changed_paths, $revision, $author, $date, $message, $pool) = @_;
 836        my %p;
 837        while(my($path,$action) = each %$changed_paths) {
 838                $p{$path} = [ $action->action,$action->copyfrom_path, $action->copyfrom_rev, $path ];
 839        }
 840        $changed_paths = \%p;
 841
 842        my %done;
 843        my @col;
 844        my $pref;
 845        my $branch;
 846
 847        while(my($path,$action) = each %$changed_paths) {
 848                ($branch,$path) = split_path($revision,$path);
 849                next if not defined $branch;
 850                $done{$branch}{$path} = $action;
 851        }
 852        while(($branch,$changed_paths) = each %done) {
 853                commit($branch, $changed_paths, $revision, $author, $date, $message);
 854        }
 855}
 856
 857$opt_l = $svn->{'maxrev'} if not defined $opt_l or $opt_l > $svn->{'maxrev'};
 858
 859if ($opt_l < $current_rev) {
 860    print "Up to date: no new revisions to fetch!\n" if $opt_v;
 861    unlink("$git_dir/SVN2GIT_HEAD");
 862    exit;
 863}
 864
 865print "Fetching from $current_rev to $opt_l ...\n" if $opt_v;
 866
 867my $pool=SVN::Pool->new;
 868$svn->{'svn'}->get_log("/",$current_rev,$opt_l,0,1,1,\&commit_all,$pool);
 869$pool->clear;
 870
 871
 872unlink($git_index);
 873
 874if (defined $orig_git_index) {
 875        $ENV{GIT_INDEX_FILE} = $orig_git_index;
 876} else {
 877        delete $ENV{GIT_INDEX_FILE};
 878}
 879
 880# Now switch back to the branch we were in before all of this happened
 881if($orig_branch) {
 882        print "DONE\n" if $opt_v and (not defined $opt_l or $opt_l > 0);
 883        system("cp","$git_dir/refs/heads/$opt_o","$git_dir/refs/heads/master")
 884                if $forward_master;
 885        unless ($opt_i) {
 886                system('git-read-tree', '-m', '-u', 'SVN2GIT_HEAD', 'HEAD');
 887                die "read-tree failed: $?\n" if $?;
 888        }
 889} else {
 890        $orig_branch = "master";
 891        print "DONE; creating $orig_branch branch\n" if $opt_v and (not defined $opt_l or $opt_l > 0);
 892        system("cp","$git_dir/refs/heads/$opt_o","$git_dir/refs/heads/master")
 893                unless -f "$git_dir/refs/heads/master";
 894        system('git-update-ref', 'HEAD', "$orig_branch");
 895        unless ($opt_i) {
 896                system('git checkout');
 897                die "checkout failed: $?\n" if $?;
 898        }
 899}
 900unlink("$git_dir/SVN2GIT_HEAD");
 901close(BRANCHES);