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

madduck's git repository

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

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

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

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

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

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