deptool-bootstrap

#!/usr/bin/perl -w
# vim: set filetype=perl: # -*- Perl -*-
#
#  (c) Copyright 2004-2008, Hewlett-Packard Development Company, LP
#
#  See the file named COPYING for license details
=pod

=head1 NAME

deptool - a program for helping with the software development process

=cut

use strict;

use Carp;
use Cwd qw/getcwd chdir/;
use Data::Dumper;
use English;
use Fcntl;
use File::Basename;
use File::Compare;
use File::Copy;
use File::Path;
use File::Find;
use File::stat;
use FileHandle;
use Getopt::Long;
use IPC::Open3;
use MIME::Base64;
use POSIX 'ceil';
use Pod::Usage;
use Safe;
use Sys::Hostname;

# TODO: split this file into separate pieces for the different commands or
# something, it's gotten gigantic.

BEGIN {
    # One use of time in the code; shouldn't really matter, may help a little.
    eval "use Time::HiRes 'time';";
    if ($@) {
        die $@ unless $@ =~ m!Can.t locate Time/Hires.pm in !;
    }
    # Debian Wheezy (7.0) dropped Digest::SHA1
    eval "use Digest::SHA 'sha1_hex';";
    if (!$@) {
        eval 'sub hexDigest { return sha1_hex($_[0]); };';
    } else {
        die $@ unless $@ =~ m!Can.t locate Digest/SHA.pm in !;
        # RHEL5 doesn't have Digest::SHA1 by default, only MD5
        eval "use Digest::SHA1 'sha1_hex';";
        if (!$@) {
            eval 'sub hexDigest { return sha1_hex($_[0]); };';
        } else {
            die $@ unless $@ =~ m!Can.t locate Digest/SHA1.pm in !;

            eval "use Digest::MD5 'md5_hex';";
            die "Can not use Digest::SHA1 or Digest::MD5: $@" if $@;
            eval 'sub hexDigest { return md5_hex($_[0]); };';
            warn "Using Digest::MD5 instead of Digest::SHA1.
Install package or set the DEPTOOL_NOWARN_MD5 environment variable"
                unless defined $ENV{DEPTOOL_NOWARN_MD5};
        }
    }
}


# TODO: pull should walk in the current directory before walking in the
# dependent ones since it may need additional dependencies, and/or they
# may have changed.  Test case is revision in tla that switched the
# dependencies around.

# TODO: check for make file left overs in source directory (these should only
# be in build, or debug, or etc. directories). Jay at least seems to futz up
# and make crap in src every so often those breaking depbuild (or at least
# misleading it as to what has been created and what should be recreated).

# TODO: think about where to document the code to remove the .deptool.build_stamp
# file now present in Lintel/CMakeLists.txt

# TODO: add ability to have hooks for pre-commit checks, this allows
# for mechanical verification of common errors.

# TODO: figure out a way to run all of the deptool commands for
# regression testing; this may need to wait until we have alternative
# monotone directory support.

# TODO: deptool should add text to the checkin message indicating
# whether testing was performed for each commit.

# TODO: ought to separate out all the commands into sub-modules -- would speedup starting deptool,
# and would make the code easier to deal with.

sub usage {
    pod2usage(-exitval => 'NOEXIT', -verbose => 0);
    confess @_ if @_ > 0;
    exit(0);
}

=pod

=head1 SYNOPSIS

 % deptool <command> [--man] [options] [args]
   init --(git|mtn|tar) [--server=<hostname>] [branch-prefix|tar-spec...]
   checkout [--(git|mtn)] [--sub-branch=...] <branch-substring...>
   pull # pull branch and dependencies
   build [-t (and test)] [-d (debug build)] [-o (optimize build)] [-l|local]
   commit [--no-tests] # commit branch after dependencies
   publish [--no-tests] # publish branch and dependencies
   pin <revision> # pin branch at a particular revision
   code-review <revision...> # code-review a revision
   review-status <revision/selector> # check the review status
   help [commands|options|environment|command-name] # get help

=head1 OVERVIEW

The deptool command is designed to assist with the software
development process.  In particular, it has support for getting the
version controlled copy of software via the monotone version control
system, building, committing, and publishing said software after
running appropriate tests, and easing code reviews of a collection of
changes.  Since software often has multiple dependencies that all need
to be built and updated, deptool is able to handle a related set of
software via version control dependencies specified as part of the
source code.  Since you may want to build software with multiple
options, deptool is able to handle additional build-type directories
which will automatically enable configuration with additional
arguments.  Deptool keeps stamp files so that it can avoid rebuilding
and testing a package which has dependencies from two separate places.

In general, use of deptool consists of the following steps:

    % deptool init # initial environment preparation
    % deptool checkout branch-substring... # checkout sources
    % cd ~/projects/project-name
    % deptool build # build project-name and its dependencies
    # edit the source code
    % deptool commit # optional; if it's not yet ready to be public
    % deptool publish # make changes visible to other people

To set up the environment, and make it easier to move between the
source and build directories, you probably want to put something like
the following in your shell startup files; unfortunately the cdopt and
cddebug bits only work under sh-based shells right now.

    DEPTOOL=`(echo $HOME/build/opt*/bin/deptool) 2>/dev/null | awk '{print $1}'`
    eval `$DEPTOOL getenv for-sh`

    s () { eval `$DEPTOOL cdsrc $PWD` }
    b () { eval `$DEPTOOL cdopt $PWD "$@"` }
    d () { eval `$DEPTOOL cddebug $PWD "$@"` }
    # note in bash you have to put returns after the { and before the }

Occasionally if something has been incorrectly committed, or you want
to force reconfiguration, you may need commands like:

    % deptool pin <revision> # work around bad published revision
    % deptool cmake clean # clean out cmake config files
    % deptool cmake # rebuild the cmake configuration
    % make -j $MAKE_PARALLELISM # rebuild in parallel using the deptool env

To use deptool, you need to have at least a minimal deptool.config file 'C<{
}>'.  This file is described in detail in the deptool.config section.  A more
normal configuration file would list the dependencies and enable parallel
testing.  Such a configuration might look like the following:

    {
        dependencies => [qw/Lintel OtherPackage/],
        parallel_test => 1,
    }

=cut

my $auto_yes_to_prompts = 1;
my $quiet = 0;
my $print_manpage = 0;
my $noconfig = 0;
my $debug = 0;

$Global::last_stamp_timestamp = time();

my @original_arguments = @ARGV;
Getopt::Long::Configure(qw/pass_through no_auto_abbrev/);
GetOptions("auto-yes!" => \$auto_yes_to_prompts,
           "quiet!" => \$quiet,
           "noconfig!" => \$noconfig,
           "projects=s" => \$Cache::projects,
           "build-root=s" => \$Cache::build_root,
           "operating-system=s" => \$Cache::operating_system,
           "uname-m=s" => \$Cache::uname_m,
           "build-debug=s" => \$Cache::build_debug,
           "build-opt=s" => \$Cache::build_optimize,
           "man!" => \$print_manpage,
           "monotone-dir=s" => \$ENV{DEPTOOL_MTN_REPO_DIR},
           "debug!" => \$debug);

=pod

=head1 OPTIONS

=over 4

=item --no-auto-yes

Do not automatically answer 'yes' to all of the prompts that are
provided if there is a sane default answer.  Default is true because
in practice that's what everyone did.

=item --quiet

Print out less output by default; the output from the commands being
run will still be printed out.

=item --projects=<path>

Specify the default projects directory.  Normally this would come from
the PROJECTS environment variable, which defaults to ~/projects.

=item --build-root=<path>

Specify the default root build directory.  Normally this would come from
the BUILD_ROOT environment variable, which defaults to ~/build.

=item --operating-system=<string>

Specify the operating system's name.  Normally this would be specified
in the BUILD_OS environment variable, which defaults to various strings depending
on the inferred operating system, e.g. debian-etch, or rhel5.

=item --uname-m=<string>

Specify the hardware machine type.  Normally this would be specified
by the UNAME_M environment variable, which defaults to the output from
uname -m.

=item --build-debug=<path>

Specify the debugging build directory.  Normally this would be
specified by the BUILD_DEBUG environment variable, which defaults to
$BUILD_ROOT/dbg-$BUILD_OS-$UNAME_M, or $BUILD_ROOT/debug if that directory
exists.

=item --build-opt=<path>

Specify the optimize build directory.  Normally this would be
specified by the BUILD_OPT environment variable, which defaults to
$BUILD_ROOT/opt-$BUILD_OS-$UNAME_M, or $BUILD_ROOT/optimize if that
directory exists.

=item --monotone-dir=<path>

Specify the directory to search for monotone databases that include
the current project.  This can be also be specified using the
MONOTONE_DIR environment variable, or failing that, the directory
defaults to $HOME/.monotone.

=item --man

Print out the complete manual page.

=back

=cut

Getopt::Long::Configure(qw/no_pass_through auto_abbrev/);

help("all") if $print_manpage;

usage("Missing argument") if @ARGV == 0;

my %commands = ('checkout' => \&depCheckout,
                'co' => \&depCheckout,
                'pull' => \&depPull,
                'build' => \&depBuild,
#                'clear' => \&depClear,
                'commit' => \&depCommit,
                'publish' => \&depPublish,
                # below commands don't run in all dep dirs.
                'init' => \&depInit,
                'tarinit' => \&depTarInit,
                'cmake' => \&runCMake,
                'pin' => \&setPin,
                'code-review' => \&codeReview,
                'review-status' => \&reviewStatus,
                'mtnpull' => sub { mtnOp("pull"); },
                'mtnpush' => sub { mtnOp("push"); },
                'mtnsync' => sub { mtnOp("sync"); },
                'mtnserve' => \&mtnServe,
                'getenv' => \&getEnv,
                'cdsrc' => \&cdSrc,
                'cdopt' => sub { cdBuild('opt'); },
                'cddebug' => sub { cdBuild('debug'); },
                # get usage without error message
                '-h' => \&usage,
                '--help' => \&usage,
                'help' => sub { help(@ARGV); },
);

=pod

=head1 COMMANDS

Further details on all commands can be found by running C<deptool
help> I<command>

=over 4

=item init [I<--server=hostname>] [I<branch-prefix>]

Initialize the system, this will create the appropriate version
control files, and will pull the initial database(s).

