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

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