From: Joey Hess <joey@kodama.kitenet.net>
Date: Fri, 26 Oct 2007 06:30:51 +0000 (-0400)
Subject: Merge commit 'madduck/master'
X-Git-Url: https://git.madduck.net/code/myrepos.git/commitdiff_plain/a33917423c99bcf6dc02d939e7956a746aa974ca?ds=inline;hp=-c

Merge commit 'madduck/master'
---

a33917423c99bcf6dc02d939e7956a746aa974ca
diff --combined mr
index 2187aa0,a611e38..13807f8
--- a/mr
+++ b/mr
@@@ -314,22 -314,31 +314,22 @@@ my $config_overridden=0
  my $verbose=0;
  my $stats=0;
  my $no_recurse=0;
 +my $no_chdir=0;
  my $jobs=1;
  my %config;
  my %configfiles;
  my %knownactions;
  my %alias;
  my $directory=getcwd();
 +my (@ok, @failed, @skipped);
  
 -Getopt::Long::Configure("no_permute");
 -my $result=GetOptions(
 -	"d|directory=s" => sub { $directory=abs_path($_[1]) },
 -	"c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
 -	"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");
 +getopts();
  
 -}
 +# This can happen if it's run in a directory that was removed
 +# or other strangeness.
  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
  # in is significant.