=item tarinit [I</path/to/tar.bz2>...] [I<http://host/path/to/tar>]
      [I<http://host/path/to/latest-release>]

Initialize the system.  This will optionally download and unpack the
specified source packages.

=item checkout I<branch-substring>

Select a particular branch by using branch-substring.  Checkout that
branch and all of its dependencies into $PROJECTS.  You can use co as
a shorter alias for this command.

=item pull

Select the current branch based on the current directory.  Pull the
current branch and all it's dependencies from the server specified in
the _MTN directory.

=item build [I<-t>] [I<-d>] [I<-o>]

Build and install the current branch after building and installing its
dependencies.  Select the type of build (debug or optimized) based on
the current directory or the options.

=item commit [I<--no-tests>] [I<-d>] [I<-o>]

Commit the current branch after committing its dependencies.  If there
are unknown files, prompt for them to be either added or ignored.  If
there are changes, perform a build before performing the commit.

Tests will be run by default before committing, but can be disabled
with --no-tests.  You can also specify the build type to be run before
committing.

=item publish [I<--no-tests>]

Perform the full publishing steps; first run a commit, then build and
test, next pull and update.  If no changes were made, synchronize the
updates to the central server.  Alternately, restart the loop at the
build and test stage.

=item cmake [I<--clean> | I<clean> | I<cmake options...>]

Run the cmake configuration command, or clean out the cmake
configuration files.  See help cmake for details on how cmake is
run.  Additional cmake options can also be specified.

=item pin I<revision>

Pin the current source directory to a particular revision after
updating the current source directory to that revision.

=item code-review I<revision>...

Perform a code review of the selected revisions.  This will treat the
collection of revisions as if they were a single change.  Currently it
works poorly if there are renames in the changes.

=item mtnpull

Run the mtn pull operation with the appropriate options based on the
current directory.

=item mtnpush

Run the mtn push operation with the appropriate options based on the
current directory.

=item mtnsync

Run the mtn sync operation with the appropriate options based on the
current directory.

=item mtnserve [--work-dir=I</path>] [--config-from=I<base-URL>]

Start up a monotone server based on the database for the current
directory, or as a general repository based on the configuration
of some other repository.

=item getenv I<variable> I<for-{sh,csh}>

Print the selected environment information.  If a variable is
specified, then just that variable will be printed.  If for-sh or
for-csh is specified, then all environment variables will be printed
using the syntax of the specified shell.

=item cdsrc I<dir>

Print out the command to cd to the source directory for the specified
directory.

=item cdopt I<dir> [I<build-type>]

Print out the command to cd to the optimized build directory for the
specified directory and optional build type.  Currently does not work
for csh-style shells.

=item cddebug I<dir> [I<build-type>]

Same as cdopt, except for the debug build directory.

=back

=head1 COMMAND DETAILS

=cut

# TODO: when we move to separate modules for all the packages, below should be unnecessary
@deptool::GitVC::ISA = qw/deptool/;
@deptool::MonotoneVC::ISA = qw/deptool/;

main();

sub main {
    my $command = shift @ARGV;
    my $fn = $commands{$command};

    usage("Unrecognized command '$command'") unless defined $fn;
    $|=1;

    # handle case where start dir is a symlink
    aliasChdir($ENV{PWD}) if defined $ENV{PWD};
    &$fn;
}

# TODO: factor this out into a library so that it can be used by lots
# of things.
sub helpSection {
    my ($section) = @_;

    my $fn;

    if ($PERL_VERSION ge v5.10) {
        eval q! # checked on Debian Lenny, openSUSE 11.1
            use IO::String;
            use Pod::Select;
            use Pod::Text::Termcap;

            my $out = IO::String->new;

            podselect({-sections => [$section], -output => $out }, $0);

            my $to_text = new Pod::Text::Termcap;
            $out->setpos(0);
            $to_text->parse_from_filehandle($out);
        !;
        if ($@ && $@ =~ m!Can.t locate IO/String.pm in!o) {
            # Write out to a temporary file.
            eval q!
                use Pod::Select;
                use File::Temp;
                use Pod::Text::Termcap;

                my $fh = new File::Temp();
                # Couldn't figure out how to pass just the handle to podselect;
                # the idiom suggested on the File::Temp page didn't work (wrote
                # to the redirect as if it was a filename)
                podselect({-sections => [$section], -output => $fh->filename }, $0);
                my $to_text = new Pod::Text::Termcap;
                $to_text->parse_from_file($fh->filename);
            !;
        }

    } else {
        # RHEL4 (perl 5.8.5), Debian Etch (perl 5.8.8)
        # -sections => ... works on Etch but not RHEL4
        $fn = eval q!
            my $parser = new Pod::Usage(USAGE_OPTIONS => {-verbose => 99});

            $parser->select($section);
            $parser->parse_from_file($0);
        !;
    }

    die "Eval-for-docs failed: $@" if $@;

    exit(0);
}

sub help {
    my ($what) = @_;
    $what ||= 'all';
    if ($what eq 'all') {
        # Might be able to get rid of the 'user contributed perl doc'
        # stuff in the man page title by invoking perldoc ourselves.
        pod2usage(-verbose => 2, -exitval => 0);
    } elsif ($what eq 'commands') {
        helpSection("COMMANDS");
    } elsif (defined $commands{$what}) {
        helpSection("COMMAND DETAILS/^$what(\\s.*)?\$");
    } else {
        usage("Unknown option to help '$what'");
    }

    exit(0);
}

##### Pre-declarations

sub depWalk ($$$);

##### Dependency Init

=pod

=head2 init [--(mtn|git|tar)] [vc-specific-options] [I<repository/tar specifier>...]

The init command will initialize the default setup for the specified version control system.  If no
version control system is specified, it will default to git.  You can specify at most one of the
different version control systems on a single command line since the behavior is enough different
that specifying multiple ones is unlikely to do the right thing.

=head3 init --git [--server=I<hostname>] [I<repository specifier>]

The init command will initialize the global configuration for git, such as the name and email
address of the committer.  It will also download one or more repositories, by default the one for
contining Lintel.  The repository specifiers can either be short names, such as "simpl/Lintel" in
which case the server hostname will be added or full URLs such as
ssh://git@github.com:dataseries/Lintel.git If you specify a short name, then the default server
will be assumed to be git-pa1.hpl.hp.com, which is only accessible from the HP intranet.

Init will make a full mirror of the remote repositories into $HOME/.git/I<shortname>.  Right now it
assumes that the repositories are readable through the git protocol and writeable through the ssh
protocol, and it will set up the configuration to operate in that mode.

In order to write to a particular project you have to perform two steps.  First you have to send
your ssh key (e.g. $HOME/.ssh/id_rsa.pub; in the format of an authorized_keys file) to the
appropriate administrator.  Second you need to get permission to write to the project.  It is
slightly preferrable to have only one ssh key because it leads to additional work for the
administrator to have multiple ones, but the latter can work.  The expected format of a key is the
openssh authorized_keys format, i.e. a line starting with ssh-rsa (or dsa), then a long series of
alphanumeric characters and then a name for the key (usually an email address).

=head3 init --mtn [--server=I<hostname>] [I<repository specifier>]

This command will also populate the initial database for checkouts, by default, the one that
would contain Lintel since deptool is in Lintel.  By default it assumes that usi.hpl.hp.com is the
central version control server, but this can be overridden with the --server option.  It will use
ssd as the default branch prefix.  If you do not have the environment variables set up by using the
getenv command, deptool will ask a number of questions about where the files should be placed.  It
is usually safe to run the init command with the -y option so that these questions will be
automatically answered.

After you have run init, you will have a key file.  To be able to sync to a particular server, you
need to send the public key to the monotone administrator for that server.  You can get the key
file by running mtn pubkey I<email-address>, the same address you used when running deptool init.
For HP Labs, the administrator of usi.hpl.hp.com is anderse@hpl.hp.com.

B<Warning:> If you already have a key set up on one machine, you should just copy your keys
directory to the new machine rather than creating a new key.  Monotone can get confused by multiple
keys with the same email address.

=head3 init --tar [I<download-specification>]

The tarinit command will initialize the software packages based on tar files.  It has three
possible types of download specifications, listed below.  If no arguments are specified, then it
defaults to http://tesla.hpl.hp.com/opensource/latest-release; which will download the open-source
packages available on tesla and unpack then.

=over 4

=item I</path/to/file.tar.bz2>

This specifies that deptool should unpack the specified tar file into the projects directory.  The
tar file will normally unpack into a directory names I<package>-I<date>, in which case the -I<date>
portion will be removed.  If there is already a I<package> available in the projects directory, it
will only be replaced if it has a different release date than the file.tar.bz2 one.

=item I<http://host/path/to/tar>

This specifies that deptool should first download the tar file into the projects directory and then
unpack it as if the downloaded file had been specified to tarinit.  Deptool will use wget to
download the file.  If the tar file has already been downloaded, it will just be used.

=item I<http://host/path/to/latest-release>

This specifies that deptool should download the specified text file, and should then download all
of the packages specified in the latest-release file.

=back

=cut

sub depInit {
    my %mode;
    my $server;
    Getopt::Long::Configure(qw/pass_through no_auto_abbrev/);
    my $result = GetOptions("server=s" => \$server,
                            "mtn!" => \$mode{mtn},
                            "git!" => \$mode{git},
                            "tar!" => \$mode{tar});
    usage("Unknown error") unless $result;
    Getopt::Long::Configure(qw/no_pass_through auto_abbrev/);
    my $count = 0;
    map { ++$count if $_; } values %mode;
    if ($count == 0) {
        $mode{git} = 1;
    } elsif ($count > 1) {
        die "You must specify at most one of --mtn, --git, or --tar";
    }
    $ENV{MTN_SERVER} = $server if defined $server;
    $ENV{DEPTOOL_GIT_SERVER} = $server if defined $server;
    depInitMtn($server) if $mode{mtn};
    deptool::GitVC::init($server) if $mode{git};
    deptool::TarVC::init() if $mode{tar};
}

sub checkForBinary {
    my ($binary) = @_;

    my @paths = split(/:/, $ENV{PATH});
    foreach my $path (@paths) {
        return 1 if -x "$path/$binary";
    }
    return 0;
}

sub depInitMtn {
    die "Unable to find mtn binary in path; you should repair this.
Usually yum install monotone or apt-get install monotone will work.
http://usi.hpl.hp.com/twiki/pub/USI/MonotoneVersionControl/mtn-static
is a static linux binary, alternately, you can get something from
the monotone web site: http://www.monotone.ca/"
        unless checkForBinary("mtn");

    my $server = mtnServer();
    my $email;
    my @branch_prefixes = @ARGV;
    if (@branch_prefixes == 0) {
        print "Assuming default branch prefix ssd\n";
        @branch_prefixes = ("ssd");
    }

    initMtnDir();
    initMtnKeysRc();

    initMtnDbs($server, \@branch_prefixes);
}

sub initMtnDir {
    my $monotone_dir = mtnRepoDir();
    if (! -d $monotone_dir) {
        userPrompt("Create monotone directory $monotone_dir");
        mkdir($monotone_dir, 0755) or die "Unable to mkdir $monotone_dir: $!";
    }
}

sub initMtnKeysRc {
    my $monotone_dir = mtnRepoDir();
    if (! -d "$monotone_dir/keys") {
        print <<EOF;

The key will be generated with an empty password.  You can change it
by running mtn chkeypass or mtn passphrase depending on your monotone
version.

Run 'deptool help publish' to learn where you have to send your public key
so tha tyou can publish.

WARNING: if you already have a monotone key, you should ctrl-c now, and copy
WARNING: your key file over.  Monotone deals poorly with multiple keys with
WARNING: the same e-mail address.
EOF

        print "Enter e-mail address for identifying monotone key: ";
        my $email = <STDIN>;
        chomp $email;
        die "Unexpected email format '$email'" unless $email =~ /^\S+\@\S+\.\w+$/o;

        runCommand("yes default-password | mtn genkey $email");

        print <<"END";
Key generated with password 'default-password'; can be changed with
mtn chkeypass or mtn passphrase depending on your monotone version
END

        chmod(0700, "$monotone_dir/keys");
        if (-f "$monotone_dir/monotonerc") {
            print <<"EOF";
You probably want to add:
function get_passphrase(keypair_id)
  return "default-password"
end
To your $monotone_dir/monotonerc file
EOF
        } else {
            userPrompt("Create default monotonerc?");
            my $mtnrc = new FileHandle(">$monotone_dir/monotonerc")
                or die "can't write $monotone_dir/monotonerc: $!";
            print $mtnrc <<"EOF";
-- Change with mtn chkeypass or mtn passphrase, then change here.
function get_passphrase(keypair_id)
  return "default-password"
end

-- Next three are for letting you run your own server
function get_netsync_read_permitted (collection, identity)
  return true
end

function get_netsync_write_permitted (identity)
  if (identity == "$email") then return true end
  return false
end

function get_netsync_anonymous_read_permitted (collection)
  return true
end

-- performance optimization
function get_vcache_size()
  return 512*1024*1024
end
EOF
            chmod(0700, "$monotone_dir/monotonerc");
        }
    }
}

sub initMtnDbs {
    my($server, $branch_prefixes) = @_;

    my $monotone_dir = mtnRepoDir();
    foreach my $branch_prefix (@$branch_prefixes) {
        my $db = $branch_prefix;
        $db =~ s/\W.*$//o;
        die "Invalid branch prefix $branch_prefix, should start with normal chars"
            if $db eq '';
        unless (-f "$monotone_dir/${db}.db") {
            userPrompt("create local repository $monotone_dir/${db}.db");
            runCommand("mtn -d $monotone_dir/${db}.db db init");
        }

        userPrompt("pull $branch_prefix* from $server (can take a while)");
        my $qm = quotemeta $branch_prefix;
        runCommand("mtn -d $monotone_dir/${db}.db pull $server $qm\\*");
    }
}

=pod

=head2 tarinit [--no-cache] [I<download-specification>]

Deprecated form of init --tar; will be removed after 2012-12-31.

=cut

sub depTarInit {
    warn "tarinit is deprecated, and will be removed after 2012-12-31,
it has been replaced by init --tar for consistency with the other forms
of init";
    deptool::TarVC::init();
}

##### Dependency Checkout

=pod

=head2 checkout [--(git|mtn)] [--sub-branch=...] I<branch-substring>...

The checkout command, which can be abbreviated as co, checks out a branch and its dependencies.  It
will find the appropriate branch by selecting from all the branches in the repositories found under
~/.git, and the databases found as ~/.monotone/*.db.  It will then attempt to select the most
appropriate matching branch.  If there is a conflict between the git and the monotone options, it
will default to the git option.  This process will repeat for all dependencies of the package you
selected, for example, if you checked out DataSeries, checkout would checkout Lintel automatically.
If a sub-branch is specified, then deptool will add that sub-branch to all branches if it exists.
If it doesn't exist, deptool will check out the main branch.  For example if you check out
--sub-branch=feature/parallel DataSeries, deptool will checkout DataSeries/feature/parallel, and
Lintel/feature/parallel if it exists.  You can also specify required sub-branches in the branch
strings, e.g. checkout --git Lintel/feature/parallel.  Error checking for nonsensical combinations
of checkouts is not well implemented.

=head3 checkout --git

Deptool will first find all of the available repositories and branches under ~/.git.  It will
construct long branch names that combine the repository name with the branch name, treating the
master branch as empty.  E.g. if you have a repository simpl/Lintel with branches master,
feature/goodness, and personal/eric; you will get a list simpl/Lintel, simpl/Lintel/master,
simpl/Lintel/feature/goodness, simpl/Lintel/personal/eric.  It will then identify all branches that
match the specified substring, and select the shortest one if it is a unique prefix of the others
and otherwise report an error.

Deptool will select the directory name based on the last part of the repository name, e.g. if the
repository is named simpl/something/Project, the directory name for the checkout will be
~/projects/Project.  The root for checkouts can be changed by setting $PROJECTS.

=head3 checkout --mtn

Deptool will automatically select the branch that matches with the least length so it will ignore
sub-branches that may be present.  For example, if you ran checkout Data, it would select the
ssd.hpl.hp.com/DataSeries branch and put the checkout in ~/projects/DataSeries (by default,
changeable by setting $PROJECTS).

Deptool will choose the directory name based on the branch name after stripping out the initial
uniquifier.  This is based on the assumption that branches will be named as
I<uniquifier>/I<branch-name>/I<sub-branch>.

If multiple branches match and they do not share a common prefix, deptool will abort the checkout.

=head2 co

See help checkout

=cut

# TODO: general consensus between Joe and Eric is that if you do a checkout of a related set of
# sub-branches that all the sub branches should show up in their primary directory.  e.g. 'deptool
# co --sub-branch=testing KeyValue' should pick out all the testing sub-branches in the ~5
# recursive dependencies of KeyValue, and put them in directories named KeyValue, SimReal, gflib,
# etc.  The rationale is that in this situation you probably are using separate PROJECTS and
# BUILD_* directories.
#
# However, you can also want a separate sub-directory for a related version of a package, e.g.  if
# you are working on the parallel mode for DataSeries, or support for git in deptool, you can want
# to keep that separate from the existing primary branch, in which case having the checkout in
# Lintel_git, which allows you to work in a separate directory or branch, but still get it
# installed into the common location so that it can be tested.
#
# Support for the former mode is pretty complete since you can set PROJECTS and BUILD_OPT, and the
# right thing just happens; support for the latter is manual.  If we are going to support common
# use of transient branches for git, then we probably want to support commands like make-subbranch,
# propagate (to a further sub-branch or to a separate branch), and delete-subbranch; or some
# equivalent set of commands.  For now the conclusion is that we need to gain some experience
# working with git to get better feel for how working with branches should operate, i.e. just do it
# manually and eventually encode a workflow into deptool.  We may want to have related sub-branches
# like DataSeries_parallel_sort and _parallel_analysis for which propagate up and down the tree is
# simplified.

sub depCheckout {
    my ($mtn, $git, $sub_branch);
    my $result = GetOptions("mtn" => \$mtn, "git" => \$git, "sub-branch=s" => \$sub_branch);
    usage("Unknown error") unless $result;
    usage("No branch-substrings specified") unless @ARGV > 0;
    unless ($mtn || $git) {
        $mtn = $git = 1;
    }

    my @branches;
    my %branch_to_info;

    depCheckoutGetMtnBranches(\@branches, \%branch_to_info) if $mtn;
    depCheckoutGetGitBranches(\@branches, \%branch_to_info) if $git;

    my @branch_regexes = (@ARGV);
    my %did_regex;
    while (@branch_regexes > 0) {
        my $branch_regex = shift @branch_regexes;
        next if $did_regex{$branch_regex};
        $did_regex{$branch_regex} = 1;

        my $branch = depCheckoutSelectBranch($branch_regex, \@branches, \%branch_to_info);
        if (defined $sub_branch) {
            my $tmp = eval { depCheckoutSelectBranch("$branch_regex/$sub_branch", \@branches,
                                                     \%branch_to_info); };
            if (!$@ && defined $tmp) {
                $branch = $tmp;
            } else {
                print "WARNING: no sub-branch found matching $branch_regex/$sub_branch\n";
            }
        }

        my $info = $branch_to_info{$branch};
        my $fn = $info->{fn};
        my $path = &$fn($branch, $info);

        my $config = readConfig($path);
        if (defined $config->{dependencies} && @{$config->{dependencies}} > 0) {
            print "Adding VC dependencies: ", join(" ", @{$config->{dependencies}}), "\n";
            push(@branch_regexes, @{$config->{dependencies}});
        }
    }
}

sub depCheckoutSelectBranch {
    my ($branch_regex, $branches, $branch_to_info) = @_;

    $branch_regex =~ s/;\w+//o;
    $branch_regex = "/$branch_regex" unless $branch_regex =~ m!^/!o;
    my @possibles = grep(m/$branch_regex/, @$branches);
    die "No branches found matching $branch_regex"
        unless @possibles > 0;
    @possibles = sort { length $a <=> length $b } @possibles;

    my %vcs;
    map { my $info = $branch_to_info->{$_} || die "?"; $vcs{$info->{vc}} = 1; } @possibles;
    if ($vcs{git} && $vcs{mtn}) { # prefer git to mtn.
        print "Found both git and monotone dbs.  Pruning out monotone dbs for
 $branch_regex, use --mtn to force usage\n";
        @possibles = grep($branch_to_info->{$_}->{vc} ne 'mtn', @possibles);
    }
    my $branch = shift @possibles;
    foreach $_ (@possibles) {
        die "multiple non-prefixed matches for $branch_regex:
$branch $_
You need to provide more specificity in the dependencies in deptool.config\n "
            unless /^$branch/;
    }

    return $branch;
}

sub depCheckoutGetMtnBranches {
    my ($branches, $branch_to_info) = @_;

    my @dbs = glob(mtnRepoDir() . "/*.db");
    return if @dbs == 0; # Just be silent for case where someone is git (or svn) only.
    @dbs = sort @dbs;

    foreach my $db (@dbs) {
        my $tmp = new FileHandle("mtn -d $db list branches |");
        my @tmp = <$tmp>;
        close($tmp);
        grep(chomp, @tmp);
        push(@$branches, @tmp);
        map {
            warn "duplicate db ($db, $branch_to_info->{$_}->{mtn_db}) for branch $_
will use latter."
                if defined $branch_to_info->{$_} && defined $branch_to_info->{$_}->{mtn_db};
            $branch_to_info->{$_} = { mtn_db => $db, fn => \&depCheckoutMonotoneCheckout,
                                      vc => 'mtn' };
        } @tmp;
    }
}

sub depCheckoutGetGitBranches {
    my ($branches, $branch_to_info) = @_;

    my $git_repo_dir = gitRepoDir();
    my @repo_dirs;
    find(sub {
             return unless -d "$_/objects";
             # branches doesn't always exist
             foreach my $subdir (qw!hooks info objects objects/pack objects/info refs!) {
                 return unless -d "$File::Find::name/$subdir";
             }
             foreach my $subfile (qw!config description HEAD!) {
                 return unless -f "$File::Find::name/$subfile";
             }
             push(@repo_dirs, $File::Find::name);
             $File::Find::prune = 1;
         }, "$git_repo_dir/"); # extra / to force lookup through symlink
    # in case working dir is local but git repo is on a shared filesystem.
    print "Found repo dirs: @repo_dirs\n";
    foreach my $repo_dir (@repo_dirs) {
        my $prefix = $repo_dir;
        die "? $prefix $git_repo_dir"
            unless substr($prefix, 0, length $git_repo_dir) eq $git_repo_dir;
        substr($prefix, 0, length $git_repo_dir) = '';
        print "$prefix:\n";
        my $qm = quotemeta $repo_dir;
        my $fh = new FileHandle("git --git-dir=$qm branch |")
            || die "Can't run git branch: $!";
        my @sub_branch;
        while (<$fh>) {
            die "? $_ " unless /^\*? +(\S+)$/o;
            print "  $1\n";
            push (@sub_branch, $1);
            push (@sub_branch, "") if $1 eq 'master';
        }
        close($fh);
        die "git branch failed: $?" unless $? == 0;
        foreach my $sub_branch (@sub_branch) {
            my $branch = $prefix;
            $branch .= "/$sub_branch" unless $sub_branch eq '';
            die "? $branch" if defined $branch_to_info->{$branch};
            $branch_to_info->{$branch} = { git_dir => $repo_dir, fn => \&depCheckoutGitCheckout,
                                           co_path => $prefix, vc => 'git',
                                           sub_branch => $sub_branch };
            push(@$branches, $branch);
        }
    }
}

sub depCheckoutMonotoneCheckout {
    my ($branch, $info) = @_;
    my $db = $info->{mtn_db};
    my $dir = $branch;
    $dir =~ s!^\w+(\.\w+)*/!!o; # strip uniqueifier we put on

    my $path = projects() . "/$dir";
    print << "END";

Selected monotone branch $branch from database $db
Checking out into: $path
END

    if (-d "$path/_MTN") {
        print "Found $path/_MTN; skipping redundant checkout.\n";
    } else {
        die "$path already exists; mtn checkout would fail"
            if -d $path;
        userPrompt("continue even though you have a / in the directory")
            if $dir =~ m!/!o;

        runCommand(qw/mtn -d/,$db,qw/co -b/,$branch,$path);
    }
    return $path;
}

sub depCheckoutGitCheckout {
    my ($branch, $info) = @_;

    my $co_path = $info->{co_path};

    $co_path =~ s!^.*/!!o;

    my $path = projects() . "/$co_path";

    print << "END";

Selected git branch $branch from $info->{git_dir}
Cloning into $path
END

    if (-d "$path/.git") {
        print "Found $path/.git; skipping redundant clone.\n";
    } else {
        die "$path already exists; not managed by git?"
            if -d $path;
        my @sub_branch;
        push(@sub_branch, '-b', $info->{sub_branch})
            unless $info->{sub_branch} eq '';
        runCommand(qw/git clone -o local-cache/, @sub_branch, $info->{git_dir}, $path);
        # Clone appears to copy config entries, e.g. user.email, merge.tool by default, so we don't
        # have to fix that up.
        my @common = (qw/git --git-dir/, "$path/.git");
        # I think that the + in the remote.local.fetch config entry is fine because it is
        # updating the remotes/local/* set of things.
        my $remote_to_info = deptool::GitVC::getAllRemotes($info->{git_dir});
        die "Unable to find origin remote in $info->{git_dir}"
            unless defined $remote_to_info->{origin};
        my $branch = $info->{sub_branch} || 'master';
        my @opts = ('-m', $branch, 'origin', $remote_to_info->{origin}->{fetch});
        # git fetch origin '+refs/heads/*:refs/remotes/origin/*'
        runCommand(@common, qw/remote add -f/, @opts);
        runCommand(@common, qw/remote set-url --push origin/, $remote_to_info->{origin}->{push});
        runCommand(@common, 'config', "branch.$branch.remote", 'origin');
    }
    return $path;
}

sub depCheckoutGitGetRemoteFetch {
    my ($git_dir) = @_;
    my $fh = new FileHandle("git --git-dir $git_dir remote -v |")
        or die "Unable to list remotes in $git_dir: $!";

    while (<$fh>) {
        return $1 if /^origin\s+(\S+)\s+\(fetch\)/o;
    }
    die "Unable to find origin-fetch URL in $git_dir";
}


##### Dependency build

=pod

=head2 build [I<-t>] [I<-d>] [I<-o>] [I<-l|--local>]

This command will build the current project directory after building and
installing all of the dependencies.  The type of build is determined by the
current directory and the options.  If either -d or -o are specified, then we
perform a debug or an optimized build respectively.  If we are in the projects
directory or an optimized build directory, we perform an optimized build.  If
we are in a debug build directory, we perform a debug build.  If -t is
specified, tests will be run in addition to building and installing each of the
packages.  If -l is specified, only the build for the local directory will be
performed, none of the dependencies will be rebuilt.

If a directory hasn't been configured, then the deptool cmake command
will be automatically run to configure the package before it is built.

=cut

sub depBuild {
    my %options = (tests => 0, local_only => 0);

    my $cwd = aliasGetCwd();
    my $debug = buildDebug();
    if ($cwd =~ /^$debug/o) {
        $options{mode} = 'debug';
    } else {
        $options{mode} = 'optimize';
    }

    my $ret = GetOptions("t|tests!" => \$options{tests},
                         "o|optimize" => sub { $options{mode} = 'optimize' },
                         "d|debug" => sub { $options{mode} = 'debug' },
                         "l|local!" => \$options{local_only});

    usage("unknown option to build") unless $ret;

    $options{builddir} = $options{mode} eq 'debug' ? buildDebug() : buildOpt();
    $options{projects} = projects();

    return depBuildParallel(\%options);
}

sub parseDependency {
    my ($dep) = @_;
    my $sub_build_type;
    $dep =~ s!^[^/]*/!!;
    if ($dep =~ /^(.+);(\w+)$/o) {
        ($dep,$sub_build_type) = ($1,$2);
    }
    $sub_build_type ||= '';
    return ($dep, $sub_build_type);
}

sub dbpFindOld {
    my ($src) = @_;
    confess "?? $src" unless defined $src && -d $src && -f ".deptool.build_stamp";

    my $ref_stat = stat(".deptool.build_stamp")
        or die "Unable to stat .deptool.build_stamp: $!";
    my @newer;
    find(sub { return unless -f $_;
               # Assume changes in the version control directories don't matter; otherwise
               # we have to re-test after committing
               return if $File::Find::name =~ m!^$src/_MTN!;
               return if $File::Find::name =~ m!^$src/\.git!;
               my $stat = stat($_) or die "can't stat $_: $!";
               push(@newer, $File::Find::name)
                   if $stat->mtime() > $ref_stat->mtime(); }, $src);

    return @newer;
}

sub dbpBuildMake {
    my($src, $build) = @_;

    if (-f ".deptool.build_stamp") {
        print "depbuild: $build already has current build\n";
        return;
    }
    if (! -f "Makefile" || ! -d "CMakeFiles" || ! -f "CMakeCache.txt") {
        local @ARGV = ();
        print "depbuild: creating makefile in $build\n";
        runCMakeConfig();
    }

    print "depbuild: building...\n";
    my $make_parallelism = makeParallelism();
    runCommand("make", "-j", $make_parallelism);
    stamp("build");
}

sub stampUpToDate {
    my($which, $options) = @_;

    return 0 unless -f ".deptool.${which}_stamp";
    my $build_stat = stat(".deptool.build_stamp")
        or confess "Unable to stat .deptool.build_stamp: $!";
    my $which_stat = stat(".deptool.${which}_stamp")
        or die "Unable to stat .deptool.${which}_stamp: $!";
    if (defined $options && $which eq "install") {
        my $lastbuild = $options->{"lastbuild $options->{building}"};
        if (!defined $lastbuild || $lastbuild < $which_stat->mtime()) {
            $options->{"lastbuild $options->{building}"} = $which_stat->mtime();
        }
    }
    return ($which_stat->mtime() > $build_stat->mtime());
}

sub stampTime {
    my ($build_path, $which) = @_;

    my $file = "$build_path/.deptool.${which}_stamp";
    return 0 unless -f $file;
    my $stat = stat($file) or die "Can't stat $file: $!";
    return $stat->mtime();
}

sub stamp {
    my($which, $options) = @_;

    my $filename = ".deptool.${which}_stamp";

    my $fh = new FileHandle("+>>$filename")
        or die "Can't open $filename for append: $!";
    close($fh);

    ++$Global::last_stamp_timestamp; # ensure uniqueness
    while (1) {
        my $now = time();
        utime undef, undef, $filename;
        my $st = stampTime(".", $which);

        if ($now < $st - 2 || $now > $st + 2) {
            my $delta = $now - $st;
            warn "Weird discrepancy in filesystem timestamp vs. machine timestamp.
Machine is at $now, Filesystem at $st, machine - fs = $delta";
        }

        if ($st >= $Global::last_stamp_timestamp) {
            $Global::last_stamp_timestamp = $st;
            last;
        }

        print "deptool: sleep(0.25) for unique .deptool.*_stamp file timestamps\n"
            if 0;
        select(undef,undef,undef, 0.25);
    }
}

sub projectBuildPath {
    my ($build_dir, $project, $sub_type) = @_;

    confess "internal" unless defined $build_dir;
    my $dir = "$build_dir/$project";
    $dir .= "-$sub_type" if $sub_type ne '';
    return $dir;
}

sub dbpOutOfDate {
    my ($build_path, $dependencies, $info) = @_;

    my $build_stamp = stampTime($build_path, "build");
    my $out_of_date = $build_stamp > 0 ? 0 : 1;
    my $deps_done_all_installs = 1;

    map {
        my $path = $_;
        my $dep_info = $dependencies->{$path};

        if ($dep_info->{src} eq $info->{src}) {
            # ignore self dependencies
        } else {
            if ($dep_info->{done_install}) {
                my $them_install_stamp = stampTime($path, 'install');
                $out_of_date = 1 if $build_stamp <= $them_install_stamp;
            } else {
                $deps_done_all_installs = 0;
            }
        }
    } keys %{$info->{deps}};

    return ($build_stamp, $deps_done_all_installs, $out_of_date);
}

sub dbpStartBuild {
    my ($children, $pending, $dependencies) = @_;

    for (my $i=0; $i < @$pending; ++$i) {
        my ($build_path, $type) = @{$pending->[$i]};
        next unless $type eq 'build';

        unless (-d $build_path) {
            mkpath($build_path) or die "Can not mkdir($build_path): $!";
        }
        aliasChdir($build_path);

        my $info = $dependencies->{$build_path};

        my ($build_stamp, $deps_done_all_installs, $out_of_date)
            = dbpOutOfDate($build_path, $dependencies, $info);

        next unless $deps_done_all_installs;

        splice(@$pending, $i, 1);

        aliasChdir($build_path);

        if (!$out_of_date && $build_stamp > 0) {
            my @old = dbpFindOld(projects() . "/$info->{src}");
            if (@old > 0) {
                print "Local rebuild of $build_path\n";
                $out_of_date = 1;
            }
        }

        if ($out_of_date) {
            print "Start build in $build_path\n";
            unlink(".deptool.build_stamp");
            $info->{running_build} = 1;

            $children->fork(
                 cmd => sub {
                     # builds are nice to be behind install/test
                     POSIX::nice(10) or die "nice failed: $!";
                     dbpBuildMake($info->{src}, $build_path);
                 },
                 exitfn => sub { $info->{running_build} = 0; $info->{status_build} = $_[1]; },
                 stdout => 'deptool.build.out', stderr => 'deptool.build.err');

            return $build_path;
        } else {
            print "Up to date build in $build_path\n";
            $info->{done_build} = 1;
            return undef;
        }
    }
    # print "No builds active\n";
    return undef;
}

sub dbpGetCTestInfo {
    my $tests = new FileHandle "ctest -N |"
        or die "Can't run ctest -N";
    $_ = <$tests>;
    $_ = <$tests> if /^Start processing tests$/o; # cmake 2.4, 2.6 line
    die "unexpected line from ctest" unless /^Test project \S+$/o;

    my $maxtest = 0;
    my @testlist;
    while(<$tests>) {
        next if /^\s*$/o;
        if (/^Total Tests: (\d+)$/o) {
            die "$maxtest != $1" unless $maxtest == $1;
            $_ = <$tests>;
            last unless defined $_;
            die "Unexpected ctest output";
        }
        die "?" unless m!^\s*\d+/\s*(\d+)\s* Testing (\S+)\s*$!o
            || /^  Test\s+\#(\d+): (.+)$/o;
        push(@testlist, $2);
        die "$1 < $maxtest" if $1 < $maxtest;
        $maxtest = $1;
    }
    close($tests);
    die "test count mismatch" unless @testlist == $maxtest;
    return @testlist;
}

sub dbpGetTestStatus {
    my ($num) = @_;

    my $file = "Testing/Parallel/$num/handler_output";
    my $fh = new FileHandle($file) or die "can't read $file: $!";
    $_ = <$fh>;
    die "unexpected ctest handler_output" unless /^Test project \S+$/o;
    $_ = <$fh>;
    die "unexpected ctest handler_output" unless /^$/o;
    $_ = <$fh>;
    my ($tnum, $tnum_line, $test_name, $status);
    if (m!^\s*(\d+)/$!o) { # ctest 2.4, 2.6
        ($tnum, $tnum_line) = ($1, $_);
        $_ = <$fh>;
        chomp;
        die "$file missing test status '$_'?"
            unless m!^\s*\d+ Testing (.*?)\s+(\S+)\s*$!o;
        ($test_name, $status) = ($1, $2);
    } elsif (m!^\s+Start (\d+): !o) { # ctest 2.8
        ($tnum, $tnum_line) = ($1, $_);
        $_ = <$fh>;
        die "unexpected ctest handler_output" unless /^$/o;
        $_ = <$fh>;
        die "unexpected ctest handler_output" unless m!^\s*(\d+)/$!o;
        $_ = <$fh>;
        die "unexpected ctest output '$_'"
            unless m!^\s*\d+ Test #\d+: (\S+)\s+.+\s(\w+)\s+\d+\.\d+ sec$!o;
        ($test_name, $status) = ($1, $2);
    } else {
        die "unexpected line from ctest '$_'";
    }
    die "internal $tnum $num" unless $tnum == $num;
# TODO: handle file like:
#Test project /.home-bill-h/anderse/build/opt-debian-4.0-i686/KeyValue
#
#110/
#158 Testing fs-disk-converge-retrieve-fail***Exception:
#SegFault
#
#0% tests passed, 1 tests failed out of 1
#
#        110 - fs-disk-converge-retrieve-fail (SEGFAULT)

    return ("${tnum_line}$_", $test_name, $status);
}

sub dbpReadCTestOutput {
    my ($filename) = @_;

    my $fh = new FileHandle($filename) or die "Unable to open $filename for read: $!";
    my $cur_section = 'unknown';
    my $ret = {};
    while (<$fh>) {
        if (s/\[([A-Z_]+)\] \n$//o) {
            my $new_section = $1;
            $ret->{$cur_section} .= $_ if $_ ne '';
            $cur_section = $new_section;
        } else {
            $ret->{$cur_section} .= $_;
        }
    }
    die "did not find sections in $filename" if $cur_section eq 'unknown';

    return $ret;
}

sub dbpRunIndividualTest {
    my ($test) = @_;

    print "Start test at ", time, "\n";
    $ENV{DEPTOOL_PARALLEL_TEST_NUM} = $test;
    my $testdir = "Testing/Parallel/$test";
    my $time = "/usr/bin/time";
    $time = '' unless -x $time;
    my $fh = new FileHandle("$time ctest -V -O $testdir/log -I $test,$test,1 2>&1 |")
        or die "Can not fork ctest: $!";

    while(<$fh>) {
        # throw this all away, it's intermingled output streams
        # without any signals of separation, so is effectively
        # useless.
        if (/user.*system.*CPU/o) {
            print $_;
        }
    }
    my $ok = close($fh) || 0;
    print "End test at ", time, "\n";

    my $sections = dbpReadCTestOutput("$testdir/log");

    while (my ($section, $data) = each %$sections) {
        $section =~ tr/A-Z/a-z/;
        my $filename = "$testdir/$section";
        my $fh = new FileHandle(">$filename") or die "can not write $filename: $!";
        print $fh $data or die "can't print to $filename: $!";
        close($fh) or die "can't close $filename: $!";
    }

    if ($ok) {
        rename("$testdir/handler_verbose_output", "$testdir/success_output")
            or die "rename failed: $!";
        die "Ok, but missing Passed in handler_output"
            unless $sections->{HANDLER_OUTPUT} =~ /Passed/o;
        exit(0);
    } else {
        rename("$testdir/handler_verbose_output", "$testdir/failure_output")
            or die "rename failed: $!";
        die "Not ok, but have Passed in handler_output"
            if $sections->{HANDLER_OUTPUT} =~ /Passed/o;
        exit(3);
    }
}

sub dbpDoParallelTest {
    my ($build_path, $config) = @_;

    my @testlist = dbpGetCTestInfo();

    die "unimplemented no tests" unless @testlist > 0;

    my $children = Lintel::ProcessManager->new(auto_kill_on_destroy => 1);
    my $parallelism = $ENV{MAKE_PARALLELISM} || 1;

    map { rmtree($_) if -d $_ } qw(Testing/Temporary Testing/Parallel);

    mkpath("Testing/Parallel");

    my @status = map { 77 } 1 .. scalar @testlist;

    my $starttest = sub {
        my ($test) = @_;

        my $testdir = "Testing/Parallel/$test";
        mkdir($testdir, 0777) or die "Can not mkdir $testdir: $!";

        $children->fork(cmd => sub { dbpRunIndividualTest($test); },
                        exitfn => sub { $status[$test] = $_[1]; },
                        stdout => "$testdir/deptool_out", stderr => 'STDOUT');
    };

    my %sequential_tests;
    if (defined $config->{sequential_tests}) {
        print "Running sequential tests.\n";
        foreach my $test (@{$config->{sequential_tests}}) {
            my @match_nums;
            for (my $testnum = 0; $testnum < @testlist; ++$testnum) {
                next unless $testlist[$testnum] =~ /$test/;
                push (@match_nums, $testnum + 1); # ctest counts from 1.
            }
            die "Did not find any test that matched $test"
                unless @match_nums > 0;
            foreach my $match_num (@match_nums) {
                if ($sequential_tests{$match_num}) {
                    warn "Already ran test $match_num ($test)";
                    next;
                }
                $sequential_tests{$match_num} = 1;
                print "Test $match_num\n";
                &$starttest($match_num);
                $children->wait();
                die "?" unless $children->nChildren() == 0;
            }
        }
    }

    print "Running parallel tests:\n";
    for (my $i = @testlist; $i >= 1; --$i) {
        next if $sequential_tests{$i};
        my $running = $children->nChildren() + 1; # add the one we're about to start
        my $remain = $i - 1;
        print "Start test $i; $running running, $remain remain\n";
        &$starttest($i);
        while ($children->nChildren() >= $parallelism) {
            $children->wait();
        }
    }
    while ($children->nChildren() > 0) {
        my $running = $children->nChildren();
        print "$running running, 0 remain\n";
        $children->wait();
    }
    print "All tests finished.\n";

    my @all;
    my @failed;
    for (my $i = 1; $i <= @testlist; ++$i) {
        my ($line, $testname, $status) = dbpGetTestStatus($i);
        push (@all, $line);
        if ($status eq 'Passed') {
            die "status mismatch ($status[$i]) != 0" unless $status[$i] == 0;
        } else {
            die "status mismatch ($status, $status[$i])" unless $status[$i] == 3 << 8;
            push(@failed, [$testname, "Testing/Parallel/$i/failure_output"] );
        }
    }

    if (@failed == 0) {
        print "Test Status:\n";
        print @all;
        exit(0);
    } else {
        system("cat $failed[0]->[1]");
        print "\n\n------\nSOME TESTS FAILED.\n", @all, "\n";
        print "Failing tests: ", join(", ", map { $_->[0] } @failed), "\n";
        print "Output from $failed[0]->[0] shown above\n";
        print "All failure data present as $build_path/Testing/Parallel/*/failure_output\n";
        exit(1);
    }
}


sub dbpStartParallelTest {
    my ($children, $info, $build_path, $config) = @_;

    print "Starting parallel test in $build_path\n";
    $info->{"running_test"} = 1;

    $children->fork(cmd => sub { dbpDoParallelTest($build_path, $config); },
                    exitfn => sub { $info->{"running_test"} = 0; $info->{status_test} = $_[1]; },
                    stdout => "deptool.test.out", stderr => "deptool.test.err");

    return $build_path;
}

sub dbpStartWhich {
    my ($which, $children, $pending, $dependencies) = @_;

    for (my $i=0; $i < @$pending; ++$i) {
        my ($build_path, $type) = @{$pending->[$i]};
        next unless $type eq $which;

        my $info = $dependencies->{$build_path};

        next unless $info->{done_build};

        splice(@$pending, $i, 1);

        my $build_stamp = stampTime($build_path, "build");
        my $which_stamp = stampTime($build_path, $which);

        if ($which_stamp <= $build_stamp) {
            aliasChdir($build_path);
            if ($which eq 'test') {
                my $config = readConfig(projects() . "/$info->{src}");
                if ($config->{parallel_test}
                    || (defined $config->{parallel_test_path}
                        && &{$config->{parallel_test_path}}($build_path))) {
                    return dbpStartParallelTest($children, $info, $build_path, $config);
                }
            }

            print "Starting $which in $build_path\n";
            $info->{"running_$which"} = 1;
            $children->fork(cmd => "make $which",
                            stdout => "deptool.$which.out", stderr => "deptool.$which.err",
                            exitfn => sub { $info->{"running_$which"} = 0;
                                            $info->{"status_$which"} = $_[1]; });
            return $build_path;
        } else {
            print "Up to date $which in $build_path\n";
            $info->{"done_$which"} = 1;
            return undef;
        }
    }
    # print "No $which active\n";
    return undef;
}

sub dbpFinishWhich {
    my ($which, $running, $dependencies) = @_;

    my $dir = $running->{$which};
    return 1 unless defined $dir;
    my $info = $dependencies->{$dir};

    die "??" unless defined $info->{"running_$which"};
    unless ($info->{"running_$which"} == 0) {
        # print "$which not done\n";
        return 1;
    }

    die "internal" unless defined $info->{"status_$which"};
    aliasChdir($dir);
    if ($info->{"status_$which"} == 0) {
        print "Successful finish of $which of $dir.";
        my $errors = "$dir/deptool.$which.err";
        if (-s $errors == 0) {
            print " No error output.\n";
        } else {
            print " Error/warning output (stderr):\n";
            my $fh = new FileHandle($errors)
                or die "Can't open $errors for read: $!";
            while (<$fh>) {
                print "  $_";
            }
            close($fh);
        }
        stamp($which);
        $info->{"done_$which"} = 1;
        $running->{$which} = undef;

        if ($which eq 'build') {
            my ($build_stamp, $deps_done_all_installs, $out_of_date)
                = dbpOutOfDate($dir, $dependencies, $info);
            die "Internal error, not up to date" if $out_of_date || ! $deps_done_all_installs;
        }
        return 1;
    } else {
        print "\n";
        print "--------------------\n";
        print "ERROR: failed $which in $dir\n";
        print "-------------------- STDOUT:\n";
        system("cat deptool.$which.out");
        if (-s "deptool.$which.err") {
            print "\n-------------------- STDERR:\n";
            system("cat deptool.$which.err");
        }
        return 0;
    }
}

sub depBuildStandard {
    my %options = @_;
    $options{mode} = 'optimize';
    $options{tests} = 1 unless defined $options{tests};
    $options{builddir} = buildOpt();
    $options{projects} = projects();

    return depBuildParallel(\%options);
}

sub depBuildParallel {
    my ($options) = @_;

    my $projects = projects();
    my $start_src = rootSrcDir();
    $start_src =~ s!^.*/!!o;

    my $start_dir = aliasGetCwd();
    # Calculate all things we could build and their dependencies
    my %dependencies;
    my @pending = ([$start_src,'']);
    while (@pending > 0) {
        my ($src, $sub_build_type) = @{shift @pending};
        my $build_path = projectBuildPath($options->{builddir}, $src, $sub_build_type);
        next if defined $dependencies{$build_path};
        aliasChdir("$projects/$src");

        my $info = $dependencies{$build_path} = {
            src => $src,
            deps => {}
        };

        next if $options->{local_only};
        my @vcdeps = getVCDeps(aliasGetCwd());
        foreach my $dep (@vcdeps) {
            my ($dep_project, $dep_sub_type) = parseDependency($dep);

            my $dep_src = "$projects/$dep_project";
            depWalkTryCheckout($dep_project) unless -d $dep_src;

            push(@pending, [$dep_project, $dep_sub_type]);
            my $dep_path = projectBuildPath($options->{builddir}, $dep_project, $dep_sub_type);
            $info->{deps}->{$dep_path} = 1;
        }
    }

    # reverse is a hack to classify some bits later until I can fix it to
    # estimate and order
    foreach my $build_dir (reverse sort keys %dependencies) {
        map { push(@pending, [ $build_dir, $_ ]); } qw/build test install/;
    }

    @pending = grep ($_->[1] ne 'test', @pending) unless $options->{tests};

    my %running;
    my $children = Lintel::ProcessManager->new(auto_kill_on_destroy => 1);

    my $prev_pending_size = @pending;
    # Process everything we have to process.
    my $ok = 1;

    while (@pending > 0 || $children->nChildren() > 0) {
        if ($ok) {
            unless (defined $running{build}) {
                $running{build} = dbpStartBuild($children, \@pending, \%dependencies);
            }
            foreach my $which (qw/install test/) {
                next if defined $running{$which};
                $running{$which} = dbpStartWhich($which, $children, \@pending, \%dependencies);
            }
        } else {
            last if $children->nChildren() == 0;
        }

        if (@pending == $prev_pending_size) {
            # only wait if we couldn't get anything removed
            die "Not making progress, no children ok=$ok; '$pending[0]->[1]' '$pending[0]->[0]'"
                unless $children->nChildren() > 0;

            my %finished = $children->wait(10);

            if (scalar keys %finished == 0) {
                print "Waiting on:\n";
                foreach my $which (qw/build install test/) {
                    next unless defined $running{$which};
                    my $dir = $running{$which};
                    my $fh = new FileHandle "$dir/deptool.$which.out"
                        or die "Can't open $dir/deptool.$which.out for read: $!";
                    $dir =~ s!^.*/!!o;
                    my $lastline = '';
                    while (<$fh>) {
                        $lastline = $_;
                    }
                    chomp $lastline;
                    print "  $which in $dir: $lastline\n";
                }
            } else {
                foreach my $which (qw/build install test/) {
                    unless (dbpFinishWhich($which, \%running, \%dependencies)) {
                        print "Failed on $which in $running{$which}\n";
                        $ok = 0;
                    }
                }
            }
        }
        $prev_pending_size = @pending;
    }

    unless ($ok) {
        print "Exiting on error, check previous output for precise problem.\n";
        exit(1);
    }

    aliasChdir($start_dir); # TODO: figure out why this isn't already happening, we can be left in the wrong dir
    return %$options;
}

##### Set pin

=pod

=head2 pin I<revision>

Occasionally someone will publish an update to a project that works
for that project, but breaks a project that depends on it.  If they
didn't test that project, then builds will fail until the software is
repaired.  In order to work around this problem, you can pin the
revision back to the one that used to work.  This command only works
in a source directory.  If the current source directory isn't at the
specified revision, then it will update to the specified revision.
The pin will remain until the head revision for the project changes,
as the assumption is that when the head revision changes it has fixed
the bug.

=cut

sub setPin {
    my $vcs = createVCInterface();

    die "Have unknown files; setpin is disallowed"
        if depCommitHaveUnknown();
    die "Have changes; setpin is disallowed"
        if $vcs->haveUncommittedChanges();
    my @heads = deptool::MonotoneVC::getCurHeads();
    die "Have multiple heads; setpin is disallowed"
        unless @heads == 1;
    my($revision) = @ARGV;

    if (defined $revision) {
        runCommand("mtn","update","-r",$revision);
    }

    $revision = deptool::MonotoneVC::getCurRevision()
        unless defined $revision;

    my $filename = depPinFilename();
    my $fh = new FileHandle ">>$filename"
        or die "Unable to open $filename for append: $!";
    print $fh "$heads[0] $revision\n";
    print "Pinning to $revision so long as head remains at $heads[0]\n";
    close($fh);
}

##### Dependency pull

=pod

=head2 pull [--unsafe]

If you want to update your local repositories and projects, but aren't yet
ready to make your changes available or just want changes other people have
made, then pull is the command you want to use.  Pull will walk all of the
directories dependent on your current directory and will pull data from the
central server and then update the local directory.  If you happen to have
outstanding changes, pull will normally perform a commit before doing the
update so that you wouldn't accidentally destroy your current changes.  If you
are sure that you want to pull despite having changes, you can use the --unsafe
option.

=cut

sub depPull {
    my %options;

    my $ret = GetOptions("unsafe!" => \$options{unsafe_pull_with_changes});
    usage("unknown options to pull") unless $ret;

    depWalk(sub { depPullCheckClean(\%options) },
            sub { depPullOne(\%options); }, 0);
}

sub depPullOne {
    my($options) = @_;

    my $vcs = createVCInterface();

    depCommitOne() unless $options->{unsafe_pull_with_changes};
    $vcs->pull($options);
}

sub depPinFilename {
    return "$ENV{HOME}/.monotone/deptool-version-pins";
}

sub depPullCheckClean {
    my ($options) = @_;

    return if $options->{unsafe_pull_with_changes};
    my $cwd = aliasGetCwd();

    my $vcs = createVCInterface();
    if (depCommitHaveUnknown($vcs)) {
        die "You have unknown files in $cwd
Requiring you to commit first. Aborting.\n";
    }
    if ($vcs->haveUncommittedChanges()) {
        die "You have uncommitted changes in $cwd
Requiring you to commit first. Aborting.\n";
    }
}

##### Dependency commit

=pod

=head2 commit [--no-tests]

If you have a set of changes that are sufficiently complete to pass
all the tests, but not yet ready for publishing, then you can run
deptool commit in order to commit all of the changes you have made as
well as any changes in dependent projects.  Commit will first run all
of the tests to verify that the changes are internally consistent.

=cut

sub depCommit {
    my %options = ('tests' => 1);
    my $ret = GetOptions("t|tests!" => \$options{tests});
    usage("unknown option to commit") unless $ret;

    depCommitOptions(%options);
}

sub depCommitOptions {
    my (%options) = @_;

    %options = depBuildStandard(%options);
    depWalk(sub { }, sub { depCommitOne(%options); }, 0);
}

sub depCommitOne {
    my %options = @_;
    my $cwd = aliasGetCwd();
    my $vc_interface = createVCInterface($cwd);

    depCommitUnknown();
    depCommitDoCommit(%options);
}

sub ignoresFileName ($) {
    my ($vcs) = @_;
    return $vcs->globalDir() . "/deptool-commit-ignores";
}

sub depCommitUnknown {
    my $vcs = createVCInterface();
    my $cwd = aliasGetCwd();
    # TODO: check to make sure that we properly add recursive subdirectories;
    # there seemed to be a bug in this.  Unknown if moving the
    # haveUnknown/getUnknown bits into the while loop will fix it.
    while(1) {
        return unless depCommitHaveUnknown($vcs);
        my @unknown = $vcs->listUnknownFiles();

        print "You have un-added files in $cwd:\n";
        print join("\n", @unknown);
        print "\n\nDo you want to ignore or add them [no-default]?";
        $_ = <STDIN>;
        chomp;
        if ($_ eq 'ignore') {
            my $sha1 = hexDigest(join('',@unknown));
            my $ignores_name = ignoresFileName($vcs);
            my $fh = new FileHandle ">>$ignores_name"
                or die "Can't open $ignores_name: $!";
            print $fh "$cwd $sha1\n";
            close($fh);
            return;
        } elsif ($_ eq 'add') {
            print "Adding files...\n";
            $vcs->addAllUnknownFiles();
            return;
        } else {
            print "Expected 'ignore' or 'add', not '$_'; try again\n";
        }
    }
}

sub depCommitHaveUnknown {
    my ($vcs) = @_;
    my @unknown = $vcs->listUnknownFiles();

    return 0 if @unknown == 0;
    my $fh = new FileHandle ignoresFileName($vcs);
    if ($fh) {
        my $cwd = aliasGetCwd();
        my $sha1 = hexDigest(join('', @unknown));
        while(<$fh>) {
            return 0 if $_ eq "$cwd $sha1\n";
        }
    }

    return 1;
}

sub depCommitDoCommit {
    my $vcs = createVCInterface();
    my %options = @_;
    my $cwd = aliasGetCwd();
    my $first_time = 1;
    while(1) {
        if (!$vcs->haveUncommittedChanges()) {
            print "depcommit: no changes in $cwd\n"
                if $first_time;
            return;
        }

        $auto_yes_to_prompts = 0 unless $first_time;
        $first_time = 0;
        print "depcommit: you have uncommitted differences in $cwd
depcommit: will show differences after successful build\n";
        userPrompt("build");
        depBuildStandard(%options);
        print "\n" x 20;
        aliasChdir($cwd);
        last if $vcs->tryCommit();
    }
}

##### runCMake

=pod

=head2 cmake [I<--clean> | I<clean> | I<cmake options...>]

This command has to be run in either the build or debug directory.  In the build directory, it will
set the install prefix to $BUILD_OPT and the cmake build type to RelWithDebInfo.  In the debug
directory, it will set the install prefix to $BUILD_DEBUG and the cmake build type to Debug.  If
you are in a sub-type build directory (see cdopt), then the deptool cmake command will
automatically add -DBUILD_SUBDIR=I<sub-type> to the cmake instantiation so that the configuration
can take into effect the sub-type.  You can set the environment variable DEPTOOL_CMAKE_FLAGS if
there are additional flags that need to be passed to cmake.  You can also specify directory
specific options on the command line.

=cut

sub runCMake {
    my $clean = 0;
    Getopt::Long::Configure('pass_through');
    my $result = GetOptions("clean!" => \$clean);
    usage("Unknown argument to runCMake") unless $result;

    if ($clean) {
        usage("unexpected extra arguments") unless @ARGV == 0;
    } elsif (defined $ARGV[0] && $ARGV[0] eq 'clean') {
        usage("unexpected extra arguments") unless @ARGV == 1;
        runCMakeClean();
    } else {
        runCMakeConfig(@ARGV);
    }
}

sub runCMakeClean {
    my $cwd = aliasGetCwd();
    my $projects = projects();
    my $debug = buildDebug();
    my $opt = buildOpt();

    die "Will not clean unless under projects, debug or optimize dir"
        unless $cwd =~ m!^(($projects)|($debug)|($opt))/!o;
    print "Cleaning cmake files out of $cwd\n"
        unless $quiet;
    my @files;
    my @dirs;
    find(sub { push(@files, $File::Find::name) if /^CMakeCache.txt$/o
                   || /^Makefile$/o;
               push(@dirs, $File::Find::name) if /^CMakeFiles$/o; },
         $cwd);
    unlink(@files) == scalar @files
        or die "Unable to unlink one of @files: $!";
    rmtree(\@dirs);
    map { die "unable to delete $_" if -d $_ } @dirs;
    return 0;
}

sub runCMakeConfig {
    my @extra_args = @_;

    my $cwd = aliasGetCwd();
    my ($src, $build_subdir) = srcDir();
    my $debug = buildDebug();
    my $opt = buildOpt();

    die "Unable to find expected deptool.config file in $src"
        unless -f "$src/deptool.config";

    my @cmakecmd = ('cmake');
    if ($cwd =~ /^$debug/o) {
        push(@cmakecmd, "-D", "CMAKE_INSTALL_PREFIX=$debug", "-D",
             "CMAKE_BUILD_TYPE=Debug");
    } elsif ($cwd =~ /^$opt/o) {
        push(@cmakecmd, "-D", "CMAKE_INSTALL_PREFIX=$opt", "-D",
             "CMAKE_BUILD_TYPE=RelWithDebInfo");
    } else {
        die "Not under optimize or debug directory; aborting";
    }

    if (defined $build_subdir) {
        push(@cmakecmd, "-D", "BUILD_SUBDIR=$build_subdir");
    }
    push(@cmakecmd, @extra_args);
    if (defined $ENV{DEPTOOL_CMAKE_FLAGS}) {
        push(@cmakecmd, split(/\s+/o, $ENV{DEPTOOL_CMAKE_FLAGS}));
    }
    push(@cmakecmd, $src);
    eval { runCommand(@cmakecmd) };
    if ($@) {
        my $err = $@;

        warn $err;
        my $dep_info = "$src/doc/dependencies.txt";
        if (-r $dep_info && -f $dep_info) {
            my $fh = new FileHandle $dep_info
                or die "Unable to open $dep_info for read: $!";
            my $os = operatingSystem();
            my @deps;
            while (<$fh>) {
                next unless /^\S.*\($os\):/o;
                push(@deps, $_);
                while (<$fh>) {
                    last unless /^\s+/o || /^$/o;
                    push(@deps, $_);
                }
                last;
            }
            close($fh);
            print STDERR "\ncmake failed. You may be missing required dependencies.\n";
            if (@deps > 0) {
                print STDERR "From $dep_info:\n\n";
                print STDERR @deps;
            } else {
                print STDERR "Unable to find dependencies for $os.\n";
                print STDERR "You may find similar OSs in $dep_info.\n";
            }
        }
        exit(1);
    }
}

##### Monotone operations

=pod

=head2 mtnpull

Run the appropriate mtn pull command for the current directory.  The
command will automatically use the right database and branch based on
the current directory, and can be run in both the source directory and
the build directory.  Does not update the current directory, and does
not run for dependencies.

=head2 mtnpush

Run the appropriate mtn push command for the current directory.  The
command will automatically use the right database and branch based on
the current directory, and can be run in both the source directory and
the build directory.  Does not update the current directory, and does
not run for dependencies.

=head2 mtnsync

Run the appropriate mtn sync command for the current directory.  The
command will automatically use the right database and branch based on
the current directory, and can be run in both the source directory and
the build directory.  Does not update the current directory, and does
not run for dependencies.

=cut

sub mtnOp {
    my($op) = @_;

    die "??" unless $op =~ /^((pull)|(push)|(sync))$/o;
    my $src = rootSrcDir();
    die "missing $src/_MTN" unless -d "$src/_MTN";
    my %mtn_opts = deptool::MonotoneVC::readMtnOptions($src);
    my $branch = $mtn_opts{branch};
    my $database = $mtn_opts{database};

    die "? no branch" unless defined $branch;
    die "? no database" unless defined $database;

    my $syncbranch = $branch;
    $syncbranch =~ s!^(.*/.*)/.*$!$1!o;
    my $server = mtnServer();
    my $maybe_proto= substr($server,0,4);
    if ($maybe_proto eq "ssh:") {
        $server = $server . basename($database);
    }

    runCommand("mtn","-d",$database,$op,$server,"$syncbranch*");
    runCommand("mtn","-d",$database,'heads','-b',$branch);
}

=pod

=head2 mtnserve [options]

Run the mtn serve command with the appropriate database based on the
current directory, or as a general repository based on the configuration
of some other repository.

If no options are specified, this variant is intended to be used with the
MTN_SERVER environment variable and the mtn{pull,push,sync} sub-commands to
move a few revisions between databases. The database for the current source
directory is identified and a monotone server is started for that database.
This usage is currently deprecated unless it turns out to be useful in which
case we will revisit that decision.

The variant with options is intended to be used to set up an untested repository, as
controlled by the untested_repository option in the deptool.config file.  This variant
is identified by specifying the config-from option.  Options include:

=over 4

=item --config-from=I<base-url>

The the monotonerc and public keys are downloaded from that URL (after
appending /monotonerc, and /pubkeys).  They are loaded into a special
'serve.db' database.

=item --work-dir=I<path>

The work-dir option can be specified to control where the database, public keys
and monotonerc will be stored.  By default this will be ~/.monotone/untested-repo.

=item --push-to=I<server>:I<project>

The push-to option specifies a server and a project to push the updates to if
the project builds and passes tests.

=item --rebuild-log=I<path>

The rebuild-log option specifies a filename where the result of the most recent rebuild
should be stored.  The output is in html form, so can be viewed through a web browser.

=back

=cut

sub mtnServe {
    my ($work_dir, $config_from, $push_to, $rebuild_log);

    my $result = GetOptions("config-from=s" => \$config_from,
                            "work-dir=s" => \$work_dir,
                            "push-to=s" => \$push_to,
                            "rebuild-log=s" => \$rebuild_log);
    usage("Unknown error") unless $result;

    my $vcs = createVCInterface();
    if (defined $config_from) {
        mtnServeGeneral($work_dir, $config_from, $push_to, $rebuild_log);
    } else {
        warn "Deprecating the local mode of mtn serve, will be removed after 2011-06-01;
report if you are still using it and how the general mode is insufficient";
        die "Unable to support work dir/push_to/rebuild-log in local mode"
            if defined $work_dir || defined $push_to || defined $rebuild_log;

        my $src = rootSrcDir();
        my %mtn_opts = deptool::MonotoneVC::readMtnOptions($src);
        die "? no database" unless defined $mtn_opts{database};

        my $vcver = $vcs->versionString();
        if ($vcver =~ /^monotone-0.28\b/o) {
            runCommand("mtn","-d",$mtn_opts{database},'serve','*');
        } elsif ($vcver =~ /^monotone-0.4\d\b/o) {
            runCommand("mtn","-d",$mtn_opts{database},'serve');
        } else {
            die "Don't know how to run serve on $vcver";
        }
    }
}

sub urlMirror {
    my ($from, $to) = @_;

    my $ret = mirror($from, $to);
    die "Unable to fetch $from to $to: $ret"
        unless $ret == 200 || $ret == 304;
}

sub mtnServeGeneral {
    my ($work_dir, $config_from, $push_to, $rebuild_log) = @_;

    eval "use LWP::Simple; use HTML::Parser;";
    die $@ if $@;

    # setup: copy config, prepare db/keys

    $work_dir = "$ENV{HOME}/.monotone/untested-repo" unless defined $work_dir;
    mkpath("$work_dir/pubkeys");
    if (defined $config_from) {
        print "Mirroring monotonerc, pubkeys from $config_from...\n";
        urlMirror("$config_from/monotonerc", "$work_dir/serve.rc");
        my $key_list = get("$config_from/pubkeys");
        die "Unable to get $config_from/pubkeys" unless defined $key_list;

        my @keys;
        my $parser = HTML::Parser->new(api_version => 3,
                                       start_h => [ sub { push(@keys, $_[0]->{href}); }, 'attr']);
        $parser->parse($key_list);
        @keys = grep(defined && /\.pubkey$/o, @keys);
        map { urlMirror("$config_from/pubkeys/$_", "$work_dir/pubkeys/$_") } @keys;
    }
    unless (-f "$work_dir/serve.db") {
        runCommand('mtn', '-d', "$work_dir/serve.db", 'db', 'init');
    }
    runCommand("cat $work_dir/pubkeys/*.pubkey | mtn -d $work_dir/serve.db read");

    my $pm = Lintel::ProcessManager->new();
    my @args = ('mtn', '-d', "$work_dir/serve.db", '--norc', '--rcfile', "$work_dir/serve.rc");

    # start push-to process
    if (defined $push_to) {
        die "Invalid push to, expected server:project" unless $push_to =~ /^(.+):(\w+)$/o;
        my ($host, $project) = ($1,$2);
        unlink(glob("$work_dir/to-push-*.db"));
        writeFile("$work_dir/next-sync-id", "0");
        my $push_pid = $pm->fork(cmd => sub { mtnServePushTo($work_dir, $host, $project,
                                                             $rebuild_log); },
                                 stdout => "$work_dir/push_to.log", stderr => 'STDOUT',
                                 exitfn => sub { print "Unexpected exit of push-to, consult $work_dir/push_to.log\n"; exit(1); });
        writeFile("$work_dir/push_to.sh", <<"END");
#!/bin/sh
ID=`cat $work_dir/next-sync-id`
cp -p $work_dir/serve.db $work_dir/to-push-\$ID.db
kill -USR1 $push_pid
END
        writeFile("$work_dir/push_to.rc", <<"END");
function note_netsync_end (session_id, status, bytes_in, bytes_out, certs_in, certs_out, revs_in,
                           revs_out, keys_in, keys_out)
   if revs_in + certs_in > 0 then
       return execute("lintel-flock", "--filename", "$work_dir/next-sync-id", "--",
                      "/bin/sh", "$work_dir/push_to.sh");
   end
end
END
        push(@args, "--rcfile", "$work_dir/push_to.rc");
    }
    push (@args, 'serve');

    # start the mtn server
    $pm->fork(cmd => \@args, stdout => "$work_dir/serve.log", stderr => 'STDOUT',
              exitfn => sub { print "Unexpected exit of mtn server, examine $work_dir/serve.log\n";
                              exit(1); });
    print "Server starting, logging to $work_dir/*.log\n";
    $pm->waitAll();
}

sub mtnServePushTo {
    my ($workdir, $host, $project, $rebuild_log) = @_;

    my $updated = 0;
    $SIG{USR1} = sub {
        print "Got signal\n" if 0;
        $updated = 1;
    };

    my $push_count = 0;
    $ENV{PROJECTS} = "$workdir/projects";
    $ENV{BUILD_OPT} = "$workdir/build";
    $ENV{MONOTONE_DIR} = "$workdir/dbs";
    $ENV{MTN_SERVER} = $host;
    $ENV{PATH} = "$workdir/build/bin:$ENV{PATH}";

    mkpath("$workdir/dbs");
    symlink("$workdir/keys", "$workdir/dbs/keys")
        or warn "symlink failed: $!";
    readlink("$workdir/dbs/keys") eq "$workdir/keys" or die "?";
    my $pm = Lintel::ProcessManager->new();
    my $failure_count = 0;
    my $last_heads = '';
    while (1) {
        print "Push to waiting...\n";
        while (!$updated) {
            if ($failure_count > 0 && $failure_count < 5) { # at least one, not too many
                print "(... 10-15s before retry ...)\n";
                sleep(10);
                runCommand("/bin/sh $workdir/push_to.sh") unless $updated;
                while (!$updated) {
                    sleep(1); # wait for signal to arrive
                }
            } else {
                sleep(600);
            }
        }
        my $now = scalar localtime(time);
        print "\n---------------------------------------------------------\n";
        print "Updated at $now, id=$push_count\n";
        $updated = 0;
        my $push_id = $push_count;
        {
            my $fh = Lintel::File::Lock::getLock("$workdir/next-sync-id");
            ++$push_count;
            seek($fh, 0, Fcntl::SEEK_SET);
            print $fh $push_count;
            close($fh);
        }
        die "missing $workdir/to-push-$push_id.db" unless -f "$workdir/to-push-$push_id.db";
        rename("$workdir/to-push-$push_id.db", "$workdir/dbs/to-push.db");
        print "Rebuilding, testing, pushing; logging to $workdir/push-one.log\n";
        my $pid = $pm->fork('cmd' => sub {
                                runCommand("deptool checkout $project");
                                chdir("$workdir/projects/$project")
                                    or die "chdir $workdir/projects/$project failed: $!";
                                runCommand("deptool pull");
                                mtnServePushToBackpropagate($host);
                                # survive errors in publish
                                eval { runCommand("deptool publish"); };
                                my $error = $@;
                                mtnServePushToBackpropagate($host);
                                die $error if $error;
                                exit(0);
                            }, 'stdout' => "$workdir/push-one.log", 'stderr' => 'STDOUT');
        my %pid_to_status = $pm->waitAll();
        die "internal" unless defined $pid_to_status{$pid};

        my $output = readFile("$workdir/push-one.log");
        my @heads = grep(/^HEADS /o, split(/\n/o, $output));
        die "Missing heads?" unless @heads > 0;
        my $new_heads = join('', @heads);
        if ($pid_to_status{$pid} == 0) {
            print "Success at $now\n";
            $failure_count = 0;
        } else {
            if ($last_heads eq $new_heads) {
                print "Unchanged heads ($new_heads)\n";
            } else {
                print "Heads have changed, reseting failure count\n";
                $failure_count = 0;
            }
            ++$failure_count;
            print "Failure $failure_count at $now\n";
        }
        $last_heads = $new_heads;
        if (defined $rebuild_log) {
            unlink($rebuild_log);
            mkpath($rebuild_log);
            grep(s!HEADS (\w+):!  <LI> <B>$1</B>:!o, @heads);
            my $result = $pid_to_status{$pid} == 0 ? qq(<FONT COLOR="green">Success</FONT>)
                : qq(<FONT COLOR="red">Failure</FONT>);

            my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
            my $outpath = sprintf("%s/%04d-%02d-%02dT%02d:%02d:%02d.html", $rebuild_log,
                                  $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
            writeFile($outpath, <<"END");
<H1>$result on rebuild at $now</H1>
<H2>Head revisions:</H2>
<UL>
@heads
</UL>
<H2>Log:</H2>
<PRE>
$output
</PRE>
END
            unlink("$rebuild_log/current.html");
            symlink($outpath, "$rebuild_log/current.html") or die "symlink failed: $!";
        }
    }
    exit(0);
}

sub mtnServePushToBackpropagate {
    my ($host) = @_;
    $ENV{MTN_SERVER} = 'localhost';
    depWalk(sub {
        my @heads = deptool::MonotoneVC::getCurHeads();
        my ($project, @rest) = divideDir(aliasGetCwd());
        print "HEADS $project: @heads\n";
        mtnOp("push"); # push anything we got to the untested server
    }, sub { }, 0);
    $ENV{MTN_SERVER} = $host;
}

##### depPublish

=pod

=head2 publish [--no-tests]

The publish command is the core logic for making changes globally
available.  It performs the following steps:

  made_changes = true
  while made_changes {
      made_changes = false
      Build and test (C<deptool build -t>)
      Commit any local changes (C<deptool commit>)
      Pull from the central server (C<deptool pull>)
      if made_changes == false {
          Synchronize with the central server
          # if we got changes here, print a warning before continuing
      }
  }

Normally, before you can publish you will need to get authorization at the
central server.  In order to do so, for monotone, you would run C<mtn pubkey>
I<email-address> and send the result to the appropriate administrator.

The --no-tests option is only valid if an untested_repository has been
specified in the deptool.config file. It won't run the tests, but will
compile and publish to the untested_repository.

=cut

sub depPublish {
    my %options = ('tests' => 1);
    my $ret = GetOptions("t|tests!" => \$options{tests});
    usage("unknown option to publish") unless $ret;

    unless ($options{tests}) {
        my $config = readConfig(rootSrcDir());
        die "Unable to publish without tests unless untested_repository option
is set in deptool.config"
            unless defined $config->{untested_repository};
        $ENV{MTN_SERVER} = $config->{untested_repository};
    }
    print "deppublish: committing any outstanding changes\n";
    print "  cwd = ", aliasGetCwd(), "\n" if $debug;
    depCommitOptions(%options);
    print "  cwd = ", aliasGetCwd(), "\n" if $debug;
    $options{made_changes} = 1;

    while ($options{made_changes}) {
        $options{made_changes} = 0;
        print "deppublish: verifying current version passes regression tests\n";
        depBuildStandard(%options);
        print "deppublish: pulling in any remote changes\n";
        print "  cwd = ", aliasGetCwd(), "\n" if $debug;
        depWalk(sub { }, sub { depPullOne(\%options); }, 0);

        unless ($options{made_changes}) {
            print "\n" x 5;
            print <<"END";
*** Running the sync.  In the unlikely case that you get any updates, you ***
*** need to get them tested and synchronized quickly because they made it ***
*** out so other people can see them. ***
END
            print "  cwd = ", aliasGetCwd(), "\n" if $debug;
            depWalk(sub { }, sub { depSyncOne(\%options); }, 0);
            print "****** WARNING, got changes; re-running deppublish...\n"
                if $options{made_changes};
        }
    }
}

sub depSyncOne {
    my($options) = @_;

    my $vcs = createVCInterface()->sync($options);
}

##### Code review diff

=pod

=head2 code-review I<revision>...

The code-review command is designed to help performing code reviews of
a set of related changes.  For a single revision, it is exactly
equivalent to running kdiff3 on all files that were changed in
I<revision>.

If multiple revisions are specified, the first step is to build a
single diff between the parent of the earliest revision specified and
the latest revision specified.  Therefore, the code review code will
first sort the revisions by the date they were committed.  Then it
will checkout the parent of the first revision.  Then for each
revision I<r> in date order, it will apply the patch between I<r> and
I<r>'s parent, which may not be the previous listed revision.
Assuming each of the patch commands succeeds, the resulting directory
will be the equivalent of just applying the updates specified by the
revisions in order.

If one of the patches does not succeed, the code review will prompt
the user to make a repair patch, in particular by creating the file
that should have been created.  The code review tool with then store
the additional patch in /tmp so that it can be re-applied if
necessary.

Regardless, eventually a pair of directories will be created, the
first being the parent of the earliest revision, and the last being
the result of applying all of the patches for each revision and any
recovery patches.  The code review tool then will proceed to review
each of the files that have changed.  It will sort the files such that
cmake files go before others, tests come next, and then headers and
c++ files in alphabetical order.  The user can override this default
order by creating the file /tmp/diff-order-I<last-revision>.txt,
usually by starting with the one specified.

The tool will then prompt for a command.  Commands include:

=over

=item auto

automatically move onto the next step until we get to the end, or the
diff ordering file changes.

=item files

print a list of all the files that are going to be compared

=item reviewed [I<comments>]

specify that the revisions under code-review have been reviewed, and optionally
include a comment on the review.  Review status can be determined by using
C<deptool review-status>.

=item finish

clean up all temporary files, then exit.

=item exit

stop the code review; do not clean up temporary files.

=item ask

ask whether you wanted to mark the revisions as reviewed or finish.  This is the
default when hitting return at the end of the review.

=item help

get help usage

=item I<filename-substring>

select the unique filename that matches I<filename-substring> to be reviewed
next, or if multiple files match, then choose the alphabetically first one.

=back

Usually users will just hit return to bring up the kdiff3 window for
comparing the two files until they get to the end.  They can
alternately use the auto command to skip having to hit return.

=head3 BUGS

=over

=item *

renames currently confuse the code review tool.

=item *

should check *.patch.err file to see if we have any skipped patches,
this can occur as a result of renames and as a result of added files in
skipped revisions

=item *

what in the world do we do to help people review merge revisions?  Occasionally
people actually edit when they merge (because of a conflict), and it could be
useful to review those, but what would we review it against?  Would a three-way
merge make sense?

=back

=cut

sub codeReview {
    my @revisions = @ARGV;

    $auto_yes_to_prompts = 0;
    my $root_src_dir = rootSrcDir();
    aliasChdir($root_src_dir);
    die "No revisions specified." if @revisions == 0;

    eval 'use File::Copy::Recursive "rcopy";';
    die "aptitude install libfile-copy-recursive-perl
yum -y install perl-File-Copy-Recursive?\n$@" if $@;
    my %parents;
    my %dates;
    my $branch;
    my $vcs = createVCInterface();
    $vcs->codeReviewPrep();
    my @full_revs;
    foreach my $revision (@revisions) {
        my $info = $vcs->parseRevisionInfo($revision);

        if (ref $info->{ancestor}) {
            print "Revision $revision appears to be a merge
revision.  That is currently not supported for viewing differences.  Most
likely, the revision was a mistake in specifying the revision to review.
However, if you know an appropriate way to review merge revisions, please
provide feedback.\n";
            userPrompt("Continue reviewing");
            $info->{ancestor} = "merge:$info->{ancestor}->[0]";    # lie
            $info->{revision} = "merge:$info->{revision}";     # mark as merge
        }
        foreach $_ (qw/revision ancestor date branch/) {
            die "Missing requiring revision info $_ on revision $revision"
                unless defined $info->{$_};
            if (ref $info->{$_}) {
                $info->{$_} = $info->{$_}->[0];
            }
        }
        die "Duplicate revision $revision specified?"
            if defined $parents{$info->{revision}};
        $parents{$info->{revision}} = $info->{ancestor};
        $dates{$info->{revision}} = $info->{date};
        $branch = $info->{branch} unless defined $branch;
        unless($branch eq $info->{branch}) {
            userPrompt("continue through mismatch on branches for specified revisions?\n ($branch != $info->{branch})");
            $branch = $info->{branch};
        }
    }

    @revisions = sort { $dates{$a} cmp $dates{$b} } keys %parents;

    my $basedir = "/tmp/code-review-" . getpwuid($UID);
    my $original_dir = $parents{$revisions[0]};
    my $final_dir = $revisions[@revisions - 1];
    if (-d $basedir && -d "$basedir/$original_dir" &&
        -d "$basedir/$final_dir" && -f "$basedir/diff-order") {
        print "$basedir already exists, as do the relevant
first and last revisions and the diff-order file.
Assuming you just want to continue reviewing.\n";
    } elsif (-d $basedir) {
        print "Missing expected files to continue diffing in $basedir\n";
        print "Return to delete, ctrl-c to abort: ";
        $_ = <STDIN>;
        rmtree($basedir);
    }

    if (! -d $basedir) {
        mkdir($basedir, 0755) or die "unable to mkdir $basedir: $!";
        codeReviewSequence($vcs, \@revisions, \%parents, $basedir);
    } else {
        kdiffDirs($vcs, $basedir, $original_dir, $final_dir, \@revisions);
    }
}

sub codeReviewSequence {
    my ($vcs, $revs, $parents, $basedir) = @_;

    die "no revisions?" unless @$revs > 0;
    my @revisions = grep(!/^merge:/o, @$revs);
    my ($start, $last);

    if (@revisions > 0) {
        $start = $parents->{$revisions[0]};

        print "Trying to build single sequence diff from ",
            substr($start,0,20), " to ", substr($revisions[@revisions-1],0,20),
                "\n  using ", join(", ", map { substr($_, 0, 8) } @revisions), "\n";

        $vcs->codeReviewCheckout("$basedir/$start", $start);

        $last = $start;
        while (@revisions > 0) {
            my $to = $revisions[0];
            my $from = $parents->{$to};

            print "Trying to patch $last\n   with ", substr($from, 0, 20),
                " -> ", substr($to, 0, 20), "\n";

            codeReviewPatch($vcs, $basedir, $last, $from, $to);
            $last = $to;
            shift @revisions;
        }

        print "Successfully built single sequence for review.\n";

        makeDiffOrder($basedir, $start, $last);
    } else {
        print "No files to review, all specified revisions are merge revisions.\n";
        my $fh = new FileHandle ">$basedir/diff-order" or die "bad";
        close($fh);
        ($start, $last) = ('no-such-directory', 'no-such-directory');
    }

    kdiffDirs($vcs, $basedir, $start, $last, $revs);
}

# TODO-sprint: make .thrift files show up early by default.
sub makeDiffOrder {
    my ($basedir, $original_dir, $final_dir) = @_;

    my $reference_file = "/tmp/diff-order-$final_dir.txt";
    if (-f $reference_file) {
        print "$reference_file exits; just using it.\n";
        copy($reference_file, "$basedir/diff-order")
            or die "copy failed: $!";
        return;
    }
    my @changed = getChanged($basedir, $original_dir, $final_dir);

    my %file_key;
    map { die "?? $_" unless m!^(.+/)?([^/]+?)(?:\.(\w+))?$!o;
          my ($dir, $name, $suffix) = ($1, $2, $3);
          $dir ||= '';
          $suffix ||= 'no-suffix';
          my $test_key = $dir =~ m!/tests\b!o ? 0 : 1;
          my $thrift_key = $suffix eq 'thrift' ? 0 : 1;
          my $header_key = $suffix eq 'hpp' ? 0 : 1;
          my $cmake_key = $name =~ /^CMake/o ? 0 : 1;

          # sort cmake files first, then tests, then by filename
          # sorting headers before sources.

          $file_key{$_} = "$cmake_key-$test_key-$name-$header_key";
      } @changed;
    @changed = sort { $file_key{$a} cmp $file_key{$b} } @changed;

    my $fh = new FileHandle ">$basedir/diff-order"
        or die "bad";
    print $fh join("\n", @changed), "\n";
    close($fh);

    print "store this file as $reference_file to automatically use it.";
    print "Changed:\n", join("\n", @changed), "\n";
}

sub kdiffDirs {
    my ($vcs, $basedir, $original_dir, $final_dir, $revisions) = @_;

    # TODO-sprint: make this extract the relevant part from each log
    # message for the file we are reviewing.

    foreach my $rev (@$revisions) {
        $rev =~ s/^merge://o;
        print $vcs->rawRevisionInfo($rev);
    }
    my $cur = '*start*';
    my $auto = undef;
    while(1) {
        print "\n";
        print "------------------------------------------------------------\n";
        print "Last file diffed: $cur\n";
        my $next = getNextDiffFile($basedir, $cur);
        print "Current next file to diff: $next\n";
        print "Editable diff ordering file: $basedir/diff-order\n";
        my $default = "diff $next";
        $default = "ask" if $next eq '*end*';
        print "commands: auto, files, reviewed, finish, exit, ask, help\n";
        print "Enter filename substring or command [$default]: ";
        if (defined $auto && (-M "$basedir/diff-order") == $auto) {
            print "[auto]\n";
            $_ = '';
        } else {
            $_ = <STDIN>;
            chomp;
        }
        $_ = 'ask' if $_ eq '' && $default eq 'ask';
        if ($_ eq '') {
            my $check_next = getNextDiffFile($basedir, $cur);
            if ($check_next ne $next) {
                print "\n***ordering file changed***\n";
                redo;
            }
            my $original = "$basedir/$original_dir/$next";
            my $final = "$basedir/$final_dir/$next";
            unless (-f $original) {
                print "Assuming $final is new file, creating empty temporary\n";
                my ($dir, $file) = $original =~ m!^(.+)/([^/]+)$!o;
                unless (-d $dir) {
                    mkpath([$dir], 0, 0777);
                    die "?" unless -d $dir;
                }
                my $fh = new FileHandle ">$original"
                    or die "bad: $!";
                close($fh);
            }
            if (! (-f $original && -f $final)) {
                warn "$original or $final missing; looping";
                $auto = undef;
                redo;
            }
            eval {
                runCommand('kdiff3','--L1', "original ($next)", '--L2', "new ($next)",
                           "$basedir/$original_dir/$next",
                           "$basedir/$final_dir/$next");
            };
            # warn "kdiff3 command failed (ignoring)" if $@;
            $cur = $next;
        } elsif (/^reviewed\s*(.*)$/o) {
            codeReviewMarkReviewed($vcs, $revisions, $1);
            runCommand("rm -rf $basedir");
            last;
        } elsif ($_ eq 'auto') {
            $auto = -M "$basedir/diff-order";
        } elsif ($_ eq 'files') {
            my @files = getDiffOrder($basedir);
            print "\n\nFiles:\n", join("\n", @files), "\n";
        } elsif ($_ eq 'exit') {
            last;
        } elsif ($_ eq 'finish') {
            runCommand("rm -rf $basedir");
            last;
        } elsif ($_ eq 'ask') {
            while (1) {
                print "Did you mean to type reviewed, {y[es], n[o]}? ";
                $_ = <STDIN>;
                if (/^\s*$/o) {
                    print "There is no default.\n";
                } elsif (/^y/io) {
                    codeReviewMarkReviewed($vcs, $revisions);
                    runCommand("rm -rf $basedir");
                    last;
                } elsif (/^n/io) {
                    runCommand("rm -rf $basedir");
                    last;
                } else {
                    chomp;
                    print "Unrecognized response '$_'\n";
                }
            }
            last;
        } elsif ($_ eq 'help') {
            # TODO-sprint: figure out how to extract this from the pod help;
            # they got out of sync.
            print <<"END_OF_HELP";

auto: skip the prompt for a command until the next file to diff changes
files: list the files we will diff.
reviewed <optional-comment>: mark the revisions as reviewed, and then finish.
finish: delete the code review temporary directories and exit
exit: exit from deptool code-review-diff
help: show this help
*: try to find a file with this as a substring and diff it next.
END_OF_HELP
        } else {
            $cur = selectPrevDiffFile($basedir, $_, $cur);
        }
    }
}

sub codeReviewMarkReviewed {
    my ($vcs, $revisions, $comment) = @_;

    $comment ||= '';
    my @at = localtime(time);
    my $at = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $at[5]+1900, $at[4]+1, $at[3],
                     $at[2], $at[1], $at[0]);
    if (length $comment < 1) {
        $comment = $at;
    } else {
        $comment = "$at: $comment";
    }
    die "?" if $comment =~ /\n/o;
    $vcs->markReviewed($revisions, $comment);
}

sub getChanged {
    my ($basedir, $start, $last) = @_;

    my @old_files = findFilesPrefix("$basedir/$start");
    my @new_files = findFilesPrefix("$basedir/$last");
    die "??" if @new_files == 0;
    my @changed;
    my %old;
    map { $old{$_} = 1 } @old_files;
    map {
        if (defined $old{$_}) {
            ++$old{$_};
            my $old = "$basedir/$start/$_";
            my $new = "$basedir/$last/$_";
            if (-d $old && -d $new) {
                # ignore
            } else {
                die "? $_" if -d $old || -d $new;
                push(@changed, $_) unless compare($old, $new) == 0;
            }
        } else {
            push(@changed, $_)
                unless -d "$basedir/$last/$_" || /\.orig$/o || /\.rej$/o;
        }
      } @new_files;

    while(my($k,$v) = each %old) {
        # TODO: check the log message to determine if the file was actually dropped
        warn "old file $k missing, assuming it was dropped" unless $v == 2;
    }

    @changed = grep(!/((-cr-version-[a-f0-9]+)|(-cr-edit-me))$/o, @changed);
    return @changed;
}

sub getNextDiffFile {
    my($basedir, $cur) = @_;

    my @order = getDiffOrder($basedir);
    return '*end*' if @order == 0;
    return $order[0] if $cur eq '*start*';
    for(my $i=0; $i < @order; ++$i) {
        if ($order[$i] eq $cur) {
            return '*end*' if $i + 1 == @order;
            return $order[$i+1];
        }
    }
    return "**ERROR: Unable to find file $cur";
}

sub selectPrevDiffFile {
    my ($basedir, $target, $cur) = @_;

    my @order = getDiffOrder($basedir);
    my @match = grep(/$target/, @order);
    if (@match == 0) {
        print "\n\n************\nNo match for $target found. Choices:\n",
            join("\n", @order), "\n";
        return $cur;
    }

    if (@match > 1) {
        @match = sort @match;
        print "\n\n************\nMultiple matches for $target found:\n",
            join("\n", @match), "\n";
    }

    for(my $i=0; $i < @order; ++$i) {
        if ($order[$i] eq $match[0]) {
            return "*start*" if $i == 0;
            return $order[$i-1];
        }
    }
    die "??";
}

sub getDiffOrder {
    my($basedir) = @_;

    my $fh = new FileHandle "$basedir/diff-order"
        or die "Can't open $basedir/diff-order for read: $!";
    my @order = <$fh>;
    close($fh);
    grep(chomp, @order);
    @order = grep(!/^\s*$/o, @order);

    return @order;
}

sub codeReviewPatch {
    my ($vcs, $basedir, $last, $from, $to) = @_;

    rcopy("$basedir/$last", "$basedir/$to")
        or die "copy ($basedir/$last,$basedir/$to) failed: $!";

    unless ($vcs->codeReviewTryPatch($from, $to, $basedir)) {
        my @failed = grep(/\.rej$/o, findFilesPrefix("$basedir/$to"));
        print "\n\n**************\n";
        print "Patch failed ($basedir/$to.patch.err) for files: ", join(", ", @failed), "\n";

        my $fh = new FileHandle "$basedir/$to.patch.err"
            or die "Can't open $basedir/$to.patch.err: $!";
        my @errors = <$fh>;
        print @errors;
        close($fh);
        unless (@failed > 0) {
            print "No failed files found, above should show errors.\n";
            userPrompt("continue code-review");
            return;
        }

        foreach my $file (@failed) {
            my $patch = $file;
            $file =~ s/\.rej$//o;
            my $repairpatch = $file;
            $repairpatch =~ s!/!_!go;
            $repairpatch = "/tmp/repair-$to-$repairpatch";
            if (-f $repairpatch) {
                print "$repairpatch exists; will just apply\n";
                runCommand("patch -p4 -d $basedir/$to < $repairpatch");
            } else {
                print "will start $ENV{EDITOR} for $file and rejected patch\n";
                print "return to continue, ctrl-c to abort: ";
                $_ = <STDIN>;
                copy("$basedir/$to/$file","$basedir/$to/$file-cr-edit-me");
                $vcs->codeReviewExtractFile($to, $file, "$basedir/$to/$file-cr-version-$to");
                runCommand("$ENV{EDITOR} $basedir/$to/$patch $basedir/$to/$file-cr-version-$to $basedir/$to/$file-cr-edit-me");
                if (compare("$basedir/$to/$file","$basedir/$to/$file-cr-edit-me") == 0) {
                    print "No changes made.  Return to save empty patch, ctrl-c to abort: ";
                    $_ = <STDIN>;
                }

                print "Saving repair difference as $repairpatch\n";
                eval { runCommand("diff -u $basedir/$to/$file $basedir/$to/$file-cr-edit-me >$repairpatch"); };
                rename("$basedir/$to/$file-cr-edit-me", "$basedir/$to/$file")
                    or die "rename failed: $!";
            }
            unlink("$basedir/$to/$patch", "$basedir/$to/$file-cr-version-$to");
        }
    }
}

sub findFilesPrefix {
    my ($prefix) = @_;

    my @ret;
    find(sub { local $_ = $File::Find::name;
               die "??" unless s,^$prefix\b/?,,;
               push(@ret, $_); }, $prefix);
    return @ret;
}

=pod

=head2 review-status [I<revision>...] | [I<selector>...]

The C<review-status> command will print out the review status for a set of
listed revisions, or the revisions selected by the selectors.  Valid selectors
include:

=over 4

=item who=I<regex>

Include the revision of the author of the revision matches I<regex>; usually
just the username would be used.

=item min-date=I<date>

Specify a minimum date (in the form YYYY-MM-DD) to include in the list, usually
used to prune out early revisions that were reviewed before using this feature.

=item max-date=I<date>

Specify a maximum date (in the form YYYY-MM-DD) to include in the list, useful
for reducing the number of revisions to examine.

=item unreviewed

Only print out revisions that have not been reviewed.  Note that this option is
slower than the others since the certificates need to be retrieved in addition
to the log information in order to determine if there have been any reviews.

=item (db|repo)=I<path>

Instead of using the database/repository implied by the current directory, use one specified
explicitly.

=item branch=I<branch>

Select only revisions on the specified branch.  If using the implicit branch
from the current directory, revision status will follow revisions to other
branches.

=back

=cut

sub reviewStatus {
    usage("Missing arguments to review-status") unless @ARGV > 0;

    my $unreviewed_only;

    my @revisions;
    my @selectors;

    foreach $_ (@ARGV) {
        if ($_ eq 'unreviewed') {
            $unreviewed_only = 1;
        } elsif (/^((db)|(repo))=(\S+)$/o) {
            push(@selectors, "repo=$4");
        } elsif (/=/o) {
            # TODO-sprint: check that min-data and max-date selectors match YYYY-MM-DD format

            # TODO-sprint: consider a summary line that shows the number of unreviewed and total
            # revisions examined
            push(@selectors, $_);
        } elsif (/^[0-9a-fA-F]+$/o) {
            push(@revisions, $_);;
        } else {
            die "Unknown argument $_; see deptool help review-status";
        }
    }

    my $vcs = createVCInterface();
    if (@selectors > 0) {
        push(@revisions, selectRevisions($vcs, @selectors));
    }

    die "Selectors @ARGV did not select any revisions"
        unless @revisions > 0;

    foreach my $revision (@revisions) {
        my $info = ref $revision ? $revision : $vcs->parseRevisionInfo($revision);

        my @reviews = $vcs->getReviews($info->{revision});
        next if $unreviewed_only && @reviews > 0;
        foreach $_ (qw/changelog author date/) {
            die "Missing $_ info for $revision parseRevisionInfo incorrect?"
                unless defined $info->{$_};
        }
        my $changelog_by = $info->{author};
        my $changelog = $_ = $info->{changelog};
        s/^\s*\n//go;
        s/\n(.|\n)*$//o;
        s/^\s+\*\s+//o;

        s/^(.{1,60}\S+).*/$1/o; # try to break at whitespace
        s/^(.{1,70}).*/$1/o; # truncate regardless
        $_ .= " ..." unless $_ eq $changelog;
        print "$info->{revision}: $changelog_by\n  ($_)\n";
        if (@reviews > 0) {
            foreach my $ent (@reviews) {
                $_ = $ent->[1];
                chomp;
                my $date = 'unknown';
                $date = $1
                    if s/^(\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2})(: )?//o;
                print "  reviewed by $ent->[0] at $date\n";
                print "    $_\n" if length > 0;
            }
        } else {
            print "  No reviews for revision dated $info->{date}.\n";
        }
        print "\n";
    }
}

