#!/usr/bin/perl -w
#
# buildtool -- Product Build Management Tool
# 
# Copyright (C) 2000-2001, Michael Jennings
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies of the Software, its documentation and marketing & publicity
# materials, and acknowledgment shall be given in the documentation, materials
# and software packages that this Software was used.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
# IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
# $Id: buildtool,v 1.207 2006/09/26 20:13:30 mej Exp $
#

use strict;

# Include the Perl Modules we need
use Cwd '&abs_path';
use POSIX;
use Getopt::Long;
use File::Find;
use Mezzanine::Util;
use Mezzanine::Config;
use Mezzanine::PkgVars;
use Mezzanine::Src;
use Mezzanine::Pkg;
use Mezzanine::Build;
use Mezzanine::Prod;
use Mezzanine::Instroot;

my $GLOBAL_LOG = 0;  # Overall log file for product build
my $verbosity = 2;  # Logging verbosity
my $global_user;  # Repository userid
my $global_tree;  # Repository to use
my $global_tag;  # Tag to get packages with
my $buildtree_layout = "mej";  # The layout style to use for the build tree.
my $prod = "";
my $failure;
my @failed_pkgs;
my @completed_pkgs;
my $num_processes;
my $num_built = 0;
my @instroot_pool;
my $scm;

# RPM/SRPM cache data.
my $rpm_cache;
my ($CFG_RPMCACHE_NAME, $CFG_RPMCACHE_PATH, $CFG_RPMCACHE_MTIME, $CFG_RPMCACHE_SIBLINGS) = (0, 1, 2, 3);

# Configuration data.
my $config;
my @config_vars = ("DEBUG", "VERBOSITY", "TARGET", "BUILDTREE_LAYOUT",
                   "CLEAN", "LOGFILE", "HINTS", "DEP_INSTALLER",
                   "PARALLELIZE", "LOCATIONS", "BUILDUSER",
                   "INSTROOT", "INSTROOT_INIT", "INSTROOT_COPY",
                   "INSTROOT_RESET", "INSTROOT_SOURCE_RSYNC",
                   "BUILDROOT", "TMPDIR", "MAKE", "MFLAGS", "CFLAGS",
                   "PATH", "RETRY", "REBUILD", "PRODUCTS", "LOGDIR",
                   "ALLOW_EPOCH");

# Print usage information
sub
print_usage_info
{
    my ($leader, $underbar);

    print "\n";
    $leader = "$PROGNAME $VERSION Usage Information";
    $underbar = $leader;
    $underbar =~ s/./-/g;
    print "$leader\n$underbar\n";
    print "\n";
    print "  Syntax:   buildtool [ options ]\n";
    print "\n";
    print "    -h --help                        Show this usage information\n";
    print "    -d --debug                       Turn on debugging\n";
    print "    -v --version                     Show version and copyright\n";
    print "    -q --quiet                       Be somewhat quiet.  Simply gives basic progress info\n";
    print "    -Q --really-quiet --silent       Be very quiet.  Only errors are reported\n";
    print "    -D --dir <directory>             Specify the repository to use (overrides all product files)\n";
    print "    -l --log <logfile>               Specify a log file to send informational output to\n";
    print "    -P --parallel [expr]             Parallelize the build process based on the number of CPU's\n";
    print "    -t --target <arch>               Tell rpm to build for a particular target architecture\n";
    print "    -C --cflags <flags>              Specify the \$CFLAGS variable to use for building\n";
    print "    -U --repuser <userid>            Specify a userid for the repository (overrides product files)\n";
    print "    -T --tag <tag>                   Specify a tag to use (overrides all product files)\n";
    print "    -L --location <location_spec>    Specify where packages should be placed (as in product file)\n";
    print "    -s --srcdir <dir>                (Re)build all packages under <dir>\n";
    print "    -i --instroot --jail <dir>       Specify chroot jail to build in (or copy from, if parallel)\n";
    print "    -H --hints <file_or_dir>         Specify location of pre-build hints or hint files\n";
    print "    -u --user <userid>               Build packages as <userid> instead of current user\n";
    print "    -b --buildtree <style>           Use the specified layout for the build tree\n";
    print "       --di --dep-installer <prog>   Specify the mechanism used to install build dependencies\n";
    print "       --is --instroot-src <path>    Path to clean source for chroot jail (replaces next 3 opts)\n";
    print "       --ii --instroot-init <cmd>    Command used to initialize chroot jail\n";
    print "       --ir --instroot-reset <cmd>   Command used to reset chroot jail\n";
    print "       --ic --instroot-copy <cmd>    Command used to copy chroot jail\n";
    print "       --builddir <path>             Use <path> as the root of the build tree\n";
    print "       --nocache                     Do not scan the cache (use with care)\n";
    print "       --retry                       Retry packages which have previously failed to build\n";
    print "       --rebuild                     Rebuild previously successful packages for verification\n";
    print "       --clean                       Clean up RPM and buildroot directories when done\n";
    print "       --allow-epoch                 Allow Epoch in spec file (prepend \"no\" to disallow)\n";
    print "       --savecfg                     Preserve current settings for future use\n";
    print "\n";
    exit(MEZZANINE_SUCCESS);
}

# Normal print (i.e., don't print this in -q or -Q mode)
sub nprintf    {printf @_ if ($GLOBAL_LOG || $verbosity >= 2);}
sub nprint     {print  @_ if ($GLOBAL_LOG || $verbosity >= 2);}
# Quiet print (i.e., print in -q mode but not in -Q mode)
sub qprintf    {printf @_ if ($GLOBAL_LOG || $verbosity >= 1);}
sub qprint     {print  @_ if ($GLOBAL_LOG || $verbosity >= 1);}

# What to do if a package completes successfully
sub
complete_package
{
    my $pkg = $_[0];

    push @completed_pkgs, $pkg;
    nprint "Package build for $pkg completed successfully.  (${\(&get_timestamp())})\n";
}

# What to do if a package didn't need to be built.
sub
skipped_package
{
    my $pkg = $_[0];

    push @completed_pkgs, $pkg;
    nprint "Package build for $pkg was not needed.  (${\(&get_timestamp())})\n";
}

# What to do if a package fails
sub
fail_package
{
    my ($pkg, $msg) = @_;

    push @failed_pkgs, $pkg;
    if ($msg) {
        $msg =~ s/\.+$//;
        $failure->{$pkg}{"MESSAGE"} = $msg;
        eprint "Package \"$pkg\" failed:  $msg.\n";
    } else {
        eprint "Package \"$pkg\" failed with an unknown error.\n";
    }
}

# Remove failed packages and packages we don't build from the list
sub
update_package_list
{
    my $parray = shift;
    my @p = @{$parray};

    @{$parray} = ();
    foreach my $pkg (@p) {
        next if ($pkgs->{$pkg}{"TYPE"} eq "image");
        if (!grep($_ eq $pkg, @failed_pkgs)) {
            push @{$parray}, $pkg;
        }
    }
    return (@{$parray});
}

