use strict;
use Getopt::Long;
use Cwd qw(getcwd abs_path);
-use POSIX "WNOHANG";
+
+# things that can happen when mr runs a command
use constant {
OK => 0,
FAILED => 1,
ABORT => 3,
};
-$SIG{INT}=sub {
- print STDERR "mr: interrupted\n";
- exit 2;
-};
-
-$ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
+# configurables
my $config_overridden=0;
my $verbose=0;
my $stats=0;
my $no_recurse=0;
+my $no_chdir=0;
my $jobs=1;
+my $directory=getcwd();
+
+# globals :-(
my %config;
my %configfiles;
my %knownactions;
my %alias;
-my $directory=getcwd();
-
-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");
-
-}
-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.
-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);
-
-my $action=expandaction(shift @ARGV);
-
-# commands that do not operate on all repos
-if ($action eq 'help') {
- help(@ARGV);
-}
-elsif ($action eq 'config') {
- config(@ARGV);
-}
-elsif ($action eq 'register') {
- register(@ARGV);
-}
-
-# work out what repos to act on
-my @repos;
-my $nochdir=0;
-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;
- }
- }
- $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));
- }
-}
-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;
+
+main();
sub rcs_test { #{{{
my ($action, $dir, $topdir, $subdir) = @_;
}
}
- if (! $nochdir && ! chdir($dir)) {
+ if (! $no_chdir && ! chdir($dir)) {
print STDERR "mr $action: failed to chdir to $dir: $!\n";
return FAILED;
}
}
}
else {
- if (! $nochdir) {
+ if (! $no_chdir) {
print "mr $action: $topdir$subdir\n";
}
else {
# run actions on multiple repos, in parallel
sub mrs { #{{{
+ my $action=shift;
+ my @repos=@_;
+
$| = 1;
my @active;
my @fhs;
}
} #}}}
+sub showstats { #{{{
+ my $action=shift;
+ 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;
} @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;
my $ret=system($value);
if ($ret != 0) {
if (($? & 127) == 2) {
- print STDERR "mr $action: chain test interrupted\n";
+ print STDERR "mr: chain test interrupted\n";
exit 2;
}
elsif ($? & 127) {
- print STDERR "mr $action: chain test received signal ".($? & 127)."\n";
+ print STDERR "mr: chain test received signal ".($? & 127)."\n";
}
}
else {
print $out @out;
close $out;
} #}}}
-
+
+sub dispatch { #{{{
+ my $action=shift;
+
+ # actions that do not operate on all repos
+ if ($action eq 'help') {
+ help(@ARGV);
+ }
+ elsif ($action eq 'config') {
+ config(@ARGV);
+ }
+ elsif ($action eq 'register') {
+ register(@ARGV);
+ }
+
+ if ($jobs > 1) {
+ mrs($action, selectrepos());
+ }
+ else {
+ foreach my $repo (selectrepos()) {
+ record($repo, action($action, @$repo));
+ }
+ }
+} #}}}
+
sub help { #{{{
- exec($config{''}{DEFAULT}{$action}) || die "exec: $!";
+ exec($config{''}{DEFAULT}{help}) || die "exec: $!";
} #}}}
sub config { #{{{
}
}
if (! $found) {
- die "mr $action: $section $_ not set\n";
+ die "mr config: $section $_ not set\n";
}
}
}
# Find the closest known mrconfig file to the current
# directory.
$directory.="/" unless $directory=~/\/$/;
+ my $foundconfig=0;
foreach my $topdir (reverse sort keys %config) {
next unless length $topdir;
if ($directory=~/^\Q$topdir\E/) {
$ENV{MR_CONFIG}=$configfiles{$topdir};
$directory=$topdir;
+ $foundconfig=1;
last;
}
}
+ if (! $foundconfig) {
+ $directory=""; # no config file, use builtin
+ }
}
if (@ARGV) {
my $subdir=shift @ARGV;
if (! chdir($subdir)) {
- print STDERR "mr $action: failed to chdir to $subdir: $!\n";
+ print STDERR "mr register: 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";
+ die "mr register: 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;
+ print "mr register: running >>$command<<\n" if $verbose;
exec($command) || die "exec: $!";
} #}}}
}
}
return $action;
-}
+} #}}}
+
+sub getopts { #{{{
+ Getopt::Long::Configure("bundling", "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");
+ }
+} #}}}
+
+sub init { #{{{
+ $SIG{INT}=sub {
+ print STDERR "mr: interrupted\n";
+ exit 2;
+ };
+
+ $ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
+
+ # 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.
+ 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;
+ };
+} #}}}
+
+sub main { #{{{
+ getopts();
+ init();
+ loadconfig(\*DATA);
+ loadconfig($ENV{MR_CONFIG});
+ #use Data::Dumper; print Dumper(\%config);
+
+ my $action=expandaction(shift @ARGV);
+ dispatch($action);
+ showstats($action);
+
+ if (@failed) {
+ exit 1;
+ }
+ elsif (! @ok && @skipped) {
+ exit 1;
+ }
+ else {
+ exit 0;
+ }
+} #}}}
# Finally, some useful actions that mr knows about by default.
# These can be overridden in ~/.mrconfig.
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
+ test "$(GIT_CONFIG="$MR_REPO"/config git config --get core.bare)" = true
svn_update = svn update "$@"
git_update = if [ "$@" ]; then git pull "$@"; else git pull -t origin master; fi
echo "Registering svn url: $url in $MR_CONFIG"
mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
git_register =
- url="$(LANG=C git-config --get remote.origin.url)" || true
+ url="$(LANG=C git config --get remote.origin.url)" || true
if [ -z "$url" ]; then
error "cannot determine git url"
fi
echo "Registering darcs repository $url in $MR_CONFIG"
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
+ url="$(LANG=C GIT_CONFIG=config git config --get remote.origin.url)" || true
if [ -z "$url" ]; then
error "cannot determine git url"
fi
projects / code / myrepos.git / blobdiff