sub selectRevisions {
    my ($vcs, @selectors) = @_;

    my %selectors = ('who' => undef,
                     'min-date' => undef,
                     'max-date' => undef,
                     'branch' => undef,
                     'db' => undef,
                     'repo' => undef);

    foreach $_ (@selectors) {
        if (/^(\S+)=(\S+)$/o) {
            my ($sel, $val) = ($1, $2);
            die "Unknown selector $sel" unless exists $selectors{$sel};
            die "Duplicate selector $sel" if defined $selectors{$sel};
            $selectors{$sel} = $val;
        } else {
            die "Unknown argument '$_'; see deptool help review-status";
        }
    }
    $vcs->setRepository($selectors{repo}) if defined $selectors{repo};

    my @revisions = $vcs->parseNonMergeRevisions($selectors{branch});
    my @ret;
    foreach my $rev (@revisions) {
        die "? $rev->{revision}"
            unless defined $rev->{author} && defined $rev->{date};
        next if defined $selectors{who} && $rev->{author} !~ /$selectors{who}/o;
        next if defined $selectors{'min-date'} && $rev->{date} lt $selectors{'min-date'};
        next if defined $selectors{'max-date'} && $rev->{date} gt $selectors{'max-date'};
        push (@ret, $rev);
    }
    return @ret;
}

