X-Git-Url: https://git.madduck.net/code/myrepos.git/blobdiff_plain/273d6e796f78781580939f34a9958ce34c36e90e..f025519645efdd153b5de8957565915837771d51:/mr diff --git a/mr b/mr index 2187aa0..62c6be8 100755 --- a/mr +++ b/mr @@ -296,7 +296,8 @@ use warnings; 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, @@ -304,86 +305,23 @@ use constant { 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(); 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) = @_; @@ -405,6 +343,11 @@ sub rcs_test { #{{{ 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; } @@ -635,6 +578,7 @@ sub record { #{{{ } #}}} sub showstats { #{{{ + my $action=shift; if (! @ok && ! @failed && ! @skipped) { die "mr $action: no repositories found to work on\n"; } @@ -830,11 +774,11 @@ sub loadconfig { #{{{ 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 { @@ -949,9 +893,33 @@ sub modifyconfig { #{{{ 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 { #{{{ @@ -984,7 +952,7 @@ sub config { #{{{ } } if (! $found) { - die "mr $action: $section $_ not set\n"; + die "mr config: $section $_ not set\n"; } } } @@ -997,33 +965,38 @@ sub register { #{{{ # 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: $!"; } #}}} @@ -1052,7 +1025,7 @@ sub expandaction { #{{{ } #}}} 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 }, @@ -1067,6 +1040,54 @@ sub getopts { #{{{ } } #}}} +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. #DATA{{{ @@ -1120,7 +1141,7 @@ darcs_test = test -d "$MR_REPO"/_darcs 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 @@ -1166,7 +1187,7 @@ svn_register = 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 @@ -1196,7 +1217,7 @@ darcs_register = 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