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

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