aboutsummaryrefslogtreecommitdiff
path: root/contrib/git-svn/git-svn.perl
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/git-svn/git-svn.perl')
-rwxr-xr-xcontrib/git-svn/git-svn.perl429
1 files changed, 424 insertions, 5 deletions
diff --git a/contrib/git-svn/git-svn.perl b/contrib/git-svn/git-svn.perl
index d8f103ed9..d5c7e4796 100755
--- a/contrib/git-svn/git-svn.perl
+++ b/contrib/git-svn/git-svn.perl
@@ -35,8 +35,8 @@ my $sha1_short = qr/[a-f\d]{4,40}/;
my ($_revision,$_stdin,$_no_ignore_ext,$_no_stop_copy,$_help,$_rmdir,$_edit,
$_find_copies_harder, $_l, $_cp_similarity,
$_repack, $_repack_nr, $_repack_flags,
- $_template, $_shared,
- $_version, $_upgrade, $_authors, $_branch_all_refs);
+ $_template, $_shared, $_no_default_regex, $_no_graft_copy,
+ $_version, $_upgrade, $_authors, $_branch_all_refs, @_opt_m);
my (@_branch_from, %tree_map, %users);
my ($_svn_co_url_revs, $_svn_pg_peg_revs);
my @repo_path_split_cache;
@@ -48,6 +48,12 @@ my %fc_opts = ( 'no-ignore-externals' => \$_no_ignore_ext,
'repack:i' => \$_repack,
'repack-flags|repack-args|repack-opts=s' => \$_repack_flags);
+my ($_trunk, $_tags, $_branches);
+my %multi_opts = ( 'trunk|T=s' => \$_trunk,
+ 'tags|t=s' => \$_tags,
+ 'branches|b=s' => \$_branches );
+my %init_opts = ( 'template=s' => \$_template, 'shared' => \$_shared );
+
# yes, 'native' sets "\n". Patches to fix this for non-*nix systems welcome:
my %EOL = ( CR => "\015", LF => "\012", CRLF => "\015\012", native => "\012" );
@@ -56,8 +62,7 @@ my %cmd = (
{ 'revision|r=s' => \$_revision, %fc_opts } ],
init => [ \&init, "Initialize a repo for tracking" .
" (requires URL argument)",
- { 'template=s' => \$_template,
- 'shared' => \$_shared } ],
+ \%init_opts ],
commit => [ \&commit, "Commit git revisions to SVN",
{ 'stdin|' => \$_stdin,
'edit|e' => \$_edit,
@@ -71,7 +76,19 @@ my %cmd = (
rebuild => [ \&rebuild, "Rebuild git-svn metadata (after git clone)",
{ 'no-ignore-externals' => \$_no_ignore_ext,
'upgrade' => \$_upgrade } ],
+ 'graft-branches' => [ \&graft_branches,
+ 'Detect merges/branches from already imported history',
+ { 'merge-rx|m' => \@_opt_m,
+ 'no-default-regex' => \$_no_default_regex,
+ 'no-graft-copy' => \$_no_graft_copy } ],
+ 'multi-init' => [ \&multi_init,
+ 'Initialize multiple trees (like git-svnimport)',
+ { %multi_opts, %fc_opts } ],
+ 'multi-fetch' => [ \&multi_fetch,
+ 'Fetch multiple trees (like git-svnimport)',
+ \%fc_opts ],
);
+
my $cmd;
for (my $i = 0; $i < @ARGV; $i++) {
if (defined $cmd{$ARGV[$i]}) {
@@ -96,7 +113,7 @@ init_vars();
load_authors() if $_authors;
load_all_refs() if $_branch_all_refs;
svn_compat_check();
-migration_check() unless $cmd eq 'init';
+migration_check() unless $cmd =~ /^(?:init|multi-init)$/;
$cmd{$cmd}->[0]->(@ARGV);
exit 0;
@@ -219,6 +236,7 @@ when you have upgraded your tools and habits to use refs/remotes/$GIT_SVN
sub init {
$SVN_URL = shift or die "SVN repository location required " .
"as a command-line argument\n";
+ $SVN_URL =~ s!/+$!!; # strip trailing slash
unless (-d $GIT_DIR) {
my @init_db = ('git-init-db');
push @init_db, "--template=$_template" if defined $_template;
@@ -358,8 +376,283 @@ sub show_ignore {
}
}
+sub graft_branches {
+ my $gr_file = "$GIT_DIR/info/grafts";
+ my ($grafts, $comments) = read_grafts($gr_file);
+ my $gr_sha1;
+
+ if (%$grafts) {
+ # temporarily disable our grafts file to make this idempotent
+ chomp($gr_sha1 = safe_qx(qw/git-hash-object -w/,$gr_file));
+ rename $gr_file, "$gr_file~$gr_sha1" or croak $!;
+ }
+
+ my $l_map = read_url_paths();
+ my @re = map { qr/$_/is } @_opt_m if @_opt_m;
+ unless ($_no_default_regex) {
+ push @re, ( qr/\b(?:merge|merging|merged)\s+(\S.+)/is,
+ qr/\b(?:from|of)\s+(\S.+)/is );
+ }
+ foreach my $u (keys %$l_map) {
+ if (@re) {
+ foreach my $p (keys %{$l_map->{$u}}) {
+ graft_merge_msg($grafts,$l_map,$u,$p);
+ }
+ }
+ graft_file_copy($grafts,$l_map,$u) unless $_no_graft_copy;
+ }
+
+ write_grafts($grafts, $comments, $gr_file);
+ unlink "$gr_file~$gr_sha1" if $gr_sha1;
+}
+
+sub multi_init {
+ my $url = shift;
+ $_trunk ||= 'trunk';
+ $_trunk =~ s#/+$##;
+ $url =~ s#/+$## if $url;
+ if ($_trunk !~ m#^[a-z\+]+://#) {
+ $_trunk = '/' . $_trunk if ($_trunk !~ m#^/#);
+ unless ($url) {
+ print STDERR "E: '$_trunk' is not a complete URL ",
+ "and a separate URL is not specified\n";
+ exit 1;
+ }
+ $_trunk = $url . $_trunk;
+ }
+ if ($GIT_SVN eq 'git-svn') {
+ print "GIT_SVN_ID set to 'trunk' for $_trunk\n";
+ $GIT_SVN = $ENV{GIT_SVN_ID} = 'trunk';
+ }
+ init_vars();
+ init($_trunk);
+ complete_url_ls_init($url, $_branches, '--branches/-b', '');
+ complete_url_ls_init($url, $_tags, '--tags/-t', 'tags/');
+}
+
+sub multi_fetch {
+ # try to do trunk first, since branches/tags
+ # may be descended from it.
+ if (-d "$GIT_DIR/svn/trunk") {
+ print "Fetching trunk\n";
+ defined(my $pid = fork) or croak $!;
+ if (!$pid) {
+ $GIT_SVN = $ENV{GIT_SVN_ID} = 'trunk';
+ init_vars();
+ fetch(@_);
+ exit 0;
+ }
+ waitpid $pid, 0;
+ croak $? if $?;
+ }
+ rec_fetch('', "$GIT_DIR/svn", @_);
+}
+
########################### utility functions #########################
+sub rec_fetch {
+ my ($pfx, $p, @args) = @_;
+ my @dir;
+ foreach (sort <$p/*>) {
+ if (-r "$_/info/url") {
+ $pfx .= '/' if $pfx && $pfx !~ m!/$!;
+ my $id = $pfx . basename $_;
+ next if $id eq 'trunk';
+ print "Fetching $id\n";
+ defined(my $pid = fork) or croak $!;
+ if (!$pid) {
+ $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
+ init_vars();
+ fetch(@args);
+ exit 0;
+ }
+ waitpid $pid, 0;
+ croak $? if $?;
+ } elsif (-d $_) {
+ push @dir, $_;
+ }
+ }
+ foreach (@dir) {
+ my $x = $_;
+ $x =~ s!^\Q$GIT_DIR\E/svn/!!;
+ rec_fetch($x, $_);
+ }
+}
+
+sub complete_url_ls_init {
+ my ($url, $var, $switch, $pfx) = @_;
+ unless ($var) {
+ print STDERR "W: $switch not specified\n";
+ return;
+ }
+ $var =~ s#/+$##;
+ if ($var !~ m#^[a-z\+]+://#) {
+ $var = '/' . $var if ($var !~ m#^/#);
+ unless ($url) {
+ print STDERR "E: '$var' is not a complete URL ",
+ "and a separate URL is not specified\n";
+ exit 1;
+ }
+ $var = $url . $var;
+ }
+ chomp(my @ls = safe_qx(qw/svn ls --non-interactive/, $var));
+ my $old = $GIT_SVN;
+ defined(my $pid = fork) or croak $!;
+ if (!$pid) {
+ foreach my $u (map { "$var/$_" } (grep m!/$!, @ls)) {
+ $u =~ s#/+$##;
+ if ($u !~ m!\Q$var\E/(.+)$!) {
+ print STDERR "W: Unrecognized URL: $u\n";
+ die "This should never happen\n";
+ }
+ my $id = $pfx.$1;
+ print "init $u => $id\n";
+ $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
+ init_vars();
+ init($u);
+ }
+ exit 0;
+ }
+ waitpid $pid, 0;
+ croak $? if $?;
+}
+
+sub common_prefix {
+ my $paths = shift;
+ my %common;
+ foreach (@$paths) {
+ my @tmp = split m#/#, $_;
+ my $p = '';
+ while (my $x = shift @tmp) {
+ $p .= "/$x";
+ $common{$p} ||= 0;
+ $common{$p}++;
+ }
+ }
+ foreach (sort {length $b <=> length $a} keys %common) {
+ if ($common{$_} == @$paths) {
+ return $_;
+ }
+ }
+ return '';
+}
+
+# this isn't funky-filename safe, but good enough for now...
+sub graft_file_copy {
+ my ($grafts, $l_map, $u) = @_;
+ my $paths = $l_map->{$u};
+ my $pfx = common_prefix([keys %$paths]);
+
+ my $pid = open my $fh, '-|';
+ defined $pid or croak $!;
+ unless ($pid) {
+ exec(qw/svn log -v/, $u.$pfx) or croak $!;
+ }
+ my ($r, $mp) = (undef, undef);
+ while (<$fh>) {
+ chomp;
+ if (/^\-{72}$/) {
+ $mp = $r = undef;
+ } elsif (/^r(\d+) \| /) {
+ $r = $1 unless defined $r;
+ } elsif (/^Changed paths:/) {
+ $mp = 1;
+ } elsif ($mp && m#^ [AR] /(\S.*?) \(from /(\S+?):(\d+)\)$#) {
+ my $dbg = "r$r | $_";
+ my ($p1, $p0, $r0) = ($1, $2, $3);
+ my $c;
+ foreach my $x (keys %$paths) {
+ next unless ($p1 =~ /^\Q$x\E/);
+ my $i = $paths->{$x};
+ my $f = "$GIT_DIR/svn/$i/revs/$r";
+ unless (-r $f) {
+ print STDERR "r$r of $i not imported,",
+ " $dbg\n";
+ next;
+ }
+ $c = file_to_s($f);
+ }
+ next unless $c;
+ foreach my $x (keys %$paths) {
+ next unless ($p0 =~ /^\Q$x\E/);
+ my $i = $paths->{$x};
+ my $f = "$GIT_DIR/svn/$i/revs/$r0";
+ while ($r0 && !-r $f) {
+ # could be an older revision, too...
+ $r0--;
+ $f = "$GIT_DIR/svn/$i/revs/$r0";
+ }
+ unless (-r $f) {
+ print STDERR "r$r0 of $i not imported,",
+ " $dbg\n";
+ next;
+ }
+ my $r1 = file_to_s($f);
+ $grafts->{$c}->{$r1} = 1;
+ }
+ }
+ }
+}
+
+sub process_merge_msg_matches {
+ my ($grafts, $l_map, $u, $p, $c, @matches) = @_;
+ my (@strong, @weak);
+ foreach (@matches) {
+ # merging with ourselves is not interesting
+ next if $_ eq $p;
+ if ($l_map->{$u}->{$_}) {
+ push @strong, $_;
+ } else {
+ push @weak, $_;
+ }
+ }
+ foreach my $w (@weak) {
+ last if @strong;
+ # no exact match, use branch name as regexp.
+ my $re = qr/\Q$w\E/i;
+ foreach (keys %{$l_map->{$u}}) {
+ if (/$re/) {
+ push @strong, $_;
+ last;
+ }
+ }
+ last if @strong;
+ $w = basename($w);
+ $re = qr/\Q$w\E/i;
+ foreach (keys %{$l_map->{$u}}) {
+ if (/$re/) {
+ push @strong, $_;
+ last;
+ }
+ }
+ }
+ my ($rev) = ($c->{m} =~ /^git-svn-id:\s(?:\S+?)\@(\d+)
+ \s(?:[a-f\d\-]+)$/xsm);
+ unless (defined $rev) {
+ ($rev) = ($c->{m} =~/^git-svn-id:\s(\d+)
+ \@(?:[a-f\d\-]+)/xsm);
+ return unless defined $rev;
+ }
+ foreach my $m (@strong) {
+ my ($r0, $s0) = find_rev_before($rev, $m);
+ $grafts->{$c->{c}}->{$s0} = 1 if defined $s0;
+ }
+}
+
+sub graft_merge_msg {
+ my ($grafts, $l_map, $u, $p, @re) = @_;
+
+ my $x = $l_map->{$u}->{$p};
+ my $rl = rev_list_raw($x);
+ while (my $c = next_rev_list_entry($rl)) {
+ foreach my $re (@re) {
+ my (@br) = ($c->{m} =~ /$re/g);
+ next unless @br;
+ process_merge_msg_matches($grafts,$l_map,$u,$p,$c,@br);
+ }
+ }
+}
+
sub read_uuid {
return if $SVN_UUID;
my $info = shift || svn_info('.');
@@ -402,6 +695,7 @@ sub repo_path_split {
$url .= "/$n";
}
push @repo_path_split_cache, qr/^(\Q$url\E)/;
+ $path = join('/',@paths);
return ($url, $path);
}
@@ -806,6 +1100,38 @@ sub svn_commit_tree {
return fetch("$committed=$commit")->{revision};
}
+sub rev_list_raw {
+ my (@args) = @_;
+ my $pid = open my $fh, '-|';
+ defined $pid or croak $!;
+ if (!$pid) {
+ exec(qw/git-rev-list --pretty=raw/, @args) or croak $!;
+ }
+ return { fh => $fh, t => { } };
+}
+
+sub next_rev_list_entry {
+ my $rl = shift;
+ my $fh = $rl->{fh};
+ my $x = $rl->{t};
+ while (<$fh>) {
+ if (/^commit ($sha1)$/o) {
+ if ($x->{c}) {
+ $rl->{t} = { c => $1 };
+ return $x;
+ } else {
+ $x->{c} = $1;
+ }
+ } elsif (/^parent ($sha1)$/o) {
+ $x->{p}->{$1} = 1;
+ } elsif (s/^ //) {
+ $x->{m} ||= '';
+ $x->{m} .= $_;
+ }
+ }
+ return ($x != $rl->{t}) ? $x : undef;
+}
+
# read the entire log into a temporary file (which is removed ASAP)
# and store the file handle + parser state
sub svn_log_raw {
@@ -1318,6 +1644,16 @@ sub svn_propget_base {
return safe_qx(qw/svn propget/, $p, $f);
}
+sub git_svn_each {
+ my $sub = shift;
+ foreach (`git-rev-parse --symbolic --all`) {
+ next unless s#^refs/remotes/##;
+ chomp $_;
+ next unless -f "$GIT_DIR/svn/$_/info/url";
+ &$sub($_);
+ }
+}
+
sub migration_check {
return if (-d "$GIT_DIR/svn" || !-d $GIT_DIR);
print "Upgrading repository...\n";
@@ -1344,6 +1680,16 @@ sub migration_check {
print "Done upgrading.\n";
}
+sub find_rev_before {
+ my ($r, $git_svn_id) = @_;
+ my @revs = map { basename $_ } <$GIT_DIR/svn/$git_svn_id/revs/*>;
+ foreach my $r0 (sort { $b <=> $a } @revs) {
+ next if $r0 >= $r;
+ return ($r0, file_to_s("$GIT_DIR/svn/$git_svn_id/revs/$r0"));
+ }
+ return (undef, undef);
+}
+
sub init_vars {
$GIT_SVN ||= $ENV{GIT_SVN_ID} || 'git-svn';
$GIT_SVN_DIR = "$GIT_DIR/svn/$GIT_SVN";
@@ -1384,6 +1730,79 @@ sub set_default_vals {
}
}
+sub read_grafts {
+ my $gr_file = shift;
+ my ($grafts, $comments) = ({}, {});
+ if (open my $fh, '<', $gr_file) {
+ my @tmp;
+ while (<$fh>) {
+ if (/^($sha1)\s+/) {
+ my $c = $1;
+ if (@tmp) {
+ @{$comments->{$c}} = @tmp;
+ @tmp = ();
+ }
+ foreach my $p (split /\s+/, $_) {
+ $grafts->{$c}->{$p} = 1;
+ }
+ } else {
+ push @tmp, $_;
+ }
+ }
+ close $fh or croak $!;
+ @{$comments->{'END'}} = @tmp if @tmp;
+ }
+ return ($grafts, $comments);
+}
+
+sub write_grafts {
+ my ($grafts, $comments, $gr_file) = @_;
+
+ open my $fh, '>', $gr_file or croak $!;
+ foreach my $c (sort keys %$grafts) {
+ if ($comments->{$c}) {
+ print $fh $_ foreach @{$comments->{$c}};
+ }
+ my $p = $grafts->{$c};
+ delete $p->{$c}; # commits are not self-reproducing...
+ my $pid = open my $ch, '-|';
+ defined $pid or croak $!;
+ if (!$pid) {
+ exec(qw/git-cat-file commit/, $c) or croak $!;
+ }
+ while (<$ch>) {
+ if (/^parent ([a-f\d]{40})/) {
+ $p->{$1} = 1;
+ } else {
+ last unless /^\S/i;
+ }
+ }
+ close $ch; # breaking the pipe
+ print $fh $c, ' ', join(' ', sort keys %$p),"\n";
+ }
+ if ($comments->{'END'}) {
+ print $fh $_ foreach @{$comments->{'END'}};
+ }
+ close $fh or croak $!;
+}
+
+sub read_url_paths {
+ my $l_map = {};
+ git_svn_each(sub { my $x = shift;
+ my $u = file_to_s("$GIT_DIR/svn/$x/info/repo_url");
+ my $p = file_to_s("$GIT_DIR/svn/$x/info/repo_path");
+ # we hate trailing slashes
+ if ($u =~ s#(?:^\/+|\/+$)##g) {
+ s_to_file($u,"$GIT_DIR/svn/$x/info/repo_url");
+ }
+ if ($p =~ s#(?:^\/+|\/+$)##g) {
+ s_to_file($p,"$GIT_DIR/svn/$x/info/repo_path");
+ }
+ $l_map->{$u}->{$p} = $x;
+ });
+ return $l_map;
+}
+
__END__
Data structures: