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

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