@@@ -347,43 -356,190 +347,43 @@@ loadconfig($ENV{MR_CONFIG})
  #use Data::Dumper;
  #print Dumper(\%config);
  
 -# alias expansion and command stemming
 -my $action=shift @ARGV;
 -if (exists $alias{$action}) {
 -	$action=$alias{$action};
 -}
 -if (! exists $knownactions{$action}) {
 -	my @matches = grep { /^\Q$action\E/ }
 -		keys %knownactions, keys %alias;
 -	if (@matches == 1) {
 -		$action=$matches[0];
 -	}
 -	elsif (@matches == 0) {
 -		die "mr: unknown action \"$action\" (known actions: ".
 -			join(", ", sort keys %knownactions).")\n";
 -	}
 -	else {
 -		die "mr: ambiguous action \"$action\" (matches: ".
 -			join(", ", @matches).")\n";
 -	}
 -}
 +my $action=expandaction(shift @ARGV);
 +dispatch($action);
 +showstats($action);
  
 -# commands that do not operate on all repos
 -if ($action eq 'help') {
 -	exec($config{''}{DEFAULT}{$action}) || die "exec: $!";
 +if (@failed) {
 +	exit 1;
  }
 -elsif ($action eq 'config') {
 -	if (@ARGV < 2) {
 -		die "mr config: not enough parameters\n";
 -	}
 -	my $section=shift;
 -	if ($section=~/^\//) {
 -		# try to convert to a path relative to the config file
 -		my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
 -		$dir=abs_path($dir);
 -		$dir.="/" unless $dir=~/\/$/;
 -		if ($section=~/^\Q$dir\E(.*)/) {
 -			$section=$1;
 -		}
 -	}
 -	my %changefields;
 -	foreach (@ARGV) {
 -		if (/^([^=]+)=(.*)$/) {
 -			$changefields{$1}=$2;
 -		}
 -		else {
 -			my $found=0;
 -			foreach my $topdir (sort keys %config) {
 -				if (exists $config{$topdir}{$section} &&
 -				    exists $config{$topdir}{$section}{$_}) {
 -					print $config{$topdir}{$section}{$_}."\n";
 -					$found=1;
 -					last if $section eq 'DEFAULT';
 -				}
 -			}
 -			if (! $found) {
 -				die "mr $action: $section $_ not set\n";
 -			}
 -		}
 -	}
 -	modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
 +elsif (! @ok && @skipped) {
 +	exit 1;
 +}
 +else {
  	exit 0;
  }
 -elsif ($action eq 'register') {
 -	if (! $config_overridden) {
 -		# Find the closest known mrconfig file to the current
 -		# directory.
 -		$directory.="/" unless $directory=~/\/$/;
 -		foreach my $topdir (reverse sort keys %config) {
 -			next unless length $topdir;
 -			if ($directory=~/^\Q$topdir\E/) {
 -				$ENV{MR_CONFIG}=$configfiles{$topdir};
 -				$directory=$topdir;
 -				last;
 -			}
 -		}
 -	}
 -	if (@ARGV) {
 -		my $subdir=shift @ARGV;
 -		if (! chdir($subdir)) {
 -			print STDERR "mr $action: failed to chdir to $subdir: $!\n";
 -		}
 -	}
 -
 -	$ENV{MR_REPO}=getcwd();
 -	my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT');
 -	if (! defined $command) {
 -		die "mr $action: unknown repository type\n";
 -	}
  
 -	$ENV{MR_REPO}=~s/.*\/(.*)/$1/;
 -	$command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
 -		"my_action(){ $command\n }; my_action ".
 -		join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
 -	print "mr $action: running >>$command<<\n" if $verbose;
 -	exec($command) || die "exec: $!";
 -}
 +sub dispatch { #{{{
 +	my $action=shift;
  
 -# 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},
 -		};
 +	# actions that do not operate on all repos
 +	if ($action eq 'help') {
 +		help(@ARGV);
  	}
 -}
 -@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 $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=~/\/$/;
 -		if ($d=~/^\Q$dir\E/) {
 -			push @repos, [$dir, $topdir, $subdir];
 -			last;
 -		}
 +	elsif ($action eq 'config') {
 +		config(@ARGV);
  	}
 -	$nochdir=1;
 -}
 -
 -# 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));
 +	elsif ($action eq 'register') {
 +		register(@ARGV);
  	}
 -}
 -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 ($jobs > 1) {
 +		mrs($action, selectrepos());
  	}
 -	if (@failed) {
 -		print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
 +	else {
 +		foreach my $repo (selectrepos()) {
 +			record($repo, action($action, @$repo));
 +		}
  	}
 -}
 -if (@failed) {
 -	exit 1;
 -}
 -elsif (! @ok && @skipped) {
 -	exit 1;
 -}
 -exit 0;
 +} #}}}
  
  sub rcs_test { #{{{
  	my ($action, $dir, $topdir, $subdir) = @_;
@@@ -483,7 -639,7 +483,7 @@@ sub action { #{{
  		}
  	}
  	
 -	if (! $nochdir && ! chdir($dir)) {
 +	if (! $no_chdir && ! chdir($dir)) {
  		print STDERR "mr $action: failed to chdir to $dir: $!\n";
  		return FAILED;
  	}
@@@ -499,7 -655,7 +499,7 @@@
  		}
  	}
  	else {
 -		if (! $nochdir) {
 +		if (! $no_chdir) {
  			print "mr $action: $topdir$subdir\n";
  		}
  		else {
@@@ -543,9 -699,6 +543,9 @@@
  
  # run actions on multiple repos, in parallel
  sub mrs { #{{{
 +	my $action=shift;
 +	my @repos=@_;
 +
  	$| = 1;
  	my @active;
  	my @fhs;
@@@ -634,25 -787,6 +634,25 @@@ sub record { #{{
  	}
  } #}}}
  
 +sub showstats { #{{{
 +	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";
 +		}
 +	}
 +} #}}}
 +
  sub showstat { #{{{
  	my $count=shift;
  	my $singular=shift;
@@@ -663,64 -797,6 +663,64 @@@
  	return;
  } #}}}
  
 +# an ordered list of repos
 +sub repolist { #{{{
 +	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},
 +			};
 +		}
 +	}
 +	return sort {
 +		$a->{order}  <=> $b->{order}
 +		             ||
 +		$a->{topdir} cmp $b->{topdir}
 +		             ||
 +		$a->{subdir} cmp $b->{subdir}
 +	} @list;
 +} #}}}
 +
 +# figure out which repos to act on
 +sub selectrepos { #{{{
 +	my @repos;
 +	foreach my $repo (repolist()) {
 +		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 repolist()) {
 +			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=~/\/$/;
 +			if ($d=~/^\Q$dir\E/) {
 +				push @repos, [$dir, $topdir, $subdir];
 +				last;
 +			}
 +		}
 +		$no_chdir=1;
 +	}
 +	return @repos;
 +} #}}}
 +
  my %loaded;
  sub loadconfig { #{{{
  	my $f=shift;
@@@ -949,123 -1025,6 +949,123 @@@ sub modifyconfig { #{{
  	print $out @out;
  	close $out;	
  } #}}}
 +	
 +sub help { #{{{
 +	exec($config{''}{DEFAULT}{$action}) || die "exec: $!";
 +} #}}}
 +	
 +sub config { #{{{
 +	if (@_ < 2) {
 +		die "mr config: not enough parameters\n";
 +	}
 +	my $section=shift;
 +	if ($section=~/^\//) {
 +		# try to convert to a path relative to the config file
 +		my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
 +		$dir=abs_path($dir);
 +		$dir.="/" unless $dir=~/\/$/;
 +		if ($section=~/^\Q$dir\E(.*)/) {
 +			$section=$1;
 +		}
 +	}
 +	my %changefields;
 +	foreach (@_) {
 +		if (/^([^=]+)=(.*)$/) {
 +			$changefields{$1}=$2;
 +		}
 +		else {
 +			my $found=0;
 +			foreach my $topdir (sort keys %config) {
 +				if (exists $config{$topdir}{$section} &&
 +				    exists $config{$topdir}{$section}{$_}) {
 +					print $config{$topdir}{$section}{$_}."\n";
 +					$found=1;
 +					last if $section eq 'DEFAULT';
 +				}
 +			}
 +			if (! $found) {
 +				die "mr $action: $section $_ not set\n";
 +			}
 +		}
 +	}
 +	modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
 +	exit 0;
 +} #}}}
 +
 +sub register { #{{{
 +	if (! $config_overridden) {
 +		# Find the closest known mrconfig file to the current
 +		# directory.
 +		$directory.="/" unless $directory=~/\/$/;
 +		foreach my $topdir (reverse sort keys %config) {
 +			next unless length $topdir;
 +			if ($directory=~/^\Q$topdir\E/) {
 +				$ENV{MR_CONFIG}=$configfiles{$topdir};
 +				$directory=$topdir;
 +				last;
 +			}
 +		}
 +	}
 +	if (@ARGV) {
 +		my $subdir=shift @ARGV;
 +		if (! chdir($subdir)) {
 +			print STDERR "mr $action: failed to chdir to $subdir: $!\n";
 +		}
 +	}
 +
 +	$ENV{MR_REPO}=getcwd();
 +	my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT');
 +	if (! defined $command) {
 +		die "mr $action: unknown repository type\n";
 +	}
 +
 +	$ENV{MR_REPO}=~s/.*\/(.*)/$1/;
 +	$command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
 +		"my_action(){ $command\n }; my_action ".
 +		join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
 +	print "mr $action: running >>$command<<\n" if $verbose;
 +	exec($command) || die "exec: $!";
 +} #}}}
 +
 +# alias expansion and command stemming
 +sub expandaction { #{{{
 +	my $action=shift;
 +	if (exists $alias{$action}) {
 +		$action=$alias{$action};
 +	}
 +	if (! exists $knownactions{$action}) {
 +		my @matches = grep { /^\Q$action\E/ }
 +			keys %knownactions, keys %alias;
 +		if (@matches == 1) {
 +			$action=$matches[0];
 +		}
 +		elsif (@matches == 0) {
 +			die "mr: unknown action \"$action\" (known actions: ".
 +				join(", ", sort keys %knownactions).")\n";
 +		}
 +		else {
 +			die "mr: ambiguous action \"$action\" (matches: ".
 +				join(", ", @matches).")\n";
 +		}
 +	}
 +	return $action;
 +} #}}}
 +
 +sub getopts { #{{{
 +	Getopt::Long::Configure("no_permute");
 +	my $result=GetOptions(
 +		"d|directory=s" => sub { $directory=abs_path($_[1]) },
 +		"c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
 +		"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");
 +	}
 +} #}}}
  
  # Finally, some useful actions that mr knows about by default.
  # These can be overridden in ~/.mrconfig.
