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