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

madduck's git repository

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

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

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

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

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

Add git-remote file to lib. This adds a special type of git repository, where the...
[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 -v
183
184 Be verbose.
185
186 =item -q
187
188 Be quiet.
189
190 =item -s
191
192 Expand the statistics line displayed at the end to include information
193 about exactly which repositories failed and were skipped, if any.
194
195 =item -i
196
197 Interactive mode. If a repository fails to be processed, a subshell will be
198 started which you can use to resolve or investigate the problem. Exit the
199 subshell to continue the mr run.
200
201 =item -n [number]
202
203 If no number if specified, just operate on the repository for the current
204 directory, do not recurse into deeper repositories.
205
206 If a number is specified, will recurse into repositories at most that many
207 subdirectories deep. For example, with -n 2 it would recurse into ./src/foo,
208 but not ./src/packages/bar.
209
210 =item -j [number]
211
212 Run the specified number of jobs in parallel, or an unlimited number of jobs
213 with no number specified. This can greatly speed up operations such as updates.
214 It is not recommended for interactive operations.
215
216 Note that running more than 10 jobs at a time is likely to run afoul of
217 ssh connection limits. Running between 3 and 5 jobs at a time will yield
218 a good speedup in updates without loading the machine too much.
219
220 =back
221
222 =head1 FILES
223
224 The ~/.mrlog file contains commands that mr has remembered to run later,
225 due to being offline. You can delete or edit this file to remove commands,
226 or even to add other commands for 'mr online' to run. If the file is
227 present, mr assumes it is in offline mode.
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 =head1 EXTENSIONS
345
346 mr can be extended to support things such as unison and remote git
347 checkout. Some files providing such extensions are available in
348 /usr/share/mr/. See the documentation in the files for details about using
349 them.
350
351 =head1 AUTHOR
352
353 Copyright 2007 Joey Hess <joey@kitenet.net>
354
355 Licensed under the GNU GPL version 2 or higher.
356
357 http://kitenet.net/~joey/code/mr/
358
359 =cut
360
361 use warnings;
362 use strict;
363 use Getopt::Long;
364 use Cwd qw(getcwd abs_path);
365
366 # things that can happen when mr runs a command
367 use constant {
368         OK => 0,
369         FAILED => 1,
370         SKIPPED => 2,
371         ABORT => 3,
372 };
373
374 # configurables
375 my $config_overridden=0;
376 my $verbose=0;
377 my $quiet=0;
378 my $stats=0;
379 my $interactive=0;
380 my $max_depth;
381 my $no_chdir=0;
382 my $jobs=1;
383 my $directory=getcwd();
384 $ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
385
386 # globals :-(
387 my %config;
388 my %configfiles;
389 my %knownactions;
390 my %alias;
391 my (@ok, @failed, @skipped);
392
393 main();
394
395 my %rcs;
396 sub rcs_test {
397         my ($action, $dir, $topdir, $subdir) = @_;
398
399         if (exists $rcs{$dir}) {
400                 return $rcs{$dir};
401         }
402
403         my $test="set -e\n";
404         foreach my $rcs_test (
405                         sort {
406                                 length $a <=> length $b 
407                                           ||
408                                        $a cmp $b
409                         } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
410                 my ($rcs)=$rcs_test=~/(.*)_test/;
411                 $test="my_$rcs_test() {\n$config{$topdir}{$subdir}{$rcs_test}\n}\n".$test;
412                 $test.="if my_$rcs_test; then echo $rcs; fi\n";
413         }
414         $test=$config{$topdir}{$subdir}{lib}."\n".$test
415                 if exists $config{$topdir}{$subdir}{lib};
416         
417         print "mr $action: running rcs test >>$test<<\n" if $verbose;
418         my $rcs=`$test`;
419         chomp $rcs;
420         if ($rcs=~/\n/s) {
421                 $rcs=~s/\n/, /g;
422                 print STDERR "mr $action: found multiple possible repository types ($rcs) for $dir\n";
423                 return undef;
424         }
425         if (! length $rcs) {
426                 return $rcs{$dir}=undef;
427         }
428         else {
429                 return $rcs{$dir}=$rcs;
430         }
431 }
432         
433 sub findcommand {
434         my ($action, $dir, $topdir, $subdir, $is_checkout) = @_;
435         
436         if (exists $config{$topdir}{$subdir}{$action}) {
437                 return $config{$topdir}{$subdir}{$action};
438         }
439
440         if ($is_checkout) {
441                 return undef;
442         }
443
444         my $rcs=rcs_test(@_);
445
446         if (defined $rcs && 
447             exists $config{$topdir}{$subdir}{$rcs."_".$action}) {
448                 return $config{$topdir}{$subdir}{$rcs."_".$action};
449         }
450         else {
451                 return undef;
452         }
453 }
454
455 sub action {
456         my ($action, $dir, $topdir, $subdir) = @_;
457         
458         $ENV{MR_CONFIG}=$configfiles{$topdir};
459         my $lib=exists $config{$topdir}{$subdir}{lib} ?
460                        $config{$topdir}{$subdir}{lib}."\n" : "";
461         my $is_checkout=($action eq 'checkout');
462
463         $ENV{MR_REPO}=$dir;
464
465         if ($is_checkout) {
466                 if (-d $dir) {
467                         print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
468                         return SKIPPED;
469                 }
470
471                 $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
472         }
473         elsif ($action =~ /update/) {
474                 if (! -d $dir) {
475                         return action("checkout", $dir, $topdir, $subdir);
476                 }
477         }
478
479         my $skiptest=findcommand("skip", $dir, $topdir, $subdir, $is_checkout);
480         my $command=findcommand($action, $dir, $topdir, $subdir, $is_checkout);
481
482         if (defined $skiptest) {
483                 my $test="set -e;".$lib.
484                         "my_action(){ $skiptest\n }; my_action '$action'";
485                 print "mr $action: running skip test >>$test<<\n" if $verbose;
486                 my $ret=system($test);
487                 if ($ret != 0) {
488                         if (($? & 127) == 2) {
489                                 print STDERR "mr $action: interrupted\n";
490                                 return ABORT;
491                         }
492                         elsif ($? & 127) {
493                                 print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
494                                 return ABORT;
495                         }
496                 }
497                 if ($ret >> 8 == 0) {
498                         print "mr $action: $dir skipped per config file\n" if $verbose;
499                         return SKIPPED;
500                 }
501         }
502
503         if ($is_checkout && ! -d $dir) {
504                 print "mr $action: creating parent directory $dir\n" if $verbose;
505                 system("mkdir", "-p", $dir);
506         }
507
508         if (! $no_chdir && ! chdir($dir)) {
509                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
510                 return FAILED;
511         }
512         elsif (! defined $command) {
513                 my $rcs=rcs_test(@_);
514                 if (! defined $rcs) {
515                         print STDERR "mr $action: unknown repository type and no defined $action command for $dir\n";
516                         return FAILED;
517                 }
518                 else {
519                         print STDERR "mr $action: no defined action for $rcs repository $dir, skipping\n";
520                         return SKIPPED;
521                 }
522         }
523         else {
524                 if (! $no_chdir) {
525                         print "mr $action: $dir\n" unless $quiet;
526                 }
527                 else {
528                         my $s=$directory;
529                         $s=~s/^\Q$dir\E\/?//;
530                         print "mr $action: $dir (in subdir $s)\n" unless $quiet;
531                 }
532                 $command="set -e; ".$lib.
533                         "my_action(){ $command\n }; my_action ".
534                         join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
535                 print "mr $action: running >>$command<<\n" if $verbose;
536                 my $ret=system($command);
537                 if ($ret != 0) {
538                         if (($? & 127) == 2) {
539                                 print STDERR "mr $action: interrupted\n";
540                                 return ABORT;
541                         }
542                         elsif ($? & 127) {
543                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
544                                 return ABORT;
545                         }
546                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
547                         if ($ret >> 8 != 0) {
548                                 print STDERR "mr $action: command failed\n";
549                                 if (-e "$ENV{HOME}/.mrlog" && $action ne 'remember') {
550                                         # recreate original command line to
551                                         # remember, and avoid recursing
552                                         my @orig=@ARGV;
553                                         @ARGV=('-n', $action, @orig);
554                                         action("remember", $dir, $topdir, $subdir);
555                                         @ARGV=@orig;
556                                 }
557                         }
558                         elsif ($ret != 0) {
559                                 print STDERR "mr $action: command died ($ret)\n";
560                         }
561                         return FAILED;
562                 }
563                 else {
564                         if ($action eq 'checkout' && ! -d $dir) {
565                                 print STDERR "mr $action: $dir missing after checkout\n";;
566                                 return FAILED;
567                         }
568
569                         return OK;
570                 }
571         }
572 }
573
574 # run actions on multiple repos, in parallel
575 sub mrs {
576         my $action=shift;
577         my @repos=@_;
578
579         $| = 1;
580         my @active;
581         my @fhs;
582         my @out;
583         my $running=0;
584         while (@fhs or @repos) {
585                 while ((!$jobs || $running < $jobs) && @repos) {
586                         $running++;
587                         my $repo = shift @repos;
588                         pipe(my $outfh, CHILD_STDOUT);
589                         pipe(my $errfh, CHILD_STDERR);
590                         my $pid;
591                         unless ($pid = fork) {
592                                 die "mr $action: cannot fork: $!" unless defined $pid;
593                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
594                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
595                                 close CHILD_STDOUT;
596                                 close CHILD_STDERR;
597                                 close $outfh;
598                                 close $errfh;
599                                 exit action($action, @$repo);
600                         }
601                         close CHILD_STDOUT;
602                         close CHILD_STDERR;
603                         push @active, [$pid, $repo];
604                         push @fhs, [$outfh, $errfh];
605                         push @out, ['',     ''];
606                 }
607                 my ($rin, $rout) = ('','');
608                 my $nfound;
609                 foreach my $fh (@fhs) {
610                         next unless defined $fh;
611                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
612                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
613                 }
614                 $nfound = select($rout=$rin, undef, undef, 1);
615                 foreach my $channel (0, 1) {
616                         foreach my $i (0..$#fhs) {
617                                 next unless defined $fhs[$i];
618                                 my $fh = $fhs[$i][$channel];
619                                 next unless defined $fh;
620                                 if (vec($rout, fileno($fh), 1) == 1) {
621                                         my $r = '';
622                                         if (sysread($fh, $r, 1024) == 0) {
623                                                 close($fh);
624                                                 $fhs[$i][$channel] = undef;
625                                                 if (! defined $fhs[$i][0] &&
626                                                     ! defined $fhs[$i][1]) {
627                                                         waitpid($active[$i][0], 0);
628                                                         print STDOUT $out[$i][0];
629                                                         print STDERR $out[$i][1];
630                                                         record($active[$i][1], $? >> 8);
631                                                         splice(@fhs, $i, 1);
632                                                         splice(@active, $i, 1);
633                                                         splice(@out, $i, 1);
634                                                         $running--;
635                                                 }
636                                         }
637                                         $out[$i][$channel] .= $r;
638                                 }
639                         }
640                 }
641         }
642 }
643
644 sub record {
645         my $dir=shift()->[0];
646         my $ret=shift;
647
648         if ($ret == OK) {
649                 push @ok, $dir;
650                 print "\n";
651         }
652         elsif ($ret == FAILED) {
653                 if ($interactive) {
654                         chdir($dir) unless $no_chdir;
655                         print STDERR "mr: Starting interactive shell. Exit shell to continue.\n";
656                         system((getpwuid($<))[8]);
657                 }
658                 push @failed, $dir;
659                 print "\n";
660         }
661         elsif ($ret == SKIPPED) {
662                 push @skipped, $dir;
663         }
664         elsif ($ret == ABORT) {
665                 exit 1;
666         }
667         else {
668                 die "unknown exit status $ret";
669         }
670 }
671
672 sub showstats {
673         my $action=shift;
674         if (! @ok && ! @failed && ! @skipped) {
675                 die "mr $action: no repositories found to work on\n";
676         }
677         print "mr $action: finished (".join("; ",
678                 showstat($#ok+1, "ok", "ok"),
679                 showstat($#failed+1, "failed", "failed"),
680                 showstat($#skipped+1, "skipped", "skipped"),
681         ).")\n" unless $quiet;
682         if ($stats) {
683                 if (@skipped) {
684                         print "mr $action: (skipped: ".join(" ", @skipped).")\n" unless $quiet;
685                 }
686                 if (@failed) {
687                         print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
688                 }
689         }
690 }
691
692 sub showstat {
693         my $count=shift;
694         my $singular=shift;
695         my $plural=shift;
696         if ($count) {
697                 return "$count ".($count > 1 ? $plural : $singular);
698         }
699         return;
700 }
701
702 # an ordered list of repos
703 sub repolist {
704         my @list;
705         foreach my $topdir (sort keys %config) {
706                 foreach my $subdir (sort keys %{$config{$topdir}}) {
707                         push @list, {
708                                 topdir => $topdir,
709                                 subdir => $subdir,
710                                 order => $config{$topdir}{$subdir}{order},
711                         };
712                 }
713         }
714         return sort {
715                 $a->{order}  <=> $b->{order}
716                              ||
717                 $a->{topdir} cmp $b->{topdir}
718                              ||
719                 $a->{subdir} cmp $b->{subdir}
720         } @list;
721 }
722
723 # figure out which repos to act on
724 sub selectrepos {
725         my @repos;
726         foreach my $repo (repolist()) {
727                 my $topdir=$repo->{topdir};
728                 my $subdir=$repo->{subdir};
729
730                 next if $subdir eq 'DEFAULT';
731                 my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
732                 my $d=$directory;
733                 $dir.="/" unless $dir=~/\/$/;
734                 $d.="/" unless $d=~/\/$/;
735                 next if $dir ne $d && $dir !~ /^\Q$d\E/;
736                 if (defined $max_depth) {
737                         my @a=split('/', $dir);
738                         my @b=split('/', $d);
739                         do { } while (@a && @b && shift(@a) eq shift(@b));
740                         next if @a > $max_depth || @b > $max_depth;
741                 }
742                 push @repos, [$dir, $topdir, $subdir];
743         }
744         if (! @repos) {
745                 # fallback to find a leaf repo
746                 foreach my $repo (reverse repolist()) {
747                         my $topdir=$repo->{topdir};
748                         my $subdir=$repo->{subdir};
749                         
750                         next if $subdir eq 'DEFAULT';
751                         my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
752                         my $d=$directory;
753                         $dir.="/" unless $dir=~/\/$/;
754                         $d.="/" unless $d=~/\/$/;
755                         if ($d=~/^\Q$dir\E/) {
756                                 push @repos, [$dir, $topdir, $subdir];
757                                 last;
758                         }
759                 }
760                 $no_chdir=1;
761         }
762         return @repos;
763 }
764
765 sub expandenv {
766         my $val=shift;
767         
768
769         if ($val=~/\$/) {
770                 $val=`echo "$val"`;
771                 chomp $val;
772         }
773         
774         return $val;
775 }
776
777 my %loaded;
778 sub loadconfig {
779         my $f=shift;
780
781         my @toload;
782
783         my $in;
784         my $dir;
785         if (ref $f eq 'GLOB') {
786                 $dir="";
787                 $in=$f; 
788         }
789         else {
790                 if (! -e $f) {
791                         return;
792                 }
793
794                 my $absf=abs_path($f);
795                 if ($loaded{$absf}) {
796                         return;
797                 }
798                 $loaded{$absf}=1;
799
800                 ($dir)=$f=~/^(.*\/)[^\/]+$/;
801                 if (! defined $dir) {
802                         $dir=".";
803                 }
804                 $dir=abs_path($dir)."/";
805                 
806                 if (! exists $configfiles{$dir}) {
807                         $configfiles{$dir}=$f;
808                 }
809
810                 # copy in defaults from first parent
811                 my $parent=$dir;
812                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
813                         if ($parent eq '/') {
814                                 $parent="";
815                         }
816                         if (exists $config{$parent} &&
817                             exists $config{$parent}{DEFAULT}) {
818                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
819                                 last;
820                         }
821                 }
822                 
823                 print "mr: loading config $f\n" if $verbose;
824                 open($in, "<", $f) || die "mr: open $f: $!\n";
825         }
826         my @lines=<$in>;
827         close $in;
828
829         my $section;
830         my $line=0;
831         while (@lines) {
832                 $_=shift @lines;
833                 $line++;
834                 chomp;
835                 next if /^\s*\#/ || /^\s*$/;
836                 if (/^\[([^\]]*)\]\s*$/) {
837                         $section=expandenv($1);
838                 }
839                 elsif (/^(\w+)\s*=\s*(.*)/) {
840                         my $parameter=$1;
841                         my $value=$2;
842
843                         # continued value
844                         while (@lines && $lines[0]=~/^\s(.+)/) {
845                                 shift(@lines);
846                                 $line++;
847                                 $value.="\n$1";
848                                 chomp $value;
849                         }
850
851                         if ($parameter eq "include") {
852                                 print "mr: including output of \"$value\"\n" if $verbose;
853                                 unshift @lines, `$value`;
854                                 if ($?) {
855                                         print STDERR "mr: include command exited nonzero ($?)\n";
856                                 }
857                                 next;
858                         }
859
860                         if (! defined $section) {
861                                 die "$f line $.: parameter ($parameter) not in section\n";
862                         }
863                         if ($section ne 'ALIAS' &&
864                             ! exists $config{$dir}{$section} &&
865                             exists $config{$dir}{DEFAULT}) {
866                                 # copy in defaults
867                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
868                         }
869                         if ($section eq 'ALIAS') {
870                                 $alias{$parameter}=$value;
871                         }
872                         elsif ($parameter eq 'lib') {
873                                 $config{$dir}{$section}{lib}.=$value."\n";
874                         }
875                         else {
876                                 $config{$dir}{$section}{$parameter}=$value;
877                                 if ($parameter =~ /.*_(.*)/) {
878                                         $knownactions{$1}=1;
879                                 }
880                                 else {
881                                         $knownactions{$parameter}=1;
882                                 }
883                                 if ($parameter eq 'chain' &&
884                                     length $dir && $section ne "DEFAULT" &&
885                                     -e $dir.$section."/.mrconfig") {
886                                         my $ret=system($value);
887                                         if ($ret != 0) {
888                                                 if (($? & 127) == 2) {
889                                                         print STDERR "mr: chain test interrupted\n";
890                                                         exit 2;
891                                                 }
892                                                 elsif ($? & 127) {
893                                                         print STDERR "mr: chain test received signal ".($? & 127)."\n";
894                                                 }
895                                         }
896                                         else {
897                                                 push @toload, $dir.$section."/.mrconfig";
898                                         }
899                                 }
900                         }
901                 }
902                 else {
903                         die "$f line $line: parse error\n";
904                 }
905         }
906
907         foreach (@toload) {
908                 loadconfig($_);
909         }
910 }
911
912 sub modifyconfig {
913         my $f=shift;
914         # the section to modify or add
915         my $targetsection=shift;
916         # fields to change in the section
917         # To remove a field, set its value to "".
918         my %changefields=@_;
919
920         my @lines;
921         my @out;
922
923         if (-e $f) {
924                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
925                 @lines=<$in>;
926                 close $in;
927         }
928
929         my $formatfield=sub {
930                 my $field=shift;
931                 my @value=split(/\n/, shift);
932
933                 return "$field = ".shift(@value)."\n".
934                         join("", map { "\t$_\n" } @value);
935         };
936         my $addfields=sub {
937                 my @blanks;
938                 while ($out[$#out] =~ /^\s*$/) {
939                         unshift @blanks, pop @out;
940                 }
941                 foreach my $field (sort keys %changefields) {
942                         if (length $changefields{$field}) {
943                                 push @out, "$field = $changefields{$field}\n";
944                                 delete $changefields{$field};
945                         }
946                 }
947                 push @out, @blanks;
948         };
949
950         my $section;
951         while (@lines) {
952                 $_=shift(@lines);
953
954                 if (/^\s*\#/ || /^\s*$/) {
955                         push @out, $_;
956                 }
957                 elsif (/^\[([^\]]*)\]\s*$/) {
958                         if (defined $section && 
959                             $section eq $targetsection) {
960                                 $addfields->();
961                         }
962
963                         $section=expandenv($1);
964
965                         push @out, $_;
966                 }
967                 elsif (/^(\w+)\s*=\s(.*)/) {
968                         my $parameter=$1;
969                         my $value=$2;
970
971                         # continued value
972                         while (@lines && $lines[0]=~/^\s(.+)/) {
973                                 shift(@lines);
974                                 $value.="\n$1";
975                                 chomp $value;
976                         }
977
978                         if ($section eq $targetsection) {
979                                 if (exists $changefields{$parameter}) {
980                                         if (length $changefields{$parameter}) {
981                                                 $value=$changefields{$parameter};
982                                         }
983                                         delete $changefields{$parameter};
984                                 }
985                         }
986
987                         push @out, $formatfield->($parameter, $value);
988                 }
989         }
990
991         if (defined $section && 
992             $section eq $targetsection) {
993                 $addfields->();
994         }
995         elsif (%changefields) {
996                 push @out, "\n[$targetsection]\n";
997                 foreach my $field (sort keys %changefields) {
998                         if (length $changefields{$field}) {
999                                 push @out, $formatfield->($field, $changefields{$field});
1000                         }
1001                 }
1002         }
1003
1004         open(my $out, ">", $f) || die "mr: write $f: $!\n";
1005         print $out @out;
1006         close $out;     
1007 }
1008
1009 sub dispatch {
1010         my $action=shift;
1011
1012         # actions that do not operate on all repos
1013         if ($action eq 'help') {
1014                 help(@ARGV);
1015         }
1016         elsif ($action eq 'config') {
1017                 config(@ARGV);
1018         }
1019         elsif ($action eq 'register') {
1020                 register(@ARGV);
1021         }
1022         elsif ($action eq 'remember' ||
1023                $action eq 'offline' ||
1024                $action eq 'online') {
1025                 my @repos=selectrepos;
1026                 action($action, @{$repos[0]}) if @repos;
1027                 exit 0;
1028         }
1029
1030         if (!$jobs || $jobs > 1) {
1031                 mrs($action, selectrepos());
1032         }
1033         else {
1034                 foreach my $repo (selectrepos()) {
1035                         record($repo, action($action, @$repo));
1036                 }
1037         }
1038 }
1039
1040 sub help {
1041         exec($config{''}{DEFAULT}{help}) || die "exec: $!";
1042 }
1043
1044 sub config {
1045         if (@_ < 2) {
1046                 die "mr config: not enough parameters\n";
1047         }
1048         my $section=shift;
1049         if ($section=~/^\//) {
1050                 # try to convert to a path relative to the config file
1051                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
1052                 $dir=abs_path($dir);
1053                 $dir.="/" unless $dir=~/\/$/;
1054                 if ($section=~/^\Q$dir\E(.*)/) {
1055                         $section=$1;
1056                 }
1057         }
1058         my %changefields;
1059         foreach (@_) {
1060                 if (/^([^=]+)=(.*)$/) {
1061                         $changefields{$1}=$2;
1062                 }
1063                 else {
1064                         my $found=0;
1065                         foreach my $topdir (sort keys %config) {
1066                                 if (exists $config{$topdir}{$section} &&
1067                                     exists $config{$topdir}{$section}{$_}) {
1068                                         print $config{$topdir}{$section}{$_}."\n";
1069                                         $found=1;
1070                                         last if $section eq 'DEFAULT';
1071                                 }
1072                         }
1073                         if (! $found) {
1074                                 die "mr config: $section $_ not set\n";
1075                         }
1076                 }
1077         }
1078         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
1079         exit 0;
1080 }
1081
1082 sub register {
1083         if ($config_overridden) {
1084                 # Find the directory that the specified config file is
1085                 # located in.
1086                 ($directory)=abs_path($ENV{MR_CONFIG})=~/^(.*\/)[^\/]+$/;
1087         }
1088         else {
1089                 # Find the closest known mrconfig file to the current
1090                 # directory.
1091                 $directory.="/" unless $directory=~/\/$/;
1092                 my $foundconfig=0;
1093                 foreach my $topdir (reverse sort keys %config) {
1094                         next unless length $topdir;
1095                         if ($directory=~/^\Q$topdir\E/) {
1096                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
1097                                 $directory=$topdir;
1098                                 $foundconfig=1;
1099                                 last;
1100                         }
1101                 }
1102                 if (! $foundconfig) {
1103                         $directory=""; # no config file, use builtin
1104                 }
1105         }
1106         if (@ARGV) {
1107                 my $subdir=shift @ARGV;
1108                 if (! chdir($subdir)) {
1109                         print STDERR "mr register: failed to chdir to $subdir: $!\n";
1110                 }
1111         }
1112
1113         $ENV{MR_REPO}=getcwd();
1114         my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT', 0);
1115         if (! defined $command) {
1116                 die "mr register: unknown repository type\n";
1117         }
1118
1119         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
1120         $command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
1121                 "my_action(){ $command\n }; my_action ".
1122                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
1123         print "mr register: running >>$command<<\n" if $verbose;
1124         exec($command) || die "exec: $!";
1125 }
1126
1127 # alias expansion and command stemming
1128 sub expandaction {
1129         my $action=shift;
1130         if (exists $alias{$action}) {
1131                 $action=$alias{$action};
1132         }
1133         if (! exists $knownactions{$action}) {
1134                 my @matches = grep { /^\Q$action\E/ }
1135                         keys %knownactions, keys %alias;
1136                 if (@matches == 1) {
1137                         $action=$matches[0];
1138                 }
1139                 elsif (@matches == 0) {
1140                         die "mr: unknown action \"$action\" (known actions: ".
1141                                 join(", ", sort keys %knownactions).")\n";
1142                 }
1143                 else {
1144                         die "mr: ambiguous action \"$action\" (matches: ".
1145                                 join(", ", @matches).")\n";
1146                 }
1147         }
1148         return $action;
1149 }
1150
1151 sub getopts {
1152         my @saved=@ARGV;
1153         Getopt::Long::Configure("bundling", "no_permute");
1154         my $result=GetOptions(
1155                 "d|directory=s" => sub { $directory=abs_path($_[1]) },
1156                 "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
1157                 "v|verbose" => \$verbose,
1158                 "q|quiet" => \$quiet,
1159                 "s|stats" => \$stats,
1160                 "i|interactive" => \$interactive,
1161                 "n|no-recurse:i" => \$max_depth,
1162                 "j|jobs:i" => \$jobs,
1163         );
1164         if (! $result || @ARGV < 1) {
1165                 die("Usage: mr [-d directory] action [params ...]\n".
1166                     "(Use mr help for man page.)\n");
1167         }
1168         
1169         $ENV{MR_SWITCHES}="";
1170         foreach my $option (@saved) {
1171                 last if $option eq $ARGV[0];
1172                 $ENV{MR_SWITCHES}.="$option ";
1173         }
1174 }
1175
1176 sub init {
1177         $SIG{INT}=sub {
1178                 print STDERR "mr: interrupted\n";
1179                 exit 2;
1180         };
1181         
1182         # This can happen if it's run in a directory that was removed
1183         # or other strangeness.
1184         if (! defined $directory) {
1185                 die("mr: failed to determine working directory\n");
1186         }
1187         # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
1188         # the config file might be a symlink to elsewhere, and the directory it's
1189         # in is significant.
1190         if ($ENV{MR_CONFIG} !~ /^\//) {
1191                 $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
1192         }
1193         # Try to set MR_PATH to the path to the program.
1194         eval {
1195                 use FindBin qw($Bin $Script);
1196                 $ENV{MR_PATH}=$Bin."/".$Script;
1197         };
1198 }
1199
1200 sub main {
1201         getopts();
1202         init();
1203
1204         loadconfig(\*DATA);
1205         loadconfig($ENV{MR_CONFIG});
1206         #use Data::Dumper; print Dumper(\%config);
1207         
1208         my $action=expandaction(shift @ARGV);
1209         dispatch($action);
1210         showstats($action);
1211
1212         if (@failed) {
1213                 exit 1;
1214         }
1215         elsif (! @ok && @skipped) {
1216                 exit 1;
1217         }
1218         else {
1219                 exit 0;
1220         }
1221 }
1222
1223 # Finally, some useful actions that mr knows about by default.
1224 # These can be overridden in ~/.mrconfig.
1225 __DATA__
1226 [ALIAS]
1227 co = checkout
1228 ci = commit
1229 ls = list
1230
1231 [DEFAULT]
1232 order = 10
1233 lib =
1234         error() {
1235                 echo "mr: $@" >&2
1236                 exit 1
1237         }
1238         warning() {
1239                 echo "mr (warning): $@" >&2
1240         }
1241         info() {
1242                 echo "mr: $@" >&2
1243         }
1244         hours_since() {
1245                 if [ -z "$1" ] || [ -z "$2" ]; then
1246                         error "mr: usage: hours_since action num"
1247                 fi
1248                 for dir in .git .svn .bzr CVS .hg _darcs; do
1249                         if [ -e "$MR_REPO/$dir" ]; then
1250                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1251                                 break
1252                         fi
1253                 done
1254                 if [ -z "$flagfile" ]; then
1255                         error "cannot determine flag filename"
1256                 fi
1257                 delta=`perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile"`
1258                 if [ "$delta" -lt "$2" ]; then
1259                         exit 0
1260                 else
1261                         touch "$flagfile"
1262                         exit 1
1263                 fi
1264         }
1265
1266 svn_test = test -d "$MR_REPO"/.svn
1267 git_test = test -d "$MR_REPO"/.git
1268 bzr_test = test -d "$MR_REPO"/.bzr
1269 cvs_test = test -d "$MR_REPO"/CVS
1270 hg_test  = test -d "$MR_REPO"/.hg
1271 darcs_test = test -d "$MR_REPO"/_darcs
1272 git_bare_test =
1273         test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
1274         test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
1275         test "`GIT_CONFIG="$MR_REPO"/config git config --get core.bare`" = true
1276
1277 svn_update = svn update "$@"
1278 git_update = git pull "$@"
1279 bzr_update = bzr merge "$@"
1280 cvs_update = cvs update "$@"
1281 hg_update  = hg pull "$@" && hg update "$@"
1282 darcs_update = darcs pull -a "$@"
1283
1284 svn_status = svn status "$@"
1285 git_status = git status "$@" || true
1286 bzr_status = bzr status "$@"
1287 cvs_status = cvs status "$@"
1288 hg_status  = hg status "$@"
1289 darcs_status = darcs whatsnew -ls "$@" || true
1290
1291 svn_commit = svn commit "$@"
1292 git_commit = git commit -a "$@" && git push --all
1293 bzr_commit = bzr commit "$@" && bzr push
1294 cvs_commit = cvs commit "$@"
1295 hg_commit  = hg commit -m "$@" && hg push
1296 darcs_commit = darcs record -a -m "$@" && darcs push -a
1297
1298 git_record = git commit -a "$@"
1299 bzr_record = bzr commit "$@"
1300 hg_record  = hg commit -m "$@"
1301 darcs_record = darcs record -a -m "$@"
1302
1303 svn_push = :
1304 git_push = git push "$@"
1305 bzr_push = bzr push "$@"
1306 cvs_push = :
1307 hg_push = hg push "$@"
1308 darcs_push = darcs push -a "$@"
1309
1310 svn_diff = svn diff "$@"
1311 git_diff = git diff "$@"
1312 bzr_diff = bzr diff "$@"
1313 cvs_diff = cvs diff "$@"
1314 hg_diff  = hg diff "$@"
1315 darcs_diff = darcs diff -u "$@"
1316
1317 svn_log = svn log "$@"
1318 git_log = git log "$@"
1319 bzr_log = bzr log "$@"
1320 cvs_log = cvs log "$@"
1321 hg_log  = hg log "$@"
1322 darcs_log = darcs changes "$@"
1323 git_bare_log = git log "$@"
1324
1325 svn_register =
1326         url=`LC_ALL=C svn info . | grep -i '^URL:' | cut -d ' ' -f 2`
1327         if [ -z "$url" ]; then
1328                 error "cannot determine svn url"
1329         fi
1330         echo "Registering svn url: $url in $MR_CONFIG"
1331         mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
1332 git_register = 
1333         url="`LC_ALL=C git config --get remote.origin.url`" || true
1334         if [ -z "$url" ]; then
1335                 error "cannot determine git url"
1336         fi
1337         echo "Registering git url: $url in $MR_CONFIG"
1338         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone '$url' '$MR_REPO'"
1339 bzr_register =
1340         url="`LC_ALL=C bzr info . | egrep -i 'checkout of branch|parent branch' | awk '{print $NF}'`"
1341         if [ -z "$url" ]; then
1342                 error "cannot determine bzr url"
1343         fi
1344         echo "Registering bzr url: $url in $MR_CONFIG"
1345         mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr clone '$url' '$MR_REPO'"
1346 cvs_register =
1347         repo=`cat CVS/Repository`
1348         root=`cat CVS/Root`
1349         if [ -z "$root" ]; then
1350                 error "cannot determine cvs root"
1351                 fi
1352         echo "Registering cvs repository $repo at root $root"
1353         mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
1354 hg_register = 
1355         url=`hg showconfig paths.default`
1356         echo "Registering mercurial repo url: $url in $MR_CONFIG"
1357         mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone '$url' '$MR_REPO'"
1358 darcs_register = 
1359         url=`cat _darcs/prefs/defaultrepo`
1360         echo "Registering darcs repository $url in $MR_CONFIG"
1361         mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get '$url' '$MR_REPO'"
1362 git_bare_register = 
1363         url="`LC_ALL=C GIT_CONFIG=config git config --get remote.origin.url`" || true
1364         if [ -z "$url" ]; then
1365                 error "cannot determine git url"
1366         fi
1367         echo "Registering git url: $url in $MR_CONFIG"
1368         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
1369
1370 help =
1371         if [ ! -e "$MR_PATH" ]; then
1372                 error "cannot find program path"
1373         fi
1374         tmp=$(mktemp -t mr.XXXXXXXXXX) || error "mktemp failed"
1375         trap "rm -f $tmp" exit
1376         pod2man -c mr "$MR_PATH" > "$tmp" || error "pod2man failed"
1377         man -l "$tmp" || error "man failed"
1378 list = true
1379 config = 
1380
1381 online =
1382         if [ -s ~/.mrlog ]; then
1383                 info "running offline commands"
1384                 mv -f ~/.mrlog ~/.mrlog.old
1385                 if ! sh -e ~/.mrlog.old; then
1386                         error "offline command failed; left in ~/.mrlog.old"
1387                 fi
1388                 rm -f ~/.mrlog.old
1389         else
1390                 info "no offline commands to run"
1391         fi
1392 offline =
1393         umask 077
1394         touch ~/.mrlog
1395         info "offline mode enabled"
1396 remember =
1397         info "remembering command: 'mr $@'"
1398         command="mr -d '$(pwd)' $MR_SWITCHES"
1399         for w in "$@"; do
1400                 command="$command '$w'"
1401         done
1402         if [ ! -e ~/.mrlog ] || ! grep -q -F "$command" ~/.mrlog; then
1403                 echo "$command" >> ~/.mrlog
1404         fi
1405
1406 ed = echo "A horse is a horse, of course, of course.."
1407 T = echo "I pity the fool."
1408 right = echo "Not found."
1409
1410 # vim:sw=8:sts=0:ts=8:noet