##### Change Directory functions
# Actually just prints out what has to happen such that eval of returned string
# in bourne shells will change the directory.

=pod

=head2 cdsrc I<cwd>

The source and build directories maintain parallel structure.
Therefore if you are currently in $BUILD_OPT/Lintel/src/tests, it can
be useful to jump to $PROJECTS/Lintel/src/tests.  The cdsrc command
will print out the shell command necessary to make this switch.
Therefore you probably want an alias along the lines of:

    s () { eval `$DEPTOOL cdsrc $PWD` }

to make it easier to type the command in.  The s command will deal
correctly with sub-build-type directories except it will get confused
if you have a source directory named project-something.


=head2 cdopt I<cwd> [I<build-type>]

The cdopt command performs the reverse jump from cdsrc, it moves from
a position under $PROJECTS to one under $BUILD_OPT.  The build-type
optional argument allows you to have multiple directories that all
build from the source directory with different build options.  Since
deptool wants to remember the build type for each directory, it
actually prints out a command that sets the environment variable for
the build-type if needed.  An alias along the lines of:

    b () { eval `$DEPTOOL cdopt $PWD "$@"` }

will make it easier to issue this command.  Unfortunately because of
the environment setting, this command only works with bourne-shells
right now.  If you specify '' as the build type, it will remove the
build type from whatever directory you are currently in.

