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

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