+Licensed under the GNU GPL version 2 or higher.
+
+http://kitenet.net/~joey/code/mr/
+
+=cut
+
+use warnings;
+use strict;
+use Getopt::Long;
+use Cwd qw(getcwd abs_path);
+
+# things that can happen when mr runs a command
+use constant {
+ OK => 0,
+ FAILED => 1,
+ SKIPPED => 2,
+ ABORT => 3,
+};
+
+# configurables
+my $config_overridden=0;
+my $verbose=0;
+my $quiet=0;
+my $stats=0;
+my $force=0;
+my $insecure=0;
+my $interactive=0;
+my $max_depth;
+my $no_chdir=0;
+my $jobs=1;
+my $trust_all=0;
+my $directory=getcwd();
+
+$ENV{MR_CONFIG}=find_mrconfig();
+
+# globals :-(
+my %config;
+my %configfiles;
+my %knownactions;
+my %alias;
+my (@ok, @failed, @skipped);
+
+main();
+
+sub shellquote {
+ my $i=shift;
+ $i=~s/'/'"'"'/g;
+ return "'$i'";
+}
+
+# Runs a shell command using a supplied function.
+# The lib will be included in the shell command line, and any params
+# will be available in the shell as $1, $2, etc.
+my $lastlib;
+sub runsh {
+ my ($action, $topdir, $subdir, $command, $params, $runner) = @_;
+
+ # optimisation: avoid running the shell for true and false
+ if ($command =~ /^\s*true\s*$/) {
+ $?=0;
+ return 0;
+ }
+ elsif ($command =~ /^\s*false\s*$/) {
+ $?=0;
+ return 1;
+ }
+
+ my $quotedparams=join(" ", (map { shellquote($_) } @$params));
+ my $lib=exists $config{$topdir}{$subdir}{lib} ?
+ $config{$topdir}{$subdir}{lib}."\n" : "";
+ if ($verbose && (! defined $lastlib || $lastlib ne $lib)) {
+ print "mr library now: >>$lib<<\n";
+ $lastlib=$lib;
+ }
+ my $shellcode="set -e;".$lib.
+ "my_sh(){ $command\n }; my_sh $quotedparams";
+ print "mr $action: running $action >>$command<<\n" if $verbose;
+ $runner->($shellcode);
+}
+
+sub runshpipe {
+ runsh @_, sub {
+ my $sh=shift;
+ my $ret=`$sh`;
+ chomp $ret;
+ return $ret;
+ };
+}
+
+my %vcs;
+my %vcs_dir_test;
+sub vcs_test {
+ my ($action, $dir, $topdir, $subdir) = @_;
+
+ if (exists $vcs{$dir}) {
+ return $vcs{$dir};
+ }
+
+ my $test="";
+ my $dir_test="";
+ foreach my $vcs_test (
+ sort {
+ length $a <=> length $b
+ ||
+ $a cmp $b
+ } grep { /_test$/ } keys %{$config{$topdir}{$subdir}}) {
+ if ($vcs_test =~ /(.*)_dir_test/) {
+ my $vcs=$1;
+ if (! defined $vcs_dir_test{$vcs}) {
+ $dir_test.=$config{$topdir}{$subdir}{$vcs_test}."\n";
+ }
+ next;
+ }
+ my $vcs=$vcs_test =~ /(.*)_test/;
+ $test="my_$vcs_test() {\n$config{$topdir}{$subdir}{$vcs_test}\n}\n".$test;
+ $test.="if my_$vcs_test; then echo $vcs; fi\n";
+ }
+
+ if (length $dir_test) {
+ runsh "vcs dir test", $topdir, $subdir, $dir_test, [], sub {
+ my $sh=shift;
+ foreach my $line (`$sh`) {
+ chomp $line;
+ my ($vcs, $dir)=split(" ", $line);
+ $vcs_dir_test{$vcs}=$dir;
+ }
+ }
+ }
+
+ foreach my $vcs (keys %vcs_dir_test) {
+ if (-d "$ENV{MR_REPO}/$vcs_dir_test{$vcs}") {
+ return $vcs{$dir}=$vcs;
+ }
+ }
+
+ my $vcs=runshpipe "vcs test", $topdir, $subdir, $test, [];
+ if ($vcs=~/\n/s) {
+ $vcs=~s/\n/, /g;
+ print STDERR "mr $action: found multiple possible repository types ($vcs) for ".fulldir($topdir, $subdir)."\n";
+ return undef;
+ }
+ if (! length $vcs) {
+ return $vcs{$dir}=undef;
+ }
+ else {
+ return $vcs{$dir}=$vcs;
+ }
+}
+
+sub findcommand {
+ my ($action, $dir, $topdir, $subdir, $is_checkout) = @_;
+
+ if (exists $config{$topdir}{$subdir}{$action}) {
+ return $config{$topdir}{$subdir}{$action};
+ }
+
+ if ($is_checkout) {
+ return undef;
+ }
+
+ my $vcs=vcs_test(@_);
+
+ if (defined $vcs &&
+ exists $config{$topdir}{$subdir}{$vcs."_".$action}) {
+ return $config{$topdir}{$subdir}{$vcs."_".$action};
+ }
+ else {
+ return undef;
+ }
+}
+
+sub fulldir {
+ my ($topdir, $subdir) = @_;
+ return $subdir =~ /^\// ? $subdir : $topdir.$subdir;
+}
+
+sub action {
+ my ($action, $dir, $topdir, $subdir, $force_checkout) = @_;
+ my $fulldir=fulldir($topdir, $subdir);
+
+ $ENV{MR_CONFIG}=$configfiles{$topdir};
+ my $is_checkout=($action eq 'checkout');
+ my $is_update=($action =~ /update/);
+
+ ($ENV{MR_REPO}=$dir) =~ s!/$!!;
+ $ENV{MR_ACTION}=$action;
+
+ foreach my $testname ("skip", "deleted") {
+ next if $force && $testname eq "skip";
+
+ my $testcommand=findcommand($testname, $dir, $topdir, $subdir, $is_checkout);
+
+ if (defined $testcommand) {
+ my $ret=runsh "$testname test", $topdir, $subdir,
+ $testcommand, [$action],
+ sub { system(shift()) };
+ if ($ret != 0) {
+ if (($? & 127) == 2) {
+ print STDERR "mr $action: interrupted\n";
+ return ABORT;
+ }
+ elsif ($? & 127) {
+ print STDERR "mr $action: $testname test received signal ".($? & 127)."\n";
+ return ABORT;
+ }
+ }
+ if ($ret >> 8 == 0) {
+ if ($testname eq "deleted") {
+ if (-d $dir) {
+ print STDERR "mr error: $dir should be deleted yet still exists\n";
+ return FAILED;
+ }
+ }
+ print "mr $action: skip $dir skipped\n" if $verbose;
+ return SKIPPED;
+ }
+ }
+ }
+
+ if ($is_checkout) {
+ if (! $force_checkout) {
+ if (-d $dir) {
+ print "mr $action: $dir already exists, skipping checkout\n" if $verbose;
+ return SKIPPED;
+ }
+
+ $dir=~s/^(.*)\/[^\/]+\/?$/$1/;
+ }
+ }
+ elsif ($is_update) {
+ if (! -d $dir) {
+ return action("checkout", $dir, $topdir, $subdir);
+ }
+ }
+
+ my $command=findcommand($action, $dir, $topdir, $subdir, $is_checkout);
+
+ if ($is_checkout && ! -d $dir) {
+ print "mr $action: creating parent directory $dir\n" if $verbose;
+ system("mkdir", "-p", $dir);
+ }
+
+ if (! $no_chdir && ! chdir($dir)) {
+ print STDERR "mr $action: failed to chdir to $dir: $!\n";
+ return FAILED;
+ }
+ elsif (! defined $command) {
+ my $vcs=vcs_test(@_);
+ if (! defined $vcs) {
+ print STDERR "mr $action: unknown repository type and no defined $action command for $fulldir\n";
+ return FAILED;
+ }
+ else {
+ print STDERR "mr $action: no defined action for $vcs repository $fulldir, skipping\n";
+ return SKIPPED;
+ }
+ }
+ else {
+ my $actionmsg;
+ if (! $no_chdir) {
+ $actionmsg="mr $action: $fulldir";
+ }
+ else {
+ my $s=$directory;
+ $s=~s/^\Q$fulldir\E\/?//;
+ $actionmsg="mr $action: $fulldir (in subdir $s)";
+ }
+ print "$actionmsg\n" unless $quiet;
+
+ my $hookret=hook("pre_$action", $topdir, $subdir);
+ return $hookret if $hookret != OK;
+
+ my $ret=runsh $action, $topdir, $subdir,
+ $command, \@ARGV, sub {
+ my $sh=shift;
+ if ($quiet) {
+ my $output = qx/$sh 2>&1/;
+ my $ret = $?;
+ if ($ret != 0) {
+ print "$actionmsg\n";
+ print STDERR $output;
+ }
+ return $ret;
+ }
+ else {
+ system($sh);
+ }
+ };
+ if ($ret != 0) {
+ if (($? & 127) == 2) {
+ print STDERR "mr $action: interrupted\n";
+ return ABORT;
+ }
+ elsif ($? & 127) {
+ print STDERR "mr $action: received signal ".($? & 127)."\n";
+ return ABORT;
+ }
+ print STDERR "mr $action: failed ($ret)\n" if $verbose;
+ if ($ret >> 8 != 0) {
+ print STDERR "mr $action: command failed\n";
+ if (-e "$ENV{HOME}/.mrlog" && $action ne 'remember') {
+ # recreate original command line to
+ # remember, and avoid recursing
+ my @orig=@ARGV;
+ @ARGV=('-n', $action, @orig);
+ action("remember", $dir, $topdir, $subdir);
+ @ARGV=@orig;
+ }
+ }
+ elsif ($ret != 0) {
+ print STDERR "mr $action: command died ($ret)\n";
+ }
+ return FAILED;
+ }
+ else {
+ if ($is_checkout && ! -d $dir) {
+ print STDERR "mr $action: $dir missing after checkout\n";;
+ return FAILED;
+ }
+
+ my $ret=hook("post_$action", $topdir, $subdir);
+ return $ret if $ret != OK;
+
+ if (($is_checkout || $is_update)) {
+ my $ret=hook("fixups", $topdir, $subdir);
+ return $ret if $ret != OK;
+ }
+
+ return OK;
+ }
+ }
+}
+
+sub hook {
+ my ($hook, $topdir, $subdir) = @_;
+
+ my $command=$config{$topdir}{$subdir}{$hook};
+ return OK unless defined $command;
+ my $ret=runsh $hook, $topdir, $subdir, $command, [], sub {
+ my $sh=shift;
+ if ($quiet) {
+ my $output = qx/$sh 2>&1/;
+ my $ret = $?;
+ if ($ret != 0) {
+ print STDERR $output;
+ }
+ return $ret;
+ }
+ else {
+ system($sh);
+ }
+ };
+ if ($ret != 0) {
+ if (($? & 127) == 2) {
+ print STDERR "mr $hook: interrupted\n";
+ return ABORT;
+ }
+ elsif ($? & 127) {
+ print STDERR "mr $hook: received signal ".($? & 127)."\n";
+ return ABORT;
+ }
+ else {
+ return FAILED;
+ }
+ }
+
+ return OK;
+}
+
+# run actions on multiple repos, in parallel
+sub mrs {
+ my $action=shift;
+ my @repos=@_;
+
+ $| = 1;
+ my @active;
+ my @fhs;
+ my @out;
+ my $running=0;
+ while (@fhs or @repos) {
+ while ((!$jobs || $running < $jobs) && @repos) {
+ $running++;
+ my $repo = shift @repos;
+ pipe(my $outfh, CHILD_STDOUT);
+ pipe(my $errfh, CHILD_STDERR);
+ my $pid;
+ unless ($pid = fork) {
+ die "mr $action: cannot fork: $!" unless defined $pid;
+ open(STDOUT, ">&CHILD_STDOUT") || die "mr $action cannot reopen stdout: $!";
+ open(STDERR, ">&CHILD_STDERR") || die "mr $action cannot reopen stderr: $!";
+ close CHILD_STDOUT;
+ close CHILD_STDERR;
+ close $outfh;
+ close $errfh;
+ exit action($action, @$repo);
+ }
+ close CHILD_STDOUT;
+ close CHILD_STDERR;
+ push @active, [$pid, $repo];
+ push @fhs, [$outfh, $errfh];
+ push @out, ['', ''];
+ }
+ my ($rin, $rout) = ('','');
+ my $nfound;
+ foreach my $fh (@fhs) {
+ next unless defined $fh;
+ vec($rin, fileno($fh->[0]), 1) = 1 if defined $fh->[0];
+ vec($rin, fileno($fh->[1]), 1) = 1 if defined $fh->[1];
+ }
+ $nfound = select($rout=$rin, undef, undef, 1);
+ foreach my $channel (0, 1) {
+ foreach my $i (0..$#fhs) {
+ next unless defined $fhs[$i];
+ my $fh = $fhs[$i][$channel];
+ next unless defined $fh;
+ if (vec($rout, fileno($fh), 1) == 1) {
+ my $r = '';
+ if (sysread($fh, $r, 1024) == 0) {
+ close($fh);
+ $fhs[$i][$channel] = undef;
+ if (! defined $fhs[$i][0] &&
+ ! defined $fhs[$i][1]) {
+ waitpid($active[$i][0], 0);
+ print STDOUT $out[$i][0];
+ print STDERR $out[$i][1];
+ record($active[$i][1], $? >> 8);
+ splice(@fhs, $i, 1);
+ splice(@active, $i, 1);
+ splice(@out, $i, 1);
+ $running--;
+ }
+ }
+ $out[$i][$channel] .= $r;
+ }
+ }
+ }
+ }
+}
+
+sub record {
+ my $dir=shift()->[0];
+ my $ret=shift;
+
+ if ($ret == OK) {
+ push @ok, $dir;
+ print "\n" unless $quiet;
+ }
+ elsif ($ret == FAILED) {
+ if ($interactive) {
+ chdir($dir) unless $no_chdir;
+ print STDERR "mr: Starting interactive shell. Exit shell to continue.\n";
+ system((getpwuid($<))[8], "-i");
+ }
+ push @failed, $dir;
+ print "\n" unless $quiet;
+ }
+ elsif ($ret == SKIPPED) {
+ push @skipped, $dir;
+ }
+ elsif ($ret == ABORT) {
+ exit 1;
+ }
+ else {
+ die "unknown exit status $ret";
+ }
+}
+
+sub showstats {
+ my $action=shift;
+ if (! @ok && ! @failed && ! @skipped) {
+ die "mr $action: no repositories found to work on\n";
+ }
+ print "mr $action: finished (".join("; ",
+ showstat($#ok+1, "ok", "ok"),
+ showstat($#failed+1, "failed", "failed"),
+ showstat($#skipped+1, "skipped", "skipped"),
+ ).")\n" unless $quiet;
+ if ($stats) {
+ if (@skipped) {
+ print "mr $action: (skipped: ".join(" ", @skipped).")\n" unless $quiet;
+ }
+ if (@failed) {
+ print STDERR "mr $action: (failed: ".join(" ", @failed).")\n";
+ }
+ }
+}
+
+sub showstat {
+ my $count=shift;
+ my $singular=shift;
+ my $plural=shift;
+ if ($count) {
+ return "$count ".($count > 1 ? $plural : $singular);
+ }
+ return;
+}
+
+# an ordered list of repos
+sub repolist {
+ my @list;
+ foreach my $topdir (sort keys %config) {
+ foreach my $subdir (sort keys %{$config{$topdir}}) {
+ push @list, {
+ topdir => $topdir,
+ subdir => $subdir,
+ order => $config{$topdir}{$subdir}{order},
+ };
+ }
+ }
+ return sort {
+ $a->{order} <=> $b->{order}
+ ||
+ $a->{topdir} cmp $b->{topdir}
+ ||
+ $a->{subdir} cmp $b->{subdir}
+ } @list;
+}
+
+sub repodir {
+ my $repo=shift;
+ my $topdir=$repo->{topdir};
+ my $subdir=$repo->{subdir};
+ my $ret=($subdir =~/^\//) ? $subdir : $topdir.$subdir;
+ $ret=~s/\/\.$//;
+ return $ret;
+}