X-Git-Url: https://git.madduck.net/code/myrepos.git/blobdiff_plain/08e80ec74eafb9b4407d42c5334026bcffcfd839..de0874e8884604b08e3a3b9a1bf682cf2b88f1f2:/mr?ds=inline diff --git a/mr b/mr index e927a12..2187aa0 100755 --- a/mr +++ b/mr @@ -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. @@ -356,189 +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}; - 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", '', '', 'DEFAULT'); - if (! defined $command) { - die "mr $action: unknown repository type\n"; - } +sub dispatch { #{{{ + my $action=shift; - $ENV{MR_REPO}=~s/.*\/(.*)/$1/; - $command="set -e; ".$config{''}{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: $!"; -} - -# 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) = @_; @@ -549,7 +394,7 @@ sub rcs_test { #{{{ length $a <=> length $b || $a cmp $b - } grep { /_test/ } keys %{$config{$topdir}{$subdir}}) { + } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) { my ($rcs)=$rcs_test=~/(.*)_test/; $test="my_$rcs_test() {\n$config{$topdir}{$subdir}{$rcs_test}\n}\n".$test; $test.="if my_$rcs_test; then echo $rcs; fi\n"; @@ -570,6 +415,10 @@ sub rcs_test { #{{{ sub findcommand { #{{{ my ($action, $dir, $topdir, $subdir) = @_; + + if (exists $config{$topdir}{$subdir}{$action}) { + return $config{$topdir}{$subdir}{$action}; + } my $rcs=rcs_test(@_); @@ -577,9 +426,6 @@ sub findcommand { #{{{ exists $config{$topdir}{$subdir}{$rcs."_".$action}) { return $config{$topdir}{$subdir}{$rcs."_".$action}; } - elsif (exists $config{$topdir}{$subdir}{$action}) { - return $config{$topdir}{$subdir}{$action}; - } else { return undef; } @@ -637,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; } @@ -653,7 +499,7 @@ sub action { #{{{ } } else { - if (! $nochdir) { + if (! $no_chdir) { print "mr $action: $topdir$subdir\n"; } else { @@ -697,6 +543,9 @@ sub action { #{{{ # run actions on multiple repos, in parallel sub mrs { #{{{ + my $action=shift; + my @repos=@_; + $| = 1; my @active; my @fhs; @@ -785,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; @@ -795,6 +663,64 @@ sub showstat { #{{{ 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; @@ -1023,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. @@ -1121,21 +1164,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) @@ -1143,22 +1186,22 @@ cvs_register = 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 $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