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

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