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

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