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

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