]> git.madduck.net Git - code/myrepos.git/blob - mr

madduck's git repository

Every one of the projects in this repository is available at the canonical URL git://git.madduck.net/madduck/pub/<projectpath> — see each project's metadata for the exact URL.

All patches and comments are welcome. Please squash your changes to logical commits before using git-format-patch and git-send-email to patches@git.madduck.net. If you'd read over the Git project's submission guidelines and adhered to them, I'd be especially grateful.

SSH access, as well as push access can be individually arranged.

If you use my repositories frequently, consider adding the following snippet to ~/.gitconfig and using the third clone URL listed for each project:

[url "git://git.madduck.net/madduck/"]
  insteadOf = madduck:

606ea5d2dfac9e105a3e38625367269e0158e1c0
[code/myrepos.git] / mr
1 #!/usr/bin/perl
2
3 #man{{{
4
5 =head1 NAME
6
7 mr - a Multiple Repository management tool
8
9 =head1 SYNOPSIS
10
11 B<mr> [options] checkout
12
13 B<mr> [options] update
14
15 B<mr> [options] status
16
17 B<mr> [options] commit [-m "message"]
18
19 B<mr> [options] diff
20
21 B<mr> [options] log
22
23 B<mr> [options] register [repository]
24
25 B<mr> [options] config section ["parameter=[value]" ...]
26
27 B<mr> [options] action [params ...]
28
29 =head1 DESCRIPTION
30
31 B<mr> is a Multiple Repository management tool. It can checkout, update, or
32 perform other actions on a set of repositories as if they were one combined
33 respository. It supports any combination of subversion, git, cvs, mecurial,
34 bzr and darcs repositories, and support for other revision control systems can
35 easily be added.
36
37 B<mr> cds into and operates on all registered repositories at or below your
38 working directory. Or, if you are in a subdirectory of a repository that
39 contains no other registered repositories, it will stay in that directory,
40 and work on only that repository,
41
42 These predefined commands should be fairly familiar to users of any revision
43 control system:
44
45 =over 4
46
47 =item checkout (or co)
48
49 Checks out any repositories that are not already checked out.
50
51 =item update
52
53 Updates each repository from its configured remote repository.
54
55 If a repository isn't checked out yet, it will first check it out.
56
57 =item status
58
59 Displays a status report for each repository, showing what
60 uncommitted changes are present in the repository.
61
62 =item commit (or ci)
63
64 Commits changes to each repository. (By default, changes are pushed to the
65 remote repository too, when using distributed systems like git.)
66
67 The optional -m parameter allows specifying a commit message.
68
69 =item diff
70
71 Show a diff of uncommitted changes.
72
73 =item log
74
75 Show the commit log.
76
77 =back
78
79 These commands are also available:
80
81 =over 4
82
83 =item list (or ls)
84
85 List the repositories that mr will act on.
86
87 =item register
88
89 Register an existing repository in a mrconfig file. By default, the
90 repository in the current directory is registered, or you can specify a
91 directory to register.
92
93 The mrconfig file that is modified is chosen by either the -c option, or by
94 looking for the closest known one at or below the current directory.
95
96 =item config
97
98 Adds, modifies, removes, or prints a value from a mrconfig file. The next
99 parameter is the name of the section the value is in. To add or modify
100 values, use one or more instances of "parameter=value". Use "parameter=" to
101 remove a parameter. Use just "parameter" to get the value of a parameter.
102
103 For example, to add (or edit) a repository in src/foo:
104
105   mr config src/foo checkout="svn co svn://example.com/foo/trunk foo"
106
107 To show the command that mr uses to update the repository in src/foo:
108
109   mr config src/foo update
110
111 To see the built-in library of shell functions contained in mr:
112
113   mr config DEFAULT lib
114
115 The ~/.mrconfig file is used by default. To use a different config file,
116 use the -c option.
117
118 =item help
119
120 Displays this help.
121
122 =back
123
124 Actions can be abbreviated to any unambiguous subsctring, so
125 "mr st" is equivilant to "mr status", and "mr up" is equivilant to "mr
126 update"
127
128 Additional parameters can be passed to most commands, and are passed on
129 unchanged to the underlying revision control system. This is mostly useful
130 if the repositories mr will act on all use the same revision control
131 system.
132
133 =head1 OPTIONS
134
135 =over 4
136
137 =item -d directory
138
139 Specifies the topmost directory that B<mr> should work in. The default is
140 the current working directory.
141
142 =item -c mrconfig
143
144 Use the specified mrconfig file. The default is B<~/.mrconfig>
145
146 =item -v
147
148 Be verbose.
149
150 =item -s
151
152 Expand the statistics line displayed at the end to include information
153 about exactly which repositories failed and were skipped, if any.
154
155 =item -n
156
157 Just operate on the repository for the current directory, do not 
158 recurse into deeper repositories.
159
160 =item -j number
161
162 Run the specified number of jobs in parallel. This can greatly speed up
163 operations such as updates. It is not recommended for interactive
164 operations.
165
166 =back
167
168 =head1 FILES
169
170 B<mr> is configured by .mrconfig files. It starts by reading the .mrconfig
171 file in your home directory, and this can in turn chain load .mrconfig files
172 from repositories.
173
174 Here is an example .mrconfig file:
175
176   [src]
177   checkout = svn co svn://svn.example.com/src/trunk src
178   chain = true
179
180   [src/linux-2.6]
181   checkout = git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git &&
182         cd linux-2.6 &&
183         git checkout -b mybranch origin/master
184
185 The .mrconfig file uses a variant of the INI file format. Lines starting with
186 "#" are comments. Values can be continued to the following line by
187 indenting the line with whitespace.
188
189 The "DEFAULT" section allows setting default values for the sections that
190 come after it.
191
192 The "ALIAS" section allows adding aliases for actions. Each parameter
193 is an alias, and its value is the action to use.
194
195 All other sections add repositories. The section header specifies the
196 directory where the repository is located. This is relative to the directory
197 that contains the mrconfig file, but you can also choose to use absolute
198 paths.
199
200 Within a section, each parameter defines a shell command to run to handle a
201 given action. mr contains default handlers for "update", "status",
202 "commit", and other standard actions. Normally you only need to specify what
203 to do for "checkout".
204
205 Note that these shell commands are run in a "set -e" shell
206 environment, where any additional parameters you pass are available in
207 "$@". The "checkout" command is run in the parent of the repository
208 directory, since the repository isn't checked out yet. All other commands
209 are run inside the repository, though not necessarily at the top of it.
210
211 The "MR_REPO" environment variable is set to the path to the top of the
212 repository. The "MR_CONFIG" environment variable is set to the .mrconfig file
213 that defines the repo being acted on, or, if the repo is not yet in a config
214 file, the .mrconfig file that should be modified to register the repo.
215
216 A few parameters have special meanings:
217
218 =over 4
219
220 =item skip
221
222 If the "skip" parameter is set and its command returns true, then B<mr>
223 will skip acting on that repository. The command is passed the action
224 name in $1.
225
226 Here are two examples. The first skips the repo unless
227 mr is run by joey. The second uses the hours_since function
228 (included in mr's built-in library) to skip updating the repo unless it's
229 been at least 12 hours since the last update.
230
231   skip = test $(whoami) != joey
232   skip = [ "$1" = update ] && ! hours_since "$1" 12
233
234 =item order
235
236 The "order" parameter can be used to override the default ordering of
237 repositories. The default order value is 10. Use smaller values to make
238 repositories be processed earlier, and larger values to make repositories
239 be processed later.
240
241 Note that if a repository is located in a subdirectory of another
242 repository, ordering it to be processed earlier is not recommended.
243
244 =item chain
245
246 If the "chain" parameter is set and its command returns true, then B<mr>
247 will try to load a .mrconfig file from the root of the repository. (You
248 should avoid chaining from repositories with untrusted committers.)
249
250 =item lib
251
252 The "lib" parameter can specify some shell code that will be run before each
253 command, this can be a useful way to define shell functions for other commands
254 to use.
255
256 =back
257
258 When looking for a command to run for a given action, mr first looks for
259 a parameter with the same name as the action. If that is not found, it
260 looks for a parameter named "rcs_action" (substituting in the name of the
261 revision control system and the action). The name of the revision control
262 system is itself determined by running each defined "rcs_test" action,
263 until one succeeds.
264
265 Internally, mr has settings for "git_update", "svn_update", etc. To change
266 the action that is performed for a given revision control system, you can
267 override these rcs specific actions. To add a new revision control system,
268 you can just add rcs specific actions for it.
269
270 =head1 AUTHOR
271
272 Copyright 2007 Joey Hess <joey@kitenet.net>
273
274 Licensed under the GNU GPL version 2 or higher.
275
276 http://kitenet.net/~joey/code/mr/
277
278 =cut
279
280 #}}}
281
282 use warnings;
283 use strict;
284 use Getopt::Long;
285 use Cwd qw(getcwd abs_path);
286 use POSIX "WNOHANG";
287 use constant {
288         OK => 0,
289         FAILED => 1,
290         SKIPPED => 2,
291         ABORT => 3,
292 };
293
294 $SIG{INT}=sub {
295         print STDERR "mr: interrupted\n";
296         exit 2;
297 };
298
299 $ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
300 my $config_overridden=0;
301 my $verbose=0;
302 my $stats=0;
303 my $no_recurse=0;
304 my $jobs=1;
305 my %config;
306 my %configfiles;
307 my %knownactions;
308 my %alias;
309 my $directory=getcwd();
310
311 Getopt::Long::Configure("no_permute");
312 my $result=GetOptions(
313         "d|directory=s" => sub { $directory=abs_path($_[1]) },
314         "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
315         "v|verbose" => \$verbose,
316         "s|stats" => \$stats,
317         "n|no-recurse" => \$no_recurse,
318         "j|jobs=i" => \$jobs,
319 );
320 if (! $result || @ARGV < 1) {
321         die("Usage: mr [-d directory] action [params ...]\n".
322             "(Use mr help for man page.)\n");
323
324 }
325 if (! defined $directory) {
326         die("mr: failed to determine working directory\n");
327 }
328
329 # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
330 # the config file might be a symlink to elsewhere, and the directory it's
331 # in is significant.
332 if ($ENV{MR_CONFIG} !~ /^\//) {
333         $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
334 }
335 # Try to set MR_PATH to the path to the program.
336 eval {
337         use FindBin qw($Bin $Script);
338         $ENV{MR_PATH}=$Bin."/".$Script;
339 };
340
341 loadconfig(\*DATA);
342 loadconfig($ENV{MR_CONFIG});
343 #use Data::Dumper;
344 #print Dumper(\%config);
345
346 # alias expansion and command stemming
347 my $action=shift @ARGV;
348 if (exists $alias{$action}) {
349         $action=$alias{$action};
350 }
351 if (! exists $knownactions{$action}) {
352         my @matches = grep { /^\Q$action\E/ }
353                 keys %knownactions, keys %alias;
354         if (@matches == 1) {
355                 $action=$matches[0];
356         }
357         elsif (@matches == 0) {
358                 die "mr: unknown action \"$action\" (known actions: ".
359                         join(", ", sort keys %knownactions).")\n";
360         }
361         else {
362                 die "mr: ambiguous action \"$action\" (matches: ".
363                         join(", ", @matches).")\n";
364         }
365 }
366
367 # commands that do not operate on all repos
368 if ($action eq 'help') {
369         exec($config{''}{DEFAULT}{$action}) || die "exec: $!";
370 }
371 elsif ($action eq 'config') {
372         if (@ARGV < 2) {
373                 die "mr config: not enough parameters\n";
374         }
375         my $section=shift;
376         if ($section=~/^\//) {
377                 # try to convert to a path relative to the config file
378                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
379                 $dir=abs_path($dir);
380                 $dir.="/" unless $dir=~/\/$/;
381                 if ($section=~/^\Q$dir\E(.*)/) {
382                         $section=$1;
383                 }
384         }
385         my %changefields;
386         foreach (@ARGV) {
387                 if (/^([^=]+)=(.*)$/) {
388                         $changefields{$1}=$2;
389                 }
390                 else {
391                         my $found=0;
392                         foreach my $topdir (sort keys %config) {
393                                 if (exists $config{$topdir}{$section} &&
394                                     exists $config{$topdir}{$section}{$_}) {
395                                         print $config{$topdir}{$section}{$_}."\n";
396                                         $found=1;
397                                         last if $section eq 'DEFAULT';
398                                 }
399                         }
400                         if (! $found) {
401                                 die "mr $action: $section $_ not set\n";
402                         }
403                 }
404         }
405         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
406         exit 0;
407 }
408 elsif ($action eq 'register') {
409         if (! $config_overridden) {
410                 # Find the closest known mrconfig file to the current
411                 # directory.
412                 $directory.="/" unless $directory=~/\/$/;
413                 foreach my $topdir (reverse sort keys %config) {
414                         next unless length $topdir;
415                         if ($directory=~/^\Q$topdir\E/) {
416                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
417                                 last;
418                         }
419                 }
420         }
421         my $command="set -e; ".$config{''}{DEFAULT}{lib}."\n".
422                 "my_action(){ $config{''}{DEFAULT}{$action}\n }; my_action ".
423                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
424         print STDERR "mr $action: running >>$command<<\n" if $verbose;
425         exec($command) || die "exec: $!";
426 }
427
428 # an ordered list of repos
429 my @list;
430 foreach my $topdir (sort keys %config) {
431         foreach my $subdir (sort keys %{$config{$topdir}}) {
432                 push @list, {
433                         topdir => $topdir,
434                         subdir => $subdir,
435                         order => $config{$topdir}{$subdir}{order},
436                 };
437         }
438 }
439 @list = sort {
440                 $a->{order}  <=> $b->{order}
441                              ||
442                 $a->{topdir} cmp $b->{topdir}
443                              ||
444                 $a->{subdir} cmp $b->{subdir}
445         } @list;
446
447 # work out what repos to act on
448 my @repos;
449 my $nochdir=0;
450 foreach my $repo (@list) {
451         my $topdir=$repo->{topdir};
452         my $subdir=$repo->{subdir};
453
454         next if $subdir eq 'DEFAULT';
455         my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
456         my $d=$directory;
457         $dir.="/" unless $dir=~/\/$/;
458         $d.="/" unless $d=~/\/$/;
459         next if $no_recurse && $d ne $dir;
460         next if $dir ne $d && $dir !~ /^\Q$d\E/;
461         push @repos, [$dir, $topdir, $subdir];
462 }
463 if (! @repos) {
464         # fallback to find a leaf repo
465         foreach my $repo (reverse @list) {
466                 my $topdir=$repo->{topdir};
467                 my $subdir=$repo->{subdir};
468                 
469                 next if $subdir eq 'DEFAULT';
470                 my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
471                 my $d=$directory;
472                 $dir.="/" unless $dir=~/\/$/;
473                 $d.="/" unless $d=~/\/$/;
474                 if ($d=~/^\Q$dir\E/) {
475                         push @repos, [$dir, $topdir, $subdir];
476                         last;
477                 }
478         }
479         $nochdir=1;
480 }
481
482 # run the action on each repository and print stats
483 my (@ok, @failed, @skipped);
484 if ($jobs > 1) {
485         mrs(@repos);
486 }
487 else {
488         foreach my $repo (@repos) {
489                 record($repo, action($action, @$repo));
490         }
491 }
492 if (! @ok && ! @failed && ! @skipped) {
493         die "mr $action: no repositories found to work on\n";
494 }
495 print "mr $action: finished (".join("; ",
496         showstat($#ok+1, "ok", "ok"),
497         showstat($#failed+1, "failed", "failed"),
498         showstat($#skipped+1, "skipped", "skipped"),
499 ).")\n";
500 if ($stats) {
501         if (@skipped) {
502                 print "mr $action: (skipped: ".join(" ", @skipped).")\n";
503         }
504         if (@failed) {
505                 print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
506         }
507 }
508 if (@failed) {
509         exit 1;
510 }
511 elsif (! @ok && @skipped) {
512         exit 1;
513 }
514 exit 0;
515
516 sub rcs_test { #{{{
517         my ($action, $dir, $topdir, $subdir) = @_;
518
519         my $test="set -e\n";
520         foreach my $rcs_test (grep { /_test/ } keys %{$config{$topdir}{$subdir}}) {
521                 my ($rcs)=$rcs_test=~/(.*)_test/;
522                 $test="my_$rcs_test(){ $config{$topdir}{$subdir}{$rcs_test}\n }\n".$test;
523                 $test.="if my_$rcs_test; then echo $rcs; fi\n";
524         }
525         $test=$config{$topdir}{$subdir}{lib}."\n".$test
526                 if exists $config{$topdir}{$subdir}{lib};
527         
528         print "mr $action: running rcs test >>$test<<\n" if $verbose;
529         $ENV{MR_REPO}=$dir;
530         $ENV{MR_CONFIG}=$configfiles{$topdir};
531         my $rcs=`$test`;
532         chomp $rcs;
533         if (! length $rcs) {
534                 return undef;
535         }
536         else {
537                 return $rcs;
538         }
539 } #}}}
540         
541 sub findcommand { #{{{
542         my ($action, $dir, $topdir, $subdir) = @_;
543
544         my $rcs=rcs_test(@_);
545
546         if (defined $rcs && 
547             exists $config{$topdir}{$subdir}{$rcs."_".$action}) {
548                 return $config{$topdir}{$subdir}{$rcs."_".$action};
549         }
550         elsif (exists $config{$topdir}{$subdir}{$action}) {
551                 return $config{$topdir}{$subdir}{$action};
552         }
553         else {
554                 return undef;
555         }
556 } #}}}
557
558 sub action { #{{{
559         my ($action, $dir, $topdir, $subdir) = @_;
560
561         $ENV{MR_CONFIG}=$configfiles{$topdir};
562         my $lib=exists $config{$topdir}{$subdir}{lib} ?
563                        $config{$topdir}{$subdir}{lib}."\n" : "";
564
565         if ($action eq 'checkout') {
566                 if (-d $dir) {
567                         print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
568                         return SKIPPED;
569                 }
570
571                 $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
572
573                 if (! -d $dir) {
574                         print "mr $action: creating parent directory $dir\n" if $verbose;
575                         system("mkdir", "-p", $dir);
576                 }
577         }
578         elsif ($action =~ /update/) {
579                 if (! -d $dir) {
580                         return action("checkout", $dir, $topdir, $subdir);
581                 }
582         }
583
584         $ENV{MR_REPO}=$dir;
585
586         my $skiptest=findcommand("skip", $dir, $topdir, $subdir);
587         my $command=findcommand($action, $dir, $topdir, $subdir);
588
589         if (defined $skiptest) {
590                 my $test="set -e;".$lib.
591                         "my_action(){ $skiptest\n }; my_action '$action'";
592                 print "mr $action: running skip test >>$test<<\n" if $verbose;
593                 my $ret=system($test);
594                 if ($ret != 0) {
595                         if (($? & 127) == 2) {
596                                 print STDERR "mr $action: interrupted\n";
597                                 return ABORT;
598                         }
599                         elsif ($? & 127) {
600                                 print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
601                                 return ABORT;
602                         }
603                 }
604                 if ($ret >> 8 == 0) {
605                         print "mr $action: $dir skipped per config file\n" if $verbose;
606                         return SKIPPED;
607                 }
608         }
609         
610         if (! $nochdir && ! chdir($dir)) {
611                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
612                 return FAILED;
613         }
614         elsif (! defined $command) {
615                 my $rcs=rcs_test(@_);
616                 if (! defined $rcs) {
617                         print STDERR "mr $action: unknown repository type and no defined $action command for $topdir$subdir\n";
618                         return FAILED;
619                 }
620                 else {
621                         print STDERR "mr $action: no defined $action command for $rcs repository $topdir$subdir, skipping\n";
622                         return SKIPPED;
623                 }
624         }
625         else {
626                 if (! $nochdir) {
627                         print "mr $action: $topdir$subdir\n";
628                 }
629                 else {
630                         my $s=$directory;
631                         $s=~s/^\Q$topdir$subdir\E\/?//;
632                         print "mr $action: $topdir$subdir (in subdir $s)\n";
633                 }
634                 $command="set -e; ".$lib.
635                         "my_action(){ $command\n }; my_action ".
636                         join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
637                 print STDERR "mr $action: running >>$command<<\n" if $verbose;
638                 my $ret=system($command);
639                 if ($ret != 0) {
640                         if (($? & 127) == 2) {
641                                 print STDERR "mr $action: interrupted\n";
642                                 return ABORT;
643                         }
644                         elsif ($? & 127) {
645                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
646                                 return ABORT;
647                         }
648                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
649                         if ($ret >> 8 != 0) {
650                                 print STDERR "mr $action: command failed\n";
651                         }
652                         elsif ($ret != 0) {
653                                 print STDERR "mr $action: command died ($ret)\n";
654                         }
655                         return FAILED;
656                 }
657                 else {
658                         if ($action eq 'checkout' && ! -d $dir) {
659                                 print STDERR "mr $action: $dir missing after checkout\n";;
660                                 return FAILED;
661                         }
662
663                         return OK;
664                 }
665         }
666 } #}}}
667
668 # run actions on multiple repos, in parallel
669 sub mrs { #{{{
670         $| = 1;
671         my @active;
672         my @fhs;
673         my @out;
674         my $running=0;
675         while (@fhs or @repos) {
676                 while ($running < $jobs && @repos) {
677                         $running++;
678                         my $repo = shift @repos;
679                         pipe(my $outfh, CHILD_STDOUT);
680                         pipe(my $errfh, CHILD_STDERR);
681                         my $pid;
682                         unless ($pid = fork) {
683                                 die "mr $action: cannot fork: $!" unless defined $pid;
684                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
685                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
686                                 close CHILD_STDOUT;
687                                 close CHILD_STDERR;
688                                 close $outfh;
689                                 close $errfh;
690                                 exit action($action, @$repo);
691                         }
692                         close CHILD_STDOUT;
693                         close CHILD_STDERR;
694                         push @active, [$pid, $repo];
695                         push @fhs, [$outfh, $errfh];
696                         push @out, ['',     ''];
697                 }
698                 my ($rin, $rout) = ('','');
699                 my $nfound;
700                 foreach my $fh (@fhs) {
701                         next unless defined $fh;
702                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
703                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
704                 }
705                 $nfound = select($rout=$rin, undef, undef, 1);
706                 foreach my $channel (0, 1) {
707                         foreach my $i (0..$#fhs) {
708                                 next unless defined $fhs[$i];
709                                 my $fh = $fhs[$i][$channel];
710                                 next unless defined $fh;
711                                 if (vec($rout, fileno($fh), 1) == 1) {
712                                         my $r = '';
713                                         if (sysread($fh, $r, 1024) == 0) {
714                                                 close($fh);
715                                                 $fhs[$i][$channel] = undef;
716                                                 if (! defined $fhs[$i][0] &&
717                                                     ! defined $fhs[$i][1]) {
718                                                         waitpid($active[$i][0], 0);
719                                                         print STDOUT $out[$i][0];
720                                                         print STDERR $out[$i][1];
721                                                         record($active[$i][1], $? >> 8);
722                                                         splice(@fhs, $i, 1);
723                                                         splice(@active, $i, 1);
724                                                         splice(@out, $i, 1);
725                                                         $running--;
726                                                 }
727                                         }
728                                         $out[$i][$channel] .= $r;
729                                 }
730                         }
731                 }
732         }
733 } #}}}
734
735 sub record { #{{{
736         my $dir=shift()->[0];
737         my $ret=shift;
738
739         if ($ret == OK) {
740                 push @ok, $dir;
741                 print "\n";
742         }
743         elsif ($ret == FAILED) {
744                 push @failed, $dir;
745                 print "\n";
746         }
747         elsif ($ret == SKIPPED) {
748                 push @skipped, $dir;
749         }
750         elsif ($ret == ABORT) {
751                 exit 1;
752         }
753         else {
754                 die "unknown exit status $ret";
755         }
756 } #}}}
757
758 sub showstat { #{{{
759         my $count=shift;
760         my $singular=shift;
761         my $plural=shift;
762         if ($count) {
763                 return "$count ".($count > 1 ? $plural : $singular);
764         }
765         return;
766 } #}}}
767
768 my %loaded;
769 sub loadconfig { #{{{
770         my $f=shift;
771
772         my @toload;
773
774         my $in;
775         my $dir;
776         if (ref $f eq 'GLOB') {
777                 $dir="";
778                 $in=$f; 
779         }
780         else {
781                 if (! -e $f) {
782                         return;
783                 }
784
785                 my $absf=abs_path($f);
786                 if ($loaded{$absf}) {
787                         return;
788                 }
789                 $loaded{$absf}=1;
790
791                 ($dir)=$f=~/^(.*\/)[^\/]+$/;
792                 if (! defined $dir) {
793                         $dir=".";
794                 }
795                 $dir=abs_path($dir)."/";
796                 
797                 if (! exists $configfiles{$dir}) {
798                         $configfiles{$dir}=$f;
799                 }
800
801                 # copy in defaults from first parent
802                 my $parent=$dir;
803                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
804                         if ($parent eq '/') {
805                                 $parent="";
806                         }
807                         if (exists $config{$parent} &&
808                             exists $config{$parent}{DEFAULT}) {
809                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
810                                 last;
811                         }
812                 }
813                 
814                 print "mr: loading config $f\n" if $verbose;
815                 open($in, "<", $f) || die "mr: open $f: $!\n";
816         }
817         my @lines=<$in>;
818         close $in;
819
820         my $section;
821         my $line=0;
822         while (@lines) {
823                 $_=shift @lines;
824                 $line++;
825                 chomp;
826                 next if /^\s*\#/ || /^\s*$/;
827                 if (/^\[([^\]]*)\]\s*$/) {
828                         $section=$1;
829                 }
830                 elsif (/^(\w+)\s*=\s*(.*)/) {
831                         my $parameter=$1;
832                         my $value=$2;
833
834                         # continued value
835                         while (@lines && $lines[0]=~/^\s(.+)/) {
836                                 shift(@lines);
837                                 $line++;
838                                 $value.="\n$1";
839                                 chomp $value;
840                         }
841
842                         if (! defined $section) {
843                                 die "$f line $.: parameter ($parameter) not in section\n";
844                         }
845                         if ($section ne 'ALIAS' &&
846                             ! exists $config{$dir}{$section} &&
847                             exists $config{$dir}{DEFAULT}) {
848                                 # copy in defaults
849                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
850                         }
851                         if ($section eq 'ALIAS') {
852                                 $alias{$parameter}=$value;
853                         }
854                         elsif ($parameter eq 'lib') {
855                                 $config{$dir}{$section}{lib}.=$value."\n";
856                         }
857                         else {
858                                 $config{$dir}{$section}{$parameter}=$value;
859                                 $knownactions{$parameter}=1;
860                                 if ($parameter eq 'chain' &&
861                                     length $dir && $section ne "DEFAULT" &&
862                                     -e $dir.$section."/.mrconfig") {
863                                         my $ret=system($value);
864                                         if ($ret != 0) {
865                                                 if (($? & 127) == 2) {
866                                                         print STDERR "mr $action: chain test interrupted\n";
867                                                         exit 2;
868                                                 }
869                                                 elsif ($? & 127) {
870                                                         print STDERR "mr $action: chain test received signal ".($? & 127)."\n";
871                                                 }
872                                         }
873                                         else {
874                                                 push @toload, $dir.$section."/.mrconfig";
875                                         }
876                                 }
877                         }
878                 }
879                 else {
880                         die "$f line $line: parse error\n";
881                 }
882         }
883
884         foreach (@toload) {
885                 loadconfig($_);
886         }
887 } #}}}
888
889 sub modifyconfig { #{{{
890         my $f=shift;
891         # the section to modify or add
892         my $targetsection=shift;
893         # fields to change in the section
894         # To remove a field, set its value to "".
895         my %changefields=@_;
896
897         my @lines;
898         my @out;
899
900         if (-e $f) {
901                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
902                 @lines=<$in>;
903                 close $in;
904         }
905
906         my $formatfield=sub {
907                 my $field=shift;
908                 my @value=split(/\n/, shift);
909
910                 return "$field = ".shift(@value)."\n".
911                         join("", map { "\t$_\n" } @value);
912         };
913         my $addfields=sub {
914                 my @blanks;
915                 while ($out[$#out] =~ /^\s*$/) {
916                         unshift @blanks, pop @out;
917                 }
918                 foreach my $field (sort keys %changefields) {
919                         if (length $changefields{$field}) {
920                                 push @out, "$field = $changefields{$field}\n";
921                                 delete $changefields{$field};
922                         }
923                 }
924                 push @out, @blanks;
925         };
926
927         my $section;
928         while (@lines) {
929                 $_=shift(@lines);
930
931                 if (/^\s*\#/ || /^\s*$/) {
932                         push @out, $_;
933                 }
934                 elsif (/^\[([^\]]*)\]\s*$/) {
935                         if (defined $section && 
936                             $section eq $targetsection) {
937                                 $addfields->();
938                         }
939
940                         $section=$1;
941
942                         push @out, $_;
943                 }
944                 elsif (/^(\w+)\s*=\s(.*)/) {
945                         my $parameter=$1;
946                         my $value=$2;
947
948                         # continued value
949                         while (@lines && $lines[0]=~/^\s(.+)/) {
950                                 shift(@lines);
951                                 $value.="\n$1";
952                                 chomp $value;
953                         }
954
955                         if ($section eq $targetsection) {
956                                 if (exists $changefields{$parameter}) {
957                                         if (length $changefields{$parameter}) {
958                                                 $value=$changefields{$parameter};
959                                         }
960                                         delete $changefields{$parameter};
961                                 }
962                         }
963
964                         push @out, $formatfield->($parameter, $value);
965                 }
966         }
967
968         if (defined $section && 
969             $section eq $targetsection) {
970                 $addfields->();
971         }
972         elsif (%changefields) {
973                 push @out, "\n[$targetsection]\n";
974                 foreach my $field (sort keys %changefields) {
975                         if (length $changefields{$field}) {
976                                 push @out, $formatfield->($field, $changefields{$field});
977                         }
978                 }
979         }
980
981         open(my $out, ">", $f) || die "mr: write $f: $!\n";
982         print $out @out;
983         close $out;     
984 } #}}}
985
986 # Finally, some useful actions that mr knows about by default.
987 # These can be overridden in ~/.mrconfig.
988 #DATA{{{
989 __DATA__
990 [ALIAS]
991 co = checkout
992 ci = commit
993 ls = list
994
995 [DEFAULT]
996 order = 10
997 lib =
998         PWD="$pwd"
999         error() {
1000                 echo "mr: $@" >&2
1001                 exit 1
1002         }
1003         warning() {
1004                 echo "mr (warning): $@" >&2
1005         }
1006         info() {
1007                 echo "mr: $@" >&2
1008         }
1009         hours_since() {
1010                 if [ -z "$1" ] || [ -z "$2" ]; then
1011                         error "mr: usage: hours_since action num"
1012                 fi
1013                 for dir in .git .svn .bzr CVS .hg _darcs; do
1014                         if [ -e "$MR_REPO/$dir" ]; then
1015                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1016                                 break
1017                         fi
1018                 done
1019                 if [ -z "$flagfile" ]; then
1020                         error "cannot determine flag filename"
1021                 fi
1022                 delta=$(perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile")
1023                 if [ "$delta" -lt "$2" ]; then
1024                         exit 0
1025                 else
1026                         touch "$flagfile"
1027                         exit 1
1028                 fi
1029         }
1030         get_git_repo_type()
1031         {
1032                 if [ -d "$1"/.git ] && [ -d "$1"/.git/refs/heads ] &&
1033                         [ -d "$1"/.git/objects ] && [ -f "$1"/.git/config ];
1034                         then
1035                         echo non-bare
1036                 elif [ -d "$1"/refs/heads ] && [ -d "$1"/refs/tags ] &&
1037                         [ -d "$1"/objects ] && [ -f "$1"/config ]; then
1038                         local bare
1039                         bare="$(GIT_CONFIG="$1"/config git-config --get core.bare)"
1040                         case "$bare" in
1041                                 true) echo bare;;
1042                                 false) echo fake-bare;;
1043                                 *) return 255;;
1044                         esac
1045                 else
1046                         return 1
1047                 fi
1048         }
1049
1050 svn_test = test -d "$MR_REPO"/.svn
1051 git_test = test -d "$MR_REPO"/.git
1052 bzr_test = test -d "$MR_REPO"/.bzr
1053 cvs_test = test -d "$MR_REPO"/CVS
1054 hg_test  = test -d "$MR_REPO"/.hg
1055 darcs_test = test -d "$MR_REPO"/_darcs
1056
1057 svn_update = svn update "$@"
1058 git_update = 
1059         # all this is because of a bug in git-fetch, which requires GIT_DIR set
1060         local git_dir_override; git_dir_override=.git
1061         case "$(get_git_repo_type "$MR_REPO")" in
1062                 fake-bare) git_dir_override="$MR_REPO";;
1063         esac
1064         args="$@"
1065         [ -z "$args" ] && args="-t origin master"
1066         eval GIT_DIR="$git_dir_override" git pull "$args"
1067 bzr_update = bzr merge "$@"
1068 cvs_update = cvs update "$@"
1069 hg_update  = hg pull "$@" && hg update "$@"
1070 darcs_update = darcs pull -a "$@"
1071
1072 svn_status = svn status "$@"
1073 git_status = git status "$@" || true
1074 bzr_status = bzr status "$@"
1075 cvs_status = cvs status "$@"
1076 hg_status  = hg status "$@"
1077 darcs_status = darcs whatsnew -ls "$@"
1078
1079 svn_commit = svn commit "$@"
1080 git_commit = 
1081         case "$(get_git_repo_type "$MR_REPO")" in
1082                 bare) error "cannot commit to bare git repositories";;
1083                 fake-bare) error "commit does not work for fake bare git repositories (yet).";;
1084         esac
1085         git commit -a "$@" && git push --all
1086 bzr_commit = bzr commit "$@" && bzr push
1087 cvs_commit = cvs commit "$@"
1088 hg_commit  = hg commit -m "$@" && hg push
1089 darcs_commit = darcs commit -a -m "$@" && darcs push -a
1090
1091 svn_diff = svn diff "$@"
1092 git_diff = 
1093         case "$(get_git_repo_type "$MR_REPO")" in
1094                 bare) error "cannot diff in bare git repositories";;
1095                 fake-bare) error "diff does not work for fake bare git repositories (yet).";;
1096         esac
1097         git diff "$@"
1098 bzr_diff = bzr diff "$@"
1099 cvs_diff = cvs diff "$@"
1100 hg_diff  = hg diff "$@"
1101 darcs_diff = darcs diff "$@"
1102
1103 svn_log = svn log "$@"
1104 git_log = git log "$@"
1105 bzr_log = bzr log "$@"
1106 cvs_log = cvs log "$@"
1107 hg_log  = hg log "$@"
1108 darcs_log = darcs changes "$@"
1109
1110 svn_register =
1111         if [ -n "$1" ]; then
1112                 cd "$1"
1113         fi
1114         basedir="${PWD##*/}"
1115         url=$(LANG=C svn info . | grep -i ^URL: | cut -d ' ' -f 2)
1116         if [ -z "$url" ]; then
1117                 error "cannot determine svn url"
1118         fi
1119         echo "Registering svn url: $url in $MR_CONFIG"
1120         mr -c "$MR_CONFIG" config "$PWD" checkout="svn co $url $basedir"
1121 git_register = 
1122         if [ -n "$1" ]; then
1123                 cd "$1"
1124         fi
1125         basedir="${PWD##*/}"
1126         local repo_type; repo_type="$(get_git_repo_type .)"
1127         local config;
1128         case "$repo_type" in
1129                 non-bare) config=.git/config;;
1130                 bare|fake-bare) config=config;;
1131         esac
1132         url="$(LANG=C GIT_CONFIG="$config" git-config --get remote.origin.url)"
1133         if [ -z "$url" ]; then
1134                 error "cannot determine git url"
1135         fi
1136         case "$repo_type" in
1137                 bare|fake-bare)
1138                         # this seems like a bare repo as it has no
1139                         # worktree.
1140                         local work_tree
1141                         work_tree="$(git-config --get core.worktree)" || :
1142                         if [ ! -d "$work_tree" ]; then
1143                                 error "git worktree $work_tree does not exist"
1144                         fi
1145                         suffix=" (with worktree $work_tree)"
1146                         mr -c "$MR_CONFIG" config "$PWD" \
1147                                 lib="GIT_WORK_TREE=$work_tree; export GIT_WORK_TREE"
1148                         ;;
1149         esac
1150         echo "Registering git url: $url in $MR_CONFIG${suffix:-}"
1151         mr -c "$MR_CONFIG" config "$PWD" checkout="git clone $url $basedir"
1152 bzr_register =
1153         if [ -n "$1" ]; then
1154                 cd "$1"
1155         fi
1156         basedir="${PWD##*/}"
1157         url=$(cat .bzr/branch/parent)
1158         if [ -z "$url" ]; then
1159                 error "cannot determine bzr url"
1160         fi
1161         echo "Registering bzr url: $url in $MR_CONFIG"
1162         mr -c "$MR_CONFIG" config "$PWD" checkout="bzr clone $url $basedir"
1163 cvs_register =
1164         if [ -n "$1" ]; then
1165                 cd "$1"
1166         fi
1167         basedir="${PWD##*/}"
1168         repo=$(cat CVS/Repository)
1169         root=$(cat CVS/Root)
1170         if [ -z "$root" ]; then
1171                 error "cannot determine cvs root"
1172                 fi
1173         echo "Registering cvs repository $repo at root $root"
1174         mr -c "$MR_CONFIG" config "$PWD" \
1175                 checkout="cvs -d '$root' co -d $basedir $repo"
1176 hg_register = 
1177         if [ -n "$1" ]; then
1178                 cd "$1"
1179         fi
1180         basedir="${PWD##*/}"
1181         url=$(hg showconfig paths.default)
1182         echo "Registering mercurial repo url: $url in $MR_CONFIG"
1183         mr -c "$MR_CONFIG" config "$PWD" \
1184                 checkout="hg clone $url $basedir"
1185 darcs_register = 
1186         if [ -n "$1" ]; then
1187                 cd "$1"
1188         fi
1189         basedir="${PWD##*/}"
1190         url=$(cat _darcs/prefs/defaultrepo)
1191         echo "Registering darcs repository $url in $MR_CONFIG"
1192         mr -c "$MR_CONFIG" config "$PWD" \
1193                 checkout="darcs get $url $basedir"
1194
1195 help =
1196         if [ ! -e "$MR_PATH" ]; then
1197                 error "cannot find program path"
1198         fi
1199         (pod2man -c mr "$MR_PATH" | man -l -) || error "pod2man or man failed"
1200 list = true
1201 config = 
1202
1203 ed = echo "A horse is a horse, of course, of course.."
1204 T = echo "I pity the fool."
1205 right = echo "Not found."
1206 #}}}
1207
1208 # vim:sw=8:sts=0:ts=8:noet