=head2 cddebug

The cddebug command is the same as cdopt, except it takes you to the
debug directory.  The natural alias is therefore:

    d () { eval `$DEPTOOL cddebug $PWD "$@"` }

=cut

sub cdSrc {
    my $cwd = cdInitialPrep(1, 'cdsrc <cur-working-dir>');

    my ($project, $subprojdir, $buildtype) = divideDir($cwd);
    $subprojdir ||= '';
    my $srcdir = "$ENV{PROJECTS}/$project$subprojdir";
    if (-d $srcdir) {
        print "cd $srcdir\n";
        exit(0);
    } else {
        print "echo '$srcdir does not exist'\n";
        exit(1);
    }
}

sub cdBuild {
    my($what) = @_;

    my $cwd = cdInitialPrep(2, "cd${what} <cur-working-dir> [build-type] -- type defaults to previous; use '' to reset.");

    my ($project, $subprojdir, $buildtype) = divideDir($cwd);
    $subprojdir ||= '';
    $buildtype ||= '';

    my $cleanproj = $project;
    $cleanproj =~ s/\W/_/go;

    my $deptool_env = "deptool_${cleanproj}_subbuild";
    $buildtype = $ENV{$deptool_env}
        if $buildtype eq '' && defined $ENV{$deptool_env};
    $buildtype = $ARGV[1] if @ARGV == 2;

    my $xbuildtype = $buildtype eq '' ? '' : "-$buildtype";
    my $envvar = $what eq 'opt' ? 'BUILD_OPT' : 'BUILD_DEBUG';
    my $builddir = "$ENV{$envvar}/$project$xbuildtype$subprojdir";
    if (! -d $builddir) {
        print STDERR "$builddir missing, creating...\n";
        mkpath($builddir) or die "Unable to mkdir $builddir: $!";
    }

    print "export ${deptool_env}=$buildtype;\n";
    print "cd $builddir\n";
}

sub cdInitialPrep {
    my ($maxargs, $usage) = @_;
    $maxargs ||= 1;
    unless (defined $ENV{PROJECTS} && defined $ENV{BUILD_DEBUG} &&
            defined $ENV{BUILD_OPT}) {
        print "echo 'can not use deptool cd operations environment is not set up'\n";
        exit(1);
    }

    unless (@ARGV >= 1 && @ARGV <= $maxargs && -d $ARGV[0]) {
        print "echo 'Usage: deptool $usage'";
        exit(1);
    }
    return $ARGV[0];
}

# TODO: combine this somehow with srcDir
# returns (project, subdir, build-type)
sub divideDir {
    my($dir) = @_;

    my $projects = projects();
    my $opt = buildOpt();
    my $debug = buildDebug();
    if ($dir =~ m!^$projects/([^/]+)(/.+)?$!o) {
        return ($1, $2, undef);
    } elsif ($dir =~ m!^$opt/([^/]+?)(?:-(\w+))?(/.+)?$!o) {
        return ($1, $3, $2);
    } elsif ($dir =~ m!^$debug/([^/]+?)(?:-(\w+))?(/.+)?$!o) {
        return ($1, $3, $2);
    } else {
        print "echo '$dir is not under $projects, $opt, or $debug'\n";
        exit(1);
    }
}

##### Common -- depwalk

sub depWalkRecurse ($$$$$$);

# pre_fn gets called before we recurse into the version control dependencies
# post_fn gets called after we recursed into the version control dependencies

sub depWalk ($$$) {
    my($pre_fn, $post_fn, $use_sub_build_type) = @_;

    my $src = rootSrcDir();
    depWalkRecurse($pre_fn, $post_fn, $src, {}, $use_sub_build_type, '');
}

# TODO: extend visited to instead of having just a flag to note
# visited, it's a hash map that has pre_visited, stamp => { build => ,
# test => , install => } pass the hash map into, the pre and post
# functions (make sure they have the same signature; both should take
# all three arguments); use that hash map in stampUpToDate, and
# require it to be passed in.  Inside of depWalkRecurse, initialize
# the stamp files at the beginning, set them to 0 during the two
# unlinks in depBuildCheckOld.  stamp() should also take the array,
# and should update it when it makes the utime call, and then
# stampUpToDate should only look at the array, not do stat calls on
# it's own.
#
# Probably rename visited to
# build_dir_status, possibly include dependencies in there, instead of
# as a separate array,
# e.g. $build_dir_status->{dirish}->{dependencies} = [
# build_dir_status->{depdir}->{stamp} ]

sub depWalkRecurse ($$$$$$) {
    my($pre_fn, $post_fn, $src, $visited, $use_sub_build_type, $build_type) = @_;

    if ($use_sub_build_type) {
        if (defined $visited->{"$src $build_type"}) {
            return if $visited->{"$src $build_type"};
        }
        $visited->{"$src $build_type"} = 1;
    } else {
        return if $visited->{$src};
        $visited->{$src} = 1;
    }

    aliasChdir($src);
    &$pre_fn($build_type);
    my @vcdeps = getVCDeps($src);

    if (@vcdeps > 0) {
        my $projects = projects();
        foreach my $dep (@vcdeps) {
            my ($project, $sub_build_type) = parseDependency($dep);

            my $depsrc = "$projects/$project";
            depWalkTryCheckout($project) unless -d $depsrc;
            depWalkRecurse($pre_fn, $post_fn, $depsrc, $visited, $use_sub_build_type,
                           $sub_build_type);
        }
    }
    aliasChdir($src);
    print "depwalk: running walk function in $src ($build_type)\n\n"
        unless $quiet;
    &$post_fn($build_type, \@vcdeps);
    print "\n";
}

sub depWalkTryCheckout {
    my ($dep) = @_;
    my $projects = projects();

    print "depWalk: Trying to checkout missing dependency $dep\n";
    eval {
        local @ARGV = ($dep);
        depCheckout($dep);
    };

    if ($@ && $@ =~ /No branches found matching/o) {
        depWalkTryInit($dep);
        eval {
            local @ARGV = ($dep);
            depCheckout($dep);
        };
    }

    die "Unable to find dependency $dep as $projects/$dep; depCheckout failed: $@"
        if $@;

    die "depCheckout succeeded, but missing directory??"
        unless -d "$projects/$dep";
}

sub depWalkTryInit {
    my ($dep) = @_;
    my $fh = new FileHandle "mtn list branches |"
        or die "Can't start mtn list branches: $!";
    my $uniqueifier = "unknown.example.com";
    while(<$fh>) {
        if (m!^(\w+\.[^/]+)/!o) {
            $uniqueifier = $1;
            last;
        }
    }
    close($fh);

    print "Unable to find dependency $dep in current monotone databases.\n";
    my $to_init = "$uniqueifier/$dep";
    print "Branch to init [$to_init]: ";
    $_ = <STDIN>;
    if (!/^\s*$/o) {
        chomp;
        $to_init = $_;
    }
    eval {
        local @ARGV = ($to_init);
        depInit();
    };
    die "depInit($to_init) failed: $@"
        if $@;
}

# TODO: combine this somehow with divideDir
sub srcDir {
    my $start = aliasGetCwd();
    my $projects = projects();
    my $debug = buildDebug();
    my $opt = buildOpt();

    local $_ = $start;
    my $build_subdir;
    if (m!^$projects/!o) {
        # in a source directory already
    } elsif (-d "_MTN") {
        # in some kind of source directory already.
    } elsif (m!^(($debug)|($opt))/!o) {
        s!^(($debug)|($opt))/!!o;
        if (-d "$projects/$_") {
            $_ = "$projects/$_";
        } elsif (m!^(\w[^/]*)-(\w+)(/.*)$!o && -d "$projects/$1/$3") {
            $build_subdir = $2;
            $_ = "$projects/$1$3";
        } elsif (m!^(\w[^/]*)-(\w+)$!o && -d "$projects/$1") {
            $build_subdir = $2;
            $_ = "$projects/$1";
        } else {
            die "$start is under a build directory, but can't find related source dir";
        }
    } else {
        die "$_ is not under a projects or build directory";
    }
    return ($_, $build_subdir) if wantarray;
    return $_;
}

sub rootSrcDir {
    my $start = srcDir();
    local $_ = $start;
    while (! -f "$_/deptool.config") {
        s!/[^/]+$!!o;
        die "Unable to find deptool.config file anywhere under $start"
            if $_ eq '';
    }
    return $_;
}

##### Env functions

=pod

=head2 getenv [--quiet] [--unset] I<what>

The getenv command allows you to get the environment variables that are needed for deptool to work
without prompting.  This command has two forms, one that gets a specific environment variable and
prints it out, and one that prints out a string that can be evaluated to set all the environment
variables in the shell. In the form for printing out all values for a shell, the --unset option
will instead cause the values to be unset in the environment.  Because of the multiple modes,
I<what> can have a number of values:

=over

=item for-sh

Print out all of the environment variables formatted for sh-style
shells.  This command does not prompt for input, so if values are not
currently set in the environment, the defaults will be used.

=item for-csh

The same as for-sh, except for csh-based shells.

=item projects

The PROJECTS environment variable.  Specifies the root directory for
sources of projects.

=item buildRoot

The BUILD_ROOT environment variable.  Specifies the parent directory
for the optimize and debug build directories.  Unused if BUILD_OPT and
BUILD_DEBUG are set.

=item operatingSystem

The BUILD_OS environment variable.  Automatically inferred by looking at
various files in /etc to determine the operating system type and
version.

=item unameM

The UNAME_M environment variable.  The result of running uname -m as
you have to build differently for different architecture types.

=item buildDebug

The BUILD_DEBUG environment variable.  Specifies the root directory
for debugging builds.  Defaults to $BUILD_ROOT/dbg-$BUILD_OS-$UNAME_M, or
$BUILD_ROOT/debug if the latter exists.

=item buildOpt

The BUILD_OPT environment variable.  Specifies the root directory
for optimized builds.  Defaults to $BUILD_ROOT/opt-$BUILD_OS-$UNAME_M, or
$BUILD_ROOT/optimize if the latter exists.

=item makeParallelism

The MAKE_PARALLELISM environment variable.  Defaults to ceil(1.5 *
ncores), or 1 if the number of cores can't be determined.  Useful for
C<make -j $MAKE_PARALLELISM>.

=item mtnServer

The MTN_SERVER environment variable.  Defaults to usi.hpl.hp.com.
Needed to determine the central repository for public updates.
To use 'mtn over ssh' instead of the default monotone protocol
for deppull, deppublish operations, it can be specified as
ssh://[user@]server[:port]/path-to-monotone-db/
deptool appends the appropriate database

=item gitServer

The DEPTOOL_GIT_SERVER environment variable.  Defaults to git-pa1.hpl.hp.com.  Needed to determine
the central repository for init.

=item gitRepoDir

The DEPTOOL_GIT_REPO_DIR environment variable.  Defaults to ~/.git.  Stores the local mirrors of
remote repositories.

=back

=cut

sub getEnv {
    my $unset;
    my $result = GetOptions("quiet!" => \$quiet,
                            "unset!" => \$unset);

    usage("Unknown error") unless $result;
    usage("Missing requested env var") unless @ARGV == 1;

    my $env = $ARGV[0];
    if ($env =~ /^for-((sh)|(csh))$/o) {
        my $shell = $1;
        $shell = "unset-$shell" if $unset;
        $quiet = 1;
        $auto_yes_to_prompts = 1;

        printEnv($shell, 'PROJECTS', \&projects);
        printEnv($shell, 'BUILD_ROOT', \&buildRoot);
        printEnv($shell, 'BUILD_OS', \&operatingSystem);
        printEnv($shell, 'UNAME_M', \&unameM);
        printEnv($shell, 'BUILD_DEBUG', \&buildDebug);
        printEnv($shell, 'BUILD_OPT', \&buildOpt);
        printEnv($shell, 'MAKE_PARALLELISM', \&makeParallelism);
        printEnv($shell, 'MTN_SERVER', \&mtnServer);
        printEnv($shell, 'DEPTOOL_GIT_SERVER', \&gitServer);
        printEnv($shell, 'DEPTOOL_GIT_REPO_DIR', \&gitRepoDir);
        printEnv($shell, 'DEPTOOL_MTN_REPO_DIR', \&mtnRepoDir);
    } else {
        usage("Bad env var request") unless $env =~ /^\w+$/o;
        my $ret = eval "$ARGV[0]()";
        die "Unknown env var $env"
            if $@ && $@ =~ /^Undefined subroutine/o;
        die $@ if $@;

        print "$ret\n";
    }
}

sub printEnv {
    my($shell, $envvar, $fn) = @_;

    my $val = &$fn();
    if ($shell eq 'sh') {
        print qq{export $envvar="$val";\n};
    } elsif ($shell eq 'csh') {
        print qq{setenv $envvar "$val";\n};
    } elsif ($shell eq 'unset-sh') {
        print qq{unset $envvar\n};
    } elsif ($shell eq 'unset-csh') {
        print qq{unsetenv $envvar\n};
    } else {
        die "?? $shell";
    }
}

sub projects {
    $Cache::projects ||= $ENV{PROJECTS};
    unless(defined $Cache::projects) {
        userPrompt("missing \$ENV{PROJECTS}; assume $ENV{HOME}/projects");
        $Cache::projects = "$ENV{HOME}/projects";
    }
    return $Cache::projects;
}

sub buildRoot {
    $Cache::build_root ||= $ENV{BUILD_ROOT};
    unless(defined $Cache::build_root) {
        userPrompt("missing \$ENV{BUILD_ROOT}; assume $ENV{HOME}/build");
        $Cache::build_root = "$ENV{HOME}/build";
    }
    return $Cache::build_root;
}

sub operatingSystem {
    $Cache::operating_system ||= $ENV{BUILD_OS};
    unless(defined $Cache::operating_system) {
        $Cache::operating_system = "unknown";
        if (-f "/etc/lsb-release") { # need to check this first, Ubuntu has /etc/debian_version
            my $lsbver = new FileHandle("/etc/lsb-release")
                or die "Can't open /etc/debian_version for read: $!";
            my %info;
            while(<$lsbver>) {
                next if /^#/o || /^\s*$/o;
                chomp;
                die "unknown line in /etc/lsb-release '$_'"
                    unless /^([A-Z_]+)=(.+)$/o;
                $info{$1} = $2;
            }
            if (defined $info{DISTRIB_ID} && defined $info{DISTRIB_RELEASE}
                && $info{DISTRIB_ID} eq 'Ubuntu' && $info{DISTRIB_RELEASE} =~ /^\d+\.\d+$/o) {
                $Cache::operating_system = "ubuntu-$info{DISTRIB_RELEASE}";
            } elsif (defined $info{DISTRIB_ID}) {
                $Cache::operating_system = "unknown-distrib-$info{DISTRIB_ID}";
            } else {
                $Cache::operating_system = "unknown-lsb";
            }
            return $Cache::operating_system unless $Cache::operating_system =~ /^unknown/o;
        }

        if (-f "/etc/debian_version") {
            my $debver = new FileHandle("/etc/debian_version")
                or die "Can't open /etc/debian_version for read: $!";
            $_ = <$debver>;
            close($debver);
            chomp;
            if (/^(\d+\.\d+)(\.\d+)?$/o) {
                $Cache::operating_system = "debian-$1";
            } elsif (m!^([a-z]+)/sid$!o) {
                $Cache::operating_system = "debian-${1}_unstable";
            } elsif (m!^testing$!o) {
                $Cache::operating_system = "debian-testing_unstable";
            } else {
                s/\W//go; s/\s/_/go;
                $Cache::operating_system = "debian-unknown-$_";
            }
        } elsif (-f "/etc/redhat-release") {
            my $rhver = new FileHandle("/etc/redhat-release")
                or die "Can't open /etc/redhat-release for read: $!";
            $_ = <$rhver>;
            close($rhver);
            chomp;
            # Include minor versions because major things like boost installs
            # can change between minor releases of the OS.
            if (/^Red Hat Enterprise Linux.+release (\d+\.\d+) /o) {
                $Cache::operating_system = "rhel-$1";
            } elsif (/^Red Hat Enterprise Linux.*release (\d+) .*Update (\d+)\b/o) {
                $Cache::operating_system = "rhel-$1.$2";
            } elsif (/^Fedora release (\d+) \(.*\)$/o) {
                $Cache::operating_system = "fedora-$1";
            } elsif (/^CentOS release (\d+\.\d+) /o) {
                $Cache::operating_system = "centos-$1";
            } elsif (/^CentOS Linux release (\d+\.\d+) /o) {
                $Cache::operating_system = "centos-$1";
            } elsif (/^Scientific Linux release (\d+\.\d+) /o) {
                $Cache::operating_system = "scilinux-$1";
            } else {
                s/\W/_/go; s/\s/_/go;
                $Cache::operating_system = "rh-unknown-$_";
            }
        } elsif (-f "/etc/SuSE-release") {
            my $susever = new FileHandle("/etc/SuSE-release")
                or die "Can't open /etc/SuSE-release for read: $!";
            $_ = <$susever>;
            close($susever);
            chomp;
            # unclear if openSUSE minor releases are compatible; given 8 month release cycle, seems
            # unlikely so we tie to the minor version also.
            if (/^openSUSE (\d+\.\d+) /o) {
                $Cache::operating_system = "opensuse-$1";
            } elsif (/^SUSE Linux Enterprise Server (\d+\.\d+)\b/o) {
                $Cache::operating_system = "suse-$1";
            } elsif (/^SUSE Linux Enterprise Server (\d+)/o) {
                $Cache::operating_system = "suse-$1";
            } else {
                s/\W/_/go; s/\s/_/go;
                $Cache::operating_system = "suse-unknown-$_";
            }
        }

        if ($Cache::operating_system =~ /^unknown/o) {
            my $uname = new FileHandle("uname -rs |")
                or die "Can't run uname -rs for read: $!";
            $_ = <$uname>;
            chomp;
            if (/^FreeBSD (\d+\.\d+)-RELEASE$/o) {
                $Cache::operating_system = "freebsd-$1";
            } elsif (/^FreeBSD\s/o) {
                s/^FreeBSD\s+//o;
                s/\W/_/go; s/\s/_/go;
                $Cache::operating_system = "freebsd-unknown-$_";
            } elsif (/^OpenBSD (\d+\.\d+)$/o) {
                $Cache::operating_system = "openbsd-$1";
            } elsif (/^OpenBSD\s/o) {
                s/^OpenBSD\s+//o;
                s/\W/_/go; s/\s/_/go;
                $Cache::operating_system = "openbsd-unknown-$_";
            } elsif (/^Darwin\s+/o) {
                my $sys_prof = new FileHandle("system_profiler SPSoftwareDataType |")
                    or die "Can't run system_profiler SPSoftwareDataType for read: $!";
                my $sys_ver;
                while (<$sys_prof>) {
                    $sys_ver = $1 if /^\s+System Version: Mac OS X (\d+\.\d+\b)/o;
                }
                die "Unable to find system version in output of system_profiler SPSoftwareDataType"
                    unless defined $sys_ver;
                $Cache::operating_system = "macos-$sys_ver";
            } elsif (/^(\w+)\s+(\S.*)$/o) {
                s/\W/_/go; s/\s/_/go;
                $Cache::operating_system = "unknown-$_";
            }
        }

        if ($Cache::operating_system =~ /unknown/o) {
            if (defined $ENV{OS}) {
                print STDERR "Unrecognized operating system, overriding with deprecated env var OS\n";
                $Cache::operating_system = $ENV{OS};
            } else {
                print STDERR "Unrecognized operating system, using $Cache::operating_system\n";
            }
            print STDERR "Set \$BUILD_OS to avoid warning, or fix deptool to auto-detect\n";
            unless ($quiet) { # We're probably running under getEnv.
                print "Hit return to continue: ";
                $_ = <STDIN>;
            }
        }
    }
    return $Cache::operating_system;
}

