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

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