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

quote all url and dir strings written by mr reg
[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                                 $directory=$topdir;
431                                 last;
432                         }
433                 }
434         }
435         if (@ARGV) {
436                 my $subdir=shift @ARGV;
437                 if (! chdir($subdir)) {
438                         print STDERR "mr $action: failed to chdir to $subdir: $!\n";
439                 }
440         }
441
442         $ENV{MR_REPO}=getcwd();
443         my $command=findcommand("register", $ENV{MR_CONFIG}, $directory, 'DEFAULT');
444         if (! defined $command) {
445                 die "mr $action: unknown repository type\n";
446         }
447
448         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
449         $command="set -e; ".$config{$ENV{MR_CONFIG}}{$directory}{lib}."\n".
450                 "my_action(){ $command\n }; my_action ".
451                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
452         print "mr $action: running >>$command<<\n" if $verbose;
453         exec($command) || die "exec: $!";
454 }
455
456 # an ordered list of repos
457 my @list;
458 foreach my $topdir (sort keys %config) {
459         foreach my $subdir (sort keys %{$config{$topdir}}) {
460                 push @list, {
461                         topdir => $topdir,
462                         subdir => $subdir,
463                         order => $config{$topdir}{$subdir}{order},
464                 };
465         }
466 }
467 @list = sort {
468                 $a->{order}  <=> $b->{order}
469                              ||
470                 $a->{topdir} cmp $b->{topdir}
471                              ||
472                 $a->{subdir} cmp $b->{subdir}
473         } @list;
474
475 # work out what repos to act on
476 my @repos;
477 my $nochdir=0;
478 foreach my $repo (@list) {
479         my $topdir=$repo->{topdir};
480         my $subdir=$repo->{subdir};
481
482         next if $subdir eq 'DEFAULT';
483         my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
484         my $d=$directory;
485         $dir.="/" unless $dir=~/\/$/;
486         $d.="/" unless $d=~/\/$/;
487         next if $no_recurse && $d ne $dir;
488         next if $dir ne $d && $dir !~ /^\Q$d\E/;
489         push @repos, [$dir, $topdir, $subdir];
490 }
491 if (! @repos) {
492         # fallback to find a leaf repo
493         foreach my $repo (reverse @list) {
494                 my $topdir=$repo->{topdir};
495                 my $subdir=$repo->{subdir};
496                 
497                 next if $subdir eq 'DEFAULT';
498                 my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
499                 my $d=$directory;
500                 $dir.="/" unless $dir=~/\/$/;
501                 $d.="/" unless $d=~/\/$/;
502                 if ($d=~/^\Q$dir\E/) {
503                         push @repos, [$dir, $topdir, $subdir];
504                         last;
505                 }
506         }
507         $nochdir=1;
508 }
509
510 # run the action on each repository and print stats
511 my (@ok, @failed, @skipped);
512 if ($jobs > 1) {
513         mrs(@repos);
514 }
515 else {
516         foreach my $repo (@repos) {
517                 record($repo, action($action, @$repo));
518         }
519 }
520 if (! @ok && ! @failed && ! @skipped) {
521         die "mr $action: no repositories found to work on\n";
522 }
523 print "mr $action: finished (".join("; ",
524         showstat($#ok+1, "ok", "ok"),
525         showstat($#failed+1, "failed", "failed"),
526         showstat($#skipped+1, "skipped", "skipped"),
527 ).")\n";
528 if ($stats) {
529         if (@skipped) {
530                 print "mr $action: (skipped: ".join(" ", @skipped).")\n";
531         }
532         if (@failed) {
533                 print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
534         }
535 }
536 if (@failed) {
537         exit 1;
538 }
539 elsif (! @ok && @skipped) {
540         exit 1;
541 }
542 exit 0;
543
544 sub rcs_test { #{{{
545         my ($action, $dir, $topdir, $subdir) = @_;
546
547         my $test="set -e\n";
548         foreach my $rcs_test (
549                         sort {
550                                 length $a <=> length $b 
551                                           ||
552                                        $a cmp $b
553                         } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
554                 my ($rcs)=$rcs_test=~/(.*)_test/;
555                 $test="my_$rcs_test() {\n$config{$topdir}{$subdir}{$rcs_test}\n}\n".$test;
556                 $test.="if my_$rcs_test; then echo $rcs; fi\n";
557         }
558         $test=$config{$topdir}{$subdir}{lib}."\n".$test
559                 if exists $config{$topdir}{$subdir}{lib};
560         
561         print "mr $action: running rcs test >>$test<<\n" if $verbose;
562         my $rcs=`$test`;
563         chomp $rcs;
564         if (! length $rcs) {
565                 return undef;
566         }
567         else {
568                 return $rcs;
569         }
570 } #}}}
571         
572 sub findcommand { #{{{
573         my ($action, $dir, $topdir, $subdir) = @_;
574         
575         if (exists $config{$topdir}{$subdir}{$action}) {
576                 return $config{$topdir}{$subdir}{$action};
577         }
578
579         my $rcs=rcs_test(@_);
580
581         if (defined $rcs && 
582             exists $config{$topdir}{$subdir}{$rcs."_".$action}) {
583                 return $config{$topdir}{$subdir}{$rcs."_".$action};
584         }
585         else {
586                 return undef;
587         }
588 } #}}}
589
590 sub action { #{{{
591         my ($action, $dir, $topdir, $subdir) = @_;
592
593         $ENV{MR_CONFIG}=$configfiles{$topdir};
594         my $lib=exists $config{$topdir}{$subdir}{lib} ?
595                        $config{$topdir}{$subdir}{lib}."\n" : "";
596
597         if ($action eq 'checkout') {
598                 if (-d $dir) {
599                         print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
600                         return SKIPPED;
601                 }
602
603                 $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
604
605                 if (! -d $dir) {
606                         print "mr $action: creating parent directory $dir\n" if $verbose;
607                         system("mkdir", "-p", $dir);
608                 }
609         }
610         elsif ($action =~ /update/) {
611                 if (! -d $dir) {
612                         return action("checkout", $dir, $topdir, $subdir);
613                 }
614         }
615
616         $ENV{MR_REPO}=$dir;
617
618         my $skiptest=findcommand("skip", $dir, $topdir, $subdir);
619         my $command=findcommand($action, $dir, $topdir, $subdir);
620
621         if (defined $skiptest) {
622                 my $test="set -e;".$lib.
623                         "my_action(){ $skiptest\n }; my_action '$action'";
624                 print "mr $action: running skip test >>$test<<\n" if $verbose;
625                 my $ret=system($test);
626                 if ($ret != 0) {
627                         if (($? & 127) == 2) {
628                                 print STDERR "mr $action: interrupted\n";
629                                 return ABORT;
630                         }
631                         elsif ($? & 127) {
632                                 print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
633                                 return ABORT;
634                         }
635                 }
636                 if ($ret >> 8 == 0) {
637                         print "mr $action: $dir skipped per config file\n" if $verbose;
638                         return SKIPPED;
639                 }
640         }
641         
642         if (! $nochdir && ! chdir($dir)) {
643                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
644                 return FAILED;
645         }
646         elsif (! defined $command) {
647                 my $rcs=rcs_test(@_);
648                 if (! defined $rcs) {
649                         print STDERR "mr $action: unknown repository type and no defined $action command for $topdir$subdir\n";
650                         return FAILED;
651                 }
652                 else {
653                         print STDERR "mr $action: no defined $action command for $rcs repository $topdir$subdir, skipping\n";
654                         return SKIPPED;
655                 }
656         }
657         else {
658                 if (! $nochdir) {
659                         print "mr $action: $topdir$subdir\n";
660                 }
661                 else {
662                         my $s=$directory;
663                         $s=~s/^\Q$topdir$subdir\E\/?//;
664                         print "mr $action: $topdir$subdir (in subdir $s)\n";
665                 }
666                 $command="set -e; ".$lib.
667                         "my_action(){ $command\n }; my_action ".
668                         join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
669                 print "mr $action: running >>$command<<\n" if $verbose;
670                 my $ret=system($command);
671                 if ($ret != 0) {
672                         if (($? & 127) == 2) {
673                                 print STDERR "mr $action: interrupted\n";
674                                 return ABORT;
675                         }
676                         elsif ($? & 127) {
677                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
678                                 return ABORT;
679                         }
680                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
681                         if ($ret >> 8 != 0) {
682                                 print STDERR "mr $action: command failed\n";
683                         }
684                         elsif ($ret != 0) {
685                                 print STDERR "mr $action: command died ($ret)\n";
686                         }
687                         return FAILED;
688                 }
689                 else {
690                         if ($action eq 'checkout' && ! -d $dir) {
691                                 print STDERR "mr $action: $dir missing after checkout\n";;
692                                 return FAILED;
693                         }
694
695                         return OK;
696                 }
697         }
698 } #}}}
699
700 # run actions on multiple repos, in parallel
701 sub mrs { #{{{
702         $| = 1;
703         my @active;
704         my @fhs;
705         my @out;
706         my $running=0;
707         while (@fhs or @repos) {
708                 while ($running < $jobs && @repos) {
709                         $running++;
710                         my $repo = shift @repos;
711                         pipe(my $outfh, CHILD_STDOUT);
712                         pipe(my $errfh, CHILD_STDERR);
713                         my $pid;
714                         unless ($pid = fork) {
715                                 die "mr $action: cannot fork: $!" unless defined $pid;
716                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
717                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
718                                 close CHILD_STDOUT;
719                                 close CHILD_STDERR;
720                                 close $outfh;
721                                 close $errfh;
722                                 exit action($action, @$repo);
723                         }
724                         close CHILD_STDOUT;
725                         close CHILD_STDERR;
726                         push @active, [$pid, $repo];
727                         push @fhs, [$outfh, $errfh];
728                         push @out, ['',     ''];
729                 }
730                 my ($rin, $rout) = ('','');
731                 my $nfound;
732                 foreach my $fh (@fhs) {
733                         next unless defined $fh;
734                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
735                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
736                 }
737                 $nfound = select($rout=$rin, undef, undef, 1);
738                 foreach my $channel (0, 1) {
739                         foreach my $i (0..$#fhs) {
740                                 next unless defined $fhs[$i];
741                                 my $fh = $fhs[$i][$channel];
742                                 next unless defined $fh;
743                                 if (vec($rout, fileno($fh), 1) == 1) {
744                                         my $r = '';
745                                         if (sysread($fh, $r, 1024) == 0) {
746                                                 close($fh);
747                                                 $fhs[$i][$channel] = undef;
748                                                 if (! defined $fhs[$i][0] &&
749                                                     ! defined $fhs[$i][1]) {
750                                                         waitpid($active[$i][0], 0);
751                                                         print STDOUT $out[$i][0];
752                                                         print STDERR $out[$i][1];
753                                                         record($active[$i][1], $? >> 8);
754                                                         splice(@fhs, $i, 1);
755                                                         splice(@active, $i, 1);
756                                                         splice(@out, $i, 1);
757                                                         $running--;
758                                                 }
759                                         }
760                                         $out[$i][$channel] .= $r;
761                                 }
762                         }
763                 }
764         }
765 } #}}}
766
767 sub record { #{{{
768         my $dir=shift()->[0];
769         my $ret=shift;
770
771         if ($ret == OK) {
772                 push @ok, $dir;
773                 print "\n";
774         }
775         elsif ($ret == FAILED) {
776                 push @failed, $dir;
777                 print "\n";
778         }
779         elsif ($ret == SKIPPED) {
780                 push @skipped, $dir;
781         }
782         elsif ($ret == ABORT) {
783                 exit 1;
784         }
785         else {
786                 die "unknown exit status $ret";
787         }
788 } #}}}
789
790 sub showstat { #{{{
791         my $count=shift;
792         my $singular=shift;
793         my $plural=shift;
794         if ($count) {
795                 return "$count ".($count > 1 ? $plural : $singular);
796         }
797         return;
798 } #}}}
799
800 my %loaded;
801 sub loadconfig { #{{{
802         my $f=shift;
803
804         my @toload;
805
806         my $in;
807         my $dir;
808         if (ref $f eq 'GLOB') {
809                 $dir="";
810                 $in=$f; 
811         }
812         else {
813                 if (! -e $f) {
814                         return;
815                 }
816
817                 my $absf=abs_path($f);
818                 if ($loaded{$absf}) {
819                         return;
820                 }
821                 $loaded{$absf}=1;
822
823                 ($dir)=$f=~/^(.*\/)[^\/]+$/;
824                 if (! defined $dir) {
825                         $dir=".";
826                 }
827                 $dir=abs_path($dir)."/";
828                 
829                 if (! exists $configfiles{$dir}) {
830                         $configfiles{$dir}=$f;
831                 }
832
833                 # copy in defaults from first parent
834                 my $parent=$dir;
835                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
836                         if ($parent eq '/') {
837                                 $parent="";
838                         }
839                         if (exists $config{$parent} &&
840                             exists $config{$parent}{DEFAULT}) {
841                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
842                                 last;
843                         }
844                 }
845                 
846                 print "mr: loading config $f\n" if $verbose;
847                 open($in, "<", $f) || die "mr: open $f: $!\n";
848         }
849         my @lines=<$in>;
850         close $in;
851
852         my $section;
853         my $line=0;
854         while (@lines) {
855                 $_=shift @lines;
856                 $line++;
857                 chomp;
858                 next if /^\s*\#/ || /^\s*$/;
859                 if (/^\[([^\]]*)\]\s*$/) {
860                         $section=$1;
861                 }
862                 elsif (/^(\w+)\s*=\s*(.*)/) {
863                         my $parameter=$1;
864                         my $value=$2;
865
866                         # continued value
867                         while (@lines && $lines[0]=~/^\s(.+)/) {
868                                 shift(@lines);
869                                 $line++;
870                                 $value.="\n$1";
871                                 chomp $value;
872                         }
873
874                         if ($parameter eq "include") {
875                                 print "mr: including output of \"$value\"\n" if $verbose;
876                                 unshift @lines, `$value`;
877                                 next;
878                         }
879
880                         if (! defined $section) {
881                                 die "$f line $.: parameter ($parameter) not in section\n";
882                         }
883                         if ($section ne 'ALIAS' &&
884                             ! exists $config{$dir}{$section} &&
885                             exists $config{$dir}{DEFAULT}) {
886                                 # copy in defaults
887                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
888                         }
889                         if ($section eq 'ALIAS') {
890                                 $alias{$parameter}=$value;
891                         }
892                         elsif ($parameter eq 'lib') {
893                                 $config{$dir}{$section}{lib}.=$value."\n";
894                         }
895                         else {
896                                 $config{$dir}{$section}{$parameter}=$value;
897                                 if ($parameter =~ /.*_(.*)/) {
898                                         $knownactions{$1}=1;
899                                 }
900                                 else {
901                                         $knownactions{$parameter}=1;
902                                 }
903                                 if ($parameter eq 'chain' &&
904                                     length $dir && $section ne "DEFAULT" &&
905                                     -e $dir.$section."/.mrconfig") {
906                                         my $ret=system($value);
907                                         if ($ret != 0) {
908                                                 if (($? & 127) == 2) {
909                                                         print STDERR "mr $action: chain test interrupted\n";
910                                                         exit 2;
911                                                 }
912                                                 elsif ($? & 127) {
913                                                         print STDERR "mr $action: chain test received signal ".($? & 127)."\n";
914                                                 }
915                                         }
916                                         else {
917                                                 push @toload, $dir.$section."/.mrconfig";
918                                         }
919                                 }
920                         }
921                 }
922                 else {
923                         die "$f line $line: parse error\n";
924                 }
925         }
926
927         foreach (@toload) {
928                 loadconfig($_);
929         }
930 } #}}}
931
932 sub modifyconfig { #{{{
933         my $f=shift;
934         # the section to modify or add
935         my $targetsection=shift;
936         # fields to change in the section
937         # To remove a field, set its value to "".
938         my %changefields=@_;
939
940         my @lines;
941         my @out;
942
943         if (-e $f) {
944                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
945                 @lines=<$in>;
946                 close $in;
947         }
948
949         my $formatfield=sub {
950                 my $field=shift;
951                 my @value=split(/\n/, shift);
952
953                 return "$field = ".shift(@value)."\n".
954                         join("", map { "\t$_\n" } @value);
955         };
956         my $addfields=sub {
957                 my @blanks;
958                 while ($out[$#out] =~ /^\s*$/) {
959                         unshift @blanks, pop @out;
960                 }
961                 foreach my $field (sort keys %changefields) {
962                         if (length $changefields{$field}) {
963                                 push @out, "$field = $changefields{$field}\n";
964                                 delete $changefields{$field};
965                         }
966                 }
967                 push @out, @blanks;
968         };
969
970         my $section;
971         while (@lines) {
972                 $_=shift(@lines);
973
974                 if (/^\s*\#/ || /^\s*$/) {
975                         push @out, $_;
976                 }
977                 elsif (/^\[([^\]]*)\]\s*$/) {
978                         if (defined $section && 
979                             $section eq $targetsection) {
980                                 $addfields->();
981                         }
982
983                         $section=$1;
984
985                         push @out, $_;
986                 }
987                 elsif (/^(\w+)\s*=\s(.*)/) {
988                         my $parameter=$1;
989                         my $value=$2;
990
991                         # continued value
992                         while (@lines && $lines[0]=~/^\s(.+)/) {
993                                 shift(@lines);
994                                 $value.="\n$1";
995                                 chomp $value;
996                         }
997
998                         if ($section eq $targetsection) {
999                                 if (exists $changefields{$parameter}) {
1000                                         if (length $changefields{$parameter}) {
1001                                                 $value=$changefields{$parameter};
1002                                         }
1003                                         delete $changefields{$parameter};
1004                                 }
1005                         }
1006
1007                         push @out, $formatfield->($parameter, $value);
1008                 }
1009         }
1010
1011         if (defined $section && 
1012             $section eq $targetsection) {
1013                 $addfields->();
1014         }
1015         elsif (%changefields) {
1016                 push @out, "\n[$targetsection]\n";
1017                 foreach my $field (sort keys %changefields) {
1018                         if (length $changefields{$field}) {
1019                                 push @out, $formatfield->($field, $changefields{$field});
1020                         }
1021                 }
1022         }
1023
1024         open(my $out, ">", $f) || die "mr: write $f: $!\n";
1025         print $out @out;
1026         close $out;     
1027 } #}}}
1028
1029 # Finally, some useful actions that mr knows about by default.
1030 # These can be overridden in ~/.mrconfig.
1031 #DATA{{{
1032 __DATA__
1033 [ALIAS]
1034 co = checkout
1035 ci = commit
1036 ls = list
1037
1038 [DEFAULT]
1039 order = 10
1040 lib =
1041         error() {
1042                 echo "mr: $@" >&2
1043                 exit 1
1044         }
1045         warning() {
1046                 echo "mr (warning): $@" >&2
1047         }
1048         info() {
1049                 echo "mr: $@" >&2
1050         }
1051         hours_since() {
1052                 if [ -z "$1" ] || [ -z "$2" ]; then
1053                         error "mr: usage: hours_since action num"
1054                 fi
1055                 for dir in .git .svn .bzr CVS .hg _darcs; do
1056                         if [ -e "$MR_REPO/$dir" ]; then
1057                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1058                                 break
1059                         fi
1060                 done
1061                 if [ -z "$flagfile" ]; then
1062                         error "cannot determine flag filename"
1063                 fi
1064                 delta=$(perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile")
1065                 if [ "$delta" -lt "$2" ]; then
1066                         exit 0
1067                 else
1068                         touch "$flagfile"
1069                         exit 1
1070                 fi
1071         }
1072
1073 svn_test = test -d "$MR_REPO"/.svn
1074 git_test = test -d "$MR_REPO"/.git
1075 bzr_test = test -d "$MR_REPO"/.bzr
1076 cvs_test = test -d "$MR_REPO"/CVS
1077 hg_test  = test -d "$MR_REPO"/.hg
1078 darcs_test = test -d "$MR_REPO"/_darcs
1079 git_bare_test =
1080         test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
1081         test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
1082         test "$(GIT_CONFIG="$MR_REPO"/config git-config --get core.bare)" = true
1083
1084 svn_update = svn update "$@"
1085 git_update = if [ "$@" ]; then git pull "$@"; else git pull -t origin master; fi
1086 bzr_update = bzr merge "$@"
1087 cvs_update = cvs update "$@"
1088 hg_update  = hg pull "$@" && hg update "$@"
1089 darcs_update = darcs pull -a "$@"
1090
1091 svn_status = svn status "$@"
1092 git_status = git status "$@" || true
1093 bzr_status = bzr status "$@"
1094 cvs_status = cvs status "$@"
1095 hg_status  = hg status "$@"
1096 darcs_status = darcs whatsnew -ls "$@"
1097
1098 svn_commit = svn commit "$@"
1099 git_commit = git commit -a "$@" && git push --all
1100 bzr_commit = bzr commit "$@" && bzr push
1101 cvs_commit = cvs commit "$@"
1102 hg_commit  = hg commit -m "$@" && hg push
1103 darcs_commit = darcs commit -a -m "$@" && darcs push -a
1104
1105 svn_diff = svn diff "$@"
1106 git_diff = git diff "$@"
1107 bzr_diff = bzr diff "$@"
1108 cvs_diff = cvs diff "$@"
1109 hg_diff  = hg diff "$@"
1110 darcs_diff = darcs diff "$@"
1111
1112 svn_log = svn log "$@"
1113 git_log = git log "$@"
1114 bzr_log = bzr log "$@"
1115 cvs_log = cvs log "$@"
1116 hg_log  = hg log "$@"
1117 darcs_log = darcs changes "$@"
1118 git_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'p '$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         echo "Registering git url: $url in $MR_CONFIG"
1163         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
1164
1165 help =
1166         if [ ! -e "$MR_PATH" ]; then
1167                 error "cannot find program path"
1168         fi
1169         (pod2man -c mr "$MR_PATH" | man -l -) || error "pod2man or man failed"
1170 list = true
1171 config = 
1172
1173 ed = echo "A horse is a horse, of course, of course.."
1174 T = echo "I pity the fool."
1175 right = echo "Not found."
1176 #}}}
1177
1178 # vim:sw=8:sts=0:ts=8:noet