]> 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:

74d0129432c3f701a0f29c2b816b4eb1a85583ab
[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. (For the "register" action, "MR_REPO" is instead set to the 
213 basename of the directory that should be created when checking the
214 repository out.)
215
216 The "MR_CONFIG" environment variable is set to the .mrconfig file
217 that defines the repo being acted on, or, if the repo is not yet in a config
218 file, the .mrconfig file that should be modified to register the repo.
219
220 A few parameters have special meanings:
221
222 =over 4
223
224 =item skip
225
226 If the "skip" parameter is set and its command returns true, then B<mr>
227 will skip acting on that repository. The command is passed the action
228 name in $1.
229
230 Here are two examples. The first skips the repo unless
231 mr is run by joey. The second uses the hours_since function
232 (included in mr's built-in library) to skip updating the repo unless it's
233 been at least 12 hours since the last update.
234
235   skip = test $(whoami) != joey
236   skip = [ "$1" = update ] && ! hours_since "$1" 12
237
238 =item order
239
240 The "order" parameter can be used to override the default ordering of
241 repositories. The default order value is 10. Use smaller values to make
242 repositories be processed earlier, and larger values to make repositories
243 be processed later.
244
245 Note that if a repository is located in a subdirectory of another
246 repository, ordering it to be processed earlier is not recommended.
247
248 =item chain
249
250 If the "chain" parameter is set and its command returns true, then B<mr>
251 will try to load a .mrconfig file from the root of the repository. (You
252 should avoid chaining from repositories with untrusted committers.)
253
254 =item include
255
256 If the "include" parameter is set, its command is ran, and should output
257 additional mrconfig file content. The content is included as if it were
258 part of the including file.
259
260 Unlike all other parameters, this parameter does not need to be placed
261 within a section.
262
263 =item lib
264
265 The "lib" parameter can specify some shell code that will be run before each
266 command, this can be a useful way to define shell functions for other commands
267 to use.
268
269 =back
270
271 When looking for a command to run for a given action, mr first looks for
272 a parameter with the same name as the action. If that is not found, it
273 looks for a parameter named "rcs_action" (substituting in the name of the
274 revision control system and the action). The name of the revision control
275 system is itself determined by running each defined "rcs_test" action,
276 until one succeeds.
277
278 Internally, mr has settings for "git_update", "svn_update", etc. To change
279 the action that is performed for a given revision control system, you can
280 override these rcs specific actions. To add a new revision control system,
281 you can just add rcs specific actions for it.
282
283 =head1 AUTHOR
284
285 Copyright 2007 Joey Hess <joey@kitenet.net>
286
287 Licensed under the GNU GPL version 2 or higher.
288
289 http://kitenet.net/~joey/code/mr/
290
291 =cut
292
293 #}}}
294
295 use warnings;
296 use strict;
297 use Getopt::Long;
298 use Cwd qw(getcwd abs_path);
299 use POSIX "WNOHANG";
300 use constant {
301         OK => 0,
302         FAILED => 1,
303         SKIPPED => 2,
304         ABORT => 3,
305 };
306
307 $SIG{INT}=sub {
308         print STDERR "mr: interrupted\n";
309         exit 2;
310 };
311
312 $ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
313 my $config_overridden=0;
314 my $verbose=0;
315 my $stats=0;
316 my $no_recurse=0;
317 my $jobs=1;
318 my %config;
319 my %configfiles;
320 my %knownactions;
321 my %alias;
322 my $directory=getcwd();
323
324 Getopt::Long::Configure("no_permute");
325 my $result=GetOptions(
326         "d|directory=s" => sub { $directory=abs_path($_[1]) },
327         "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
328         "v|verbose" => \$verbose,
329         "s|stats" => \$stats,
330         "n|no-recurse" => \$no_recurse,
331         "j|jobs=i" => \$jobs,
332 );
333 if (! $result || @ARGV < 1) {
334         die("Usage: mr [-d directory] action [params ...]\n".
335             "(Use mr help for man page.)\n");
336
337 }
338 if (! defined $directory) {
339         die("mr: failed to determine working directory\n");
340 }
341
342 # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
343 # the config file might be a symlink to elsewhere, and the directory it's
344 # in is significant.
345 if ($ENV{MR_CONFIG} !~ /^\//) {
346         $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
347 }
348 # Try to set MR_PATH to the path to the program.
349 eval {
350         use FindBin qw($Bin $Script);
351         $ENV{MR_PATH}=$Bin."/".$Script;
352 };
353
354 loadconfig(\*DATA);
355 loadconfig($ENV{MR_CONFIG});
356 #use Data::Dumper;
357 #print Dumper(\%config);
358
359 # alias expansion and command stemming
360 my $action=shift @ARGV;
361 if (exists $alias{$action}) {
362         $action=$alias{$action};
363 }
364 if (! exists $knownactions{$action}) {
365         my @matches = grep { /^\Q$action\E/ }
366                 keys %knownactions, keys %alias;
367         if (@matches == 1) {
368                 $action=$matches[0];
369         }
370         elsif (@matches == 0) {
371                 die "mr: unknown action \"$action\" (known actions: ".
372                         join(", ", sort keys %knownactions).")\n";
373         }
374         else {
375                 die "mr: ambiguous action \"$action\" (matches: ".
376                         join(", ", @matches).")\n";
377         }
378 }
379
380 # commands that do not operate on all repos
381 if ($action eq 'help') {
382         exec($config{''}{DEFAULT}{$action}) || die "exec: $!";
383 }
384 elsif ($action eq 'config') {
385         if (@ARGV < 2) {
386                 die "mr config: not enough parameters\n";
387         }
388         my $section=shift;
389         if ($section=~/^\//) {
390                 # try to convert to a path relative to the config file
391                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
392                 $dir=abs_path($dir);
393                 $dir.="/" unless $dir=~/\/$/;
394                 if ($section=~/^\Q$dir\E(.*)/) {
395                         $section=$1;
396                 }
397         }
398         my %changefields;
399         foreach (@ARGV) {
400                 if (/^([^=]+)=(.*)$/) {
401                         $changefields{$1}=$2;
402                 }
403                 else {
404                         my $found=0;
405                         foreach my $topdir (sort keys %config) {
406                                 if (exists $config{$topdir}{$section} &&
407                                     exists $config{$topdir}{$section}{$_}) {
408                                         print $config{$topdir}{$section}{$_}."\n";
409                                         $found=1;
410                                         last if $section eq 'DEFAULT';
411                                 }
412                         }
413                         if (! $found) {
414                                 die "mr $action: $section $_ not set\n";
415                         }
416                 }
417         }
418         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
419         exit 0;
420 }
421 elsif ($action eq 'register') {
422         if (! $config_overridden) {
423                 # Find the closest known mrconfig file to the current
424                 # directory.
425                 $directory.="/" unless $directory=~/\/$/;
426                 foreach my $topdir (reverse sort keys %config) {
427                         next unless length $topdir;
428                         if ($directory=~/^\Q$topdir\E/) {
429                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
430                                 last;
431                         }
432                 }
433         }
434         if (@ARGV) {
435                 my $subdir=shift @ARGV;
436                 if (! chdir($subdir)) {
437                         print STDERR "mr $action: failed to chdir to $subdir: $!\n";
438                 }
439         }
440
441         $ENV{MR_REPO}=getcwd();
442         my $command=findcommand("register", '', '', 'DEFAULT');
443         if (! defined $command) {
444                 die "mr $action: unknown repository type\n";
445         }
446
447         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
448         $command="set -e; ".$config{''}{DEFAULT}{lib}."\n".
449                 "my_action(){ $command\n }; my_action ".
450                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
451         print "mr $action: running >>$command<<\n" if $verbose;
452         exec($command) || die "exec: $!";
453 }
454
455 # an ordered list of repos
456 my @list;
457 foreach my $topdir (sort keys %config) {
458         foreach my $subdir (sort keys %{$config{$topdir}}) {
459                 push @list, {
460                         topdir => $topdir,
461                         subdir => $subdir,
462                         order => $config{$topdir}{$subdir}{order},
463                 };
464         }
465 }
466 @list = sort {
467                 $a->{order}  <=> $b->{order}
468                              ||
469                 $a->{topdir} cmp $b->{topdir}
470                              ||
471                 $a->{subdir} cmp $b->{subdir}
472         } @list;
473
474 # work out what repos to act on
475 my @repos;
476 my $nochdir=0;
477 foreach my $repo (@list) {
478         my $topdir=$repo->{topdir};
479         my $subdir=$repo->{subdir};
480
481         next if $subdir eq 'DEFAULT';
482         my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
483         my $d=$directory;
484         $dir.="/" unless $dir=~/\/$/;
485         $d.="/" unless $d=~/\/$/;
486         next if $no_recurse && $d ne $dir;
487         next if $dir ne $d && $dir !~ /^\Q$d\E/;
488         push @repos, [$dir, $topdir, $subdir];
489 }
490 if (! @repos) {
491         # fallback to find a leaf repo
492         foreach my $repo (reverse @list) {
493                 my $topdir=$repo->{topdir};
494                 my $subdir=$repo->{subdir};
495                 
496                 next if $subdir eq 'DEFAULT';
497                 my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
498                 my $d=$directory;
499                 $dir.="/" unless $dir=~/\/$/;
500                 $d.="/" unless $d=~/\/$/;
501                 if ($d=~/^\Q$dir\E/) {
502                         push @repos, [$dir, $topdir, $subdir];
503                         last;
504                 }
505         }
506         $nochdir=1;
507 }
508
509 # run the action on each repository and print stats
510 my (@ok, @failed, @skipped);
511 if ($jobs > 1) {
512         mrs(@repos);
513 }
514 else {
515         foreach my $repo (@repos) {
516                 record($repo, action($action, @$repo));
517         }
518 }
519 if (! @ok && ! @failed && ! @skipped) {
520         die "mr $action: no repositories found to work on\n";
521 }
522 print "mr $action: finished (".join("; ",
523         showstat($#ok+1, "ok", "ok"),
524         showstat($#failed+1, "failed", "failed"),
525         showstat($#skipped+1, "skipped", "skipped"),
526 ).")\n";
527 if ($stats) {
528         if (@skipped) {
529                 print "mr $action: (skipped: ".join(" ", @skipped).")\n";
530         }
531         if (@failed) {
532                 print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
533         }
534 }
535 if (@failed) {
536         exit 1;
537 }
538 elsif (! @ok && @skipped) {
539         exit 1;
540 }
541 exit 0;
542
543 sub rcs_test { #{{{
544         my ($action, $dir, $topdir, $subdir) = @_;
545
546         my $test="set -e\n";
547         foreach my $rcs_test (
548                         sort {
549                                 length $a <=> length $b 
550                                           ||
551                                        $a cmp $b
552                         } grep { /_test/ } keys %{$config{$topdir}{$subdir}}) {
553                 my ($rcs)=$rcs_test=~/(.*)_test/;
554                 $test="my_$rcs_test() {\n$config{$topdir}{$subdir}{$rcs_test}\n}\n".$test;
555                 $test.="if my_$rcs_test; then echo $rcs; fi\n";
556         }
557         $test=$config{$topdir}{$subdir}{lib}."\n".$test
558                 if exists $config{$topdir}{$subdir}{lib};
559         
560         print "mr $action: running rcs test >>$test<<\n" if $verbose;
561         my $rcs=`$test`;
562         chomp $rcs;
563         if (! length $rcs) {
564                 return undef;
565         }
566         else {
567                 return $rcs;
568         }
569 } #}}}
570         
571 sub findcommand { #{{{
572         my ($action, $dir, $topdir, $subdir) = @_;
573         
574         if (exists $config{$topdir}{$subdir}{$action}) {
575                 return $config{$topdir}{$subdir}{$action};
576         }
577
578         my $rcs=rcs_test(@_);
579
580         if (defined $rcs && 
581             exists $config{$topdir}{$subdir}{$rcs."_".$action}) {
582                 return $config{$topdir}{$subdir}{$rcs."_".$action};
583         }
584         else {
585                 return undef;
586         }
587 } #}}}
588
589 sub action { #{{{
590         my ($action, $dir, $topdir, $subdir) = @_;
591
592         $ENV{MR_CONFIG}=$configfiles{$topdir};
593         my $lib=exists $config{$topdir}{$subdir}{lib} ?
594                        $config{$topdir}{$subdir}{lib}."\n" : "";
595
596         if ($action eq 'checkout') {
597                 if (-d $dir) {
598                         print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
599                         return SKIPPED;
600                 }
601
602                 $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
603
604                 if (! -d $dir) {
605                         print "mr $action: creating parent directory $dir\n" if $verbose;
606                         system("mkdir", "-p", $dir);
607                 }
608         }
609         elsif ($action =~ /update/) {
610                 if (! -d $dir) {
611                         return action("checkout", $dir, $topdir, $subdir);
612                 }
613         }
614
615         $ENV{MR_REPO}=$dir;
616
617         my $skiptest=findcommand("skip", $dir, $topdir, $subdir);
618         my $command=findcommand($action, $dir, $topdir, $subdir);
619
620         if (defined $skiptest) {
621                 my $test="set -e;".$lib.
622                         "my_action(){ $skiptest\n }; my_action '$action'";
623                 print "mr $action: running skip test >>$test<<\n" if $verbose;
624                 my $ret=system($test);
625                 if ($ret != 0) {
626                         if (($? & 127) == 2) {
627                                 print STDERR "mr $action: interrupted\n";
628                                 return ABORT;
629                         }
630                         elsif ($? & 127) {
631                                 print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
632                                 return ABORT;
633                         }
634                 }
635                 if ($ret >> 8 == 0) {
636                         print "mr $action: $dir skipped per config file\n" if $verbose;
637                         return SKIPPED;
638                 }
639         }
640         
641         if (! $nochdir && ! chdir($dir)) {
642                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
643                 return FAILED;
644         }
645         elsif (! defined $command) {
646                 my $rcs=rcs_test(@_);
647                 if (! defined $rcs) {
648                         print STDERR "mr $action: unknown repository type and no defined $action command for $topdir$subdir\n";
649                         return FAILED;
650                 }
651                 else {
652                         print STDERR "mr $action: no defined $action command for $rcs repository $topdir$subdir, skipping\n";
653                         return SKIPPED;
654                 }
655         }
656         else {
657                 if (! $nochdir) {
658                         print "mr $action: $topdir$subdir\n";
659                 }
660                 else {
661                         my $s=$directory;
662                         $s=~s/^\Q$topdir$subdir\E\/?//;
663                         print "mr $action: $topdir$subdir (in subdir $s)\n";
664                 }
665                 $command="set -e; ".$lib.
666                         "my_action(){ $command\n }; my_action ".
667                         join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
668                 print "mr $action: running >>$command<<\n" if $verbose;
669                 my $ret=system($command);
670                 if ($ret != 0) {
671                         if (($? & 127) == 2) {
672                                 print STDERR "mr $action: interrupted\n";
673                                 return ABORT;
674                         }
675                         elsif ($? & 127) {
676                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
677                                 return ABORT;
678                         }
679                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
680                         if ($ret >> 8 != 0) {
681                                 print STDERR "mr $action: command failed\n";
682                         }
683                         elsif ($ret != 0) {
684                                 print STDERR "mr $action: command died ($ret)\n";
685                         }
686                         return FAILED;
687                 }
688                 else {
689                         if ($action eq 'checkout' && ! -d $dir) {
690                                 print STDERR "mr $action: $dir missing after checkout\n";;
691                                 return FAILED;
692                         }
693
694                         return OK;
695                 }
696         }
697 } #}}}
698
699 # run actions on multiple repos, in parallel
700 sub mrs { #{{{
701         $| = 1;
702         my @active;
703         my @fhs;
704         my @out;
705         my $running=0;
706         while (@fhs or @repos) {
707                 while ($running < $jobs && @repos) {
708                         $running++;
709                         my $repo = shift @repos;
710                         pipe(my $outfh, CHILD_STDOUT);
711                         pipe(my $errfh, CHILD_STDERR);
712                         my $pid;
713                         unless ($pid = fork) {
714                                 die "mr $action: cannot fork: $!" unless defined $pid;
715                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
716                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
717                                 close CHILD_STDOUT;
718                                 close CHILD_STDERR;
719                                 close $outfh;
720                                 close $errfh;
721                                 exit action($action, @$repo);
722                         }
723                         close CHILD_STDOUT;
724                         close CHILD_STDERR;
725                         push @active, [$pid, $repo];
726                         push @fhs, [$outfh, $errfh];
727                         push @out, ['',     ''];
728                 }
729                 my ($rin, $rout) = ('','');
730                 my $nfound;
731                 foreach my $fh (@fhs) {
732                         next unless defined $fh;
733                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
734                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
735                 }
736                 $nfound = select($rout=$rin, undef, undef, 1);
737                 foreach my $channel (0, 1) {
738                         foreach my $i (0..$#fhs) {
739                                 next unless defined $fhs[$i];
740                                 my $fh = $fhs[$i][$channel];
741                                 next unless defined $fh;
742                                 if (vec($rout, fileno($fh), 1) == 1) {
743                                         my $r = '';
744                                         if (sysread($fh, $r, 1024) == 0) {
745                                                 close($fh);
746                                                 $fhs[$i][$channel] = undef;
747                                                 if (! defined $fhs[$i][0] &&
748                                                     ! defined $fhs[$i][1]) {
749                                                         waitpid($active[$i][0], 0);
750                                                         print STDOUT $out[$i][0];
751                                                         print STDERR $out[$i][1];
752                                                         record($active[$i][1], $? >> 8);
753                                                         splice(@fhs, $i, 1);
754                                                         splice(@active, $i, 1);
755                                                         splice(@out, $i, 1);
756                                                         $running--;
757                                                 }
758                                         }
759                                         $out[$i][$channel] .= $r;
760                                 }
761                         }
762                 }
763         }
764 } #}}}
765
766 sub record { #{{{
767         my $dir=shift()->[0];
768         my $ret=shift;
769
770         if ($ret == OK) {
771                 push @ok, $dir;
772                 print "\n";
773         }
774         elsif ($ret == FAILED) {
775                 push @failed, $dir;
776                 print "\n";
777         }
778         elsif ($ret == SKIPPED) {
779                 push @skipped, $dir;
780         }
781         elsif ($ret == ABORT) {
782                 exit 1;
783         }
784         else {
785                 die "unknown exit status $ret";
786         }
787 } #}}}
788
789 sub showstat { #{{{
790         my $count=shift;
791         my $singular=shift;
792         my $plural=shift;
793         if ($count) {
794                 return "$count ".($count > 1 ? $plural : $singular);
795         }
796         return;
797 } #}}}
798
799 my %loaded;
800 sub loadconfig { #{{{
801         my $f=shift;
802
803         my @toload;
804
805         my $in;
806         my $dir;
807         if (ref $f eq 'GLOB') {
808                 $dir="";
809                 $in=$f; 
810         }
811         else {
812                 if (! -e $f) {
813                         return;
814                 }
815
816                 my $absf=abs_path($f);
817                 if ($loaded{$absf}) {
818                         return;
819                 }
820                 $loaded{$absf}=1;
821
822                 ($dir)=$f=~/^(.*\/)[^\/]+$/;
823                 if (! defined $dir) {
824                         $dir=".";
825                 }
826                 $dir=abs_path($dir)."/";
827                 
828                 if (! exists $configfiles{$dir}) {
829                         $configfiles{$dir}=$f;
830                 }
831
832                 # copy in defaults from first parent
833                 my $parent=$dir;
834                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
835                         if ($parent eq '/') {
836                                 $parent="";
837                         }
838                         if (exists $config{$parent} &&
839                             exists $config{$parent}{DEFAULT}) {
840                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
841                                 last;
842                         }
843                 }
844                 
845                 print "mr: loading config $f\n" if $verbose;
846                 open($in, "<", $f) || die "mr: open $f: $!\n";
847         }
848         my @lines=<$in>;
849         close $in;
850
851         my $section;
852         my $line=0;
853         while (@lines) {
854                 $_=shift @lines;
855                 $line++;
856                 chomp;
857                 next if /^\s*\#/ || /^\s*$/;
858                 if (/^\[([^\]]*)\]\s*$/) {
859                         $section=$1;
860                 }
861                 elsif (/^(\w+)\s*=\s*(.*)/) {
862                         my $parameter=$1;
863                         my $value=$2;
864
865                         # continued value
866                         while (@lines && $lines[0]=~/^\s(.+)/) {
867                                 shift(@lines);
868                                 $line++;
869                                 $value.="\n$1";
870                                 chomp $value;
871                         }
872
873                         if ($parameter eq "include") {
874                                 print "mr: including output of \"$value\"\n" if $verbose;
875                                 unshift @lines, `$value`;
876                                 next;
877                         }
878
879                         if (! defined $section) {
880                                 die "$f line $.: parameter ($parameter) not in section\n";
881                         }
882                         if ($section ne 'ALIAS' &&
883                             ! exists $config{$dir}{$section} &&
884                             exists $config{$dir}{DEFAULT}) {
885                                 # copy in defaults
886                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
887                         }
888                         if ($section eq 'ALIAS') {
889                                 $alias{$parameter}=$value;
890                         }
891                         elsif ($parameter eq 'lib') {
892                                 $config{$dir}{$section}{lib}.=$value."\n";
893                         }
894                         else {
895                                 $config{$dir}{$section}{$parameter}=$value;
896                                 if ($parameter =~ /.*_(.*)/) {
897                                         $knownactions{$1}=1;
898                                 }
899                                 else {
900                                         $knownactions{$parameter}=1;
901                                 }
902                                 if ($parameter eq 'chain' &&
903                                     length $dir && $section ne "DEFAULT" &&
904                                     -e $dir.$section."/.mrconfig") {
905                                         my $ret=system($value);
906                                         if ($ret != 0) {
907                                                 if (($? & 127) == 2) {
908                                                         print STDERR "mr $action: chain test interrupted\n";
909                                                         exit 2;
910                                                 }
911                                                 elsif ($? & 127) {
912                                                         print STDERR "mr $action: chain test received signal ".($? & 127)."\n";
913                                                 }
914                                         }
915                                         else {
916                                                 push @toload, $dir.$section."/.mrconfig";
917                                         }
918                                 }
919                         }
920                 }
921                 else {
922                         die "$f line $line: parse error\n";
923                 }
924         }
925
926         foreach (@toload) {
927                 loadconfig($_);
928         }
929 } #}}}
930
931 sub modifyconfig { #{{{
932         my $f=shift;
933         # the section to modify or add
934         my $targetsection=shift;
935         # fields to change in the section
936         # To remove a field, set its value to "".
937         my %changefields=@_;
938
939         my @lines;
940         my @out;
941
942         if (-e $f) {
943                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
944                 @lines=<$in>;
945                 close $in;
946         }
947
948         my $formatfield=sub {
949                 my $field=shift;
950                 my @value=split(/\n/, shift);
951
952                 return "$field = ".shift(@value)."\n".
953                         join("", map { "\t$_\n" } @value);
954         };
955         my $addfields=sub {
956                 my @blanks;
957                 while ($out[$#out] =~ /^\s*$/) {
958                         unshift @blanks, pop @out;
959                 }
960                 foreach my $field (sort keys %changefields) {
961                         if (length $changefields{$field}) {
962                                 push @out, "$field = $changefields{$field}\n";
963                                 delete $changefields{$field};
964                         }
965                 }
966                 push @out, @blanks;
967         };
968
969         my $section;
970         while (@lines) {
971                 $_=shift(@lines);
972
973                 if (/^\s*\#/ || /^\s*$/) {
974                         push @out, $_;
975                 }
976                 elsif (/^\[([^\]]*)\]\s*$/) {
977                         if (defined $section && 
978                             $section eq $targetsection) {
979                                 $addfields->();
980                         }
981
982                         $section=$1;
983
984                         push @out, $_;
985                 }
986                 elsif (/^(\w+)\s*=\s(.*)/) {
987                         my $parameter=$1;
988                         my $value=$2;
989
990                         # continued value
991                         while (@lines && $lines[0]=~/^\s(.+)/) {
992                                 shift(@lines);
993                                 $value.="\n$1";
994                                 chomp $value;
995                         }
996
997                         if ($section eq $targetsection) {
998                                 if (exists $changefields{$parameter}) {
999                                         if (length $changefields{$parameter}) {
1000                                                 $value=$changefields{$parameter};
1001                                         }
1002                                         delete $changefields{$parameter};
1003                                 }
1004                         }
1005
1006                         push @out, $formatfield->($parameter, $value);
1007                 }
1008         }
1009
1010         if (defined $section && 
1011             $section eq $targetsection) {
1012                 $addfields->();
1013         }
1014         elsif (%changefields) {
1015                 push @out, "\n[$targetsection]\n";
1016                 foreach my $field (sort keys %changefields) {
1017                         if (length $changefields{$field}) {
1018                                 push @out, $formatfield->($field, $changefields{$field});
1019                         }
1020                 }
1021         }
1022
1023         open(my $out, ">", $f) || die "mr: write $f: $!\n";
1024         print $out @out;
1025         close $out;     
1026 } #}}}
1027
1028 # Finally, some useful actions that mr knows about by default.
1029 # These can be overridden in ~/.mrconfig.
1030 #DATA{{{
1031 __DATA__
1032 [ALIAS]
1033 co = checkout
1034 ci = commit
1035 ls = list
1036
1037 [DEFAULT]
1038 order = 10
1039 lib =
1040         error() {
1041                 echo "mr: $@" >&2
1042                 exit 1
1043         }
1044         warning() {
1045                 echo "mr (warning): $@" >&2
1046         }
1047         info() {
1048                 echo "mr: $@" >&2
1049         }
1050         hours_since() {
1051                 if [ -z "$1" ] || [ -z "$2" ]; then
1052                         error "mr: usage: hours_since action num"
1053                 fi
1054                 for dir in .git .svn .bzr CVS .hg _darcs; do
1055                         if [ -e "$MR_REPO/$dir" ]; then
1056                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1057                                 break
1058                         fi
1059                 done
1060                 if [ -z "$flagfile" ]; then
1061                         error "cannot determine flag filename"
1062                 fi
1063                 delta=$(perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile")
1064                 if [ "$delta" -lt "$2" ]; then
1065                         exit 0
1066                 else
1067                         touch "$flagfile"
1068                         exit 1
1069                 fi
1070         }
1071
1072 svn_test = test -d "$MR_REPO"/.svn
1073 git_test = test -d "$MR_REPO"/.git
1074 bzr_test = test -d "$MR_REPO"/.bzr
1075 cvs_test = test -d "$MR_REPO"/CVS
1076 hg_test  = test -d "$MR_REPO"/.hg
1077 darcs_test = test -d "$MR_REPO"/_darcs
1078 git_bare_test =
1079         test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
1080         test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
1081         test "$(GIT_CONFIG="$MR_REPO"/config git-config --get core.bare)" = true
1082
1083 svn_update = svn update "$@"
1084 git_update = if [ "$@" ]; then git pull "$@"; else git pull -t origin master; fi
1085 bzr_update = bzr merge "$@"
1086 cvs_update = cvs update "$@"
1087 hg_update  = hg pull "$@" && hg update "$@"
1088 darcs_update = darcs pull -a "$@"
1089
1090 svn_status = svn status "$@"
1091 git_status = git status "$@" || true
1092 bzr_status = bzr status "$@"
1093 cvs_status = cvs status "$@"
1094 hg_status  = hg status "$@"
1095 darcs_status = darcs whatsnew -ls "$@"
1096
1097 svn_commit = svn commit "$@"
1098 git_commit = git commit -a "$@" && git push --all
1099 bzr_commit = bzr commit "$@" && bzr push
1100 cvs_commit = cvs commit "$@"
1101 hg_commit  = hg commit -m "$@" && hg push
1102 darcs_commit = darcs commit -a -m "$@" && darcs push -a
1103
1104 svn_diff = svn diff "$@"
1105 git_diff = git diff "$@"
1106 bzr_diff = bzr diff "$@"
1107 cvs_diff = cvs diff "$@"
1108 hg_diff  = hg diff "$@"
1109 darcs_diff = darcs diff "$@"
1110
1111 svn_log = svn log "$@"
1112 git_log = git log "$@"
1113 bzr_log = bzr log "$@"
1114 cvs_log = cvs log "$@"
1115 hg_log  = hg log "$@"
1116 darcs_log = darcs changes "$@"
1117 git_bare_log = git log "$@"
1118
1119 svn_register =
1120         url=$(LANG=C svn info . | grep -i ^URL: | cut -d ' ' -f 2)
1121         if [ -z "$url" ]; then
1122                 error "cannot determine svn url"
1123         fi
1124         echo "Registering svn url: $url in $MR_CONFIG"
1125         mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co $url $MR_REPO"
1126 git_register = 
1127         url="$(LANG=C git-config --get remote.origin.url)" || true
1128         if [ -z "$url" ]; then
1129                 error "cannot determine git url"
1130         fi
1131         echo "Registering git url: $url in $MR_CONFIG"
1132         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone $url $MR_REPO"
1133 bzr_register =
1134         url=$(cat .bzr/branch/parent)
1135         if [ -z "$url" ]; then
1136                 error "cannot determine bzr url"
1137         fi
1138         echo "Registering bzr url: $url in $MR_CONFIG"
1139         mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr clone $url $MR_REPO"
1140 cvs_register =
1141         repo=$(cat CVS/Repository)
1142         root=$(cat CVS/Root)
1143         if [ -z "$root" ]; then
1144                 error "cannot determine cvs root"
1145                 fi
1146         echo "Registering cvs repository $repo at root $root"
1147         mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d $MR_REPO $repo"
1148 hg_register = 
1149         url=$(hg showconfig paths.default)
1150         echo "Registering mercurial repo url: $url in $MR_CONFIG"
1151         mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone $url $MR_REPO"
1152 darcs_register = 
1153         url=$(cat _darcs/prefs/defaultrepo)
1154         echo "Registering darcs repository $url in $MR_CONFIG"
1155         mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get $url $MR_REPO"
1156 git_bare_register = 
1157         url="$(LANG=C GIT_CONFIG=config git-config --get remote.origin.url)" || true
1158         if [ -z "$url" ]; then
1159                 error "cannot determine git url"
1160         fi
1161         echo "Registering git url: $url in $MR_CONFIG"
1162         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare $url $MR_REPO"
1163
1164 help =
1165         if [ ! -e "$MR_PATH" ]; then
1166                 error "cannot find program path"
1167         fi
1168         (pod2man -c mr "$MR_PATH" | man -l -) || error "pod2man or man failed"
1169 list = true
1170 config = 
1171
1172 ed = echo "A horse is a horse, of course, of course.."
1173 T = echo "I pity the fool."
1174 right = echo "Not found."
1175 #}}}
1176
1177 # vim:sw=8:sts=0:ts=8:noet