X-Git-Url: https://git.madduck.net/code/myrepos.git/blobdiff_plain/2359ca6904c1b268ace92ee0306539c779eff8e8..de0874e8884604b08e3a3b9a1bf682cf2b88f1f2:/mr diff --git a/mr b/mr index 6c59683..2187aa0 100755 --- a/mr +++ b/mr @@ -1,5 +1,7 @@ #!/usr/bin/perl +#man{{{ + =head1 NAME mr - a Multiple Repository management tool @@ -14,50 +16,119 @@ B [options] status B [options] commit [-m "message"] +B [options] diff + +B [options] log + +B [options] register [repository] + +B [options] config section ["parameter=[value]" ...] + B [options] action [params ...] =head1 DESCRIPTION -B is a Multiple Repository management tool. It allows you to register a -set of repositories in a .mrconfig file, and then checkout, update, or -perform other actions on all of the repositories at once. +B is a Multiple Repository management tool. It can checkout, update, or +perform other actions on a set of repositories as if they were one combined +respository. It supports any combination of subversion, git, cvs, mecurial, +bzr and darcs repositories, and support for other revision control systems can +easily be added. -Any mix of revision control systems can be used with B, and you can -define arbitrary actions for commands like "update", "checkout", or "commit". +B cds into and operates on all registered repositories at or below your +working directory. Or, if you are in a subdirectory of a repository that +contains no other registered repositories, it will stay in that directory, +and work on only that repository, -The predefined commands should be fairly familiar to users of any revision +These predefined commands should be fairly familiar to users of any revision control system: =over 4 =item checkout (or co) -Checks out all the registered repositories that are not already checked -out. +Checks out any repositories that are not already checked out. =item update -Updates each registered repository from its configured remote repository. +Updates each repository from its configured remote repository. If a repository isn't checked out yet, it will first check it out. =item status -Displays a status report for each registered repository, showing what +Displays a status report for each repository, showing what uncommitted changes are present in the repository. =item commit (or ci) -Commits changes to each registered repository. (By default, changes -are pushed to the remote repository too, when using distributed systems -like git.) +Commits changes to each repository. (By default, changes are pushed to the +remote repository too, when using distributed systems like git.) The optional -m parameter allows specifying a commit message. +=item diff + +Show a diff of uncommitted changes. + +=item log + +Show the commit log. + +=back + +These commands are also available: + +=over 4 + +=item list (or ls) + +List the repositories that mr will act on. + +=item register + +Register an existing repository in a mrconfig file. By default, the +repository in the current directory is registered, or you can specify a +directory to register. + +The mrconfig file that is modified is chosen by either the -c option, or by +looking for the closest known one at or below the current directory. + +=item config + +Adds, modifies, removes, or prints a value from a mrconfig file. The next +parameter is the name of the section the value is in. To add or modify +values, use one or more instances of "parameter=value". Use "parameter=" to +remove a parameter. Use just "parameter" to get the value of a parameter. + +For example, to add (or edit) a repository in src/foo: + + mr config src/foo checkout="svn co svn://example.com/foo/trunk foo" + +To show the command that mr uses to update the repository in src/foo: + + mr config src/foo update + +To see the built-in library of shell functions contained in mr: + + mr config DEFAULT lib + +The ~/.mrconfig file is used by default. To use a different config file, +use the -c option. + +=item help + +Displays this help. + =back Actions can be abbreviated to any unambiguous subsctring, so -"mr st" is equivilant to "mr status". +"mr st" is equivilant to "mr status", and "mr up" is equivilant to "mr +update" + +Additional parameters can be passed to most commands, and are passed on +unchanged to the underlying revision control system. This is mostly useful +if the repositories mr will act on all use the same revision control +system. =head1 OPTIONS @@ -66,77 +137,148 @@ Actions can be abbreviated to any unambiguous subsctring, so =item -d directory Specifies the topmost directory that B should work in. The default is -the current working directory. B will operate on all registered -repositories at or under the directory. +the current working directory. =item -c mrconfig -Use the specified mrconfig file, instead of looking for on in your home -directory. +Use the specified mrconfig file. The default is B<~/.mrconfig> =item -v Be verbose. +=item -s + +Expand the statistics line displayed at the end to include information +about exactly which repositories failed and were skipped, if any. + +=item -n + +Just operate on the repository for the current directory, do not +recurse into deeper repositories. + +=item -j number + +Run the specified number of jobs in parallel. This can greatly speed up +operations such as updates. It is not recommended for interactive +operations. + =back =head1 FILES B is configured by .mrconfig files. It starts by reading the .mrconfig -file in your home directory. Each repository specified in a .mrconfig file -can also have its own .mrconfig file in its root directory that can -optionally be used as well. So you could have a ~/.mrconfig that registers a -repository ~/src, that itself contains a ~/src/.mrconfig file, that in turn -registers several additional repositories. +file in your home directory, and this can in turn chain load .mrconfig files +from repositories. + +Here is an example .mrconfig file: + + [src] + checkout = svn co svn://svn.example.com/src/trunk src + chain = true + + [src/linux-2.6] + checkout = git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git && + cd linux-2.6 && + git checkout -b mybranch origin/master The .mrconfig file uses a variant of the INI file format. Lines starting with -"#" are comments. Lines ending with "\" are continued on to the next line. -Sections specify where each repository is located, relative to the -directory that contains the .mrconfig file. +"#" are comments. Values can be continued to the following line by +indenting the line with whitespace. + +The "DEFAULT" section allows setting default values for the sections that +come after it. + +The "ALIAS" section allows adding aliases for actions. Each parameter +is an alias, and its value is the action to use. + +All other sections add repositories. The section header specifies the +directory where the repository is located. This is relative to the directory +that contains the mrconfig file, but you can also choose to use absolute +paths. Within a section, each parameter defines a shell command to run to handle a -given action. Note that these shell commands are run in a "set -e" shell +given action. mr contains default handlers for "update", "status", +"commit", and other standard actions. Normally you only need to specify what +to do for "checkout". + +Note that these shell commands are run in a "set -e" shell environment, where any additional parameters you pass are available in -"$@". B cds into the repository directory before running -a command, except for the "checkout" command, which is run in the parent -of the repository directory, since the repository isn't checked out yet. +"$@". The "checkout" command is run in the parent of the repository +directory, since the repository isn't checked out yet. All other commands +are run inside the repository, though not necessarily at the top of it. + +The "MR_REPO" environment variable is set to the path to the top of the +repository. (For the "register" action, "MR_REPO" is instead set to the +basename of the directory that should be created when checking the +repository out.) + +The "MR_CONFIG" environment variable is set to the .mrconfig file +that defines the repo being acted on, or, if the repo is not yet in a config +file, the .mrconfig file that should be modified to register the repo. + +A few parameters have special meanings: + +=over 4 + +=item skip + +If the "skip" parameter is set and its command returns true, then B +will skip acting on that repository. The command is passed the action +name in $1. + +Here are two examples. The first skips the repo unless +mr is run by joey. The second uses the hours_since function +(included in mr's built-in library) to skip updating the repo unless it's +been at least 12 hours since the last update. + + skip = test $(whoami) != joey + skip = [ "$1" = update ] && ! hours_since "$1" 12 + +=item order + +The "order" parameter can be used to override the default ordering of +repositories. The default order value is 10. Use smaller values to make +repositories be processed earlier, and larger values to make repositories +be processed later. + +Note that if a repository is located in a subdirectory of another +repository, ordering it to be processed earlier is not recommended. + +=item chain -There are three special parameters. If the "skip" parameter is set and -its command returns nonzero, then B will skip acting on that repository. -If the "chain" parameter is set and its command returns nonzero, then B +If the "chain" parameter is set and its command returns true, then B will try to load a .mrconfig file from the root of the repository. (You -should avoid chaining from repositories with untrusted committers.) The -"lib" parameter can specify some shell code that will be run before each -command, this can be a useful way to define shell functions other commands -can use. +should avoid chaining from repositories with untrusted committers.) -The "default" section allows setting up default handlers for each action, -and is overridden by the contents of other sections. mr contains default -handlers for the "update", "status", and "commit" actions, so normally -you only need to specify what to do for "checkout". +=item include -The "alias" section allows adding aliases for commands. Each parameter -is an alias, and its value is the command to run. +If the "include" parameter is set, its command is ran, and should output +additional mrconfig file content. The content is included as if it were +part of the including file. -For example: +Unlike all other parameters, this parameter does not need to be placed +within a section. - [src] - checkout = svn co svn://svn.example.com/src/trunk src - chain = true +=item lib - [src/linux-2.6] - skip = small - checkout = git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git - - [default] - lib = \ - small() { - case "$(hostname)" in; \ - slug|snail); \ - return 0; ;; ; \ - esac; \ - return 1; \ - } +The "lib" parameter can specify some shell code that will be run before each +command, this can be a useful way to define shell functions for other commands +to use. + +=back + +When looking for a command to run for a given action, mr first looks for +a parameter with the same name as the action. If that is not found, it +looks for a parameter named "rcs_action" (substituting in the name of the +revision control system and the action). The name of the revision control +system is itself determined by running each defined "rcs_test" action, +until one succeeds. + +Internally, mr has settings for "git_update", "svn_update", etc. To change +the action that is performed for a given revision control system, you can +override these rcs specific actions. To add a new revision control system, +you can just add rcs specific actions for it. =head1 AUTHOR @@ -148,135 +290,370 @@ http://kitenet.net/~joey/code/mr/ =cut +#}}} + use warnings; use strict; use Getopt::Long; use Cwd qw(getcwd abs_path); - -my $directory=getcwd(); -my $config="$ENV{HOME}/.mrconfig"; +use POSIX "WNOHANG"; +use constant { + OK => 0, + FAILED => 1, + SKIPPED => 2, + ABORT => 3, +}; + +$SIG{INT}=sub { + print STDERR "mr: interrupted\n"; + exit 2; +}; + +$ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig"; +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); + +getopts(); -Getopt::Long::Configure("no_permute"); -my $result=GetOptions( - "d=s" => sub { $directory=abs_path($_[1]) }, - "c=s" => \$config, - "v" => \$verbose, -); -if (! $result || @ARGV < 1) { - die("Usage: mr [-d directory] action [params ...]\n"); +# 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($config); +loadconfig($ENV{MR_CONFIG}); #use Data::Dumper; #print Dumper(\%config); -my $action=shift @ARGV; -if (! exists $knownactions{$action}) { - if (exists $alias{$action}) { - $action=$alias{$action}; +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 { - my @matches = grep { /^\Q$action\E/ } - keys %knownactions, keys %alias; - if (@matches == 1) { - $action=$matches[0]; - } - else { - die "mr: ambiguous action \"$action\" (matches @matches)\n"; + foreach my $repo (selectrepos()) { + record($repo, action($action, @$repo)); } } -} - -my (@failed, @successful, @skipped); -my $first=1; -foreach my $topdir (sort keys %config) { - foreach my $subdir (sort keys %{$config{$topdir}}) { - next if $subdir eq 'default'; - - my $dir=$topdir.$subdir; +} #}}} - if (defined $directory && - $dir ne $directory && - $dir !~ /^\Q$directory\E\//) { - print "mr $action: $dir skipped per -d parameter ($directory)\n" if $verbose; - push @skipped, $dir; - next; - } +sub rcs_test { #{{{ + my ($action, $dir, $topdir, $subdir) = @_; - print "\n" unless $first; - $first=0; + my $test="set -e\n"; + foreach my $rcs_test ( + sort { + length $a <=> length $b + || + $a cmp $b + } 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"; + } + $test=$config{$topdir}{$subdir}{lib}."\n".$test + if exists $config{$topdir}{$subdir}{lib}; + + print "mr $action: running rcs test >>$test<<\n" if $verbose; + my $rcs=`$test`; + chomp $rcs; + if (! length $rcs) { + return undef; + } + else { + return $rcs; + } +} #}}} + +sub findcommand { #{{{ + my ($action, $dir, $topdir, $subdir) = @_; + + if (exists $config{$topdir}{$subdir}{$action}) { + return $config{$topdir}{$subdir}{$action}; + } - action($action, $dir, $topdir, $subdir); + my $rcs=rcs_test(@_); + if (defined $rcs && + exists $config{$topdir}{$subdir}{$rcs."_".$action}) { + return $config{$topdir}{$subdir}{$rcs."_".$action}; } -} + else { + return undef; + } +} #}}} -sub action { +sub action { #{{{ my ($action, $dir, $topdir, $subdir) = @_; - - my $lib= exists $config{$topdir}{$subdir}{lib} ? - $config{$topdir}{$subdir}{lib} : ""; + + $ENV{MR_CONFIG}=$configfiles{$topdir}; + my $lib=exists $config{$topdir}{$subdir}{lib} ? + $config{$topdir}{$subdir}{lib}."\n" : ""; if ($action eq 'checkout') { if (-d $dir) { print "mr $action: $dir already exists, skipping checkout\n" if $verbose; - push @skipped, $dir; - return; + return SKIPPED; } + $dir=~s/^(.*)\/[^\/]+\/?$/$1/; + + if (! -d $dir) { + print "mr $action: creating parent directory $dir\n" if $verbose; + system("mkdir", "-p", $dir); + } } - elsif ($action eq 'update') { + elsif ($action =~ /update/) { if (! -d $dir) { return action("checkout", $dir, $topdir, $subdir); } } - - if (! chdir($dir)) { - print STDERR "mr $action: failed to chdir to $dir: $!\n"; - push @skipped, $dir; - } - if (exists $config{$topdir}{$subdir}{skip}) { - my $ret=system($lib.$config{$topdir}{$subdir}{skip}); + $ENV{MR_REPO}=$dir; + + my $skiptest=findcommand("skip", $dir, $topdir, $subdir); + my $command=findcommand($action, $dir, $topdir, $subdir); + + if (defined $skiptest) { + my $test="set -e;".$lib. + "my_action(){ $skiptest\n }; my_action '$action'"; + print "mr $action: running skip test >>$test<<\n" if $verbose; + my $ret=system($test); + if ($ret != 0) { + if (($? & 127) == 2) { + print STDERR "mr $action: interrupted\n"; + return ABORT; + } + elsif ($? & 127) { + print STDERR "mr $action: skip test received signal ".($? & 127)."\n"; + return ABORT; + } + } if ($ret >> 8 == 0) { print "mr $action: $dir skipped per config file\n" if $verbose; - push @skipped, $dir; - return; + return SKIPPED; } } - - if (! exists $config{$topdir}{$subdir}{$action}) { - print STDERR "mr $action: no defined $action command for $topdir$subdir, skipping\n"; - push @skipped, $dir; + + if (! $no_chdir && ! chdir($dir)) { + print STDERR "mr $action: failed to chdir to $dir: $!\n"; + return FAILED; + } + elsif (! defined $command) { + my $rcs=rcs_test(@_); + if (! defined $rcs) { + print STDERR "mr $action: unknown repository type and no defined $action command for $topdir$subdir\n"; + return FAILED; + } + else { + print STDERR "mr $action: no defined $action command for $rcs repository $topdir$subdir, skipping\n"; + return SKIPPED; + } } else { - print "mr $action: in $dir\n"; - my $command="set -e; ".$lib. - "my_action(){ $config{$topdir}{$subdir}{$action} ; }; my_action ". + if (! $no_chdir) { + print "mr $action: $topdir$subdir\n"; + } + else { + my $s=$directory; + $s=~s/^\Q$topdir$subdir\E\/?//; + print "mr $action: $topdir$subdir (in subdir $s)\n"; + } + $command="set -e; ".$lib. + "my_action(){ $command\n }; my_action ". join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV); + print "mr $action: running >>$command<<\n" if $verbose; my $ret=system($command); if ($ret != 0) { - print STDERR "mr $action: failed to run: $command\n" if $verbose; - push @failed, $topdir.$subdir; + if (($? & 127) == 2) { + print STDERR "mr $action: interrupted\n"; + return ABORT; + } + elsif ($? & 127) { + print STDERR "mr $action: received signal ".($? & 127)."\n"; + return ABORT; + } + print STDERR "mr $action: failed ($ret)\n" if $verbose; if ($ret >> 8 != 0) { print STDERR "mr $action: command failed\n"; } elsif ($ret != 0) { print STDERR "mr $action: command died ($ret)\n"; } + return FAILED; } else { - push @successful, $dir; + if ($action eq 'checkout' && ! -d $dir) { + print STDERR "mr $action: $dir missing after checkout\n";; + return FAILED; + } + + return OK; } } -} +} #}}} + +# run actions on multiple repos, in parallel +sub mrs { #{{{ + my $action=shift; + my @repos=@_; + + $| = 1; + my @active; + my @fhs; + my @out; + my $running=0; + while (@fhs or @repos) { + while ($running < $jobs && @repos) { + $running++; + my $repo = shift @repos; + pipe(my $outfh, CHILD_STDOUT); + pipe(my $errfh, CHILD_STDERR); + my $pid; + unless ($pid = fork) { + die "mr $action: cannot fork: $!" unless defined $pid; + open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!"; + open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!"; + close CHILD_STDOUT; + close CHILD_STDERR; + close $outfh; + close $errfh; + exit action($action, @$repo); + } + close CHILD_STDOUT; + close CHILD_STDERR; + push @active, [$pid, $repo]; + push @fhs, [$outfh, $errfh]; + push @out, ['', '']; + } + my ($rin, $rout) = ('',''); + my $nfound; + foreach my $fh (@fhs) { + next unless defined $fh; + vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0]; + vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1]; + } + $nfound = select($rout=$rin, undef, undef, 1); + foreach my $channel (0, 1) { + foreach my $i (0..$#fhs) { + next unless defined $fhs[$i]; + my $fh = $fhs[$i][$channel]; + next unless defined $fh; + if (vec($rout, fileno($fh), 1) == 1) { + my $r = ''; + if (sysread($fh, $r, 1024) == 0) { + close($fh); + $fhs[$i][$channel] = undef; + if (! defined $fhs[$i][0] && + ! defined $fhs[$i][1]) { + waitpid($active[$i][0], 0); + print STDOUT $out[$i][0]; + print STDERR $out[$i][1]; + record($active[$i][1], $? >> 8); + splice(@fhs, $i, 1); + splice(@active, $i, 1); + splice(@out, $i, 1); + $running--; + } + } + $out[$i][$channel] .= $r; + } + } + } + } +} #}}} -sub showstat { +sub record { #{{{ + my $dir=shift()->[0]; + my $ret=shift; + + if ($ret == OK) { + push @ok, $dir; + print "\n"; + } + elsif ($ret == FAILED) { + push @failed, $dir; + print "\n"; + } + elsif ($ret == SKIPPED) { + push @skipped, $dir; + } + elsif ($ret == ABORT) { + exit 1; + } + else { + die "unknown exit status $ret"; + } +} #}}} + +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; my $plural=shift; @@ -284,22 +661,68 @@ sub showstat { return "$count ".($count > 1 ? $plural : $singular); } return; -} -print "\nmr $action: finished (".join("; ", - showstat($#successful+1, "successful", "successful"), - showstat($#failed+1, "failed", "failed"), - showstat($#skipped+1, "skipped", "skipped"), -).")\n"; -if (@failed) { - exit 1; -} -elsif (! @successful && @skipped) { - exit 1; -} -exit 0; +} #}}} + +# 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 { +sub loadconfig { #{{{ my $f=shift; my @toload; @@ -307,123 +730,490 @@ sub loadconfig { my $in; my $dir; if (ref $f eq 'GLOB') { - $in=$f; $dir=""; + $in=$f; } else { - # $f might be a symlink + if (! -e $f) { + return; + } + my $absf=abs_path($f); if ($loaded{$absf}) { return; } $loaded{$absf}=1; - print "mr: loading config $f\n" if $verbose; - open($in, "<", $f) || die "mr: open $f: $!\n"; ($dir)=$f=~/^(.*\/)[^\/]+$/; if (! defined $dir) { $dir="."; } $dir=abs_path($dir)."/"; + + if (! exists $configfiles{$dir}) { + $configfiles{$dir}=$f; + } # copy in defaults from first parent my $parent=$dir; - while ($parent=~s/^(.*)\/[^\/]+\/?$/$1/) { + while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) { + if ($parent eq '/') { + $parent=""; + } if (exists $config{$parent} && - exists $config{$parent}{default}) { - $config{$dir}{default}={ %{$config{$parent}{default}} }; + exists $config{$parent}{DEFAULT}) { + $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} }; last; } } + + print "mr: loading config $f\n" if $verbose; + open($in, "<", $f) || die "mr: open $f: $!\n"; } + my @lines=<$in>; + close $in; my $section; - while (<$in>) { + my $line=0; + while (@lines) { + $_=shift @lines; + $line++; chomp; next if /^\s*\#/ || /^\s*$/; - if (/^\s*\[([^\]]*)\]\s*$/) { + if (/^\[([^\]]*)\]\s*$/) { $section=$1; } - elsif (/^\s*(\w+)\s*=\s*(.*)/) { + elsif (/^(\w+)\s*=\s*(.*)/) { my $parameter=$1; my $value=$2; - # continuation line - while ($value=~/(.*)\\$/) { - $value=$1.<$in>; + # continued value + while (@lines && $lines[0]=~/^\s(.+)/) { + shift(@lines); + $line++; + $value.="\n$1"; chomp $value; } + if ($parameter eq "include") { + print "mr: including output of \"$value\"\n" if $verbose; + unshift @lines, `$value`; + next; + } + if (! defined $section) { die "$f line $.: parameter ($parameter) not in section\n"; } - if ($section ne 'alias' && + if ($section ne 'ALIAS' && ! exists $config{$dir}{$section} && - exists $config{$dir}{default}) { + exists $config{$dir}{DEFAULT}) { # copy in defaults - $config{$dir}{$section}={ %{$config{$dir}{default}} }; + $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} }; } - if ($section eq 'alias') { + if ($section eq 'ALIAS') { $alias{$parameter}=$value; } elsif ($parameter eq 'lib') { - $config{$dir}{$section}{lib}.=$value." ; "; + $config{$dir}{$section}{lib}.=$value."\n"; } else { $config{$dir}{$section}{$parameter}=$value; - $knownactions{$parameter}=1; + if ($parameter =~ /.*_(.*)/) { + $knownactions{$1}=1; + } + else { + $knownactions{$parameter}=1; + } if ($parameter eq 'chain' && - length $dir && $section ne "default" && - -e $dir.$section."/.mrconfig" && - system($value) >> 8 == 0) { - push @toload, $dir.$section."/.mrconfig"; + length $dir && $section ne "DEFAULT" && + -e $dir.$section."/.mrconfig") { + my $ret=system($value); + if ($ret != 0) { + if (($? & 127) == 2) { + print STDERR "mr $action: chain test interrupted\n"; + exit 2; + } + elsif ($? & 127) { + print STDERR "mr $action: chain test received signal ".($? & 127)."\n"; + } + } + else { + push @toload, $dir.$section."/.mrconfig"; + } } } } else { - die "$f line $.: parse error\n"; + die "$f line $line: parse error\n"; } } - close $in; foreach (@toload) { loadconfig($_); } -} +} #}}} + +sub modifyconfig { #{{{ + my $f=shift; + # the section to modify or add + my $targetsection=shift; + # fields to change in the section + # To remove a field, set its value to "". + my %changefields=@_; + + my @lines; + my @out; + + if (-e $f) { + open(my $in, "<", $f) || die "mr: open $f: $!\n"; + @lines=<$in>; + close $in; + } + + my $formatfield=sub { + my $field=shift; + my @value=split(/\n/, shift); + + return "$field = ".shift(@value)."\n". + join("", map { "\t$_\n" } @value); + }; + my $addfields=sub { + my @blanks; + while ($out[$#out] =~ /^\s*$/) { + unshift @blanks, pop @out; + } + foreach my $field (sort keys %changefields) { + if (length $changefields{$field}) { + push @out, "$field = $changefields{$field}\n"; + delete $changefields{$field}; + } + } + push @out, @blanks; + }; + + my $section; + while (@lines) { + $_=shift(@lines); + + if (/^\s*\#/ || /^\s*$/) { + push @out, $_; + } + elsif (/^\[([^\]]*)\]\s*$/) { + if (defined $section && + $section eq $targetsection) { + $addfields->(); + } + + $section=$1; + + push @out, $_; + } + elsif (/^(\w+)\s*=\s(.*)/) { + my $parameter=$1; + my $value=$2; + + # continued value + while (@lines && $lines[0]=~/^\s(.+)/) { + shift(@lines); + $value.="\n$1"; + chomp $value; + } + + if ($section eq $targetsection) { + if (exists $changefields{$parameter}) { + if (length $changefields{$parameter}) { + $value=$changefields{$parameter}; + } + delete $changefields{$parameter}; + } + } + + push @out, $formatfield->($parameter, $value); + } + } + + if (defined $section && + $section eq $targetsection) { + $addfields->(); + } + elsif (%changefields) { + push @out, "\n[$targetsection]\n"; + foreach my $field (sort keys %changefields) { + if (length $changefields{$field}) { + push @out, $formatfield->($field, $changefields{$field}); + } + } + } + + open(my $out, ">", $f) || die "mr: write $f: $!\n"; + 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. +#DATA{{{ __DATA__ -[alias] - co = checkout - ci = commit -[default] -lib = \ - error() { \ - echo "mr: $@" >&2; \ - exit 1; \ - } -update = \ - if [ -d .svn ]; then \ - svn update "$@"; \ - elif [ -d .git ]; then \ - git pull origin master "$@"; \ - else \ - error "unknown repo type"; \ +[ALIAS] +co = checkout +ci = commit +ls = list + +[DEFAULT] +order = 10 +lib = + error() { + echo "mr: $@" >&2 + exit 1 + } + warning() { + echo "mr (warning): $@" >&2 + } + info() { + echo "mr: $@" >&2 + } + hours_since() { + if [ -z "$1" ] || [ -z "$2" ]; then + error "mr: usage: hours_since action num" + fi + for dir in .git .svn .bzr CVS .hg _darcs; do + if [ -e "$MR_REPO/$dir" ]; then + flagfile="$MR_REPO/$dir/.mr_last$1" + break + fi + done + if [ -z "$flagfile" ]; then + error "cannot determine flag filename" + fi + delta=$(perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile") + if [ "$delta" -lt "$2" ]; then + exit 0 + else + touch "$flagfile" + exit 1 + fi + } + +svn_test = test -d "$MR_REPO"/.svn +git_test = test -d "$MR_REPO"/.git +bzr_test = test -d "$MR_REPO"/.bzr +cvs_test = test -d "$MR_REPO"/CVS +hg_test = test -d "$MR_REPO"/.hg +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 + +svn_update = svn update "$@" +git_update = if [ "$@" ]; then git pull "$@"; else git pull -t origin master; fi +bzr_update = bzr merge "$@" +cvs_update = cvs update "$@" +hg_update = hg pull "$@" && hg update "$@" +darcs_update = darcs pull -a "$@" + +svn_status = svn status "$@" +git_status = git status "$@" || true +bzr_status = bzr status "$@" +cvs_status = cvs status "$@" +hg_status = hg status "$@" +darcs_status = darcs whatsnew -ls "$@" + +svn_commit = svn commit "$@" +git_commit = git commit -a "$@" && git push --all +bzr_commit = bzr commit "$@" && bzr push +cvs_commit = cvs commit "$@" +hg_commit = hg commit -m "$@" && hg push +darcs_commit = darcs commit -a -m "$@" && darcs push -a + +svn_diff = svn diff "$@" +git_diff = git diff "$@" +bzr_diff = bzr diff "$@" +cvs_diff = cvs diff "$@" +hg_diff = hg diff "$@" +darcs_diff = darcs diff "$@" + +svn_log = svn log "$@" +git_log = git log "$@" +bzr_log = bzr log "$@" +cvs_log = cvs log "$@" +hg_log = hg log "$@" +darcs_log = darcs changes "$@" +git_bare_log = git log "$@" + +svn_register = + url=$(LANG=C svn info . | grep -i ^URL: | cut -d ' ' -f 2) + if [ -z "$url" ]; then + 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'" +git_register = + url="$(LANG=C git-config --get remote.origin.url)" || true + if [ -z "$url" ]; then + error "cannot determine git url" fi -status = \ - if [ -d .svn ]; then \ - svn status "$@"; \ - elif [ -d .git ]; then \ - git status "$@" || true; \ - else \ - error "unknown repo type"; \ + echo "Registering git url: $url in $MR_CONFIG" + 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 -commit = \ - if [ -d .svn ]; then \ - svn commit "$@"; \ - elif [ -d .git ]; then \ - git commit -a "$@" && git push --all; \ - else \ - error "unknown repo type"; \ + echo "Registering bzr url: $url in $MR_CONFIG" + mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr clone '$url' '$MR_REPO'" +cvs_register = + repo=$(cat CVS/Repository) + root=$(cat CVS/Root) + if [ -z "$root" ]; then + 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'" +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'" +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'" +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'" + +help = + if [ ! -e "$MR_PATH" ]; then + error "cannot find program path" + fi + (pod2man -c mr "$MR_PATH" | man -l -) || error "pod2man or man failed" +list = true +config = + +ed = echo "A horse is a horse, of course, of course.." +T = echo "I pity the fool." +right = echo "Not found." +#}}} + +# vim:sw=8:sts=0:ts=8:noet