X-Git-Url: https://git.madduck.net/code/myrepos.git/blobdiff_plain/2d6f3db853c1575babfacadcee0d46c3c63b976e..36ce226caca56a82e8c56426c5bb9bfc47e9e642:/mr?ds=inline

diff --git a/mr b/mr
index cd0dea7..b268027 100755
--- a/mr
+++ b/mr
@@ -28,11 +28,11 @@ B<mr> [options] action [params ...]
 
 =head1 DESCRIPTION
 
-B<mr> is a Multiple Repository management tool. It
-can checkout, update, or perform other actions on
-a set of repositories as if they were one combined respository. It
-supports any combination of subversion, git, cvs, and bzr repositories, 
-and support for other revision control systems can easily be added.
+B<mr> is a Multiple Repository management tool. It can checkout, update, or
+perform other actions on a set of repositories as if they were one combined
+respository. It supports any combination of subversion, git, cvs, mecurial,
+bzr and darcs repositories, and support for other revision control systems can
+easily be added.
 
 B<mr> cds into and operates on all registered repositories at or below your
 working directory. Or, if you are in a subdirectory of a repository that
@@ -157,6 +157,12 @@ about exactly which repositories failed and were skipped, if any.
 Just operate on the repository for the current directory, do not 
 recurse into deeper repositories.
 
+=item -j number
+
+Run the specified number of jobs in parallel. This can greatly speed up
+operations such as updates. It is not recommended for interactive
+operations.
+
 =back
 
 =head1 FILES
@@ -223,7 +229,17 @@ mr is run by joey. The second uses the hours_since function
 been at least 12 hours since the last update.
 
   skip = test $(whoami) != joey
-  skip = [ "$1" = update ] && [ $(hours_since "$1") -lt 12 ]
+  skip = [ "$1" = update ] && ! hours_since "$1" 12
+
+=item order
+
+The "order" parameter can be used to override the default ordering of
+repositories. The default order value is 10. Use smaller values to make
+repositories be processed earlier, and larger values to make repositories
+be processed later.
+
+Note that if a repository is located in a subdirectory of another
+repository, ordering it to be processed earlier is not recommended.
 
 =item chain
 
@@ -255,6 +271,13 @@ use warnings;
 use strict;
 use Getopt::Long;
 use Cwd qw(getcwd abs_path);