@@@ -1079,6 -1038,7 +1079,7 @@@ ls = lis
  [DEFAULT]
  order = 10
  lib =
+ 	PWD="$(pwd)"
  	error() {
  		echo "mr: $@" >&2
  		exit 1
@@@ -1164,21 -1124,21 +1165,21 @@@ svn_register 
  		error "cannot determine svn url"
  	fi
  	echo "Registering svn url: $url in $MR_CONFIG"
- 	mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
+ 	mr -c "$MR_CONFIG" config "$PWD" checkout="svn co '$url' '$MR_REPO'"
  git_register = 
  	url="$(LANG=C git-config --get remote.origin.url)" || true
  	if [ -z "$url" ]; then
  		error "cannot determine git url"
  	fi
  	echo "Registering git url: $url in $MR_CONFIG"
- 	mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone '$url' '$MR_REPO'"
+ 	mr -c "$MR_CONFIG" config "$PWD" checkout="git clone '$url' '$MR_REPO'"
  bzr_register =
  	url=$(cat .bzr/branch/parent)
  	if [ -z "$url" ]; then
  		error "cannot determine bzr url"
  	fi
  	echo "Registering bzr url: $url in $MR_CONFIG"
- 	mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr clone '$url' '$MR_REPO'"
+ 	mr -c "$MR_CONFIG" config "$PWD" checkout="bzr clone '$url' '$MR_REPO'"
  cvs_register =
  	repo=$(cat CVS/Repository)
  	root=$(cat CVS/Root)
@@@ -1186,22 -1146,22 +1187,22 @@@
  		error "cannot determine cvs root"
  		fi
  	echo "Registering cvs repository $repo at root $root"
- 	mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
+ 	mr -c "$MR_CONFIG" config "$PWD" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
  hg_register = 
  	url=$(hg showconfig paths.default)
  	echo "Registering mercurial repo url: $url in $MR_CONFIG"
- 	mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone '$url' '$MR_REPO'"
+ 	mr -c "$MR_CONFIG" config "$PWD" checkout="hg clone '$url' '$MR_REPO'"
  darcs_register = 
  	url=$(cat _darcs/prefs/defaultrepo)
  	echo "Registering darcs repository $url in $MR_CONFIG"
- 	mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get '$url'p '$MR_REPO'"
+ 	mr -c "$MR_CONFIG" config "$PWD" checkout="darcs get '$url'p '$MR_REPO'"
  git_bare_register = 
  	url="$(LANG=C GIT_CONFIG=config git-config --get remote.origin.url)" || true
  	if [ -z "$url" ]; then
  		error "cannot determine git url"
  	fi
  	echo "Registering git url: $url in $MR_CONFIG"
- 	mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
+ 	mr -c "$MR_CONFIG" config "$PWD" checkout="git clone --bare '$url' '$MR_REPO'"
  
  help =
  	if [ ! -e "$MR_PATH" ]; then