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

madduck's git repository

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

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

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

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

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

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