When looking for a command to run for a given action, mr first looks for
a parameter with the same name as the action. If that is not found, it
looks for a parameter named "VCS_action" (substituting in the name of the
-version control system and the action). The name of the version control
-system is itself determined by running each defined "VCS_test" action,
-until one succeeds.
+version control system and the action).
Internally, mr has settings for "git_update", "svn_update", etc. To change
the action that is performed for a given version control system, you can
to the existing value of the parameter. In this way, actions
can be constructed accumulatively.
+=item VCS_test
+
+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
main();
+sub shellquote {
+ my $i=shift;
+ $i=~s/'/'"'"'/g;
+ return "'$i'";
+}
+
+# Runs a shell command using a supplied function.
+# The lib will be included in the shell command line, and any params
+# will be available in the shell as $1, $2, etc.
+my $lastlib;
+sub runsh {
+ my ($action, $topdir, $subdir, $command, $params, $runner) = @_;
+
+ # optimisation: avoid running the shell for true and false
+ if ($command =~ /^\s*true\s*$/) {
+ $?=0;
+ return 0;
+ }
+ elsif ($command =~ /^\s*false\s*$/) {
+ $?=0;
+ return 1;
+ }
+
+ my $quotedparams=join(" ", (map { shellquote($_) } @$params));
+ my $lib=exists $config{$topdir}{$subdir}{lib} ?
+ $config{$topdir}{$subdir}{lib}."\n" : "";
+ if ($verbose && (! defined $lastlib || $lastlib ne $lib)) {
+ print "mr library now: >>$lib<<\n";
+ $lastlib=$lib;
+ }
+ my $shellcode="set -e;".$lib.
+ "my_sh(){ $command\n }; my_sh $quotedparams";
+ print "mr $action: running $action >>$command<<\n" if $verbose;
+ $runner->($shellcode);
+}
+
+sub runshpipe {
+ runsh @_, sub {
+ my $sh=shift;
+ my $ret=`$sh`;
+ chomp $ret;
+ return $ret;
+ };
+}
+
my %vcs;
+my %vcs_dir_test;
sub vcs_test {
my ($action, $dir, $topdir, $subdir) = @_;
return $vcs{$dir};
}
- my $test="set -e\n";
+ my $test="";
+ my $dir_test="";
foreach my $vcs_test (
sort {
length $a <=> length $b
||
$a cmp $b
} grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
- my ($vcs)=$vcs_test=~/(.*)_test/;
+ 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";
}
- $test=$config{$topdir}{$subdir}{lib}."\n".$test
- if exists $config{$topdir}{$subdir}{lib};
-
- print "mr $action: running vcs test >>$test<<\n" if $verbose;
- my $vcs=`$test`;
- chomp $vcs;
+
+ 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;
+ }
+ }
+ }
+
+ foreach my $vcs (keys %vcs_dir_test) {
+ if (-d "$ENV{MR_REPO}/$vcs_dir_test{$vcs}") {
+ return $vcs{$dir}=$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";
my $fulldir=fulldir($topdir, $subdir);
$ENV{MR_CONFIG}=$configfiles{$topdir};
- my $lib=exists $config{$topdir}{$subdir}{lib} ?
- $config{$topdir}{$subdir}{lib}."\n" : "";
my $is_checkout=($action eq 'checkout');
my $is_update=($action =~ /update/);
my $testcommand=findcommand($testname, $dir, $topdir, $subdir, $is_checkout);
if (defined $testcommand) {
- my $test="set -e;".$lib.
- "my_action(){ $testcommand\n }; my_action '$action'";
- print "mr $action: running $testname test >>$test<<\n" if $verbose;
- my $ret=system($test);
+ my $ret=runsh "$testname test", $topdir, $subdir,
+ $testcommand, [$action],
+ sub { system(shift()) };
if ($ret != 0) {
if (($? & 127) == 2) {
print STDERR "mr $action: interrupted\n";
my $hookret=hook("pre_$action", $topdir, $subdir);
return $hookret if $hookret != OK;
- $command="set -e; ".$lib.
- "my_action(){ $command\n }; my_action ".
- join(" ", map { s/\\/\\\\/g; s/"/\"/g; '"'.$_.'"' } @ARGV);
- print "mr $action: running >>$command<<\n" if $verbose;
- my $ret;
- if ($quiet) {
- my $output = qx/$command 2>&1/;
- $ret = $?;
- if ($ret != 0) {
- print "$actionmsg\n";
- print STDERR $output;
- }
- }
- else {
- $ret=system($command);
- }
+ my $ret=runsh $action, $topdir, $subdir,
+ $command, \@ARGV, sub {
+ my $sh=shift;
+ if ($quiet) {
+ my $output = qx/$sh 2>&1/;
+ my $ret = $?;
+ if ($ret != 0) {
+ print "$actionmsg\n";
+ print STDERR $output;
+ }
+ return $ret;
+ }
+ else {
+ system($sh);
+ }
+ };
if ($ret != 0) {
if (($? & 127) == 2) {
print STDERR "mr $action: interrupted\n";
my $command=$config{$topdir}{$subdir}{$hook};
return OK unless defined $command;
- my $lib=exists $config{$topdir}{$subdir}{lib} ?
- $config{$topdir}{$subdir}{lib}."\n" : "";
- my $shell="set -e;".$lib.
- "my_hook(){ $command\n }; my_hook";
- print "mr $hook: running >>$shell<<\n" if $verbose;
- my $ret;
- if ($quiet) {
- my $output = qx/$shell 2>&1/;
- $ret = $?;
- if ($ret != 0) {
- print STDERR $output;
- }
- }
- else {
- $ret=system($shell);
- }
+ my $ret=runsh $hook, $topdir, $subdir, $command, [], sub {
+ my $sh=shift;
+ if ($quiet) {
+ my $output = qx/$sh 2>&1/;
+ my $ret = $?;
+ if ($ret != 0) {
+ print STDERR $output;
+ }
+ return $ret;
+ }
+ else {
+ system($sh);
+ }
+ };
if ($ret != 0) {
if (($? & 127) == 2) {
print STDERR "mr $hook: interrupted\n";
my $lineerror = sub {
my $msg=shift;
if (defined $included) {
- die "mr: $f line $lineno included line '$line': $msg\n";
+ die "mr: $msg at $f line $lineno, included line: $line\n";
}
else {
- die "mr: $f line $lineno: $msg\n";
+ die "mr: $msg at $f line $lineno\n";
}
};
my $trusterror = sub {
fi
}
-svn_test = test -d "$MR_REPO"/.svn
-git_test = test -d "$MR_REPO"/.git
-bzr_test = test -d "$MR_REPO"/.bzr
-cvs_test = test -d "$MR_REPO"/CVS
-hg_test = test -d "$MR_REPO"/.hg
-darcs_test = test -d "$MR_REPO"/_darcs
+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 &&
projects / code / myrepos.git / blobdiff