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

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