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

Merge commit 'madduck/master'
[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 use POSIX "WNOHANG";
300 use constant {
301         OK => 0,
302         FAILED => 1,
303         SKIPPED => 2,
304         ABORT => 3,
305 };
306
307 $SIG{INT}=sub {
308         print STDERR "mr: interrupted\n";
309         exit 2;
310 };
311
312 $ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
313 my $config_overridden=0;
314 my $verbose=0;
315 my $stats=0;
316 my $no_recurse=0;
317 my $no_chdir=0;
318 my $jobs=1;
319 my %config;
320 my %configfiles;
321 my %knownactions;
322 my %alias;
323 my $directory=getcwd();
324 my (@ok, @failed, @skipped);
325
326 getopts();
327
328 # This can happen if it's run in a directory that was removed
329 # or other strangeness.
330 if (! defined $directory) {
331         die("mr: failed to determine working directory\n");
332 }
333 # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
334 # the config file might be a symlink to elsewhere, and the directory it's
335 # in is significant.
336 if ($ENV{MR_CONFIG} !~ /^\//) {
337         $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
338 }
339 # Try to set MR_PATH to the path to the program.
340 eval {
341         use FindBin qw($Bin $Script);
342         $ENV{MR_PATH}=$Bin."/".$Script;
343 };
344
345 loadconfig(\*DATA);
346 loadconfig($ENV{MR_CONFIG});
347 #use Data::Dumper;
348 #print Dumper(\%config);
349
350 my $action=expandaction(shift @ARGV);
351 dispatch($action);
352 showstats($action);
353
354 if (@failed) {
355         exit 1;
356 }
357 elsif (! @ok && @skipped) {
358         exit 1;
359 }
360 else {
361         exit 0;
362 }
363
364 sub dispatch { #{{{
365         my $action=shift;
366
367         # actions that do not operate on all repos
368         if ($action eq 'help') {
369                 help(@ARGV);
370         }
371         elsif ($action eq 'config') {
372                 config(@ARGV);
373         }
374         elsif ($action eq 'register') {
375                 register(@ARGV);
376         }
377
378         if ($jobs > 1) {
379                 mrs($action, selectrepos());
380         }
381         else {
382                 foreach my $repo (selectrepos()) {
383                         record($repo, action($action, @$repo));
384                 }
385         }
386 } #}}}
387
388 sub rcs_test { #{{{
389         my ($action, $dir, $topdir, $subdir) = @_;
390
391         my $test="set -e\n";
392         foreach my $rcs_test (
393                         sort {
394                                 length $a <=> length $b 
395                                           ||
396                                        $a cmp $b
397                         } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
398                 my ($rcs)=$rcs_test=~/(.*)_test/;
399                 $test="my_$rcs_test() {\n$config{$topdir}{$subdir}{$rcs_test}\n}\n".$test;
400                 $test.="if my_$rcs_test; then echo $rcs; fi\n";
401         }
402         $test=$config{$topdir}{$subdir}{lib}."\n".$test
403                 if exists $config{$topdir}{$subdir}{lib};
404         
405         print "mr $action: running rcs test >>$test<<\n" if $verbose;
406         my $rcs=`$test`;
407         chomp $rcs;
408         if (! length $rcs) {
409                 return undef;
410         }
411         else {
412                 return $rcs;
413         }
414 } #}}}
415         
416 sub findcommand { #{{{
417         my ($action, $dir, $topdir, $subdir) = @_;
418         
419         if (exists $config{$topdir}{$subdir}{$action}) {
420                 return $config{$topdir}{$subdir}{$action};
421         }
422
423         my $rcs=rcs_test(@_);
424
425         if (defined $rcs && 
426             exists $config{$topdir}{$subdir}{$rcs."_".$action}) {
427                 return $config{$topdir}{$subdir}{$rcs."_".$action};
428         }
429         else {
430                 return undef;
431         }
432 } #}}}
433
434 sub action { #{{{
435         my ($action, $dir, $topdir, $subdir) = @_;
436
437         $ENV{MR_CONFIG}=$configfiles{$topdir};
438         my $lib=exists $config{$topdir}{$subdir}{lib} ?
439                        $config{$topdir}{$subdir}{lib}."\n" : "";
440
441         if ($action eq 'checkout') {
442                 if (-d $dir) {
443                         print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
444                         return SKIPPED;
445                 }
446
447                 $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
448
449                 if (! -d $dir) {
450                         print "mr $action: creating parent directory $dir\n" if $verbose;
451                         system("mkdir", "-p", $dir);
452                 }
453         }
454         elsif ($action =~ /update/) {
455                 if (! -d $dir) {
456                         return action("checkout", $dir, $topdir, $subdir);
457                 }
458         }
459
460         $ENV{MR_REPO}=$dir;
461
462         my $skiptest=findcommand("skip", $dir, $topdir, $subdir);
463         my $command=findcommand($action, $dir, $topdir, $subdir);
464
465         if (defined $skiptest) {
466                 my $test="set -e;".$lib.
467                         "my_action(){ $skiptest\n }; my_action '$action'";
468                 print "mr $action: running skip test >>$test<<\n" if $verbose;
469                 my $ret=system($test);
470                 if ($ret != 0) {
471                         if (($? & 127) == 2) {
472                                 print STDERR "mr $action: interrupted\n";
473                                 return ABORT;
474                         }
475                         elsif ($? & 127) {
476                                 print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
477                                 return ABORT;
478                         }
479                 }
480                 if ($ret >> 8 == 0) {
481                         print "mr $action: $dir skipped per config file\n" if $verbose;
482                         return SKIPPED;
483                 }
484         }
485         
486         if (! $no_chdir && ! chdir($dir)) {
487                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
488                 return FAILED;
489         }
490         elsif (! defined $command) {
491                 my $rcs=rcs_test(@_);
492                 if (! defined $rcs) {
493                         print STDERR "mr $action: unknown repository type and no defined $action command for $topdir$subdir\n";
494                         return FAILED;
495                 }
496                 else {
497                         print STDERR "mr $action: no defined $action command for $rcs repository $topdir$subdir, skipping\n";
498                         return SKIPPED;
499                 }
500         }
501         else {
502                 if (! $no_chdir) {
503                         print "mr $action: $topdir$subdir\n";
504                 }
505                 else {
506                         my $s=$directory;
507                         $s=~s/^\Q$topdir$subdir\E\/?//;
508                         print "mr $action: $topdir$subdir (in subdir $s)\n";
509                 }
510                 $command="set -e; ".$lib.
511                         "my_action(){ $command\n }; my_action ".
512                         join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
513                 print "mr $action: running >>$command<<\n" if $verbose;
514                 my $ret=system($command);
515                 if ($ret != 0) {
516                         if (($? & 127) == 2) {
517                                 print STDERR "mr $action: interrupted\n";
518                                 return ABORT;
519                         }
520                         elsif ($? & 127) {
521                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
522                                 return ABORT;
523                         }
524                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
525                         if ($ret >> 8 != 0) {
526                                 print STDERR "mr $action: command failed\n";
527                         }
528                         elsif ($ret != 0) {
529                                 print STDERR "mr $action: command died ($ret)\n";
530                         }
531                         return FAILED;
532                 }
533                 else {
534                         if ($action eq 'checkout' && ! -d $dir) {
535                                 print STDERR "mr $action: $dir missing after checkout\n";;
536                                 return FAILED;
537                         }
538
539                         return OK;
540                 }
541         }
542 } #}}}
543
544 # run actions on multiple repos, in parallel
545 sub mrs { #{{{
546         my $action=shift;
547         my @repos=@_;
548
549         $| = 1;
550         my @active;
551         my @fhs;
552         my @out;
553         my $running=0;
554         while (@fhs or @repos) {
555                 while ($running < $jobs && @repos) {
556                         $running++;
557                         my $repo = shift @repos;
558                         pipe(my $outfh, CHILD_STDOUT);
559                         pipe(my $errfh, CHILD_STDERR);
560                         my $pid;
561                         unless ($pid = fork) {
562                                 die "mr $action: cannot fork: $!" unless defined $pid;
563                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
564                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
565                                 close CHILD_STDOUT;
566                                 close CHILD_STDERR;
567                                 close $outfh;
568                                 close $errfh;
569                                 exit action($action, @$repo);
570                         }
571                         close CHILD_STDOUT;
572                         close CHILD_STDERR;
573                         push @active, [$pid, $repo];
574                         push @fhs, [$outfh, $errfh];
575                         push @out, ['',     ''];
576                 }
577                 my ($rin, $rout) = ('','');
578                 my $nfound;
579                 foreach my $fh (@fhs) {
580                         next unless defined $fh;
581                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
582                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
583                 }
584                 $nfound = select($rout=$rin, undef, undef, 1);
585                 foreach my $channel (0, 1) {
586                         foreach my $i (0..$#fhs) {
587                                 next unless defined $fhs[$i];
588                                 my $fh = $fhs[$i][$channel];
589                                 next unless defined $fh;
590                                 if (vec($rout, fileno($fh), 1) == 1) {
591                                         my $r = '';
592                                         if (sysread($fh, $r, 1024) == 0) {
593                                                 close($fh);
594                                                 $fhs[$i][$channel] = undef;
595                                                 if (! defined $fhs[$i][0] &&
596                                                     ! defined $fhs[$i][1]) {
597                                                         waitpid($active[$i][0], 0);
598                                                         print STDOUT $out[$i][0];
599                                                         print STDERR $out[$i][1];
600                                                         record($active[$i][1], $? >> 8);
601                                                         splice(@fhs, $i, 1);
602                                                         splice(@active, $i, 1);
603                                                         splice(@out, $i, 1);
604                                                         $running--;
605                                                 }
606                                         }
607                                         $out[$i][$channel] .= $r;
608                                 }
609                         }
610                 }
611         }
612 } #}}}
613
614 sub record { #{{{
615         my $dir=shift()->[0];
616         my $ret=shift;
617
618         if ($ret == OK) {
619                 push @ok, $dir;
620                 print "\n";
621         }
622         elsif ($ret == FAILED) {
623                 push @failed, $dir;
624                 print "\n";
625         }
626         elsif ($ret == SKIPPED) {
627                 push @skipped, $dir;
628         }
629         elsif ($ret == ABORT) {
630                 exit 1;
631         }
632         else {
633                 die "unknown exit status $ret";
634         }
635 } #}}}
636
637 sub showstats { #{{{
638         if (! @ok && ! @failed && ! @skipped) {
639                 die "mr $action: no repositories found to work on\n";
640         }
641         print "mr $action: finished (".join("; ",
642                 showstat($#ok+1, "ok", "ok"),
643                 showstat($#failed+1, "failed", "failed"),
644                 showstat($#skipped+1, "skipped", "skipped"),
645         ).")\n";
646         if ($stats) {
647                 if (@skipped) {
648                         print "mr $action: (skipped: ".join(" ", @skipped).")\n";
649                 }
650                 if (@failed) {
651                         print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
652                 }
653         }
654 } #}}}
655
656 sub showstat { #{{{
657         my $count=shift;
658         my $singular=shift;
659         my $plural=shift;
660         if ($count) {
661                 return "$count ".($count > 1 ? $plural : $singular);
662         }
663         return;
664 } #}}}
665
666 # an ordered list of repos
667 sub repolist { #{{{
668         my @list;
669         foreach my $topdir (sort keys %config) {
670                 foreach my $subdir (sort keys %{$config{$topdir}}) {
671                         push @list, {
672                                 topdir => $topdir,
673                                 subdir => $subdir,
674                                 order => $config{$topdir}{$subdir}{order},
675                         };
676                 }
677         }
678         return sort {
679                 $a->{order}  <=> $b->{order}
680                              ||
681                 $a->{topdir} cmp $b->{topdir}
682                              ||
683                 $a->{subdir} cmp $b->{subdir}
684         } @list;
685 } #}}}
686
687 # figure out which repos to act on
688 sub selectrepos { #{{{
689         my @repos;
690         foreach my $repo (repolist()) {
691                 my $topdir=$repo->{topdir};
692                 my $subdir=$repo->{subdir};
693
694                 next if $subdir eq 'DEFAULT';
695                 my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
696                 my $d=$directory;
697                 $dir.="/" unless $dir=~/\/$/;
698                 $d.="/" unless $d=~/\/$/;
699                 next if $no_recurse && $d ne $dir;
700                 next if $dir ne $d && $dir !~ /^\Q$d\E/;
701                 push @repos, [$dir, $topdir, $subdir];
702         }
703         if (! @repos) {
704                 # fallback to find a leaf repo
705                 foreach my $repo (reverse repolist()) {
706                         my $topdir=$repo->{topdir};
707                         my $subdir=$repo->{subdir};
708                         
709                         next if $subdir eq 'DEFAULT';
710                         my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
711                         my $d=$directory;
712                         $dir.="/" unless $dir=~/\/$/;
713                         $d.="/" unless $d=~/\/$/;
714                         if ($d=~/^\Q$dir\E/) {
715                                 push @repos, [$dir, $topdir, $subdir];
716                                 last;
717                         }
718                 }
719                 $no_chdir=1;
720         }
721         return @repos;
722 } #}}}
723
724 my %loaded;
725 sub loadconfig { #{{{
726         my $f=shift;
727
728         my @toload;
729
730         my $in;
731         my $dir;
732         if (ref $f eq 'GLOB') {
733                 $dir="";
734                 $in=$f; 
735         }
736         else {
737                 if (! -e $f) {
738                         return;
739                 }
740
741                 my $absf=abs_path($f);
742                 if ($loaded{$absf}) {
743                         return;
744                 }
745                 $loaded{$absf}=1;
746
747                 ($dir)=$f=~/^(.*\/)[^\/]+$/;
748                 if (! defined $dir) {
749                         $dir=".";
750                 }
751                 $dir=abs_path($dir)."/";
752                 
753                 if (! exists $configfiles{$dir}) {
754                         $configfiles{$dir}=$f;
755                 }
756
757                 # copy in defaults from first parent
758                 my $parent=$dir;
759                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
760                         if ($parent eq '/') {
761                                 $parent="";
762                         }
763                         if (exists $config{$parent} &&
764                             exists $config{$parent}{DEFAULT}) {
765                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
766                                 last;
767                         }
768                 }
769                 
770                 print "mr: loading config $f\n" if $verbose;
771                 open($in, "<", $f) || die "mr: open $f: $!\n";
772         }
773         my @lines=<$in>;
774         close $in;
775
776         my $section;
777         my $line=0;
778         while (@lines) {
779                 $_=shift @lines;
780                 $line++;
781                 chomp;
782                 next if /^\s*\#/ || /^\s*$/;
783                 if (/^\[([^\]]*)\]\s*$/) {
784                         $section=$1;
785                 }
786                 elsif (/^(\w+)\s*=\s*(.*)/) {
787                         my $parameter=$1;
788                         my $value=$2;
789
790                         # continued value
791                         while (@lines && $lines[0]=~/^\s(.+)/) {
792                                 shift(@lines);
793                                 $line++;
794                                 $value.="\n$1";
795                                 chomp $value;
796                         }
797
798                         if ($parameter eq "include") {
799                                 print "mr: including output of \"$value\"\n" if $verbose;
800                                 unshift @lines, `$value`;
801                                 next;
802                         }
803
804                         if (! defined $section) {
805                                 die "$f line $.: parameter ($parameter) not in section\n";
806                         }
807                         if ($section ne 'ALIAS' &&
808                             ! exists $config{$dir}{$section} &&
809                             exists $config{$dir}{DEFAULT}) {
810                                 # copy in defaults
811                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
812                         }
813                         if ($section eq 'ALIAS') {
814                                 $alias{$parameter}=$value;
815                         }
816                         elsif ($parameter eq 'lib') {
817                                 $config{$dir}{$section}{lib}.=$value."\n";
818                         }
819                         else {
820                                 $config{$dir}{$section}{$parameter}=$value;
821                                 if ($parameter =~ /.*_(.*)/) {
822                                         $knownactions{$1}=1;
823                                 }
824                                 else {
825                                         $knownactions{$parameter}=1;
826                                 }
827                                 if ($parameter eq 'chain' &&
828                                     length $dir && $section ne "DEFAULT" &&
829                                     -e $dir.$section."/.mrconfig") {
830                                         my $ret=system($value);
831                                         if ($ret != 0) {
832                                                 if (($? & 127) == 2) {
833                                                         print STDERR "mr $action: chain test interrupted\n";
834                                                         exit 2;
835                                                 }
836                                                 elsif ($? & 127) {
837                                                         print STDERR "mr $action: chain test received signal ".($? & 127)."\n";
838                                                 }
839                                         }
840                                         else {
841                                                 push @toload, $dir.$section."/.mrconfig";
842                                         }
843                                 }
844                         }
845                 }
846                 else {
847                         die "$f line $line: parse error\n";
848                 }
849         }
850
851         foreach (@toload) {
852                 loadconfig($_);
853         }
854 } #}}}
855
856 sub modifyconfig { #{{{
857         my $f=shift;
858         # the section to modify or add
859         my $targetsection=shift;
860         # fields to change in the section
861         # To remove a field, set its value to "".
862         my %changefields=@_;
863
864         my @lines;
865         my @out;
866
867         if (-e $f) {
868                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
869                 @lines=<$in>;
870                 close $in;
871         }
872
873         my $formatfield=sub {
874                 my $field=shift;
875                 my @value=split(/\n/, shift);
876
877                 return "$field = ".shift(@value)."\n".
878                         join("", map { "\t$_\n" } @value);
879         };
880         my $addfields=sub {
881                 my @blanks;
882                 while ($out[$#out] =~ /^\s*$/) {
883                         unshift @blanks, pop @out;
884                 }
885                 foreach my $field (sort keys %changefields) {
886                         if (length $changefields{$field}) {
887                                 push @out, "$field = $changefields{$field}\n";
888                                 delete $changefields{$field};
889                         }
890                 }
891                 push @out, @blanks;
892         };
893
894         my $section;
895         while (@lines) {
896                 $_=shift(@lines);
897
898                 if (/^\s*\#/ || /^\s*$/) {
899                         push @out, $_;
900                 }
901                 elsif (/^\[([^\]]*)\]\s*$/) {
902                         if (defined $section && 
903                             $section eq $targetsection) {
904                                 $addfields->();
905                         }
906
907                         $section=$1;
908
909                         push @out, $_;
910                 }
911                 elsif (/^(\w+)\s*=\s(.*)/) {
912                         my $parameter=$1;
913                         my $value=$2;
914
915                         # continued value
916                         while (@lines && $lines[0]=~/^\s(.+)/) {
917                                 shift(@lines);
918                                 $value.="\n$1";
919                                 chomp $value;
920                         }
921
922                         if ($section eq $targetsection) {
923                                 if (exists $changefields{$parameter}) {
924                                         if (length $changefields{$parameter}) {
925                                                 $value=$changefields{$parameter};
926                                         }
927                                         delete $changefields{$parameter};
928                                 }
929                         }
930
931                         push @out, $formatfield->($parameter, $value);
932                 }
933         }
934
935         if (defined $section && 
936             $section eq $targetsection) {
937                 $addfields->();
938         }
939         elsif (%changefields) {
940                 push @out, "\n[$targetsection]\n";
941                 foreach my $field (sort keys %changefields) {
942                         if (length $changefields{$field}) {
943                                 push @out, $formatfield->($field, $changefields{$field});
944                         }
945                 }
946         }
947
948         open(my $out, ">", $f) || die "mr: write $f: $!\n";
949         print $out @out;
950         close $out;     
951 } #}}}
952         
953 sub help { #{{{
954         exec($config{''}{DEFAULT}{$action}) || die "exec: $!";
955 } #}}}
956         
957 sub config { #{{{
958         if (@_ < 2) {
959                 die "mr config: not enough parameters\n";
960         }
961         my $section=shift;
962         if ($section=~/^\//) {
963                 # try to convert to a path relative to the config file
964                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
965                 $dir=abs_path($dir);
966                 $dir.="/" unless $dir=~/\/$/;
967                 if ($section=~/^\Q$dir\E(.*)/) {
968                         $section=$1;
969                 }
970         }
971         my %changefields;
972         foreach (@_) {
973                 if (/^([^=]+)=(.*)$/) {
974                         $changefields{$1}=$2;
975                 }
976                 else {
977                         my $found=0;
978                         foreach my $topdir (sort keys %config) {
979                                 if (exists $config{$topdir}{$section} &&
980                                     exists $config{$topdir}{$section}{$_}) {
981                                         print $config{$topdir}{$section}{$_}."\n";
982                                         $found=1;
983                                         last if $section eq 'DEFAULT';
984                                 }
985                         }
986                         if (! $found) {
987                                 die "mr $action: $section $_ not set\n";
988                         }
989                 }
990         }
991         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
992         exit 0;
993 } #}}}
994
995 sub register { #{{{
996         if (! $config_overridden) {
997                 # Find the closest known mrconfig file to the current
998                 # directory.
999                 $directory.="/" unless $directory=~/\/$/;
1000                 foreach my $topdir (reverse sort keys %config) {
1001                         next unless length $topdir;
1002                         if ($directory=~/^\Q$topdir\E/) {
1003                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
1004                                 $directory=$topdir;
1005                                 last;
1006                         }
1007                 }
1008         }
1009         if (@ARGV) {
1010                 my $subdir=shift @ARGV;
1011                 if (! chdir($subdir)) {
1012                         print STDERR "mr $action: failed to chdir to $subdir: $!\n";
1013                 }
1014         }
1015
1016         $ENV{MR_REPO}=getcwd();
1017         my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT');
1018         if (! defined $command) {
1019                 die "mr $action: unknown repository type\n";
1020         }
1021
1022         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
1023         $command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
1024                 "my_action(){ $command\n }; my_action ".
1025                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
1026         print "mr $action: running >>$command<<\n" if $verbose;
1027         exec($command) || die "exec: $!";
1028 } #}}}
1029
1030 # alias expansion and command stemming
1031 sub expandaction { #{{{
1032         my $action=shift;
1033         if (exists $alias{$action}) {
1034                 $action=$alias{$action};
1035         }
1036         if (! exists $knownactions{$action}) {
1037                 my @matches = grep { /^\Q$action\E/ }
1038                         keys %knownactions, keys %alias;
1039                 if (@matches == 1) {
1040                         $action=$matches[0];
1041                 }
1042                 elsif (@matches == 0) {
1043                         die "mr: unknown action \"$action\" (known actions: ".
1044                                 join(", ", sort keys %knownactions).")\n";
1045                 }
1046                 else {
1047                         die "mr: ambiguous action \"$action\" (matches: ".
1048                                 join(", ", @matches).")\n";
1049                 }
1050         }
1051         return $action;
1052 } #}}}
1053
1054 sub getopts { #{{{
1055         Getopt::Long::Configure("no_permute");
1056         my $result=GetOptions(
1057                 "d|directory=s" => sub { $directory=abs_path($_[1]) },
1058                 "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
1059                 "v|verbose" => \$verbose,
1060                 "s|stats" => \$stats,
1061                 "n|no-recurse" => \$no_recurse,
1062                 "j|jobs=i" => \$jobs,
1063         );
1064         if (! $result || @ARGV < 1) {
1065                 die("Usage: mr [-d directory] action [params ...]\n".
1066                     "(Use mr help for man page.)\n");
1067         }
1068 } #}}}
1069
1070 # Finally, some useful actions that mr knows about by default.
1071 # These can be overridden in ~/.mrconfig.
1072 #DATA{{{
1073 __DATA__
1074 [ALIAS]
1075 co = checkout
1076 ci = commit
1077 ls = list
1078
1079 [DEFAULT]
1080 order = 10
1081 lib =
1082         PWD="$(pwd)"
1083         error() {
1084                 echo "mr: $@" >&2
1085                 exit 1
1086         }
1087         warning() {
1088                 echo "mr (warning): $@" >&2
1089         }
1090         info() {
1091                 echo "mr: $@" >&2
1092         }
1093         hours_since() {
1094                 if [ -z "$1" ] || [ -z "$2" ]; then
1095                         error "mr: usage: hours_since action num"
1096                 fi
1097                 for dir in .git .svn .bzr CVS .hg _darcs; do
1098                         if [ -e "$MR_REPO/$dir" ]; then
1099                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1100                                 break
1101                         fi
1102                 done
1103                 if [ -z "$flagfile" ]; then
1104                         error "cannot determine flag filename"
1105                 fi
1106                 delta=$(perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile")
1107                 if [ "$delta" -lt "$2" ]; then
1108                         exit 0
1109                 else
1110                         touch "$flagfile"
1111                         exit 1
1112                 fi
1113         }
1114
1115 svn_test = test -d "$MR_REPO"/.svn
1116 git_test = test -d "$MR_REPO"/.git
1117 bzr_test = test -d "$MR_REPO"/.bzr
1118 cvs_test = test -d "$MR_REPO"/CVS
1119 hg_test  = test -d "$MR_REPO"/.hg
1120 darcs_test = test -d "$MR_REPO"/_darcs
1121 git_bare_test =
1122         test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
1123         test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
1124         test "$(GIT_CONFIG="$MR_REPO"/config git-config --get core.bare)" = true
1125
1126 svn_update = svn update "$@"
1127 git_update = if [ "$@" ]; then git pull "$@"; else git pull -t origin master; fi
1128 bzr_update = bzr merge "$@"
1129 cvs_update = cvs update "$@"
1130 hg_update  = hg pull "$@" && hg update "$@"
1131 darcs_update = darcs pull -a "$@"
1132
1133 svn_status = svn status "$@"
1134 git_status = git status "$@" || true
1135 bzr_status = bzr status "$@"
1136 cvs_status = cvs status "$@"
1137 hg_status  = hg status "$@"
1138 darcs_status = darcs whatsnew -ls "$@"
1139
1140 svn_commit = svn commit "$@"
1141 git_commit = git commit -a "$@" && git push --all
1142 bzr_commit = bzr commit "$@" && bzr push
1143 cvs_commit = cvs commit "$@"
1144 hg_commit  = hg commit -m "$@" && hg push
1145 darcs_commit = darcs commit -a -m "$@" && darcs push -a
1146
1147 svn_diff = svn diff "$@"
1148 git_diff = git diff "$@"
1149 bzr_diff = bzr diff "$@"
1150 cvs_diff = cvs diff "$@"
1151 hg_diff  = hg diff "$@"
1152 darcs_diff = darcs diff "$@"
1153
1154 svn_log = svn log "$@"
1155 git_log = git log "$@"
1156 bzr_log = bzr log "$@"
1157 cvs_log = cvs log "$@"
1158 hg_log  = hg log "$@"
1159 darcs_log = darcs changes "$@"
1160 git_bare_log = git log "$@"
1161
1162 svn_register =
1163         url=$(LANG=C svn info . | grep -i ^URL: | cut -d ' ' -f 2)
1164         if [ -z "$url" ]; then
1165                 error "cannot determine svn url"
1166         fi
1167         echo "Registering svn url: $url in $MR_CONFIG"
1168         mr -c "$MR_CONFIG" config "$PWD" checkout="svn co '$url' '$MR_REPO'"
1169 git_register = 
1170         url="$(LANG=C git-config --get remote.origin.url)" || true
1171         if [ -z "$url" ]; then
1172                 error "cannot determine git url"
1173         fi
1174         echo "Registering git url: $url in $MR_CONFIG"
1175         mr -c "$MR_CONFIG" config "$PWD" checkout="git clone '$url' '$MR_REPO'"
1176 bzr_register =
1177         url=$(cat .bzr/branch/parent)
1178         if [ -z "$url" ]; then
1179                 error "cannot determine bzr url"
1180         fi
1181         echo "Registering bzr url: $url in $MR_CONFIG"
1182         mr -c "$MR_CONFIG" config "$PWD" checkout="bzr clone '$url' '$MR_REPO'"
1183 cvs_register =
1184         repo=$(cat CVS/Repository)
1185         root=$(cat CVS/Root)
1186         if [ -z "$root" ]; then
1187                 error "cannot determine cvs root"
1188                 fi
1189         echo "Registering cvs repository $repo at root $root"
1190         mr -c "$MR_CONFIG" config "$PWD" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
1191 hg_register = 
1192         url=$(hg showconfig paths.default)
1193         echo "Registering mercurial repo url: $url in $MR_CONFIG"
1194         mr -c "$MR_CONFIG" config "$PWD" checkout="hg clone '$url' '$MR_REPO'"
1195 darcs_register = 
1196         url=$(cat _darcs/prefs/defaultrepo)
1197         echo "Registering darcs repository $url in $MR_CONFIG"
1198         mr -c "$MR_CONFIG" config "$PWD" checkout="darcs get '$url'p '$MR_REPO'"
1199 git_bare_register = 
1200         url="$(LANG=C GIT_CONFIG=config git-config --get remote.origin.url)" || true
1201         if [ -z "$url" ]; then
1202                 error "cannot determine git url"
1203         fi
1204         echo "Registering git url: $url in $MR_CONFIG"
1205         mr -c "$MR_CONFIG" config "$PWD" checkout="git clone --bare '$url' '$MR_REPO'"
1206
1207 help =
1208         if [ ! -e "$MR_PATH" ]; then
1209                 error "cannot find program path"
1210         fi
1211         (pod2man -c mr "$MR_PATH" | man -l -) || error "pod2man or man failed"
1212 list = true
1213 config = 
1214
1215 ed = echo "A horse is a horse, of course, of course.."
1216 T = echo "I pity the fool."
1217 right = echo "Not found."
1218 #}}}
1219
1220 # vim:sw=8:sts=0:ts=8:noet