+use POSIX "WNOHANG";
+use constant {
+	OK => 0,
+	FAILED => 1,
+	SKIPPED => 2,
+	ABORT => 3,
+};
 
 $SIG{INT}=sub {
 	print STDERR "mr: interrupted\n";
@@ -263,14 +286,15 @@ $SIG{INT}=sub {
 
 $ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
 my $config_overridden=0;
-my $directory=getcwd();
 my $verbose=0;
 my $stats=0;
 my $no_recurse=0;
+my $jobs=1;
 my %config;
 my %configfiles;
 my %knownactions;
 my %alias;
+my $directory=getcwd();
 
 Getopt::Long::Configure("no_permute");
 my $result=GetOptions(
@@ -279,12 +303,16 @@ my $result=GetOptions(
 	"v|verbose" => \$verbose,
 	"s|stats" => \$stats,
 	"n|no-recurse" => \$no_recurse,
+	"j|jobs=i" => \$jobs,
 );
 if (! $result || @ARGV < 1) {
 	die("Usage: mr [-d directory] action [params ...]\n".
 	    "(Use mr help for man page.)\n");
 
 }
+if (! defined $directory) {
+	die("mr: failed to determine working directory\n");
+}
 
 # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
 # the config file might be a symlink to elsewhere, and the directory it's
@@ -292,17 +320,17 @@ if (! $result || @ARGV < 1) {
 if ($ENV{MR_CONFIG} !~ /^\//) {
 	$ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
 }
+# Try to set MR_PATH to the path to the program.
+eval {
+	use FindBin qw($Bin $Script);
+	$ENV{MR_PATH}=$Bin."/".$Script;
+};
 
 loadconfig(\*DATA);
 loadconfig($ENV{MR_CONFIG});
 #use Data::Dumper;
 #print Dumper(\%config);
 
-eval {
-	use FindBin qw($Bin $Script);
-	$ENV{MR_PATH}=$Bin."/".$Script;
-};
-
 # alias expansion and command stemming
 my $action=shift @ARGV;
 if (exists $alias{$action}) {
@@ -385,43 +413,93 @@ elsif ($action eq 'register') {
 	exec($command) || die "exec: $!";
 }
 
+# an ordered list of repos
+my @list;
+foreach my $topdir (sort keys %config) {
+	foreach my $subdir (sort keys %{$config{$topdir}}) {
+		push @list, {
+			topdir => $topdir,
+			subdir => $subdir,
+			order => $config{$topdir}{$subdir}{order},
+		};
+	}
+}
+@list = sort {
+		$a->{order}  <=> $b->{order}
+		             ||
+		$a->{topdir} cmp $b->{topdir}
+		             ||
+		$a->{subdir} cmp $b->{subdir}
+	} @list;
+
 # work out what repos to act on
 my @repos;
 my $nochdir=0;
-foreach my $topdir (sort keys %config) {
-	foreach my $subdir (sort keys %{$config{$topdir}}) {
+foreach my $repo (@list) {
+	my $topdir=$repo->{topdir};
+	my $subdir=$repo->{subdir};
+
+	next if $subdir eq 'DEFAULT';
+	my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
+	my $d=$directory;
+	$dir.="/" unless $dir=~/\/$/;
+	$d.="/" unless $d=~/\/$/;
+	next if $no_recurse && $d ne $dir;
+	next if $dir ne $d && $dir !~ /^\Q$d\E/;
+	push @repos, [$dir, $topdir, $subdir];
+}
+if (! @repos) {
+	# fallback to find a leaf repo
+	foreach my $repo (reverse @list) {
+		my $topdir=$repo->{topdir};
+		my $subdir=$repo->{subdir};
+		
 		next if $subdir eq 'DEFAULT';
 		my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
 		my $d=$directory;
 		$dir.="/" unless $dir=~/\/$/;
 		$d.="/" unless $d=~/\/$/;
-		next if $no_recurse && $d ne $dir;
-		next if $dir ne $d && $dir !~ /^\Q$d\E/;
-		push @repos, [$dir, $topdir, $subdir];
-	}
-}
-if (! @repos) {
-	# fallback to find a leaf repo
-	LEAF: foreach my $topdir (reverse sort keys %config) {
-		foreach my $subdir (reverse sort keys %{$config{$topdir}}) {
-			next if $subdir eq 'DEFAULT';
-			my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
-			my $d=$directory;
-			$dir.="/" unless $dir=~/\/$/;
-			$d.="/" unless $d=~/\/$/;
-			if ($d=~/^\Q$dir\E/) {
-				push @repos, [$dir, $topdir, $subdir];
-				last LEAF;
-			}
+		if ($d=~/^\Q$dir\E/) {
+			push @repos, [$dir, $topdir, $subdir];
+			last;
 		}
 	}
 	$nochdir=1;
 }
 
-my (@failed, @ok, @skipped);
-foreach my $repo (@repos) {
-	action($action, @$repo);
+# run the action on each repository and print stats
+my (@ok, @failed, @skipped);
+if ($jobs > 1) {
+	mrs(@repos);
+}
+else {
+	foreach my $repo (@repos) {
+		record($repo, action($action, @$repo));
+	}
+}
+if (! @ok && ! @failed && ! @skipped) {
+	die "mr $action: no repositories found to work on\n";
+}
+print "mr $action: finished (".join("; ",
+	showstat($#ok+1, "ok", "ok"),
+	showstat($#failed+1, "failed", "failed"),
+	showstat($#skipped+1, "skipped", "skipped"),
+).")\n";
+if ($stats) {
+	if (@skipped) {
+		print "mr $action: (skipped: ".join(" ", @skipped).")\n";
+	}
+	if (@failed) {
+		print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
+	}
 }
+if (@failed) {
+	exit 1;
+}
+elsif (! @ok && @skipped) {
+	exit 1;
+}
+exit 0;
 
 sub action { #{{{
 	my ($action, $dir, $topdir, $subdir) = @_;
@@ -433,18 +511,17 @@ sub action { #{{{
 	if ($action eq 'checkout') {
 		if (-d $dir) {
 			print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
-			push @skipped, $dir;
-			return;
+			return SKIPPED;
 		}
 
 		$dir=~s/^(.*)\/[^\/]+\/?$/$1/;
 
 		if (! -d $dir) {
 			print "mr $action: creating parent directory $dir\n" if $verbose;
-			my $ret=system("mkdir", "-p", $dir);
+			system("mkdir", "-p", $dir);
 		}
 	}
-	elsif ($action eq 'update') {
+	elsif ($action =~ /update/) {
 		if (! -d $dir) {
 			return action("checkout", $dir, $topdir, $subdir);
 		}
@@ -460,34 +537,35 @@ sub action { #{{{
 		if ($ret != 0) {
 			if (($? & 127) == 2) {
 				print STDERR "mr $action: interrupted\n";
-				exit 2;
+				return ABORT;
 			}
 			elsif ($? & 127) {
 				print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
-				exit 1;
+				return ABORT;
 			}
 		}
 		if ($ret >> 8 == 0) {
 			print "mr $action: $dir skipped per config file\n" if $verbose;
-			push @skipped, $dir;
-			return;
+			return SKIPPED;
 		}
 	}
 	
 	if (! $nochdir && ! chdir($dir)) {
 		print STDERR "mr $action: failed to chdir to $dir: $!\n";
-		push @failed, $dir;
+		return FAILED;
 	}
 	elsif (! exists $config{$topdir}{$subdir}{$action}) {
 		print STDERR "mr $action: no defined $action command for $topdir$subdir, skipping\n";
-		push @skipped, $dir;
+		return SKIPPED;
 	}
 	else {
 		if (! $nochdir) {
 			print "mr $action: $topdir$subdir\n";
 		}
 		else {
-			print "mr $action: $topdir$subdir (in subdir $directory)\n";
+			my $s=$directory;
+			$s=~s/^\Q$topdir$subdir\E\/?//;
+			print "mr $action: $topdir$subdir (in subdir $s)\n";
 		}
 		my $command="set -e; ".$lib.
 			"my_action(){ $config{$topdir}{$subdir}{$action}\n }; my_action ".
@@ -497,32 +575,120 @@ sub action { #{{{
 		if ($ret != 0) {
 			if (($? & 127) == 2) {
 				print STDERR "mr $action: interrupted\n";
-				exit 2;
+				return ABORT;
 			}
 			elsif ($? & 127) {
 				print STDERR "mr $action: received signal ".($? & 127)."\n";
+				return ABORT;
 			}
 			print STDERR "mr $action: failed ($ret)\n" if $verbose;
-			push @failed, $dir;
 			if ($ret >> 8 != 0) {
 				print STDERR "mr $action: command failed\n";
 			}
 			elsif ($ret != 0) {
 				print STDERR "mr $action: command died ($ret)\n";
 			}
+			return FAILED;
 		}
 		else {
 			if ($action eq 'checkout' && ! -d $dir) {
 				print STDERR "mr $action: $dir missing after checkout\n";;
-				push @failed, $dir;
-				return;
+				return FAILED;
 			}
 
-			push @ok, $dir;
+			return OK;
+		}
+	}
+} #}}}
+
+# run actions on multiple repos, in parallel
+sub mrs { #{{{
+	$| = 1;
+	my @active;
+	my @fhs;
+	my @out;
+	my $running=0;
+	while (@fhs or @repos) {
+		while ($running < $jobs && @repos) {
+			$running++;
+			my $repo = shift @repos;
+			pipe(my $outfh, CHILD_STDOUT);
+			pipe(my $errfh, CHILD_STDERR);
+			my $pid;
+			unless ($pid = fork) {
+				die "mr $action: cannot fork: $!" unless defined $pid;
+				open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
+				open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
+				close CHILD_STDOUT;
+				close CHILD_STDERR;
+				close $outfh;
+				close $errfh;
+				exit action($action, @$repo);
+			}
+			close CHILD_STDOUT;
+			close CHILD_STDERR;
+			push @active, [$pid, $repo];
+			push @fhs, [$outfh, $errfh];
+			push @out, ['',     ''];
+		}
+		my ($rin, $rout) = ('','');
+		my $nfound;
+		foreach my $fh (@fhs) {
+			next unless defined $fh;
+			vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
+			vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
+		}
+		$nfound = select($rout=$rin, undef, undef, 1);
+		foreach my $channel (0, 1) {
+			foreach my $i (0..$#fhs) {
+				next unless defined $fhs[$i];
+				my $fh = $fhs[$i][$channel];
+				next unless defined $fh;
+				if (vec($rout, fileno($fh), 1) == 1) {
+					my $r = '';
+					if (sysread($fh, $r, 1024) == 0) {
+						close($fh);
+						$fhs[$i][$channel] = undef;
+						if (! defined $fhs[$i][0] &&
+						    ! defined $fhs[$i][1]) {
+						    	waitpid($active[$i][0], 0);
+							print STDOUT $out[$i][0];
+							print STDERR $out[$i][1];
+							record($active[$i][1], $? >> 8);
+						    	splice(@fhs, $i, 1);
+						    	splice(@active, $i, 1);
+						    	splice(@out, $i, 1);
+							$running--;
+						}
+					}
+					$out[$i][$channel] .= $r;
+				}
+			}
 		}
+	}
+} #}}}
 
+sub record { #{{{
+	my $dir=shift()->[0];
+	my $ret=shift;
+
+	if ($ret == OK) {
+		push @ok, $dir;
+		print "\n";
+	}
+	elsif ($ret == FAILED) {
+		push @failed, $dir;
 		print "\n";
 	}
+	elsif ($ret == SKIPPED) {
+		push @skipped, $dir;
+	}
+	elsif ($ret == ABORT) {
+		exit 1;
+	}
+	else {
+		die "unknown exit status $ret";
+	}
 } #}}}
 
 sub showstat { #{{{
@@ -534,29 +700,6 @@ sub showstat { #{{{
 	}
 	return;
 } #}}}
-if (! @ok && ! @failed && ! @skipped) {
-	die "mr $action: no repositories found to work on\n";
-}
-print "mr $action: finished (".join("; ",
-	showstat($#ok+1, "ok", "ok"),
-	showstat($#failed+1, "failed", "failed"),
-	showstat($#skipped+1, "skipped", "skipped"),
-).")\n";
-if ($stats) {
-	if (@skipped) {
-		print "mr $action: (skipped: ".join(" ", @skipped).")\n";
-	}
-	if (@failed) {
-		print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
-	}
-}
-if (@failed) {
-	exit 1;
-}
-elsif (! @ok && @skipped) {
-	exit 1;
-}
-exit 0;
 
 my %loaded;
 sub loadconfig { #{{{
@@ -786,13 +929,17 @@ ci = commit
 ls = list
 
 [DEFAULT]
+order = 10
 lib =
 	error() {
 		echo "mr: $@" >&2
 		exit 1
 	}
 	hours_since() {
-		for dir in .git .svn .bzr CVS; do
+		if [ -z "$1" ] || [ -z "$2" ]; then
+			error "mr: usage: hours_since action num"
+		fi
+		for dir in .git .svn .bzr CVS .hg _darcs; do
 			if [ -e "$MR_REPO/$dir" ]; then
 				flagfile="$MR_REPO/$dir/.mr_last$1"
 				break
@@ -801,35 +948,51 @@ lib =
 		if [ -z "$flagfile" ]; then
 			error "cannot determine flag filename"
 		fi
-		perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile"
-		touch "$flagfile"
+		delta=$(perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile")
+		if [ "$delta" -lt "$2" ]; then
+			exit 0
+		else
+			touch "$flagfile"
+			exit 1
+		fi
 	}
 
 update =
 	if [ -d "$MR_REPO"/.svn ]; then
 		svn update "$@"
-	elif [ -d "$MR_REPO"/.git ]; then
+	elif [ -d "$MR_REPO"/.git ] || [ "${MR_REPO%.git/}" != "$MR_REPO" ]; then
+		# this is a bug in git-fetch, which requires GIT_DIR set
+		[ "${MR_REPO%.git/}" != "$MR_REPO" ] && GIT_DIR="$MR_REPO" && export GIT_DIR
 		if [ -z "$@" ]; then
 			git pull -t origin master
 		else
 			git pull "$@"
 		fi
+		unset GIT_DIR
 	elif [ -d "$MR_REPO"/.bzr ]; then
 		bzr merge "$@"
 	elif [ -d "$MR_REPO"/CVS ]; then
 		cvs update "$@"
+	elif [ -d "$MR_REPO"/.hg ]; then
+		hg pull "$@" && hg update "$@"
+	elif [ -d "$MR_REPO"/_darcs ]; then
+		darcs pull -a "$@"
 	else
 		error "unknown repo type"
 	fi
 status =
 	if [ -d "$MR_REPO"/.svn ]; then
 		svn status "$@"
-	elif [ -d "$MR_REPO"/.git ]; then
+	elif [ -d "$MR_REPO"/.git ] || [ "${MR_REPO%.git/}" != "$MR_REPO" ]; then
 		git status "$@" || true
 	elif [ -d "$MR_REPO"/.bzr ]; then
 		bzr status "$@"
 	elif [ -d "$MR_REPO"/CVS ]; then
 		cvs status "$@"
+	elif [ -d "$MR_REPO"/.hg ]; then
+		hg status "$@"
+	elif [ -d "$MR_REPO"/_darcs ]; then
+		darcs whatsnew -ls "$@"
 	else
 		error "unknown repo type"
 	fi
@@ -838,10 +1001,16 @@ commit =
 		svn commit "$@"
 	elif [ -d "$MR_REPO"/.git ]; then
 		git commit -a "$@" && git push --all
+	elif [ "${MR_REPO%.git/}" != "$MR_REPO" ]; then
+		error "commit does not work for fake bare git repositories (yet)."
 	elif [ -d "$MR_REPO"/.bzr ]; then
 		bzr commit "$@" && bzr push
 	elif [ -d "$MR_REPO"/CVS ]; then
 		cvs commit "$@"
+	elif [ -d "$MR_REPO"/.hg ]; then
+		hg commit -m "$@" && hg push
+	elif [ -d "$MR_REPO"/_darcs ]; then
+		darcs commit -a -m "$@" && darcs push -a
 	else
 		error "unknown repo type"
 	fi
@@ -850,22 +1019,32 @@ diff =
 		svn diff "$@"
 	elif [ -d "$MR_REPO"/.git ]; then
 		git diff "$@"
+	elif [ "${MR_REPO%.git/}" != "$MR_REPO" ]; then
+		error "commit does not work for fake bare git repositories (yet)."
 	elif [ -d "$MR_REPO"/.bzr ]; then
 		bzr diff "$@"
 	elif [ -d "$MR_REPO"/CVS ]; then
 		cvs diff "$@"
+	elif [ -d "$MR_REPO"/.hg ]; then
+		hg diff "$@"
+	elif [ -d "$MR_REPO"/_darcs ]; then
+		darcs diff "$@"
 	else
 		error "unknown repo type"
 	fi
 log =
 	if [ -d "$MR_REPO"/.svn ]; then
 		svn log"$@"
-	elif [ -d "$MR_REPO"/.git ]; then
+	elif [ -d "$MR_REPO"/.git ] || [ "${MR_REPO%.git/}" != "$MR_REPO" ]; then
 		git log "$@"
 	elif [ -d "$MR_REPO"/.bzr ]; then
 		bzr log "$@"
 	elif [ -d "$MR_REPO"/CVS ]; then
 		cvs log "$@"
+	elif [ -d "$MR_REPO"/.hg ]; then
+		hg log "$@"
+	elif [ -d "$MR_REPO"/_darcs ]; then
+		darcs changes "$@"
 	else
 		error "unknown repo type"
 	fi
@@ -881,12 +1060,37 @@ register =
 		fi
 		echo "Registering svn url: $url in $MR_CONFIG"
 		mr -c "$MR_CONFIG" config "$(pwd)" checkout="svn co $url $basedir"
-	elif [ -d .git ]; then
-		url=$(LANG=C git-config --get remote.origin.url)
+	elif [ -d .git ] || [ "${basedir%.git}" != "$basedir" ]; then
+		GIT_CONFIG=.git/config
+		[ ! -f $GIT_CONFIG ] && GIT_CONFIG=config
+		export GIT_CONFIG
+		url="$(LANG=C git-config --get remote.origin.url)"
 		if [ -z "$url" ]; then
 			error "cannot determine git url"
 		fi
-		echo "Registering git url: $url in $MR_CONFIG"
+		if [ $GIT_CONFIG = config ]; then
+			# this seems like a bare repo as it has no worktree.
+			# mr needs a worktree and cannot work with bare
+			# repositories, so ensure that it's "fake bare" and
+			# has a worktree configured.
+			case "$(git-config --get core.bare)" in
+				true) error "cannot register a bare git repository";;
+			esac
+			GIT_WORK_TREE="$(git-config --get core.worktree)" || :
+			case "$GIT_WORK_TREE" in
+				'') error "cannot register a fake bare git repository without core.worktree";;
+				*)
+					if [ ! -d "$GIT_WORK_TREE" ]; then
+						error "git worktree $GIT_WORK_TREE does not exist"
+					fi;;
+			esac
+			suffix=" (with worktree $GIT_WORK_TREE)"
+			mr -c "$MR_CONFIG" config "$(pwd)" \
+				lib="GIT_WORK_TREE=$GIT_WORK_TREE; export GIT_WORK_TREE"
+			unset GIT_WORK_TREE
+		fi
+		echo "Registering git url: $url in $MR_CONFIG${suffix:-}"
+		unset GIT_CONFIG
 		mr -c "$MR_CONFIG" config "$(pwd)" checkout="git clone $url $basedir"
 	elif [ -d .bzr ]; then
 		url=$(cat .bzr/branch/parent)
@@ -904,6 +1108,16 @@ register =
 		echo "Registering cvs repository $repo at root $root"
 		mr -c "$MR_CONFIG" config "$(pwd)" \
 			checkout="cvs -d '$root' co -d $basedir $repo"
+	elif [ -d .hg ]; then
+		url=$(hg showconfig paths.default)
+		echo "Registering mercurial repo url: $url in $MR_CONFIG"
+		mr -c "$MR_CONFIG" config "$(pwd)" \
+			checkout="hg clone $url $basedir"
+	elif [ -d _darcs ]; then
+		url=$(cat _darcs/prefs/defaultrepo)
+		echo "Registering darcs repository $url in $MR_CONFIG"
+		mr -c "$MR_CONFIG" config "$(pwd)" \
+			checkout="darcs get $url $basedir"
 	else
 		error "unable to register this repo type"
 	fi
@@ -919,3 +1133,5 @@ ed = echo "A horse is a horse, of course, of course.."
 T = echo "I pity the fool."
 right = echo "Not found."
 #}}}
+
+# vim:sw=8:sts=0:ts=8:noet