sub unameM {
    $Cache::uname_m ||= $ENV{UNAME_M};

    unless(defined $Cache::uname_m) {
        $Cache::uname_m = `uname -m`;
        chomp $Cache::uname_m;
        if ($Cache::uname_m eq '') {
            $Cache::uname_m = "arch_unknown";
            warn "Unknown architecture, using arch_unknown";
        }
    }
    return $Cache::uname_m;
}

sub buildDebug {
    $Cache::build_debug ||= $ENV{BUILD_DEBUG};
    unless(defined $Cache::build_debug) {
        my $root = buildRoot();
        if (-d "$root/debug") {
            $Cache::build_debug = "$root/debug";
        } else {
            $Cache::build_debug
                = buildRoot() . "/dbg-" . operatingSystem() . "-" . unameM();
        }
        userPrompt("missing \$ENV{BUILD_DEBUG}; assume $Cache::build_debug");
    }
    return $Cache::build_debug;
}

sub buildOpt {
    $Cache::build_optimize ||= $ENV{BUILD_OPT};
    unless(defined $Cache::build_optimize) {
        my $root = buildRoot();
        if (-d "$root/optimize") {
            $Cache::build_optimize = "$root/optimize";
        } else {
            $Cache::build_optimize
                = buildRoot() . "/opt-" . operatingSystem() . "-" . unameM();
        }
        userPrompt("missing \$ENV{BUILD_OPT}; assume $Cache::build_optimize");
    }
    return $Cache::build_optimize;
}

sub makeParallelism {
    if (defined $ENV{MAKE_PARALLELISM}) {
        return $ENV{MAKE_PARALLELISM};
    }
    my $nprocessors = 0;
    my $fh = new FileHandle "/proc/cpuinfo";
    if ($fh) { # linux
        while(<$fh>) {
            ++$nprocessors if /^processor\s+:\s+\d+$/o;
        }
        close($fh);
    }
    if ($nprocessors == 0) {
        $fh = new FileHandle "sysctl hw.ncpu 2>/dev/null |"; # freebsd, openbsd, macos
        while (<$fh>) {
            if (/^hw\.ncpu: (\d+)$/o) {
                $nprocessors = $1;
            } elsif (/^hw\.ncpu=(\d+)$/o) {
                $nprocessors = $1;
            }
        }
    }
    if ($nprocessors == 0) {
        print "Warning: unable to find \# processors in /proc/cpuinfo\n"
            unless $quiet;
        return 1;
    }
    return POSIX::ceil($nprocessors * 1.5); # oversubscribe by 50%
}

sub mtnServer {
    unless(defined $ENV{MTN_SERVER}) {
        userPrompt("assume default mtn server usi.hpl.hp.com (set via \$MTN_SERVER)");
        $ENV{MTN_SERVER} = "usi.hpl.hp.com";
    }
    return $ENV{MTN_SERVER};
}

sub gitServer {
    unless(defined $ENV{DEPTOOL_GIT_SERVER}) {
        userPrompt("assume default git server git-pa1.hpl.hp.com (set via \$DEPTOOL_GIT_SERVER)");
        $ENV{DEPTOOL_GIT_SERVER} = "git-pa1.hpl.hp.com";
    }
    return $ENV{DEPTOOL_GIT_SERVER};
}

sub gitRepoDir {
    unless(defined $ENV{DEPTOOL_GIT_REPO_DIR}) {
        userPrompt("assume default git repo dir $ENV{HOME}/.git (set via \$DEPTOOL_GIT_REPO_DIR)");
        $ENV{DEPTOOL_GIT_REPO_DIR} = "$ENV{HOME}/.git";
    }
    return $ENV{DEPTOOL_GIT_REPO_DIR};
}

sub mtnRepoDir {
    # TODO-eric: commit this, wait a week for it to be in use, switch dotfiles over to using
    # new env var, wait a week, add warning about fallback, then remove.
    $ENV{DEPTOOL_MTN_REPO_DIR} = $ENV{MONOTONE_DIR}
        if defined $ENV{MONOTONE_DIR} && !defined $ENV{DEPTOOL_MTN_REPO_DIR};
    unless(defined $ENV{DEPTOOL_MTN_REPO_DIR}) {
        userPrompt("assume default monotone repo dir $ENV{HOME}/.monotone (set via \$DEPTOOL_MTN_REPO_DIR)");
        $ENV{DEPTOOL_MTN_REPO_DIR} = "$ENV{HOME}/.monotone";
    }
    return $ENV{DEPTOOL_MTN_REPO_DIR};
}

##### Common functions

# TODO-sprint: add in support for rc file, allow user to specify config name as argument
# add documentation.  Put call to readDeptoolRc back in before my %commands
#
# sub readDeptoolRc {
#     my $cfile = "$ENV{HOME}/.deptoolrc";
#     if (! $noconfig && -f $cfile && -r $cfile) {
#         my $config = new FileHandle($cfile)
#             or die "Can't open $cfile for read: $!";
#         while (<$config>) {
#             chomp;
#             next if /^\s*(#.*)?$/;   # Ignore comments and empty lines
#             if (/^([A-Z_]+)=(.+)$/o) {
#                 $ENV{$1} = $2;
#             } elsif (/^([A-Z_]+)=$/o) {
#                 delete $ENV{$1};
#             } else {
#                 warn "Ignoring invalid line '$_' in $cfile";
#             }
#         }
#         close($config);
#     }
# }

=pod

=head1 deptool.config

The deptool.config file at the root of the source directory for each project.
It is a perl expression that is evaluated in order to determine how to build
the project, and is used to identify the root source directory.  It includes
descriptions of dependencies, and enables control over parallel testing.  The
file is expect to return a hash reference, for example:

    {
        dependencies => [qw/Lintel DataSeries SomethingElse/],
        parallel_test => 0, # default value, disable parallel testing in general
        parallel_test_path => sub {
            # build in parallel if the build path ends in /Lintel
            return $_[0] =~ m!/Lintel$/o;
        }
        untested_repository => 'untested.server.example.com'
    }

deptool.conf will be evaluated in a Safe(3perl) compartment so it can't execute
functions such as system.  A copy of the environment will be present as %ENV.

Valid options in a deptool.config file include the following.  Unknown options will
result in a warning being printed out.

=over 4

=item dependencies => [qw/project list/]

List of projects that this project depends on.  Deptool will use this to make
sure those projects are built and installed first.  It will also automatically
check them out if you are using version control.

If you want special builds in different modes, then you can list them as
'I<dependency>;I<sub-build-type>' (without the '').  This input has the same
effect as creating a dependency where you run b I<sub-build-type> and then
build in that directory.

=item parallel_test => [0|1]

Should deptool execute the tests for this directory in parallel.  The
default is 0 (no).

=item parallel_test_path => sub { my ($build_path) = @_; return 0|1; }

Given the current build path, should deptool execute tests in
parallel?  This function allows you to have parallel tests for some
build modes and not for others.

=item sequential_tests => [qr/test-name-re/,...]

Specify a list of regex's for tests that have to be run sequentially.  All of
the sequential tests will be executed before any of the parallel tests.  It is
an error for a regexp to match multiple tests or no tests.  This option has no
effect if parallel tests are not enabled.

=item untested_repository => 'hostname'

Specify a hostname for a repository that does not require tests to be run before
publish is executed.

=back

=cut

# Pass in the directory, it knows the filename.
sub readConfig {
    my ($cfg_dir) = @_;

    confess "internal: \$cfg_dir not defined" unless defined $cfg_dir;
    confess "internal: missing directory $cfg_dir" unless -d $cfg_dir;

    my $cfg_path = "$cfg_dir/deptool.config";
    confess "Error: missing $cfg_path\n"
        unless -r $cfg_path;

    my $file = readFile($cfg_path);

    my $compartment = new Safe;
    %{$compartment->varglob('ENV')} = %ENV;
    my $result = $compartment->reval($file);
    die "Unable to evaluate $cfg_path: $@" if $@;
    die "Did not get a hash ref back from evaluating $cfg_path" unless ref $result eq 'HASH';

    die "Invalid parallel_test value in $cfg_path, expected 0|1, not '$result->{parallel_test}'"
        if defined $result->{parallel_test} && $result->{parallel_test} !~ /^[01]$/o;
    die "Invalid parallel_test_path value in $cfg_path\n"
        . " expected sub { }, not '$result->{parallel_test}'"
        if defined $result->{parallel_test_path} && ref $result->{parallel_test_path} ne 'CODE';
    if (defined $result->{sequential_tests}) {
        die "Invalid sequential_tests value in $cfg_path\n"
            . " expected [...], not '$result->{sequential_tests}'"
            unless ref $result->{sequential_tests} eq 'ARRAY';
        foreach my $elem (@{$result->{sequential_tests}}) {
            die "Invalid sequential_tests array element in $cfg_path\n"
                . " expected qr/.../, not '$elem' --> '" . (ref $elem) . "'"
                unless (ref $elem) =~ /\bRegexp$/o;
        }
    }

    if (defined $result->{dependencies}) {
        die "Invalid dependencies value in $cfg_path\n"
            . " expected [ ... ], not '$result->{dependencies}'"
            unless ref $result->{dependencies} eq 'ARRAY';
        foreach my $elem (@{$result->{dependencies}}) {
            die "Invalid dependencies array element in $cfg_path\n"
                . " expected .+(;\\w+)?, not '$elem'"
                unless $elem =~ /^.+(;\w+)?$/o;
        }
    }

    my %expect = map { $_ => 1 } qw/dependencies parallel_test parallel_test_path
                                    sequential_tests untested_repository/;

    foreach my $key (keys %$result) {
        warn "Unrecognized option '$key' in $cfg_path" unless $expect{$key};
    }

    return $result;
}

sub getVCDeps {
    my ($config_or_path) = @_;

    unless (ref $config_or_path) {
        $config_or_path = readConfig($config_or_path);
    }

    return () unless defined $config_or_path->{dependencies};

    return @{$config_or_path->{dependencies}};
}

sub userPrompt {
    my($msg) = @_;

    return if $auto_yes_to_prompts && $quiet;

    print STDERR "\nDo you want to: $msg\n";
    print STDERR "Return to continue, ctrl-c to abort: ";
    if ($auto_yes_to_prompts) {
        print STDERR "[auto-yes]\n";
    } else {
        $_ = <STDIN>;
        die "You provided 'n' for input, aborting anyway"
            if /^n/io;
    }
}

sub runCommand {
    my(@command) = @_;

    print "Running: ", join(" ", @command), "\n";
    quietRunCommand(@command);
}

sub quietRunCommand {
    my(@command) = @_;

    my $ret = system(@command);

    die "'" . join(" ", @command) . "' failed ($ret)\n" unless $ret == 0;
}

sub aliasChdir {
    my($dir) = @_;

    chdir($dir) or confess "Unable to chdir($dir): $!";
    my $here = getcwd();
    return if defined $Cache::alias_cd{$here};
    print "ACD $here -> $dir\n" if 0;
    $Cache::alias_cd{$here} = $dir;
}

sub aliasGetCwd {
    my $here = getcwd();
    print "AG $here -> $Cache::alias_cd{$here}\n" if 0;
    return $Cache::alias_cd{$here}
        if defined $Cache::alias_cd{$here};
    return $here;
}

sub getCmdOutput {
    my($cmd, $pre_close_fn) = @_;

    my ($write, $read, $error) = (new FileHandle, new FileHandle, new FileHandle);
    my $pid = open3($write, $read, $error, $cmd);

    # TODO: write the select loop that can handle unbounded output.  The following is unsafe
    # because it assumes the stderr output is small enough that it can be entirely buffered.

    close($write) or die "close failed: $!";
    my @stdout = <$read>;
    my @stderr = <$error>;

    my $kid = waitpid($pid, 0);
    my $status = $?;
    die "? $kid $pid" unless $kid == $pid;

    &$pre_close_fn(\@stdout, \@stderr) if defined $pre_close_fn;
    close($read) or confess "close failed: $!\ncommand is $cmd";
    close($error) or confess "close failed: $!\ncommand is $cmd";
    confess "$cmd failed" unless $status == 0;
    return @stdout;
}

sub simpleParse {
    my($data, $matches) = @_;

    my %ret;

    # print join(", ", @$matches);
    confess "simpleParse(): matches array should have even # entries"
        unless @$matches % 2 == 0;
    die "bad parse: # data lines = " . scalar @$data . " < #match pairs = " . (@$matches/2)
        unless @$data >= @$matches/2;
    for(my $i=0; $i < @$matches/2; ++$i) {
        local $_ = $data->[$i];
        chomp;
        my $match = $matches->[2*$i];
        my $var = $matches->[2*$i+1];

        confess "?? $i" unless defined $match;
        confess "Error on line $i expected $match, got '$_'"
            unless /$match/;
        $ret{$var} = $1 if defined $var;
    }
    return %ret;
}

sub writeFile {
    my ($filename, $contents) = @_;

    my $fh = new FileHandle ">$filename"
        or die "Unable to open $filename for write: $!";
    print $fh $contents;
    close($fh);
    die "$filename has wrong size" unless -s $filename == length $contents;
}

sub readFile {
    my ($filename) = @_;

    my $fh = new FileHandle($filename)
        or die "Can not open $filename for read: $!";
    # slurp mode
    local $/;
    my $file = <$fh>;
}

###### Version control abstraction functions

# TODO: propagate this to other vc actions so we can support multiple vc
# systems (e.g. svn) at the same time.

sub createVCInterface {
    my $srcdir = rootSrcDir();

    my $ret;
    if (-d "$srcdir/_MTN") {
        die "Multiple VC interfaces to $srcdir" if defined $ret;
        $ret = new deptool::MonotoneVC;
    }

    if (-d "$srcdir/.git") {
        die "Multiple VC interfaces to $srcdir" if defined $ret;
        $ret = new deptool::GitVC;
    }

    return $ret;
}

package deptool;

use Carp;

sub parseRevisionInfo { # run in a source directory that should include the specified revision
    my ($this, $revision) = @_;

    confess "unimplemented";
    # note that ancestor, author, date, and branch can all be arrays if there are multiple
    # values for those either because it is a merge revision or multiple people generated
    # identical results.
    return { revision => $revision, # allowed to expand it out if desired
             ancestor => '...', # required, array if this is a merge revision, undef if this is the
                                # first revision
             author => '...', # optional
             date => 'sortable-in-ascii-order, e.g. ISO8601 date',
             branch => '...', # to detect whether all revs are on the same branch
             changelog => '...' # multi-line string
           };
}

sub codeReviewPrep {
    my ($this) = @_;

    # Any preparation you need to be able to run the other codeReview commands in an arbitrary
    # directory.
    confess "unimplemented";
}

sub codeReviewCheckout { # run out of an arbitrary directory
    my($this, $targetdir, $revision) = @_;

    # check out revision $revision into $targetdir; you can assume codeReviewPrep has been called
    # on $this
    confess "unimplemented";
}

sub codeReviewTryPatch { # run out of an arbitrary directory
    my ($this, $from, $to, $basedir) = @_;

    # You can assume codeReviewPrep has been called on $this.  You can also assume that $from is
    # the direct ancestor of $to.

    # Steps in this function:
    # 1) write the diff between $from and $to into the file named $basedir/$to.patch
    #
    # 2) attempt to patch $basedir/$to with $basedir/$to.patch writing output and errors to
    #    $basedir/$to.patch.err
    #
    # 3) return true if the patch succeeded, false otherwise.
    confess "unimplemented";
}

sub codeReviewExtractFile {
    my ($this, $rev, $file, $dest) = @_;

    # You can assume codeReviewPrep has been called on $this.
    #
    # Extract $file from revision $rev and write it to $dest
    confess "unimplemented";
}

sub markReviewed {
    my ($this, $revisions, $comment) = @_;

    # You can assume codeReviewPrep has been called on $this.
    #
    # Record associated with all the $revisions = ['rev', 'rev', 'rev'] entries that they have been
    # reviewed by the current user and the comment for the review is $comment (which will be a
    # non-empty single-line string)
    confess "unimplemented";
}

sub setRepository {
    my ($this, $repository) = @_;

    # Store the repository specified by the user for use in getReviews
    confess "unimplemented";
}

sub getReviews {
    my ($this, $revision) = @_;

    # setRepository may have been called.
    confess "unimplemented";
    # return ( [ 'author', 'review comment' ], ... ); potentially empty for no reviews
}

sub parseNonMergeRevisions {
    my ($this, $branch) = @_;
    # branch may be undefined, in which case the current branch should be used

    # setRepository may have been called.
    confess "unimplemented";
    # return ({ parseRevisionInfo output}, ...);
}

package deptool::MonotoneVC;

use strict;
use Carp;

use vars '@ISA';
@ISA = qw/deptool/;

sub new {
    my ($class) = @_;

    return bless { }, $class;
}

sub globalDir {
    return main::mtnRepoDir();
}

sub addAllUnknownFiles {
    main::runCommand(qw/mtn add --recursive --unknown/);
}

sub listUnknownFiles {
    my $fh = new FileHandle "mtn list unknown |"
        or die "bad fork mtn: $!";
    my @unknown = <$fh>;
    close($fh);
    die "?? mtn" if $?;
    grep(chomp, @unknown);
    return @unknown;
}

sub haveUncommittedChanges {
    my $fh = new FileHandle "mtn diff |"
        or die "fork fail: $!";
    $_ = <$fh>;
    return 1 unless /^\#\s*$/o;
    $_ = <$fh>;
    return 1 unless /^\# no changes\s*$/o;
    $_ = <$fh>;
    return 1 unless /^\#\s*$/o;
    $_ = <$fh>;
    return 1 if defined $_;
    return 0;
}

sub tryCommit {
    main::runCommand(qw/mtn diff/);
    my $cwd = main::aliasGetCwd();
    print "\ndepcommit: You have uncommitted differences (shown above) in $cwd\n";
    main::userPrompt("commit changes");
    die "depcommit: ERROR missing _MTN directory in xxx"
        unless -d "_MTN";

    eval { main::runCommand(qw/mtn commit/); };
    if ($@) {
        die "$@" if $@ !~ /mtn commit.*failed/o;
        warn "$@"; # redundant?
        return 0;
    } else {
        return 1;
    }
}

# TODO-reviewer: I'd like to dump the pin code; we use it really infrequently, it's fairly
# complicated, and once we're on git, it can be better implemented with a local branch.
# I don't think that anyone is using it so I don't think we're losing much.  However, it was
# part of the public interface, so an arguement could be made that it should go through a
# deprecation cycle.

sub foundPin {
    my($rev, $head) = @_;

    my $filename = main::depPinFilename();
    return 0 unless -r $filename;
    my $fh = new FileHandle($filename)
        or die "Can't open $filename for read: $!";
    while(<$fh>) {
        return 1 if /^$head $rev$/;
    }
    return 0;
}

sub hadPin {
    my($rev) = @_;

    my $filename = main::depPinFilename();
    return 0 unless -r $filename;
    my $fh = new FileHandle($filename)
        or die "Can't open $filename for read: $!";
    while(<$fh>) {
        return 1 if /$rev$/;
    }
    return 0;
}

sub getCurHeads {
    my($fh) = new FileHandle("mtn automate heads |")
        or die "Unable to fork: $!";
    my @heads = <$fh>;
    close($fh);
    die "??" unless @heads > 0;
    grep(chomp, @heads);
    return @heads;
}

sub pullAndMerge {
    main::mtnOp("pull");
    while(1) {
        my $fh = new FileHandle "mtn automate heads |";
        my @heads = getCurHeads();
        last if @heads == 1;
        my $cwd = main::aliasGetCwd();
        print "\n" x 5, "You have multiple heads in $cwd.";
        main::userPrompt("merge the heads");
        main::runCommand("mtn","merge");
    }
}

sub getCurRevision {
    my($fh) = new FileHandle("mtn automate get_base_revision_id |")
        or die "Unable to fork: $!";

    local $_ = <$fh>;
    die "??" unless $_ =~ /^[a-fA-F0-9]{40}$/o;
    chomp;
    close($fh);
    return $_;
}

sub pullDoUpdate {
    my ($options) = @_;

    # Do Update
    my $cwd = main::aliasGetCwd();
    my $cur_rev = getCurRevision();
    my $deppin_filename = main::depPinFilename();
    if (-f $deppin_filename) {
        my @heads = getCurHeads();
        die "??" unless @heads == 1;

        if (foundPin($cur_rev, $heads[0])) {
            print << "END";
****
  You are currently pinned to revision $cur_rev
  The head revision has not changed, so the pin remains.
  To remove the pin, edit $deppin_filename
****
END
            return;
        } elsif (hadPin($cur_rev)) {
            print <<"END";
****
You would be pinned to $cur_rev, but the head
has been updated.  To reset the pin:
cd $cwd; deptool pin $cur_rev
****
END
            # skip prompting, will do so for the update.
        }
    }
    while(1) {
        my $cur_rev = getCurRevision();
        my @heads = getCurHeads();
        die "??" unless @heads == 1;
        last if $cur_rev eq $heads[0];
        print <<"END";
You current checkout is not up to date in $cwd.
$cur_rev != $heads[0]
END
        main::userPrompt("update to the current revision");
        main::runCommand("mtn","update");
        $options->{made_changes} = 1;
    }
}

# sets $options->{made_changes} if we made changes.
sub pull {
    my ($this, $options) = @_;
    pullAndMerge();
    pullDoUpdate($options);
}

sub sync {
    my ($this, $options) = @_;
    main::mtnOp("sync");
    pullDoUpdate($options);
}

sub version {
    my ($this) = @_;

    unless (defined $this->{mtn_version}) {
        my @output = main::getCmdOutput("mtn --version");

        die "bad return from mtn --version" unless @output == 1;

        local $_ = $output[0];
        die "can't parse '$output[0]'" unless /^monotone (\d+\.\d+\S*) /o;
        $this->{mtn_version} = $1;
    }
    return $this->{mtn_version};
}

sub versionString {
    my ($this) = @_;

    return "monotone-" . $this->version();
}

sub rawRevisionInfo {
    my ($this, $revision) = @_;

    my $db = defined $this->{database} ? "-d $this->{database}" : '';
    my $vcver = $this->versionString();
    if ($vcver =~ /^monotone-(\d+)\.(\d+)\b/o) {
        my ($major, $minor) = ($1,$2);
        my $check_fn = sub {
            my ($out, $err) = @_;

            if (grep(/no match for selection/o, @{$err}) > 0) {
                die "Revision '$revision' not found. Did you specify the correct revision?";
            }
        };
        if ($major == 0 && $minor <= 0.28) { # may be later than this
            return main::getCmdOutput("mtn $db log -r $revision --last 1", $check_fn);
        } elsif ($major == 0 && $minor < 45) { # date formatting added in 0.45
            return main::getCmdOutput("mtn $db log --from $revision --last 1 --no-graph",
                                      $check_fn);
        } else {
            return main::getCmdOutput("mtn $db log --no-format-dates --from $revision --last 1"
                                      . " --no-graph", $check_fn);
        }
    } else {
        die "Don't know how to get revision log on $vcver";
    }
}

