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="`LC_ALL=C bzr info . | egrep -i 'checkout of branch|parent branch' | awk '{print $NF}'`"
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