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

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