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

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