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

Fix fake-bare worktree checkout
[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. The "MR_CONFIG" environment variable is set to the .mrconfig file
213 that defines the repo being acted on, or, if the repo is not yet in a config
214 file, the .mrconfig file that should be modified to register the repo.
215
216 A few parameters have special meanings:
217
218 =over 4
219
220 =item skip
221
222 If the "skip" parameter is set and its command returns true, then B<mr>
223 will skip acting on that repository. The command is passed the action
224 name in $1.
225
226 Here are two examples. The first skips the repo unless
227 mr is run by joey. The second uses the hours_since function
228 (included in mr's built-in library) to skip updating the repo unless it's
229 been at least 12 hours since the last update.
230
231   skip = test $(whoami) != joey
232   skip = [ "$1" = update ] && ! hours_since "$1" 12
233
234 =item order
235
236 The "order" parameter can be used to override the default ordering of
237 repositories. The default order value is 10. Use smaller values to make
238 repositories be processed earlier, and larger values to make repositories
239 be processed later.
240
241 Note that if a repository is located in a subdirectory of another
242 repository, ordering it to be processed earlier is not recommended.
243
244 =item chain
245
246 If the "chain" parameter is set and its command returns true, then B<mr>
247 will try to load a .mrconfig file from the root of the repository. (You
248 should avoid chaining from repositories with untrusted committers.)
249
250 =item lib
251
252 The "lib" parameter can specify some shell code that will be run before each
253 command, this can be a useful way to define shell functions for other commands
254 to use.
255
256 =back
257
258 =head1 AUTHOR
259
260 Copyright 2007 Joey Hess <joey@kitenet.net>
261
262 Licensed under the GNU GPL version 2 or higher.
263
264 http://kitenet.net/~joey/code/mr/
265
266 =cut
267
268 #}}}
269
270 use warnings;
271 use strict;
272 use Getopt::Long;
273 use Cwd qw(getcwd abs_path);
274 use POSIX "WNOHANG";
275 use constant {
276         OK => 0,
277         FAILED => 1,
278         SKIPPED => 2,
279         ABORT => 3,
280 };
281
282 $SIG{INT}=sub {
283         print STDERR "mr: interrupted\n";
284         exit 2;
285 };
286
287 $ENV{MR_CONFIG}="$ENV{HOME}/.mrconfig";
288 my $config_overridden=0;
289 my $verbose=0;
290 my $stats=0;
291 my $no_recurse=0;
292 my $jobs=1;
293 my %config;
294 my %configfiles;
295 my %knownactions;
296 my %alias;
297 my $directory=getcwd();
298
299 Getopt::Long::Configure("no_permute");
300 my $result=GetOptions(
301         "d|directory=s" => sub { $directory=abs_path($_[1]) },
302         "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
303         "v|verbose" => \$verbose,
304         "s|stats" => \$stats,
305         "n|no-recurse" => \$no_recurse,
306         "j|jobs=i" => \$jobs,
307 );
308 if (! $result || @ARGV < 1) {
309         die("Usage: mr [-d directory] action [params ...]\n".
310             "(Use mr help for man page.)\n");
311
312 }
313 if (! defined $directory) {
314         die("mr: failed to determine working directory\n");
315 }
316
317 # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
318 # the config file might be a symlink to elsewhere, and the directory it's
319 # in is significant.
320 if ($ENV{MR_CONFIG} !~ /^\//) {
321         $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
322 }
323 # Try to set MR_PATH to the path to the program.
324 eval {
325         use FindBin qw($Bin $Script);
326         $ENV{MR_PATH}=$Bin."/".$Script;
327 };
328
329 loadconfig(\*DATA);
330 loadconfig($ENV{MR_CONFIG});
331 #use Data::Dumper;
332 #print Dumper(\%config);
333
334 # alias expansion and command stemming
335 my $action=shift @ARGV;
336 if (exists $alias{$action}) {
337         $action=$alias{$action};
338 }
339 if (! exists $knownactions{$action}) {
340         my @matches = grep { /^\Q$action\E/ }
341                 keys %knownactions, keys %alias;
342         if (@matches == 1) {
343                 $action=$matches[0];
344         }
345         elsif (@matches == 0) {
346                 die "mr: unknown action \"$action\" (known actions: ".
347                         join(", ", sort keys %knownactions).")\n";
348         }
349         else {
350                 die "mr: ambiguous action \"$action\" (matches: ".
351                         join(", ", @matches).")\n";
352         }
353 }
354
355 # commands that do not operate on all repos
356 if ($action eq 'help') {
357         exec($config{''}{DEFAULT}{$action}) || die "exec: $!";
358 }
359 elsif ($action eq 'config') {
360         if (@ARGV < 2) {
361                 die "mr config: not enough parameters\n";
362         }
363         my $section=shift;
364         if ($section=~/^\//) {
365                 # try to convert to a path relative to the config file
366                 my ($dir)=$ENV{MR_CONFIG}=~/^(.*\/)[^\/]+$/;
367                 $dir=abs_path($dir);
368                 $dir.="/" unless $dir=~/\/$/;
369                 if ($section=~/^\Q$dir\E(.*)/) {
370                         $section=$1;
371                 }
372         }
373         my %changefields;
374         foreach (@ARGV) {
375                 if (/^([^=]+)=(.*)$/) {
376                         $changefields{$1}=$2;
377                 }
378                 else {
379                         my $found=0;
380                         foreach my $topdir (sort keys %config) {
381                                 if (exists $config{$topdir}{$section} &&
382                                     exists $config{$topdir}{$section}{$_}) {
383                                         print $config{$topdir}{$section}{$_}."\n";
384                                         $found=1;
385                                         last if $section eq 'DEFAULT';
386                                 }
387                         }
388                         if (! $found) {
389                                 die "mr $action: $section $_ not set\n";
390                         }
391                 }
392         }
393         modifyconfig($ENV{MR_CONFIG}, $section, %changefields) if %changefields;
394         exit 0;
395 }
396 elsif ($action eq 'register') {
397         if (! $config_overridden) {
398                 # Find the closest known mrconfig file to the current
399                 # directory.
400                 $directory.="/" unless $directory=~/\/$/;
401                 foreach my $topdir (reverse sort keys %config) {
402                         next unless length $topdir;
403                         if ($directory=~/^\Q$topdir\E/) {
404                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
405                                 last;
406                         }
407                 }
408         }
409         my $command="set -e; ".$config{''}{DEFAULT}{lib}."\n".
410                 "my_action(){ $config{''}{DEFAULT}{$action}\n }; my_action ".
411                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
412         print STDERR "mr $action: running >>$command<<\n" if $verbose;
413         exec($command) || die "exec: $!";
414 }
415
416 # an ordered list of repos
417 my @list;
418 foreach my $topdir (sort keys %config) {
419         foreach my $subdir (sort keys %{$config{$topdir}}) {
420                 push @list, {
421                         topdir => $topdir,
422                         subdir => $subdir,
423                         order => $config{$topdir}{$subdir}{order},
424                 };
425         }
426 }
427 @list = sort {
428                 $a->{order}  <=> $b->{order}
429                              ||
430                 $a->{topdir} cmp $b->{topdir}
431                              ||
432                 $a->{subdir} cmp $b->{subdir}
433         } @list;
434
435 # work out what repos to act on
436 my @repos;
437 my $nochdir=0;
438 foreach my $repo (@list) {
439         my $topdir=$repo->{topdir};
440         my $subdir=$repo->{subdir};
441
442         next if $subdir eq 'DEFAULT';
443         my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
444         my $d=$directory;
445         $dir.="/" unless $dir=~/\/$/;
446         $d.="/" unless $d=~/\/$/;
447         next if $no_recurse && $d ne $dir;
448         next if $dir ne $d && $dir !~ /^\Q$d\E/;
449         push @repos, [$dir, $topdir, $subdir];
450 }
451 if (! @repos) {
452         # fallback to find a leaf repo
453         foreach my $repo (reverse @list) {
454                 my $topdir=$repo->{topdir};
455                 my $subdir=$repo->{subdir};
456                 
457                 next if $subdir eq 'DEFAULT';
458                 my $dir=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
459                 my $d=$directory;
460                 $dir.="/" unless $dir=~/\/$/;
461                 $d.="/" unless $d=~/\/$/;
462                 if ($d=~/^\Q$dir\E/) {
463                         push @repos, [$dir, $topdir, $subdir];
464                         last;
465                 }
466         }
467         $nochdir=1;
468 }
469
470 # run the action on each repository and print stats
471 my (@ok, @failed, @skipped);
472 if ($jobs > 1) {
473         mrs(@repos);
474 }
475 else {
476         foreach my $repo (@repos) {
477                 record($repo, action($action, @$repo));
478         }
479 }
480 if (! @ok && ! @failed && ! @skipped) {
481         die "mr $action: no repositories found to work on\n";
482 }
483 print "mr $action: finished (".join("; ",
484         showstat($#ok+1, "ok", "ok"),
485         showstat($#failed+1, "failed", "failed"),
486         showstat($#skipped+1, "skipped", "skipped"),
487 ).")\n";
488 if ($stats) {
489         if (@skipped) {
490                 print "mr $action: (skipped: ".join(" ", @skipped).")\n";
491         }
492         if (@failed) {
493                 print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
494         }
495 }
496 if (@failed) {
497         exit 1;
498 }
499 elsif (! @ok && @skipped) {
500         exit 1;
501 }
502 exit 0;
503
504 sub action { #{{{
505         my ($action, $dir, $topdir, $subdir) = @_;
506
507         $ENV{MR_CONFIG}=$configfiles{$topdir};
508         my $lib=exists $config{$topdir}{$subdir}{lib} ?
509                        $config{$topdir}{$subdir}{lib}."\n" : "";
510
511         if ($action eq 'checkout') {
512                 if (-d $dir) {
513                         print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
514                         return SKIPPED;
515                 }
516
517                 $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
518
519                 if (! -d $dir) {
520                         print "mr $action: creating parent directory $dir\n" if $verbose;
521                         system("mkdir", "-p", $dir);
522                 }
523         }
524         elsif ($action =~ /update/) {
525                 if (! -d $dir) {
526                         return action("checkout", $dir, $topdir, $subdir);
527                 }
528         }
529         
530         $ENV{MR_REPO}=$dir;
531
532         if (exists $config{$topdir}{$subdir}{skip}) {
533                 my $test="set -e;".$lib.
534                         "my_action(){ $config{$topdir}{$subdir}{skip}\n }; my_action '$action'";
535                 print "mr $action: running skip test >>$test<<\n" if $verbose;
536                 my $ret=system($test);
537                 if ($ret != 0) {
538                         if (($? & 127) == 2) {
539                                 print STDERR "mr $action: interrupted\n";
540                                 return ABORT;
541                         }
542                         elsif ($? & 127) {
543                                 print STDERR "mr $action: skip test received signal ".($? & 127)."\n";
544                                 return ABORT;
545                         }
546                 }
547                 if ($ret >> 8 == 0) {
548                         print "mr $action: $dir skipped per config file\n" if $verbose;
549                         return SKIPPED;
550                 }
551         }
552         
553         if (! $nochdir && ! chdir($dir)) {
554                 print STDERR "mr $action: failed to chdir to $dir: $!\n";
555                 return FAILED;
556         }
557         elsif (! exists $config{$topdir}{$subdir}{$action}) {
558                 print STDERR "mr $action: no defined $action command for $topdir$subdir, skipping\n";
559                 return SKIPPED;
560         }
561         else {
562                 if (! $nochdir) {
563                         print "mr $action: $topdir$subdir\n";
564                 }
565                 else {
566                         my $s=$directory;
567                         $s=~s/^\Q$topdir$subdir\E\/?//;
568                         print "mr $action: $topdir$subdir (in subdir $s)\n";
569                 }
570                 my $command="set -e; ".$lib.
571                         "my_action(){ $config{$topdir}{$subdir}{$action}\n }; my_action ".
572                         join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
573                 print STDERR "mr $action: running >>$command<<\n" if $verbose;
574                 my $ret=system($command);
575                 if ($ret != 0) {
576                         if (($? & 127) == 2) {
577                                 print STDERR "mr $action: interrupted\n";
578                                 return ABORT;
579                         }
580                         elsif ($? & 127) {
581                                 print STDERR "mr $action: received signal ".($? & 127)."\n";
582                                 return ABORT;
583                         }
584                         print STDERR "mr $action: failed ($ret)\n" if $verbose;
585                         if ($ret >> 8 != 0) {
586                                 print STDERR "mr $action: command failed\n";
587                         }
588                         elsif ($ret != 0) {
589                                 print STDERR "mr $action: command died ($ret)\n";
590                         }
591                         return FAILED;
592                 }
593                 else {
594                         if ($action eq 'checkout' && ! -d $dir) {
595                                 print STDERR "mr $action: $dir missing after checkout\n";;
596                                 return FAILED;
597                         }
598
599                         return OK;
600                 }
601         }
602 } #}}}
603
604 # run actions on multiple repos, in parallel
605 sub mrs { #{{{
606         $| = 1;
607         my @active;
608         my @fhs;
609         my @out;
610         my $running=0;
611         while (@fhs or @repos) {
612                 while ($running < $jobs && @repos) {
613                         $running++;
614                         my $repo = shift @repos;
615                         pipe(my $outfh, CHILD_STDOUT);
616                         pipe(my $errfh, CHILD_STDERR);
617                         my $pid;
618                         unless ($pid = fork) {
619                                 die "mr $action: cannot fork: $!" unless defined $pid;
620                                 open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
621                                 open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
622                                 close CHILD_STDOUT;
623                                 close CHILD_STDERR;
624                                 close $outfh;
625                                 close $errfh;
626                                 exit action($action, @$repo);
627                         }
628                         close CHILD_STDOUT;
629                         close CHILD_STDERR;
630                         push @active, [$pid, $repo];
631                         push @fhs, [$outfh, $errfh];
632                         push @out, ['',     ''];
633                 }
634                 my ($rin, $rout) = ('','');
635                 my $nfound;
636                 foreach my $fh (@fhs) {
637                         next unless defined $fh;
638                         vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
639                         vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
640                 }
641                 $nfound = select($rout=$rin, undef, undef, 1);
642                 foreach my $channel (0, 1) {
643                         foreach my $i (0..$#fhs) {
644                                 next unless defined $fhs[$i];
645                                 my $fh = $fhs[$i][$channel];
646                                 next unless defined $fh;
647                                 if (vec($rout, fileno($fh), 1) == 1) {
648                                         my $r = '';
649                                         if (sysread($fh, $r, 1024) == 0) {
650                                                 close($fh);
651                                                 $fhs[$i][$channel] = undef;
652                                                 if (! defined $fhs[$i][0] &&
653                                                     ! defined $fhs[$i][1]) {
654                                                         waitpid($active[$i][0], 0);
655                                                         print STDOUT $out[$i][0];
656                                                         print STDERR $out[$i][1];
657                                                         record($active[$i][1], $? >> 8);
658                                                         splice(@fhs, $i, 1);
659                                                         splice(@active, $i, 1);
660                                                         splice(@out, $i, 1);
661                                                         $running--;
662                                                 }
663                                         }
664                                         $out[$i][$channel] .= $r;
665                                 }
666                         }
667                 }
668         }
669 } #}}}
670
671 sub record { #{{{
672         my $dir=shift()->[0];
673         my $ret=shift;
674
675         if ($ret == OK) {
676                 push @ok, $dir;
677                 print "\n";
678         }
679         elsif ($ret == FAILED) {
680                 push @failed, $dir;
681                 print "\n";
682         }
683         elsif ($ret == SKIPPED) {
684                 push @skipped, $dir;
685         }
686         elsif ($ret == ABORT) {
687                 exit 1;
688         }
689         else {
690                 die "unknown exit status $ret";
691         }
692 } #}}}
693
694 sub showstat { #{{{
695         my $count=shift;
696         my $singular=shift;
697         my $plural=shift;
698         if ($count) {
699                 return "$count ".($count > 1 ? $plural : $singular);
700         }
701         return;
702 } #}}}
703
704 my %loaded;
705 sub loadconfig { #{{{
706         my $f=shift;
707
708         my @toload;
709
710         my $in;
711         my $dir;
712         if (ref $f eq 'GLOB') {
713                 $dir="";
714                 $in=$f; 
715         }
716         else {
717                 if (! -e $f) {
718                         return;
719                 }
720
721                 my $absf=abs_path($f);
722                 if ($loaded{$absf}) {
723                         return;
724                 }
725                 $loaded{$absf}=1;
726
727                 ($dir)=$f=~/^(.*\/)[^\/]+$/;
728                 if (! defined $dir) {
729                         $dir=".";
730                 }
731                 $dir=abs_path($dir)."/";
732                 
733                 if (! exists $configfiles{$dir}) {
734                         $configfiles{$dir}=$f;
735                 }
736
737                 # copy in defaults from first parent
738                 my $parent=$dir;
739                 while ($parent=~s/^(.*\/)[^\/]+\/?$/$1/) {
740                         if ($parent eq '/') {
741                                 $parent="";
742                         }
743                         if (exists $config{$parent} &&
744                             exists $config{$parent}{DEFAULT}) {
745                                 $config{$dir}{DEFAULT}={ %{$config{$parent}{DEFAULT}} };
746                                 last;
747                         }
748                 }
749                 
750                 print "mr: loading config $f\n" if $verbose;
751                 open($in, "<", $f) || die "mr: open $f: $!\n";
752         }
753         my @lines=<$in>;
754         close $in;
755
756         my $section;
757         my $line=0;
758         while (@lines) {
759                 $_=shift @lines;
760                 $line++;
761                 chomp;
762                 next if /^\s*\#/ || /^\s*$/;
763                 if (/^\[([^\]]*)\]\s*$/) {
764                         $section=$1;
765                 }
766                 elsif (/^(\w+)\s*=\s*(.*)/) {
767                         my $parameter=$1;
768                         my $value=$2;
769
770                         # continued value
771                         while (@lines && $lines[0]=~/^\s(.+)/) {
772                                 shift(@lines);
773                                 $line++;
774                                 $value.="\n$1";
775                                 chomp $value;
776                         }
777
778                         if (! defined $section) {
779                                 die "$f line $.: parameter ($parameter) not in section\n";
780                         }
781                         if ($section ne 'ALIAS' &&
782                             ! exists $config{$dir}{$section} &&
783                             exists $config{$dir}{DEFAULT}) {
784                                 # copy in defaults
785                                 $config{$dir}{$section}={ %{$config{$dir}{DEFAULT}} };
786                         }
787                         if ($section eq 'ALIAS') {
788                                 $alias{$parameter}=$value;
789                         }
790                         elsif ($parameter eq 'lib') {
791                                 $config{$dir}{$section}{lib}.=$value."\n";
792                         }
793                         else {
794                                 $config{$dir}{$section}{$parameter}=$value;
795                                 $knownactions{$parameter}=1;
796                                 if ($parameter eq 'chain' &&
797                                     length $dir && $section ne "DEFAULT" &&
798                                     -e $dir.$section."/.mrconfig") {
799                                         my $ret=system($value);
800                                         if ($ret != 0) {
801                                                 if (($? & 127) == 2) {
802                                                         print STDERR "mr $action: chain test interrupted\n";
803                                                         exit 2;
804                                                 }
805                                                 elsif ($? & 127) {
806                                                         print STDERR "mr $action: chain test received signal ".($? & 127)."\n";
807                                                 }
808                                         }
809                                         else {
810                                                 push @toload, $dir.$section."/.mrconfig";
811                                         }
812                                 }
813                         }
814                 }
815                 else {
816                         die "$f line $line: parse error\n";
817                 }
818         }
819
820         foreach (@toload) {
821                 loadconfig($_);
822         }
823 } #}}}
824
825 sub modifyconfig { #{{{
826         my $f=shift;
827         # the section to modify or add
828         my $targetsection=shift;
829         # fields to change in the section
830         # To remove a field, set its value to "".
831         my %changefields=@_;
832
833         my @lines;
834         my @out;
835
836         if (-e $f) {
837                 open(my $in, "<", $f) || die "mr: open $f: $!\n";
838                 @lines=<$in>;
839                 close $in;
840         }
841
842         my $formatfield=sub {
843                 my $field=shift;
844                 my @value=split(/\n/, shift);
845
846                 return "$field = ".shift(@value)."\n".
847                         join("", map { "\t$_\n" } @value);
848         };
849         my $addfields=sub {
850                 my @blanks;
851                 while ($out[$#out] =~ /^\s*$/) {
852                         unshift @blanks, pop @out;
853                 }
854                 foreach my $field (sort keys %changefields) {
855                         if (length $changefields{$field}) {
856                                 push @out, "$field = $changefields{$field}\n";
857                                 delete $changefields{$field};
858                         }
859                 }
860                 push @out, @blanks;
861         };
862
863         my $section;
864         while (@lines) {
865                 $_=shift(@lines);
866
867                 if (/^\s*\#/ || /^\s*$/) {
868                         push @out, $_;
869                 }
870                 elsif (/^\[([^\]]*)\]\s*$/) {
871                         if (defined $section && 
872                             $section eq $targetsection) {
873                                 $addfields->();
874                         }
875
876                         $section=$1;
877
878                         push @out, $_;
879                 }
880                 elsif (/^(\w+)\s*=\s(.*)/) {
881                         my $parameter=$1;
882                         my $value=$2;
883
884                         # continued value
885                         while (@lines && $lines[0]=~/^\s(.+)/) {
886                                 shift(@lines);
887                                 $value.="\n$1";
888                                 chomp $value;
889                         }
890
891                         if ($section eq $targetsection) {
892                                 if (exists $changefields{$parameter}) {
893                                         if (length $changefields{$parameter}) {
894                                                 $value=$changefields{$parameter};
895                                         }
896                                         delete $changefields{$parameter};
897                                 }
898                         }
899
900                         push @out, $formatfield->($parameter, $value);
901                 }
902         }
903
904         if (defined $section && 
905             $section eq $targetsection) {
906                 $addfields->();
907         }
908         elsif (%changefields) {
909                 push @out, "\n[$targetsection]\n";
910                 foreach my $field (sort keys %changefields) {
911                         if (length $changefields{$field}) {
912                                 push @out, $formatfield->($field, $changefields{$field});
913                         }
914                 }
915         }
916
917         open(my $out, ">", $f) || die "mr: write $f: $!\n";
918         print $out @out;
919         close $out;     
920 } #}}}
921
922 # Finally, some useful actions that mr knows about by default.
923 # These can be overridden in ~/.mrconfig.
924 #DATA{{{
925 __DATA__
926 [ALIAS]
927 co = checkout
928 ci = commit
929 ls = list
930
931 [DEFAULT]
932 order = 10
933 lib =
934         PWD="$pwd"
935         error() {
936                 echo "mr: $@" >&2
937                 exit 1
938         }
939         warning() {
940                 echo "mr (warning): $@" >&2
941         }
942         info() {
943                 echo "mr: $@" >&2
944         }
945         hours_since() {
946                 if [ -z "$1" ] || [ -z "$2" ]; then
947                         error "mr: usage: hours_since action num"
948                 fi
949                 for dir in .git .svn .bzr CVS .hg _darcs; do
950                         if [ -e "$MR_REPO/$dir" ]; then
951                                 flagfile="$MR_REPO/$dir/.mr_last$1"
952                                 break
953                         fi
954                 done
955                 if [ -z "$flagfile" ]; then
956                         error "cannot determine flag filename"
957                 fi
958                 delta=$(perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile")
959                 if [ "$delta" -lt "$2" ]; then
960                         exit 0
961                 else
962                         touch "$flagfile"
963                         exit 1
964                 fi
965         }
966         get_git_repo_type()
967         {
968                 if [ -d "$1"/.git ] && [ -d "$1"/.git/refs/heads ] &&
969                         [ -d "$1"/.git/objects ] && [ -f "$1"/.git/config ];
970                         then
971                         echo non-bare
972                 elif [ -d "$1"/refs/heads ] && [ -d "$1"/refs/tags ] &&
973                         [ -d "$1"/objects ] && [ -f "$1"/config ]; then
974                         local bare
975                         bare="$(GIT_CONFIG="$1"/config git-config --get core.bare)"
976                         case "$bare" in
977                                 true) echo bare;;
978                                 false) echo fake-bare;;
979                                 *) return 255;;
980                         esac
981                 else
982                         return 1
983                 fi
984         }
985         is_git_repo() {
986                 get_git_repo_type "$1" >/dev/null
987         }
988         get_repo_type() {
989                 if [ -d "$1"/.svn ]; then
990                         echo svn
991                 elif is_git_repo "$1"; then
992                         echo git
993                 elif [ -d "$1"/.bzr ]; then
994                         echo bzr
995                 elif [ -d "$1"/CVS ]; then
996                         echo CVS
997                 elif [ -d "$1"/.hg ]; then
998                         echo hg
999                 elif [ -d "$1"/_darcs ]; then
1000                         echo darcs
1001                 else
1002                         echo unknown
1003                 fi
1004         }
1005
1006 update =
1007         case "$(get_repo_type "$MR_REPO")" in
1008         svn) svn update "$@";;
1009         git)
1010                 # all this is because of a bug in git-fetch, which requires GIT_DIR set
1011                 local git_dir_override; git_dir_override=.git
1012                 case "$(get_git_repo_type "$MR_REPO")" in
1013                         fake-bare) git_dir_override="$MR_REPO";;
1014                 esac
1015                 args="$@"
1016                 [ -z "$args" ] && args="-t origin master"
1017                 eval GIT_DIR="$git_dir_override" git pull "$args"
1018                 ;;
1019         bzr) bzr merge "$@";;
1020         CVS) cvs update "$@";;
1021         hg) hg pull "$@" && hg update "$@";;
1022         darcs) darcs pull -a "$@";;
1023         *) error "unknown repo type";;
1024         esac
1025
1026 status =
1027         case "$(get_repo_type "$MR_REPO")" in
1028         svn) svn status "$@";;
1029         git) git status "$@" || :;;
1030         bzr) bzr status "$@";;
1031         CVS) cvs status "$@";;
1032         hg) hg status "$@";;
1033         darcs) darcs whatsnew -ls "$@";;
1034         *) error "unknown repo type";;
1035         esac
1036
1037 commit =
1038         case "$(get_repo_type "$MR_REPO")" in
1039         svn) svn commit "$@";;
1040         git)
1041                 case "$(get_git_repo_type "$MR_REPO")" in
1042                         bare) error "cannot commit to bare git repositories";;
1043                         fake-bare) error "commit does not work for fake bare git repositories (yet).";;
1044                 esac
1045                 git commit -a "$@" && git push --all
1046                 ;;
1047         bzr) bzr commit "$@" && bzr push;;
1048         CVS) cvs commit "$@";;
1049         hg) hg commit -m "$@" && hg push;;
1050         darcs) darcs commit -a -m "$@" && darcs push -a;;
1051         *) error "unknown repo type";;
1052         esac
1053
1054 diff =
1055         case "$(get_repo_type "$MR_REPO")" in
1056         svn) svn diff "$@";;
1057         git)
1058                 case "$(get_git_repo_type "$MR_REPO")" in
1059                         bare) error "cannot diff in bare git repositories";;
1060                         fake-bare) error "diff does not work for fake bare git repositories (yet).";;
1061                 esac
1062                 git diff "$@"
1063                 ;;
1064         bzr) bzr diff "$@";;
1065         CVS) cvs diff "$@";;
1066         hg) hg diff "$@";;
1067         darcs) darcs diff "$@";;
1068         *) error "unknown repo type";;
1069         esac
1070
1071 log =
1072         case "$(get_repo_type "$MR_REPO")" in
1073         svn) svn log"$@";;
1074         git) git log "$@";;
1075         bzr) bzr log "$@";;
1076         CVS) cvs log "$@";;
1077         hg) hg log "$@";;
1078         darcs) darcs changes "$@";;
1079         *) error "unknown repo type";;
1080         esac
1081
1082 register =
1083         if [ -n "$1" ]; then
1084                 cd "$1"
1085         fi
1086         basedir="${PWD##*/}"
1087         case "$(get_repo_type .)" in
1088         svn)
1089                 url=$(LANG=C svn info . | grep -i ^URL: | cut -d ' ' -f 2)
1090                 if [ -z "$url" ]; then
1091                         error "cannot determine svn url"
1092                 fi
1093                 echo "Registering svn url: $url in $MR_CONFIG"
1094                 mr -c "$MR_CONFIG" config "$PWD" checkout="svn co $url $basedir"
1095                 ;;
1096         git)
1097                 local repo_type; repo_type="$(get_git_repo_type .)"
1098                 local config;
1099                 case "$repo_type" in
1100                         non-bare) config=.git/config;;
1101                         bare|fake-bare) config=config;;
1102                 esac
1103                 url="$(LANG=C GIT_CONFIG="$config" git-config --get remote.origin.url)" || :
1104                 if [ -z "$url" ]; then
1105                         error "cannot determine git url"
1106                 fi
1107                 set -x
1108                 local clone_opts add_cmd work_tree suffix
1109                 case "$repo_type" in
1110                         fake-bare)
1111                                 # this seems like a fake bare repo and needs a worktree
1112                                 work_tree="$(git-config --get core.worktree)" || :
1113                                 work_tree="${work_tree%%/}/"
1114                                 if [ ! -d "$work_tree" ]; then
1115                                         error "git worktree '$work_tree' does not exist"
1116                                 fi
1117                                 clone_opts=" --no-checkout"
1118                                 add_cmd="$add_cmd && cd $basedir"
1119                                 add_cmd="$add_cmd && git read-tree HEAD"
1120                                 add_cmd="$add_cmd && git checkout-index -a --prefix='$work_tree' || :"
1121                                 add_cmd="$add_cmd; git config core.worktree '$work_tree'"
1122                                 add_cmd="$add_cmd && mv .git/* . && rmdir .git"
1123                                 suffix=" (with worktree $work_tree)"
1124                                 ;;
1125                         bare)
1126                                 clone_opts=" --bare"
1127                                 suffix=" (bare repository)"
1128                                 ;;
1129                 esac
1130                 echo "Registering git url: $url in $MR_CONFIG${suffix:-}"
1131                 mr -c "$MR_CONFIG" config "$PWD" checkout="git clone${clone_opts:-} $url $basedir${add_cmd:-}"
1132                 ;;
1133         bzr)
1134                 url=$(cat .bzr/branch/parent)
1135                 if [ -z "$url" ]; then
1136                         error "cannot determine bzr url"
1137                 fi
1138                 echo "Registering bzr url: $url in $MR_CONFIG"
1139                 mr -c "$MR_CONFIG" config "$PWD" checkout="bzr clone $url $basedir"
1140                 ;;
1141         CVS)
1142                 repo=$(cat CVS/Repository)
1143                 root=$(cat CVS/Root)
1144                 if [ -z "$root" ]; then
1145                         error "cannot determine cvs root"
1146                 fi
1147                 echo "Registering cvs repository $repo at root $root"
1148                 mr -c "$MR_CONFIG" config "$PWD" \
1149                         checkout="cvs -d '$root' co -d $basedir $repo"
1150                 ;;
1151         hg)
1152                 url=$(hg showconfig paths.default)
1153                 echo "Registering mercurial repo url: $url in $MR_CONFIG"
1154                 mr -c "$MR_CONFIG" config "$PWD" \
1155                         checkout="hg clone $url $basedir"
1156                 ;;
1157         darcs)
1158                 url=$(cat _darcs/prefs/defaultrepo)
1159                 echo "Registering darcs repository $url in $MR_CONFIG"
1160                 mr -c "$MR_CONFIG" config "$PWD" \
1161                         checkout="darcs get $url $basedir"
1162                 ;;
1163         *) error "unable to register this repo type";;
1164         esac
1165
1166 help =
1167         if [ ! -e "$MR_PATH" ]; then
1168                 error "cannot find program path"
1169         fi
1170         (pod2man -c mr "$MR_PATH" | man -l -) || error "pod2man or man failed"
1171 list = true
1172 config = 
1173
1174 ed = echo "A horse is a horse, of course, of course.."
1175 T = echo "I pity the fool."
1176 right = echo "Not found."
1177 #}}}
1178
1179 # vim:sw=8:sts=0:ts=8:noet