# Check to see if we actually need to build this package.
sub
is_build_needed
{
    my ($pkg, $pkgfile, $srpm_dir);
    my @stat1;
    my @srpm_matches;

    if ($config->get("REBUILD")) {
        dprint "Rebuild forced by configuration.\n";
        return 1;
    } else {
        foreach my $key ($config->keys()) {
            dprintf("Got config key %s with value %s.\n", $key, $config->get($key));
        }
    }

    $pkg = &pkgvar_name();
    if (!$pkg) {
        dprint "Doh!  is_build_needed() called with no package name set.  I suck!\n";
        return -1;
    }

    $pkgfile = &pkgvar_filename();
    if (!$pkgfile) {
        dprint "Doh!  is_build_needed() called for $pkg with no filename set.  I suck!\n";
        return -1;
    }

    # If the file/module does not exist, we definitely need to build it.
    if (! -e $pkgfile) {
        dprint "Doh!  $pkgfile doesn't exist.  It must be built.\n";
    } else {
        my $which_one;

        $which_one = &newest_file($pkgfile);
        if ($which_one && -e $which_one) {
            @stat1 = stat($which_one);
        } else {
            @stat1 = stat($pkgfile);
        }
    }

    # If there is no SRPMS directory, then there are surely no SRPMS to be checked.
    $srpm_dir = &pkgvar_topdir() . "/SRPMS";
    if (! -d $srpm_dir) {
        dprint "SRPM directory $srpm_dir does not exist.\n";
        dprint "Listing:  " . `/bin/ls -Fla $srpm_dir/../` . "\n\n----\n";
        return 1;
    }

    # For each SRPM that matches the package name, see if it's newer than the directory.
    # If so, we do not need to build that package.
    if ($pkgs->{$pkg}{"TYPE"} =~ /^s?rpm$/) {
        @srpm_matches = &grepdir(sub {&basename($_) =~ /^\Q$pkg\E\.(no)?src\.rpm$/}, $srpm_dir);
    } else {
        @srpm_matches = &grepdir(sub {&basename($_) =~ /^\Q$pkg\E-[^-]+-[^-]+\.(no)?src\.rpm$/}, $srpm_dir);
    }

    foreach my $srpm (@srpm_matches) {
        my @stat2;

        dprint "Checking $srpm...\n";
        @stat2 = stat($srpm);
        if ($stat2[9] >= $stat1[9]) {
            # SRPM is newer than (or the same age as) the file/module.  Skip it.
            dprint "$srpm is newer than $pkgfile; no need to build $pkg.\n";
            &pkgvar_filename($srpm);
            return 0;
        } else {
            dprintf("$srpm is older than $pkgfile:  %s < %s.\n",
                    POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime($stat2[9])),
                    POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime($stat1[9])));
        }
    }
    # Doh, gotta build this one.
    dprint "No matching SRPM's found which are newer than $pkgfile.  Must build $pkg.\n";
    return 1;
}

# Scan the binary RPM directories to see which binaries belong to which SRPM's.
sub
scan_rpm_dirs
{
    my $topdir;
    my @contents = ();
    my %siblings;

    nprint "Updating state information....\n";
    $topdir = &pkgvar_topdir();

    $rpm_cache = Mezzanine::Config->new("$PROGNAME/rpm_cache.cdf");

    # Pre-scan all the binary RPM's for future use.  We need to know what SRPM
    # each binary came from, because some (lame) packages change the base name.
    if (-d $topdir) {
        if ($buildtree_layout eq "orc") {
            find({ "wanted" => sub { ! -d $_ && $_ =~ /\.rpm$/ && push @contents, $_ }, "no_chdir" => 1 },
                 $topdir);
        } else {
            find({ "wanted" => sub { ! -d $_ && $_ =~ /\.rpm$/ && push @contents, $_ }, "no_chdir" => 1 },
                 "$topdir/RPMS", "$topdir/SRPMS");
        }
    }
    foreach my $rpm (sort(@contents)) {
        my ($aref, $rpmfile, $name, $path, $mtime);
        my $srpm;
        my @info;

        $rpmfile = &basename($rpm);
        $path = &dirname($rpm);
        $aref = $rpm_cache->get($rpmfile);

        if ($OPTION{"nocache"}) {
            dprint "Ignoring any cache info for $rpm.\n";
        } elsif (ref($aref) eq "ARRAY") {
            my @statinfo;

            # Valid array ref.  Let's make sure the times match.
            @statinfo = stat($rpm);
            if ($aref->[$CFG_RPMCACHE_MTIME]) {
                $mtime = $aref->[$CFG_RPMCACHE_MTIME];
            } else {
                $mtime = 0;
            }
            if ($statinfo[9] > $mtime) {
                # Our cache info is outdated.  We'll have to update it.
                dprint "Out-of-date cache info for $rpm\n";
            } elsif ($statinfo[9] < $mtime) {
                dprint "Cache data newer than $rpm?!?!\n";
            } else {
                dprint "Cache data matches, skipping $rpm.\n";
                @{$siblings{$rpmfile}} = split(' ', $aref->[$CFG_RPMCACHE_SIBLINGS]);
                next;
            }
        } else {
            dprint "Cache lookup for $rpm failed.\n";
        }

        # If we get here, we need to update our cache info.
        # Stat the file
        @info = stat($rpm);
        $mtime = $info[9];

        # Get name and architecture
        @info = &parse_rpm_name($rpmfile);
        $name = $info[0];

        if ($info[3] eq "src" || $info[3] eq "nosrc") {
            # It's an SRPM.  Do we need to do anything here?

        } else {
            # It's a binary RPM.
            my @tmp;

            $srpm = `rpm -qp $rpm --queryformat \"%{SOURCERPM}\"`;
            if (! $srpm) {
                eprint "Unable to find SRPM for $rpm.  This could be bad.\n";
            } else {
                $siblings{$rpmfile} = [ $srpm ];
            }
            if (!defined($siblings{$srpm})) {
                $siblings{$srpm} = [ $rpmfile ];
            } else {
                push @{$siblings{$srpm}}, $rpmfile;
            }
        }
        @info = ($name, $path, $mtime, "");
        $rpm_cache->set($rpmfile, \@info);
    }

    # Now that we've got all the data, store it back into the config object.
    foreach my $rpm (sort(keys(%siblings))) {
        my $aref = $rpm_cache->get($rpm);

        dprint "Recording cache info for $rpm.\n";
        if (! $aref || ref($aref) ne "ARRAY") {
            eprint "EEEEP!  Caching mechanism fell apart for $rpm!\n";
            next;
        } else {
            dprint "Recording cache information for $rpm.\n";
        }

        $aref->[$CFG_RPMCACHE_SIBLINGS] = join(' ', @{$siblings{$rpm}});
        # This next part shouldn't be needed, but for paranoia...
        $rpm_cache->set($rpm, $aref);
    }
    $rpm_cache->save();
}