sub parseRevisionInfo {
    my ($this, $revision) = @_;

    my @output = $this->rawRevisionInfo($revision);

    my %raw_info;

    while ($_ = shift @output) {
        last if /^$/o;
        next if /^-+$/o;
        chomp;
        die "unable to parse $_" unless /^(\w+):\s+(\S.+)$/o;
        if (defined $raw_info{$1}) {
            die "internal" if ref $raw_info{$1};
            $raw_info{$1} = [$raw_info{$1}, $2];
        } else {
            $raw_info{$1} = $2;
        }
    }
    $_ = shift @output; die "?" unless /^Changelog:/o;
    $_ = shift @output; die "?" unless /^$/o;
    $raw_info{changelog} = join('', @output);

    foreach $_ (qw/Revision Author Date Branch/) {
        die "Missing expected revision info $_ for revision $revision"
            unless defined $raw_info{$_};
    }

    return { revision => $raw_info{Revision},
             ancestor => $raw_info{Parent},
             author => $raw_info{Author},
             date => $raw_info{Date},
             branch => $raw_info{Branch},
             changelog => $raw_info{changelog} };
}

sub codeReviewPrep {
    my ($this) = @_;

    my %mtn_options = readMtnOptions();
    $this->{database} = $mtn_options{database};
    die "missing db in .../_MTN/options"
        unless defined $this->{database};
}

sub markReviewed {
    my ($this, $revisions, $comment) = @_;

    foreach my $revision (@$revisions) {
        main::quietRunCommand('mtn', 'cert', $revision, 'review', $comment);
    }
}

sub readMtnOptions {
    my ($src) = @_;

    $src = main::rootSrcDir() unless defined $src;
    my $fh = new FileHandle("$src/_MTN/options")
        or die "Can't open $src/_MTN/options for read: $!";
    my %ret;
    while(<$fh>) {
        $ret{branch} = $1 if /^\s*branch \"(.+)\"$/o;
        $ret{database} = $1 if /^\s*database \"(.+)\"$/o;
    }
    close($fh);

    return %ret;
}

sub codeReviewCheckout {
    my($this, $targetdir, $revision) = @_;

    my $info = $this->parseRevisionInfo($revision);
    my @cmd = (qw/mtn checkout -d/, $this->{database}, '-r', $revision);
    if (ref $info->{branch}) {
        my @values = sort { (length $a) <=> (length $b) } @{$info->{branch}};
        push(@cmd, "-b", $values[0]);
        print "Using shortest branch $values[0]\n";
    }

    main::quietRunCommand(@cmd, $targetdir);
}

sub codeReviewTryPatch {
    my ($this, $from, $to, $basedir) = @_;

    # TODO: use processmanager so we can be safe on this command execution
    main::runCommand("mtn diff -d $this->{database} -r $from -r $to >$basedir/$to.patch");
    eval {
        main::runCommand("patch -p0 --ignore-whitespace -d $basedir/$to <$basedir/$to.patch >$basedir/$to.patch.err 2>&1");
    };
    return $@ ? 0 : 1;
}

sub codeReviewExtractFile {
    my ($this, $to, $file, $dest) = @_;

    main::runCommand("mtn cat -r $to $file >$dest");
}

sub setRepository {
    my ($this, $db) = @_;

    $this->{database} = $db;
}

sub getReviews {
    my ($this, $revision) = @_;

    my $db = defined $this->{database} ? "-d $this->{database}" : '';
    my @certs = main::getCmdOutput("mtn $db list certs $revision");
    my @reviews;
    for (my $i=0; $i < @certs; ++$i) {
        next unless $certs[$i] =~ /^Name\s+: review$/o;
        die "Internal parse error $certs[$i-2] " unless $certs[$i-2] =~ /^Key\s+: (.+)$/o;
        my $author = $1;
        die "Internal parse error $certs[$i+1] " unless $certs[$i+1] =~ /^Value : (.+)$/o;
        push (@reviews, [ $author, $1 ]);
    }
    return @reviews;
}

sub parseNonMergeRevisions {
    my ($this, $branch) = @_;

    my $db = defined $this->{database} ? "--db $this->{database}" : '';

    my $from = '';
    if (defined $branch) {
        my @out = main::getCmdOutput("mtn $db head -b $branch");
        grep(chomp, @out);

        die "no heads for branch $branch"
            unless @out > 0;

        die "multiple heads for branch $branch ($out[0] $out[1])?"
            unless @out == 1;

        die "head output for branch $branch not hex ($out[0])?"
            unless $out[0] =~ /^([0-9a-f]+) \S+/o;

        $from = "--from $1";
    }

    my $cmd;

    my $vcver = $this->versionString();
    if ($vcver =~ /^monotone-(\d+)\.(\d+)\b/o) {
        my ($major, $minor) = ($1,$2);
        if ($major == 0 && $minor <= 0.28) { # may be later than this
            $cmd = "mtn $db log $from --no-merges";
        } elsif ($major == 0 && $minor < 45) { # date formatting added in 0.45
            $cmd = "mtn $db log $from --no-graph --no-merges";
        } else {
            $cmd = "mtn $db log $from --no-graph --no-merges --no-format-dates";
        }
    } else {
        die "Don't know how to get non-merge revisions from $vcver";
    }

    my $fh = new FileHandle "$cmd |"
        or die "Unable to run $cmd: $!";
    my %remap = ( 'Parent' => 'ancestor', 'Author' => 'author', 'Date' => 'date',
                  'Branch' => 'branch' );
    my @ret;
    while (<$fh>) {
        chomp;
        die "? '$_'" unless /^-+$/o;
        my %ent;
        my $tmp = $_;
        $_ = <$fh>;
        if ($_ =~ /^Revision: ([a-f0-9]{40})$/o) {
            $ent{revision} = $1;
            while (<$fh>) {
                last if /^\s*$/o;
                die "? '$_'" unless /^(\w+):\s+(.*)$/o; # .* because earliest Ancestor is empty.
                my $k = $remap{$1};
                next unless defined $k;
                if (defined $ent{$k}) {
                    if (ref $ent{$k}) {
                        push(@{$ent{$k}}, $2);
                    } else {
                        $ent{$k} = [$ent{$k}, $2];
                    }
                } else {
                    $ent{$k} = $2;
                }
            }
            $ent{changelog} = '';
            while (<$fh>) {
                last if /^-{50,}$/o;
                $ent{changelog} .= $_;
            }
            $ent{changelog} =~ s/Changelog:\s*\n//o;
            # dunno how this happened, but it's present on some old DataSeries revisions.
            $ent{branch} ||= 'unknown-branch';
            push (@ret, \%ent);
        } else {
            # assume someone put lots of --- in the changelog

            confess "weird, no revision data accumulated $_ " unless @ret > 0;
            my $ent = $ret[@ret-1];
            $ent->{changes} .= $tmp;
            while (1) {
                last if /^-{50,}$/o;
                $ent{changes} .= $_;
                $_ = <$fh>;
                last unless defined $_;
            }
        }
        last unless defined $_;
        redo;
    }
    $_ = <$fh>;
    die "? '$_' still have input; last rev $ret[$#ret]->{Revision}" if defined $_;
    close($fh) or confess "close failed: $! ($?)\ncommand is $cmd";
    die "$cmd failed" unless $? == 0;
    return @ret;
}

package deptool::GitVC;

use strict;
use vars '@ISA';
@ISA = qw/deptool/;

use Carp;
use English;
use File::Path;

sub new {
    my ($class) = @_;

    return bless { }, $class;
}

sub globalDir {
    return main::gitRepoDir();
}

sub init {
    die "Unable to find git binary in path; you should repair this.
Usually yum install git or apt-get install git will work."
        unless main::checkForBinary("git");

    my $server = main::gitServer();
    my @repositories = @ARGV;
    if (@repositories == 0) {
        print "Assuming default repository simpl/Lintel\n";
        @repositories = ("simpl/Lintel");
    }
    initConfig();
    initRepositories($server, \@repositories);

    # clone from git+ssh://gitosis@host/repo?
#  git remote set-url --push origin ssh://gitolite@git.u/simpl/Lintel
#  Fetch URL: git://git.u/simpl/Lintel
#  Push  URL: ssh://gitolite@git.u/simpl/Lintel
# http://git-wt-commit.rubyforge.org/git-publish-branch
    # no signatures for git commits, can sign tags.
    # http://git.661346.n2.nabble.com/GPG-signing-for-git-commit-td2582986.html
    # branch naming: http://nvie.com/posts/a-successful-git-branching-model/
    # http://scottchacon.com/2011/08/31/github-flow.html

    # branch naming: big question seems to be common commits to master or infrequent, i.e.
    # can unstable commits go to master.  Seems to depend on quality of regression tests;
    # high quality -> direct to master, low quality -> develop branch, then branch for release
    # and stabilization testing.  Convention from core git tools is direct to master; convention
    # from gittool is direct to develop.

    # upstream branches only tracked for 1 level unless you do --mirror which implies --bare.
    # we want to support local branches that never go back to central.
    # we want to allow/encourage rebase for things that haven't been pushed to central
}

sub initConfig {
    my ($quiet) = @_;

    # git config --global -l
    # set user.name, user.email, core.editor, merge.tool

    my $config_date = '2011-12-07';
    my %config = qw/core.editor emacs merge.tool kdiff3 deptool.diff difftool/;
    my @pwuid = getpwuid($UID);
    my @gecos = split(/,/o, $pwuid[6]);
    $config{'user.name'} = $gecos[0]; # hope

    my $vcs = new deptool::GitVC;
    $vcs->readConfig(\%config);
    # Define deptool config version by date so that if there turn out to be more things we
    # want to configure, we can update the date and the config can be updated.
    if (defined $config{'deptool.config'} && $config{'deptool.config'} eq $config_date) {
        if (!$quiet) {
            print "Git configuration up to date ($config_date). To reconfigure, first:\n";
            print "% git config --global deptool.config reconfig\n\n";
        }
        return;
    } elsif (defined $config{'deptool.config'}) {
        print "Git configuration out of date: $config{'deptool.config'} != $config_date.\n";
        # TODO-reviewer: this won't update checked out directories.  Should we be reading the
        # global state then the local one when we load the config?
    }

    my $deptool_ignores = $vcs->globalDir() . "/deptool.ignores";
    if (! -f $deptool_ignores) {
        # mode 0755 so others can by default see repos, but not write to them.
        mkpath([$vcs->globalDir()], 1, 0755);
        my $fh = new FileHandle ">$deptool_ignores"
            or die "Unable to write $deptool_ignores";
        print $fh <<'EOF';
# File automatically generated by deptool, changes may be overwritten.
*~
\#*\#
EOF
    }
    $config{'core.excludesfile'} = $deptool_ignores;

    foreach my $ent (qw/user.email user.name core.editor core.excludesfile merge.tool deptool.diff/) {
        $config{$ent} ||= '';
        print "Enter git configuration for $ent [default=$config{$ent}]: ";
        my $val = <STDIN>;
        chomp $val;
        $val = $config{$ent} if $val =~ /^\s*$/o;
        if ($val eq '') {
            warn "Invalid to have an empty value for $ent.  Please enter a valid value";
            redo;
        }
        if ($ent eq 'user.email' && $val !~ /\@/) {
            warn "Invalid email address specified, should have an \@ in it.";
            redo;
        }

        main::quietRunCommand('git','config','--global',$ent,$val);
    }

    main::quietRunCommand('git','config','--global','deptool.config',$config_date);
}

