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

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