# Build a single package from source (if needed) and place the resulting files where they go.
sub
build_single_package
{
    my $pkg = shift;
    my ($pkgfile, $err, $msg, $outfiles);

    # Binaries or not, we need to know the full path and name of the source package.
    dprintf("Building $pkg in %s.\n", &pkgvar_topdir());
    &pkgvar_name($pkg);
    if (! ($pkgfile = &pkgvar_filename($pkgs->{$pkg}{"MODULE"}, $pkgs->{$pkg}{"FILENAME"}))) {
        &fail_package($pkg, "I don't know what file/module to build from!");
        return MEZZANINE_NO_SOURCES;
    }

    # If there are binaries, no point in trying to build source.
    if ($pkgs->{$pkg}{"BINS"}) {
        $outfiles = join(' ', &pkgvar_filename(), @{$pkgs->{$pkg}{"BINS"}});
    } elsif ($pkgs->{$pkg}{"TYPE"} eq "rpm") {
        $outfiles = &pkgvar_filename();
    } elsif (&is_build_needed()) {
        # Build the source
        if ($pkgs->{$pkg}{"INSTROOT"}) {
            $ENV{"HOME"} = &pkgvar_buildroot();
            &pkgvar_instroot($pkgs->{$pkg}{"INSTROOT"});
            if (! -e $pkgs->{$pkg}{"INSTROOT"} && $pkgs->{$pkg}{"INSTROOT_INIT"}) {
                my @output;

                nprint "Initializing chroot jail, please wait.\n";
                @output = &run_cmd($pkgs->{$pkg}{"INSTROOT_INIT"}, $pkgs->{$pkg}{"INSTROOT"}, "instroot-init:  ");
                if ($output[0] != MEZZANINE_SUCCESS) {
                    wprint "Initialization of install root failed.\n";
                }
            } elsif (-e $pkgs->{$pkg}{"INSTROOT"} && $pkgs->{$pkg}{"INSTROOT_RESET"}) {
                my @output;

                nprint "Resetting chroot jail, please wait.\n";
                @output = &run_cmd($pkgs->{$pkg}{"INSTROOT_RESET"}, $pkgs->{$pkg}{"INSTROOT"}, "instroot-reset:  ");
                if ($output[0] != MEZZANINE_SUCCESS) {
                    wprint "Reset of install root failed.\n";
                }
            }
            if ($pkgs->{$pkg}{"BUILDUSER"}) {
                &pkgvar_set("builduser", $pkgs->{$pkg}{"BUILDUSER"});
                &file_owner($pkgs->{$pkg}{"BUILDUSER"}, "", $pkgs->{$pkg}{"INSTROOT"});
                dprintf("Building as %s (%lu:%lu)\n", &pkgvar_get("builduser"), $mz_uid, $mz_gid);
            }
        } else {
            &pkgvar_instroot("");
            if ($pkgs->{$pkg}{"BUILDUSER"}) {
                &pkgvar_set("builduser", $pkgs->{$pkg}{"BUILDUSER"});
                &file_owner($pkgs->{$pkg}{"BUILDUSER"});
                dprintf("Building as %s (%lu:%lu)\n", &pkgvar_get("builduser"), $mz_uid, $mz_gid);
            }
        }
        dprint "Build tree layout style:  $buildtree_layout\n";
        ($err, $msg, $outfiles) = &build_package();
        if ($err != MEZZANINE_SUCCESS) {
            &fail_package($pkg, $msg);
            return $err;
        } else {
            $num_built++;
        }
    } else {
        my $aref;
        my $srpm;

        # No build needed.  Just get the list of output files.
        $srpm = &basename(&pkgvar_filename());
        $aref = $rpm_cache->get($srpm);

        if (ref($aref) eq "ARRAY") {
            my @tmp = split(' ', $aref->[$CFG_RPMCACHE_SIBLINGS]);

            for (my $i = 0; $i < scalar(@tmp); $i++) {
                my $aref2 = $rpm_cache->get($tmp[$i]);

                if (ref($aref2) ne "ARRAY") {
                    eprint "Bugger.  No data for $tmp[$i].  Not good.\n";
                    &fail_package($pkg, "Cache has gone to pot");
                }
                $tmp[$i] = $aref2->[$CFG_RPMCACHE_PATH] . '/' . $tmp[$i];
            }
            $outfiles = &pkgvar_filename() . ' ' . join(' ', @tmp);
            dprint "Got cached output files:  $outfiles\n";
        } else {
            eprint "Oh dear.  No data for $srpm.  This is bad news.\n";
            &fail_package($pkg, "Big huge messy caching foul-up occured");
        }
    }
    $err = &place_package_files($pkg, $outfiles, $pkgs->{$pkg}{"LOCATIONS"});
    return $err if ($err != MEZZANINE_SUCCESS);
    &complete_package($pkg);
    return MEZZANINE_SUCCESS;
}

