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

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