X-Git-Url: https://git.tokkee.org/?a=blobdiff_plain;f=git-svn.perl;h=49dd649bc562ac1b8e5da708ba91572b5e0f0c11;hb=6954ef206343d366c365f5946caa967f92d7bab1;hp=650c9e5f02ead07351629d6572e82c3a9ac7ef92;hpb=8fb5d44a47dd3657c8be0de5dcf220935b04e98e;p=git.git

diff --git a/git-svn.perl b/git-svn.perl
index 650c9e5f0..49dd649bc 100755
--- a/git-svn.perl
+++ b/git-svn.perl
@@ -26,6 +26,7 @@ if (! exists $ENV{SVN_SSH}) {
 		$ENV{SVN_SSH} = $ENV{GIT_SSH};
 		if ($^O eq 'msys') {
 			$ENV{SVN_SSH} =~ s/\\/\\\\/g;
+			$ENV{SVN_SSH} =~ s/(.*)/"$1"/;
 		}
 	}
 }
@@ -35,11 +36,13 @@ $ENV{TZ} = 'UTC';
 $| = 1; # unbuffer STDOUT
 
 sub fatal (@) { print STDERR "@_\n"; exit 1 }
-require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
-require SVN::Ra;
-require SVN::Delta;
-if ($SVN::Core::VERSION lt '1.1.0') {
-	fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)";
+sub _req_svn {
+	require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
+	require SVN::Ra;
+	require SVN::Delta;
+	if ($SVN::Core::VERSION lt '1.1.0') {
+		fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)";
+	}
 }
 my $can_compress = eval { require Compress::Zlib; 1};
 push @Git::SVN::Ra::ISA, 'SVN::Ra';
@@ -115,6 +118,7 @@ my %init_opts = ( 'template=s' => \$_template, 'shared:s' => \$_shared,
 		  'use-svm-props' => sub { $icv{useSvmProps} = 1 },
 		  'use-svnsync-props' => sub { $icv{useSvnsyncProps} = 1 },
 		  'rewrite-root=s' => sub { $icv{rewriteRoot} = $_[1] },
+		  'rewrite-uuid=s' => sub { $icv{rewriteUUID} = $_[1] },
                   %remote_opts );
 my %cmt_opts = ( 'edit|e' => \$_edit,
 		'rmdir' => \$SVN::Git::Editor::_rmdir,
@@ -155,12 +159,16 @@ my %cmd = (
 	            { 'message|m=s' => \$_message,
 	              'destination|d=s' => \$_branch_dest,
 	              'dry-run|n' => \$_dry_run,
-		      'tag|t' => \$_tag } ],
+	              'tag|t' => \$_tag,
+	              'username=s' => \$Git::SVN::Prompt::_username,
+	              'commit-url=s' => \$_commit_url } ],
 	tag => [ sub { $_tag = 1; cmd_branch(@_) },
 	         'Create a tag in the SVN repository',
 	         { 'message|m=s' => \$_message,
 	           'destination|d=s' => \$_branch_dest,
-	           'dry-run|n' => \$_dry_run } ],
+	           'dry-run|n' => \$_dry_run,
+	           'username=s' => \$Git::SVN::Prompt::_username,
+	           'commit-url=s' => \$_commit_url } ],
 	'set-tree' => [ \&cmd_set_tree,
 	                "Set an SVN repository to a git tree-ish",
 			{ 'stdin' => \$_stdin, %cmt_opts, %fc_opts, } ],
@@ -708,7 +716,23 @@ sub cmd_branch {
 		}
 	}
 	my ($lft, $rgt) = @{ $glob->{path} }{qw/left right/};