# Spawn a child buildtool
sub
build_package_forked
{
    my ($pkg, $logfile) = @_;
    my $pid;

    do {
        if ($pid = fork()) {
            # Parent -- return PID
            nprint "Spawned child process $pid to build $pkg (log file is $logfile)\n";
            return $pid;
        } elsif (defined $pid) {
            my ($err, $buildroot);

            # Child -- reset state as needed and jump to build process
            if (-e $logfile) {
                #dprint "Log file $logfile exists.\n";
                if (! -e "$logfile.save") {
                    #dprint "Renaming to $logfile.save.\n";
                    &move_files($logfile, "$logfile.save");
                } else {
                    #dprint "Removing $logfile.\n";
                    &nuke_tree($logfile);
                }
            } elsif (-e "$logfile.broken") {
                if (! $OPTION{"retry"}) {
                    my ($pkgfile, $which_one);
                    my $failed = 0;

                    # It was broken before.  See if it's been updated since then.
                    $pkgfile = &pkgvar_filename($pkgs->{$pkg}{"MODULE"}, $pkgs->{$pkg}{"FILENAME"});
                    if ($pkgfile) {
                        my (@stat1, @stat2);

                        $which_one = &newest_file($pkgfile);
                        if ($which_one && -e $which_one) {
                            @stat1 = stat($which_one);
                        } else {
                            @stat1 = stat($pkgfile);
                        }
                        @stat2 = stat("$logfile.broken");
                        if ($stat1[9] <= $stat2[9]) {
                            # The "broken" log is newer than the module/package.  Skip it.
                            dprint "No updates to $pkg detected since last build failure.\n";
                            $failed = 1;
                        } else {
                            dprint "$pkg has been updated since previous build failure.\n";
                        }
                    } else {
                        wprint "Unable to find package source for $pkg.  Cannot check for updates.\n";
                    }
                    if ($failed) {
                        dprint "Package $pkg failed previously.  Aborting.\n";
                        exit MEZZANINE_PACKAGE_FAILED;
                    }
                }
                dprint "Retrying build for failed package $pkg.\n";
            }

            close $GLOBAL_LOG if ($GLOBAL_LOG);
            open(STDOUT, ">/dev/null");
            open(STDIN, "</dev/null");
            if (!open(LOGFILE, ">$logfile")) {
                eprint "Unable to open $logfile -- $!\n";
            } else {
                $GLOBAL_LOG = \*LOGFILE;
                #system("chattr +S $logfile");  # Try to set sync on the log file, fail silently
                open(STDERR, ">&LOGFILE");
                select LOGFILE; $| = 1;
                chown($mz_uid, $mz_gid, $logfile);
            }
            qprintf("Package build of $pkg started.  (%s)\n", &get_timestamp());
            $num_built = 0;
            $buildroot = &pkgvar_buildroot();
            if ($buildroot) {
                &pkgvar_buildroot("$buildroot/$pkg.$$");
            } else {
                &pkgvar_buildroot(&create_temp_space($pkg, "dironly"));
            }
            if ($pkgs->{$pkg}{"INSTROOT"}) {
                # This package build is chrooted.

                &pkgvar_instroot($pkgs->{$pkg}{"INSTROOT"});
                $pkgs->{$pkg}{"INSTROOT_RESET"} = "true";
            } else {
                &pkgvar_instroot("");
            }
            $err = &build_single_package($pkg);
            &cleanup_build_tree();
            if (&pkgvar_instroot() && -d &pkgvar_instroot()) {
                ### Not here.  We use the pool now.
                ### &nuke_tree(&pkgvar_instroot());
            }
            if (&pkgvar_buildroot() && -d &pkgvar_buildroot()) {
                &nuke_tree(&pkgvar_buildroot());
            }
            if ($err == MEZZANINE_SUCCESS) {
                if (! $num_built) {
                    $err = MEZZANINE_BUILD_UNNEEDED;
                }
                if (-e "$logfile.broken") {
                    wprint "Breakage log file $logfile.broken exists -- Package fixed itself!?\n";
                    &nuke_tree("$logfile.broken");
                    &nuke_tree("$logfile.save");
                } elsif ((! $num_built) && (-e "$logfile.save")) {
                    dprint "Log file $logfile.save for actual build exists -- Moving back into place.\n";
                    &move_files($logfile, "$logfile.latest");
                    &move_files("$logfile.save", $logfile);
                }
            } else {
                dprint "Renaming $logfile to $logfile.broken.\n";
                &nuke_tree("$logfile.save");
                &nuke_tree("$logfile.broken");
                &move_files($logfile, "$logfile.broken");
            }
            close(LOGFILE) if ($GLOBAL_LOG);
            exit ($err);
        } elsif ($! !~ /No more processes/ && $! !~ /Resource temporarily unavailable/) {
            &fatal_error("fork() failed -- $!\n");
        }
        # Temporary failure
        dprint "Failed temporarily -- $!\n";
        sleep 5;
    } while (1);
}

# Download packages from the repository
sub
download_packages
{
    my @packages = @_;
    my ($line, $err, $msg, $package_scm);

    nprint "Downloading packages, please wait..." if (! &debug_get());
    foreach my $pkg (@packages) {
        my ($files, $tag);

        $err = 0;
        $files = &pkgvar_filename($pkgs->{$pkg}{"MODULE"}, $pkgs->{$pkg}{"FILENAME"});
        if (defined($pkgs->{$pkg}{"BINS"})) {
            $files = join(' ', $files, @{$pkgs->{$pkg}{"BINS"}});
        }
        &pkgvar_filename($files);

	# Set the proper REPOSITORY and tag for the checkout.
        if ($global_tree) {
            $package_scm = Mezzanine::SCM->new($scm->scmobj_propget("type"));
            $package_scm->scmobj_propset("repository", $scm->scmobj_propget("repository"));
        } elsif ($pkgs->{$pkg}{"REPOSITORY"}) {
            $package_scm = Mezzanine::SCM->auto_detect($pkgs->{$pkg}{"REPOSITORY"});
            if ($package_scm) {
                my @tmp;

                @tmp = $package_scm->parse_repository_path($pkgs->{$pkg}{"REPOSITORY"});
                if (scalar(@tmp) && defined($tmp[0])) {
                    $package_scm->compose_repository_path(@tmp);
                } else {
                    $package_scm->scmobj_propset("repository", $pkgs->{$pkg}{"REPOSITORY"});
                }
            } elsif ($scm && $scm->scmobj_propget("repository")) {
                $package_scm->scmobj_propset("repository", $scm->scmobj_propget("repository"));
            } else {
                # FIXME:  What to do??
            }
        } else {
            # FIXME:  What to do??
        }
        if ($global_user) {
            my @tmp;

            @tmp = $package_scm->parse_repository_path();
            $tmp[1] = $global_user;
            $package_scm->compose_repository_path(@tmp);
        }
        if ($global_tag) {
            $package_scm->scmobj_propset("source_tag", $global_tag);
        } elsif ($pkgs->{$pkg}{"TAG"}) {
            $package_scm->scmobj_propset("source_tag", $pkgs->{$pkg}{"TAG"});
        }

        nprint "$pkg..." if (! &debug_get());
        ($err, $msg) = &fetch_package($package_scm);
        if ($err != MEZZANINE_SUCCESS && $err != MEZZANINE_DUPLICATE) {
            &fail_package($pkg, $msg);
            next;
        }
    }
    nprint "done.\n\n" if (! &debug_get());
}

