]> git.madduck.net Git - code/myrepos.git/blob - mr

madduck's git repository

Every one of the projects in this repository is available at the canonical URL git://git.madduck.net/madduck/pub/<projectpath> — see each project's metadata for the exact URL.

All patches and comments are welcome. Please squash your changes to logical commits before using git-format-patch and git-send-email to patches@git.madduck.net. If you'd read over the Git project's submission guidelines and adhered to them, I'd be especially grateful.

SSH access, as well as push access can be individually arranged.

If you use my repositories frequently, consider adding the following snippet to ~/.gitconfig and using the third clone URL listed for each project:

[url "git://git.madduck.net/madduck/"]
  insteadOf = madduck:

releasing version 0.41
[code/myrepos.git] / mr
1 #!/usr/bin/perl
2
3 =head1 NAME
4
5 mr - a Multiple Repository management tool
6
7 =head1 SYNOPSIS
8
9 B<mr> [options] checkout
10
11 B<mr> [options] update
12
13 B<mr> [options] status
14
15 B<mr> [options] commit [-m "message"]
16
17 B<mr> [options] record [-m "message"]
18
19 B<mr> [options] diff
20
21 B<mr> [options] log
22
23 B<mr> [options] bootstrap url
24
25 B<mr> [options] register [repository]
26
27 B<mr> [options] config section ["parameter=[value]" ...]
28
29 B<mr> [options] action [params ...]
30
31 B<mr> [options] [online|offline]
32
33 B<mr> [options] remember action [params ...]
34
35 =head1 DESCRIPTION
36
37 B<mr> is a Multiple Repository management tool. It can checkout, update, or
38 perform other actions on a set of repositories as if they were one combined
39 repository. It supports any combination of subversion, git, cvs, mecurial,
40 bzr and darcs repositories, and support for other revision control systems can
41 easily be added.
42
43 B<mr> cds into and operates on all registered repositories at or below your
44 working directory. Or, if you are in a subdirectory of a repository that
45 contains no other registered repositories, it will stay in that directory,
46 and work on only that repository,
47
48 These predefined commands should be fairly familiar to users of any revision
49 control system:
50
51 =over 4
52
53 =item checkout (or co)
54
55 Checks out any repositories that are not already checked out.
56
57 =item update
58
59 Updates each repository from its configured remote repository.
60
61 If a repository isn't checked out yet, it will first check it out.
62
63 =item status
64
65 Displays a status report for each repository, showing what
66 uncommitted changes are present in the repository.
67
68 =item commit (or ci)
69
70 Commits changes to each repository. (By default, changes are pushed to the
71 remote repository too, when using distributed systems like git. If you
72 don't like this default, you can change it in your .mrconfig, or use record
73 instead.)
74
75 The optional -m parameter allows specifying a commit message.
76
77 =item record
78
79 Records changes to the local repository, but does not push them to the
80 remote repository. Only supported for distributed revision control systems.
81
82 The optional -m parameter allows specifying a commit message.
83
84 =item push
85
86 Pushes committed local changes to the remote repository. A no-op for
87 centralized revision control systems.
88
89 =item diff
90
91 Show a diff of uncommitted changes.
92
93 =item log
94
95 Show the commit log.
96
97 =back
98
99 These commands are also available:
100
101 =over 4
102
103 =item bootstrap url
104
105 Causes mr to download the url, save it to a .mrconfig file in the
106 current directory, and then check out all repositories listed in it.
107
108 (Please only do this if you have reason to trust the url, since
109 mrconfig files can contain arbitrary commands!)
110
111 =item list (or ls)
112
113 List the repositories that mr will act on.
114
115 =item register
116
117 Register an existing repository in a mrconfig file. By default, the
118 repository in the current directory is registered, or you can specify a
119 directory to register.
120
121 The mrconfig file that is modified is chosen by either the -c option, or by
122 looking for the closest known one at or below the current directory.
123
124 =item config
125
126 Adds, modifies, removes, or prints a value from a mrconfig file. The next
127 parameter is the name of the section the value is in. To add or modify
128 values, use one or more instances of "parameter=value". Use "parameter=" to
129 remove a parameter. Use just "parameter" to get the value of a parameter.
130
131 For example, to add (or edit) a repository in src/foo:
132
133   mr config src/foo checkout="svn co svn://example.com/foo/trunk foo"
134
135 To show the command that mr uses to update the repository in src/foo:
136
137   mr config src/foo update
138
139 To see the built-in library of shell functions contained in mr:
140
141   mr config DEFAULT lib
142
143 The ~/.mrconfig file is used by default. To use a different config file,
144 use the -c option.
145
146 =item offline
147
148 Advises mr that it is in offline mode. Any commands that fail in
149 offline mode will be remembered, and retried when mr is told it's online.
150
151 =item online
152
153 Advices mr that it is in online mode again. Commands that failed while in
154 offline mode will be re-run.
155
156 =item remember
157
158 Remember a command, to be run later when mr re-enters online mode. This
159 implicitly puts mr into offline mode. The command can be any regular mr
160 command. This is useful when you know that a command will fail due to being
161 offline, and so don't want to run it right now at all, but just remember
162 to run it when you go back online.
163
164 =item help
165
166 Displays this help.
167
168 =back
169
170 Actions can be abbreviated to any unambiguous substring, so
171 "mr st" is equivalent to "mr status", and "mr up" is equivalent to "mr
172 update"
173
174 Additional parameters can be passed to most commands, and are passed on
175 unchanged to the underlying revision control system. This is mostly useful
176 if the repositories mr will act on all use the same revision control
177 system.
178
179 =head1 OPTIONS
180
181 =over 4
182
183 =item -d directory
184
185 Specifies the topmost directory that B<mr> should work in. The default is
186 the current working directory.
187
188 =item -c mrconfig
189
190 Use the specified mrconfig file. The default is B<~/.mrconfig>
191
192 =item -p
193
194 Search in the current directory, and its parent directories and use
195 the first B<.mrconfig> found, instead of the default B<~/.mrconfig>.
196
197 =item -v
198
199 Be verbose.
200
201 =item -q
202
203 Be quiet.
204
205 =item -s
206
207 Expand the statistics line displayed at the end to include information
208 about exactly which repositories failed and were skipped, if any.
209
210 =item -i
211
212 Interactive mode. If a repository fails to be processed, a subshell will be
213 started which you can use to resolve or investigate the problem. Exit the
214 subshell to continue the mr run.
215
216 =item -n [number]
217
218 If no number if specified, just operate on the repository for the current
219 directory, do not recurse into deeper repositories.
220
221 If a number is specified, will recurse into repositories at most that many
222 subdirectories deep. For example, with -n 2 it would recurse into ./src/foo,
223 but not ./src/packages/bar.
224
225 =item -j [number]
226
227 Run the specified number of jobs in parallel, or an unlimited number of jobs
228 with no number specified. This can greatly speed up operations such as updates.
229 It is not recommended for interactive operations.
230
231 Note that running more than 10 jobs at a time is likely to run afoul of
232 ssh connection limits. Running between 3 and 5 jobs at a time will yield
233 a good speedup in updates without loading the machine too much.
234
235 =back
236
237 =head1 FILES
238
239 B<mr> is configured by .mrconfig files. It starts by reading the .mrconfig
240 file in your home directory, and this can in turn chain load .mrconfig files
241 from repositories.
242
243 Here is an example .mrconfig file:
244
245   [src]
246   checkout = svn co svn://svn.example.com/src/trunk src
247   chain = true
248
249   [src/linux-2.6]
250   checkout = git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux-2.6.git &&
251         cd linux-2.6 &&
252         git checkout -b mybranch origin/master
253
254 The .mrconfig file uses a variant of the INI file format. Lines starting with
255 "#" are comments. Values can be continued to the following line by
256 indenting the line with whitespace.
257
258 The "DEFAULT" section allows setting default values for the sections that
259 come after it.
260
261 The "ALIAS" section allows adding aliases for actions. Each parameter
262 is an alias, and its value is the action to use.
263
264 All other sections add repositories. The section header specifies the
265 directory where the repository is located. This is relative to the directory
266 that contains the mrconfig file, but you can also choose to use absolute
267 paths. (Note that you can use environment variables in section names; they
268 will be passed through the shell for expansion. For example, 
269 "[$HOSTNAME]", or "[${HOSTNAME}foo]")
270
271 Within a section, each parameter defines a shell command to run to handle a
272 given action. mr contains default handlers for "update", "status",
273 "commit", and other standard actions. Normally you only need to specify what
274 to do for "checkout".
275
276 Note that these shell commands are run in a "set -e" shell
277 environment, where any additional parameters you pass are available in
278 "$@". The "checkout" command is run in the parent of the repository
279 directory, since the repository isn't checked out yet. All other commands
280 are run inside the repository, though not necessarily at the top of it.
281
282 The "MR_REPO" environment variable is set to the path to the top of the
283 repository. (For the "register" action, "MR_REPO" is instead set to the 
284 basename of the directory that should be created when checking the
285 repository out.)
286
287 The "MR_CONFIG" environment variable is set to the .mrconfig file
288 that defines the repo being acted on, or, if the repo is not yet in a config
289 file, the .mrconfig file that should be modified to register the repo.
290
291 A few parameters have special meanings:
292
293 =over 4
294
295 =item skip
296
297 If the "skip" parameter is set and its command returns true, then B<mr>
298 will skip acting on that repository. The command is passed the action
299 name in $1.
300
301 Here are two examples. The first skips the repo unless
302 mr is run by joey. The second uses the hours_since function
303 (included in mr's built-in library) to skip updating the repo unless it's
304 been at least 12 hours since the last update.
305
306   skip = test `whoami` != joey
307   skip = [ "$1" = update ] && ! hours_since "$1" 12
308
309 =item order
310
311 The "order" parameter can be used to override the default ordering of
312 repositories. The default order value is 10. Use smaller values to make
313 repositories be processed earlier, and larger values to make repositories
314 be processed later.
315
316 Note that if a repository is located in a subdirectory of another
317 repository, ordering it to be processed earlier is not recommended.
318
319 =item chain
320
321 If the "chain" parameter is set and its command returns true, then B<mr>
322 will try to load a .mrconfig file from the root of the repository. (You
323 should avoid chaining from repositories with untrusted committers.)
324
325 =item include
326
327 If the "include" parameter is set, its command is ran, and should output
328 additional mrconfig file content. The content is included as if it were
329 part of the including file.
330
331 Unlike all other parameters, this parameter does not need to be placed
332 within a section.
333
334 =item lib
335
336 The "lib" parameter can specify some shell code that will be run before each
337 command, this can be a useful way to define shell functions for other commands
338 to use.
339
340 =back
341
342 When looking for a command to run for a given action, mr first looks for
343 a parameter with the same name as the action. If that is not found, it
344 looks for a parameter named "rcs_action" (substituting in the name of the
345 revision control system and the action). The name of the revision control
346 system is itself determined by running each defined "rcs_test" action,
347 until one succeeds.
348
349 Internally, mr has settings for "git_update", "svn_update", etc. To change
350 the action that is performed for a given revision control system, you can
351 override these rcs specific actions. To add a new revision control system,
352 you can just add rcs specific actions for it.
353
354 The ~/.mrlog file contains commands that mr has remembered to run later,
355 due to being offline. You can delete or edit this file to remove commands,
356 or even to add other commands for 'mr online' to run. If the file is
357 present, mr assumes it is in offline mode.
358
359 =head1 EXTENSIONS
360
361 mr can be extended to support things such as unison and git-svn. Some
362 files providing such extensions are available in /usr/share/mr/. See
363 the documentation in the files for details about using them.
364
365 =head1 AUTHOR
366
367 Copyright 2007-2009 Joey Hess <joey@kitenet.net>
368
369 Licensed under the GNU GPL version 2 or higher.
370
371 http://kitenet.net/~joey/code/mr/
372
373 =cut
374
375 use warnings;
376 use strict;
377 use Getopt::Long;
378 use Cwd qw(getcwd abs_path);
379
380 # things that can happen when mr runs a command
381 use constant {
382         OK => 0,
383         FAILED => 1,
384         SKIPPED => 2,
385         ABORT => 3,
386 };
387
388 # configurables
389 my $config_overridden=0;
390 my $verbose=0;
391 my $quiet=0;
392 my $stats=0;
393 my $interactive=0;
394 my $max_depth;
395 my $no_chdir=0;
396 my $jobs=1;
397 my $directory=getcwd();
398 $ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
399
400 # globals :-(
401 my %config;
402 my %configfiles;
403 my %knownactions;
404 my %alias;
405 my (@ok, @failed, @skipped);
406
407 main();
408
409 my %rcs;
410 sub rcs_test {
411         my ($action, $dir, $topdir, $subdir) = @_;
412
413         if (exists $rcs{$dir}) {
414                 return $rcs{$dir};
415         }
416
417         my $test="set -e\n";
418         foreach my $rcs_test (
419                         sort {
420                                 length $a <=> length $b 
421                                           ||
422                                        $a cmp $b
423                         } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
424                 my ($rcs)=$rcs_test=~/(.*)_test/;
425                 $test="my_$rcs_test() {\n$config{$topdir}{$subdir}{$rcs_test}\n}\n".$test;
426                 $test.="if my_$rcs_test; then echo $rcs; fi\n";
427         }
428         $test=$config{$topdir}{$subdir}{lib}."\n".$test
429                 if exists $config{$topdir}{$subdir}{lib};
430         
431         print "mr $action: running rcs test >>$test<<\n" if $verbose;
432         my $rcs=`$test`;
433         chomp $rcs;
434         if ($rcs=~/\n/s) {
435                 $rcs=~s/\n/, /g;
436                 print STDERR "mr $action: found multiple possible repository types ($rcs) for $topdir$subdir\n";
437                 return undef;
438         }
439         if (! length $rcs) {
440                 return $rcs{$dir}=undef;
441         }
442         else {
443                 return $rcs{$dir}=$rcs;
444         }
445 }
446         
447 sub findcommand {
448         my ($action, $dir, $topdir, $subdir, $is_checkout) = @_;
449         
450         if (exists $config{$topdir}{$subdir}{$action}) {
451                 return $config{$topdir}{$subdir}{$action};
452         }
453
454         if ($is_checkout) {
455                 return undef;
456         }
457
458         my $rcs=rcs_test(@_);
459
460         if (defined $rcs && 
461             exists $config{$topdir}{$subdir}{$rcs."_".$action}) {
462                 return $config{$topdir}{$subdir}{$rcs."_".$action};
463         }
464         else {
465                 return undef;
466         }
467 }
468
469 sub action {
470         my ($action, $dir, $topdir, $subdir) = @_;
471         
472         $ENV{MR_CONFIG}=$configfiles{$topdir};
473         my $lib=exists $config{$topdir}{$subdir}{lib} ?
474                        $config{$topdir}{$subdir}{lib}."\n" : "";
475         my $is_checkout=($action eq 'checkout');
476
477         $ENV{MR_REPO}=$dir;
478
479         if ($is_checkout) {
480                 if (-d $dir) {
481                         print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
482                         return SKIPPED;
483                 }
484
485                 $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
486         }
487         elsif ($action =~ /update/) {
488                 if (! -d $dir) {
489                         return action("checkout", $dir, $topdir, $subdir);
490                 }
491         }
492
493         my $skiptest=findcommand("skip", $dir, $topdir, $subdir, $is_checkout);
494         my $command=findcommand($action, $dir, $topdir, $subdir, $is_checkout);
495
496         if (defined $skiptest) {
497                 my $test="set -e;".$lib.
498                         "my_action(){ $skiptest\n }; my_action '$action'";
499                 print "mr $action: running skip test >>$test<<\n" if $verbose;
500                 my $ret=system($test);
501                 if ($ret != 0) {
502                         if (($? & 127) == 2) {
503                                 print STDERR "mr $action: interrupted\n";
504                                 return ABORT;
505                         }
506                         elsif ($? & 127) {
507                                 print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
508                                 return ABORT;
509                         }
510                 }
511                 if ($ret >> 8 == 0) {
512                         print "mr $action: $dir skipped per config file\n" if $verbose;
513                         return SKIPPED;
514                 }
515         }
516
517         if ($is_checkout && ! -d $dir) {
518                 print "mr $action: creating parent directory $dir\n" if $verbose;
519                 system("mkdir", "-p", $dir);
520         }
521
522         if (! $no_chdir && ! chdir($dir)) {
523                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
524                 return FAILED;
525         }
526         elsif (! defined $command) {
527                 my $rcs=rcs_test(@_);
528                 if (! defined $rcs) {
529                         print STDERR "mr $action: unknown repository type and no defined $action command for $topdir$subdir\n";
530                         return FAILED;
531                 }
532                 else {
533                         print STDERR "mr $action: no defined action for $rcs repository $topdir$subdir, skipping\n";
534                         return SKIPPED;
535                 }
536         }
537         else {
538                 if (! $no_chdir) {
539                         print "mr $action: $topdir$subdir\n" unless $quiet;
540                 }
541                 else {
542                         my $s=$directory;
543                         $s=~s/^\Q$topdir$subdir\E\/?//;
544                         print "mr $action: $topdir$subdir (in subdir $s)\n" unless $quiet;
545                 }
546                 $command="set -e; ".$lib.
547                         "my_action(){ $command\n }; my_action ".
548                         join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
549                 print "mr $action: running >>$command<<\n" if $verbose;
550                 my $ret=system($command);
551                 if ($ret != 0) {
552                         if (($? & 127) == 2) {
553                                 print STDERR "mr $action: interrupted\n";
554                                 return ABORT;
555                         }
556                         elsif ($? & 127) {
557                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
558                                 return ABORT;
559                         }
560                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
561                         if ($ret >> 8 != 0) {
562                                 print STDERR "mr $action: command failed\n";
563                                 if (-e "$ENV{HOME}/.mrlog" && $action ne 'remember') {
564                                         # recreate original command line to
565                                         # remember, and avoid recursing
566                                         my @orig=@ARGV;
567                                         @ARGV=('-n', $action, @orig);
568                                         action("remember", $dir, $topdir, $subdir);
569                                         @ARGV=@orig;
570                                 }
571                         }
572                         elsif ($ret != 0) {
573                                 print STDERR "mr $action: command died ($ret)\n";
574                         }
575                         return FAILED;
576                 }
577                 else {
578                         if ($action eq 'checkout' && ! -d $dir) {
579                                 print STDERR "mr $action: $dir missing after checkout\n";;
580                                 return FAILED;
581                         }
582
583                         return OK;
584                 }
585         }
586 }
587
588 # run actions on multiple repos, in parallel
589 sub mrs {
590         my $action=shift;
591         my @repos=@_;
592
593         $| = 1;
594         my @active;
595         my @fhs;
596         my @out;
597         my $running=0;
598         while (@fhs or @repos) {
599                 while ((!$jobs || $running < $jobs) && @repos) {
600                         $running++;
601                         my $repo = shift @repos;
602                         pipe(my $outfh, CHILD_STDOUT);
603                         pipe(my $errfh, CHILD_STDERR);
604                         my $pid;
605                         unless ($pid = fork) {
606                                 die "mr $action: cannot fork: $!" unless defined $pid;
607                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
608                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
609                                 close CHILD_STDOUT;
610                                 close CHILD_STDERR;
611                                 close $outfh;
612                                 close $errfh;
613                                 exit action($action, @$repo);
614                         }
615                         close CHILD_STDOUT;
616                         close CHILD_STDERR;
617                         push @active, [$pid, $repo];
618                         push @fhs, [$outfh, $errfh];
619                         push @out, ['',     ''];
620                 }
621                 my ($rin, $rout) = ('','');
622                 my $nfound;
623                 foreach my $fh (@fhs) {
624                         next unless defined $fh;
625                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
626                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
627                 }
628                 $nfound = select($rout=$rin, undef, undef, 1);
629                 foreach my $channel (0, 1) {
630                         foreach my $i (0..$#fhs) {
631                                 next unless defined $fhs[$i];
632                                 my $fh = $fhs[$i][$channel];
633                                 next unless defined $fh;
634                                 if (vec($rout, fileno($fh), 1) == 1) {
635                                         my $r = '';
636                                         if (sysread($fh, $r, 1024) == 0) {
637                                                 close($fh);
638                                                 $fhs[$i][$channel] = undef;
639                                                 if (! defined $fhs[$i][0] &&
640                                                     ! defined $fhs[$i][1]) {
641                                                         waitpid($active[$i][0], 0);
642                                                         print STDOUT $out[$i][0];
643                                                         print STDERR $out[$i][1];
644                                                         record($active[$i][1], $? >> 8);
645                                                         splice(@fhs, $i, 1);
646                                                         splice(@active, $i, 1);
647                                                         splice(@out, $i, 1);
648                                                         $running--;
649                                                 }
650                                         }
651                                         $out[$i][$channel] .= $r;
652                                 }
653                         }
654                 }
655         }
656 }
657
658 sub record {
659         my $dir=shift()->[0];
660         my $ret=shift;
661
662         if ($ret == OK) {
663                 push @ok, $dir;
664                 print "\n";
665         }
666         elsif ($ret == FAILED) {
667                 if ($interactive) {
668                         chdir($dir) unless $no_chdir;
669                         print STDERR "mr: Starting interactive shell. Exit shell to continue.\n";
670                         system((getpwuid($<))[8]);
671                 }
672                 push @failed, $dir;
673                 print "\n";
674         }
675         elsif ($ret == SKIPPED) {
676                 push @skipped, $dir;
677         }
678         elsif ($ret == ABORT) {
679                 exit 1;
680         }
681         else {
682                 die "unknown exit status $ret";
683         }
684 }
685
686 sub showstats {
687         my $action=shift;
688         if (! @ok && ! @failed && ! @skipped) {
689                 die "mr $action: no repositories found to work on\n";
690         }
691         print "mr $action: finished (".join("; ",
692                 showstat($#ok+1, "ok", "ok"),
693                 showstat($#failed+1, "failed", "failed"),
694                 showstat($#skipped+1, "skipped", "skipped"),
695         ).")\n" unless $quiet;
696         if ($stats) {
697                 if (@skipped) {
698                         print "mr $action: (skipped: ".join(" ", @skipped).")\n" unless $quiet;
699                 }
700                 if (@failed) {
701                         print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
702                 }
703         }
704 }
705
706 sub showstat {
707         my $count=shift;
708         my $singular=shift;
709         my $plural=shift;
710         if ($count) {
711                 return "$count ".($count > 1 ? $plural : $singular);
712         }
713         return;
714 }
715
716 # an ordered list of repos
717 sub repolist {
718         my @list;
719         foreach my $topdir (sort keys %config) {
720                 foreach my $subdir (sort keys %{$config{$topdir}}) {
721                         push @list, {
722                                 topdir => $topdir,
723                                 subdir => $subdir,
724                                 order => $config{$topdir}{$subdir}{order},
725                         };
726                 }
727         }
728         return sort {
729                 $a->{order}  <=> $b->{order}
730                              ||
731                 $a->{topdir} cmp $b->{topdir}
732                              ||
733                 $a->{subdir} cmp $b->{subdir}
734         } @list;
735 }
736
737 # figure out which repos to act on
738 sub selectrepos {
739         my @repos;
740         foreach my $repo (repolist()) {
741                 my $topdir=$repo->{topdir};
742                 my $subdir=$repo->{subdir};
743
744                 next if $subdir eq 'DEFAULT';
745                 my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
746                 my $d=$directory;
747                 $dir.="/" unless $dir=~/\/$/;
748                 $d.="/" unless $d=~/\/$/;
749                 next if $dir ne $d && $dir !~ /^\Q$d\E/;
750                 if (defined $max_depth) {
751                         my @a=split('/', $dir);
752                         my @b=split('/', $d);
753                         do { } while (@a && @b && shift(@a) eq shift(@b));
754                         next if @a > $max_depth || @b > $max_depth;
755                 }
756                 push @repos, [$dir, $topdir, $subdir];
757         }
758         if (! @repos) {
759                 # fallback to find a leaf repo
760                 foreach my $repo (reverse repolist()) {
761                         my $topdir=$repo->{topdir};
762                         my $subdir=$repo->{subdir};
763                         
764                         next if $subdir eq 'DEFAULT';
765                         my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
766                         my $d=$directory;
767                         $dir.="/" unless $dir=~/\/$/;
768                         $d.="/" unless $d=~/\/$/;
769                         if ($d=~/^\Q$dir\E/) {
770                                 push @repos, [$dir, $topdir, $subdir];
771                                 last;
772                         }
773                 }
774                 $no_chdir=1;
775         }
776         return @repos;
777 }
778
779 sub expandenv {
780         my $val=shift;
781         
782
783         if ($val=~/\$/) {
784                 $val=`echo "$val"`;
785                 chomp $val;
786         }
787         
788         return $val;
789 }
790
791 my %loaded;
792 sub loadconfig {
793         my $f=shift;
794
795         my @toload;
796
797         my $in;
798         my $dir;
799         if (ref $f eq 'GLOB') {
800                 $dir="";
801                 $in=$f; 
802         }
803         else {
804                 if (! -e $f) {
805                         return;
806                 }
807
808                 my $absf=abs_path($f);
809                 if ($loaded{$absf}) {
810                         return;
811                 }
812                 $loaded{$absf}=1;
813
814                 ($dir)=$f=~/^(.*\/)[^\/]+$/;
815                 if (! defined $dir) {
816                         $dir=".";
817                 }
818                 $dir=abs_path($dir)."/";
819                 
820                 if (! exists $configfiles{$dir}) {
821                         $configfiles{$dir}=$f;
822                 }
823
824                 # copy in defaults from first parent
825                 my $parent=$dir;
826                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
827                         if ($parent eq '/') {
828                                 $parent="";
829                         }
830                         if (exists $config{$parent} &&
831                             exists $config{$parent}{DEFAULT}) {
832                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
833                                 last;
834                         }
835                 }
836                 
837                 print "mr: loading config $f\n" if $verbose;
838                 open($in, "<", $f) || die "mr: open $f: $!\n";
839         }
840         my @lines=<$in>;
841         close $in;
842
843         my $section;
844         my $line=0;
845         while (@lines) {
846                 $_=shift @lines;
847                 $line++;
848                 chomp;
849                 next if /^\s*\#/ || /^\s*$/;
850                 if (/^\[([^\]]*)\]\s*$/) {
851                         $section=expandenv($1);
852                 }
853                 elsif (/^(\w+)\s*=\s*(.*)/) {
854                         my $parameter=$1;
855                         my $value=$2;
856
857                         # continued value
858                         while (@lines && $lines[0]=~/^\s(.+)/) {
859                                 shift(@lines);
860                                 $line++;
861                                 $value.="\n$1";
862                                 chomp $value;
863                         }
864
865                         if ($parameter eq "include") {
866                                 print "mr: including output of \"$value\"\n" if $verbose;
867                                 unshift @lines, `$value`;
868                                 if ($?) {
869                                         print STDERR "mr: include command exited nonzero ($?)\n";
870                                 }
871                                 next;
872                         }
873
874                         if (! defined $section) {
875                                 die "$f line $.: parameter ($parameter) not in section\n";
876                         }
877                         if ($section ne 'ALIAS' &&
878                             ! exists $config{$dir}{$section} &&
879                             exists $config{$dir}{DEFAULT}) {
880                                 # copy in defaults
881                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
882                         }
883                         if ($section eq 'ALIAS') {
884                                 $alias{$parameter}=$value;
885                         }
886                         elsif ($parameter eq 'lib') {
887                                 $config{$dir}{$section}{lib}.=$value."\n";
888                         }
889                         else {
890                                 $config{$dir}{$section}{$parameter}=$value;
891                                 if ($parameter =~ /.*_(.*)/) {
892                                         $knownactions{$1}=1;
893                                 }
894                                 else {
895                                         $knownactions{$parameter}=1;
896                                 }
897                                 if ($parameter eq 'chain' &&
898                                     length $dir && $section ne "DEFAULT" &&
899                                     -e $dir.$section."/.mrconfig") {
900                                         my $ret=system($value);
901                                         if ($ret != 0) {
902                                                 if (($? & 127) == 2) {
903                                                         print STDERR "mr: chain test interrupted\n";
904                                                         exit 2;
905                                                 }
906                                                 elsif ($? & 127) {
907                                                         print STDERR "mr: chain test received signal ".($? & 127)."\n";
908                                                 }
909                                         }
910                                         else {
911                                                 push @toload, $dir.$section."/.mrconfig";
912                                         }
913                                 }
914                         }
915                 }
916                 else {
917                         die "$f line $line: parse error\n";
918                 }
919         }
920
921         foreach (@toload) {
922                 loadconfig($_);
923         }
924 }
925
926 sub modifyconfig {
927         my $f=shift;
928         # the section to modify or add
929         my $targetsection=shift;
930         # fields to change in the section
931         # To remove a field, set its value to "".
932         my %changefields=@_;
933
934         my @lines;
935         my @out;
936
937         if (-e $f) {
938                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
939                 @lines=<$in>;
940                 close $in;
941         }
942
943         my $formatfield=sub {
944                 my $field=shift;
945                 my @value=split(/\n/, shift);
946
947                 return "$field = ".shift(@value)."\n".
948                         join("", map { "\t$_\n" } @value);
949         };
950         my $addfields=sub {
951                 my @blanks;
952                 while ($out[$#out] =~ /^\s*$/) {
953                         unshift @blanks, pop @out;
954                 }
955                 foreach my $field (sort keys %changefields) {
956                         if (length $changefields{$field}) {
957                                 push @out, "$field = $changefields{$field}\n";
958                                 delete $changefields{$field};
959                         }
960                 }
961                 push @out, @blanks;
962         };
963
964         my $section;
965         while (@lines) {
966                 $_=shift(@lines);
967
968                 if (/^\s*\#/ || /^\s*$/) {
969                         push @out, $_;
970                 }
971                 elsif (/^\[([^\]]*)\]\s*$/) {
972                         if (defined $section && 
973                             $section eq $targetsection) {
974                                 $addfields->();
975                         }
976
977                         $section=expandenv($1);
978
979                         push @out, $_;
980                 }
981                 elsif (/^(\w+)\s*=\s(.*)/) {
982                         my $parameter=$1;
983                         my $value=$2;
984
985                         # continued value
986                         while (@lines && $lines[0]=~/^\s(.+)/) {
987                                 shift(@lines);
988                                 $value.="\n$1";
989                                 chomp $value;
990                         }
991
992                         if ($section eq $targetsection) {
993                                 if (exists $changefields{$parameter}) {
994                                         if (length $changefields{$parameter}) {
995                                                 $value=$changefields{$parameter};
996                                         }
997                                         delete $changefields{$parameter};
998                                 }
999                         }
1000
1001                         push @out, $formatfield->($parameter, $value);
1002                 }
1003         }
1004
1005         if (defined $section && 
1006             $section eq $targetsection) {
1007                 $addfields->();
1008         }
1009         elsif (%changefields) {
1010                 push @out, "\n[$targetsection]\n";
1011                 foreach my $field (sort keys %changefields) {
1012                         if (length $changefields{$field}) {
1013                                 push @out, $formatfield->($field, $changefields{$field});
1014                         }
1015                 }
1016         }
1017
1018         open(my $out, ">", $f) || die "mr: write $f: $!\n";
1019         print $out @out;
1020         close $out;     
1021 }
1022
1023 sub dispatch {
1024         my $action=shift;
1025
1026         # actions that do not operate on all repos
1027         if ($action eq 'help') {
1028                 help(@ARGV);
1029         }
1030         elsif ($action eq 'config') {
1031                 config(@ARGV);
1032         }
1033         elsif ($action eq 'register') {
1034                 register(@ARGV);
1035         }
1036         elsif ($action eq 'bootstrap') {
1037                 bootstrap();
1038         }
1039         elsif ($action eq 'remember' ||
1040                $action eq 'offline' ||
1041                $action eq 'online') {
1042                 my @repos=selectrepos;
1043                 action($action, @{$repos[0]}) if @repos;
1044                 exit 0;
1045         }
1046
1047         if (!$jobs || $jobs > 1) {
1048                 mrs($action, selectrepos());
1049         }
1050         else {
1051                 foreach my $repo (selectrepos()) {
1052                         record($repo, action($action, @$repo));
1053                 }
1054         }
1055 }
1056
1057 sub help {
1058         exec($config{''}{DEFAULT}{help}) || die "exec: $!";
1059 }
1060
1061 sub config {
1062         if (@_ < 2) {
1063                 die "mr config: not enough parameters\n";
1064         }
1065         my $section=shift;
1066         if ($section=~/^\//) {
1067                 # try to convert to a path relative to the config file
1068                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
1069                 $dir=abs_path($dir);
1070                 $dir.="/" unless $dir=~/\/$/;
1071                 if ($section=~/^\Q$dir\E(.*)/) {
1072                         $section=$1;
1073                 }
1074         }
1075         my %changefields;
1076         foreach (@_) {
1077                 if (/^([^=]+)=(.*)$/) {
1078                         $changefields{$1}=$2;
1079                 }
1080                 else {
1081                         my $found=0;
1082                         foreach my $topdir (sort keys %config) {
1083                                 if (exists $config{$topdir}{$section} &&
1084                                     exists $config{$topdir}{$section}{$_}) {
1085                                         print $config{$topdir}{$section}{$_}."\n";
1086                                         $found=1;
1087                                         last if $section eq 'DEFAULT';
1088                                 }
1089                         }
1090                         if (! $found) {
1091                                 die "mr config: $section $_ not set\n";
1092                         }
1093                 }
1094         }
1095         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
1096         exit 0;
1097 }
1098
1099 sub register {
1100         if ($config_overridden) {
1101                 # Find the directory that the specified config file is
1102                 # located in.
1103                 ($directory)=abs_path($ENV{MR_CONFIG})=~/^(.*\/)[^\/]+$/;
1104         }
1105         else {
1106                 # Find the closest known mrconfig file to the current
1107                 # directory.
1108                 $directory.="/" unless $directory=~/\/$/;
1109                 my $foundconfig=0;
1110                 foreach my $topdir (reverse sort keys %config) {
1111                         next unless length $topdir;
1112                         if ($directory=~/^\Q$topdir\E/) {
1113                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
1114                                 $directory=$topdir;
1115                                 $foundconfig=1;
1116                                 last;
1117                         }
1118                 }
1119                 if (! $foundconfig) {
1120                         $directory=""; # no config file, use builtin
1121                 }
1122         }
1123         if (@ARGV) {
1124                 my $subdir=shift @ARGV;
1125                 if (! chdir($subdir)) {
1126                         print STDERR "mr register: failed to chdir to $subdir: $!\n";
1127                 }
1128         }
1129
1130         $ENV{MR_REPO}=getcwd();
1131         my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT', 0);
1132         if (! defined $command) {
1133                 die "mr register: unknown repository type\n";
1134         }
1135
1136         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
1137         $command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
1138                 "my_action(){ $command\n }; my_action ".
1139                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
1140         print "mr register: running >>$command<<\n" if $verbose;
1141         exec($command) || die "exec: $!";
1142 }
1143
1144 sub bootstrap {
1145         my $url=shift @ARGV;
1146
1147         if (! defined $url || ! length $url) {
1148                 die "mr: bootstrap requires url\n";
1149         }
1150
1151         if (-e ".mrconfig") {
1152                 die "mr: .mrconfig file already exists, not overwriting with $url\n";
1153         }
1154
1155         if (system("curl", "-s", $url, "-o", ".mrconfig") != 0) {
1156                 die "mr: download of $url failed\n";
1157         }
1158
1159         exec("mr $ENV{MR_SWITCHES} -c .mrconfig checkout");
1160         die "failed to run mr checkout";
1161 }
1162
1163 # alias expansion and command stemming
1164 sub expandaction {
1165         my $action=shift;
1166         if (exists $alias{$action}) {
1167                 $action=$alias{$action};
1168         }
1169         if (! exists $knownactions{$action}) {
1170                 my @matches = grep { /^\Q$action\E/ }
1171                         keys %knownactions, keys %alias;
1172                 if (@matches == 1) {
1173                         $action=$matches[0];
1174                 }
1175                 elsif (@matches == 0) {
1176                         die "mr: unknown action \"$action\" (known actions: ".
1177                                 join(", ", sort keys %knownactions).")\n";
1178                 }
1179                 else {
1180                         die "mr: ambiguous action \"$action\" (matches: ".
1181                                 join(", ", @matches).")\n";
1182                 }
1183         }
1184         return $action;
1185 }
1186
1187 sub find_nearest_mrconfig {
1188         my $dir=getcwd();
1189         while (length $dir) {
1190                 if (-e "$dir/.mrconfig") {
1191                         return "$dir/.mrconfig";
1192                 }
1193                 $dir=~s/\/[^\/]*$//;
1194         }
1195         die "no .mrconfig found in path\n";
1196 }
1197
1198 sub getopts {
1199         my @saved=@ARGV;
1200         Getopt::Long::Configure("bundling", "no_permute");
1201         my $result=GetOptions(
1202                 "d|directory=s" => sub { $directory=abs_path($_[1]) },
1203                 "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
1204                 "p|path" => sub { $ENV{MR_CONFIG}=find_nearest_mrconfig(); $config_overridden=1 },
1205                 "v|verbose" => \$verbose,
1206                 "q|quiet" => \$quiet,
1207                 "s|stats" => \$stats,
1208                 "i|interactive" => \$interactive,
1209                 "n|no-recurse:i" => \$max_depth,
1210                 "j|jobs:i" => \$jobs,
1211         );
1212         if (! $result || @ARGV < 1) {
1213                 die("Usage: mr [-d directory] action [params ...]\n".
1214                     "(Use mr help for man page.)\n");
1215         }
1216         
1217         $ENV{MR_SWITCHES}="";
1218         foreach my $option (@saved) {
1219                 last if $option eq $ARGV[0];
1220                 $ENV{MR_SWITCHES}.="$option ";
1221         }
1222 }
1223
1224 sub init {
1225         $SIG{INT}=sub {
1226                 print STDERR "mr: interrupted\n";
1227                 exit 2;
1228         };
1229         
1230         # This can happen if it's run in a directory that was removed
1231         # or other strangeness.
1232         if (! defined $directory) {
1233                 die("mr: failed to determine working directory\n");
1234         }
1235         # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
1236         # the config file might be a symlink to elsewhere, and the directory it's
1237         # in is significant.
1238         if ($ENV{MR_CONFIG} !~ /^\//) {
1239                 $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
1240         }
1241         # Try to set MR_PATH to the path to the program.
1242         eval {
1243                 use FindBin qw($Bin $Script);
1244                 $ENV{MR_PATH}=$Bin."/".$Script;
1245         };
1246 }
1247
1248 sub main {
1249         getopts();
1250         init();
1251
1252         loadconfig(\*DATA);
1253         loadconfig($ENV{MR_CONFIG});
1254         #use Data::Dumper; print Dumper(\%config);
1255         
1256         my $action=expandaction(shift @ARGV);
1257         dispatch($action);
1258         showstats($action);
1259
1260         if (@failed) {
1261                 exit 1;
1262         }
1263         elsif (! @ok && @skipped) {
1264                 exit 1;
1265         }
1266         else {
1267                 exit 0;
1268         }
1269 }
1270
1271 # Finally, some useful actions that mr knows about by default.
1272 # These can be overridden in ~/.mrconfig.
1273 __DATA__
1274 [ALIAS]
1275 co = checkout
1276 ci = commit
1277 ls = list
1278
1279 [DEFAULT]
1280 order = 10
1281 lib =
1282         error() {
1283                 echo "mr: $@" >&2
1284                 exit 1
1285         }
1286         warning() {
1287                 echo "mr (warning): $@" >&2
1288         }
1289         info() {
1290                 echo "mr: $@" >&2
1291         }
1292         hours_since() {
1293                 if [ -z "$1" ] || [ -z "$2" ]; then
1294                         error "mr: usage: hours_since action num"
1295                 fi
1296                 for dir in .git .svn .bzr CVS .hg _darcs; do
1297                         if [ -e "$MR_REPO/$dir" ]; then
1298                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1299                                 break
1300                         fi
1301                 done
1302                 if [ -z "$flagfile" ]; then
1303                         error "cannot determine flag filename"
1304                 fi
1305                 delta=`perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile"`
1306                 if [ "$delta" -lt "$2" ]; then
1307                         exit 0
1308                 else
1309                         touch "$flagfile"
1310                         exit 1
1311                 fi
1312         }
1313
1314 svn_test = test -d "$MR_REPO"/.svn
1315 git_test = test -d "$MR_REPO"/.git
1316 bzr_test = test -d "$MR_REPO"/.bzr
1317 cvs_test = test -d "$MR_REPO"/CVS
1318 hg_test  = test -d "$MR_REPO"/.hg
1319 darcs_test = test -d "$MR_REPO"/_darcs
1320 git_bare_test =
1321         test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
1322         test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
1323         test "`GIT_CONFIG="$MR_REPO"/config git config --get core.bare`" = true
1324
1325 svn_update = svn update "$@"
1326 git_update = git pull "$@"
1327 bzr_update = bzr merge --pull "$@"
1328 cvs_update = cvs update "$@"
1329 hg_update  = hg pull "$@" && hg update "$@"
1330 darcs_update = darcs pull -a "$@"
1331
1332 svn_status = svn status "$@"
1333 git_status = git status "$@" || true
1334 bzr_status = bzr status "$@"
1335 cvs_status = cvs status "$@"
1336 hg_status  = hg status "$@"
1337 darcs_status = darcs whatsnew -ls "$@" || true
1338
1339 svn_commit = svn commit "$@"
1340 git_commit = git commit -a "$@" && git push --all
1341 bzr_commit = bzr commit "$@" && bzr push
1342 cvs_commit = cvs commit "$@"
1343 hg_commit  = hg commit -m "$@" && hg push
1344 darcs_commit = darcs record -a -m "$@" && darcs push -a
1345
1346 git_record = git commit -a "$@"
1347 bzr_record = bzr commit "$@"
1348 hg_record  = hg commit -m "$@"
1349 darcs_record = darcs record -a -m "$@"
1350
1351 svn_push = :
1352 git_push = git push "$@"
1353 bzr_push = bzr push "$@"
1354 cvs_push = :
1355 hg_push = hg push "$@"
1356 darcs_push = darcs push -a "$@"
1357
1358 svn_diff = svn diff "$@"
1359 git_diff = git diff "$@"
1360 bzr_diff = bzr diff "$@"
1361 cvs_diff = cvs diff "$@"
1362 hg_diff  = hg diff "$@"
1363 darcs_diff = darcs diff -u "$@"
1364
1365 svn_log = svn log "$@"
1366 git_log = git log "$@"
1367 bzr_log = bzr log "$@"
1368 cvs_log = cvs log "$@"
1369 hg_log  = hg log "$@"
1370 darcs_log = darcs changes "$@"
1371 git_bare_log = git log "$@"
1372
1373 svn_register =
1374         url=`LC_ALL=C svn info . | grep -i '^URL:' | cut -d ' ' -f 2`
1375         if [ -z "$url" ]; then
1376                 error "cannot determine svn url"
1377         fi
1378         echo "Registering svn url: $url in $MR_CONFIG"
1379         mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
1380 git_register = 
1381         url="`LC_ALL=C git config --get remote.origin.url`" || true
1382         if [ -z "$url" ]; then
1383                 error "cannot determine git url"
1384         fi
1385         echo "Registering git url: $url in $MR_CONFIG"
1386         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone '$url' '$MR_REPO'"
1387 bzr_register =
1388         url="`LC_ALL=C bzr info . | egrep -i 'checkout of branch|parent branch' | awk '{print $NF}'`"
1389         if [ -z "$url" ]; then
1390                 error "cannot determine bzr url"
1391         fi
1392         echo "Registering bzr url: $url in $MR_CONFIG"
1393         mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr clone '$url' '$MR_REPO'"
1394 cvs_register =
1395         repo=`cat CVS/Repository`
1396         root=`cat CVS/Root`
1397         if [ -z "$root" ]; then
1398                 error "cannot determine cvs root"
1399                 fi
1400         echo "Registering cvs repository $repo at root $root"
1401         mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
1402 hg_register = 
1403         url=`hg showconfig paths.default`
1404         echo "Registering mercurial repo url: $url in $MR_CONFIG"
1405         mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone '$url' '$MR_REPO'"
1406 darcs_register = 
1407         url=`cat _darcs/prefs/defaultrepo`
1408         echo "Registering darcs repository $url in $MR_CONFIG"
1409         mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get '$url' '$MR_REPO'"
1410 git_bare_register = 
1411         url="`LC_ALL=C GIT_CONFIG=config git config --get remote.origin.url`" || true
1412         if [ -z "$url" ]; then
1413                 error "cannot determine git url"
1414         fi
1415         echo "Registering git url: $url in $MR_CONFIG"
1416         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
1417
1418 help =
1419         if [ ! -e "$MR_PATH" ]; then
1420                 error "cannot find program path"
1421         fi
1422         tmp=$(mktemp -t mr.XXXXXXXXXX) || error "mktemp failed"
1423         trap "rm -f $tmp" exit
1424         pod2man -c mr "$MR_PATH" > "$tmp" || error "pod2man failed"
1425         man -l "$tmp" || error "man failed"
1426 list = true
1427 config = 
1428 bootstrap = 
1429
1430 online =
1431         if [ -s ~/.mrlog ]; then
1432                 info "running offline commands"
1433                 mv -f ~/.mrlog ~/.mrlog.old
1434                 if ! sh -e ~/.mrlog.old; then
1435                         error "offline command failed; left in ~/.mrlog.old"
1436                 fi
1437                 rm -f ~/.mrlog.old
1438         else
1439                 info "no offline commands to run"
1440         fi
1441 offline =
1442         umask 077
1443         touch ~/.mrlog
1444         info "offline mode enabled"
1445 remember =
1446         info "remembering command: 'mr $@'"
1447         command="mr -d '$(pwd)' $MR_SWITCHES"
1448         for w in "$@"; do
1449                 command="$command '$w'"
1450         done
1451         if [ ! -e ~/.mrlog ] || ! grep -q -F "$command" ~/.mrlog; then
1452                 echo "$command" >> ~/.mrlog
1453         fi
1454
1455 ed = echo "A horse is a horse, of course, of course.."
1456 T = echo "I pity the fool."
1457 right = echo "Not found."
1458
1459 # vim:sw=8:sts=0:ts=8:noet