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();
+$ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
+
+# globals :-(
my %config;
my %configfiles;
my %knownactions;
my %alias;
-my $directory=getcwd();
my (@ok, @failed, @skipped);
-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.
-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);
-dispatch($action);
-showstats($action);
-
-if (@failed) {
- exit 1;
-}
-elsif (! @ok && @skipped) {
- exit 1;
-}
-else {
- exit 0;
-}
-
-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));
- }
- }
-} #}}}
+main();
sub rcs_test { #{{{
my ($action, $dir, $topdir, $subdir) = @_;
print "mr $action: running rcs test >>$test<<\n" if $verbose;
my $rcs=`$test`;
chomp $rcs;
+ if ($rcs=~/\n/s) {
+ $rcs=~s/\n/, /g;
+ print STDERR "mr $action: found multiple possible repository types ($rcs) for $topdir$subdir\n";
+ return undef;
+ }
if (! length $rcs) {
return undef;
}
} #}}}
sub findcommand { #{{{
- my ($action, $dir, $topdir, $subdir) = @_;
+ my ($action, $dir, $topdir, $subdir, $is_checkout) = @_;
if (exists $config{$topdir}{$subdir}{$action}) {
return $config{$topdir}{$subdir}{$action};
}
+ if ($is_checkout) {
+ return undef;
+ }
+
my $rcs=rcs_test(@_);
if (defined $rcs &&
$ENV{MR_CONFIG}=$configfiles{$topdir};
my $lib=exists $config{$topdir}{$subdir}{lib} ?
$config{$topdir}{$subdir}{lib}."\n" : "";
+ my $is_checkout=($action eq 'checkout');
- if ($action eq 'checkout') {
+ if ($is_checkout) {
if (-d $dir) {
print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
return SKIPPED;
}
$dir=~s/^(.*)\/[^\/]+\/?$/$1/;
-
- if (! -d $dir) {
- print "mr $action: creating parent directory $dir\n" if $verbose;
- system("mkdir", "-p", $dir);
- }
}
elsif ($action =~ /update/) {
if (! -d $dir) {
$ENV{MR_REPO}=$dir;
- my $skiptest=findcommand("skip", $dir, $topdir, $subdir);
- my $command=findcommand($action, $dir, $topdir, $subdir);
+ my $skiptest=findcommand("skip", $dir, $topdir, $subdir, $is_checkout);
+ my $command=findcommand($action, $dir, $topdir, $subdir, $is_checkout);
if (defined $skiptest) {
my $test="set -e;".$lib.
return SKIPPED;
}
}
-
+
+ if ($is_checkout && ! -d $dir) {
+ print "mr $action: creating parent directory $dir\n" if $verbose;
+ system("mkdir", "-p", $dir);
+ }
+
if (! $no_chdir && ! chdir($dir)) {
print STDERR "mr $action: failed to chdir to $dir: $!\n";
return FAILED;
} #}}}
sub showstats { #{{{
+ my $action=shift;
if (! @ok && ! @failed && ! @skipped) {
die "mr $action: no repositories found to work on\n";
}
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');
+ my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT', 0);
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: $!";
} #}}}
} #}}}
sub getopts { #{{{
- Getopt::Long::Configure("no_permute");
+ 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 },
}
} #}}}
+sub init { #{{{
+ $SIG{INT}=sub {
+ print STDERR "mr: interrupted\n";
+ exit 2;
+ };
+
+ # 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.
#DATA{{{
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