sub
place_package_files
{
    my ($pkg, $outfiles, $locations) = @_;
    my $instroot;
    my @outfiles;
    my @contents;

    # If we didn't find any, something is very wrong.
    if (! $outfiles) {
        &fail_package($pkg, "No output packages were found");
        return MEZZANINE_PACKAGE_FAILED;
    }
    if (! $locations) {
        wprint "No locations specified for $pkg.\n";
        $locations = "/.*/=.";
    }
    dprint "Output files for $pkg:  $outfiles\n";

    $instroot = $pkgs->{$pkg}{"INSTROOT"};
    if ($instroot) {
        foreach my $file (split(' ', $outfiles)) {
            if ((-e "$instroot$file") && (&abs_path($file) ne &abs_path("$instroot$file"))) {
                &move_files("$instroot$file", $file);
            }
        }
    }

    # Copy each package into the appropriate place
    foreach my $file (split(' ', $outfiles)) {
        foreach my $loc (split(",", $locations)) {
            my ($regex, $stop, $dest);

            # Format is:  /regexp/.path  where . is some delimiter character that
            # tells us whether to check other locations or stop once we match
            # (':' to continue looking for matches, or '=' to stop if a match is found).
            dprint "Testing location \"$loc\"\n";
            if ($loc !~ m/^\/([^\/]+)\/(.)(\S+)?$/) {
                eprint "Location specifier \"$loc\" is invalid.\n";
                next;
            }
            ($regex, $stop, $dest) = ($1, $2, $3);
            if ($stop eq "!") {
                # A negative match test.  If we get a match, don't accept it.
                next if ($file =~ $regex);
            } else {
                # No match.  Try next location.
                next if ($file !~ $regex);
            }
            dprint "Match found for $file:  $stop$regex ($dest).\n";

            if ($dest) {
                # If the destination does not contain a filename, add the filename portion of
                # $file to the directory path in $dest.  The destination could be used to rename
                # a file, however; that's why this check is in place.
                if (substr($dest, -3, 3) ne substr($file, -3, 3)) {
                    my $tmp;

                    ($tmp = $file) =~ s/^.*\/([^\/]+)$/$1/;
                    $dest = "$dest/$tmp";
                }
                # If it exists, delete it.
                if (-e $dest) {
                    dprint "$dest exists; removing.\n";
                    &nuke_tree($dest);
                }
                # Then link it
                dprint "ln -f $file $dest\n";
                if (!link($file, $dest)) {
                    if (exists($!{"EXDEV"}) && ($!{"EXDEV"})) {
                        # Cross-device link attempt.  Copy instead.
                        if (&copy_files($file, $dest) != 1) {
                            &fail_package($pkg, "Unable to copy $file to $dest -- $!");
                            return MEZZANINE_SYSTEM_ERROR;
                        } else {
                            dprint "Can't link across devices; had to copy.\n";
                        }
                    } else {
                        &fail_package($pkg, "Unable to create $dest as a link to $file -- $!");
                        return MEZZANINE_SYSTEM_ERROR;
                    }
                }
            }

            # If the stop character is '=', stop checking for matches for this package.
            # If it's ':' (actually, any other character than '='), keep looking for matches.
            last if ($stop eq "=");
            dprint "Non-exclusive match.  Continuing on....\n";
        }
    }
    return MEZZANINE_SUCCESS;
}

