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

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