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

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