-	my $dst = join '/', $remote->{url}, $lft, $branch_name, ($rgt || ());
+	my $url;
+	if (defined $_commit_url) {
+		$url = $_commit_url;
+	} else {
+		$url = eval { command_oneline('config', '--get',
+			"svn-remote.$gs->{repo_id}.commiturl") };
+		if (!$url) {
+			$url = $remote->{url};
+		}
+	}
+	my $dst = join '/', $url, $lft, $branch_name, ($rgt || ());
+
+	if ($dst =~ /^https:/ && $src =~ /^http:/) {
+		$src=~s/^http:/https:/;
+	}
+
+	::_req_svn();
 
 	my $ctx = SVN::Client->new(
 		auth    => Git::SVN::Ra::_auth_providers(),
@@ -1636,6 +1660,7 @@ use File::Path qw/mkpath/;
 use File::Copy qw/copy/;
 use IPC::Open3;
 use Memoize;  # core since 5.8.0, Jul 2002
+use Memoize::Storable;
 
 my ($_gc_nr, $_gc_period);
 
@@ -1806,8 +1831,8 @@ sub read_all_remotes {
 			my $rs = {
 			    t => $t,
 			    remote => $remote,
-			    path => Git::SVN::GlobSpec->new($local_ref),
-			    ref => Git::SVN::GlobSpec->new($remote_ref) };
+			    path => Git::SVN::GlobSpec->new($local_ref, 1),
+			    ref => Git::SVN::GlobSpec->new($remote_ref, 0) };
 			if (length($rs->{ref}->{right}) != 0) {
 				die "The '*' glob character must be the last ",
 				    "character of '$remote_ref'\n";
@@ -2189,6 +2214,10 @@ sub svnsync {
 		die "Can't have both 'useSvnsyncProps' and 'rewriteRoot' ",
 		    "options set!\n";
 	}
+	if ($self->rewrite_uuid) {
+		die "Can't have both 'useSvnsyncProps' and 'rewriteUUID' ",
+		    "options set!\n";
+	}
 
 	my $svnsync;
 	# see if we have it in our config, first:
@@ -2470,6 +2499,20 @@ sub rewrite_root {
 	$self->{-rewrite_root} = $rwr;
 }
 
+sub rewrite_uuid {
+	my ($self) = @_;
+	return $self->{-rewrite_uuid} if exists $self->{-rewrite_uuid};
+	my $k = "svn-remote.$self->{repo_id}.rewriteUUID";
+	my $rwid = eval { command_oneline(qw/config --get/, $k) };
+	if ($rwid) {
+		$rwid =~ s#/+$##;
+		if ($rwid !~ m#^[a-f0-9]{8}-(?:[a-f0-9]{4}-){3}[a-f0-9]{12}$#) {
+			die "$rwid is not a valid UUID (key: $k)\n";
+		}
+	}
+	$self->{-rewrite_uuid} = $rwid;
+}
+
 sub metadata_url {
 	my ($self) = @_;
 	($self->rewrite_root || $self->{url}) .
@@ -3052,12 +3095,65 @@ sub check_cherry_pick {
 	for my $range ( @ranges ) {
 		delete @commits{_rev_list($range)};
 	}
+	for my $commit (keys %commits) {
+		if (has_no_changes($commit)) {
+			delete $commits{$commit};
+		}
+	}
 	return (keys %commits);
 }
 
-BEGIN {
-	memoize 'lookup_svn_merge';
-	memoize 'check_cherry_pick';
+sub has_no_changes {
+	my $commit = shift;
+
+	my @revs = split / /, command_oneline(
+		qw(rev-list --parents -1 -m), $commit);
+
+	# Commits with no parents, e.g. the start of a partial branch,
+	# have changes by definition.
+	return 1 if (@revs < 2);
+
+	# Commits with multiple parents, e.g a merge, have no changes
+	# by definition.
+	return 0 if (@revs > 2);
+
+	return (command_oneline("rev-parse", "$commit^{tree}") eq
+		command_oneline("rev-parse", "$commit~1^{tree}"));
+}
+
+# The GIT_DIR environment variable is not always set until after the command
+# line arguments are processed, so we can't memoize in a BEGIN block.
+{
+	my $memoized = 0;
+
+	sub memoize_svn_mergeinfo_functions {
+		return if $memoized;
+		$memoized = 1;
+
+		my $cache_path = "$ENV{GIT_DIR}/svn/.caches/";
+		mkpath([$cache_path]) unless -d $cache_path;
+
+		tie my %lookup_svn_merge_cache => 'Memoize::Storable',
+		    "$cache_path/lookup_svn_merge.db", 'nstore';
+		memoize 'lookup_svn_merge',
+			SCALAR_CACHE => 'FAULT',
+			LIST_CACHE => ['HASH' => \%lookup_svn_merge_cache],
+		;
+
+		tie my %check_cherry_pick_cache => 'Memoize::Storable',
+		    "$cache_path/check_cherry_pick.db", 'nstore';
+		memoize 'check_cherry_pick',
+			SCALAR_CACHE => 'FAULT',
+			LIST_CACHE => ['HASH' => \%check_cherry_pick_cache],
+		;
+
+		tie my %has_no_changes_cache => 'Memoize::Storable',
+		    "$cache_path/has_no_changes.db", 'nstore';
+		memoize 'has_no_changes',
+			SCALAR_CACHE => ['HASH' => \%has_no_changes_cache],
+			LIST_CACHE => 'FAULT',
+		;
+	}
 }
 
 sub parents_exclude {
@@ -3101,6 +3197,8 @@ sub find_extra_svn_parents {
 	my ($self, $ed, $mergeinfo, $parents) = @_;
 	# aha!  svk:merge property changed...
 
+	memoize_svn_mergeinfo_functions();
+
 	# We first search for merged tips which are not in our
 	# history.  Then, we figure out which git revisions are in
 	# that tip, but not this revision.  If all of those revisions
@@ -3134,10 +3232,21 @@ sub find_extra_svn_parents {
 		my $ranges = $ranges{$merge_tip};
 
 		# check out 'new' tips
-		my $merge_base = command_oneline(
-			"merge-base",
-			@$parents, $merge_tip,
-		       );
+		my $merge_base;
+		eval {
+			$merge_base = command_oneline(
+				"merge-base",
+				@$parents, $merge_tip,
+			);
+		};
+		if ($@) {
+			die "An error occurred during merge-base"
+				unless $@->isa("Git::Error::Command");
+
+			warn "W: Cannot find common ancestor between ".
+			     "@$parents and $merge_tip. Ignoring merge info.\n";
+			next;
+		}
 
 		# double check that there are no missing non-merge commits
 		my (@incomplete) = check_cherry_pick(
@@ -3168,7 +3277,7 @@ sub find_extra_svn_parents {
 					"$new_parents[$i]..$new_parents[$j]",
 				       );
 				if ( !$revs ) {
-					undef($new_parents[$i]);
+					undef($new_parents[$j]);
 				}
 			}
 		}
@@ -3253,6 +3362,10 @@ sub make_log_entry {
 			die "Can't have both 'useSvmProps' and 'rewriteRoot' ",
 			    "options set!\n";
 		}
+		if ($self->rewrite_uuid) {
+			die "Can't have both 'useSvmProps' and 'rewriteUUID' ",
+			    "options set!\n";
+		}
 		my ($uuid, $r) = $headrev =~ m{^([a-f\d\-]{30,}):(\d+)$}i;
 		# we don't want "SVM: initializing mirror for junk" ...
 		return undef if $r == 0;
@@ -3283,10 +3396,10 @@ sub make_log_entry {
 	} else {
 		my $url = $self->metadata_url;
 		remove_username($url);
-		$log_entry{metadata} = "$url\@$rev " .
-		                       $self->ra->get_uuid;
-		$email ||= "$author\@" . $self->ra->get_uuid;
-		$commit_email ||= "$author\@" . $self->ra->get_uuid;
+		my $uuid = $self->rewrite_uuid || $self->ra->get_uuid;
+		$log_entry{metadata} = "$url\@$rev " . $uuid;
+		$email ||= "$author\@" . $uuid;
+		$commit_email ||= "$author\@" . $uuid;
 	}
 	$log_entry{name} = $name;
 	$log_entry{email} = $email;
@@ -3368,7 +3481,7 @@ sub rebuild {
 				'--');
 	my $metadata_url = $self->metadata_url;
 	remove_username($metadata_url);
-	my $svn_uuid = $self->ra_uuid;
+	my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid;
 	my $c;
 	while (<$log>) {
 		if ( m{^commit ($::sha1)$} ) {
@@ -4750,6 +4863,8 @@ sub new {
 	$url =~ s!/+$!!;
 	return $RA if ($RA && $RA->{url} eq $url);
 
+	::_req_svn();
+
 	SVN::_Core::svn_config_ensure($config_dir, undef);
 	my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers);
 	my $config = SVN::Core::config_get_config($config_dir);
@@ -5157,6 +5272,7 @@ sub match_globs {
 			next if (length $g->{path}->{right} &&
 				 ($self->check_path($p, $r) !=
 				  $SVN::Node::dir));
+			next unless $p =~ /$g->{path}->{regex}/;
 			$exists->{$p} = Git::SVN->init($self->{url}, $p, undef,
 					 $g->{ref}->full_path($de), 1);
 		}
@@ -5930,29 +6046,48 @@ use strict;
 use warnings;
 
 sub new {
-	my ($class, $glob) = @_;
+	my ($class, $glob, $pattern_ok) = @_;
 	my $re = $glob;
 	$re =~ s!/+$!!g; # no need for trailing slashes
-	$re =~ m!^([^*]*)(\*(?:/\*)*)(.*)$!;
-	my $temp = $re;
-	my ($left, $right) = ($1, $3);
-	$re = $2;
-	my $depth = $re =~ tr/*/*/;
-	if ($depth != $temp =~ tr/*/*/) {
-		die "Only one set of wildcard directories " .
-			"(e.g. '*' or '*/*/*') is supported: '$glob'\n";
+	my (@left, @right, @patterns);
+	my $state = "left";
+	my $die_msg = "Only one set of wildcard directories " .
+				"(e.g. '*' or '*/*/*') is supported: '$glob'\n";
+	for my $part (split(m|/|, $glob)) {
+		if ($part =~ /\*/ && $part ne "*") {
+			die "Invalid pattern in '$glob': $part\n";
+		} elsif ($pattern_ok && $part =~ /[{}]/ &&
+			 $part !~ /^\{[^{}]+\}/) {
+			die "Invalid pattern in '$glob': $part\n";
+		}
+		if ($part eq "*") {
+			die $die_msg if $state eq "right";
+			$state = "pattern";
+			push(@patterns, "[^/]*");
+		} elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) {
+			die $die_msg if $state eq "right";
+			$state = "pattern";
+			my $p = quotemeta($1);
+			$p =~ s/\\,/|/g;
+			push(@patterns, "(?:$p)");
+		} else {
+			if ($state eq "left") {
+				push(@left, $part);
+			} else {
+				push(@right, $part);
+				$state = "right";
+			}
+		}
 	}
+	my $depth = @patterns;
 	if ($depth == 0) {
-		die "One '*' is needed for glob: '$glob'\n";
-	}
-	$re =~ s!\*!\[^/\]*!g;
-	$re = quotemeta($left) . "($re)" . quotemeta($right);
-	if (length $left && !($left =~ s!/+$!!g)) {
-		die "Missing trailing '/' on left side of: '$glob' ($left)\n";
-	}
-	if (length $right && !($right =~ s!^/+!!g)) {
-		die "Missing leading '/' on right side of: '$glob' ($right)\n";
+		die "One '*' is needed in glob: '$glob'\n";
 	}
+	my $left = join('/', @left);
+	my $right = join('/', @right);
+	$re = join('/', @patterns);
+	$re = join('\/',
+		   grep(length, quotemeta($left), "($re)", quotemeta($right)));
 	my $left_re = qr/^\/\Q$left\E(\/|$)/;
 	bless { left => $left, right => $right, left_regex => $left_re,
 	        regex => qr/$re/, glob => $glob, depth => $depth }, $class;