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 directory that the specified config file is
1032                 # located in.
1033                 ($directory)=abs_path($ENV{MR_CONFIG})=~/^(.*\/)[^\/]+$/;
1034         }
1035         else {
1036                 # Find the closest known mrconfig file to the current
1037                 # directory.
1038                 $directory.="/" unless $directory=~/\/$/;
1039                 my $foundconfig=0;
1040                 foreach my $topdir (reverse sort keys %config) {
1041                         next unless length $topdir;
1042                         if ($directory=~/^\Q$topdir\E/) {
1043                                 $ENV{MR_CONFIG}=$configfiles{$topdir};
1044                                 $directory=$topdir;
1045                                 $foundconfig=1;
1046                                 last;
1047                         }
1048                 }
1049                 if (! $foundconfig) {
1050                         $directory=""; # no config file, use builtin
1051                 }
1052         }
1053         if (@ARGV) {
1054                 my $subdir=shift @ARGV;
1055                 if (! chdir($subdir)) {
1056                         print STDERR "mr register: failed to chdir to $subdir: $!\n";
1057                 }
1058         }
1059
1060         $ENV{MR_REPO}=getcwd();
1061         my $command=findcommand("register", $ENV{MR_REPO}, $directory, 'DEFAULT', 0);
1062         if (! defined $command) {
1063                 die "mr register: unknown repository type\n";
1064         }
1065
1066         $ENV{MR_REPO}=~s/.*\/(.*)/$1/;
1067         $command="set -e; ".$config{$directory}{DEFAULT}{lib}."\n".
1068                 "my_action(){ $command\n }; my_action ".
1069                 join(" ", map { s/\//\/\//g; s/"/\"/g; '"'.$_.'"' } @ARGV);
1070         print "mr register: running >>$command<<\n" if $verbose;
1071         exec($command) || die "exec: $!";
1072 } #}}}
1073
1074 # alias expansion and command stemming
1075 sub expandaction { #{{{
1076         my $action=shift;
1077         if (exists $alias{$action}) {
1078                 $action=$alias{$action};
1079         }
1080         if (! exists $knownactions{$action}) {
1081                 my @matches = grep { /^\Q$action\E/ }
1082                         keys %knownactions, keys %alias;
1083                 if (@matches == 1) {
1084                         $action=$matches[0];
1085                 }
1086                 elsif (@matches == 0) {
1087                         die "mr: unknown action \"$action\" (known actions: ".
1088                                 join(", ", sort keys %knownactions).")\n";
1089                 }
1090                 else {
1091                         die "mr: ambiguous action \"$action\" (matches: ".
1092                                 join(", ", @matches).")\n";
1093                 }
1094         }
1095         return $action;
1096 } #}}}
1097
1098 sub getopts { #{{{
1099         Getopt::Long::Configure("bundling", "no_permute");
1100         my $result=GetOptions(
1101                 "d|directory=s" => sub { $directory=abs_path($_[1]) },
1102                 "c|config=s" => sub { $ENV{MR_CONFIG}=$_[1]; $config_overridden=1 },
1103                 "v|verbose" => \$verbose,
1104                 "q|quiet" => \$quiet,
1105                 "s|stats" => \$stats,
1106                 "i|interactive" => \$interactive,
1107                 "n|no-recurse:i" => \$max_depth,
1108                 "j|jobs:i" => \$jobs,
1109         );
1110         if (! $result || @ARGV < 1) {
1111                 die("Usage: mr [-d directory] action [params ...]\n".
1112                     "(Use mr help for man page.)\n");
1113         }
1114 } #}}}
1115
1116 sub init { #{{{
1117         $SIG{INT}=sub {
1118                 print STDERR "mr: interrupted\n";
1119                 exit 2;
1120         };
1121
1122         # This can happen if it's run in a directory that was removed
1123         # or other strangeness.
1124         if (! defined $directory) {
1125                 die("mr: failed to determine working directory\n");
1126         }
1127         # Make sure MR_CONFIG is an absolute path, but don't use abs_path since
1128         # the config file might be a symlink to elsewhere, and the directory it's
1129         # in is significant.
1130         if ($ENV{MR_CONFIG} !~ /^\//) {
1131                 $ENV{MR_CONFIG}=getcwd()."/".$ENV{MR_CONFIG};
1132         }
1133         # Try to set MR_PATH to the path to the program.
1134         eval {
1135                 use FindBin qw($Bin $Script);
1136                 $ENV{MR_PATH}=$Bin."/".$Script;
1137         };
1138 } #}}}
1139
1140 sub main { #{{{
1141         getopts();
1142         init();
1143         loadconfig(\*DATA);
1144         loadconfig($ENV{MR_CONFIG});
1145         #use Data::Dumper; print Dumper(\%config);
1146
1147         my $action=expandaction(shift @ARGV);
1148         dispatch($action);
1149         showstats($action);
1150
1151         if (@failed) {
1152                 exit 1;
1153         }
1154         elsif (! @ok && @skipped) {
1155                 exit 1;
1156         }
1157         else {
1158                 exit 0;
1159         }
1160 } #}}}
1161
1162 # Finally, some useful actions that mr knows about by default.
1163 # These can be overridden in ~/.mrconfig.
1164 #DATA{{{
1165 __DATA__
1166 [ALIAS]
1167 co = checkout
1168 ci = commit
1169 ls = list
1170
1171 [DEFAULT]
1172 order = 10
1173 lib =
1174         error() {
1175                 echo "mr: $@" >&2
1176                 exit 1
1177         }
1178         warning() {
1179                 echo "mr (warning): $@" >&2
1180         }
1181         info() {
1182                 echo "mr: $@" >&2
1183         }
1184         hours_since() {
1185                 if [ -z "$1" ] || [ -z "$2" ]; then
1186                         error "mr: usage: hours_since action num"
1187                 fi
1188                 for dir in .git .svn .bzr CVS .hg _darcs; do
1189                         if [ -e "$MR_REPO/$dir" ]; then
1190                                 flagfile="$MR_REPO/$dir/.mr_last$1"
1191                                 break
1192                         fi
1193                 done
1194                 if [ -z "$flagfile" ]; then
1195                         error "cannot determine flag filename"
1196                 fi
1197                 delta=`perl -wle 'print -f shift() ? int((-M _) * 24) : 9999' "$flagfile"`
1198                 if [ "$delta" -lt "$2" ]; then
1199                         exit 0
1200                 else
1201                         touch "$flagfile"
1202                         exit 1
1203                 fi
1204         }
1205
1206 svn_test = test -d "$MR_REPO"/.svn
1207 git_test = test -d "$MR_REPO"/.git
1208 bzr_test = test -d "$MR_REPO"/.bzr
1209 cvs_test = test -d "$MR_REPO"/CVS
1210 hg_test  = test -d "$MR_REPO"/.hg
1211 darcs_test = test -d "$MR_REPO"/_darcs
1212 git_bare_test =
1213         test -d "$MR_REPO"/refs/heads && test -d "$MR_REPO"/refs/tags &&
1214         test -d "$MR_REPO"/objects && test -f "$MR_REPO"/config &&
1215         test "`GIT_CONFIG="$MR_REPO"/config git config --get core.bare`" = true
1216
1217 svn_update = svn update "$@"
1218 git_update = git pull "$@"
1219 bzr_update = bzr merge "$@"
1220 cvs_update = cvs update "$@"
1221 hg_update  = hg pull "$@" && hg update "$@"
1222 darcs_update = darcs pull -a "$@"
1223
1224 svn_status = svn status "$@"
1225 git_status = git status "$@" || true
1226 bzr_status = bzr status "$@"
1227 cvs_status = cvs status "$@"
1228 hg_status  = hg status "$@"
1229 darcs_status = darcs whatsnew -ls "$@" || true
1230
1231 svn_commit = svn commit "$@"
1232 git_commit = git commit -a "$@" && git push --all
1233 bzr_commit = bzr commit "$@" && bzr push
1234 cvs_commit = cvs commit "$@"
1235 hg_commit  = hg commit -m "$@" && hg push
1236 darcs_commit = darcs record -a -m "$@" && darcs push -a
1237
1238 git_record = git commit -a "$@"
1239 bzr_record = bzr commit "$@"
1240 hg_record  = hg commit -m "$@"
1241 darcs_record = darcs record -a -m "$@"
1242
1243 svn_diff = svn diff "$@"
1244 git_diff = git diff "$@"
1245 bzr_diff = bzr diff "$@"
1246 cvs_diff = cvs diff "$@"
1247 hg_diff  = hg diff "$@"
1248 darcs_diff = darcs diff -u "$@"
1249
1250 svn_log = svn log "$@"
1251 git_log = git log "$@"
1252 bzr_log = bzr log "$@"
1253 cvs_log = cvs log "$@"
1254 hg_log  = hg log "$@"
1255 darcs_log = darcs changes "$@"
1256 git_bare_log = git log "$@"
1257
1258 svn_register =
1259         url=`LC_ALL=C svn info . | grep -i '^URL:' | cut -d ' ' -f 2`
1260         if [ -z "$url" ]; then
1261                 error "cannot determine svn url"
1262         fi
1263         echo "Registering svn url: $url in $MR_CONFIG"
1264         mr -c "$MR_CONFIG" config "`pwd`" checkout="svn co '$url' '$MR_REPO'"
1265 git_register =
1266         url="`LC_ALL=C git config --get remote.origin.url`" || true
1267         if [ -z "$url" ]; then
1268                 error "cannot determine git url"
1269         fi
1270         echo "Registering git url: $url in $MR_CONFIG"
1271         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone '$url' '$MR_REPO'"
1272 bzr_register =
1273         url="`LC_ALL=C bzr info . | egrep -i 'checkout of branch|parent branch' | awk '{print $NF}'`"
1274         if [ -z "$url" ]; then
1275                 error "cannot determine bzr url"
1276         fi
1277         echo "Registering bzr url: $url in $MR_CONFIG"
1278         mr -c "$MR_CONFIG" config "`pwd`" checkout="bzr clone '$url' '$MR_REPO'"
1279 cvs_register =
1280         repo=`cat CVS/Repository`
1281         root=`cat CVS/Root`
1282         if [ -z "$root" ]; then
1283                 error "cannot determine cvs root"
1284                 fi
1285         echo "Registering cvs repository $repo at root $root"
1286         mr -c "$MR_CONFIG" config "`pwd`" checkout="cvs -d '$root' co -d '$MR_REPO' '$repo'"
1287 hg_register =
1288         url=`hg showconfig paths.default`
1289         echo "Registering mercurial repo url: $url in $MR_CONFIG"
1290         mr -c "$MR_CONFIG" config "`pwd`" checkout="hg clone '$url' '$MR_REPO'"
1291 darcs_register =
1292         url=`cat _darcs/prefs/defaultrepo`
1293         echo "Registering darcs repository $url in $MR_CONFIG"
1294         mr -c "$MR_CONFIG" config "`pwd`" checkout="darcs get '$url' '$MR_REPO'"
1295 git_bare_register =
1296         url="`LC_ALL=C GIT_CONFIG=config git config --get remote.origin.url`" || true
1297         if [ -z "$url" ]; then
1298                 error "cannot determine git url"
1299         fi
1300         echo "Registering git url: $url in $MR_CONFIG"
1301         mr -c "$MR_CONFIG" config "`pwd`" checkout="git clone --bare '$url' '$MR_REPO'"
1302
1303 help =
1304         if [ ! -e "$MR_PATH" ]; then
1305                 error "cannot find program path"
1306         fi
1307         tmp=$(mktemp -t mr.XXXXXXXXXX) || error "mktemp failed"
1308         trap "rm -f $tmp" exit
1309         pod2man -c mr "$MR_PATH" > "$tmp" || error "pod2man failed"
1310         man -l "$tmp" || error "man failed"
1311 list = true
1312 config =
1313
1314 ed = echo "A horse is a horse, of course, of course.."
1315 T = echo "I pity the fool."
1316 right = echo "Not found."
1317 #}}}
1318
1319 # vim:sw=8:sts=0:ts=8:noet