From: Joey Hess <joey@kitenet.net>
Date: Fri, 16 Dec 2011 17:27:54 +0000 (-0400)
Subject: Remove dir_test hack and add a way for vcs tests to run perl code, using this for... 
X-Git-Url: https://git.madduck.net/code/myrepos.git/commitdiff_plain/52a0974a2497b483d88c49377283c9b8f2520a85?ds=inline;hp=09af48cd838965e18f3b408d931fd0c8c44a16aa

Remove dir_test hack and add a way for vcs tests to run perl code, using this for the same optimisation. Fixes support for git-svn etc. Closes: #652317
---

diff --git a/debian/changelog b/debian/changelog
index 9d97161..d477625 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,11 @@
+mr (1.09) unstable; urgency=low
+
+  * Remove dir_test hack and add a way for vcs tests to run perl code,
+    using this for the same optimisation. Fixes support for git-svn
+    etc. Closes: #652317
+
+ -- Joey Hess <joeyh@debian.org>  Fri, 16 Dec 2011 13:29:40 -0400
+
 mr (1.08) unstable; urgency=low
 
   * Fix vcs test code. Closes: #651976
diff --git a/lib/git-fake-bare b/lib/git-fake-bare
index 7a04fa6..5091d95 100644
--- a/lib/git-fake-bare
+++ b/lib/git-fake-bare
@@ -42,10 +42,10 @@ lib =
 		echo "$worktree"
 	}
 
-git_fake_bare_test = 
-	test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
-	test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
-	test `GIT_DIR="$MR_REPO" git config --get core.worktree`
+git_fake_bare_test = perl:
+	-d "$ENV{MR_REPO}/refs/heads" && -d "$ENV{MR_REPO}/refs/tags" &&
+	-d "$ENV{MR_REPO}/objects" && -f "$ENV{MR_REPO}/config" &&
+	`GIT_DIR="$ENV{MR_REPO}" git config --get core.worktree` ne ""
 
 git_fake_bare_update =
 	args="$@"
diff --git a/lib/git-svn b/lib/git-svn
index bcdb545..6cb9207 100644
--- a/lib/git-svn
+++ b/lib/git-svn
@@ -16,13 +16,13 @@ git_svn_record = git commit -a "$@"
 git_svn_diff = git diff "$@"
 git_svn_log = git svn log "$@"
 
-git_test =
-	test -d "$MR_REPO"/.git &&
-	test -z "$(GIT_CONFIG="$MR_REPO"/.git/config git config --get svn-remote.svn.url)"
+git_test = perl:
+	-d "$ENV{MR_REPO}/.git" &&
+	`GIT_CONFIG="$ENV{MR_REPO}"/.git/config git config --get svn-remote.svn.url` eq ""
 
-git_svn_test =
-	test -d "$MR_REPO"/.git &&
-	test -n "$(GIT_CONFIG="$MR_REPO"/.git/config git config --get svn-remote.svn.url)"
+git_svn_test = perl:
+	-d "$ENV{MR_REPO}/.git" &&
+	`GIT_CONFIG="$ENV{MR_REPO}"/.git/config git config --get svn-remote.svn.url` ne ""
 
 git_svn_register =
 	url="`LC_ALL=C git config --get svn-remote.svn.url`" || true
diff --git a/lib/vcsh b/lib/vcsh
index fed9de4..6681efd 100644
--- a/lib/vcsh
+++ b/lib/vcsh
@@ -6,10 +6,10 @@
 #[$HOME/.config/vcsh/repo.d/zsh.git]
 #checkout = vcsh clone git://github.com/RichiH/zshrc.git zsh
 
-vcsh_test =
-	test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
-	test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
-	test "`GIT_CONFIG="$MR_REPO"/config git config --get vcsh.vcsh`" = true
+vcsh_test = perl:
+	-d "$ENV{MR_REPO}/refs/heads" && -d "$ENV{MR_REPO}/refs/tags" &&
+	-d "$ENV{MR_REPO}/objects" && -f "$ENV{MR_REPO}/config" &&
+	`GIT_CONFIG="$ENV{MR_REPO}"/config git config --get vcsh.vcsh` =~ /true/
 
 vcsh_update = vcsh run "$MR_REPO" git pull "$@"
 
diff --git a/mr b/mr
index 23178a5..262fab5 100755
--- a/mr
+++ b/mr
@@ -467,13 +467,6 @@ can be constructed accumulatively.
 The name of the version control system is itself determined by
 running each defined "VCS_test" action, until one succeeds.
 
-=item VCS_dir_test
-
-This is a more optimised way to test for the version control system.
-Each "VCS_dir_test" action is run once, and can output lines consisting
-of the name of a VCS, and a directory to look for in the top of a repo
-to detect that VCS.
-
 =back
 
 =head1 UNTRUSTED MRCONFIG FILES
@@ -594,17 +587,22 @@ sub runsh {
 	$runner->($shellcode);
 }
 
