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