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

* Add -q flag.
[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 repository. 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 substring, so
125 "mr st" is equivalent to "mr status", and "mr up" is equivalent 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 -q
151
152 Be quiet.
153
154 =item -s
155
156 Expand the statistics line displayed at the end to include information
157 about exactly which repositories failed and were skipped, if any.
158
159 =item -n [number]
160
161 If no number if specified, just operate on the repository for the current
162 directory, do not recurse into deeper repositories.
163
164 If a number is specified, will recurse into repositories at most that many
165 subdirectories deep. For example, with -n 2 it would recurse into ./src/foo,
166 but not ./src/packages/bar.
167
168 =item -j [number]
169
170 Run the specified number of jobs in parallel, or an unlimited number of jobs
171 with no number specified. This can greatly speed up operations such as updates.
172 It is not recommended for interactive operations.
173
174 Note that running more than 10 jobs at a time is likely to run afoul of
175 ssh connection limits. Running between 3 and 5 jobs at a time will yeild
176 a good speedup in updates without loading the machine too much.
177
178 =back
179
180 =head1 FILES
181
182 B<mr> is configured by .mrconfig files. It starts by reading the .mrconfig
183 file in your home directory, and this can in turn chain load .mrconfig files
184 from repositories.
185
186 Here is an example .mrconfig file:
187
188   [src]
189   checkout = svn co svn://svn.example.com/src/trunk src
190   chain = true
191
192   [src/linux-2.6]
193   checkout = git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git &&
194         cd linux-2.6 &&
195         git checkout -b mybranch origin/master
196
197 The .mrconfig file uses a variant of the INI file format. Lines starting with
198 "#" are comments. Values can be continued to the following line by
199 indenting the line with whitespace.
200
201 The "DEFAULT" section allows setting default values for the sections that
202 come after it.
203
204 The "ALIAS" section allows adding aliases for actions. Each parameter
205 is an alias, and its value is the action to use.
206
207 All other sections add repositories. The section header specifies the
208 directory where the repository is located. This is relative to the directory
209 that contains the mrconfig file, but you can also choose to use absolute
210 paths.
211
212 Within a section, each parameter defines a shell command to run to handle a
213 given action. mr contains default handlers for "update", "status",
214 "commit", and other standard actions. Normally you only need to specify what
215 to do for "checkout".
216
217 Note that these shell commands are run in a "set -e" shell
218 environment, where any additional parameters you pass are available in
219 "$@". The "checkout" command is run in the parent of the repository
220 directory, since the repository isn't checked out yet. All other commands
221 are run inside the repository, though not necessarily at the top of it.
222
223 The "MR_REPO" environment variable is set to the path to the top of the
224 repository. (For the "register" action, "MR_REPO" is instead set to the 
225 basename of the directory that should be created when checking the
226 repository out.)
227
228 The "MR_CONFIG" environment variable is set to the .mrconfig file
229 that defines the repo being acted on, or, if the repo is not yet in a config
230 file, the .mrconfig file that should be modified to register the repo.
231
232 A few parameters have special meanings:
233
234 =over 4
235
236 =item skip
237
238 If the "skip" parameter is set and its command returns true, then B<mr>
239 will skip acting on that repository. The command is passed the action
240 name in $1.
241
242 Here are two examples. The first skips the repo unless
243 mr is run by joey. The second uses the hours_since function
244 (included in mr's built-in library) to skip updating the repo unless it's
245 been at least 12 hours since the last update.
246
247   skip = test `whoami` != joey
248   skip = [ "$1" = update ] && ! hours_since "$1" 12
249
250 =item order
251
252 The "order" parameter can be used to override the default ordering of
253 repositories. The default order value is 10. Use smaller values to make
254 repositories be processed earlier, and larger values to make repositories
255 be processed later.
256
257 Note that if a repository is located in a subdirectory of another
258 repository, ordering it to be processed earlier is not recommended.
259
260 =item chain
261
262 If the "chain" parameter is set and its command returns true, then B<mr>
263 will try to load a .mrconfig file from the root of the repository. (You
264 should avoid chaining from repositories with untrusted committers.)
265
266 =item include
267
268 If the "include" parameter is set, its command is ran, and should output
269 additional mrconfig file content. The content is included as if it were
270 part of the including file.
271
272 Unlike all other parameters, this parameter does not need to be placed
273 within a section.
274
275 =item lib
276
277 The "lib" parameter can specify some shell code that will be run before each
278 command, this can be a useful way to define shell functions for other commands
279 to use.
280
281 =back
282
283 When looking for a command to run for a given action, mr first looks for
284 a parameter with the same name as the action. If that is not found, it
285 looks for a parameter named "rcs_action" (substituting in the name of the
286 revision control system and the action). The name of the revision control
287 system is itself determined by running each defined "rcs_test" action,
288 until one succeeds.
289
290 Internally, mr has settings for "git_update", "svn_update", etc. To change
291 the action that is performed for a given revision control system, you can
292 override these rcs specific actions. To add a new revision control system,
293 you can just add rcs specific actions for it.
294
295 =head1 AUTHOR
296
297 Copyright 2007 Joey Hess <joey@kitenet.net>
298
299 Licensed under the GNU GPL version 2 or higher.
300
301 http://kitenet.net/~joey/code/mr/
302
303 =cut
304
305 #}}}
306
307 use warnings;
308 use strict;
309 use Getopt::Long;
310 use Cwd qw(getcwd abs_path);
311
312 # things that can happen when mr runs a command
313 use constant {
314         OK => 0,
315         FAILED => 1,
316         SKIPPED => 2,
317         ABORT => 3,
318 };
319
320 # configurables
321 my $config_overridden=0;
322 my $verbose=0;
323 my $quiet=0;
324 my $stats=0;
325 my $max_depth;
326 my $no_chdir=0;
327 my $jobs=1;
328 my $directory=getcwd();
329 $ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
330
331 # globals :-(
332 my %config;
333 my %configfiles;
334 my %knownactions;
335 my %alias;
336 my (@ok, @failed, @skipped);
337
338 main();
339
340 my %rcs;
341 sub rcs_test { #{{{
342         my ($action, $dir, $topdir, $subdir) = @_;
343
344         if (exists $rcs{$dir}) {
345                 return $rcs{$dir};
346         }
347
348         my $test="set -e\n";
349         foreach my $rcs_test (
350                         sort {
351                                 length $a <=> length $b 
352                                           ||
353                                        $a cmp $b
354                         } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
355                 my ($rcs)=$rcs_test=~/(.*)_test/;
356                 $test="my_$rcs_test() {\n$config{$topdir}{$subdir}{$rcs_test}\n}\n".$test;
357                 $test.="if my_$rcs_test; then echo $rcs; fi\n";
358         }
359         $test=$config{$topdir}{$subdir}{lib}."\n".$test
360                 if exists $config{$topdir}{$subdir}{lib};
361         
362         print "mr $action: running rcs test >>$test<<\n" if $verbose;
363         my $rcs=`$test`;
364         chomp $rcs;
365         if ($rcs=~/\n/s) {
366                 $rcs=~s/\n/, /g;
367                 print STDERR "mr $action: found multiple possible repository types ($rcs) for $topdir$subdir\n";
368                 return undef;
369         }
370         if (! length $rcs) {
371                 return $rcs{$dir}=undef;
372         }
373         else {
374                 return $rcs{$dir}=$rcs;
375         }
376 } #}}}
377         
378 sub findcommand { #{{{
379         my ($action, $dir, $topdir, $subdir, $is_checkout) = @_;
380         
381         if (exists $config{$topdir}{$subdir}{$action}) {
382                 return $config{$topdir}{$subdir}{$action};
383         }
384
385         if ($is_checkout) {
386                 return undef;
387         }
388
389         my $rcs=rcs_test(@_);
390
391         if (defined $rcs && 
392             exists $config{$topdir}{$subdir}{$rcs."_".$action}) {
393                 return $config{$topdir}{$subdir}{$rcs."_".$action};
394         }
395         else {
396                 return undef;
397         }
398 } #}}}
399
400 sub action { #{{{
401         my ($action, $dir, $topdir, $subdir) = @_;
402
403         $ENV{MR_CONFIG}=$configfiles{$topdir};
404         my $lib=exists $config{$topdir}{$subdir}{lib} ?
405                        $config{$topdir}{$subdir}{lib}."\n" : "";
406         my $is_checkout=($action eq 'checkout');
407
408         if ($is_checkout) {
409                 if (-d $dir) {
410                         print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
411                         return SKIPPED;
412                 }
413
414                 $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
415         }
416         elsif ($action =~ /update/) {
417                 if (! -d $dir) {
418                         return action("checkout", $dir, $topdir, $subdir);
419                 }
420         }
421
422         $ENV{MR_REPO}=$dir;
423
424         my $skiptest=findcommand("skip", $dir, $topdir, $subdir, $is_checkout);
425         my $command=findcommand($action, $dir, $topdir, $subdir, $is_checkout);
426
427         if (defined $skiptest) {
428                 my $test="set -e;".$lib.
429                         "my_action(){ $skiptest\n }; my_action '$action'";
430                 print "mr $action: running skip test >>$test<<\n" if $verbose;
431                 my $ret=system($test);
432                 if ($ret != 0) {
433                         if (($? & 127) == 2) {
434                                 print STDERR "mr $action: interrupted\n";
435                                 return ABORT;
436                         }
437                         elsif ($? & 127) {
438                                 print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
439                                 return ABORT;
440                         }
441                 }
442                 if ($ret >> 8 == 0) {
443                         print "mr $action: $dir skipped per config file\n" if $verbose;
444                         return SKIPPED;
445                 }
446         }
447
448         if ($is_checkout && ! -d $dir) {
449                 print "mr $action: creating parent directory $dir\n" if $verbose;
450                 system("mkdir", "-p", $dir);
451         }
452
453         if (! $no_chdir && ! chdir($dir)) {
454                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
455                 return FAILED;
456         }
457         elsif (! defined $command) {
458                 my $rcs=rcs_test(@_);
459                 if (! defined $rcs) {
460                         print STDERR "mr $action: unknown repository type and no defined $action command for $topdir$subdir\n";
461                         return FAILED;
462                 }
463                 else {
464                         print STDERR "mr $action: no defined action for $rcs repository $topdir$subdir, skipping\n";
465                         return SKIPPED;
466                 }
467         }
468         else {
469                 if (! $no_chdir) {
470                         print "mr $action: $topdir$subdir\n" unless $quiet;
471                 }
472                 else {
473                         my $s=$directory;
474                         $s=~s/^\Q$topdir$subdir\E\/?//;
475                         print "mr $action: $topdir$subdir (in subdir $s)\n" unless $quiet;
476                 }
477                 $command="set -e; ".$lib.
478                         "my_action(){ $command\n }; my_action ".
479                         join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
480                 print "mr $action: running >>$command<<\n" if $verbose;
481                 my $ret=system($command);
482                 if ($ret != 0) {
483                         if (($? & 127) == 2) {
484                                 print STDERR "mr $action: interrupted\n";
485                                 return ABORT;
486                         }
487                         elsif ($? & 127) {
488                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
489                                 return ABORT;
490                         }
491                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
492                         if ($ret >> 8 != 0) {
493                                 print STDERR "mr $action: command failed\n";
494                         }
495                         elsif ($ret != 0) {
496                                 print STDERR "mr $action: command died ($ret)\n";
497                         }
498                         return FAILED;
499                 }
500                 else {
501                         if ($action eq 'checkout' && ! -d $dir) {
502                                 print STDERR "mr $action: $dir missing after checkout\n";;
503                                 return FAILED;
504                         }
505
506                         return OK;
507                 }
508         }
509 } #}}}
510
511 # run actions on multiple repos, in parallel
512 sub mrs { #{{{
513         my $action=shift;
514         my @repos=@_;
515
516         $| = 1;
517         my @active;
518         my @fhs;
519         my @out;
520         my $running=0;
521         while (@fhs or @repos) {
522                 while ((!$jobs || $running < $jobs) && @repos) {
523                         $running++;
524                         my $repo = shift @repos;
525                         pipe(my $outfh, CHILD_STDOUT);
526                         pipe(my $errfh, CHILD_STDERR);
527                         my $pid;
528                         unless ($pid = fork) {
529                                 die "mr $action: cannot fork: $!" unless defined $pid;
530                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
531                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
532                                 close CHILD_STDOUT;
533                                 close CHILD_STDERR;
534                                 close $outfh;
535                                 close $errfh;
536                                 exit action($action, @$repo);
537                         }
538                         close CHILD_STDOUT;
539                         close CHILD_STDERR;
540                         push @active, [$pid, $repo];
541                         push @fhs, [$outfh, $errfh];
542                         push @out, ['',     ''];
543                 }
544                 my ($rin, $rout) = ('','');
545                 my $nfound;
546                 foreach my $fh (@fhs) {
547                         next unless defined $fh;
548                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
549                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
550                 }
551                 $nfound = select($rout=$rin, undef, undef, 1);
552                 foreach my $channel (0, 1) {
553                         foreach my $i (0..$#fhs) {
554                                 next unless defined $fhs[$i];
555                                 my $fh = $fhs[$i][$channel];
556                                 next unless defined $fh;
557                                 if (vec($rout, fileno($fh), 1) == 1) {
558                                         my $r = '';
559                                         if (sysread($fh, $r, 1024) == 0) {
560                                                 close($fh);
561                                                 $fhs[$i][$channel] = undef;
562                                                 if (! defined $fhs[$i][0] &&
563                                                     ! defined $fhs[$i][1]) {
564                                                         waitpid($active[$i][0], 0);
565                                                         print STDOUT $out[$i][0];
566                                                         print STDERR $out[$i][1];
567                                                         record($active[$i][1], $? >> 8);
568                                                         splice(@fhs, $i, 1);
569                                                         splice(@active, $i, 1);
570                                                         splice(@out, $i, 1);
571                                                         $running--;
572                                                 }
573                                         }
574                                         $out[$i][$channel] .= $r;
575                                 }
576                         }
577                 }
578         }
579 } #}}}
580
581 sub record { #{{{
582         my $dir=shift()->[0];
583         my $ret=shift;
584
585         if ($ret == OK) {
586                 push @ok, $dir;
587                 print "\n";
588         }
589         elsif ($ret == FAILED) {
590                 push @failed, $dir;
591                 print "\n";
592         }
593         elsif ($ret == SKIPPED) {
594                 push @skipped, $dir;
595         }
596         elsif ($ret == ABORT) {
597                 exit 1;
598         }
599         else {
600                 die "unknown exit status $ret";
601         }
602 } #}}}
603
604 sub showstats { #{{{
605         my $action=shift;
606         if (! @ok && ! @failed && ! @skipped) {
607                 die "mr $action: no repositories found to work on\n";
608         }
609         print "mr $action: finished (".join("; ",
610                 showstat($#ok+1, "ok", "ok"),
611                 showstat($#failed+1, "failed", "failed"),
612                 showstat($#skipped+1, "skipped", "skipped"),
613         ).")\n" unless $quiet;
614         if ($stats) {
615                 if (@skipped) {
616                         print "mr $action: (skipped: ".join(" ", @skipped).")\n" unless $quiet;
617                 }
618                 if (@failed) {
619                         print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
620                 }
621         }
622 } #}}}
623
624 sub showstat { #{{{
625         my $count=shift;
626         my $singular=shift;
627         my $plural=shift;
628         if ($count) {
629                 return "$count ".($count > 1 ? $plural : $singular);
630         }
631         return;
632 } #}}}
633
634 # an ordered list of repos
635 sub repolist { #{{{
636         my @list;
637         foreach my $topdir (sort keys %config) {
638                 foreach my $subdir (sort keys %{$config{$topdir}}) {
639                         push @list, {
640                                 topdir => $topdir,
641                                 subdir => $subdir,
642                                 order => $config{$topdir}{$subdir}{order},
643                         };
644                 }
645         }
646         return sort {
647                 $a->{order}  <=> $b->{order}
648                              ||
649                 $a->{topdir} cmp $b->{topdir}
650                              ||
651                 $a->{subdir} cmp $b->{subdir}
652         } @list;
653 } #}}}
654
655 # figure out which repos to act on
656 sub selectrepos { #{{{
657         my @repos;
658         foreach my $repo (repolist()) {
659                 my $topdir=$repo->{topdir};
660                 my $subdir=$repo->{subdir};
661
662                 next if $subdir eq 'DEFAULT';
663                 my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
664                 my $d=$directory;
665                 $dir.="/" unless $dir=~/\/$/;
666                 $d.="/" unless $d=~/\/$/;
667                 next if $dir ne $d && $dir !~ /^\Q$d\E/;
668                 if (defined $max_depth) {
669                         my @a=split('/', $dir);
670                         my @b=split('/', $d);
671                         do { } while (@a && @b && shift(@a) eq shift(@b));
672                         next if @a > $max_depth || @b > $max_depth;
673                 }
674                 push @repos, [$dir, $topdir, $subdir];
675         }
676         if (! @repos) {
677                 # fallback to find a leaf repo
678                 foreach my $repo (reverse repolist()) {
679                         my $topdir=$repo->{topdir};
680                         my $subdir=$repo->{subdir};
681                         
682                         next if $subdir eq 'DEFAULT';
683                         my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
684                         my $d=$directory;
685                         $dir.="/" unless $dir=~/\/$/;
686                         $d.="/" unless $d=~/\/$/;
687                         if ($d=~/^\Q$dir\E/) {
688                                 push @repos, [$dir, $topdir, $subdir];
689                                 last;
690                         }
691                 }
692                 $no_chdir=1;
693         }
694         return @repos;
695 } #}}}
696
697 my %loaded;
698 sub loadconfig { #{{{
699         my $f=shift;
700
701         my @toload;
702
703         my $in;
704         my $dir;
705         if (ref $f eq 'GLOB') {
706                 $dir="";
707                 $in=$f; 
708         }
709         else {
710                 if (! -e $f) {
711                         return;
712                 }
713
714                 my $absf=abs_path($f);
715                 if ($loaded{$absf}) {
716                         return;
717                 }
718                 $loaded{$absf}=1;
719
720                 ($dir)=$f=~/^(.*\/)[^\/]+$/;
721                 if (! defined $dir) {
722                         $dir=".";
723                 }
724                 $dir=abs_path($dir)."/";
725                 
726                 if (! exists $configfiles{$dir}) {
727                         $configfiles{$dir}=$f;
728                 }
729
730                 # copy in defaults from first parent
731                 my $parent=$dir;
732                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
733                         if ($parent eq '/') {
734                                 $parent="";
735                         }
736                         if (exists $config{$parent} &&
737                             exists $config{$parent}{DEFAULT}) {
738                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
739                                 last;
740                         }
741                 }
742                 
743                 print "mr: loading config $f\n" if $verbose;
744                 open($in, "<", $f) || die "mr: open $f: $!\n";
745         }
746         my @lines=<$in>;
747         close $in;
748
749         my $section;
750         my $line=0;
751         while (@lines) {
752                 $_=shift @lines;
753                 $line++;
754                 chomp;
755                 next if /^\s*\#/ || /^\s*$/;
756                 if (/^\[([^\]]*)\]\s*$/) {
757                         $section=$1;
758                 }
759                 elsif (/^(\w+)\s*=\s*(.*)/) {
760                         my $parameter=$1;
761                         my $value=$2;
762
763                         # continued value
764                         while (@lines && $lines[0]=~/^\s(.+)/) {
765                                 shift(@lines);
766                                 $line++;
767                                 $value.="\n$1";
768                                 chomp $value;
769                         }
770
771                         if ($parameter eq "include") {
772                                 print "mr: including output of \"$value\"\n" if $verbose;
773                                 unshift @lines, `$value`;
774                                 next;
775                         }
776
777                         if (! defined $section) {
778                                 die "$f line $.: parameter ($parameter) not in section\n";
779                         }
780                         if ($section ne 'ALIAS' &&
781                             ! exists $config{$dir}{$section} &&
782                             exists $config{$dir}{DEFAULT}) {
783                                 # copy in defaults
784                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
785                         }
786                         if ($section eq 'ALIAS') {
787                                 $alias{$parameter}=$value;
788                         }
789                         elsif ($parameter eq 'lib') {
790                                 $config{$dir}{$section}{lib}.=$value."\n";
791                         }
792                         else {
793                                 $config{$dir}{$section}{$parameter}=$value;
794                                 if ($parameter =~ /.*_(.*)/) {
795                                         $knownactions{$1}=1;
796                                 }
797                                 else {
798                                         $knownactions{$parameter}=1;
799                                 }
800                                 if ($parameter eq 'chain' &&
801                                     length $dir && $section ne "DEFAULT" &&
802                                     -e $dir.$section."/.mrconfig") {
803                                         my $ret=system($value);
804                                         if ($ret != 0) {
805                                                 if (($? & 127) == 2) {
806                                                         print STDERR "mr: chain test interrupted\n";
807                                                         exit 2;
808                                                 }
809                                                 elsif ($? & 127) {
810                                                         print STDERR "mr: chain test received signal ".($? & 127)."\n";
811                                                 }
812                                         }
813                                         else {
814                                                 push @toload, $dir.$section."/.mrconfig";
815                                         }
816                                 }
817                         }
818                 }
819                 else {
820                         die "$f line $line: parse error\n";
821                 }
822         }
823
824         foreach (@toload) {
825                 loadconfig($_);
826         }
827 } #}}}
828
829 sub modifyconfig { #{{{
830         my $f=shift;
831         # the section to modify or add
832         my $targetsection=shift;
833         # fields to change in the section
834         # To remove a field, set its value to "".
835         my %changefields=@_;
836
837         my @lines;
838         my @out;
839
840         if (-e $f) {
841                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
842                 @lines=<$in>;
843                 close $in;
844         }
845
846         my $formatfield=sub {
847                 my $field=shift;
848                 my @value=split(/\n/, shift);
849
850                 return "$field = ".shift(@value)."\n".
851                         join("", map { "\t$_\n" } @value);
852         };
853         my $addfields=sub {
854                 my @blanks;
855                 while ($out[$#out] =~ /^\s*$/) {
856                         unshift @blanks, pop @out;
857                 }
858                 foreach my $field (sort keys %changefields) {
859                         if (length $changefields{$field}) {
860                                 push @out, "$field = $changefields{$field}\n";
861                                 delete $changefields{$field};
862                         }
863                 }
864                 push @out, @blanks;
865         };
866
867         my $section;
868         while (@lines) {
869                 $_=shift(@lines);
870
871                 if (/^\s*\#/ || /^\s*$/) {
872                         push @out, $_;
873                 }
874                 elsif (/^\[([^\]]*)\]\s*$/) {
875                         if (defined $section && 
876                             $section eq $targetsection) {
877                                 $addfields->();
878                         }
879
880                         $section=$1;
881
882                         push @out, $_;
883                 }
884                 elsif (/^(\w+)\s*=\s(.*)/) {
885                         my $parameter=$1;
886                         my $value=$2;
887
888                         # continued value
889                         while (@lines && $lines[0]=~/^\s(.+)/) {
890                                 shift(@lines);
891                                 $value.="\n$1";
892                                 chomp $value;
893                         }
894
895                         if ($section eq $targetsection) {
896                                 if (exists $changefields{$parameter}) {
897                                         if (length $changefields{$parameter}) {
898                                                 $value=$changefields{$parameter};
899                                         }
900                                         delete $changefields{$parameter};
901                                 }
902                         }
903
904                         push @out, $formatfield->($parameter, $value);
905                 }
906         }
907
908         if (defined $section && 
909             $section eq $targetsection) {
910                 $addfields->();
911         }
912         elsif (%changefields) {
913                 push @out, "\n[$targetsection]\n";
914                 foreach my $field (sort keys %changefields) {
915                         if (length $changefields{$field}) {
916                                 push @out, $formatfield->($field, $changefields{$field});
917                         }
918                 }
919         }
920
921         open(my $out, ">", $f) || die "mr: write $f: $!\n";
922         print $out @out;
923         close $out;     
924 } #}}}
925
926 sub dispatch { #{{{
927         my $action=shift;
928
929         # actions that do not operate on all repos
930         if ($action eq 'help') {
931                 help(@ARGV);
932         }
933         elsif ($action eq 'config') {
934                 config(@ARGV);
935         }
936         elsif ($action eq 'register') {
937                 register(@ARGV);
938         }
939
940         if (!$jobs || $jobs > 1) {
941                 mrs($action, selectrepos());
942         }
943         else {
944                 foreach my $repo (selectrepos()) {
945                         record($repo, action($action, @$repo));
946                 }
947         }
948 } #}}}
949
950 sub help { #{{{
951         exec($config{''}{DEFAULT}{help}) || die "exec: $!";
952 } #}}}
953         
954 sub config { #{{{
955         if (@_ < 2) {
956                 die "mr config: not enough parameters\n";
957         }
958         my $section=shift;
959         if ($section=~/^\//) {
960                 # try to convert to a path relative to the config file
961                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
962                 $dir=abs_path($dir);
963                 $dir.="/" unless $dir=~/\/$/;
964                 if ($section=~/^\Q$dir\E(.*)/) {
965                         $section=$1;
966                 }
967         }
968         my %changefields;
969         foreach (@_) {
970                 if (/^([^=]+)=(.*)$/) {
971                         $changefields{$1}=$2;
972                 }
973                 else {
974                         my $found=0;
975                         foreach my $topdir (sort keys %config) {
976                                 if (exists $config{$topdir}{$section} &&
977                                     exists $config{$topdir}{$section}{$_}) {
978                                         print $config{$topdir}{$section}{$_}."\n";
979                                         $found=1;
980                                         last if $section eq 'DEFAULT';
981                                 }
982                         }
983                         if (! $found) {
984                                 die "mr config: $section $_ not set\n";
985                         }
986                 }
987         }
988         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
989         exit 0;
990 } #}}}
991
992 sub register { #{{{
993         if (! $config_overridden) {
994                 # Find the closest known mrconfig file to the current
995                 # directory.
996                 $directory.="/" unless $directory=~/\/$/;
997                 my $foundconfig=0;
998                 foreach my $topdir (reverse sort keys %config) {
999                         next unless length $topdir;
1000                         if ($directory=~/^\Q$topdir\E/) {
1001                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
1002                                 $directory=$topdir;
1003                                 $foundconfig=1;
1004                                 last;
1005                         }
1006                 }
1007                 if (! $foundconfig) {
1008                         $directory=""; # no config file, use builtin
1009                 }
1010         }
1011         if (@ARGV) {
1012                 my $subdir=shift @ARGV;
1013                 if (! chdir($subdir)) {
1014                         print STDERR "mr register: failed to chdir to $subdir: $!\n";
1015                 }
1016         }
1017
1018         $ENV{MR_REPO}=getcwd();
1019         my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT', 0);
1020         if (! defined $command) {
1021                 die "mr register: unknown repository type\n";
1022         }
1023
1024         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
1025         $command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
1026                 "my_action(){ $command\n }; my_action ".
1027                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
1028         print "mr register: running >>$command<<\n" if $verbose;
1029         exec($command) || die "exec: $!";
1030 } #}}}
1031
1032 # alias expansion and command stemming
1033 sub expandaction { #{{{
1034         my $action=shift;
1035         if (exists $alias{$action}) {
1036                 $action=$alias{$action};
1037         }
1038         if (! exists $knownactions{$action}) {
1039                 my @matches = grep { /^\Q$action\E/ }
1040                         keys %knownactions, keys %alias;
1041                 if (@matches == 1) {
1042                         $action=$matches[0];
1043                 }
1044                 elsif (@matches == 0) {
1045                         die "mr: unknown action \"$action\" (known actions: ".
1046                                 join(", ", sort keys %knownactions).")\n";
1047                 }
1048                 else {
1049                         die "mr: ambiguous action \"$action\" (matches: ".
1050                                 join(", ", @matches).")\n";
1051                 }
1052         }
1053         return $action;
1054 } #}}}
1055
1056 sub getopts { #{{{
1057         Getopt::Long::Configure("bundling", "no_permute");
1058         my $result=GetOptions(
1059                 "d|directory=s" => sub { $directory=abs_path($_[1]) },
1060                 "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
1061                 "v|verbose" => \$verbose,
1062                 "q|quiet" => \$quiet,
1063                 "s|stats" => \$stats,
1064                 "n|no-recurse:i" => \$max_depth,
1065                 "j|jobs:i" => \$jobs,
1066         );
1067         if (! $result || @ARGV < 1) {
1068                 die("Usage: mr [-d directory] action [params ...]\n".
1069                     "(Use mr help for man page.)\n");
1070         }
1071 } #}}}
1072
1073 sub init { #{{{
1074         $SIG{INT}=sub {
1075                 print STDERR "mr: interrupted\n";
1076                 exit 2;
1077         };
1078         
1079         # This can happen if it's run in a directory that was removed
1080         # or other strangeness.
1081         if (! defined $directory) {
1082                 die("mr: failed to determine working directory\n");
1083         }
1084         # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
1085         # the config file might be a symlink to elsewhere, and the directory it's
1086         # in is significant.
1087         if ($ENV{MR_CONFIG} !~ /^\//) {
1088                 $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
1089         }
1090         # Try to set MR_PATH to the path to the program.
1091         eval {
1092                 use FindBin qw($Bin $Script);
1093                 $ENV{MR_PATH}=$Bin."/".$Script;
1094         };
1095 } #}}}
1096
1097 sub main { #{{{
1098         getopts();
1099         init();
1100         loadconfig(\*DATA);
1101         loadconfig($ENV{MR_CONFIG});
1102         #use Data::Dumper; print Dumper(\%config);
1103
1104         my $action=expandaction(shift @ARGV);
1105         dispatch($action);
1106         showstats($action);
1107
1108         if (@failed) {
1109                 exit 1;
1110         }
1111         elsif (! @ok && @skipped) {
1112                 exit 1;
1113         }
1114         else {
1115                 exit 0;
1116         }
1117 } #}}}
1118
1119 # Finally, some useful actions that mr knows about by default.
1120 # These can be overridden in ~/.mrconfig.
1121 #DATA{{{
1122 __DATA__
1123 [ALIAS]
1124 co = checkout
1125 ci = commit
1126 ls = list
1127
1128 [DEFAULT]
1129 order = 10
1130 lib =
1131         error() {
1132                 echo "mr: $@" >&2
1133                 exit 1
1134         }
1135         warning() {
1136                 echo "mr (warning): $@" >&2
1137         }
1138         info() {
1139                 echo "mr: $@" >&2
1140         }
1141         hours_since() {
1142                 if [ -z "$1" ] || [ -z "$2" ]; then
1143                         error "mr: usage: hours_since action num"
1144                 fi
1145                 for dir in .git .svn .bzr CVS .hg _darcs; do
1146                         if [ -e "$MR_REPO/$dir" ]; then
1147                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1148                                 break
1149                         fi
1150                 done
1151                 if [ -z "$flagfile" ]; then
1152                         error "cannot determine flag filename"
1153                 fi
1154                 delta=`perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile"`
1155                 if [ "$delta" -lt "$2" ]; then
1156                         exit 0
1157                 else
1158                         touch "$flagfile"
1159                         exit 1
1160                 fi
1161         }
1162
1163 svn_test = test -d "$MR_REPO"/.svn
1164 git_test = test -d "$MR_REPO"/.git
1165 bzr_test = test -d "$MR_REPO"/.bzr
1166 cvs_test = test -d "$MR_REPO"/CVS
1167 hg_test  = test -d "$MR_REPO"/.hg
1168 darcs_test = test -d "$MR_REPO"/_darcs
1169 git_bare_test =
1170         test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
1171         test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
1172         test "`GIT_CONFIG="$MR_REPO"/config git config --get core.bare`" = true
1173
1174 svn_update = svn update "$@"
1175 git_update =
1176         if [ "$@" ]; then
1177                 git pull "$@"
1178         else
1179                 git pull
1180         fi
1181 bzr_update = bzr merge "$@"
1182 cvs_update = cvs update "$@"
1183 hg_update  = hg pull "$@" && hg update "$@"
1184 darcs_update = darcs pull -a "$@"
1185
1186 svn_status = svn status "$@"
1187 git_status = git status "$@" || true
1188 bzr_status = bzr status "$@"
1189 cvs_status = cvs status "$@"
1190 hg_status  = hg status "$@"
1191 darcs_status = darcs whatsnew -ls "$@"
1192
1193 svn_commit = svn commit "$@"
1194 git_commit = git commit -a "$@" && git push --all
1195 bzr_commit = bzr commit "$@" && bzr push
1196 cvs_commit = cvs commit "$@"
1197 hg_commit  = hg commit -m "$@" && hg push
1198 darcs_commit = darcs record -a -m "$@" && darcs push -a
1199
1200 svn_diff = svn diff "$@"
1201 git_diff = git diff "$@"
1202 bzr_diff = bzr diff "$@"
1203 cvs_diff = cvs diff "$@"
1204 hg_diff  = hg diff "$@"
1205 darcs_diff = darcs diff -u "$@"
1206
1207 svn_log = svn log "$@"
1208 git_log = git log "$@"
1209 bzr_log = bzr log "$@"
1210 cvs_log = cvs log "$@"
1211 hg_log  = hg log "$@"
1212 darcs_log = darcs changes "$@"
1213 git_bare_log = git log "$@"
1214
1215 svn_register =
1216         url=`LC_ALL=C svn info . | grep -i '^URL:' | cut -d ' ' -f 2`
1217         if [ -z "$url" ]; then
1218                 error "cannot determine svn url"
1219         fi
1220         echo "Registering svn url: $url in $MR_CONFIG"
1221         mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
1222 git_register = 
1223         url="`LC_ALL=C git config --get remote.origin.url`" || true
1224         if [ -z "$url" ]; then
1225                 error "cannot determine git url"
1226         fi
1227         echo "Registering git url: $url in $MR_CONFIG"
1228         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone '$url' '$MR_REPO'"
1229 bzr_register =
1230         url=`cat .bzr/branch/parent`
1231         if [ -z "$url" ]; then
1232                 error "cannot determine bzr url"
1233         fi
1234         echo "Registering bzr url: $url in $MR_CONFIG"
1235         mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr clone '$url' '$MR_REPO'"
1236 cvs_register =
1237         repo=`cat CVS/Repository`
1238         root=`cat CVS/Root`
1239         if [ -z "$root" ]; then
1240                 error "cannot determine cvs root"
1241                 fi
1242         echo "Registering cvs repository $repo at root $root"
1243         mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
1244 hg_register = 
1245         url=`hg showconfig paths.default`
1246         echo "Registering mercurial repo url: $url in $MR_CONFIG"
1247         mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone '$url' '$MR_REPO'"
1248 darcs_register = 
1249         url=`cat _darcs/prefs/defaultrepo`
1250         echo "Registering darcs repository $url in $MR_CONFIG"
1251         mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get '$url' '$MR_REPO'"
1252 git_bare_register = 
1253         url="`LC_ALL=C GIT_CONFIG=config git config --get remote.origin.url`" || true
1254         if [ -z "$url" ]; then
1255                 error "cannot determine git url"
1256         fi
1257         echo "Registering git url: $url in $MR_CONFIG"
1258         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
1259
1260 help =
1261         if [ ! -e "$MR_PATH" ]; then
1262                 error "cannot find program path"
1263         fi
1264         tmp=$(mktemp -t mr.XXXXXXXXXX) || error "mktemp failed"
1265         trap "rm -f $tmp" exit
1266         pod2man -c mr "$MR_PATH" > "$tmp" || error "pod2man failed"
1267         man -l "$tmp" || error "man failed"
1268 list = true
1269 config = 
1270
1271 ed = echo "A horse is a horse, of course, of course.."
1272 T = echo "I pity the fool."
1273 right = echo "Not found."
1274 #}}}
1275
1276 # vim:sw=8:sts=0:ts=8:noet