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

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