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

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