-sub runshpipe {
-	runsh @_, sub {
-		my $sh=shift;
-		my $ret=`$sh`;
-		chomp $ret;
-		return $ret;
-	};
+my %perl_cache;
+sub perl {
+	my $id=shift;
+	my $s=shift;
+	if ($s =~ m/^perl:\s+(.*)/s) {
+		return $perl_cache{$1} if exists $perl_cache{$1};
+		my $sub=eval "sub {$1}";
+		if (! defined $sub) {
+			print STDERR "mr: bad perl code in $id: $@\n";
+		}
+		return $perl_cache{$1} = $sub;
+	}
+	return undef;
 }
 
 my %vcs;
-my %vcs_dir_test;
 sub vcs_test {
 	my ($action, $dir, $topdir, $subdir) = @_;
 
@@ -613,53 +611,46 @@ sub vcs_test {
 	}
 
 	my $test="";
-	my $dir_test="";
+	my %perltest;
 	foreach my $vcs_test (
 			sort {
 				length $a <=> length $b 
 				          ||
 				       $a cmp $b
 			} grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
-		if ($vcs_test =~ /(.*)_dir_test/) {
-			my $vcs=$1;
-			if (! defined $vcs_dir_test{$vcs}) {
-				$dir_test.=$config{$topdir}{$subdir}{$vcs_test}."\n";
-			}
-			next;
-		}
 		my ($vcs)=$vcs_test =~ /(.*)_test/;
-		$test="my_$vcs_test() {\n$config{$topdir}{$subdir}{$vcs_test}\n}\n".$test;
-		$test.="if my_$vcs_test; then echo $vcs; fi\n";
-	}
-
-	if (length $dir_test) {
-		runsh "vcs dir test", $topdir, $subdir, $dir_test, [], sub {
-			my $sh=shift;
-			foreach my $line (`$sh`) {
-				chomp $line;
-				my ($vcs, $dir)=split(" ", $line);
-				$vcs_dir_test{$vcs}=$dir;
-			}
+		my $p=perl($vcs_test, $config{$topdir}{$subdir}{$vcs_test});
+		if (defined $p) {
+			$perltest{$vcs}=$p;
+		}
+		else {
+			$test="my_$vcs_test() {\n$config{$topdir}{$subdir}{$vcs_test}\n}\n".$test;
+			$test.="if my_$vcs_test; then echo $vcs; fi\n";
 		}
 	}
 
-	foreach my $vcs (keys %vcs_dir_test) {
-		if (-d "$ENV{MR_REPO}/$vcs_dir_test{$vcs}") {
-			return $vcs{$dir}=$vcs;
+	my @vcs;
+	foreach my $vcs (keys %perltest) {
+		if ($perltest{$vcs}->()) {
+			push @vcs, $vcs;
 		}
 	}
 
-	my $vcs=runshpipe "vcs test", $topdir, $subdir, $test, [];
-	if ($vcs=~/\n/s) {
-		$vcs=~s/\n/, /g;
-		print STDERR "mr $action: found multiple possible repository types ($vcs) for ".fulldir($topdir, $subdir)."\n";
+	push @vcs, split(/\n/,
+		runsh("vcs test", $topdir, $subdir, $test, [], sub {
+			my $sh=shift;
+			my $ret=`$sh`;
+			return $ret;
+		})) if length $test;
+	if (@vcs > 1) {
+		print STDERR "mr $action: found multiple possible repository types (@vcs) for ".fulldir($topdir, $subdir)."\n";
 		return undef;
 	}
-	if (! length $vcs) {
+	if (! @vcs) {
 		return $vcs{$dir}=undef;
 	}
 	else {
-		return $vcs{$dir}=$vcs;
+		return $vcs{$dir}=$vcs[0];
 	}
 }
 	
@@ -1867,17 +1858,17 @@ lib =
 		fi
 	}
 
-svn_dir_test = echo svn .svn
-git_dir_test = echo git .git
-bzr_dir_test = echo bzr .bzr
-cvs_dir_test = echo cvs CVS
-hg_dir_test  = echo hg .hg
-darcs_dir_test = echo darcs _darcs
-fossil_test = test -f "$MR_REPO"/_FOSSIL_
-git_bare_test =
-	test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
-	test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
-	test "`GIT_CONFIG="$MR_REPO"/config git config --get core.bare`" = true
+svn_test = perl: -d "$ENV{MR_REPO}/.svn"
+git_test = perl: -d "$ENV{MR_REPO}/.git"
+bzr_test = perl: -d "$ENV{MR_REPO}/.bzr"
+cvs_test = perl: -d "$ENV{MR_REPO}/CVS"
+hg_test  = perl: -d "$ENV{MR_REPO}/.hg"
+darcs_test = perl: -d "$ENV{MR_REPO}/_darcs"
+fossil_test = perl: -f "$ENV{MR_REPO}/_FOSSIL_"
+git_bare_test = perl: 
+	-d "$ENV{MR_REPO}/refs/heads" && -d "$ENV{MR_REPO}/refs/tags" &&
+	-d "$ENV{MR_REPO}/objects" && -f "$ENV{MR_REPO}/config" &&
+	`GIT_CONFIG="$ENV{MR_REPO}"/config git config --get core.bare` =~ /true/
 
 svn_update = svn update "$@"
 git_update = git pull "$@"