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

8108762c2ee95e896c3343ac7a1cbf41c6b0ad38
[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 $no_chdir=0;
318 my $jobs=1;
319 my %config;
320 my %configfiles;
321 my %knownactions;
322 my %alias;
323 my $directory=getcwd();
324
325 getopts();
326
327 # This can happen if it's run in a directory that was removed
328 # or other strangeness.
329 if (! defined $directory) {
330         die("mr: failed to determine working directory\n");
331 }
332 # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
333 # the config file might be a symlink to elsewhere, and the directory it's
334 # in is significant.
335 if ($ENV{MR_CONFIG} !~ /^\//) {
336         $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
337 }
338 # Try to set MR_PATH to the path to the program.
339 eval {
340         use FindBin qw($Bin $Script);
341         $ENV{MR_PATH}=$Bin."/".$Script;
342 };
343
344 loadconfig(\*DATA);
345 loadconfig($ENV{MR_CONFIG});
346 #use Data::Dumper;
347 #print Dumper(\%config);
348
349 my $action=expandaction(shift @ARGV);
350
351 # actions that do not operate on all repos
352 if ($action eq 'help') {
353         help(@ARGV);
354 }
355 elsif ($action eq 'config') {
356         config(@ARGV);
357 }
358 elsif ($action eq 'register') {
359         register(@ARGV);
360 }
361
362 my (@ok, @failed, @skipped);
363 if ($jobs > 1) {
364         mrs(selectrepos());
365 }
366 else {
367         foreach my $repo (selectrepos()) {
368                 record($repo, action($action, @$repo));
369         }
370 }
371
372 showstats();
373
374 if (@failed) {
375         exit 1;
376 }
377 elsif (! @ok && @skipped) {
378         exit 1;
379 }
380 exit 0;
381
382 sub rcs_test { #{{{
383         my ($action, $dir, $topdir, $subdir) = @_;
384
385         my $test="set -e\n";
386         foreach my $rcs_test (
387                         sort {
388                                 length $a <=> length $b 
389                                           ||
390                                        $a cmp $b
391                         } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
392                 my ($rcs)=$rcs_test=~/(.*)_test/;
393                 $test="my_$rcs_test() {\n$config{$topdir}{$subdir}{$rcs_test}\n}\n".$test;
394                 $test.="if my_$rcs_test; then echo $rcs; fi\n";
395         }
396         $test=$config{$topdir}{$subdir}{lib}."\n".$test
397                 if exists $config{$topdir}{$subdir}{lib};
398         
399         print "mr $action: running rcs test >>$test<<\n" if $verbose;
400         my $rcs=`$test`;
401         chomp $rcs;
402         if (! length $rcs) {
403                 return undef;
404         }
405         else {
406                 return $rcs;
407         }
408 } #}}}
409         
410 sub findcommand { #{{{
411         my ($action, $dir, $topdir, $subdir) = @_;
412         
413         if (exists $config{$topdir}{$subdir}{$action}) {
414                 return $config{$topdir}{$subdir}{$action};
415         }
416
417         my $rcs=rcs_test(@_);
418
419         if (defined $rcs && 
420             exists $config{$topdir}{$subdir}{$rcs."_".$action}) {
421                 return $config{$topdir}{$subdir}{$rcs."_".$action};
422         }
423         else {
424                 return undef;
425         }
426 } #}}}
427
428 sub action { #{{{
429         my ($action, $dir, $topdir, $subdir) = @_;
430
431         $ENV{MR_CONFIG}=$configfiles{$topdir};
432         my $lib=exists $config{$topdir}{$subdir}{lib} ?
433                        $config{$topdir}{$subdir}{lib}."\n" : "";
434
435         if ($action eq 'checkout') {
436                 if (-d $dir) {
437                         print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
438                         return SKIPPED;
439                 }
440
441                 $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
442
443                 if (! -d $dir) {
444                         print "mr $action: creating parent directory $dir\n" if $verbose;
445                         system("mkdir", "-p", $dir);
446                 }
447         }
448         elsif ($action =~ /update/) {
449                 if (! -d $dir) {
450                         return action("checkout", $dir, $topdir, $subdir);
451                 }
452         }
453
454         $ENV{MR_REPO}=$dir;
455
456         my $skiptest=findcommand("skip", $dir, $topdir, $subdir);
457         my $command=findcommand($action, $dir, $topdir, $subdir);
458
459         if (defined $skiptest) {
460                 my $test="set -e;".$lib.
461                         "my_action(){ $skiptest\n }; my_action '$action'";
462                 print "mr $action: running skip test >>$test<<\n" if $verbose;
463                 my $ret=system($test);
464                 if ($ret != 0) {
465                         if (($? & 127) == 2) {
466                                 print STDERR "mr $action: interrupted\n";
467                                 return ABORT;
468                         }
469                         elsif ($? & 127) {
470                                 print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
471                                 return ABORT;
472                         }
473                 }
474                 if ($ret >> 8 == 0) {
475                         print "mr $action: $dir skipped per config file\n" if $verbose;
476                         return SKIPPED;
477                 }
478         }
479         
480         if (! $no_chdir && ! chdir($dir)) {
481                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
482                 return FAILED;
483         }
484         elsif (! defined $command) {
485                 my $rcs=rcs_test(@_);
486                 if (! defined $rcs) {
487                         print STDERR "mr $action: unknown repository type and no defined $action command for $topdir$subdir\n";
488                         return FAILED;
489                 }
490                 else {
491                         print STDERR "mr $action: no defined $action command for $rcs repository $topdir$subdir, skipping\n";
492                         return SKIPPED;
493                 }
494         }
495         else {
496                 if (! $no_chdir) {
497                         print "mr $action: $topdir$subdir\n";
498                 }
499                 else {
500                         my $s=$directory;
501                         $s=~s/^\Q$topdir$subdir\E\/?//;
502                         print "mr $action: $topdir$subdir (in subdir $s)\n";
503                 }
504                 $command="set -e; ".$lib.
505                         "my_action(){ $command\n }; my_action ".
506                         join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
507                 print "mr $action: running >>$command<<\n" if $verbose;
508                 my $ret=system($command);
509                 if ($ret != 0) {
510                         if (($? & 127) == 2) {
511                                 print STDERR "mr $action: interrupted\n";
512                                 return ABORT;
513                         }
514                         elsif ($? & 127) {
515                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
516                                 return ABORT;
517                         }
518                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
519                         if ($ret >> 8 != 0) {
520                                 print STDERR "mr $action: command failed\n";
521                         }
522                         elsif ($ret != 0) {
523                                 print STDERR "mr $action: command died ($ret)\n";
524                         }
525                         return FAILED;
526                 }
527                 else {
528                         if ($action eq 'checkout' && ! -d $dir) {
529                                 print STDERR "mr $action: $dir missing after checkout\n";;
530                                 return FAILED;
531                         }
532
533                         return OK;
534                 }
535         }
536 } #}}}
537
538 # run actions on multiple repos, in parallel
539 sub mrs { #{{{
540         my @repos=@_;
541
542         $| = 1;
543         my @active;
544         my @fhs;
545         my @out;
546         my $running=0;
547         while (@fhs or @repos) {
548                 while ($running < $jobs && @repos) {
549                         $running++;
550                         my $repo = shift @repos;
551                         pipe(my $outfh, CHILD_STDOUT);
552                         pipe(my $errfh, CHILD_STDERR);
553                         my $pid;
554                         unless ($pid = fork) {
555                                 die "mr $action: cannot fork: $!" unless defined $pid;
556                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
557                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
558                                 close CHILD_STDOUT;
559                                 close CHILD_STDERR;
560                                 close $outfh;
561                                 close $errfh;
562                                 exit action($action, @$repo);
563                         }
564                         close CHILD_STDOUT;
565                         close CHILD_STDERR;
566                         push @active, [$pid, $repo];
567                         push @fhs, [$outfh, $errfh];
568                         push @out, ['',     ''];
569                 }
570                 my ($rin, $rout) = ('','');
571                 my $nfound;
572                 foreach my $fh (@fhs) {
573                         next unless defined $fh;
574                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
575                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
576                 }
577                 $nfound = select($rout=$rin, undef, undef, 1);
578                 foreach my $channel (0, 1) {
579                         foreach my $i (0..$#fhs) {
580                                 next unless defined $fhs[$i];
581                                 my $fh = $fhs[$i][$channel];
582                                 next unless defined $fh;
583                                 if (vec($rout, fileno($fh), 1) == 1) {
584                                         my $r = '';
585                                         if (sysread($fh, $r, 1024) == 0) {
586                                                 close($fh);
587                                                 $fhs[$i][$channel] = undef;
588                                                 if (! defined $fhs[$i][0] &&
589                                                     ! defined $fhs[$i][1]) {
590                                                         waitpid($active[$i][0], 0);
591                                                         print STDOUT $out[$i][0];
592                                                         print STDERR $out[$i][1];
593                                                         record($active[$i][1], $? >> 8);
594                                                         splice(@fhs, $i, 1);
595                                                         splice(@active, $i, 1);
596                                                         splice(@out, $i, 1);
597                                                         $running--;
598                                                 }
599                                         }
600                                         $out[$i][$channel] .= $r;
601                                 }
602                         }
603                 }
604         }
605 } #}}}
606
607 sub record { #{{{
608         my $dir=shift()->[0];
609         my $ret=shift;
610
611         if ($ret == OK) {
612                 push @ok, $dir;
613                 print "\n";
614         }
615         elsif ($ret == FAILED) {
616                 push @failed, $dir;
617                 print "\n";
618         }
619         elsif ($ret == SKIPPED) {
620                 push @skipped, $dir;
621         }
622         elsif ($ret == ABORT) {
623                 exit 1;
624         }
625         else {
626                 die "unknown exit status $ret";
627         }
628 } #}}}
629
630 sub showstats { #{{{
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";
639         if ($stats) {
640                 if (@skipped) {
641                         print "mr $action: (skipped: ".join(" ", @skipped).")\n";
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 $no_recurse && $d ne $dir;
693                 next if $dir ne $d && $dir !~ /^\Q$d\E/;
694                 push @repos, [$dir, $topdir, $subdir];
695         }
696         if (! @repos) {
697                 # fallback to find a leaf repo
698                 foreach my $repo (reverse repolist()) {
699                         my $topdir=$repo->{topdir};
700                         my $subdir=$repo->{subdir};
701                         
702                         next if $subdir eq 'DEFAULT';
703                         my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
704                         my $d=$directory;
705                         $dir.="/" unless $dir=~/\/$/;
706                         $d.="/" unless $d=~/\/$/;
707                         if ($d=~/^\Q$dir\E/) {
708                                 push @repos, [$dir, $topdir, $subdir];
709                                 last;
710                         }
711                 }
712                 $no_chdir=1;
713         }
714         return @repos;
715 } #}}}
716
717 my %loaded;
718 sub loadconfig { #{{{
719         my $f=shift;
720
721         my @toload;
722
723         my $in;
724         my $dir;
725         if (ref $f eq 'GLOB') {
726                 $dir="";
727                 $in=$f; 
728         }
729         else {
730                 if (! -e $f) {
731                         return;
732                 }
733
734                 my $absf=abs_path($f);
735                 if ($loaded{$absf}) {
736                         return;
737                 }
738                 $loaded{$absf}=1;
739
740                 ($dir)=$f=~/^(.*\/)[^\/]+$/;
741                 if (! defined $dir) {
742                         $dir=".";
743                 }
744                 $dir=abs_path($dir)."/";
745                 
746                 if (! exists $configfiles{$dir}) {
747                         $configfiles{$dir}=$f;
748                 }
749
750                 # copy in defaults from first parent
751                 my $parent=$dir;
752                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
753                         if ($parent eq '/') {
754                                 $parent="";
755                         }
756                         if (exists $config{$parent} &&
757                             exists $config{$parent}{DEFAULT}) {
758                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
759                                 last;
760                         }
761                 }
762                 
763                 print "mr: loading config $f\n" if $verbose;
764                 open($in, "<", $f) || die "mr: open $f: $!\n";
765         }
766         my @lines=<$in>;
767         close $in;
768
769         my $section;
770         my $line=0;
771         while (@lines) {
772                 $_=shift @lines;
773                 $line++;
774                 chomp;
775                 next if /^\s*\#/ || /^\s*$/;
776                 if (/^\[([^\]]*)\]\s*$/) {
777                         $section=$1;
778                 }
779                 elsif (/^(\w+)\s*=\s*(.*)/) {
780                         my $parameter=$1;
781                         my $value=$2;
782
783                         # continued value
784                         while (@lines && $lines[0]=~/^\s(.+)/) {
785                                 shift(@lines);
786                                 $line++;
787                                 $value.="\n$1";
788                                 chomp $value;
789                         }
790
791                         if ($parameter eq "include") {
792                                 print "mr: including output of \"$value\"\n" if $verbose;
793                                 unshift @lines, `$value`;
794                                 next;
795                         }
796
797                         if (! defined $section) {
798                                 die "$f line $.: parameter ($parameter) not in section\n";
799                         }
800                         if ($section ne 'ALIAS' &&
801                             ! exists $config{$dir}{$section} &&
802                             exists $config{$dir}{DEFAULT}) {
803                                 # copy in defaults
804                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
805                         }
806                         if ($section eq 'ALIAS') {
807                                 $alias{$parameter}=$value;
808                         }
809                         elsif ($parameter eq 'lib') {
810                                 $config{$dir}{$section}{lib}.=$value."\n";
811                         }
812                         else {
813                                 $config{$dir}{$section}{$parameter}=$value;
814                                 if ($parameter =~ /.*_(.*)/) {
815                                         $knownactions{$1}=1;
816                                 }
817                                 else {
818                                         $knownactions{$parameter}=1;
819                                 }
820                                 if ($parameter eq 'chain' &&
821                                     length $dir && $section ne "DEFAULT" &&
822                                     -e $dir.$section."/.mrconfig") {
823                                         my $ret=system($value);
824                                         if ($ret != 0) {
825                                                 if (($? & 127) == 2) {
826                                                         print STDERR "mr $action: chain test interrupted\n";
827                                                         exit 2;
828                                                 }
829                                                 elsif ($? & 127) {
830                                                         print STDERR "mr $action: chain test received signal ".($? & 127)."\n";
831                                                 }
832                                         }
833                                         else {
834                                                 push @toload, $dir.$section."/.mrconfig";
835                                         }
836                                 }
837                         }
838                 }
839                 else {
840                         die "$f line $line: parse error\n";
841                 }
842         }
843
844         foreach (@toload) {
845                 loadconfig($_);
846         }
847 } #}}}
848
849 sub modifyconfig { #{{{
850         my $f=shift;
851         # the section to modify or add
852         my $targetsection=shift;
853         # fields to change in the section
854         # To remove a field, set its value to "".
855         my %changefields=@_;
856
857         my @lines;
858         my @out;
859
860         if (-e $f) {
861                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
862                 @lines=<$in>;
863                 close $in;
864         }
865
866         my $formatfield=sub {
867                 my $field=shift;
868                 my @value=split(/\n/, shift);
869
870                 return "$field = ".shift(@value)."\n".
871                         join("", map { "\t$_\n" } @value);
872         };
873         my $addfields=sub {
874                 my @blanks;
875                 while ($out[$#out] =~ /^\s*$/) {
876                         unshift @blanks, pop @out;
877                 }
878                 foreach my $field (sort keys %changefields) {
879                         if (length $changefields{$field}) {
880                                 push @out, "$field = $changefields{$field}\n";
881                                 delete $changefields{$field};
882                         }
883                 }
884                 push @out, @blanks;
885         };
886
887         my $section;
888         while (@lines) {
889                 $_=shift(@lines);
890
891                 if (/^\s*\#/ || /^\s*$/) {
892                         push @out, $_;
893                 }
894                 elsif (/^\[([^\]]*)\]\s*$/) {
895                         if (defined $section && 
896                             $section eq $targetsection) {
897                                 $addfields->();
898                         }
899
900                         $section=$1;
901
902                         push @out, $_;
903                 }
904                 elsif (/^(\w+)\s*=\s(.*)/) {
905                         my $parameter=$1;
906                         my $value=$2;
907
908                         # continued value
909                         while (@lines && $lines[0]=~/^\s(.+)/) {
910                                 shift(@lines);
911                                 $value.="\n$1";
912                                 chomp $value;
913                         }
914
915                         if ($section eq $targetsection) {
916                                 if (exists $changefields{$parameter}) {
917                                         if (length $changefields{$parameter}) {
918                                                 $value=$changefields{$parameter};
919                                         }
920                                         delete $changefields{$parameter};
921                                 }
922                         }
923
924                         push @out, $formatfield->($parameter, $value);
925                 }
926         }
927
928         if (defined $section && 
929             $section eq $targetsection) {
930                 $addfields->();
931         }
932         elsif (%changefields) {
933                 push @out, "\n[$targetsection]\n";
934                 foreach my $field (sort keys %changefields) {
935                         if (length $changefields{$field}) {
936                                 push @out, $formatfield->($field, $changefields{$field});
937                         }
938                 }
939         }
940
941         open(my $out, ">", $f) || die "mr: write $f: $!\n";
942         print $out @out;
943         close $out;     
944 } #}}}
945         
946 sub help { #{{{
947         exec($config{''}{DEFAULT}{$action}) || die "exec: $!";
948 } #}}}
949         
950 sub config { #{{{
951         if (@_ < 2) {
952                 die "mr config: not enough parameters\n";
953         }
954         my $section=shift;
955         if ($section=~/^\//) {
956                 # try to convert to a path relative to the config file
957                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
958                 $dir=abs_path($dir);
959                 $dir.="/" unless $dir=~/\/$/;
960                 if ($section=~/^\Q$dir\E(.*)/) {
961                         $section=$1;
962                 }
963         }
964         my %changefields;
965         foreach (@_) {
966                 if (/^([^=]+)=(.*)$/) {
967                         $changefields{$1}=$2;
968                 }
969                 else {
970                         my $found=0;
971                         foreach my $topdir (sort keys %config) {
972                                 if (exists $config{$topdir}{$section} &&
973                                     exists $config{$topdir}{$section}{$_}) {
974                                         print $config{$topdir}{$section}{$_}."\n";
975                                         $found=1;
976                                         last if $section eq 'DEFAULT';
977                                 }
978                         }
979                         if (! $found) {
980                                 die "mr $action: $section $_ not set\n";
981                         }
982                 }
983         }
984         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
985         exit 0;
986 } #}}}
987
988 sub register { #{{{
989         if (! $config_overridden) {
990                 # Find the closest known mrconfig file to the current
991                 # directory.
992                 $directory.="/" unless $directory=~/\/$/;
993                 foreach my $topdir (reverse sort keys %config) {
994                         next unless length $topdir;
995                         if ($directory=~/^\Q$topdir\E/) {
996                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
997                                 $directory=$topdir;
998                                 last;
999                         }
1000                 }
1001         }
1002         if (@ARGV) {
1003                 my $subdir=shift @ARGV;
1004                 if (! chdir($subdir)) {
1005                         print STDERR "mr $action: failed to chdir to $subdir: $!\n";
1006                 }
1007         }
1008
1009         $ENV{MR_REPO}=getcwd();
1010         my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT');
1011         if (! defined $command) {
1012                 die "mr $action: unknown repository type\n";
1013         }
1014
1015         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
1016         $command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
1017                 "my_action(){ $command\n }; my_action ".
1018                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
1019         print "mr $action: running >>$command<<\n" if $verbose;
1020         exec($command) || die "exec: $!";
1021 } #}}}
1022
1023 # alias expansion and command stemming
1024 sub expandaction { #{{{
1025         my $action=shift;
1026         if (exists $alias{$action}) {
1027                 $action=$alias{$action};
1028         }
1029         if (! exists $knownactions{$action}) {
1030                 my @matches = grep { /^\Q$action\E/ }
1031                         keys %knownactions, keys %alias;
1032                 if (@matches == 1) {
1033                         $action=$matches[0];
1034                 }
1035                 elsif (@matches == 0) {
1036                         die "mr: unknown action \"$action\" (known actions: ".
1037                                 join(", ", sort keys %knownactions).")\n";
1038                 }
1039                 else {
1040                         die "mr: ambiguous action \"$action\" (matches: ".
1041                                 join(", ", @matches).")\n";
1042                 }
1043         }
1044         return $action;
1045 } #}}}
1046
1047 sub getopts { #{{{
1048         Getopt::Long::Configure("no_permute");
1049         my $result=GetOptions(
1050                 "d|directory=s" => sub { $directory=abs_path($_[1]) },
1051                 "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
1052                 "v|verbose" => \$verbose,
1053                 "s|stats" => \$stats,
1054                 "n|no-recurse" => \$no_recurse,
1055                 "j|jobs=i" => \$jobs,
1056         );
1057         if (! $result || @ARGV < 1) {
1058                 die("Usage: mr [-d directory] action [params ...]\n".
1059                     "(Use mr help for man page.)\n");
1060         }
1061 } #}}}
1062
1063 # Finally, some useful actions that mr knows about by default.
1064 # These can be overridden in ~/.mrconfig.
1065 #DATA{{{
1066 __DATA__
1067 [ALIAS]
1068 co = checkout
1069 ci = commit
1070 ls = list
1071
1072 [DEFAULT]
1073 order = 10
1074 lib =
1075         error() {
1076                 echo "mr: $@" >&2
1077                 exit 1
1078         }
1079         warning() {
1080                 echo "mr (warning): $@" >&2
1081         }
1082         info() {
1083                 echo "mr: $@" >&2
1084         }
1085         hours_since() {
1086                 if [ -z "$1" ] || [ -z "$2" ]; then
1087                         error "mr: usage: hours_since action num"
1088                 fi
1089                 for dir in .git .svn .bzr CVS .hg _darcs; do
1090                         if [ -e "$MR_REPO/$dir" ]; then
1091                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1092                                 break
1093                         fi
1094                 done
1095                 if [ -z "$flagfile" ]; then
1096                         error "cannot determine flag filename"
1097                 fi
1098                 delta=$(perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile")
1099                 if [ "$delta" -lt "$2" ]; then
1100                         exit 0
1101                 else
1102                         touch "$flagfile"
1103                         exit 1
1104                 fi
1105         }
1106
1107 svn_test = test -d "$MR_REPO"/.svn
1108 git_test = test -d "$MR_REPO"/.git
1109 bzr_test = test -d "$MR_REPO"/.bzr
1110 cvs_test = test -d "$MR_REPO"/CVS
1111 hg_test  = test -d "$MR_REPO"/.hg
1112 darcs_test = test -d "$MR_REPO"/_darcs
1113 git_bare_test =
1114         test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
1115         test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
1116         test "$(GIT_CONFIG="$MR_REPO"/config git-config --get core.bare)" = true
1117
1118 svn_update = svn update "$@"
1119 git_update = if [ "$@" ]; then git pull "$@"; else git pull -t origin master; fi
1120 bzr_update = bzr merge "$@"
1121 cvs_update = cvs update "$@"
1122 hg_update  = hg pull "$@" && hg update "$@"
1123 darcs_update = darcs pull -a "$@"
1124
1125 svn_status = svn status "$@"
1126 git_status = git status "$@" || true
1127 bzr_status = bzr status "$@"
1128 cvs_status = cvs status "$@"
1129 hg_status  = hg status "$@"
1130 darcs_status = darcs whatsnew -ls "$@"
1131
1132 svn_commit = svn commit "$@"
1133 git_commit = git commit -a "$@" && git push --all
1134 bzr_commit = bzr commit "$@" && bzr push
1135 cvs_commit = cvs commit "$@"
1136 hg_commit  = hg commit -m "$@" && hg push
1137 darcs_commit = darcs commit -a -m "$@" && darcs push -a
1138
1139 svn_diff = svn diff "$@"
1140 git_diff = git diff "$@"
1141 bzr_diff = bzr diff "$@"
1142 cvs_diff = cvs diff "$@"
1143 hg_diff  = hg diff "$@"
1144 darcs_diff = darcs diff "$@"
1145
1146 svn_log = svn log "$@"
1147 git_log = git log "$@"
1148 bzr_log = bzr log "$@"
1149 cvs_log = cvs log "$@"
1150 hg_log  = hg log "$@"
1151 darcs_log = darcs changes "$@"
1152 git_bare_log = git log "$@"
1153
1154 svn_register =
1155         url=$(LANG=C svn info . | grep -i ^URL: | cut -d ' ' -f 2)
1156         if [ -z "$url" ]; then
1157                 error "cannot determine svn url"
1158         fi
1159         echo "Registering svn url: $url in $MR_CONFIG"
1160         mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
1161 git_register = 
1162         url="$(LANG=C git-config --get remote.origin.url)" || true
1163         if [ -z "$url" ]; then
1164                 error "cannot determine git url"
1165         fi
1166         echo "Registering git url: $url in $MR_CONFIG"
1167         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone '$url' '$MR_REPO'"
1168 bzr_register =
1169         url=$(cat .bzr/branch/parent)
1170         if [ -z "$url" ]; then
1171                 error "cannot determine bzr url"
1172         fi
1173         echo "Registering bzr url: $url in $MR_CONFIG"
1174         mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr clone '$url' '$MR_REPO'"
1175 cvs_register =
1176         repo=$(cat CVS/Repository)
1177         root=$(cat CVS/Root)
1178         if [ -z "$root" ]; then
1179                 error "cannot determine cvs root"
1180                 fi
1181         echo "Registering cvs repository $repo at root $root"
1182         mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
1183 hg_register = 
1184         url=$(hg showconfig paths.default)
1185         echo "Registering mercurial repo url: $url in $MR_CONFIG"
1186         mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone '$url' '$MR_REPO'"
1187 darcs_register = 
1188         url=$(cat _darcs/prefs/defaultrepo)
1189         echo "Registering darcs repository $url in $MR_CONFIG"
1190         mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get '$url'p '$MR_REPO'"
1191 git_bare_register = 
1192         url="$(LANG=C GIT_CONFIG=config git-config --get remote.origin.url)" || true
1193         if [ -z "$url" ]; then
1194                 error "cannot determine git url"
1195         fi
1196         echo "Registering git url: $url in $MR_CONFIG"
1197         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
1198
1199 help =
1200         if [ ! -e "$MR_PATH" ]; then
1201                 error "cannot find program path"
1202         fi
1203         (pod2man -c mr "$MR_PATH" | man -l -) || error "pod2man or man failed"
1204 list = true
1205 config = 
1206
1207 ed = echo "A horse is a horse, of course, of course.."
1208 T = echo "I pity the fool."
1209 right = echo "Not found."
1210 #}}}
1211
1212 # vim:sw=8:sts=0:ts=8:noet