sub initRepositories {
    my ($server, $repositories) = @_;

    foreach my $repo (@$repositories) {
        my $rw_repo = $repo;
        unless ($repo =~ m!^\w+://!o) {
            # TODO: need --ssh-user option or something like that.
            $rw_repo = "ssh://gitolite\@$server/$repo";
            $repo = "git://$server/$repo";
        }
        die "? $repo" unless $repo =~ m!^\w+://[^/]+/(.+)$!o;
        # Could include the hostname, but that seems a little goofy since the "central" server
        # could change on a regular basis.  Seems better to assume that the repository names
        # are going to be unique.

        my $destdir = main::gitRepoDir() . "/$1";

        if (-d $destdir) {
            main::runCommand(qw/git --git-dir/, $destdir, qw/fetch --all/);
            main::runCommand(qw/git --git-dir/, $destdir, qw/fetch --tags/);
        } else {
            # --mirror is really dangerous, it implies --force
            # runCommand(qw/git clone --tags/, $repo, "$git_repo_dir/$shortname");
            main::runCommand(qw/git clone --mirror/, $repo, $destdir);
            my @common = (qw/git --git-dir/, $destdir);
            # Undo dangerous bits of --mirror.  --mirror on push implies --force which
            # can lose commits on the remote/central repository.  The + on the fetch spec
            # has the same property in reverse.  In essence if people want to do something
            # unsafe (and hopefully rare), make them use the raw git commands.
            main::runCommand(@common, qw/config --unset remote.origin.mirror/);
            main::runCommand(@common, qw!config remote.origin.fetch refs/*:refs/*!);
            if ($rw_repo ne $repo) {
                main::runCommand(@common, qw/remote set-url --push origin/, $rw_repo);
            }
        }
    }
}

sub readConfig {
    my ($this, $config) = @_;

    $config ||= {}; # allow overwrite of default or just read
    if (-f "$ENV{HOME}/.gitconfig") {
        my $fh = new FileHandle "git config --global -l |";
        while (<$fh>) {
            chomp;
            die "? '$_'" unless /^([\w\.]+)=(.*)$/o;
            $config->{$1} = $2;
        }
    }
    return $config;
}

sub addAllUnknownFiles {
    main::runCommand(qw/git add --all/);
}

sub getWorkdirStatus {
    my ($this, $untracked) = @_;
    $untracked ||= 'all';
    my $fh = new FileHandle "git status --porcelain -z --untracked-files=$untracked |"
        or die "bad fork git: $!";
    my @tmp = <$fh>;
    close($fh);
    die "?? git" if $?;
    return split(/\x{00}/o, join('', @tmp));
}

sub listUnknownFiles {
    my ($this) = @_;

    my @unknown = $this->getWorkdirStatus();
    @unknown = grep(s/^\?\? //o, @unknown); # keep and prune to unknown

    return @unknown;
}

sub haveUncommittedChanges {
    my ($this) = @_;

    my @status = $this->getWorkdirStatus('no');
    return @status != 0;
}

sub tryCommit {
    my ($this) = @_;

    die "\$DISPLAY is not set, deptool commit currently assumes that it can create
two windows one for the diffs and one for the commit.  Unclear how best to
handle this situation.  Suggestions are welcome.\n "
        unless defined $ENV{DISPLAY} && $ENV{DISPLAY} =~ /:/o;
    main::runCommand(qw/git add -u/); # any uncommitted files we want to track should already be added
    my $pm = Lintel::ProcessManager->new();

    my $config = $this->readConfig();

    my $commit_pid;
    if($config->{'deptool.serialdiff'} ne 'serial') {
        $commit_pid = $pm->fork(cmd => [qw/git commit/, $this->{amend} ? ('--amend') : ()]);
    }

    # TODO-reviewer: I find the git diff somewhat harder to read because it's condensed more
    # tightly.  Is it worth writing something that makes the diff easier to read by adding
    # separators between files?

    my @common = qw/--staged -M75 -C50/;
    # TODO-reviewer: new files with no content don't get shown in diff or difftool.
    if ($config->{'deptool.diff'} eq 'difftool') {
        eval { main::runCommand(qw/git difftool --gui/, @common); };
    } else {
        eval { main::runCommand(qw/git diff --patience/, @common); };
    }
    print "=================== done showing differences.\n";
    if($config->{'deptool.serialdiff'} eq 'serial') {
        $commit_pid = $pm->fork(cmd => [qw/git commit/, $this->{amend} ? ('--amend') : ()]);        
    }

    my %status = $pm->waitAll();
    die "missing $commit_pid status?" unless defined $status{$commit_pid};
    if ($status{$commit_pid} != 0) {
        die "Internal, commit failed, but no outstanding changes?"
            unless $this->haveUncommittedChanges();
        # Commit failed, don't adjust the $this->{amend} state
        print "Warning: commit failed, will re-try\n";
        return 0;
    } elsif ($this->haveUncommittedChanges()) {
        # TODO-reviewer: we could instead do git reset --soft HEAD~1 in order to back out the
        # commit.  Doing the amend seems nicer since it leaves the commit message around to be
        # edited, and the committed state is supposed to be a consistent snapshot that we just
        # compied/tested anyway.
        $this->{amend} = 1;
        print "Warning: changes made during commit, will re-try\n";
        return 0;
    } else {
        delete $this->{amend};
        return 1;
    }
}

sub getCurrentHead {
    # Seems like there should be a way to do this without getting the difference, but I can't find
    # one.
    my $fh = new FileHandle "git show --format=format:%H |";
    $_ = <$fh>;
    chomp;
    die "? '$_'" unless /^([0-9a-f]{40})$/o;
    return $1;
}

sub getAllBranches {
    my $fh = new FileHandle "git branch -a |";

    my %branch_to_info;
    while (<$fh>) {
        my $info;
        if (/^\* (\S+)$/o) {
            $info = { current => 1 };
        } elsif (/^  (\S+)$/o) {
            $info = { };
        } elsif (/^  (\S+) -> (\S+)$/o) {
            $info = { reference => $2 };
        } else {
            chomp;
            die "unrecognized branch line: $_";
        }
        die "duplicate branch line for $1" if defined $branch_to_info{$1};
        $branch_to_info{$1} = $info;
    }
    return \%branch_to_info;
}

sub getCurrentBranch {
    my ($this, $branch_to_info) = @_;

    $branch_to_info = $this->getAllBranches() unless defined $branch_to_info;
    my $current_branch;
    while (my ($branch, $info) = each %$branch_to_info) {
        next unless $info->{current};
        die "multiple current branches ($branch, $current_branch)?" if defined $current_branch;
        $current_branch = $branch;
    }
    die "no current branch?" unless defined $current_branch;
    return $current_branch;
}

sub getAllRemotes {
    my ($from) = @_;
    if (ref $from) {
        $from = ''; # current dir
    } else {
        $from = "--git-dir $from";
    }

    my $fh = new FileHandle "git $from remote -v |";

    my %remote_to_info;
    while (<$fh>) {
        chomp;
        die "can not parse '$_'" unless /^(\S+)\s+(\S+)\s+\((\w+)\)$/o;
        my ($name, $url, $mode) = ($1,$2,$3);
        die "?? '$name' '$url' '$mode'" unless defined $mode;
        if ($mode eq 'fetch') {
            die "Duplicate remote named '$name'" if defined $remote_to_info{$name};
            $remote_to_info{$name} = { fetch => $url };
        } elsif ($mode eq 'push') {
            die "Missing fetch url for remote named '$name'" unless defined $remote_to_info{$name};
            $remote_to_info{$name}->{push} = $url;
        } else {
            die "Unexpected mode '$mode', expected fetch or push";
        }
    }
    return \%remote_to_info;
}

sub pull {
    my ($this, $options) = @_;

    initConfig(1);
    # To learn about new branches:
    # git fetch origin '+refs/heads/*:refs/remotes/origin/*'
    my $cur_head = $this->getCurrentHead();

    # TODO-reviewer: should I put in the userprompt bits?  I don't think anyone was using
    # or even paying attention to them.

    # TODO-reviewer: below will not respect changes to DEPTOOL_GIT_SERVER; do we care?
    # Eric: yes, we need it for dep-publish to work with the untested repo.

    # Learn about new branches, get any new revisions:
    main::runCommand(qw!git fetch local-cache +refs/heads/*:refs/remotes/local-cache/*!);
    main::runCommand(qw!git fetch origin +refs/heads/*:refs/remotes/origin/*!);
    # oddly with the default fetch spec set to that in the config, fetch origin does nothing.
    my $branch_to_info = $this->getAllBranches();
    my $current_branch = $this->getCurrentBranch($branch_to_info);
    my @branches;
    foreach my $remote (qw/origin local-cache/) {
        my $branch = "remotes/$remote/$current_branch";
        if (defined $branch_to_info->{$branch}) {
            push (@branches, $branch);
        } else {
            # TODO: probably should do some sort of merge from some other branch option at some
            # point.
            warn "Missing remote branch $branch";
        }
    }

    if (@branches > 0) {
        # If we run this as a single command, then we seem to generate a log message in order to
        # merge the up-to-date local-cache with the origin remote.  Running the two commands
        # separately does not seem to generate the spurious log message, and the order does not
        # seem to matter.
        foreach my $branch (@branches) {
            # merge remote branch(s) to local
            main::runCommand(qw/git merge --log --ff/, $branch);
        }
    } else {
        # TODO-reviewer: die?
        warn "No remote branches for $current_branch";
    }
    my $new_head = $this->getCurrentHead();
    if ($cur_head ne $new_head) {
        $options->{made_changes} = 1;
    }
}

sub tryPush {
    my ($this, $to) = @_;

    eval { main::runCommand(qw!git push!, $to); };
    if ($@) {
        print "Push failed: $@\n";
        return 0;
    } else {
        return 1;
    }
}

sub sync {
    my ($this, $options) = @_;

    # TODO: Below doesn't respect DEPTOOL_GIT_SERVER, needed for untested repo

    if ($this->tryPush('local-cache') && $this->tryPush('origin')) {
        # success
    } else {
        print "Push failed; trying pull\n";
        $this->pull($options);
        die "push failed, but pull did not make any changes; aborting"
            unless $options->{made_changes};
    }

    # To delete a branch: gitolite config needs RW+
    # git push origin :feature/test
    # This action is unsafe in that it could delete a conflicting update, and the RW+ has the
    # same issue.  Perhaps put it in the untested repo to do this on merged branches if a
    # delete/<branch> branch is created?
}

sub rawRevisionInfo {
    my ($this, $revision, $format) = @_;

    $format ||= 'full';
    my $check_fn = sub {
        my ($out, $err) = @_;

        if (grep(/fatal: bad object/o, @{$err}) > 0) {
            die "Revision '$revision' not found. Did you specify the correct revision?";
        }
    };
    my $git_dir = defined $this->{git_dir} ? "--git-dir $this->{git_dir}/.git" : '';
    return main::getCmdOutput("git $git_dir log -1 --format=$format -r $revision", $check_fn);
}

sub parseRevisionData {
    my ($this, @output) = @_;

    grep(s/\n$//o, @output);
    my %info;
    while ($_ = shift @output) {
        last if /^$/o;
        chomp;
        die "unable to parse '$_'" unless /^(\w+) (.+)$/o;
        if (defined $info{$1}) {
            if (ref $info{$1}) {
                push(@{$info{$1}}, $2);
            } else {
                $info{$1} = [$info{$1}, $2];
            }
        } else {
            $info{$1} = $2;
        }
    }
    pop(@output) if $output[@output-1] =~ /^$/o;
    my @prefix = grep(/^\S/o, @output);
    die "parse error " . scalar @prefix . " bad lines, first bad line '$prefix[0]' " if @prefix > 0;
    grep(s/^    //o, @output);
    $info{changelog} = join('', @output);
    foreach $_ (qw/commit author/) {
        die "Missing $_ entry from git log output" unless defined $info{$_};
    }

    foreach $_ (qw/commit author/) {
        confess "Duplicate $_ entry for git data?" if ref $info{$_};
    }

    die "can not parse $info{author}"
        unless $info{author} =~ /^(.+) (\d+) [\+\-]\d{4}$/o;
    my ($author, $date_raw) = ($1, $2);
    my @d = gmtime($date_raw);
    my $date = sprintf("%04d-%02d-%02d %02d:%02d:%02d",
                       $d[5]+1900, $d[4]+1, $d[3], $d[2], $d[1], $d[0]);
    my %ret = ( revision => $info{commit}, author => $author, date => $date, branch => 'unknown',
                changelog => $info{changelog} );
    if (defined $info{parent} && ref $info{parent}) { # merge revision
        $ret{ancestor1} = $info{parent}->[0];
        $ret{ancestor2} = $info{parent}->[1];
    } else {
        $ret{ancestor} = $info{parent};
    }
    return \%ret;
}

sub parseRevisionInfo {
    my ($this, $revision) = @_;

    my @output = $this->rawRevisionInfo($revision, 'raw');
    return $this->parseRevisionData(@output);
}

sub codeReviewPrep {
    my ($this) = @_;

    $this->{srcdir} = main::aliasGetCwd();
}

sub codeReviewCheckout {
    my($this, $targetdir, $revision) = @_;

    rmtree($targetdir);
    my $cwd = main::aliasGetCwd();
    main::runCommand(qw/git clone --shared --/, "$this->{srcdir}/.git", $targetdir);
    # --git-dir isn't sufficient; if you have changes in the current directory, at least for
    # git 1.7.2.5 it will refuse to do the checkout command.
    main::aliasChdir($targetdir);
    main::runCommand(qw/git --git-dir/, "$targetdir/.git", 'checkout', $revision);
    main::aliasChdir($cwd);
}

sub markReviewed {
    my ($this, $revisions, $comment) = @_;

    my $config = $this->readConfig();
    die "Internal" unless defined $this->{srcdir};
    my $fh = new FileHandle ">>$this->{srcdir}/.deptool-git-review-markings"
        or die "Unable to open $this->{srcdir}/.deptool-git-review-markings for write: $!";
    my $email = $config->{'user.email'};
    foreach my $rev (@$revisions) {
        print $fh "$rev\t$email\t$comment\n";
    }
    close($fh);
}

sub codeReviewTryPatch {
    my ($this, $from, $to, $basedir) = @_;

    # TODO: use processmanager so we can be safe on this command execution
    main::runCommand("git --git-dir $this->{srcdir}/.git diff --patch --patience $from $to >$basedir/$to.patch");
    eval {
        main::runCommand("patch -p1 --ignore-whitespace -d $basedir/$to <$basedir/$to.patch >$basedir/$to.patch.err 2>&1");
    };
    return $@ ? 0 : 1;
}

sub codeReviewExtractFile {
    my ($this, $rev, $file, $dest) = @_;

    # You can assume codeReviewPrep has been called on $this.
    #
    # Extract $file from revision $rev and write it to $dest
    main::runCommand("git --git-dir $this->{srcdir}/.git show $rev:$file >$dest");
}

sub setRepository {
    my ($this, $repository) = @_;

    $this->{git_dir} = $repository;
}

sub getReviews {
    my ($this, $revision) = @_;

    confess "unable to handle short revision '$revision'" unless $revision =~ /^[a-f0-9]{40}$/o;
    unless (defined $this->{reviews}) {
        my $srcdir = $this->{git_dir} || main::rootSrcDir();
        $this->{reviews} = {};
        my $file = "$srcdir/.deptool-git-review-markings";
        if (-f $file) {
            my $fh = new FileHandle $file or die "Unable to open $file for read: $!";
            while (<$fh>) {
                chomp;
                die "unable to parse '$_'" unless /^([a-f0-9]{40})\t(.+?)\t(.+)$/o;
                $this->{reviews}->{$1} ||= [];
                push(@{$this->{reviews}->{$1}}, [ $2, $3 ]);
            }
        }
    }
    my $ret = $this->{reviews}->{$revision};
    return () unless defined $ret;
    return @$ret;
}

sub parseNonMergeRevisions {
    my ($this, $branch) = @_;

    my $git_dir = defined $this->{git_dir} ? "--git-dir $this->{git_dir}/.git" : '';

    # branch may be undefined, in which case the current branch should be used
    my $fh = new FileHandle "git $git_dir log --format=raw -z --no-merges |"
        or die "Unable to run git log: $!";

    local $INPUT_RECORD_SEPARATOR;
    $INPUT_RECORD_SEPARATOR = "\x00";
    my @ret;
    while (my $commit = <$fh>) {
        $commit =~ s/\x00$//o;
        my @lines = split(/\n/o, $commit);
        push(@ret, $this->parseRevisionData(@lines));
    }

    return @ret;
}

package deptool::TarVC;
# not really a full version control system, but enough for read-only snapshots from releases.

use File::Path;
use FileHandle;
use Getopt::Long;

sub init {
    my $no_cache = 0;

    # TODO-2013-04-15: remove the below option.
    my $result = GetOptions("no-cache!" => \$no_cache);

    warn "no-cache is now on by default, it seems unlikely someone would init twice"
        if $no_cache;
    usage("Unknown error") unless $result;

    my (@files) = @ARGV;

    @files = "http://tesla.hpl.hp.com/opensource/sources/latest-release"
        if @files == 0;
    my $startdir = main::aliasGetCwd();

    mkpath(main::projects());
    main::aliasChdir(main::projects());

    foreach my $file (@files) {
        if (-f $file && -r $file) {
            unpackProjectsTar($file);
        } elsif (-f "$startdir/$file" && -r "$startdir/$file") {
            unpackProjectsTar("$startdir/$file");
        } elsif ($file =~ m!^http:.*latest-release!o) {
            httpFetchLatestRelease($file);
        } elsif ($file =~ m!^http:!o) {
            httpFetchUnpackTar($file);
        } else {
            die "Unrecognized argument '$file', expected either /path/to/tar or http://url";
        }
    }
}

sub backupOldProjectDir {
    my ($project) = @_;

    my $projects = main::projects();

    my $from_name = "$projects/$project";
    if (-e $from_name) {
        my @now = localtime(time);
        my $backup_date = sprintf("%04d-%02d-%02dT%02d:%02d", $now[5] + 1900, $now[4], $now[3],
                                  $now[2], $now[1]);
        my $to_name = "${from_name}.$backup_date";
        main::userPrompt("Rename $from_name to $to_name");
        rename($from_name, $to_name)
            or die "Unable to rename $from_name to $to_name: $!";
    }
    die "$from_name still exists?"
        if -e $from_name;
}

sub unpackProjectsTar {
    my ($file) = @_;

    my $name_re = qr!\b(\w+)-([\d\-\.]+).tar.bz2!;
    die "Expected $file to be named $name_re"
        unless $file =~ $name_re;
    my ($project, $revision) = ($1,$2);

    backupOldProjectDir($project);

    my $projects = main::projects();
    if (-e "$project-$revision") {
        main::userPrompt("Delete $projects/$project-$revision");
        rmtree("$project-$revision");
    }
    die "internal $project-$revision" if -e "$project-$revision";

    main::userPrompt("Untar $file into $projects");
    system("tar xvvfj $file");
    die "Did not get expected directory $project-$revision"
        unless -d "$project-$revision";
    rename("$project-$revision",$project)
        or die "Unable to rename $project-$revision to $project";
}

sub httpFetchUnpackTar {
    my ($url) = @_;

    die "Bad url '$url', expected http://.*/\\w+-([\\d\\-\\.]+).bz2"
        unless $url =~ m!^http://.*/(\w+)-([\d\-\.]+).tar.bz2$!o;
    my ($project, $revision) = ($1, $2);

    backupOldProjectDir($project);

    my $output = "$project-$revision.tar.bz2";

    fetchHttp($url, $output);
    unpackProjectsTar(main::projects() . "/$output");
}

sub httpFetchLatestRelease {
    my ($url) = @_;

    fetchHttp($url, "latest-release");
    my $fh = new FileHandle("latest-release")
        or die "Can't open latest-release: $!";
    my @suburls = <$fh>;
    close($fh);

    foreach my $suburl (@suburls) {
        my $tmp = $url;
        $tmp =~ s/latest-release$/$suburl/o;
        httpFetchUnpackTar($tmp);
    }
}

sub fetchHttp {
    my ($url, $output) = @_;

    foreach my $file ($output, "$output.tmp") {
        unlink($file);
        die "Unable to rm $file: $!" if -e $file;
    }
    foreach my $cmd ("wget --no-cache -O $output.tmp $url",
                     "curl -o $output.tmp $url") {
        main::userPrompt($cmd);
        print "Downloading $url using http proxy '$ENV{http_proxy}'\n"
            if $debug;
        my $ret = system($cmd);

        if ($ret == 0 && -r "$output.tmp") {
            rename("$output.tmp", $output)
                or die "Unable to rename $output.tmp to $output: $!";
            return;
        } else {
            warn "'$cmd' failed";
        }
    }
    die "Unable to download $url, all commands failed.";
}

=pod

=head1 BUGS

=over

=item *

cdopt/cddbg only work for sh-style shells.

=item *

code-review gets confused by file renames

=item *

pull should walk the current directory before dependent ones to deal
with new dependencies.

=back

=head1 AUTHOR

Eric Anderson <anderse@hpl.hp.com>

=cut
package Lintel::File::Lock;
use strict;
use warnings;
use Fcntl qw/:flock :DEFAULT/;
use FileHandle;

=pod

=head1 NAME

Lintel::File::Lock - locking and unlocking of files

=head1 SYNOPSIS

  use Lintel::File::Lock;

  # Wait forever
  my $fh = Lintel::File::Lock::getLock("/tmp/lock");
  die "??" unless defined $fh

  # Wait for 10 seconds
  my $fh = Lintel::File::Lock::getLock("/tmp/lock", 10);
  warn "no lock" unless defined $fh;

  # release lock
  $fh = undef;

=head1 FUNCTIONS

=head2 getLock(filename, [waittime, verbose, flags, mode])

   my $fh = getLock($filename, $waittime, $verbose, $flags, $mode);
   my $fh = getLockEx($filename,
                      waittime => $waittime,
		      verbose => $verbose,
		      flags => $flags,
		      mode => $mode);

getLock will attempt to acquire a lock on filename.  By default, the
file will be created if it doesn't exist, and getLock will return
an exclusive locked read/write FileHandle on success.  If you are going to
write to the file, you should call one of C<seek($fh, 0, SEEK_END); or
seek($fh, 0, SEEK_SET);> to set the current writing position.

To release the lock, set the filehandle to undef.

If no waittime is specified, it will wait forever.  Otherwise if it
has waited for waittime seconds, it will return undef.  Various additional
information is printed to stderr if verbose is specified.

The flags parameter is a bitwise or of the flags to sysopen.  The
default is to use O_CREAT | O_RDWR.

The mode parameter is used to change the access rights to the file for
a file that is being newly created.  If the mode parameter is omitted
it defaults to 0666.

If some rare errors occur getLock will die.  Locking requests may be silently
ignored by some filesystems, and in particular has known errors in many NFS
implementations.  Recent Linux NFS clients talking to a recent Linux NFS server
have functional locking.

=cut

sub getLockEx {
    my ($filename, %param) = @_;
    return getLock($filename, $param{waittime}, $param{verbose},
	            $param{flags}, $param{mode});
}

sub getLock {
    my ($filename, $waittime, $verbose, $flags, $mode) = @_;
    die "?" unless defined $filename;
    $flags ||= O_CREAT | O_RDWR;
    $mode ||= 0666;

    my $fh;
    sysopen($fh, $filename, $flags, $mode)
	or die "Unable to create or open $filename for read/write: $!";
    if (defined $waittime) {
	die "??" if $waittime < 0;
	my $start = time;
	while(1) {
	    my $ret = flock($fh, LOCK_EX|LOCK_NB);
	    if ($ret) {
		return $fh;
	    } elsif (! defined $ret) {
	        die "flock($filename, LOCK_EX|LOCK_NB) failed: $!";
	    }

	    my $remain = $waittime - (time - $start);
	    print STDERR "delayed waiting for lock, $remain seconds remain...\n"
		if $verbose;
	    return undef
		if (time - $start) >= $waittime;
	    sleep(1);
	}
    } else {
	unless(flock($fh,LOCK_EX)) {
	    die "flock($filename, LOCK_EX) failed: $!";
	}
	return $fh;
    }
    die "internal error";
}

=pod

=head1 AUTHOR

Eric Anderson <anderse@hpl.hp.com>

=head1 SEE ALSO

lintel-flock(1), perl(1)

=cut

1;

package Lintel::ProcessManager;

use strict;
use warnings;
use vars qw/@EXPORT_OK/;

use Exporter 'import';
@EXPORT_OK = qw/maskCoredump/;

use Carp;
use POSIX qw(:sys_wait_h setpgid);
use Time::HiRes 'time';

# TODO: write better tests for this module (test-lintel-processmanager only covers a little of the
# functionality).

=pod

=head1 NAME

Lintel::ProcessManager - library for dealing with sub-processes

=head1 SYNOPSIS

    use Lintel::ProcessManager; # 'wcoredump'

    my $process_manager 
        = new Lintel::ProcessManager([debug => 0|1],
                                     [auto_kill_on_destroy => 0|1 (default)]);


    my $pid = $process_manager->fork(cmd => '...' | [...] | sub { ... },
                                     [setpgid => 0|1,]
                                     [stdout => '/path',]
                                     [stderr => '/path|STDOUT',]
                                     [exitfn => sub { my ($pid, $status) = @_; ... }]);

    my %pid_to_status = $process_manager->wait([timeout]);

    my %pid_to_status = $process_manager->waitAll();

    my $status = $process_manager->waitPid($pid);

    $process_manager->enableSignals([sub { my ($pm) = @_; 'should-call-wait' }]);

    my @pids = $process_manager->children();

    my $nchildren = $process_manager->nChildren();

    my $new_status = Lintel::ProcessManger::wcoredump($status); # mask out core dump status

=head1 FUNCTIONS
    
=head2 my $mgr = new Lintel::ProcessManager(%options)

Create a new process manager.  You can pass a list of options to
control how the process manager will behave.  Right now there are two
options you can specify: debug, and auto_kill_on_destroy.  The debug
option will turn on a few additional bits of output, and is really for
developers.  auto_kill_on_destroy tells the process manager what to do
when it is destroyed, but still have active sub-processes.  By default
the answer is it prints a warning and sends a term signal to all of
the sub-processes.  Setting the value to 1 disables the warning, and 0
disables the killing.

=cut

# TODO: since you can't sanely have two process managers in a single process
# (wait on one can finish children the other should process), we should have
# this return a reference to a global and print out a warning that people
# should just use the global.
sub new {
    my ($class, %opts) = @_;

    $opts{children} = {};
    $opts{in_signal_handler} = 0;

    $SIG{CHLD} = sub { };
    return bless \%opts, $class;
}

sub DESTROY {
    my ($this) = @_;

    if ($this->nChildren() > 0) {
	unless (defined $this->{auto_kill_on_destroy}) {
	    warn "Lintel::ProcessManager($$): deleting process manager with children still present:\n";
	    while (my ($k, $v) = each %{$this->{children}}) {
		my $command = 'unknown';
		if (ref $v->{cmd} eq 'ARRAY') {
		    $command = join(" ", @{$v->{cmd}});
		} elsif (ref $v->{cmd} eq 'CODE') {
		    $command = "Function: $v->{cmd}";
		}
		warn "  pid $k, command $command\n";
		warn "Automatically killing children";
	    }
	    $this->{auto_kill_on_destroy} = 1;
	}
	if ($this->{auto_kill_on_destroy}) {
	    foreach my $pid ($this->children()) {
		kill ('TERM', $pid) 
		    or warn "Unable to kill $pid process group: $!";
	    }
	}
    }
}

sub waitForFile {
    my ($this, $path, $pid) = @_;

    return unless defined $path;
    die "internal" unless defined $pid;
    print "Lintel::ProcessManager($$): Wait for file $path to be created\n" if $this->{debug};
    for(my $start = time; ! -f $path; ) {
	my $delay = time - $start;
	if ($delay >= 3) {
	    warn "Waited too long ($delay seconds) for fork to make $path";
	    die "Process $pid has exited; giving up."
		unless kill(0, $pid) >= 1;
	    die "Waited way too long; giving up."
		if $delay > 30;
	    select(undef,undef,undef,0.25); # sleep longer now.
	} else {
	    select(undef,undef,undef,0.01);
	}
    }
}

=pod

=head2 $mgr->fork(%options)

Create a new sub-process.  The options control what process is created
and how it operates.  Options include:

=over 4

=item cmd => '...' | [...] | sub { ... }

What command should be executed in the sub-process.  This option can
be either a single string, which is then passed to exec, an array
reference which is dereferenced and passed to exec, or a subrouting
which is executed, and if it returns, the process will exit(0).  The
choice between the string and array reference is to control whether
the command is run through a shell (string) or not (array ref).

=item setpgid => 0|1

Should the sub-process execute setpgid after forking.  If yes, this process will become a new
process group leader, and so can be killed as a group.  I.e. if the sub-process forks children, you
can run kill -1, $pid; and it will kill both the process and its children.  The default, 0 leaves
the sub process part of the parent's group.

=item stdout => 'path'

What path (if any) should stdout be redirected to for the sub process.

=item stderr => 'path|STDOUT'

What path (if any) should stderr be redirected to for the sub process.
If the special value STDOUT is specified, then stderr is set to be
stdout.

=item exitfn => sub { my ($pid, $status) = @_; ... }

What function should be called when the sub-process exits.  The
process will be given both the process id that exited and the status
of the exit.  It can take any desired action.  Exit functions will be
called during an execution of the wait() method.

=item max_mem_bytes => <nbytes>

This option uses BSD::Resource if it is available to set the core limit
for the process to be started.   If BSD::Resource is not available then
specifying this option will raise an error through die().

=back

=cut

sub fork {
    my ($this, %opts) = @_;

    confess "missing cmd option" unless defined $opts{cmd};

    my $cmd = $opts{cmd};
    $cmd = join(' ', @$cmd) if ref $cmd eq 'ARRAY';
    $cmd = 'FUNCTION' if ref $cmd eq 'CODE';

    if ($this->{debug}) {
	my $stdout = $opts{stdout} || 'STDOUT';
	my $stderr = $opts{stdout} || 'STDERR';
	print "Lintel::ProcessManager($$): Running '$cmd', stdout=$stdout, stderr=$stderr\n";
    }

    if (defined $opts{stdout} && -f $opts{stdout}) {
	unlink($opts{stdout}) || confess "Can't delete $opts{stdout}: $!";
    }
    if (defined $opts{stderr} && -f $opts{stderr} && $opts{stderr} ne 'STDOUT') {
	unlink($opts{stderr}) || confess "Can't delete $opts{stdout}: $!";
    }
    my $pid = fork;
    confess "fork failed: $!" unless defined $pid && $pid >= 0;
    print "Lintel::ProcessManager($$): post-fork $pid\n" if $this->{debug};

    if ($pid == 0) { 
	print "Lintel::ProcessManager($$): Child -- $cmd\n" if $this->{debug};
	$this->{children} = {};
	if ($opts{setpgid}) {
	    print "setpgid -- $$\n" if $this->{debug};
	    # Make us a separate process group so we can kill the entire
	    # set of children (if any) as a single group.
	    setpgid(0, 0) or confess "Can't setpgid: $!";
	}
	if (defined $opts{stdout}) {
	    open(STDOUT, ">$opts{stdout}")
		or die "Can't write to $opts{stdout}: $!";
	}
	if (defined $opts{stderr}) {
	    if ($opts{stderr} eq 'STDOUT') {
		open(STDERR, ">&STDOUT")
		    or confess "Can't dup stdout: $!";
	    } else {
		open(STDERR, ">$opts{stderr}")
		    or die "Can't write to $opts{stderr}: $!";
	    }
	}

        if (defined $opts{max_mem_bytes}) {
            eval q#use BSD::Resource;
                   setrlimit(RLIMIT_VMEM, $opts{max_mem_bytes}, RLIM_INFINITY)
                       || die "setrlimit failed: $!";#;
	    die "Can not support max_mem_bytes without BSD::Resource module: $@" if $@;
        }

	print STDERR "Lintel::ProcessManager($$): exec $cmd\n" if $this->{debug};

	if (ref $opts{cmd} eq 'ARRAY') {
	    exec @{$opts{cmd}};
	} elsif (ref $opts{cmd} eq 'CODE') {
	    my $fn = $opts{cmd};
	    &$fn;
	    exit(0);
	} else {
	    exec $opts{cmd};
	}

	confess "exec($cmd) failed: $!";
    }

    print "Lintel::ProcessManager($$): Parent ($pid)\n" if $this->{debug};
    $this->waitForFile($opts{stdout}, $pid);
    $this->waitForFile($opts{stderr}, $pid)
	unless defined $opts{stderr} && $opts{stderr} eq 'STDOUT';

    $this->{children}->{$pid} =	{
				 exitfn => $opts{exitfn},
				 cmd => $opts{cmd}
				};

    return $pid;
}

=pod

=head2 my $new_status = maskCoredump($status)

The maskCcoredump function will mask out the core dump status from the $status variable, returning
the revised status.  If possible, it attempts to use the POSIX::WCOREDUMP function, but since that
function is often not present, it has hardcoded the flag value for masking.

=cut

sub maskCoredump {
    confess "wcoredump called incorrectly; first argument should be defined"
        unless defined $_[0];
    my $ret = eval q!&POSIX::WCOREDUMP($_[0]);!;
    if ($@ || !defined $ret) { # Assume it was function not found.
        # TODO: use a binary module to get this out of C
        return $_[0] & ~0x80;
    } else {
        return $_[0] & ~$ret;
    }
}

=pod

=head2 my %pid_to_status = $mgr->wait([timeout])

Wait for children to exit up to timeout seconds.  Return a map from
process id to status for each child that exited.  If an exitfn was
specified for each pid, then the function will be called.  It is an
error to call this from within the process manager signal handler, or
without any children.

=cut

sub wait {
    my ($this, $timeout) = @_;

    confess "Can't call wait from inside signal handler -- race condition"
	if $this->{in_signal_handler};

    my %exited;
    my $started = time;
    my $exit_count = 0;

    my $handle_exit = sub {
        my ($child, $status) = @_;

        # TODO: add a test where we exit with lots of different status; it's possible
        # we need to set $SIG{CHLD} = 'IGNORE' or something, but it seems to be working.
        print "Lintel::ProcessManager($$): exit($child) -> $status\n" if $this->{debug};

        $exited{$child} = $status;
        ++$exit_count;

        unless (exists $this->{children}->{$child}) {
            warn "Unexpected pid $child exited with status $status";
        } else {
            my $fn = $this->{children}->{$child}->{exitfn};
            delete $this->{children}->{$child}; # in case fn calls wait
            &$fn($child, $status) if defined $fn;
        }
    };

    while ($exit_count == 0) {
	confess "Can't call wait without any children" 
	    unless $this->nChildren() > 0;
	while ((my $child = waitpid(-1, WNOHANG)) > 0) {
            &$handle_exit($child, $?);
	}
	if ($exit_count == 0) {
            # Added 'No child processes' check in because in at least one case, we got stuck in an
            # infinite loop waiting for a child to exit when there was no sub-process.
	    if ($! eq 'No child processes') {
                # Added can_signal check because we had cases (debian etch 32bit user, 64bit
		# kernel) where 'no child processes' was returned and yet, there were children as
		# per the pstree
		my @can_signal;

		foreach my $child ($this->children()) {
		    push(@can_signal, $child) if kill 0, $child;
		}

                # Added this check because on openbsd in a VM we seemed to have a race between
                # the waitpid above and the can_signal test, but on openbsd we can not send a 0
                # signal to a zombie process.  However, if any zombies are there, then the call
                # to waitpid below should succeed.
                if (@can_signal == 0) {
                    my $child = waitpid(-1, WNOHANG);
                    if ($child > 0) {
                        &$handle_exit($child, $?);
                        push(@can_signal, $child);
                    }
                }

		if (@can_signal == 0) {
		    if ($this->{debug}) {
			print "Lintel::ProcessManager($$): pstree-begin\n";
			system("pstree -p $$") == 0
                            || system("ps jx"); # openbsd
			print "Lintel::ProcessManager($$): pstree-end\n";
		    }

		    confess "Lintel::ProcessManager($$): Internal error, wait returned 'no children', can not signal any children, yet child list is still: (" . join(", ", $this->children()) . "), and exit count is 0";
		}
	    }
	    last if defined $timeout && time >= $started + $timeout;
	    select(undef, undef, undef, 0.1);
	}
    }

    return %exited;
}

=pod

=head2 my %pid_to_status = $mgr->waitAll()

Wait for all children to exit, return their status.

=cut

sub waitAll {
    my ($this) = @_;

    my %ret;
    while ($this->nChildren() > 0) {
	my %some = $this->wait();
	map { $ret{$_} = $some{$_} } keys %some;
    }

    return %ret;
}

=pod

=head2 my $status = $mgr->waitPid($pid)

Wait for a specific process to exit, return its status.  Note: any other
process may exit while waiting for this pid, and the exit functions will be
called.  Similarly, if you specify an exit function when creating $pid, it will
be called before this function exits.  Will return undef if $pid isn't
currently a child.

=cut

sub waitPid {
    my ($this, $pid) = @_;

    unless (exists $this->{children}->{$pid}) {
	print "Missing child $pid; children: ", join(", ", $this->children()), "\n" if $this->{debug};
	return undef;
    }

    while (exists $this->{children}->{$pid}) {
	my %pid_to_status = $this->wait();
	return $pid_to_status{$pid} if defined $pid_to_status{$pid};
    }
    die "Internal error: had child $pid at start, but vanished without getting status.";
}

=pod

=head2 $mgr->enableSignals(sub { my ($mgr) = @_; ... })

Specify a function to call when a child exits.  This notifies the
application that it should call wait shortly.  It is an error to call
wait() within the handler.  The reason is that there is a race
condition between the signal handler being called and the data
structures being set up to handle the sub-process exiting.

=cut

sub enableSignals {
    my ($this, $fn) = @_;

    die "?" if defined $this->{signal_handler_fn};

    $this->{signal_handler_fn} = sub {
	confess "signal recursion" if $this->{in_signal_handler};
	++$this->{in_signal_handler};

	&$fn if defined $fn;

	--$this->{in_signal_handler};
	$SIG{CHLD} = $this->{signal_handler_fn};
    };

    $SIG{CHLD} = $this->{signal_handler_fn};
}

=pod

=head2 my @pids = $mgr->children()

Return an array of the process id's of all the sub-processes

=cut

sub children {
    my ($this) = @_;

    return keys %{$this->{children}};
}

=pod

=head2 my $count = $mgr->nChildren()

Return the number of currently active children, i.e. ones that were
started but have not yet exited or been reaped (have exited but wait() has
not been called).

=cut

sub nChildren {
    my ($this) = @_;

    return scalar $this->children();
}

1;