]> git.madduck.net Git - code/myrepos.git/blob - mr

madduck's git repository

Every one of the projects in this repository is available at the canonical URL git://git.madduck.net/madduck/pub/<projectpath> — see each project's metadata for the exact URL.

All patches and comments are welcome. Please squash your changes to logical commits before using git-format-patch and git-send-email to patches@git.madduck.net. If you'd read over the Git project's submission guidelines and adhered to them, I'd be especially grateful.

SSH access, as well as push access can be individually arranged.

If you use my repositories frequently, consider adding the following snippet to ~/.gitconfig and using the third clone URL listed for each project:

[url "git://git.madduck.net/madduck/"]
  insteadOf = madduck:

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