# This routine parallelizes the product build so that each package is built by an individual buildtool process.
sub
parallel_build
{
    my @packages = @_;
    my ($pwd, $builddir, $logdir, $buildroot, $dummy);
    my (@children, @vars);
    my %child_pkg;

    # Create the directories for building this product
    if ($buildtree_layout eq "orc") {
        $builddir = $ENV{"MEZZANINE_BUILDDIR"};
        $logdir = $ENV{"MEZZANINE_LOGDIR"};
        &pkgvar_topdir($builddir);
    } else {
        $builddir = &make_build_dir($ENV{"MEZZANINE_BUILDDIR"});
        $logdir = &make_log_dir($ENV{"MEZZANINE_LOGDIR"});
        &pkgvar_topdir($builddir);

        # Need to do this here for parallel builds because it's not parallel-safe.  Race condition. :(
        &prepare_build_tree();
    }


    if (! $OPTION{"nocache"}) {
        &scan_rpm_dirs();
    }

    # Download all the packages.
    &download_packages(@packages);
    &update_package_list(\@packages);

    if ($config->get("INSTROOT")) {
        for (my $i = 0; $i < $num_processes; $i++) {
            $instroot_pool[$i] = Mezzanine::Instroot->new(
                                                          "SOURCE" => $config->get("INSTROOT"),
                                                          "INIT" => $config->get("INSTROOT_INIT"),
                                                          "RESET" => $config->get("INSTROOT_RESET")
                                                         );
            $instroot_pool[$i]->init();
        }
    }

    qprint "$PROGNAME:  Beginning $num_processes-way build of ${\(scalar(@packages))} packages.  (${\(&get_timestamp())})\n";
    for (; scalar(@packages) || scalar(@children);) {
        my ($pid, $line, $left, $failed, $bldg, $err, $pkg);

        # As long as there are packages left to build or children left to wait on, we loop.
        for (; scalar(@packages) && (scalar(@children) < $num_processes);) {
            my ($logfile, $save_builddir);

            # Spawn child processes until we fill up our allotment ($num_processes)
            $pkg = shift @packages;
            if ($pkgs->{$pkg}{"BUILDUSER"}) {
                &file_owner($pkgs->{$pkg}{"BUILDUSER"}, "", "");
            }
            if ($buildtree_layout eq "orc") {
                my $dirname = $pkg;

                #$dirname = sprintf("/%s-%s-%s", $pkg, $pkgs->{$pkg}{"VERSION"}, $pkgs->{$pkg}{"RELEASE"});
                $save_builddir = $builddir;
                $builddir .= ((substr($builddir, -1, 1) eq '/') ? ("") : ('/')) . $dirname;
                &make_build_dir($builddir);
                $logdir = $builddir;
                &pkgvar_topdir($builddir);
                &pkgvar_set("buildpkglist_filename", "$logdir/$pkg.pkglist");
            }
            if ($pkgs->{$pkg}{"INSTROOT"}) {
                foreach my $ir (@instroot_pool) {
                    if ($ir->status() eq "available") {
                        $pkgs->{$pkg}{"INSTROOT"} = $ir->path();
                        $ir->use();
                        last;
                    } elsif ($ir->status() eq "dirty") {
                        $ir->reset();
                        $pkgs->{$pkg}{"INSTROOT"} = $ir->path();
                        $ir->use();
                        last;
                    }
                }
            }
            $logfile = "$logdir/$pkg.log";
            $pid = &build_package_forked($pkg, $logfile);
            push @children, $pid;
            $child_pkg{$pid} = $pkg;
            if ($save_builddir) {
                $builddir = $save_builddir;
            }
        }

        # Okay, we can't build anything more right now.  Print some status info.
        $line = "";
        foreach my $pid (@children) {
            $line .= "$child_pkg{$pid} ($pid)    ";
        }
        nprint "$PROGNAME:  Currently building:  $line\n";
        nprint "$PROGNAME:  ${\(scalar(@completed_pkgs))} packages completed (${\(scalar(@failed_pkgs))} failed), "
            . "${\(scalar(@children))} building, ${\(scalar(@packages))} in queue.\n";

        # This loop waits until one of our immediate children dies before continuing.
        do {
            $pid = waitpid(-1, 0);
        } while (! ($pkg = $child_pkg{$pid}));
        $err = $? >> 8;
        if ($pid == -1) {
            # This should never happen.
            eprint "Ummm, waitpid() returned -1.  That wasn't very nice.  I'm offended.\n";
            next;
        }

        # Remove the child from our PID list
        @children = grep($_ != $pid, @children);

        # Check to see how it exited
        if ($err == MEZZANINE_BUILD_UNNEEDED) {
            &skipped_package($pkg);
        } elsif ($err == MEZZANINE_SUCCESS) {
            # Yay! :-)
            $num_built++;
            &complete_package($pkg);
        } else {
            my $logfile;
            my @tmp;
            local *ERRLOG;

            # Doh, it failed.  Look through the log file to try and find the problem.
            if ($buildtree_layout eq "orc") {
                my $dirname = $pkg;

                #$dirname = sprintf("/%s-%s-%s", $pkg, $pkgs->{$pkg}{"VERSION"}, $pkgs->{$pkg}{"RELEASE"});
                $logfile = "$builddir/$dirname/$pkg.log";
            } else {
                $logfile = "$logdir/$pkg.log";
            }
            if (!open(ERRLOG, $logfile) && !open(ERRLOG, "$logfile.broken")) {
                &fail_package($pkg, "Error $err (log file $logfile is missing)");
                next;
            }
            @tmp = <ERRLOG>;
            close(ERRLOG);
            # If the last line doesn't match, take the last line out of all the lines that do.
            if (scalar(@tmp)) {
                if ($tmp[$#tmp] !~ /error: /i) {
                    @tmp = grep($_ =~ /error: /i, @tmp);
                    if (!scalar(@tmp)) {
                        &fail_package($pkg, "Error $err (no errors found in log)");
                        next;
                    }
                }
                chomp($line = $tmp[$#tmp]);

                # Record that the package failed.
                if ($line =~ /^$PROGNAME:  Error:  Package \S+ failed:  (.*)$/) {
                    &fail_package($pkg, $1);
                } else {
                    $line = "Couldn't find error in log" if (! $line);
                    $line =~ s/^\w+:\s*Error:\s*//;
                    $line =~ s/^Package \"[^\"]+\" failed:\s*//;
                    &fail_package($pkg, "Error $err -- $line");
                }
            } else {
                &fail_package($pkg, "Error $err (log file $logfile is empty)");
            }
        }
        # Return its instroot to the pool, if needed.
        if ($pkgs->{$pkg}{"INSTROOT"} && -d $pkgs->{$pkg}{"INSTROOT"}) {
            foreach my $ir (@instroot_pool) {
                if ($ir->path() eq $pkgs->{$pkg}{"INSTROOT"}) {
                    if ($err == MEZZANINE_BUILD_UNNEEDED) {
                        $ir->release_clean();
                    } else {
                        $ir->release();
                    }
                    last;
                }
            }
        }
        # End of loop.  Time to spawn the next child.
    }

    # Remove chroot jail images no longer needed.
    foreach my $ir (@instroot_pool) {
        $ir->remove();
    }
    @instroot_pool = ();

    &cleanup_build_tree();
    if ($num_built > 0) {
        return $num_built;
    } else {
        return (0 - scalar(@failed_pkgs));
    }
}

sub
build_product
{
    my @packages = @_;
    my ($builddir, $logdir);

    # Create the directories for building this product
    if ($buildtree_layout eq "orc") {
        $builddir = $ENV{"MEZZANINE_BUILDDIR"};
        $logdir = $ENV{"MEZZANINE_LOGDIR"};
        &pkgvar_topdir($builddir);
    } else {
        $builddir = &make_build_dir($ENV{"MEZZANINE_BUILDDIR"});
        $logdir = &make_log_dir($ENV{"MEZZANINE_LOGDIR"});
        &pkgvar_topdir($builddir);
    }

    if (! $OPTION{"nocache"}) {
        &scan_rpm_dirs();
    }

    # Download all the packages.
    &download_packages(@packages);
    &update_package_list(\@packages);

    # Call build_single_package() for each package; we don't care how that works as long as it does. :-)
    foreach my $pkg (@packages) {
        my %preserve_pkg_vars = &pkgvar_get_all();

        if ($buildtree_layout eq "orc") {
            my $dirname = $pkg;

            #$dirname = sprintf("/%s-%s-%s", $pkg, $pkgs->{$pkg}{"VERSION"}, $pkgs->{$pkg}{"RELEASE"});
            $builddir = &pkgvar_topdir();
            $builddir .= ((substr($builddir, -1, 1) eq '/') ? ("") : ('/')) . $dirname;
            &make_build_dir($builddir);
            $logdir = $builddir;
            &pkgvar_topdir($builddir);
            &pkgvar_set("buildpkglist_filename", "$logdir/$pkg.pkglist");
        }
        &build_single_package($pkg);
        &pkgvar_reset(%preserve_pkg_vars);
    }

    # Now we clean up.
    &cleanup_build_tree();
    if ($num_built > 0) {
        return $num_built;
    } else {
        return (0 - scalar(@failed_pkgs));
    }
}

# Once we're all done, summarize any failures at the very end
# so that they're easy to find if the user is generating a log.
sub
summarize_failures
{
    my ($ns, $nf, $nt, $nb, $face, $summary_file);
    local *SUMMARY;

    # $ns is the number of successful packages.  $nf is the number of failures.
    # $nt is the total number of packages we tried to build.
    $ns = scalar(@completed_pkgs);
    $nf = scalar(@failed_pkgs);
    $nt = scalar(@packages);
    $nb = $nt - $ns - $nf;

    if ($nf == 0) {
        $face = ":-)";
    } elsif ($ns == 0) {
        $face = ":-(";
    } elsif ($ns > $nf) {
        $face = ":-}";
    } elsif ($nf > $ns) {
        $face = ":-{";
    } else {
        $face = ":-|";
    }

    if ($config->get("LOGFILE")) {
        $summary_file = $config->get("LOGFILE") . ".summary";
    } else {
        $summary_file = &getcwd() . "/$PROGNAME.summary";
    }
    if (!open(SUMMARY, ">$summary_file")) {
        $summary_file = "";
    }
    qprint "Build Summary:  $ns Successful    $nf Failed    $nb Not Built    $nt Total    $face\n";
    if ($summary_file) {
        print SUMMARY "Build Summary:  $ns Successful    $nf Failed    $nb Not Built    $nt Total    $face\n";
    }
    if ($nf) {
        foreach my $pkg (@failed_pkgs) {
            if ($failure->{$pkg}{"MESSAGE"}) {
                eprint "Package \"$pkg\" failed:  $failure->{$pkg}{MESSAGE}.\n";
                if ($summary_file) {
                    print SUMMARY "Package \"$pkg\" failed:  $failure->{$pkg}{MESSAGE}.\n";
                }
            } else {
                eprint "Package \"$pkg\" failed; reason unknown.  Check the log to see what went wrong.\n";
                if ($summary_file) {
                    print SUMMARY "Package \"$pkg\" failed; reason unknown.  Check the log to see what went wrong.\n";
                }
            }
        }
    }
}

# main() here is basically the same as main() in C
sub
main
{
    my ($srcdir, $ret);
    my @orig_argv = @ARGV;

    &mezz_init("buildtool", "3.0", "help|h", "version|v", "debug|d!",
               "quiet|q", "silent|really-quiet|Q", "srcdir|s=s@",
               "prod|p|prodfile|product=s", "dir|D|tree=s", "log|l=s",
               "parallel|P:s", "target|t=s", "cflags|C=s", "tag|T=s",
               "nocache", "clean:s", "repuser|U=s", "location|L=s",
               "instroot|i|jail=s", "hints|H=s",
               "depinstaller|dep-installer|hint-installer|hi|di=s",
               "instroot-src|is=s", "instroot-init|ii=s",
               "instroot-reset|ir=s", "instroot-copy|ic=s",
               "user|u=s", "buildtree|b=s", "builddir=s", "retry",
               "rebuild", "allow-epoch!", "savecfg!");

    if ($OPTION{"version"}) {
        &print_version($PROGNAME, $VERSION, "Michael Jennings <mej\@eterm.org>",
                       'CVS Revision $Revision: 1.207 $ created on $Date: 2006/09/26 20:13:30 $ by $Author: mej $ ');
    }
    if ($OPTION{"help"}) {
	&print_usage_info();
    }
    open(STDIN, "</dev/null");
    open(STDERR, ">&STDOUT");
    $config = Mezzanine::Config->new("build/config");
    if (!scalar($config->keys()) && ((!defined($OPTION{"savecfg"})) || ($OPTION{"savecfg"}))) {
        $OPTION{"savecfg"} = 1;
    }

    # Set basic options
    if (defined($OPTION{"debug"}) && !($OPTION{"debug"})) {
        &debug_set($config->set("DEBUG", 0));
    } else {
        &debug_set($config->set("DEBUG", $OPTION{"debug"} || $config->get("DEBUG") || 0));
    }
    $verbosity = $config->get("VERBOSITY") || 2;
    if ($OPTION{"silent"}) {
        $verbosity = 0;
    } elsif ($OPTION{"quiet"}) {
        $verbosity = 1;
    }
    $config->set("VERBOSITY", $verbosity);

    # Open log file, if any.
    $config->set("LOGFILE", $OPTION{"log"} || $config->get("LOGFILE") || "");
    if ($config->get("LOGFILE")) {
        my $log_filename = $config->get("LOGFILE");

        if (-e $log_filename) {
            rename($log_filename, "$log_filename.prev");
        }
        if (!open(LOGFILE, ">$log_filename")) {
            eprint "Unable to open $log_filename -- $!\n";
        } else {
            $GLOBAL_LOG = \*LOGFILE;
            #system("chattr +S $log_filename");  # Try to set sync on the log file, fail silently
            open(STDOUT, ">&LOGFILE");
            select LOGFILE; $| = 1;
        }
    }
    select STDOUT; $| = 1;
    nprintf("$PROGNAME $VERSION:  %s [%s]\n", join(' ', @orig_argv), &get_timestamp());

    # Basic config stuff.
    $global_user = $OPTION{"repuser"};
    $global_tree = $OPTION{"dir"};
    $global_tag = $OPTION{"tag"};
    $buildtree_layout = $config->set("BUILDTREE_LAYOUT", $OPTION{"buildtree"} || $config->get("BUILDTREE_LAYOUT") || "mej");
    $config->set("CLEAN", &pkgvar_cleanup($OPTION{"clean"} || $config->get("CLEAN") || $config->get("BUILDTREE_LAYOUT")));
    $config->set("TARGET", &pkgvar_target($OPTION{"target"} || $config->get("TARGET") || ""));
    $config->set("REBUILD", $OPTION{"rebuild"} || $config->get("REBUILD") || 0);

    # Epoch toggle
    if (defined($OPTION{"allow-epoch"})) {
        &pkgvar_set("allow_epoch", $OPTION{"allow-epoch"});
    } elsif (defined($config->get("ALLOW_EPOCH"))) {
        &pkgvar_set("allow_epoch", $config->get("ALLOW_EPOCH"));
    }
    $config->set("ALLOW_EPOCH", &pkgvar_get("allow_epoch"));

    # SCM stuff.
    $config->set("DEFAULT_SCM", $config->get("DEFAULT_SCM") || "cvs");
    if ($global_tree) {
        $scm = Mezzanine::SCM->auto_detect($global_tree);
        if ($scm) {
            my @tmp;

            $config->set("DEFAULT_SCM", $scm->scmobj_propget("type"));
            @tmp = $scm->parse_repository_path($global_tree);
            if (scalar(@tmp) && defined($tmp[0])) {
                dprintf("Parsed repository path into:  \"%s\"\n", join("\", \"", @tmp));
                $scm->compose_repository_path(@tmp);
            } else {
                eprintf("Parse error on %s repository $global_tree\n", $scm->scmobj_propget("type"));
                $global_tree = undef;
            }
        } else {
            eprint "Unrecognized repository $global_tree, ignoring.\n";
            $global_tree = undef;
        }
    }

    # Handle hint file/directory specification
    $config->set("HINTS", $OPTION{"hints"} || $config->get("HINTS") || $ENV{"MEZZANINE_HINTS"} || "");
    $config->set("DEP_INSTALLER", $OPTION{"depinstaller"} || $config->get("DEP_INSTALLER") || "false");
    if ($config->get("HINTS")) {
        if ($config->get("DEP_INSTALLER")) {
            &set_hints_info(sprintf("%s%%%s", $config->get("DEP_INSTALLER"), $config->get("HINTS")));
        } else {
            &set_hints_info($config->get("HINTS"));
        }
    } elsif ($config->get("DEP_INSTALLER")) {
        &set_hints_info($config->get("DEP_INSTALLER") . '%');
    }

    # Figure out parallelization stuff
    if (!defined($OPTION{"parallel"} && $config->has_key("PARALLELIZE"))) {
        $OPTION{"parallel"} = $config->get("PARALLELIZE");
    }
    if (defined($OPTION{"parallel"})) {
        $num_processes = &count_cpus();
        if ($OPTION{"parallel"}) {
            my ($mult, $add) = (1, 0);

            if ($OPTION{"parallel"} =~ m/^(?:[Xx]([\d.]+))?([-+][\d.]+)?$/) {
                ($mult, $add) = ($1, $2);
                $num_processes = $num_processes * ($mult ? $mult : 1) + ($add ? $add : 0);
            } elsif ($OPTION{"parallel"} =~ /^=(\d+)$/) {
                $num_processes = $1;
            }
        }
        $config->set("PARALLELIZE", $OPTION{"parallel"});
    } else {
        $num_processes = 0;
        $config->set("PARALLELIZE", 0);
    }
    dprint "Using $num_processes parallel process(es).\n";

    # Try to parse the product name we were given into a name or a name-version combo
    if ($OPTION{"prod"}) {
        $prod = $OPTION{"prod"};
    } elsif (!defined($OPTION{"srcdir"}) || !scalar(@{$OPTION{"srcdir"}})) {
        $prod = &basename(&getcwd());
    } else {
        # If we don't have a product name, but we do have one or more
        # SRPM directories to look at, we need to auto-generated the
        # prod file.  NOTE:  This must happen *before* the instroot
        # stuff below. 
        $prod = "autoprod-1.0";
    }

    # Handle specification of a global value for the LOCATIONS product
    # variable.  This must happen after $prod is set but before $OPTION{"srcdir"}
    # is handled.
    if ($config->set("LOCATIONS", $OPTION{"location"} || $config->get("LOCATIONS"))) {
        my $locations = $config->get("LOCATIONS");

        if (-d $locations) {
            $locations = '/.*/=' . $locations;
            dprint "Got global location \"$locations\".\n";
        } elsif ($locations !~ m,/[^/]+/[\@=],) {
            if (&mkdirhier($locations, 0775)) {
                dprint "Created location $locations.\n";
                $locations = "/.*/=$locations";
            } else {
                eprint "Bad location $locations, can't mkdir -- $!\n";
                $locations = "/.*/=.";
            }
        }
        &assign_product_variable($prod, "LOCATIONS", $locations);
    }

    # Set the build user if needed.  This must happen after $prod is
    # set but before $OPTION{"srcdir"} is handled.
    if ($config->set("BUILDUSER", $OPTION{"user"} || $config->get("BUILDUSER"))) {
        &assign_product_variable($prod, "BUILDUSER", $config->get("BUILDUSER"));
    }

    # Figure out the installroot stuff.
    $config->set("INSTROOT", $OPTION{"instroot"} || $config->get("INSTROOT"));
    $config->set("INSTROOT_SOURCE_RSYNC", $OPTION{"instroot-src"} || $config->get("INSTROOT_SOURCE_RSYNC"));
    $config->set("INSTROOT_INIT", $OPTION{"instroot-init"} || $config->get("INSTROOT_INIT"));
    $config->set("INSTROOT_RESET", $OPTION{"instroot-reset"} || $config->get("INSTROOT_RESET"));
    $config->set("INSTROOT_COPY", $OPTION{"instroot-copy"} || $config->get("INSTROOT_COPY"));
    if ($config->get("INSTROOT") || $config->get("INSTROOT_SOURCE_RSYNC")) {
        my ($instroot, $instroot_src, $instroot_init, $instroot_reset, $instroot_copy);

        if ($num_processes >= 1) {
            # If we're building in parallel, the INSTROOT value is our source.
            $config->set("INSTROOT_SOURCE_RSYNC", $config->get("INSTROOT"));
        } elsif ((! $config->get("INSTROOT"))
                 || ($config->get("INSTROOT") eq $config->get("INSTROOT_SOURCE_RSYNC"))) {
            # If we're building serially, make sure to avoid crapping in the source chroot jail.
            $config->set("INSTROOT", &create_temp_space("", "nameonly"));
        }

        ($instroot, $instroot_src, $instroot_init, $instroot_reset, $instroot_copy)
            = &set_instroot_info($config->get("INSTROOT"), $config->get("INSTROOT_SOURCE_RSYNC"),
                                 $config->get("INSTROOT_INIT"), $config->get("INSTROOT_RESET"), $config->get("INSTROOT_COPY"));
        &assign_product_variable($prod, "INSTROOT", $config->set("INSTROOT", $instroot));

        # If we have $instroot_init, the other two are guaranteed to have been set by set_instroot_info().
        if ($instroot_init) {
            &assign_product_variable($prod, "INSTROOT_INIT", $config->set("INSTROOT_INIT", $instroot_init));
            &assign_product_variable($prod, "INSTROOT_RESET", $config->set("INSTROOT_RESET", $instroot_reset));
            &assign_product_variable($prod, "INSTROOT_COPY", $config->set("INSTROOT_COPY", $instroot_copy));
        }
    }

    # *Now* we can look at our SRPM directories.
    if (scalar(@{$OPTION{"srcdir"}})) {

        if (scalar(@{$OPTION{"srcdir"}}) == 1) {
            @{$OPTION{"srcdir"}} = split(':', $OPTION{"srcdir"}->[0]);
        }

        # This must happen *after* the instroot stuff above.
        foreach my $srcdir (@{$OPTION{"srcdir"}}) {
            my @pkg_list;

            @pkg_list = &grepdir(sub {((-f $_ || -d $_) && (&basename($_) !~ /^\./))}, $srcdir);
            foreach my $pkg (sort(@pkg_list)) {
                my $prodfile_line;

                if (-f $pkg) {
                    $prodfile_line = $pkg;
                } elsif ($pkg =~ /(CVS|SCCS)$/) {
                    next;
                } else {
                    $prodfile_line = sprintf("%s MODULE=%s", &basename($pkg), $pkg);
                }
                &parse_product_entry($prodfile_line, $prod);
            }
        }
    }

    # Set the buildroot for the overall build.
    &pkgvar_buildroot($config->set("BUILDROOT", $config->get("BUILDROOT") || $ENV{"MEZZANINE_BUILDROOT"}));
    &mkdirhier(&pkgvar_buildroot(), 01777);
    chmod(01777, &pkgvar_buildroot());

    $ENV{"MAKE"} = $config->set("MAKE", $config->get("MAKE") || $ENV{"MEZZANINE_MAKE"} || "make");
    $ENV{"CFLAGS"} = $config->set("CFLAGS", $OPTION{"cflags"} || $config->get("CFLAGS") || $ENV{"MEZZANINE_CFLAGS"} || "-O2");
    $ENV{"PATH"} = $config->set("PATH", $config->get("PATH") || $ENV{"MEZZANINE_PATH"}
                                || "/usr/build/bin:/usr/local/build/bin:/usr/lib/qt-1.45/bin:/usr/lib/qt-2.1.0/bin"
                                . ":/bin:/usr/bin:/sbin:/usr/sbin:/usr/local/bin:/usr/X11R6/bin:/usr/kerberos/sbin"
                                . ":/usr/kerberos/bin:.");
    $ENV{"MEZZANINE_BUILDDIR"} = $config->set("BUILDDIR", $OPTION{"builddir"} || $config->get("BUILDDIR")
                                              || $ENV{"MEZZANINE_BUILDDIR"} || (&getcwd() . "/build.mezz"));
    $ENV{"MEZZANINE_LOGDIR"} = $config->set("LOGDIR", $config->get("LOGDIR") || $ENV{"MEZZANINE_LOGDIR"}
                                            || $ENV{"MEZZANINE_BUILDDIR"});

    # Don't hard code any RPATH's into binaries
    delete $ENV{"LD_RUN_PATH"};
    delete $ENV{"LD_LIBRARY_PATH"};

    # Save configuration if needed.
    if ($OPTION{"savecfg"}) {
        $config->save();
    }

    # Parse the product definition files to figure out what the heck we need to build. :)
    if ((substr($prod, 0, 8) ne "autoprod") && !&parse_prod_file($prod, 0, 0)) {
        if (! &parse_product_entry($prod)) {
            if (!scalar(@packages)) {
                eprint "$prod does not seem to be a valid product or product entry.\n";
                eprint "Perhaps you made a typo?\n";
                return MEZZANINE_BAD_PRODUCT;
            }
        }
    }
    return MEZZANINE_BAD_PRODUCT if (!scalar(@packages));

    dprint "Products to be built (", scalar(@packages), " packages):  ", join(" ", @products), "\n";

    if ($num_processes >= 1) {
        $ret = &parallel_build(@packages);
    } else {
        $ret = &build_product(@packages);
    }
    &summarize_failures();
    qprint "Build completed.  (${\(&get_timestamp())})\n";
    close($GLOBAL_LOG) if ($GLOBAL_LOG);
    return $ret;
}

exit &main();
