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

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