kdesrc-build 1.15.1-1.1 / usr / bin / kdesrc-build

#!/usr/bin/env perl

# Script to handle building KDE from source code.  All of the configuration is
# stored in the file ~/.kdesrc-buildrc.
#
# Please also see the documentation that should be included with this program,
# in the doc/ directory.
#
# Copyright © 2003 - 2012 Michael Pyne. <mpyne@kde.org>
# Home page: http://kdesrc-build.kde.org/
#
# Copyright © 2005, 2006, 2008 - 2011 David Faure <faure@kde.org>
# Copyright © 2005 Thiago Macieira <thiago@kde.org>
# Copyright © 2006 Stephan Kulow <coolo@kde.org>
# Copyright © 2006, 2008 Dirk Mueller <mueller@kde.org>
# ... and possibly others. Check the git source repository for specifics.
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 51
# Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

# Adding an option? Grep for 'defaultGlobalOptions' --mpyne

# Force all symbols to be in this package. We can tell if we're being called
# through require/eval/etc. by using the "caller" function.
package main;

use strict;
use warnings;
use Fcntl qw(:DEFAULT :seek);    # For sysopen constants
use Carp;
use POSIX qw(strftime :sys_wait_h _exit);
use File::Find; # For our lndir reimplementation.
use File::Path qw(remove_tree);
use File::Glob ':glob';
use File::Basename; # fileparse
use File::Spec;     # tmpdir, rel2abs
use File::Temp qw(tempfile);
use LWP::UserAgent;
use URI; # For git-clone snapshot support
use Sys::Hostname;
use Storable 'dclone';
use IO::Handle;
use Data::Dumper;
use 5.010_000; # Require Perl 5.10.0

# Make Perl 'plain die' exceptions use Carp::confess instead of their core
# support. This is not supported by the Perl 5 authors but assuming it works
# will be better than the alternative backtrace we get (which is to say, none)
$SIG{__DIE__} = \&Carp::confess;

# packages {{{

# global variables {{{

use constant {
    # We use a named remote to make some git commands work that don't accept the
    # full path.
    GIT_REMOTE_ALIAS => 'origin',
    KDE_PROJECT_ID   => 'kde-projects',          # git-repository-base for kde_projects.xml
};

my $versionNum = '1.15.1';

# This is a hash since Perl doesn't have a "in" keyword.
my %ignore_list;  # List of packages to refuse to include in the build list.

my $run_mode = 'build'; # Determines if updating, building, installing, etc.

# }}}

# package IPC {{{
{
    # Separate package for namespacing.
    package IPC;
# IPC message types
    use constant {
        MODULE_SUCCESS  => 1, # Used for a successful src checkout
        MODULE_FAILURE  => 2, # Used for a failed src checkout
        MODULE_SKIPPED  => 3, # Used for a skipped src checkout (i.e. build anyways)
        MODULE_UPTODATE => 4, # Used to skip building a module when had no code updates

        # One of these messages should be the first message placed on the queue.
        ALL_SKIPPED     => 5, # Used to indicate a skipped update process (i.e. build anyways)
        ALL_FAILURE     => 6, # Used to indicate a major update failure (don't build)
        ALL_UPDATING    => 7, # Informational message, feel free to start the build.

        # Used to indicate specifically that a source conflict has occurred.
        MODULE_CONFLICT => 8,
    };

    1;
}
# }}}

# package ksb::Debug {{{
{
    package ksb::Debug;

    # Debugging level constants.
    use constant {
        DEBUG   => 0,
        WHISPER => 1,
        INFO    => 2,
        NOTE    => 3,
        WARNING => 4,
        ERROR   => 5,
    };

    my $screenLog;   # Filehandle pointing to the "build log".
    my $isPretending = 0;
    my $debugLevel = INFO;

    # Colors
    my ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = ("") x 5;

    # Subroutine definitions

    sub import
    {
        my $pkg = shift;
        my $caller = caller;
        my @exports = qw(debug pretending debugging whisper
                         note info warning error pretend ksb_clr);

        ksb::Util::exportFunctionsToPackage($pkg, $caller, @exports);
    }

    # I'm lazy and would rather write in shorthand for the colors.  This sub
    # allows me to do so.
    sub ksb_clr
    {
        my $str = shift;

        $str =~ s/g\[/$GREEN/g;
        $str =~ s/]/$NORMAL/g;
        $str =~ s/y\[/$YELLOW/g;
        $str =~ s/r\[/$RED/g;
        $str =~ s/b\[/$BOLD/g;

        return $str;
    }

    # Subroutine which returns true if pretend mode is on.  Uses the prototype
    # feature so you don't need the parentheses to use it.
    sub pretending()
    {
        return $isPretending;
    }

    sub setPretending
    {
        $isPretending = shift;
    }

    sub setColorfulOutput
    {
        # No colors unless output to a tty.
        return unless -t STDOUT;

        my $useColor = shift;

        if ($useColor) {
            $RED = "\e[31m";
            $GREEN = "\e[32m";
            $YELLOW = "\e[33m";
            $NORMAL = "\e[0m";
            $BOLD = "\e[1m";
        }
        else {
            ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = ("") x 5;
        }
    }

    # Subroutine which returns true if debug mode is on.  Uses the prototype
    # feature so you don't need the parentheses to use it.
    sub debugging(;$)
    {
        my $level = shift // DEBUG;
        return $debugLevel <= $level;
    }

    sub setDebugLevel
    {
        $debugLevel = shift;
    }

    sub setLogFile
    {
        my $fileName = shift;

        return if pretending();
        open ($screenLog, '>', $fileName) or error ("Unable to open log file $fileName!");
    }

    # The next few subroutines are used to print output at different importance
    # levels to allow for e.g. quiet switches, or verbose switches.  The levels are,
    # from least to most important:
    # debug, whisper, info (default), note (quiet), warning (very-quiet), and error.
    #
    # You can also use the pretend output subroutine, which is emitted if, and only
    # if pretend mode is enabled.
    #
    # ksb_clr is automatically run on the input for all of those functions.
    # Also, the terminal color is automatically reset to normal as well so you don't
    # need to manually add the ] to reset.

    # Subroutine used to actually display the data, calls ksb_clr on each entry first.
    sub print_clr(@)
    {
        print ksb_clr($_) foreach (@_);
        print ksb_clr("]\n");

        if (defined $screenLog) {
            my @savedColors = ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD);
            # Remove color but still extract codes
            ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = ("") x 5;

            print ($screenLog ksb_clr($_)) foreach (@_);
            print ($screenLog "\n");

            ($RED, $GREEN, $YELLOW, $NORMAL, $BOLD) = @savedColors;
        }
    }

    sub debug(@)
    {
        print_clr(@_) if debugging;
    }

    sub whisper(@)
    {
        print_clr(@_) if $debugLevel <= WHISPER;
    }

    sub info(@)
    {
        print_clr(@_) if $debugLevel <= INFO;
    }

    sub note(@)
    {
        print_clr(@_) if $debugLevel <= NOTE;
    }

    sub warning(@)
    {
        print_clr(@_) if $debugLevel <= WARNING;
    }

    sub error(@)
    {
        print STDERR (ksb_clr $_) foreach (@_);
        print STDERR (ksb_clr "]\n");
    }

    sub pretend(@)
    {
        print_clr(@_) if pretending();
    }

    1;
}

# }}}

# package ksb::Util {{{
{
    package ksb::Util;

    use Carp qw(cluck);
    use Scalar::Util qw(blessed);
    use File::Path qw(make_path);
    use Cwd qw(getcwd);
    use Errno qw(:POSIX);

    ksb::Debug->import();

    # This function exports some functions from a source package (who should
    # actually call this function) to a destination package (who should have
    # made the request by calling $sourcePackage->import()). Any subroutine
    # prototypes defined when this function is called are copied over as well.
    #
    # The first parameter is the name of the source package.
    # The second parameter is the name of the destination package.
    # The remaining parameters are the names of the functions to export.
    sub exportFunctionsToPackage
    {
        my ($sourcePackage, $destinationPackage, @exports) = @_;

        # This loop is only slightly "magical". Basically to import functions
        # into a different package in Perl, we can use something like:
        # *PACKAGE::FUNCTION = \&SOURCE_PACKAGE::FUNCTION;
        # where the *PACKAGE modifies the symbol table for that package.
        #
        # The extra part, which requires using eval, is to predeclare the
        # subroutine with a prototype first (if that subroutine has a
        # prototype).
        # "sub foo($old_prototype);"

        for my $fn (@exports) {
            my $prototype = prototype("${sourcePackage}::$fn");
            if ($prototype) {
                eval "sub ${destinationPackage}::${fn}(${prototype});\n" .
                     "*${destinationPackage}::${fn} = \\&${sourcePackage}::${fn};";
            }
            else {
                eval "*${destinationPackage}::${fn} = \\&${sourcePackage}::${fn};";
            }
        }
    }

    sub import
    {
        my $pkg = shift;
        my $caller = caller;
        my @exports = qw(list_has make_exception assert_isa assert_in
                         croak_runtime croak_internal
                         log_command disable_locale_message_translation
                         split_quoted_on_whitespace
                         safe_unlink safe_system p_chdir super_mkdir
                         filter_program_output prettify_seconds
        );

        exportFunctionsToPackage($pkg, $caller, @exports);
    }

    # Function to work around a Perl language limitation.
    # First parameter is a reference to the list to search. ALWAYS.
    # Second parameter is the value to search for.
    # Returns true if the value is in the list
    sub list_has
    {
        my ($listRef, $value) = @_;
        my @list = @{$listRef};

        return scalar grep { "$_" eq "$value" } (@list);
    }

    # Returns a Perl object worth "die"ing for. (i.e. can be given to the die
    # function and handled appropriately later with an eval). The returned
    # reference will be an instance of BuildException. The actual exception
    # type is passed in as the first parameter (as a string), and can be
    # retrieved from the object later using the 'exception_type' key, and the
    # message is returned as 'message'
    #
    # First parameter: Exception type. Recommended are one of: Config, Internal
    # (for logic errors), Runtime (other runtime errors which are not logic
    # bugs in kdesrc-build), or just leave blank for 'Exception'.
    # Second parameter: Message to show to user
    # Return: Reference to the exception object suitable for giving to "die"
    sub make_exception
    {
        my $exception_type = shift // 'Exception';
        my $message = shift;
        my $levels = shift // 0; # Allow for more levels to be removed from bt

        # Remove this subroutine from the backtrace
        local $Carp::CarpLevel = 1 + $levels;

        $message = Carp::cluck($message) if $exception_type eq 'Internal';
        return bless({
            'exception_type' => $exception_type,
            'message'        => $message,
        }, 'BuildException');
    }

    # Should be used for "runtime errors" (i.e. unrecoverable runtime problems that
    # don't indicate a bug in the program itself).
    sub croak_runtime
    {
        die (make_exception('Runtime', $_[0], 1));
    }

    # Should be used for "logic errors" (i.e. impossibilities in program state, things
    # that shouldn't be possible no matter what input is fed at runtime)
    sub croak_internal
    {
        die (make_exception('Internal', $_[0], 1));
    }

    # Throws an exception if the first parameter is not an object at all, or if
    # it is not an object of the type given by the second parameter (which
    # should be a string of the class name. There is no return value;
    sub assert_isa
    {
        my ($obj, $class) = @_;

        if (!blessed($obj) || !$obj->isa($class)) {
            croak_runtime("$obj is not of type $class, but of type " . ref($obj));
        }

        return $obj;
    }

    # Throws an exception if the first parameter is not included in the
    # provided list of possible alternatives. The list of alternatives must
    # be passed as a reference, as the second parameter.
    sub assert_in
    {
        my ($val, $listRef) = @_;

        if (!list_has($listRef, $val)) {
            croak_runtime("$val is not a permissible value for its argument");
        }

        return $val;
    }

    # Subroutine to unlink the given symlink if global-pretend isn't set.
    sub safe_unlink
    {
        if (pretending())
        {
            pretend ("\tWould have unlinked ", shift, ".");
            return 1; # Return true
        }

        return unlink (shift);
    }

    # Subroutine to execute the system call on the given list if the pretend
    # global option is not set.
    #
    # Returns the shell error code, so 0 means success, non-zero means failure.
    sub safe_system(@)
    {
        if (!pretending())
        {
            whisper ("\tExecuting g['", join("' '", @_), "'");
            return system (@_) >> 8;
        }

        pretend ("\tWould have run g['", join("' '", @_), "'");
        return 0; # Return true
    }

    # Is exactly like "chdir", but it will also print out a message saying that
    # we're switching to the directory when debugging.
    sub p_chdir($)
    {
        my $dir = shift;
        debug ("\tcd g[$dir]\n");

        chdir ($dir) or do {
            return 1 if pretending();
            croak_runtime("Could not change to directory $dir: $!");
        };
    }

    # Helper subroutine to create a directory, including any parent
    # directories that may also need created.
    # Throws an exception on failure. See File::Path.
    sub super_mkdir
    {
        my $pathname = shift;
        state %createdPaths;

        if (pretending()) {
            if (!exists $createdPaths{$pathname} && ! -e $pathname) {
                pretend ("\tWould have created g[$pathname]");
            }

            $createdPaths{$pathname} = 1;
            return 1;
        }
        else {
            make_path($pathname);
            return (-e $pathname) ? 1 : 0;
        }
    }

    # This function is intended to disable the message translation catalog
    # settings in the program environment, so that any child processes executed
    # will have their output untranslated (and therefore scrapeable).
    #
    # As such this should only be called for a forked child about to exec as
    # there is no easy way to undo this within the process.
    sub disable_locale_message_translation
    {
        # Ensure that program output is untranslated by setting 'C' locale.
        # We're really trying to affect the LC_MESSAGES locale category, but
        # LC_ALL is a catch-all for that (so needs to be unset if set).
        #
        # Note that the ONLY SUPPORTED way to pass file names, command-line
        # args, etc. to commands is under the UTF-8 encoding at this point, as
        # that is the only sane way for this en_US-based developer to handle
        # the task.  Patches (likely using Encode::Locale) are accepted. :P

        $ENV{'LC_MESSAGES'} = 'C';
        if ($ENV{'LC_ALL'}) {
            $ENV{'LANG'} = $ENV{'LC_ALL'}; # This is lower-priority "catch all"
            delete $ENV{'LC_ALL'};
        }
    }

    # Returns an array of lines output from a program.  Use this only if you
    # expect that the output will be short.
    #
    # Since there is no way to disambiguate no output from an error, this
    # function will call die on error, wrap in eval if this bugs you.
    #
    # First parameter is subroutine reference to use as a filter (this sub will
    # be passed a line at a time and should return true if the line should be
    # returned).  If no filtering is desired pass 'undef'.
    #
    # Second parameter is the program to run (either full path or something
    # accessible in $PATH).
    #
    # All remaining arguments are passed to the program.
    #
    # Return value is an array of lines that were accepted by the filter.
    sub filter_program_output
    {
        my ($filterRef, $program, @args) = @_;
        $filterRef //= sub { return 1 }; # Default to all lines

        debug ("Slurping '$program' '", join("' '", @args), "'");

        my $pid = open(my $childOutput, '-|');
        croak_internal("Can't fork: $!") if ! defined($pid);

        if ($pid) {
            # parent
            my @lines = grep { &$filterRef; } (<$childOutput>);
            close $childOutput;
            waitpid $pid, 0;

            return @lines;
        }
        else {
            disable_locale_message_translation();

            # We don't want stderr output on tty.
            open (STDERR, '>', '/dev/null') or close (STDERR);

            exec { $program } ($program, @args) or
                croak_internal("Unable to exec $program: $!");
        }
    }

    # Subroutine to return a string suitable for displaying an elapsed time,
    # (like a stopwatch) would.  The first parameter is the number of seconds
    # elapsed.
    sub prettify_seconds
    {
        my $elapsed = $_[0];
        my $str = "";
        my ($days,$hours,$minutes,$seconds,$fraction);

        $fraction = int (100 * ($elapsed - int $elapsed));
        $elapsed = int $elapsed;

        $seconds = $elapsed % 60;
        $elapsed = int $elapsed / 60;

        $minutes = $elapsed % 60;
        $elapsed = int $elapsed / 60;

        $hours = $elapsed % 24;
        $elapsed = int $elapsed / 24;

        $days = $elapsed;

        $seconds = "$seconds.$fraction" if $fraction;

        my @str_list;

        for (qw(days hours minutes seconds))
        {
            # Use a symbolic reference without needing to disable strict refs.
            # I couldn't disable it even if I wanted to because these variables
            # aren't global or localized global variables.
            my $value = eval "return \$$_;";
            my $text = $_;
            $text =~ s/s$// if $value == 1; # Make singular

            push @str_list, "$value $text" if $value or $_ eq 'seconds';
        }

        # Add 'and ' in front of last element if there was more than one.
        push @str_list, ("and " . pop @str_list) if (scalar @str_list > 1);

        $str = join (", ", @str_list);

        return $str;
    }

    # Subroutine to mark a file as being the error log for a module.  This also
    # creates a symlink in the module log directory for easy viewing.
    # First parameter is the module in question.
    # Second parameter is the filename in the log directory of the error log.
    sub _setErrorLogfile
    {
        my $module = assert_isa(shift, 'Module');
        my $logfile = shift;

        return unless $logfile;

        my $logdir = $module->getLogDir();

        $module->setOption('#error-log-file', "$logdir/$logfile");
        debug ("Logfile for $module is $logfile");

        # Setup symlink in the module log directory pointing to the appropriate
        # file.  Make sure to remove it first if it already exists.
        unlink("$logdir/error.log") if -l "$logdir/error.log";

        if(-e "$logdir/error.log")
        {
            # Maybe it was a regular file?
            error ("r[b[ * Unable to create symlink to error log file]");
            return;
        }

        symlink "$logfile", "$logdir/error.log";
    }


    # Subroutine to run a command, optionally filtering on the output of the child
    # command.
    #
    # First parameter is the module object being built (for logging purposes
    #   and such).
    # Second parameter is the name of the log file to use (relative to the log
    #   directory).
    # Third parameter is a reference to an array with the command and its
    #   arguments.  i.e. ['command', 'arg1', 'arg2']
    #
    # After the required three parameters you can pass a hash reference of
    # optional features:
    #   'callback' => a reference to a subroutine to have each line
    #   of child output passed to.  This output is not supposed to be printed
    #   to the screen by the subroutine, normally the output is only logged.
    #   However this is useful for e.g. munging out the progress of the build.
    #   USEFUL: When there is no more output from the child, the callback will be
    #     called with an undef string.  (Not just empty, it is also undefined).
    #
    #   'no_translate' => any true value will cause a flag to be set to request
    #   the executed child process to not translate (for locale purposes) its
    #   output, so that it can be screen-scraped.
    #
    # The return value is the shell return code, so 0 is success, and non-zero is
    #   failure.
    #
    # NOTE: This function has a special feature.  If the command passed into the
    #   argument reference is 'kdesrc-build', then log_command will, when it
    #   forks, execute the subroutine named by the second parameter rather than
    #   executing a child process.  The subroutine should include the full package
    #   name as well (otherwise the package containing log_command's implementation
    #   is used).  The remaining arguments in the list are passed to the
    #   subroutine that is called.
    sub log_command
    {
        my ($module, $filename, $argRef, $optionsRef) = @_;
        assert_isa($module, 'Module');
        my @command = @{$argRef};

        $optionsRef //= { };
        my $callbackRef = $optionsRef->{'callback'};

        debug ("log_command(): Module $module, Command: ", join(' ', @command));

        # Fork a child, with its stdout connected to CHILD.
        my $pid = open(CHILD, '-|');
        if ($pid)
        {
            # Parent
            if (!$callbackRef && debugging()) {
                # If no other callback given, pass to debug() if debug-mode is on.
                $callbackRef = sub {
                    return unless $_; chomp; debug($_);
                };
            }

            # Final fallback: Do nothing
            $callbackRef //= sub { };

            # Filter each line
            &{$callbackRef}($_) while (<CHILD>);

            # Let callback know there is no more output.
            &{$callbackRef}(undef) if defined $callbackRef;

            close CHILD;

            # If the module fails building, set an internal flag in the module
            # options with the name of the log file containing the error message.
            # TODO: ($? is set when closing CHILD pipe?)
            my $result = $?;
            _setErrorLogfile($module, "$filename.log") if $result;

            return $result;
        }
        else
        {
            # Child. Note here that we need to avoid running our exit cleanup
            # handlers in here. For that we need POSIX::_exit.

            # Apply altered environment variables.
            $module->buildContext()->commitEnvironmentChanges();

            if (pretending())
            {
                pretend ("\tWould have run g['", join ("' '", @command), "'");
                POSIX::_exit(0);
            }

            my $logdir = $module->getLogDir();
            if (!$logdir || ! -e $logdir)
            {
                # Error creating directory for some reason.
                error ("\tLogging to std out due to failure creating log dir.");
            }

            # Redirect STDIN to /dev/null so that the handle is open but fails when
            # being read from (to avoid waiting forever for e.g. a password prompt
            # that the user can't see.

            open (STDIN, '<', "/dev/null") unless exists $ENV{'KDESRC_BUILD_USE_TTY'};
            open (STDOUT, "|tee $logdir/$filename.log") or do {
                error ("Error opening pipe to tee command.");
                # Don't abort, hopefully STDOUT still works.
            };

            # Make sure we log everything.
            # In the case of Qt, we may have forced on progress output so let's
            # leave that interactive to keep the logs sane.
            if (!($module->buildSystemType() eq 'Qt' &&
               $module->buildSystem()->forceProgressOutput()))
            {
                open (STDERR, ">&STDOUT");
            }

            # Call internal function, name given by $command[1]
            if ($command[0] eq 'kdesrc-build')
            {
                # No colors!
                ksb::Debug::setColorfulOutput(0);
                debug ("Calling $command[1]");

                my $cmd = $command[1];
                splice (@command, 0, 2); # Remove first two elements.

                no strict 'refs'; # Disable restriction on symbolic subroutines.
                if (! &{$cmd}(@command)) # Call sub
                {
                    POSIX::_exit (EINVAL);
                }

                POSIX::_exit (0); # Exit child process successfully.
            }

            # Don't leave empty output files, give an indication of the particular
            # command run. Use print to go to stdout.
            say "# kdesrc-build running: '", join("' '", @command), "'";
            say "# from directory: ", getcwd();

            # If a callback is set assume no translation can be permitted.
            disable_locale_message_translation() if $optionsRef->{'no_translate'};

            # External command.
            exec (@command) or do {
                my $cmd_string = join(' ', @command);
                error (<<EOF);
r[b[Unable to execute "$cmd_string"]!
    $!

Please check your binpath setting (it controls the PATH used by kdesrc-build).
Currently it is set to g[$ENV{PATH}].
EOF
                # Don't use return, this is the child still!
                POSIX::_exit (1);
            };
        }
    }

    # This subroutine acts like split(' ', $_) except that double-quoted strings
    # are not split in the process.
    #
    # First parameter: String to split on whitespace.
    # Return value: A list of the individual words and quoted values in the string.
    # The quotes themselves are not returned.
    sub split_quoted_on_whitespace
    {
        use Text::ParseWords qw(parse_line);
        my $line = shift;

        # Remove leading/trailing whitespace
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;

        # 0 means not to keep delimiters or quotes
        return parse_line('\s+', 0, $line);
    }

    1;
}

# }}}

# package BaseIPC {{{
# Base class for IPC interaction. Should have most of the functionality, with
# the actual bits of reading and writing left to subclasses.
{
    package BaseIPC;

    ksb::Util->import(); # make_exception, list_has
    ksb::Debug->import();

    sub new
    {
        my $class = shift;

        # Must bless a hash ref since subclasses expect it.
        my $ref = {};
        $ref->{'residue'} = ''; # Define this for later.
        $ref->{'updated'} = {}; # Tracks modules we've received status for.

        return bless $ref, $class;
    }

    sub notifyUpdateSuccess
    {
        my $self = shift;
        my ($module, $msg) = @_;

        $self->sendIPCMessage(main::IPC::MODULE_SUCCESS, "$module,$msg");
    }

    # Waits for an update for a module with the given name.
    # Returns a list containing whether the module was successfully updated,
    # and any specific string message (e.g. for module update success you get
    # number of files affected)
    # Will throw an exception for an IPC failure or if the module should not be
    # built.
    sub waitForModule
    {
        my ($self, $module) = @_;
        assert_isa($module, 'Module');

        my $moduleName = $module->name();
        my $updated = $self->{'updated'};
        my $message;

        # Wait for for the initial phase to complete, if it hasn't.
        $self->waitForStreamStart();

        # No update? Just mark as successful
        if ($self->{'no_update'} || !$module->phases()->has('update')) {
            $updated->{$moduleName} = 'success';
            return ('success', 'Skipped');
        }

        while(! defined $updated->{$moduleName}) {
            my $buffer;
            info ("\tWaiting for source code update.");

            my $ipcType = $self->receiveIPCMessage(\$buffer);
            if (!$ipcType)
            {
                croak_runtime("IPC failure updating $moduleName: $!");
            }

            whisper ("\tReceived IPC status message for $buffer: $ipcType");

            given ($ipcType) {
                when (IPC::MODULE_SUCCESS) {
                    my ($ipcModuleName, $msg) = split(/,/, $buffer);
                    $message = $msg;
                    $updated->{$ipcModuleName} = 'success';

                }
                when (IPC::MODULE_SKIPPED) {
                    # The difference between success here and 'skipped' below
                    # is that success means we should build even though we
                    # didn't perform an update, while 'skipped' means the
                    # *build* should be skipped even though there was no
                    # failure.
                    $message = 'skipped';
                    $updated->{$buffer} = 'success';
                }
                when (IPC::MODULE_CONFLICT) {
                    $module->setPersistentOption('conflicts-present', 1);
                    $message = 'conflicts present';
                    $updated->{$buffer} = 'failed';
                }
                when (IPC::MODULE_FAILURE) {
                    $message = 'update failed';
                    $updated->{$buffer} = 'failed';
                }
                when (IPC::MODULE_UPTODATE) {
                    # Properly account for users manually doing --refresh-build or
                    # using .refresh-me.
                    $message = 'no files affected';
                    if ($module->buildSystem()->needsRefreshed())
                    {
                        $updated->{$buffer} = 'success';
                        note ("\tNo source update, but g[$module] meets other building criteria.");
                    }
                    else
                    {
                        $updated->{$buffer} = 'skipped';
                    }
                }
                default {
                    croak_internal("Unhandled IPC type: $ipcType");
                }
            }
        }

        # Out of while loop, should have a status now.
        return ($updated->{$moduleName}, $message);
    }

    # Waits on the IPC connection until one of the ALL_* IPC codes is returned.
    # If IPC::ALL_SKIPPED is returned then the 'no_update' entry will be set in
    # $self to flag that you shouldn't wait.
    # If IPC::ALL_FAILURE is returned then an exception will be thrown due to the
    # fatal error.
    # This method can be called multiple times, but only the first time will
    # result in a wait.
    sub waitForStreamStart
    {
        my $self = shift;
        state $waited = 0;

        return if $waited;

        my $buffer = '';
        my $ipcType = $self->receiveIPCMessage(\$buffer);
        $waited = 1;

        if ($ipcType == IPC::ALL_FAILURE)
        {
            croak_runtime("Unable to perform source update for any module:\n\t$buffer");
        }
        elsif ($ipcType == IPC::ALL_SKIPPED)
        {
            $self->{'no_update'} = 1;
        }
        elsif ($ipcType != IPC::ALL_UPDATING)
        {
            croak_runtime("IPC failure while expecting an update status: Incorrect type: $ipcType");
        }
    }

    # Sends an IPC message along with some IPC type information.
    #
    # First parameter is the IPC type to send.
    # Second parameter is the actual message.
    # All remaining parameters are sent to the object's sendMessage()
    #  procedure.
    sub sendIPCMessage
    {
        # Use shift for these to empty @_ of the parameters.
        my $self = shift;
        my $ipcType = shift;
        my $msg = shift;

        my $encodedMsg = pack("l! a*", $ipcType, $msg);
        return $self->sendMessage("$encodedMsg\n", @_);
    }

    # Static class function to unpack a message.
    #
    # First parameter is the message.
    # Second parameter is a reference to a scalar to store the result in.
    #
    # Returns the IPC message type.
    sub unpackMsg
    {
        my ($msg, $outBuffer) = @_;
        my $returnType;

        ($returnType, $$outBuffer) = unpack("l! a*", $msg);

        return $returnType;
    }

    # Receives an IPC message and decodes it into the message and its
    # associated type information.
    #
    # First parameter is a *reference* to a scalar to hold the message contents.
    # All remaining parameters are passed to the underlying receiveMessage()
    #  procedure.
    #
    # Returns the IPC type, or undef on failure.
    sub receiveIPCMessage
    {
        my $self = shift;
        my $outBuffer = shift;

        # Check if we still have data left over from last read, and if it
        # contains a full message.
        if ($self->{'residue'} =~ /\n/)
        {
            my ($first, $remainder) = split(/\n/, $self->{'residue'}, 2);
            $self->{'residue'} = defined $remainder ? $remainder : '';

            return unpackMsg($first, $outBuffer);
        }

        # Read in messages enough to get to the message separator (\n)
        my $msg = '';
        while($msg !~ /\n/) {
            my $msgFragment = $self->receiveMessage(@_);
            $msg .= $msgFragment if defined $msgFragment;

            last unless defined $msgFragment;
        }

        return undef if not defined $msg or $msg eq '';

        # We may have residue still if we had a partial husk of a message, so
        # append to the residue before breaking up the message.  We assume a
        # newline separates the messages.
        $msg = $self->{'residue'} . $msg;
        my ($first, $remainder) = split(/\n/, $msg, 2);

        # Save rest for later.
        $self->{'residue'} = defined $remainder ? $remainder : '';

        return unpackMsg($first, $outBuffer);
    }

    # These must be reimplemented.  They must be able to handle scalars without
    # any extra frills.
    #
    # sendMessage should accept one parameter (the message to send) and return
    # true on success, or false on failure.  $! should hold the error information
    # if false is returned.
    sub sendMessage { croak_internal("Unimplemented."); }

    # receiveMessage should return a message received from the other side, or
    # undef for EOF or error.  On error, $! should be set to hold the error
    # information.
    sub receiveMessage { croak_internal("Unimplemented."); }

    # Should be reimplemented if default does not apply.
    sub supportsConcurrency
    {
        return 0;
    }

    1;
}
# }}}

# package PipeIPC {{{
# IPC class that uses pipes for communication.  Basically requires
# forking two children in order to communicate with.  Assumes that the two
# children are the update process and a monitor process which keeps the update
# going and informs us (the build process) of the status when we're ready to
# hear about it.
{
    package PipeIPC;

    our(@ISA);
    @ISA = qw(BaseIPC);

    sub new
    {
        my $class = shift;
        my $self = $class->SUPER::new;

        # Define file handles.
        $self->{$_} = new IO::Handle foreach qw/fromMon toMon fromSvn toBuild/;

        if (not pipe($self->{'fromSvn'}, $self->{'toMon'})or
            not pipe($self->{'fromMon'}, $self->{'toBuild'}))
        {
            return undef;
        }

        return bless $self, $class;
    }

    # Must override to send to correct filehandle.
    sub notifyUpdateSuccess
    {
        my $self = shift;
        my ($module, $msg) = @_;

        $self->sendIPCMessage(main::IPC::MODULE_SUCCESS, "$module,$msg", 'toMon');
    }

    # Closes the given list of filehandle ids.
    sub closeFilehandles
    {
        my $self = shift;
        my @fhs = @_;

        for my $fh (@fhs) {
            close $self->{$fh};
            $self->{$fh} = 0;
        }
    }

    # Call this to let the object know it will be the update process.
    sub setUpdater
    {
        my $self = shift;
        $self->closeFilehandles(qw/fromSvn fromMon toBuild/);
    }

    sub setBuilder
    {
        my $self = shift;
        $self->closeFilehandles(qw/fromSvn toMon toBuild/);
    }

    sub setMonitor
    {
        my $self = shift;
        $self->closeFilehandles(qw/toMon fromMon/);
    }

    sub supportsConcurrency
    {
        return 1;
    }

    # First parameter is the ipc Type of the message to send.
    # Second parameter is the module name (or other message).
    # Third parameter is the file handle id to send on.
    sub sendMessage
    {
        my $self = shift;
        my ($msg, $fh) = @_;

        return syswrite ($self->{$fh}, $msg);
    }

    # Override of sendIPCMessage to specify which filehandle to send to.
    sub sendIPCMessage
    {
        my $self = shift;
        push @_, 'toMon'; # Add filehandle to args.

        return $self->SUPER::sendIPCMessage(@_);
    }

    # Used by monitor process, so no message encoding or decoding required.
    sub sendToBuilder
    {
        my ($self, $msg) = @_;
        return $self->sendMessage($msg, 'toBuild');
    }

    # First parameter is a reference to the output buffer.
    # Second parameter is the id of the filehandle to read from.
    sub receiveMessage
    {
        my $self = shift;
        my $fh = shift;
        my $value;

        undef $!; # Clear error marker
        my $result = sysread ($self->{$fh}, $value, 256);

        return undef if not $result;
        return $value;
    }

    # Override of receiveIPCMessage to specify which filehandle to receive from.
    sub receiveIPCMessage
    {
        my $self = shift;
        push @_, 'fromMon'; # Add filehandle to args.

        return $self->SUPER::receiveIPCMessage(@_);
    }

    # Used by monitor process, so no message encoding or decoding required.
    sub receiveFromUpdater
    {
        my $self = shift;
        return $self->receiveMessage('fromSvn');
    }

    1;
}
# }}}

# package NullIPC {{{
# Dummy IPC module in case SysVIPC doesn't work.
{
    package NullIPC;

    our @ISA = qw(BaseIPC);

    sub new
    {
        my $class = shift;
        my $self = $class->SUPER::new;

        $self->{'msgList'} = []; # List of messages.
        return bless $self, $class; # OOP in Perl is so completely retarded
    }

    sub sendMessage
    {
        my $self = shift;
        my $msg = shift;

        push @{$self->{'msgList'}}, $msg;
        return 1;
    }

    sub receiveMessage
    {
        my $self = shift;

        return undef unless scalar @{$self->{'msgList'}} > 0;

        return shift @{$self->{'msgList'}};
    }

    1;
}
# }}}

# package KDEXMLReader {{{
# kde_projects.xml module-handling code.
# The core of this was graciously contributed by Allen Winter, and then
# touched-up and kdesrc-build'ed by myself -mpyne.
{
    package KDEXMLReader;
    use XML::Parser;

    my @nameStack = ();        # Used to assign full names to modules.
    my %xmlGroupingIds;        # XML tags which group repositories.
    my @modules;               # Result list
    my $curRepository;         # ref to hash table when we are in a repo
    my $trackingReposFlag = 0; # >0 if we should be tracking for repo elements.
    my $inRepo = 0;            # >0 if we are actually in a repo element.
    my $repoFound = 0;         # If we've already found the repo we need.
    my $searchProject = '';    # Project we're looking for.

    # Note on searchProject: A /-separated path is fine, in which case we look
    # for the right-most part of the full path which matches all of searchProject.
    # e.g. kde/kdebase/kde-runtime would be matched searchProject of either
    # "kdebase/kde-runtime" or simply "kde-runtime".
    sub getModulesForProject
    {
        # These are the elements that can have <repo> under them AFAICS, and
        # participate in module naming. e.g. kde/calligra or
        # extragear/utils/kdesrc-build
        @xmlGroupingIds{qw/component module project/} = 1;

        my ($class, $handle, $proj) = @_;

        $searchProject = $proj;
        @modules = ();
        @nameStack = ();
        $inRepo = 0;
        $trackingReposFlag = 0;
        $curRepository = undef;

        my $parser = XML::Parser->new(
            Handlers =>
                {
                    Start => \&xmlTagStart,
                    End => \&xmlTagEnd,
                    Char => \&xmlCharData,
                },
        );

        my $result = $parser->parse($handle);
        return @modules;
    }

    sub xmlTagStart
    {
        my ($expat, $element, %attrs) = @_;

        # In order to ensure that repos which are recursively under this node are
        # actually handled, we increment this flag if it's already >0 (which means
        # we're actively tracking repos for some given module).
        # xmlTagEnd will then decrement the flag so we eventually stop tracking
        # repos once we've fully recursively handled the node we cared about.
        if ($trackingReposFlag > 0) {
            ++$trackingReposFlag;
        }

        if (exists $xmlGroupingIds{$element}) {
            push @nameStack, $attrs{'identifier'};

            # If we're not tracking something, see if we should be. The logic is
            # fairly long-winded but essentially just breaks searchProject into
            # its components and compares it item-for-item to the end of our name
            # stack.
            if ($trackingReposFlag <= 0) {
                my @searchParts = split(m{/}, $searchProject);
                if (scalar @nameStack >= scalar @searchParts) {
                    my @candidateArray = @nameStack[-(scalar @searchParts)..-1];
                    die "candidate vs. search array mismatch" if $#candidateArray != $#searchParts;

                    $trackingReposFlag = 1;
                    for (my $i = 0; $i < scalar @searchParts; ++$i) {
                        if (($searchParts[$i] ne $candidateArray[$i]) &&
                            ($searchParts[$i] ne '*'))
                        {
                            $trackingReposFlag = 0;
                            last;
                        }
                    }

                    # Reset our found flag if we're looking for another repo
                    $repoFound = 0 if $trackingReposFlag > 0;
                }
            }
        }

        # Checking that we haven't already found a repo helps us out in
        # situations where a supermodule has its own repo, -OR- you could build
        # it in submodules. We won't typically want to do both, so prefer
        # supermodules this way. (e.g. Calligra and its Krita submodules)
        if ($element eq 'repo' &&     # Found a repo
            $trackingReposFlag > 0 && # When we were looking for one
            ($trackingReposFlag <= $repoFound || $repoFound == 0))
                # (That isn't a direct child of an existing repo)
        {
            die "We are already tracking a repository" if $inRepo > 0;
            $inRepo = 1;
            $repoFound = $trackingReposFlag;
            $curRepository = {
                'fullName' => join('/', @nameStack),
                'repo' => '',
                'name' => $nameStack[-1],
                'active' => 'false',
                'tarball' => '',
                'branch:stable' => '',
            }; # Repo/Active/tarball to be added by char handler.
        }

        # Currently we only pull data while under a <repo> tag, so bail early if
        # we're not doing this to simplify later logic.
        return unless $inRepo;

        # Character data is integrated by the char handler. To avoid having it
        # dump all willy-nilly into our dict, we leave a flag for what the
        # resultant key should be.
        if ($element eq 'active') {
            $curRepository->{'needs'} = 'active';

            # Unset our default value since one is present in the XML
            $curRepository->{'active'} = '';
        }
        # For git repos we want to retain the repository data and any snapshot
        # tarballs available.
        elsif ($element eq 'url' && $attrs{'protocol'} eq 'git') {
            $curRepository->{'needs'} =
                #                    this proto | needs this attr set
                $attrs{'protocol'} eq 'git'     ? 'repo'    :
                $attrs{'protocol'} eq 'tarball' ? 'tarball' : undef;
        }
        # i18n data gives us the defined stable and trunk branches.
        elsif ($element eq 'branch' && $attrs{'i18n'} && $attrs{'i18n'} eq 'stable') {
            $curRepository->{'needs'} = 'branch:stable';
        }
    }

    sub xmlTagEnd
    {
        my ($expat, $element) = @_;

        if (exists $xmlGroupingIds{$element}) {
            pop @nameStack;
        }

        # If gathering data for char handler, stop now.
        if ($inRepo && defined $curRepository->{'needs'}) {
            delete $curRepository->{'needs'};
        }

        if ($element eq 'repo' && $inRepo) {
            $inRepo = 0;
            push @modules, $curRepository;
            $curRepository = undef;
        }

        # See xmlTagStart above for an explanation.
        --$trackingReposFlag;
    }

    sub xmlCharData
    {
        my ($expat, $utf8Data) = @_;

        # The XML::Parser manpage makes it clear that the char handler can be
        # called consecutive times with data for the same tag, so we use the
        # append operator and then clear our flag in xmlTagEnd.
        if ($curRepository && defined $curRepository->{'needs'}) {
            $curRepository->{$curRepository->{'needs'}} .= $utf8Data;
        }
    }

    1;
}
# }}}

# package ksb::PhaseList {{{
{
    # Handles the "phases" for kdesrc-build, e.g. a simple list of phases,
    # and methods to add, clear, or filter out phases.
    package ksb::PhaseList;

    ksb::Util->import();

    # Constructor. Passed in values are the initial phases in this set.
    sub new
    {
        my ($class, @args) = @_;
        return bless [@args], $class;
    }

    # Filters out the given phase from the current list of phases.
    sub filterOutPhase
    {
        my ($self, $phase) = @_;
        @{$self} = grep { $_ ne $phase } @{$self};
    }

    # Adds the requested phase to the list of phases to build.
    sub addPhase
    {
        my ($self, $phase) = @_;
        push @{$self}, $phase unless list_has([@{$self}], $phase);
    }

    # Returns true if the given phase name is present in this list.
    sub has
    {
        my ($self, $phase) = @_;
        return grep { $_ eq $phase } (@{$self});
    }

    # Get/sets number of phases depending on whether any are passed in.
    sub phases
    {
        my ($self, @args) = @_;
        @$self = @args if scalar @args;
        return @$self;
    }

    sub clear
    {
        my $self = shift;
        splice @$self;
    }

    1;
}
# }}}

# package ksb::BuildContext {{{
{
    # This contains the information needed about the build context, e.g.
    # list of modules, what phases each module is in, the various options,
    # etc.
    package ksb::BuildContext;

    use Carp 'confess';
    use File::Basename; # dirname
    use IO::File;
    use POSIX qw(strftime);
    use Errno qw(:POSIX);

    # We derive from Module so that BuildContext acts like the 'global'
    # Module, with some extra functionality.
    our @ISA = qw(Module);

    # This is the second-half of "use Foo". The first-half is "require Foo" but
    # we already have ksb::Debug loaded above.
    ksb::Debug->import();

    ksb::Util->import();

    my @DefaultPhases = qw/update build install/;
    my @rcfiles = ("./kdesrc-buildrc", "$ENV{HOME}/.kdesrc-buildrc");
    my $LOCKFILE_NAME = '.kdesrc-lock';

    # The # will be replaced by the directory the rc File is stored in.
    my $PERSISTENT_FILE_NAME = '#/.kdesrc-build-data';

    # defaultGlobalOptions {{{
    my %defaultGlobalOptions = (
        "async"                => 1,
        "binpath"              => '',
        "build-when-unchanged" => 1, # Safe default
        "branch"               => "",
        "build-dir"            => "build",
        "build-system-only"    => "",
        "checkout-only"        => "",
        "cmake-options"        => "",
        "configure-flags"      => "",
        "colorful-output"      => 1, # Use color by default.
        "cxxflags"             => "-pipe",
        "debug"                => "",
        "debug-level"          => ksb::Debug::INFO,
        "delete-my-patches"    => 0, # Should only be set from cmdline
        "dest-dir"             => '${MODULE}', # single quotes used on purpose!
        "disable-agent-check"  => 0,   # If true we don't check on ssh-agent
        "do-not-compile"       => "",
        "git-repository-base"  => {}, # Base path template for use multiple times.
        "use-modules"          => "",
        "install-after-build"  => 1,  # Default to true
        "kdedir"               => "$ENV{HOME}/kde",
        "kde-languages"        => "",
        "libpath"              => "",
        "log-dir"              => "log",
        "make-install-prefix"  => "",  # Some people need sudo
        "make-options"         => "-j2",
        "manual-build"         => "",
        "manual-update"        => "",
        "module-base-path"     => "",  # Used for tags and branches
        "niceness"             => "10",
        "no-svn"               => "",
        "override-url"         => "",
        "prefix"               => "", # Override installation prefix.
        "pretend"              => "",
        "purge-old-logs"       => 1,
        "qtdir"                => "$ENV{HOME}/qt4",
        "reconfigure"          => "",
        "refresh-build"        => "",
        "remove-after-install" => "none", # { none, builddir, all }
        "repository"           => '',     # module's git repo
        "revision"             => 0,
        "run-tests"            => 0,  # 1 = make test, upload = make Experimental
        "set-env"              => { }, # Hash of environment vars to set
        "source-dir"           => "$ENV{HOME}/kdesrc",
        "ssh-identity-file"    => '', # If set, is passed to ssh-add.
        "stop-on-failure"      => "",
        "svn-server"           => "svn://anonsvn.kde.org/home/kde",
        "tag"                  => "",
        "use-clean-install"    => 0,
        "use-idle-io-priority" => 0,
        # Controls whether to build "stable" branches instead of "master"
        "use-stable-kde"       => 0,
    );
    # }}} 1

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

        # It is very important to use the Module:: syntax instead of Module->,
        # otherwise you can't pass $class and have it used as the classname.
        my $self = Module::new($class, undef, 'global');
        my %newOpts = (
            modules => [],
            context => $self, # Fix link to buildContext (i.e. $self)
            build_options => {
                global => \%defaultGlobalOptions,
                # Module options are stored under here as well, keyed by module->name()
            },
            # This one replaces Module::{phases}
            phases  => ksb::PhaseList->new(@DefaultPhases),
            errors  => {
                # Phase names from phases map to a references to a list of failed Modules
                # from that phase.
            },
            logPaths=> {
                # Holds a hash table of log path bases as expanded by
                # getSubdirPath (e.g. [source-dir]/log) to the actual log dir
                # *this run*, with the date and unique id added. You must still
                # add the module name to use.
            },
            rcFiles => [@rcfiles],
            rcFile  => undef,
            env     => { },
            ignore_list => [ ], # List of XML paths to ignore completely.
        );

        # Merge all new options into our self-hash.
        @{$self}{keys %newOpts} = values %newOpts;
        $self->{options} = $self->{build_options}{global};

        assert_isa($self, 'Module');
        assert_isa($self, 'ksb::BuildContext');

        return $self;
    }

    # Gets the ksb::PhaseList for this context, and optionally sets it first to
    # the ksb::PhaseList passed in.
    sub phases
    {
        my ($self, $phases) = @_;

        if ($phases) {
            confess("Invalid type, expected PhaseList")
                unless $phases->isa('ksb::PhaseList');
            $self->{phases} = $phases;
        }
        return $self->{phases};
    }

    sub addModule
    {
        my ($self, $module) = @_;
        Carp::confess("No module to push") unless $module;

        if (list_has($self->{modules}, $module)) {
            debug("Skipping duplicate module ", $module->name());
        }
        elsif ($module->getOption('#xml-full-path') &&
               list_has($self->{ignore_list}, $module->getOption('#xml-full-path')))
        {
            debug("Skipping ignored module $module");
        }
        else {
            debug("Adding ", $module->name(), " to module list");
            push @{$self->{modules}}, $module;
        }
    }

    sub moduleList
    {
        my $self = shift;
        return $self->{modules};
    }

    # Sets a list of modules to ignore processing on completely.
    # Parameters should simply be a list of XML repository paths to ignore,
    # e.g. 'extragear/utils/kdesrc-build'.
    sub setIgnoreList
    {
        my $self = shift;
        $self->{ignore_list} = [@_];

        debug ("Set context ignore list to ", join(', ', @_));
    }

    sub setupOperatingEnvironment
    {
        my $self = shift;
        # Set the process priority
        POSIX::nice(int $self->getOption('niceness'));

        # Set the IO priority if available.
        if ($self->getOption('use-idle-io-priority')) {
            # -p $$ is our PID, -c3 is idle priority
            # 0 return value means success
            if (main::safe_system('ionice', '-c3', '-p', $$) != 0) {
                warning (" b[y[*] Unable to lower I/O priority, continuing...");
            }
        }

        # Get ready for logged output.
        ksb::Debug::setLogFile($self->getLogDirFor($self) . '/build-log');
    }

    # Clears the list of environment variables to set for log_command runs.
    sub resetEnvironment
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');

        $self->{env} = { };
    }

    # Adds an environment variable and value to the list of environment
    # variables to apply for the next subprocess execution.
    #
    # Note that these changes are /not/ reflected in the current environment,
    # so if you are doing something that requires that kind of update you
    # should do that yourself (but remember to have some way to restore the old
    # value if necessary).
    #
    # In order to keep compatibility with the old 'setenv' sub, no action is
    # taken if the value is not equivalent to boolean true.
    sub queueEnvironmentVariable
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');
        my ($key, $value) = @_;

        return unless $value;

        debug ("\tQueueing g[$key] to be set to y[$value]");
        $self->{env}->{$key} = $value;
    }

    # Applies all changes queued by queueEnvironmentVariable to the actual
    # environment irretrievably. Use this before exec()'ing another child, for
    # instance.
    sub commitEnvironmentChanges
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');

        while (my ($key, $value) = each %{$self->{env}}) {
            $ENV{$key} = $value;
            debug ("\tSetting environment variable g[$key] to g[b[$value]");
        }
    }

    # Adds the given library paths to the path already given in an environment
    # variable. In addition, detected "system paths" are stripped to ensure
    # that we don't inadvertently re-add a system path to be promoted over the
    # custom code we're compiling (for instance, when a system Qt is used and
    # installed to /usr).
    #
    # If the environment variable to be modified has already been queued using
    # queueEnvironmentVariable, then that (queued) value will be modified and
    # will take effect with the next forked subprocess.
    #
    # Otherwise, the current environment variable value will be used, and then
    # queued. Either way the current environment will be unmodified afterward.
    #
    # First parameter is the name of the environment variable to modify
    # All remaining paramters are prepended to the current environment path, in
    # the order given. (i.e. param1, param2, param3 ->
    # param1:param2:param3:existing)
    sub prependEnvironmentValue
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');
        my ($envName, @items) = @_;
        my @curPaths = split(':', $self->{env}->{$envName} // $ENV{$envName} // '');

        # Filter out entries to add that are already in the environment from
        # the system.
        for my $path (grep { list_has(\@curPaths, $_) } (@items) ) {
            debug ("\tNot prepending y[$path] to y[$envName] as it appears " .
                  "to already be defined in y[$envName].");
        }

        @items = grep { not list_has(\@curPaths, $_); } (@items);

        my $envValue = join(':', @items, @curPaths);

        $envValue =~ s/^:*//;
        $envValue =~ s/:*$//; # Remove leading/trailing colons
        $envValue =~ s/:+/:/; # Remove duplicate colons

        $self->queueEnvironmentVariable($envName, $envValue);
    }

    # Installs the given subroutine as a signal handler for a set of signals which
    # could kill the program.
    #
    # First parameter is a reference to the sub to act as the handler.
    sub installSignalHandlers
    {
        my $handlerRef = shift;
        my @signals = qw/HUP INT QUIT ABRT TERM PIPE/;

        @SIG{@signals} = ($handlerRef) x scalar @signals;
    }

    # Tries to take the lock for our current base directory, which currently is
    # what passes for preventing people from accidentally running kdesrc-build
    # multiple times at once.  The lock is based on the base directory instead
    # of being global to allow for motivated and/or brave users to properly
    # configure kdesrc-build to run simultaneously with different
    # configurations.
    #
    # Return value is a boolean success flag.
    sub takeLock
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');
        my $baseDir = $self->baseConfigDirectory();
        my $lockfile = "$baseDir/$LOCKFILE_NAME";

        $! = 0; # Force reset to non-error status
        sysopen LOCKFILE, $lockfile, O_WRONLY | O_CREAT | O_EXCL;
        my $errorCode = $!; # Save for later testing.

        # Install signal handlers to ensure that the lockfile gets closed.
        # There is a race condition here, but at worst we have a stale lock
        # file, so I'm not *too* concerned.
        installSignalHandlers(sub {
            note ("Signal received, terminating.");
            @main::atexit_subs = (); # Remove their finish, doin' it manually
            main::finish($self, 5);
        });

        if ($errorCode == EEXIST)
        {
            # Path already exists, read the PID and see if it belongs to a
            # running process.
            open (my $pidFile, "<", $lockfile) or do
            {
                # Lockfile is there but we can't open it?!?  Maybe a race
                # condition but I have to give up somewhere.
                warning (" WARNING: Can't open or create lockfile r[$lockfile]");
                return 1;
            };

            my $pid = <$pidFile>;
            close $pidFile;

            if ($pid)
            {
                # Recent kdesrc-build; we wrote a PID in there.
                chomp $pid;

                # See if something's running with this PID.
                if (kill(0, $pid) == 1)
                {
                    # Something *is* running, likely kdesrc-build.  Don't use error,
                    # it'll scan for $!
                    print ksb_clr(" r[*y[*r[*] kdesrc-build appears to be running.  Do you want to:\n");
                    print ksb_clr("  (b[Q])uit, (b[P])roceed anyways?: ");

                    my $choice = <STDIN>;
                    chomp $choice;

                    if (lc $choice ne 'p')
                    {
                        say ksb_clr(" y[*] kdesrc-build run canceled.");
                        return 0;
                    }

                    # We still can't grab the lockfile, let's just hope things
                    # work out.
                    note (" y[*] kdesrc-build run in progress by user request.");
                    return 1;
                }

                # If we get here, then the program isn't running (or at least not
                # as the current user), so allow the flow of execution to fall
                # through below and unlink the lockfile.
            } # pid

            # No pid found, optimistically assume the user isn't running
            # twice.
            warning (" y[WARNING]: stale kdesrc-build lockfile found, deleting.");
            unlink $lockfile;

            sysopen (LOCKFILE, $lockfile, O_WRONLY | O_CREAT | O_EXCL) or do {
                error (" r[*] Still unable to lock $lockfile, proceeding anyways...");
                return 1;
            };

            # Hope the sysopen worked... fall-through
        }
        elsif ($errorCode == ENOTTY)
        {
            # Stupid bugs... normally sysopen will return ENOTTY, not sure who's to blame between
            # glibc and Perl but I know that setting PERLIO=:stdio in the environment "fixes" things.
            ; # pass
        }
        elsif ($errorCode != 0) # Some other error occurred.
        {
            warning (" r[*]: Error $errorCode while creating lock file (is $baseDir available?)");
            warning (" r[*]: Continuing the script for now...");

            # Even if we fail it's generally better to allow the script to proceed
            # without being a jerk about things, especially as more non-CLI-skilled
            # users start using kdesrc-build to build KDE.
            return 1;
        }

        say LOCKFILE "$$";
        close LOCKFILE;

        return 1;
    }

    # Releases the lock obtained by takeLock.
    sub closeLock
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');
        my $baseDir = $self->baseConfigDirectory();
        my $lockFile = "$baseDir/$LOCKFILE_NAME";

        unlink ($lockFile) or warning(" y[*] Failed to close lock: $!");
    }

    # This subroutine accepts a Module parameter, and returns the log directory
    # for it. You can also pass a BuildContext (including this one) to get the
    # default log directory.
    #
    # As part of setting up what path to use for the log directory, the
    # 'latest' symlink will also be setup to point to the returned log
    # directory.
    sub getLogDirFor
    {
        my ($self, $module) = @_;

        my $baseLogPath = $module->getSubdirPath('log-dir');
        my $logDir;

        if (!exists $self->{logPaths}{$baseLogPath}) {
            # No log dir made for this base, do so now.
            my $id = '01';
            my $date = strftime "%F", localtime; # ISO 8601 date
            $id++ while -e "$baseLogPath/$date-$id";
            $self->{logPaths}{$baseLogPath} = "$baseLogPath/$date-$id";
        }

        $logDir = $self->{logPaths}{$baseLogPath};
        return $logDir if pretending();

        main::super_mkdir($logDir) unless -e $logDir;

        # No symlink munging or module-name-adding is needed for the default
        # log dir.
        return $logDir if $module->isa('ksb::BuildContext');

        # Add a symlink to the latest run for this module.  'latest' itself is
        # a directory under the default log directory that holds module
        # symlinks, pointing to the last log directory run for that module.  We
        # do need to be careful of modules that have multiple directory names
        # though (like extragear/foo).

        my $latestPath = "$baseLogPath/latest";

        # Handle stuff like playground/utils or KDE/kdelibs
        my ($moduleName, $modulePath) = fileparse($module->name());
        $latestPath .= "/$modulePath" if $module->name() =~ m(/);

        main::super_mkdir($latestPath);

        my $symlinkTarget = "$logDir/$moduleName";
        my $symlink = "$latestPath/$moduleName";

        if (-l $symlink and readlink($symlink) ne $symlinkTarget)
        {
            unlink($symlink);
            symlink($symlinkTarget, $symlink);
        }
        elsif(not -e $symlink)
        {
            # Create symlink initially if we've never done it before.
            symlink($symlinkTarget, $symlink);
        }

        main::super_mkdir($symlinkTarget);
        return $symlinkTarget;
    }

    # Returns rc file in use. Call loadRcFile first.
    sub rcFile
    {
        my $self = shift;
        return $self->{rcFile};
    }

    # Forces the rc file to be read from to be that given by the first
    # parameter.
    sub setRcFile
    {
        my ($self, $file) = @_;
        $self->{rcFiles} = [$file];
        $self->{rcFile} = undef;
    }

    # Returns an open filehandle to the user's chosen rc file.  Use setRcFile
    # to choose a file to load before calling this function, otherwise
    # loadRcFile will search the default search path.  After this function is
    # called, rcFile() can be used to determine which file was loaded.
    #
    # If unable to find or open the rc file an exception is raised. Empty rc
    # files are supported however.
    #
    # TODO: Support a fallback default rc file.
    sub loadRcFile
    {
        my $self = shift;
        my @rcFiles = @{$self->{rcFiles}};
        my $fh;

        for my $file (@rcFiles)
        {
            if (open ($fh, '<', "$file"))
            {
                $self->{rcFile} = File::Spec->rel2abs($file);
                return $fh;
            }
        }

        # If still here, no luck.
        if (scalar @rcFiles == 1)
        {
            # This can only happen if the user uses --rc-file, so if we fail to
            # load the file, we need to fail to load at all.
            my $failedFile = $rcFiles[0];

            error (<<EOM);
Unable to open config file $failedFile

Script stopping here since you specified --rc-file on the command line to
load $failedFile manually.  If you wish to run the script with no configuration
file, leave the --rc-file option out of the command line.

If you want to force an empty rc file, use --rc-file /dev/null

EOM
            croak_runtime("Missing $failedFile");
        }

        # Set rcfile to something so the user knows what file to edit to
        # get what they want to work.
        $self->{rcFile} = '~/.kdesrc-buildrc';
        $self->whineForMissingConfig();
        $self->setup_default_modules();

        my $data = ''; # TODO: Point to sane default.
        open ($fh, '<', \$data);
        return $fh;
    }

    sub whineForMissingConfig
    {
        my $self = shift;
        my $searched = join ("\n    ", @{$self->{rcFiles}});
        my $homepage = "http://kdesrc-build.kde.org/";

        note (<<"HOME");
Unable to open configuration file!
We looked for:
    $searched

You should create a configuration file. The file kdesrc-buildrc-sample should
be included with your kdesrc-build package, which you can copy to
~/.kdesrc-buildrc and edit from there.

If the b[kdesrc-build-setup] program is installed, you can run that program
to quickly generate a simple configuration to get started.
HOME
    }

    # Returns the base directory that holds the configuration file. This is
    # typically used as the directory base for other necessary kdesrc-build
    # execution files, such as the persistent data store and lock file.
    #
    # The RC file must have been found and loaded first, obviously.
    sub baseConfigDirectory
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');
        my $rcfile = $self->rcFile() or
            croak_internal("Call to baseConfigDirectory before loadRcFile");

        return dirname($rcfile);
    }

    sub modulesInPhase
    {
        my ($self, $phase) = @_;
        my @list = grep { list_has([$_->phases()->phases()], $phase) } (@{$self->moduleList()});
        return @list;
    }

    # Searches for a module with a name that matches the provided parameter,
    # and returns its Module object. Returns undef if no match was found.
    # As a special-case, returns the BuildContext itself if the name passed is
    # 'global', since the BuildContext also is a (in the "is-a" OOP sense)
    # Module, specifically the 'global' one.
    sub lookupModule
    {
        my ($self, $moduleName) = @_;

        return $self if $moduleName eq 'global';

        my @options = grep { $_->name() eq $moduleName } (@{$self->moduleList()});
        return undef unless @options;

        if (scalar @options > 1) {
            croak_internal("Detected 2 or more $moduleName Module objects");
        }

        return $options[0];
    }

    # This subroutine setups a default set of modules to be updated and built,
    # and handles setting up their initial options (also just chosen by
    # default).
    #
    # Note: Call this and you stand the risk of losing the options you're
    # already set, do this only if you need to setup options for the entire
    # list of default modules.
    sub setup_default_modules()
    {
        my $self = shift;

        # TODO: Move this to the build-support git repo.
        my @defaultModuleList = qw(
            qt automoc cagibi attica soprano polkit-qt-1 phonon
            strigi kdesupport dbusmenu-qt
            kdelibs akonadi kdepimlibs
            kde-runtime kde-workspace kde-baseapps
            konsole kate kdeplasma-addons
            phonon-gstreamer phonon-vlc
            kdeartwork kdepim kdeutils kdegraphics kdegames
            kdetoys kdeedu kdenetwork
        );

        whisper("Setting up to build ", join(', ', @defaultModuleList), " by default.");

        my $allOptsRef = $self->{build_options};
        for my $i (@defaultModuleList) {
            my $options_ref = main::default_module_options($i);

            # Apply default option only if option not already set.  If the option
            # is here at this point it's probably user defined on the command line
            # or setup by kdesrc-build based on an option.
            for my $key (keys %{$options_ref}) {
                if (not exists $allOptsRef->{$i}{$key}) {
                    $allOptsRef->{$i}{$key} = $options_ref->{$key};
                }
            }

            $self->addModule(Module->new($self, $i));
        }
    }

    sub markModulePhaseFailed
    {
        my ($self, $phase, $module) = @_;
        assert_isa($module, 'Module');

        # Make a default empty list if we haven't already marked a module in this phase as
        # failed.
        $self->{errors}{$phase} //= [ ];
        push @{$self->{errors}{$phase}}, $module;
    }

    # Returns a list (i.e. not a reference to, but a real list) of Modules that failed to
    # complete the given phase.
    sub failedModulesInPhase
    {
        my ($self, $phase) = @_;

        # The || [] expands an empty array if we had no failures in the given phase.
        return @{$self->{errors}{$phase} || []};
    }

    # Returns true if the build context has overridden the value of the given module
    # option key. Use getOption (on this object!) to get what the value actually is.
    sub hasStickyOption
    {
        my ($self, $key) = @_;
        $key =~ s/^#//; # Remove sticky marker.

        return 1 if list_has([qw/pretend disable-agent-check/], $key);
        return $self->hasOption("#$key");
    }

    # OVERRIDE: Returns one of the following:
    # 1. The sticky option overriding the option name given.
    # 2. The value of the option name given.
    # 3. The empty string (this function never returns undef).
    #
    # The first matching option is returned. See Module::getOption, which is
    # typically what you should be using.
    sub getOption
    {
        my ($self, $key) = @_;

        foreach ("#$key", $key) {
            return $self->{options}{$_} if exists $self->{options}{$_};
        }

        return '';
    }

    # OVERRIDE: Overrides Module::setOption to handle some global-only options.
    sub setOption
    {
        my ($self, %options) = @_;

        # Actually set options.
        $self->SUPER::setOption(%options);

        # Automatically respond to various global option changes.
        while (my ($key, $value) = each %options) {
            my $normalizedKey = $key;
            $normalizedKey =~ s/^#//; # Remove sticky key modifier.
            given ($normalizedKey) {
                when ('colorful-output') { ksb::Debug::setColorfulOutput($value); }
                when ('debug-level')     { ksb::Debug::setDebugLevel($value); }
                when ('pretend')         { ksb::Debug::setPretending($value); }
            }
        }
    }

    #
    # Persistent option handling
    #

    # Returns the name of the file to use for persistent data.
    # Supports expanding '#' at the beginning of the filename to the directory
    # containing the rc-file in use, but only for the default name at this
    # point.
    sub persistentOptionFileName
    {
        my $self = shift;
        my $filename = $self->getOption('persistent-data-file');

        if (!$filename) {
            $filename = $PERSISTENT_FILE_NAME;
            my $dir = $self->baseConfigDirectory();
            $filename =~ s/^#/$dir/;
        }
        else {
            # Tilde-expand
            $filename =~ s/^~\//$ENV{HOME}\//;
        }

        return $filename;
    }

    # Reads in all persistent options from the file where they are kept
    # (.kdesrc-build-data) for use in the program.
    #
    # The directory used is the same directory that contains the rc file in use.
    sub loadPersistentOptions
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');
        my $fh = IO::File->new($self->persistentOptionFileName(), '<');

        return unless $fh;

        my $persistent_data;
        {
            local $/ = undef; # Read in whole file with <> operator.
            $persistent_data = <$fh>;
        }

        # $persistent_data should be Perl code which, when evaluated will give us
        # a hash called persistent_options which we can then merge into our
        # persistent options.

        my $persistent_options;

        # eval must appear after declaration of $persistent_options
        eval $persistent_data;
        if ($@)
        {
            # Failed.
            error ("Failed to read persistent module data: r[b[$@]");
            return;
        }

        # We need to keep persistent data with the context instead of with the
        # applicable modules since otherwise we might forget to write out
        # persistent data for modules we didn't build in this run. So, we just
        # store it all.
        # Layout of this data:
        #  $self->persistent_options = {
        #    'module-name' => {
        #      option => value,
        #      # foreach option/value pair
        #    },
        #    # foreach module
        #  }
        $persistent_options = {} if ref $persistent_options ne 'HASH';
        $self->{persistent_options} = $persistent_options;
    }

    # Writes out the persistent options to the file .kdesrc-build-data.
    #
    # The directory used is the same directory that contains the rc file in use.
    sub storePersistentOptions
    {
        my $self = assert_isa(shift, 'ksb::BuildContext');
        return if pretending();

        my $fh = IO::File->new($self->persistentOptionFileName(), '>');

        if (!$fh)
        {
            error ("Unable to save persistent module data: b[r[$!]");
            return;
        }

        print $fh "# AUTOGENERATED BY kdesrc-build $versionNum\n";

        $Data::Dumper::Indent = 1;
        print $fh Data::Dumper->Dump([$self->{persistent_options}], ["persistent_options"]);
        undef $fh; # Closes the file
    }

    # Returns the value of a "persistent" option (normally read in as part of
    # startup), or undef if there is no value stored.
    #
    # First parameter is the module name to get the option for, or 'global' if
    # not for a module.
    #     Note that unlike setOption/getOption, no inheritance is done at this
    #     point so if an option is present globally but not for a module you
    #     must check both if that's what you want.
    # Second parameter is the name of the value to retrieve (i.e. the key)
    sub getPersistentOption
    {
        my ($self, $moduleName, $key) = @_;
        my $persistent_opts = $self->{persistent_options};

        # We must check at each level of indirection to avoid
        # "autovivification"
        return unless exists $persistent_opts->{$moduleName};
        return unless exists $persistent_opts->{$moduleName}{$key};

        return $persistent_opts->{$moduleName}{$key};
    }

    # Clears a persistent option if set (for a given module and option-name).
    #
    # First parameter is the module name to get the option for, or 'global' for
    # the global options.
    # Second parameter is the name of the value to clear.
    # No return value.
    sub unsetPersistentOption
    {
        my ($self, $moduleName, $key) = @_;
        my $persistent_opts = $self->{persistent_options};

        if (exists $persistent_opts->{$moduleName} &&
            exists $persistent_opts->{$moduleName}->{$key})
        {
            delete $persistent_opts->{$moduleName}->{$key};
        }
    }

    # Sets a "persistent" option which will be read in for a module when
    # kdesrc-build starts up and written back out at (normal) program exit.
    #
    # First parameter is the module name to set the option for, or 'global'.
    # Second parameter is the name of the value to set (i.e. key)
    # Third parameter is the value to store, which must be a scalar.
    sub setPersistentOption
    {
        my ($self, $moduleName, $key, $value) = @_;
        my $persistent_opts = $self->{persistent_options};

        # Initialize empty hash ref if nothing defined for this module.
        $persistent_opts->{$moduleName} //= { };

        $persistent_opts->{$moduleName}{$key} = $value;
    }

    1;
}
# }}}

# package UpdateHandler {{{
{
    package UpdateHandler;

    ksb::Util->import();

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

        return bless { module => $module }, $class;
    }

    sub name
    {
        croak_internal('This package should not be used directly.');
    }

    sub module
    {
        my $self = shift;
        return $self->{module};
    }

    1;
}
# }}}

# package KDEProjectUpdate {{{
{
    package KDEProjectUpdate;

    our @ISA = qw(GitUpdate);

    sub name
    {
        return 'proj';
    }

    1;
}
# }}}

# package KDEProjectMetadataUpdate {{{
{
    package KDEProjectMetadataUpdate;

    our @ISA = qw(KDEProjectUpdate);

    ksb::Util->import();

    sub name
    {
        return 'metadata';
    }

    sub updateInternal
    {
        my $self = assert_isa(shift, 'KDEProjectMetadataUpdate');
        my $count = $self->SUPER::updateInternal();

        # Now that we in theory have up-to-date source code, read in the
        # ignore file and propagate that information to our context object.

        my $path = $self->module()->fullpath('source') . "/build-script-ignore";
        open my $fh, '<', $path or croak_internal("Unable to read ignore data: $!");

        my $ctx = $self->module()->buildContext();
        my @ignoreModules = map { chomp $_; $_ } (<$fh>);

        $ctx->setIgnoreList(@ignoreModules);

        return $count;
    }

    1;
}
# }}}

# package GitUpdate {{{
{
    package GitUpdate;

    ksb::Debug->import();
    ksb::Util->import();

    our @ISA = ('UpdateHandler');

    # scm-specific update procedure.
    # May change the current directory as necessary.
    # Assumes called as part of a Module (i.e. $self->isa('Module') should be true.
    sub updateInternal
    {
        my $self = assert_isa(shift, 'GitUpdate');
        return main::update_module_git_checkout($self->module());
    }

    sub name
    {
        return 'git';
    }

    sub currentRevisionInternal
    {
        my $self = assert_isa(shift, 'GitUpdate');
        return main::git_commit_id($self->module());
    }

    1;
}
# }}}

# package BzrUpdate {{{
# Support the bazaar source control manager for libdbusmenu-qt
{
    package BzrUpdate;

    ksb::Debug->import();
    ksb::Util->import();

    # Our superclass
    our @ISA = ('UpdateHandler');

    # scm-specific update procedure.
    # May change the current directory as necessary.
    # Should return a count of files changed (or commits, or something similar)
    sub updateInternal
    {
        my $self = assert_isa(shift, 'BzrUpdate');
        my $module = assert_isa($self->module(), 'Module');

        # Full path to source directory on-disk.
        my $srcdir = $module->fullpath('source');
        my $bzrRepoName = $module->getOption('repository');

        # Or whatever regex is appropriate to strip the bzr URI protocol.
        $bzrRepoName =~ s/^bzr:\/\///;

        if (! -e "$srcdir/.bzr") {
            # Cmdline assumes bzr will create the $srcdir directory and then
            # check the source out into that directory.
            my @cmd = ('bzr', 'branch', $bzrRepoName, $srcdir);

            # Exceptions are used for failure conditions
            if (log_command($module, 'bzr-branch', \@cmd) != 0) {
                die make_exception('Internal', "Unable to checkout $module!");
            }

            # TODO: Filtering the output by passing a subroutine to log_command
            # should give us the number of revisions, or we can just somehow
            # count files.
            my $newRevisionCount = 0;
            return $newRevisionCount;
        }
        else {
            # Update existing checkout. The source is currently in $srcdir
            p_chdir($srcdir);

            if (log_command($module, 'bzr-up', ['bzr', 'up']) != 0) {
                die make_exception('Internal', "Unable to update $module!");
            }

            # I haven't looked at bzr up output yet to determine how to find
            # number of affected files or number of revisions skipped.
            my $changeCount = 0;
            return $changeCount;
        }

        return 0;
    }

    sub name
    {
        return 'bzr';
    }

    # This is used to track things like the last successfully installed
    # revision of a given module.
    sub currentRevisionInternal
    {
        my $self = assert_isa(shift, 'BzrUpdate');
        my $module = $self->module();
        my $result;

        # filter_program_output can throw exceptions
        eval {
            p_chdir($module->fullpath('source'));

            ($result, undef) = filter_program_output(undef, 'bzr', 'revno');
            chomp $result;
        };

        if ($@) {
            error ("Unable to run r[b[bzr], is bazaar installed?");
            error (" -- Error was: r[$@]");
            return undef;
        }

        return $result;
    }

    1;
}
# }}}

# package SvnUpdate {{{
{
    package SvnUpdate;

    ksb::Debug->import();
    ksb::Util->import();

    our @ISA = ('UpdateHandler');

    # Returns true if a module has a base component to their name (e.g. KDE/,
    # extragear/, or playground).  Note that modules that aren't in trunk/KDE
    # don't necessary meet this criteria (e.g. kdereview is a module itself).
    sub _has_base_module
    {
        my $moduleName = shift;

        return $moduleName =~ /^(extragear|playground|KDE)(\/[^\/]+)?$/;
    }

    # Subroutine to return the branch prefix. i.e. the part before the branch
    # name and module name.
    #
    # The first parameter is the module name in question.
    # The second parameter should be 'branches' if we're dealing with a branch
    #      or 'tags' if we're dealing with a tag.
    #
    # Ex: 'kdelibs'  => 'branches/KDE'
    #     'kdevelop' => 'branches/kdevelop'
    sub _branch_prefix
    {
        my $moduleName = shift;
        my $type = shift;

        # These modules seem to have their own subdir in /tags.
        my @tag_components = qw/arts koffice amarok kst qt taglib/;

        # The map call adds the kde prefix to the module names because I don't feel
        # like typing them all in.
        my @kde_module_list = ((map {'kde' . $_} qw/-base-artwork -wallpapers accessibility
                addons admin artwork base bindings edu games graphics libs
                network pim pimlibs plasma-addons sdk toys utils webdev/));

        # If the user already has the module in the form KDE/foo, it's already
        # done.
        return "$type/KDE" if $moduleName =~ /^KDE\//;

        # KDE proper modules seem to use this pattern.
        return "$type/KDE" if list_has(\@kde_module_list, $moduleName);

        # KDE extragear / playground modules use this pattern
        return "$type" if _has_base_module($moduleName);

        # If we doing a tag just return 'tags' because the next part is the actual
        # tag name, which is added by the caller, unless the module has its own
        # subdirectory in /tags.
        return "$type" if $type eq 'tags' and not list_has(\@tag_components, $moduleName);

        # Everything else.
        return "$type/$moduleName";
    }

    # This subroutine is responsible for stripping the KDE/ part from the
    # beginning of modules that were entered by the user like "KDE/kdelibs"
    # instead of the normal "kdelibs".  That way you can search for kdelibs
    # without having to strip KDE/ everywhere.
    sub _moduleBaseName
    {
        my $moduleName = shift;
        $moduleName =~ s/^KDE\///;

        return $moduleName;
    }

    # Subroutine to return a module URL for a module using the 'branch' option.
    # First parameter is the module in question.
    # Second parameter is the type ('tags' or 'branches')
    sub _handle_branch_tag_option
    {
        my $module = assert_isa(shift, 'Module');
        my $type = shift;
        my $branch = _branch_prefix($module->name(), $type);
        my $svn_server = $module->getOption('svn-server');
        my $branchname = $module->getOption($type eq 'branches' ? 'branch' : 'tag');

        # Remove trailing slashes.
        $svn_server =~ s/\/*$//;

        # Remove KDE/ prefix for module name.
        my $moduleName = _moduleBaseName($module->name());

        # KDE modules have a different module naming scheme than the rest it seems.
        return "$svn_server/$branch/$branchname/$moduleName" if $branch =~ /\/KDE\/?$/;

        # Non-trunk translations happen in a single branch. Assume all non-trunk
        # global branches are intended for the stable translations.
        if ($moduleName =~ /^l10n-kde4\/?/ && $branch ne 'trunk') {
            return "$svn_server/branches/stable/$moduleName";
        }

        # Otherwise don't append the module name by default since it makes more
        # sense to branch this way in many situations (i.e. kdesupport tags, phonon)
        return "$svn_server/$branch/$branchname";
    }

    # Subroutine to return the appropriate SVN URL for a given module, based on
    # the user settings.  For example, 'kdelibs' ->
    # https://svn.kde.org/home/kde/trunk/KDE/kdelibs
    #
    # This operates under a double hierarchy:
    # 1. If any module-specific option is present, it wins.
    # 2. If only global options are present, the order override-url, tag,
    #    branch, module-base-path, is preferred.
    sub svn_module_url
    {
        my $self = assert_isa(shift, 'SvnUpdate');
        my $module = $self->module();
        my $svn_server = $module->getOption('svn-server');
        my $modulePath;

        foreach my $levelLimit ('module', 'allow-inherit') {
            $modulePath = $module->getOption('module-base-path', $levelLimit);

            # Allow user to override normal processing of the module in a few ways,
            # to make it easier to still be able to use kdesrc-build even when I
            # can't be there to manually update every little special case.
            if($module->getOption('override-url', $levelLimit))
            {
                return $module->getOption('override-url', $levelLimit);
            }

            if($module->getOption('tag', $levelLimit))
            {
                return _handle_branch_tag_option($module, 'tags');
            }

            my $branch = $module->getOption('branch', $levelLimit);
            if($branch and $branch ne 'trunk')
            {
                return _handle_branch_tag_option($module, 'branches');
            }

            my $moduleName = _moduleBaseName($module->name());

            # The following modules are in /trunk, not /trunk/KDE.  There are others,
            # but these are the important ones.
            my @non_trunk_modules = qw(extragear kdesupport koffice icecream kde-common
                playground KDE kdereview www l10n-kde4);

            my $module_root = $moduleName;
            $module_root =~ s/\/.*//; # Remove everything after the first slash

            if (not $modulePath and $levelLimit eq 'allow-inherit')
            {
                $modulePath = "trunk/KDE/$moduleName";
                $modulePath = "trunk/$moduleName" if list_has(\@non_trunk_modules, $module_root);
                $modulePath =~ s/^\/*//; # Eliminate / at beginning of string.
                $modulePath =~ s/\/*$//; # Likewise at the end.
            }

            last if $modulePath;
        }

        # Remove trailing slashes.
        $svn_server =~ s/\/*$//;

        # Note that the module name is no longer appended if module-base-path is used (i.e.
        # $branch variable was set.  This is a change as of version 1.8.
        return "$svn_server/$modulePath";
    }

    # Subroutine to determine whether or not the given module has the correct
    # URL.  If not, a warning is printed out.
    # First parameter: module to check.
    # Return: Nothing.
    sub check_module_validity
    {
        my $self = assert_isa(shift, 'SvnUpdate');
        my $module = $self->module();
        my $source_dir = $module->fullpath('source');
        my $module_expected_url = $self->svn_module_url();
        my $module_actual_url = $self->svnInfo('URL');

        $module_expected_url =~ s{/+$}{}; # Remove trailing slashes
        $module_actual_url   =~ s{/+$}{}; # Remove trailing slashes

        if ($module_actual_url ne $module_expected_url)
        {
            # Check if the --src-only flag was passed.
            if ($module->buildContext()->getOption('#allow-auto-repo-move'))
            {
                note ("g[$module] is checked out from a different location than expected.");
                note ("Attempting to correct");

                log_command($module, 'svn-switch', ['svn', 'switch', $module_expected_url]);
                return;
            }

            warning (<<EOF);
 y[!!]
 y[!!] g[$module] seems to be checked out from somewhere other than expected.
 y[!!]

kdesrc-build expects:        y[$module_expected_url]
The module is actually from: y[$module_actual_url]

If the module location is incorrect, you can fix it by either deleting the
g[b[source] directory, or by changing to the source directory and running
  svn switch $module_expected_url

If the module is fine, please update your configuration file.

If you use kdesrc-build with --src-only it will try switching for you (might not work
correctly).
EOF
        }
    }

    # Subroutine used to handle the checkout-only option.  It handles updating
    # subdirectories of an already-checked-out module.
    #
    # This function can throw an exception in the event of a update failure.
    #
    # First parameter is the module.
    # All remaining parameters are subdirectories to check out.
    #
    # Returns the number of files changed by the update, or undef if unable to
    # be determined.
    sub update_module_subdirectories
    {
        my $self = assert_isa(shift, 'SvnUpdate');
        my $module = $self->module();
        my $numChanged = 0;

        # If we have elements in @path, download them now
        for my $dir (@_)
        {
            info ("\tUpdating g[$dir]");

            my $logname = $dir;
            $logname =~ tr{/}{-};

            my $count = $self->run_svn("svn-up-$logname", [ 'svn', 'up', $dir ]);
            $numChanged = undef unless defined $count;
            $numChanged += $count if defined $numChanged;
        }

        return $numChanged;
    }

    # Checkout a module that has not been checked out before, along with any
    # subdirectories the user desires.
    #
    # This function will throw an exception in the event of a failure to update.
    #
    # The first parameter is the module to checkout (including extragear and
    # playground modules).
    # All remaining parameters are subdirectories of the module to checkout.
    #
    # Returns number of files affected, or undef.
    sub checkout_module_path
    {
        my $self = assert_isa(shift, 'SvnUpdate');
        my $module = $self->module();
        my @path = @_;
        my %pathinfo = main::get_module_path_dir($module, 'source');
        my @args;

        if (not -e $pathinfo{'path'} and not super_mkdir($pathinfo{'path'}))
        {
            croak_runtime ("Unable to create path r[$pathinfo{path}]!");
        }

        p_chdir ($pathinfo{'path'});

        my $svn_url = $self->svn_module_url();
        my $modulename = $pathinfo{'module'}; # i.e. kdelibs for KDE/kdelibs as $module

        push @args, ('svn', 'co', '--non-interactive');
        push @args, '-N' if scalar @path; # Tells svn to only update the base dir
        push @args, $svn_url;
        push @args, $modulename;

        note ("Checking out g[$module]");

        my $count = $self->run_svn('svn-co', \@args);

        p_chdir ($pathinfo{'module'}) if scalar @path;

        my $count2 = $self->update_module_subdirectories(@path);

        return $count + $count2 if defined $count and defined $count2;
        return undef;
    }

    # Update a module that has already been checked out, along with any
    # subdirectories the user desires.
    #
    # This function will throw an exception in the event of an update failure.
    #
    # The first parameter is the module to checkout (including extragear and
    # playground modules).
    # All remaining parameters are subdirectories of the module to checkout.
    sub update_module_path
    {
        my ($self, @path) = @_;
        assert_isa($self, 'SvnUpdate');
        my $module = $self->module();
        my $fullpath = $module->fullpath('source');
        my @args;

        p_chdir ($fullpath);

        push @args, ('svn', 'up', '--non-interactive');
        push @args, '-N' if scalar @path;

        note ("Updating g[$module]");

        my $count = eval { $self->run_svn('svn-up', \@args); };

        # Update failed, try svn cleanup.
        if ($@ && $@->{exception_type} ne 'ConflictPresent')
        {
            info ("\tUpdate failed, trying a cleanup.");
            my $result = safe_system('svn', 'cleanup');
            $result == 0 or croak_runtime ("Unable to update $module, " .
                               "svn cleanup failed with exit code $result");

            info ("\tCleanup complete.");

            # Now try again (allow exception to bubble up this time).
            $count = $self->run_svn('svn-up-2', \@args);
        }

        my $count2 = $self->update_module_subdirectories(@path);

        return $count + $count2 if defined $count and defined $count2;
        return undef;
    }

    # The function checks whether subversion already has an ssl acceptance
    # notification for svn.kde.org, and if it's doesn't, installs one.
    # Problems: First off, installing any kind of "accept this ssl cert without
    # user's active consent" kind of sucks.  Second, this function is very
    # specific to the various signature algorithms used by svn, so it could break
    # in the future.  But there's not a better way to skip warnings about svn.kde.org
    # until the site has a valid ssl certificate.
    #
    # Accepts no arguments, has no return value.
    sub _install_missing_ssl_signature
    {
        my $sig_dir  = "$ENV{HOME}/.subversion/auth/svn.ssl.server";
        my $sig_file = "ec08b331e2e6cabccb6c3e17a85e28ce";

        debug ("Checking $sig_dir/$sig_file for KDE SSL signature.");

        if (-e "$sig_dir/$sig_file")
        {
            debug ("KDE SSL Signature file present.");
            return;
        }

        debug ("No KDE SSL Signature found.");
        return if pretending();

        # Now we're definitely installing, let the user know.
        warning ("Installing b[y[KDE SSL signature] for Subversion.  This is to avoid");
        warning ("Subversion warnings about KDE's self-signed SSL certificate for svn.kde.org");

        # Make sure the directory is created.
        if (!super_mkdir($sig_dir))
        {
            error ("Unable to create r[Subversion signature] directory!");
            error ("$!");

            return;
        }

        my $sig_data =
'K 10
ascii_cert
V 1216
MIIDijCCAvOgAwIBAgIJAO9Ca3rOVtgrMA0GCSqGSIb3DQEBBQUAMIGLMQswCQYDVQQGE\
wJERTEQMA4GA1UECBMHQmF2YXJpYTESMBAGA1UEBxMJTnVlcm5iZXJnMREwDwYDVQQKEw\
hLREUgZS5WLjEMMAoGA1UECxMDU1ZOMRQwEgYDVQQDEwtzdm4ua2RlLm9yZzEfMB0GCSq\
GSIb3DQEJARYQc3lzYWRtaW5Aa2RlLm9yZzAeFw0wNTA1MTExMDA4MjFaFw0xNTA1MDkx\
MDA4MjFaMIGLMQswCQYDVQQGEwJERTEQMA4GA1UECBMHQmF2YXJpYTESMBAGA1UEBxMJT\
nVlcm5iZXJnMREwDwYDVQQKEwhLREUgZS5WLjEMMAoGA1UECxMDU1ZOMRQwEgYDVQQDEw\
tzdm4ua2RlLm9yZzEfMB0GCSqGSIb3DQEJARYQc3lzYWRtaW5Aa2RlLm9yZzCBnzANBgk\
qhkiG9w0BAQEFAAOBjQAwgYkCgYEA6COuBkrEcEJMhzHajKpN/StQwr/YeXIXKwtROWEt\
7evsXBNqqRe6TuUc/iVYgBuZ4umVlJ/qJ7Q8cSa8Giuk2B3ShZx/WMSC80OfGDJ4LoWm3\
uoW8h45ExAACBlhuuSSa7MkH6EXhru1SvLbAbTcSVqyTzoWxhkAb8ujy6CUxHsCAwEAAa\
OB8zCB8DAdBgNVHQ4EFgQUx2W0046HfWi1fGL1V8NlDJvnPRkwgcAGA1UdIwSBuDCBtYA\
Ux2W0046HfWi1fGL1V8NlDJvnPRmhgZGkgY4wgYsxCzAJBgNVBAYTAkRFMRAwDgYDVQQI\
EwdCYXZhcmlhMRIwEAYDVQQHEwlOdWVybmJlcmcxETAPBgNVBAoTCEtERSBlLlYuMQwwC\
gYDVQQLEwNTVk4xFDASBgNVBAMTC3N2bi5rZGUub3JnMR8wHQYJKoZIhvcNAQkBFhBzeX\
NhZG1pbkBrZGUub3JnggkA70Jres5W2CswDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQU\
FAAOBgQDjATlL2NByFDo5hhQAQdXjSYrMxil7zcpQjR+KYVizC7yK99ZsA0LYf/Qbu/pa\
oMnmKLKWeNlF8Eq7/23TeAJmjw1pKi97ZO2FJ8jvy65iBEJLRYnpJ75dvg05iugm9GZ5w\
Px6GHZmkSrteGDXgVbbSDy5exv1naqc+qEM7Ar4Xw==
K 8
failures
V 1
8
K 15
svn:realmstring
V 23
https://svn.kde.org:443
END
';

        # Remove the \<newline> parts (the gibberish should be one big long
        # line).
        $sig_data =~ s/\\\n//gm;

        open (my $sig, '>', "$sig_dir/$sig_file") or do {
            error ("Unable to open KDE SSL signature file!");
            error ("r[$!]");

            return;
        };

        print $sig $sig_data or do {
            error ("Unable to write to KDE SSL signature file!");
            error ("r[$!]");
        };

        close $sig;
    }

    # Run the svn command.  This is a special subroutine so that we can munge
    # the generated output to see what files have been added, and adjust the
    # build according.
    #
    # This function will throw an exception in the event of a build failure.
    #
    # First parameter is the Module object we're building.
    # Second parameter is the filename to use for the log file.
    # Third parameter is a reference to a list, which is the command ('svn')
    #       and all of its arguments.
    # Return value is the number of files update (may be undef if unable to tell)
    sub run_svn
    {
        my ($self, $logfilename, $arg_ref) = @_;
        assert_isa($self, 'SvnUpdate');
        my $module = $self->module();

        my $revision = $module->getOption('revision');
        if ($revision ne '0')
        {
            my @tmp = @{$arg_ref};

            # Insert after first two entries, deleting 0 entries from the
            # list.
            splice @tmp, 2, 0, '-r', $revision;
            $arg_ref = \@tmp;
        }

        my $count = 0;
        my $conflict = 0;

        my $callback = sub {
            return unless $_;

            # The check for capitalized letters in the second column is because
            # svn can use the first six columns for updates (the characters will
            # all be uppercase), which makes it hard to tell apart from normal
            # sentences (like "At Revision foo"
            $count++      if /^[UPDARGMC][ A-Z]/;
            $conflict = 1 if /^C[ A-Z]/;
        };

        # Do svn update.
        my $result = log_command($module, $logfilename, $arg_ref, { callback => $callback });

        return 0 if pretending();

        croak_runtime("Error updating $module!") unless $result == 0;

        if ($conflict)
        {
            warning ("Source code conflict exists in r[$module], this module will not");
            warning ("build until it is resolved.");

            # If in async this only affects the update process, we need to IPC it
            # to the build process.
            $module->setOption('#update-error', IPC::MODULE_CONFLICT);
            die make_exception('ConflictPresent', "Source conflicts exist in $module");
        }

        return $count;
    }

    # Subroutine to check for subversion conflicts in a module.  Basically just
    # runs svn st and looks for "^C".
    #
    # First parameter is the module to check for conflicts on.
    # Returns 0 if a conflict exists, non-zero otherwise.
    sub module_has_conflict
    {
        my $module = assert_isa(shift, 'Module');
        my $srcdir = $module->fullpath('source');

        if ($module->getOption('no-svn'))
        {
            whisper ("\tSource code conflict check skipped.");
            return 1;
        }
        else
        {
            info ("\tChecking for source conflicts... ");
        }

        my $pid = open my $svnProcess, "-|";
        if (!$pid)
        {
            error ("\tUnable to open check source conflict status: b[r[$!]");
            return 0; # false allows the build to proceed anyways.
        };

        if (0 == $pid)
        {
            # Avoid calling close subroutines in more than one routine.
            @main::atexit_subs = ();

            close STDERR; # No broken pipe warnings

            disable_locale_message_translation();
            exec {'svn'} (qw/svn --non-interactive st/, $srcdir) or
                croak_runtime("Cannot execute 'svn' program: $!");
            # Not reached
        }

        while (<$svnProcess>)
        {
            if (/^C/)
            {
                error (<<EOF);
The $module module has source code conflicts present.  This can occur
when you have made changes to the source code in the local copy
at $srcdir
that interfere with a change introduced in the source repository.
EOF

                error (<<EOF);
To fix this, y[if you have made no source changes that you haven't committed],
run y[svn revert -R $srcdir]
to bring the source directory back to a pristine state and trying building the
module again.

NOTE: Again, if you have uncommitted source code changes, running this command
will delete your changes in favor of the version in the source repository.
EOF

                kill "TERM", $pid; # Kill svn
                waitpid ($pid, 0);
                close $svnProcess;
                return 0;
            }
        }

        # conflicts cleared apparently.
        waitpid ($pid, 0);
        close $svnProcess;
        return 1;
    }

    # scm-specific update procedure.
    # May change the current directory as necessary.
    # Assumes called as part of a Module (i.e. $self->isa('Module') should be true.
    sub updateInternal
    {
        my $self = assert_isa(shift, 'SvnUpdate');
        my $module = $self->module();
        my $fullpath = $module->fullpath('source');
        my @options = split(' ', $module->getOption('checkout-only'));

        if (-e "$fullpath/.svn") {
            $self->check_module_validity();
            my $updateCount = $self->update_module_path(@options);

            my $log_filter = sub {
                return unless defined $_;
                print $_ if /^C/;
                print $_ if /Checking for/;
                return;
            };

            # Use log_command as the check so that an error file gets created.
            if (0 != log_command($module, 'conflict-check',
                                 ['kdesrc-build', 'SvnUpdate::module_has_conflict',
                                                  $module],
                                 { callback => $log_filter, no_translate => 1 })
               )
            {
                croak_runtime (" * Conflicts present in module $module");
            }

            return $updateCount;
        }
        else {
            return $self->checkout_module_path(@options);
        }
    }

    sub name
    {
        return 'svn';
    }

    sub currentRevisionInternal
    {
        my $self = assert_isa(shift, 'SvnUpdate');
        return $self->svnInfo('Revision');
    }

    # Returns a requested parameter from 'svn info'.
    #
    # First parameter is a string with the name of the parameter to retrieve (e.g. URL).
    #   Each line of output from svn info is searched for the requested string.
    # Returns the string value of the parameter or undef if an error occurred.
    sub svnInfo
    {
        my $self = assert_isa(shift, 'SvnUpdate');
        my $module = $self->module();

        my $param = shift;
        my $srcdir = $module->fullpath('source');
        my $result; # Predeclare to outscope upcoming eval

        if (pretending() && ! -e $srcdir) {
            return 'Unknown';
        }

        # Search each line of output, ignore stderr.
        # eval since filter_program_output uses exceptions.
        eval
        {
            # Need to chdir into the srcdir, in case srcdir is a symlink.
            # svn info /path/to/symlink barfs otherwise.
            p_chdir ($srcdir);

            my @lines = filter_program_output(
                sub { /^$param:/ },
                'svn', 'info', '--non-interactive', '.'
            );

            chomp ($result = $lines[0]);
            $result =~ s/^$param:\s*//;
        };

        if($@)
        {
            error ("Unable to run r[b[svn], is the Subversion program installed?");
            error (" -- Error was: r[$@]");
            return undef;
        }

        return $result;
    }

    1;
}
# }}}

# package GenericBuildSystem {{{
{
    package GenericBuildSystem;

    ksb::Debug->import();
    ksb::Util->import();

    sub new
    {
        my ($class, $module) = @_;
        return bless { module => $module }, $class;
    }

    sub module
    {
        my $self = shift;
        return $self->{module};
    }

    # Subroutine to determine if a given module needs to have the build system
    # recreated from scratch.
    # If so, it returns boolean true.
    sub needsRefreshed
    {
        my $self = assert_isa(shift, 'GenericBuildSystem');
        my $module = $self->module();
        my $builddir = $module->fullpath('build');
        my $confFileKey = $self->configuredModuleFileName();

        if (debugging())
        {
            debug ("Build directory not setup for $module.") if not -e "$builddir";
            debug (".refresh-me exists for $module.") if -e "$builddir/.refresh-me";
            debug ("refresh-build option set for $module.") if $module->getOption('refresh-build');
            debug ("Can't find configure key file for $module.") if not -e "$builddir/$confFileKey";
        }

        return 1 if ((not -e "$builddir") ||
            (-e "$builddir/.refresh-me") ||
            $module->getOption("refresh-build") ||
            (not -e "$builddir/$confFileKey"));

        return 0;
    }

    # Returns true if the given subdirectory (reference from the module's root source directory)
    # can be built or not. Should be reimplemented by subclasses as appropriate.
    sub isSubdirBuildable
    {
        return 1;
    }

    # Returns true if the buildsystem will give percentage-completion updates on its output.
    # Such percentage updates will be searched for to update the kdesrc-build status.
    sub isProgressOutputSupported
    {
        return 0;
    }

    # If this method returns a non-empty string, then that string is the name
    # of an environment variable to prepend the module's installation prefix
    # path to. Mostly a hack, but will have to do until there's a better scheme
    # for giving integration points for build systems into the actual build
    # process.
    sub prefixEnvironmentVariable
    {
        return undef;
    }

    # Returns true if the module should have make install run in order to be
    # used, or false if installation is not required or possible.
    sub needsInstalled
    {
        return 1;
    }

    # This should return a list of executable names that must be present to
    # even bother attempting to use this build system. An empty list should be
    # returned if there's no required programs.
    sub requiredPrograms
    {
        return;
    }

    sub name
    {
        return 'generic';
    }

    # Return value style: boolean
    sub buildInternal
    {
        my $self = shift;

        return main::safe_make($self->module(), {
            target => undef,
            message => 'Compiling...',
            'make-options' => [
                split(' ', $self->module()->getOption('make-options')),
            ],
            logbase => 'build',
            subdirs => [
                split(' ', $self->module()->getOption("checkout-only"))
            ],
        }) == 0;
    }

    # Return value style: boolean
    sub configureInternal
    {
        # It is possible to make it here if there's no source dir and if we're
        # pretending. If we're not actually pretending then this should be a
        # bug...
        return 1 if pretending();

        croak_internal('We were not supposed to get to this point...');
    }

    # Returns name of file that should exist (relative to the module's build directory)
    # if the module has been configured.
    sub configuredModuleFileName
    {
        my $self = shift;
        return 'Makefile';
    }

    # Runs the testsuite for the given module.
    # Returns true if a testsuite is present and all tests passed, false otherwise.
    sub runTestsuite
    {
        my $self = shift;
        my $module = $self->module();

        info ("\ty[$module] does not support the b[run-tests] option");
        return 0;
    }

    # Used to install a module (that has already been built, tested, etc.)
    # All options passed are prefixed to the eventual command to be run.
    # Returns boolean false if unable to install, true otherwise.
    sub installInternal
    {
        my $self = shift;
        my $module = $self->module();
        my @cmdPrefix = @_;

        return main::safe_make ($module, {
                target => 'install',
                message => "Installing g[$module]",
                'prefix-options' => [@cmdPrefix],
                subdirs => [ split(' ', $module->getOption("checkout-only")) ],
               }) == 0;
    }

    # Used to uninstall a previously installed module.
    # All options passed are prefixed to the eventual command to be run.
    # Returns boolean false if unable to uninstall, true otherwise.
    sub uninstallInternal
    {
        my $self = shift;
        my $module = $self->module();
        my @cmdPrefix = @_;

        return main::safe_make ($module, {
                target => 'uninstall',
                message => "Uninstalling g[$module]",
                'prefix-options' => [@cmdPrefix],
                subdirs => [ split(' ', $module->getOption("checkout-only")) ],
               }) == 0;
    }

    # Subroutine to clean the build system for the given module.  Works by
    # recursively deleting the directory and then recreating it.
    # Returns 0 for failure, non-zero for success.
    sub cleanBuildSystem
    {
        my $self = assert_isa(shift, 'GenericBuildSystem');
        my $module = $self->module();
        my $srcdir = $module->fullpath('source');
        my $builddir = $module->fullpath('build');

        if (pretending())
        {
            pretend ("\tWould have cleaned build system for g[$module]");
            return 1;
        }

        # Use an existing directory
        if (-e $builddir && $builddir ne $srcdir)
        {
            info ("\tRemoving files in build directory for g[$module]");

            # This variant of log_command runs the sub prune_under_directory($builddir)
            # in a forked child, so that we can log its output.
            if (log_command($module, 'clean-builddir', [ 'kdesrc-build', 'main::prune_under_directory', $builddir ]))
            {
                error (" r[b[*]\tFailed to clean build directory.  Verify the permissions are correct.");
                return 0; # False for this function.
            }

            # Let users know we're done so they don't wonder why rm -rf is taking so
            # long and oh yeah, why's my HD so active?...
            info ("\tOld build system cleaned, starting new build system.");
        }
        # or create the directory
        elsif (!super_mkdir ($builddir))
        {
            error ("\tUnable to create directory r[$builddir].");
            return 0;
        }

        return 1;
    }

    # Return convention: boolean
    sub createBuildSystem
    {
        my $self = assert_isa(shift, 'GenericBuildSystem');
        my $module = $self->module();
        my $builddir = $module->fullpath('build');

        if (! -e "$builddir" && !super_mkdir("$builddir"))
        {
            error ("\tUnable to create build directory for r[$module]!!");
            return 0;
        }

        return 1;
    }

    1;
}
# }}}

# package QMakeBuildSystem {{{
{
    package QMakeBuildSystem;

    our @ISA = ('GenericBuildSystem');

    ksb::Debug->import();
    ksb::Util->import();

    sub name
    {
        return 'qmake';
    }

    sub requiredPrograms
    {
        return qw{qmake};
    }

    # Returns the absolute path to 'qmake'. Note the actual executable name may
    # not necessarily be 'qmake' as some distributions rename it to allow for
    # co-installability with Qt 3 (and 5...)
    # If no suitable qmake can be found, undef is returned.
    # This is a "static class method" i.e. use QMakeBuildSystem::absPathToQMake()
    sub absPathToQMake
    {
        my @possibilities = qw/qmake qmake4 qmake-qt4 qmake-mac/;
        return grep { main::absPathToExecutable($_) } @possibilities;
    }

    # Return value style: boolean
    sub configureInternal
    {
        my $self = assert_isa(shift, 'QMakeBuildSystem');
        my $module = $self->module();
        my $builddir = $module->fullpath('build');
        my $sourcedir = $module->fullpath('source');
        my @projectFiles = glob("$sourcedir/*.pro");

        if (!@projectFiles || !$projectFiles[0]) {
            croak_internal("No *.pro files could be found for $module");
        }

        if (@projectFiles > 1) {
            error (" b[r[*] Too many possible *.pro files for $module");
            return 0;
        }

        p_chdir($builddir);

        my $qmake = absPathToQMake();
        return 0 unless $qmake;
        return log_command($module, 'qmake', [ $qmake, $projectFiles[0] ]) == 0;
    }

    1;
}
# }}}

# package l10nSystem {{{
{
    package l10nSystem;

    our @ISA = ('SvnUpdate', 'GenericBuildSystem');

    ksb::Debug->import();
    ksb::Util->import();

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

        # Ensure associated module updates from the proper svn path.
        # TODO: Support different localization branches?

        $module->setOption('module-base-path', 'trunk/l10n-kde4');
        return bless { module => $module, needsRefreshed => 1 }, $class;
    }

    sub module
    {
        my $self = shift;
        return $self->{module};
    }

    sub configuredModuleFileName
    {
        # Not quite correct (we should be looking at each individual language
        # but it at least keeps the process going.
        return 'teamnames';
    }

    # Sets the directories that are to be checked out/built/etc.
    # There should be one l10nSystem for the entire l10n build (i.e. add
    # all required support dirs and languages).
    sub setLanguageDirs
    {
        my ($self, @languageDirs) = @_;
        $self->{l10n_dirs} = \@languageDirs;
    }

    # Returns true if the given subdirectory (reference from the module's root source directory)
    # can be built or not. Should be reimplemented by subclasses as appropriate.
    sub isSubdirBuildable
    {
        my ($self, $subdir) = @_;
        return ($subdir ne 'scripts' && $subdir ne 'templates');
    }

    sub prefixEnvironmentVariable
    {
        return 'CMAKE_PREFIX_PATH';
    }

    # scm-specific update procedure.
    # May change the current directory as necessary.
    sub updateInternal
    {
        my $self = assert_isa(shift, 'UpdateHandler');
        my $module = $self->module();
        my $fullpath = $module->fullpath('source');
        my @dirs = @{$self->{l10n_dirs}};

        if (-e "$fullpath/.svn") {
            $self->check_module_validity();
            my $count = $self->update_module_path(@dirs);

            $self->{needsRefreshed} = 0 if $count == 0;
            return $count;
        }
        else {
            return $self->checkout_module_path(@dirs);
        }
    }

    sub name
    {
        return 'l10n';
    }

    # Returns a list of just the languages to install.
    sub languages
    {
        my $self = assert_isa(shift, 'l10nSystem');
        my @langs = @{$self->{l10n_dirs}};

        return grep { $self->isSubdirBuildable($_); } (@langs);
    }

    # Buildsystem support section

    sub needsRefreshed
    {
        my $self = shift;

        # Should be 1 except if no update happened.
        return $self->{needsRefreshed};
    }

    sub buildInternal
    {
        my $self = assert_isa(shift, 'l10nSystem');
        my $builddir = $self->module()->fullpath('build');
        my @langs = $self->languages();
        my $result = 0;

        $result = (main::safe_make($self->module(), {
            target => undef,
            message => "Building localization for language...",
            logbase => "build",
            subdirs => \@langs,
        }) == 0) || $result;

        return $result;
    }

    sub configureInternal
    {
        my $self = assert_isa(shift, 'l10nSystem');

        my $builddir = $self->module()->fullpath('build');
        my @langs = $self->languages();
        my $result = 0;

        for my $lang (@langs) {
            my $prefix = $self->module()->installationPath();
            p_chdir("$builddir/$lang");

            info ("\tConfiguring to build language $lang");
            $result = (log_command($self->module(), "cmake-$lang",
                ['cmake', '-DCMAKE_INSTALL_PREFIX=' . $prefix]) == 0) || $result;
        }

        return $result;
    }

    sub installInternal
    {
        my $self = assert_isa(shift, 'l10nSystem');
        my $builddir = $self->module()->fullpath('build');
        my @langs = $self->languages();

        return (main::safe_make($self->module(), {
            target => 'install',
            message => "Installing language...",
            logbase => "install",
            subdirs => \@langs,
        }) == 0);
    }

    # Subroutine to link a source directory into an alternate directory in
    # order to fake srcdir != builddir for modules that don't natively support
    # it.  The first parameter is the module to prepare.
    #
    # The return value is true (non-zero) if it succeeded, and 0 (false) if it
    # failed.
    #
    # On return from the subroutine the current directory will be in the build
    # directory, since that's the only directory you should touch from then on.
    sub prepareFakeBuilddir
    {
        my $self = assert_isa(shift, 'l10nSystem');
        my $module = $self->module();
        my $builddir = $module->fullpath('build');
        my $srcdir = $module->fullpath('source');

        # List reference, not a real list.  The initial kdesrc-build does *NOT*
        # fork another kdesrc-build using exec, see sub log_command() for more
        # info.
        my $args = [ 'kdesrc-build', 'main::safe_lndir', $srcdir, $builddir ];

        info ("\tSetting up alternate build directory for l10n");
        return (0 == log_command ($module, 'create-builddir', $args));
    }

    # Subroutine to create the build system for a module.  This involves making
    # sure the directory exists and then running any preparatory steps (like
    # for l10n modules).  This subroutine assumes that the module is already
    # downloaded.
    #
    # Return convention: boolean (inherited)
    sub createBuildSystem
    {
        my $self = assert_isa(shift, 'l10nSystem');
        my $module = $self->module();
        my $builddir = $module->fullpath('build');

        # l10n doesn't support srcdir != builddir, fake it.
        whisper ("\tFaking builddir for g[$module]");
        if (!$self->prepareFakeBuilddir())
        {
            error ("Error creating r[$module] build system!");
            return 0;
        }

        p_chdir ($builddir);

        my @langs = @{$self->{l10n_dirs}};
        @langs = grep { $self->isSubdirBuildable($_) } (@langs);

        foreach my $lang (@langs) {
            my $cmd_ref = [ './scripts/autogen.sh', $lang ];
            if (log_command ($module, "build-system-$lang", $cmd_ref))
            {
                error ("\tUnable to create build system for r[$module]");
            }
        }

        $module->setOption('#reconfigure', 1); # Force reconfigure of the module

        return 1;
    }

    1;
}
# }}}

# package KDEBuildSystem {{{
{
    package KDEBuildSystem;

    ksb::Debug->import();
    ksb::Util->import();

    our @ISA = ('GenericBuildSystem');

    sub needsInstalled
    {
        my $self = shift;

        return 0 if $self->name() eq 'kde-common'; # Vestigial
        return 1;
    }

    sub name
    {
        return 'KDE';
    }

    sub isProgressOutputSupported
    {
        return 1;
    }

    sub prefixEnvironmentVariable
    {
        return 'CMAKE_PREFIX_PATH';
    }

    sub requiredPrograms
    {
        return qw{cmake qmake};
    }

    sub runTestsuite
    {
        my $self = assert_isa(shift, 'KDEBuildSystem');
        my $module = $self->module();

        # Note that we do not run safe_make, which should really be called
        # safe_compile at this point.

        # Step 1: Ensure the tests are built, oh wait we already did that when we ran
        # CMake :)

        my $make_target = 'test';
        if ($module->getOption('run-tests') eq 'upload') {
            $make_target = 'Experimental';
        }

        info ("\tRunning test suite...");

        # Step 2: Run the tests.
        my $numTests = -1;
        my $countCallback = sub {
            if ($_ && /([0-9]+) tests failed out of/) {
                $numTests = $1;
            }
        };

        my $result = log_command($module, 'test-results',
                                 [ 'make', $make_target ],
                                 { callback => $countCallback, no_translate => 1});

        if ($result != 0) {
            if ($numTests > 0) {
                warning ("\t$numTests tests failed for y[$module], consult latest/$module/test-results.log for info");
            }
            else {
                warning ("\tSome tests failed for y[$module], consult latest/$module/test-results.log for info");
            }

            return 0;
        }
        else {
            info ("\tAll tests ran successfully.");
        }

        return 1;
    }

    sub configureInternal
    {
        my $self = assert_isa(shift, 'KDEBuildSystem');
        my $module = $self->module();

        # Use cmake to create the build directory (sh script return value
        # semantics).
        if (main::safe_run_cmake ($module))
        {
            error ("\tUnable to configure r[$module] with CMake!");
            return 0;
        }

        return 1;
    }

    1;
}
# }}}

# package QtBuildSystem {{{
{
    package QtBuildSystem;

    ksb::Debug->import();
    ksb::Util->import();

    our @ISA = ('GenericBuildSystem');

    sub needsInstalled
    {
        my $self = assert_isa(shift, 'QtBuildSystem');
        my $module = $self->module();
        return $module->getOption('qtdir') ne $module->fullpath('build');
    }

    sub name
    {
        return 'Qt';
    }

    # If coming from gitorious.org instead of KDE's mirror we should force on
    # progress output to work around a gitorious.org clone bug.
    sub forceProgressOutput
    {
        my $self = assert_isa(shift, 'QtBuildSystem');
        my $module = $self->module();

        return $module->getOption('repository') =~ /gitorious\.org\//;
    }

    # Return value style: boolean
    sub configureInternal
    {
        my $self = assert_isa(shift, 'QtBuildSystem');
        my $module = $self->module();
        my $srcdir = $module->fullpath('source');
        my $script = "$srcdir/configure";

        if (! -e $script && !pretending())
        {
            error ("\tMissing configure script for r[b[$module]");
            return 0;
        }

        my @commands = split (/\s+/, $module->getOption('configure-flags'));
        push @commands, '-confirm-license', '-opensource';

        # Get the user's CXXFLAGS
        my $cxxflags = $module->getOption('cxxflags');
        $module->buildContext()->queueEnvironmentVariable('CXXFLAGS', $cxxflags);

        my $prefix = $module->getOption('qtdir');

        # Some users have added -prefix manually to their flags, they
        # probably shouldn't anymore. :)

        if (scalar grep /^-prefix(=.*)?$/, @commands)
        {
            warning (<<EOF);
b[y[*]
b[y[*] You have the y[-prefix] option selected in your $module configure flags.
b[y[*] kdesrc-build will correctly add the -prefix option to match your Qt
b[y[*] directory setting, so you do not need to use -prefix yourself.
b[y[*]
EOF
        }

        push @commands, "-prefix", $prefix;
        unshift @commands, $script;

        my $builddir = $module->fullpath('build');
        my $old_flags = $module->getPersistentOption('last-configure-flags') || '';
        my $cur_flags = main::get_list_digest(@commands);

        if(($cur_flags ne $old_flags) ||
           ($module->getOption('reconfigure')) ||
           (! -e "$builddir/Makefile")
          )
        {
            note ("\tb[r[LGPL license selected for Qt].  See $srcdir/LICENSE.LGPL");

            info ("\tRunning g[configure]...");

            $module->setPersistentOption('last-configure-flags', $cur_flags);
            return log_command($module, "configure", \@commands) == 0;
        }

        # Skip execution of configure.
        return 1;
    }

    1;
}
# }}}

# package Module {{{
{
    package Module;

    use Storable 'dclone';
    use Carp 'confess';
    use Scalar::Util 'blessed';
    use overload
        '""' => 'toString', # Add stringify operator.
        '<=>' => 'compare',
        ;

    ksb::Debug->import();
    ksb::Util->import();

    # We will 'mixin' various backend-specific classes, e.g. GitUpdate or SvnUpdate
    our @ISA = qw/GenericBuildSystem/;

    my $ModuleSource = 'config';

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

        confess "Empty Module constructed" unless $name;

        # If building a BuildContext instead of a Module, then the context
        # can't have been setup yet...
        my $contextClass = 'ksb::BuildContext';
        if ($class ne $contextClass &&
            (!blessed($ctx) || !$ctx->isa($contextClass)))
        {
            confess "Invalid context $ctx";
        }

        # Clone the passed-in phases so we can be different.
        my $phases = dclone($ctx->phases()) if $class eq 'Module';

        # Use a sub-hash of the context's build options so that all
        # global/module options are still in the same spot. The options might
        # already be set by read_options, but in case they're not we assign { }
        # if not already defined.
        $ctx->{build_options}{$name} //= { };

        my $module = {
            name         => $name,
            scm_obj      => undef,
            build_obj    => undef,
            phases       => $phases,
            context      => $ctx,
            options      => $ctx->{build_options}{$name},
            'module-set' => undef,
        };

        return bless $module, $class;
    }

    sub phases
    {
        my $self = shift;
        return $self->{phases};
    }

    sub moduleSet
    {
        my ($self) = @_;
        return $self->{'module-set'} if exists $self->{'module-set'};
        return '';
    }

    sub setModuleSet
    {
        my ($self, $moduleSetName) = @_;
        $self->{'module-set'} = $moduleSetName;
    }

    sub setModuleSource
    {
        my ($class, $source) = @_;
        $ModuleSource = $source;
    }

    sub moduleSource
    {
        my $class = shift;
        # Should be 'config' or 'cmdline';
        return $ModuleSource;
    }

    # Subroutine to retrieve a subdirectory path with tilde-expansion and
    # relative path handling.
    # The parameter is the option key (e.g. build-dir or log-dir) to read and
    # interpret.
    sub getSubdirPath
    {
        my ($self, $subdirOption) = @_;
        my $dir = $self->getOption($subdirOption);

        # If build-dir starts with a slash, it is an absolute path.
        return $dir if $dir =~ /^\//;

        # Make sure we got a valid option result.
        if (!$dir) {
            confess ("Reading option for $subdirOption gave empty \$dir!");
        }

        # If it starts with a tilde, expand it out.
        if ($dir =~ /^~/)
        {
            $dir =~ s/^~/$ENV{'HOME'}/;
        }
        else
        {
            # Relative directory, tack it on to the end of $kdesrcdir.
            my $kdesrcdir = $self->getOption('source-dir');
            $dir = "$kdesrcdir/$dir";
        }

        return $dir;
    }

    # Do note that this returns the *base* path to the source directory,
    # without the module name or kde_projects stuff appended. If you want that
    # use subroutine fullpath().
    sub getSourceDir
    {
        my $self = shift;
        return $self->getSubdirPath('source-dir');
    }

    sub name
    {
        my $self = shift;
        return $self->{name};
    }

    sub scm
    {
        my $self = shift;

        return $self->{scm_obj} if $self->{scm_obj};

        # Look for specific setting of repository and svn-server. If both is
        # set it's a bug, if one is set, that's the type (because the user says
        # so...). Don't use getOption($key) as it will try to fallback to
        # global options.

        my $svn_status = $self->getOption('svn-server', 'module');
        my $repository = $self->getOption('repository', 'module') // '';
        my $rcfile = $self->buildContext()->rcFile();

        if ($svn_status && $repository) {
            error (<<EOF);
You have specified both y[b[svn-server] and y[b[repository] options for the
b[$self] module in $rcfile.

You should only specify one or the other -- a module cannot be both types
 - svn-server uses Subversion.
 - repository uses git.
EOF
            die (make_exception('Config', 'svn-server and repository both set'));
        }

        # Overload repository to allow bzr URLs?
        if ($repository =~ /^bzr:\/\//) {
            $self->{scm_obj} = BzrUpdate->new($self);
        }

        # If it needs a repo it's git. Everything else is svn for now.
        $self->{scm_obj} //=
            $repository
                ? GitUpdate->new($self)
                : SvnUpdate->new($self);

        return $self->{scm_obj};
    }

    sub setScmType
    {
        my ($self, $scmType) = @_;

        my $newType;

        given($scmType) {
            when('git')  { $newType = GitUpdate->new($self); }
            when('proj') { $newType = KDEProjectUpdate->new($self); }
            when('metadata') { $newType = KDEProjectMetadataUpdate->new($self); }
            when('l10n') { $newType = l10nSystem->new($self); }
            when('svn')  { $newType = SvnUpdate->new($self); }
            when('bzr')  { $newType = BzrUpdate->new($self); }
            default      { $newType = undef; }
        }

        $self->{scm_obj} = $newType;
    }

    # Returns a string describing the scm platform of the given module.
    # Return value: 'git' or 'svn' at this point, as appropriate.
    sub scmType
    {
        my $self = shift;
        return $self->scm()->name();
    }

    sub currentScmRevision
    {
        my $self = shift;

        return $self->scm()->currentRevisionInternal();
    }

    sub buildSystem
    {
        my $self = shift;

        if ($self->{build_obj} && $self->{build_obj}->name() ne 'generic') {
            return $self->{build_obj};
        }

        # If not set, let's guess.
        my $buildType;
        my $sourceDir = $self->fullpath('source');

        if (($self->getOption('repository') =~ /gitorious\.org\/qt\//) ||
            ($self->getOption('repository') =~ /^kde:qt$/) ||
            (-e "$sourceDir/bin/syncqt"))
        {
            $buildType = QtBuildSystem->new($self);
        }

        if (!$buildType && (-e "$sourceDir/CMakeLists.txt" ||
                $self->getOption('#xml-full-path')))
        {
            $buildType = KDEBuildSystem->new($self);
        }

        if (!$buildType && (glob ("$sourceDir/*.pro"))) {
            $buildType = QMakeBuildSystem->new($self);
        }

        # 'configure' is a popular fall-back option even for other build
        # systems so ensure we check last for autotools.
        if (!$buildType &&
            (-e "$sourceDir/configure" || -e "$sourceDir/autogen.sh"))
        {
            croak_internal('The autotools build system is unsupported');
        }

        # Don't just assume the build system is KDE-based...
        $buildType //= GenericBuildSystem->new($self);

        $self->{build_obj} = $buildType;

        return $self->{build_obj};
    }

    # Sets the build system **object**, although you can find the build system
    # type afterwards (see buildSystemType).
    sub setBuildSystem
    {
        my ($self, $obj) = @_;

        assert_isa($obj, 'GenericBuildSystem');
        $self->{build_obj} = $obj;
    }

    # Current possible build system types:
    # KDE (i.e. cmake), Qt, l10n (KDE language buildsystem), autotools (either
    # configure or autogen.sh). A final possibility is 'pendingSource' which
    # simply means that we don't know yet.
    #
    # If the build system type is not set ('pendingSource' counts as being
    # set!) when this function is called then it will be autodetected if
    # possible, but note that not all possible types will be detected this way.
    # If in doubt use setBuildSystemType
    sub buildSystemType
    {
        my $self = shift;
        return $self->buildSystem()->name();
    }

    # Subroutine to build this module.
    # Returns boolean false on failure, boolean true on success.
    sub build
    {
        my $self = assert_isa(shift, 'Module');
        my $moduleName = $self->name();
        my $builddir = $self->fullpath('build');
        my $start_time = time;
        my $buildSystem = $self->buildSystem();

        if ($buildSystem->name() eq 'generic' && !pretending()) {
            error ("\tr[b[$self] does not seem to have a build system to use.");
            return 0;
        }

        return 0 if !$self->setupBuildSystem();
        return 1 if $self->getOption('build-system-only');

        if (!$buildSystem->buildInternal())
        {
            # Build failed

            my $elapsed = prettify_seconds (time - $start_time);

            # Well we tried, but it isn't going to happen.
            note ("\n\tUnable to build y[$self]!");
            info ("\tTook g[$elapsed].");
            return 0;
        }
        else
        {
            my $elapsed = prettify_seconds (time - $start_time);
            info ("\tBuild succeeded after g[$elapsed].");

            # TODO: This should be a simple phase to run.
            if ($self->getOption('run-tests'))
            {
                $self->buildSystem()->runTestsuite();
            }

            # TODO: Likewise this should be a phase to run.
            if ($self->getOption('install-after-build'))
            {
                my $ctx = $self->buildContext();
                main::handle_install($ctx, $self);
            }
            else
            {
                info ("\tSkipping install for y[$self]");
            }
        }

        return 1;
    }

    # Subroutine to setup the build system in a directory.
    # Returns boolean true on success, boolean false (0) on failure.
    sub setupBuildSystem
    {
        my $self = assert_isa(shift, 'Module');
        my $moduleName = $self->name();

        my $buildSystem = $self->buildSystem();

        if ($buildSystem->name() eq 'generic' && !pretending()) {
            croak_internal('Build system determination still pending when build attempted.');
        }

        if ($buildSystem->needsRefreshed())
        {
            # The build system needs created, either because it doesn't exist, or
            # because the user has asked that it be completely rebuilt.
            info ("\tPreparing build system for y[$self].");

            # Check to see if we're actually supposed to go through the
            # cleaning process.
            if (!$self->getOption('#cancel-clean') &&
                !$buildSystem->cleanBuildSystem())
            {
                warning ("\tUnable to clean r[$self]!");
                return 0;
            }
        }

        if (!$buildSystem->createBuildSystem()) {
            error ("\tError creating r[$self]'s build system!");
            return 0;
        }

        # Now we're in the checkout directory
        # So, switch to the build dir.
        # builddir is automatically set to the right value for qt
        p_chdir ($self->fullpath('build'));

        if (!$buildSystem->configureInternal()) {
            error ("\tUnable to configure r[$self] with " . $self->buildSystemType());
            return 0;
        }

        return 1;
    }

    # Responsible for installing the module (no update, build, etc.)
    # Return value: Boolean flag indicating whether module installed successfully or
    # not.
    # Exceptions may be thrown for abnormal conditions (e.g. no build dir exists)
    sub install
    {
        my $self = assert_isa(shift, 'Module');
        my $builddir = $self->fullpath('build');
        my $buildSysFile = $self->buildSystem()->configuredModuleFileName();

        if (!pretending() && ! -e "$builddir/$buildSysFile")
        {
            warning ("\tThe build system doesn't exist for r[$self].");
            warning ("\tTherefore, we can't install it. y[:-(].");
            return 0;
        }

        $self->setupEnvironment();

        my @makeInstallOpts = split(' ', $self->getOption('make-install-prefix'));

        # We can optionally uninstall prior to installing
        # to weed out old unused files.
        if ($self->getOption('use-clean-install') &&
            $self->getPersistentOption('last-install-rev'))
        {
            if (!$self->buildSystem()->uninstallInternal(@makeInstallOpts)) {
                warning ("\tUnable to uninstall r[$self] before installing the new build.");
                warning ("\tContinuing anyways...");
            }
            else {
                $self->unsetPersistentOption('last-install-rev');
            }
        }

        if (!$self->buildSystem()->installInternal(@makeInstallOpts))
        {
            error ("\tUnable to install r[$self]!");
            $self->buildContext()->markModulePhaseFailed('install', $self);
            return 0;
        }

        if (pretending())
        {
            pretend ("\tWould have installed g[$self]");
            return 1;
        }

        # Past this point we know we've successfully installed, for real.

        $self->setPersistentOption('last-install-rev', $self->currentScmRevision());

        my $remove_setting = $self->getOption('remove-after-install');

        # Possibly remove the srcdir and builddir after install for users with
        # a little bit of HD space.
        if($remove_setting eq 'all')
        {
            # Remove srcdir
            my $srcdir = $self->fullpath('source');
            note ("\tRemoving b[r[$self source].");
            main::safe_rmtree($srcdir);
        }

        if($remove_setting eq 'builddir' || $remove_setting eq 'all')
        {
            # Remove builddir
            note ("\tRemoving b[r[$self build directory].");
            main::safe_rmtree($builddir);
        }

        return 1;
    }

    # Handles uninstalling this module (or its sub-directories as given by the checkout-only
    # option).
    #
    # Returns boolean false on failure, boolean true otherwise.
    sub uninstall
    {
        my $self = assert_isa(shift, 'Module');
        my $builddir = $self->fullpath('build');
        my $buildSysFile = $self->buildSystem()->configuredModuleFileName();

        if (!pretending() && ! -e "$builddir/$buildSysFile")
        {
            warning ("\tThe build system doesn't exist for r[$self].");
            warning ("\tTherefore, we can't uninstall it.");
            return 0;
        }

        $self->setupEnvironment();

        my @makeInstallOpts = split(' ', $self->getOption('make-install-prefix'));

        if (!$self->buildSystem()->uninstallInternal(@makeInstallOpts))
        {
            error ("\tUnable to uninstall r[$self]!");
            $self->buildContext()->markModulePhaseFailed('install', $self);
            return 0;
        }

        if (pretending())
        {
            pretend ("\tWould have uninstalled g[$self]");
            return 1;
        }

        $self->unsetPersistentOption('last-install-rev');
        return 1;
    }

    sub buildContext
    {
        my $self = shift;
        return $self->{context};
    }

    # Integrates 'set-env' option to the build context environment
    sub applyUserEnvironment
    {
        my $self = assert_isa(shift, 'Module');
        my $ctx = $self->buildContext();

        # Let's see if the user has set env vars to be set.
        # Note the global set-env must be checked separately anyways, so
        # we limit inheritance when searching.
        my $env_hash_ref = $self->getOption('set-env', 'module');

        while (my ($key, $value) = each %{$env_hash_ref})
        {
            $ctx->queueEnvironmentVariable($key, $value);
        }
    }

    # Establishes proper build environment in the build context. Should be run
    # before forking off commands for e.g. updates, builds, installs, etc.
    sub setupEnvironment
    {
        my $self = assert_isa(shift, 'Module');
        my $ctx = $self->buildContext();
        my $kdedir = $self->getOption('kdedir');
        my $qtdir = $self->getOption('qtdir');
        my $prefix = $self->installationPath();

        # Add global set-envs
        $self->buildContext()->applyUserEnvironment();

        # Add some standard directories for pkg-config support.  Include env settings.
        my @pkg_config_dirs = ("$kdedir/lib/pkgconfig", "$qtdir/lib/pkgconfig");
        $ctx->prependEnvironmentValue('PKG_CONFIG_PATH', @pkg_config_dirs);

        # Likewise, add standard directories that should be in LD_LIBRARY_PATH.
        my @ld_dirs = ("$kdedir/lib", "$qtdir/lib", $self->getOption('libpath'));
        $ctx->prependEnvironmentValue('LD_LIBRARY_PATH', @ld_dirs);

        my @path = ("$kdedir/bin", "$qtdir/bin", $self->getOption('binpath'));

        if (my $prefixEnvVar = $self->buildSystem()->prefixEnvironmentVariable())
        {
            $ctx->prependEnvironmentValue($prefixEnvVar, $prefix);
        }

        $ctx->prependEnvironmentValue('PATH', @path);

        # Set up the children's environment.  We use queueEnvironmentVariable since
        # it won't set an environment variable to nothing.  (e.g, setting QTDIR to
        # a blank string might confuse Qt or KDE.

        $ctx->queueEnvironmentVariable('QTDIR', $qtdir);

        # If the module isn't kdelibs, also append kdelibs's KDEDIR setting.
        if ($self->name() ne 'kdelibs')
        {
            my $kdelibsModule = $ctx->lookupModule('kdelibs');
            my $kdelibsDir;
            $kdelibsDir = $kdelibsModule->installationPath() if $kdelibsModule;

            if ($kdelibsDir && $kdelibsDir ne $kdedir) {
                whisper ("Module $self uses different KDEDIR than kdelibs, including kdelibs as well.");
                $kdedir .= ":$kdelibsDir"
            }
        }

        $ctx->queueEnvironmentVariable('KDEDIRS', $kdedir);

        # Read in user environment defines
        $self->applyUserEnvironment() unless $self->name() eq 'global';
    }

    # Returns the path to the log directory used during this run for this
    # Module.
    #
    # In addition it handles the 'latest' symlink to allow for ease of access
    # to the log directory afterwards.
    sub getLogDir
    {
        my ($self) = @_;
        return $self->buildContext()->getLogDirFor($self);
    }

    sub toString
    {
        my $self = shift;
        return $self->name();
    }

    sub compare
    {
        my ($self, $other) = @_;
        return $self->name() cmp $other->name();
    }

    sub update
    {
        my ($self, $ipc, $ctx) = @_;

        my $moduleName = $self->name();
        my $module_src_dir = $self->getSourceDir();
        my $kdesrc = $ctx->getSourceDir();

        if ($kdesrc ne $module_src_dir)
        {
            # This module has a different source directory, ensure it exists.
            if (!main::super_mkdir($module_src_dir))
            {
                error ("Unable to create separate source directory for r[$self]: $module_src_dir");
                $ipc->sendIPCMessage(IPC::MODULE_FAILURE, $moduleName);
                next;
            }
        }

        my $fullpath = $self->fullpath('source');
        my $count;
        my $returnValue;

        eval { $count = $self->scm()->updateInternal() };

        if ($@)
        {
            if (ref $@ && $@->isa('BuildException')) {
                $@ = $@->{'message'};
            }

            error ("Error updating r[$self], removing from list of packages to build.");
            error (" > y[$@]");

            my $reason = $self->getOption('#update-error');
            $reason = IPC::MODULE_FAILURE unless $reason; # Default error code
            main::dont_build ($self, $ipc, $reason); # Sends IPC message.
            $returnValue = 0;
        }
        else
        {
            my $message;
            if (not defined $count)
            {
                $message = ksb_clr ("b[y[Unknown changes].");
                $ipc->notifyUpdateSuccess($moduleName, $message);
            }
            elsif ($count)
            {
                $message = "1 file affected." if $count == 1;
                $message = "$count files affected." if $count != 1;
                $ipc->notifyUpdateSuccess($moduleName, $message);
            }
            else
            {
                whisper ("This module will not be built. Nothing updated.");
                $message = "0 files affected.";
                main::dont_build($self, $ipc, IPC::MODULE_UPTODATE); # Sends IPC message.
            }

            # We doing e.g. --src-only, the build phase that normally outputs
            # number of files updated doesn't get run, so manually mention it
            # here.
            if (!$ipc->supportsConcurrency()) {
                info ("\t$self update complete, $message");
            }

            $returnValue = 1;
        }

        info (""); # Print empty line.
        return $returnValue;
    }

    # This subroutine returns an option value for a given module.  Some globals
    # can't be overridden by a module's choice (but see 2nd parameter below).
    # If so, the module's choice will be ignored, and a warning will be issued.
    #
    # Option names are case-sensitive!
    #
    # Some options (e.g. cmake-options, configure-flags) have the global value
    # and then the module's own value appended together. To get the actual
    # module setting you must use the level limit parameter set to 'module'.
    #
    # Likewise, some qt module options do not obey the previous proviso since
    # Qt options are not likely to agree nicely with generic KDE buildsystem
    # options.
    #
    # 1st parameter: Name of option
    # 2nd parameter: Level limit (optional). If not present, then the value
    # 'allow-inherit' is used. Options:
    #   - allow-inherit: Module is used if present (with exceptions), otherwise
    #     global is used.
    #   - module: Only module is used (if you want only global then use the
    #     buildContext) NOTE: This overrides global "sticky" options as well!
    sub getOption
    {
        my ($self, $key, $levelLimit) = @_;
        my $ctx = $self->buildContext();
        assert_isa($ctx, 'ksb::BuildContext');
        $levelLimit //= 'allow-inherit';

        # Some global options would probably make no sense applied to Qt.
        my @qtCopyOverrides = qw(branch configure-flags tag cxxflags);
        if (list_has(\@qtCopyOverrides, $key) && $self->buildSystemType() eq 'Qt') {
            $levelLimit = 'module';
        }

        assert_in($levelLimit, [qw(allow-inherit module)]);

        # If module-only, check that first.
        return $self->{options}{$key} if $levelLimit eq 'module';

        # Some global options always override module options.
        return $ctx->getOption($key) if $ctx->hasStickyOption($key);

        # Some options append to the global (e.g. conf flags)
        my @confFlags = qw(cmake-options configure-flags cxxflags);
        if (list_has(\@confFlags, $key) && $ctx->hasOption($key)) {
            return $ctx->getOption($key) . " " . ($self->{options}{$key} || '');
        }

        # Everything else overrides the global option, unless it's simply not
        # set at all.
        return $self->{options}{$key} // $ctx->getOption($key);
    }

    # Returns true if (and only if) the given option key value is set as an
    # option for this module, even if the corresponding value is empty or
    # undefined. In other words it is a way to see if the name of the key is
    # recognized in some fashion.
    #
    # First parameter: Key to lookup.
    # Returns: True if the option is set, false otherwise.
    sub hasOption
    {
        my ($self, $key) = @_;
        my $name = $self->name();

        return exists $self->{options}{$key};
    }

    # Sets the option refered to by the first parameter (a string) to the
    # scalar (e.g. references are OK too) value given as the second paramter.
    sub setOption
    {
        my ($self, %options) = @_;
        while (my ($key, $value) = each %options) {
            # ref($value) checks if value is already a reference (i.e. a hashref)
            # which means we should just copy it over, as all handle_set_env does
            # is convert the string to the right hashref.
            if (!ref($value) && main::handle_set_env($self->{options}, $key, $value))
            {
                return
            }

            debug ("  Setting $self,$key = $value");
            $self->{options}{$key} = $value;
        }
    }

    # Simply removes the given option and its value, if present
    sub deleteOption
    {
        my ($self, $key) = @_;
        delete $self->{options}{$key} if exists $self->{options}{$key};
    }

    # Gets persistent options set for this module. First parameter is the name
    # of the option to lookup. Undef is returned if the option is not set,
    # although even if the option is set, the value returned might be empty.
    # Note that ksb::BuildContext also has this function, with a slightly
    # different signature, which OVERRIDEs this function since Perl does not
    # have parameter-based method overloading.
    sub getPersistentOption
    {
        my ($self, $key) = @_;
        return $self->buildContext()->getPersistentOption($self->name(), $key);
    }

    # Sets a persistent option (i.e. survives between processes) for this module.
    # First parameter is the name of the persistent option.
    # Second parameter is its actual value.
    # See the warning for getPersistentOption above, it also applies for this
    # method vs. ksb::BuildContext::setPersistentOption
    sub setPersistentOption
    {
        my ($self, $key, $value) = @_;
        return $self->buildContext()->setPersistentOption($self->name(), $key, $value);
    }

    # Unsets a persistent option for this module.
    # Only parameter is the name of the option to unset.
    sub unsetPersistentOption
    {
        my ($self, $key) = @_;
        $self->buildContext()->unsetPersistentOption($self->name(), $key);
    }

    # Clones the options from the given Module (as handled by
    # hasOption/setOption/getOption). Options on this module will then be able
    # to be set independently from the other module.
    sub cloneOptionsFrom
    {
        my $self = shift;
        my $other = assert_isa(shift, 'Module');

        $self->{options} = dclone($other->{options});
    }

    # Returns the path to the desired directory type (source or build),
    # including the module destination directory itself.
    sub fullpath
    {
        my ($self, $type) = @_;
        assert_in($type, [qw/build source/]);

        my %pathinfo = main::get_module_path_dir($self, $type);
        return $pathinfo{'fullpath'};
    }

    # Subroutine to return the name of the destination directory for the
    # checkout and build routines.  Based on the dest-dir option.  The return
    # value will be relative to the src/build dir.  The user may use the
    # '$MODULE' or '${MODULE}' sequences, which will be replaced by the name of
    # the module in question.
    #
    # The first parameter is optional, but if provided will be used as the base
    # path to replace $MODULE entries in dest-dir.
    sub destDir
    {
        my $self = assert_isa(shift, 'Module');
        my $destDir = $self->getOption('dest-dir');
        my $basePath = shift // $self->getOption('#xml-full-path');
        $basePath ||= $self->name(); # Default if not provided in XML

        $destDir =~ s/(\${MODULE})|(\$MODULE\b)/$basePath/g;

        return $destDir;
    }

    # Subroutine to return the installation path of a given module (the value
    # that is passed to the CMAKE_INSTALL_PREFIX CMake option).
    # It is based on the "prefix" and, if it is not set, the "kdedir" option.
    # The user may use '$MODULE' or '${MODULE}' in the "prefix" option to have
    # them replaced by the name of the module in question.
    sub installationPath
    {
        my $self = assert_isa(shift, 'Module');
        my $path = $self->getOption('prefix');

        if (!$path)
        {
            return $self->getOption('kdedir');
        }

        my $moduleName = $self->name();
        $path =~ s/(\${MODULE})|(\$MODULE\b)/$moduleName/g;

        return $path;
    }


    1;
}
# }}}

# package RecursiveFH {{{
{
    package RecursiveFH;

    # Alias the global make_exception into this package.
    *make_exception = *main::make_exception;

    sub new
    {
        my ($class) = @_;
        my $data = {
            'filehandles' => [],    # Stack of filehandles to read
            'current'     => undef, # Current filehandle to read
        };

        return bless($data, $class);
    }

    sub addFilehandle
    {
        my ($self, $fh) = @_;
        push @{$self->{filehandles}}, $fh;
        $self->setCurrentFilehandle($fh);
    }

    sub popFilehandle
    {
        my $self = shift;
        my $result = pop @{$self->{filehandles}};
        my $newFh = scalar @{$self->{filehandles}} ? ${$self->{filehandles}}[-1]
                                                   : undef;
        $self->setCurrentFilehandle($newFh);
        return $result;
    }

    sub currentFilehandle
    {
        my $self = shift;
        return $self->{current};
    }

    sub setCurrentFilehandle
    {
        my $self = shift;
        $self->{current} = shift;
    }

    # Reads the next line of input and returns it.
    # If a line of the form "include foo" is read, this function automatically
    # opens the given file and starts reading from it instead. The original
    # file is not read again until the entire included file has been read. This
    # works recursively as necessary.
    #
    # No further modification is performed to returned lines.
    #
    # undef is returned on end-of-file (but only of the initial filehandle, not
    # included files from there)
    sub readLine
    {
        my $self = shift;

        # Starts a loop so we can use evil things like "redo"
        READLINE: {
            my $line;
            my $fh = $self->currentFilehandle();

            # Sanity check since different methods might try to read same file reader
            return undef unless defined $fh;

            if (eof($fh) || !defined($line = <$fh>)) {
                my $oldFh = $self->popFilehandle();
                close $oldFh;

                my $fh = $self->currentFilehandle();

                return undef if !defined($fh);

                redo READLINE;
            }
            elsif ($line =~ /^\s*include\s+\S/) {
                # Include found, extract file name and open file.
                chomp $line;
                my ($filename) = ($line =~ /^\s*include\s+(.+)$/);

                if (!$filename) {
                    die make_exception('Config',
                        "Unable to handle file include on line $., '$line'");
                }

                my $newFh;
                $filename =~ s/^~\//$ENV{HOME}\//; # Tilde-expand

                open ($newFh, '<', $filename) or
                    die make_exception('Config',
                        "Unable to open file $filename which was included from line $.");

                $self->addFilehandle($newFh);

                redo READLINE;
            }
            else {
                return $line;
            }
        }
    }

    1;
}
# }}}

# package DependencyResolver {{{
{
    package DependencyResolver;

    # This module handles resolving dependencies between modules. Each "module"
    # from the perspective of this resolver is simply a module full name, as
    # given by the KDE Project database.  (e.g. extragear/utils/kdesrc-build)

    ksb::Debug->import();
    ksb::Util->import();

    sub new
    {
        my $class = shift;

        my $self = {
            # hash table mapping full module names (m) to a list reference
            # containing the full module names of modules that depend on m.
            dependenciesOf  => { },
        };

        return bless $self, $class;
    }

    # Reads in dependency data in a psuedo-Makefile format.
    # See kde-build-metadata/dependency-data.
    #
    # Object method.
    # First parameter is the filehandle to read from.
    sub readDependencyData
    {
        my $self = assert_isa(shift, 'DependencyResolver');
        my $fh = shift;

        my $dependenciesOfRef  = $self->{dependenciesOf};
        my $dependencyAtom =
            qr/
            ^\s*      # Clear leading whitespace
            ([^:\s]+) # Capture anything not a colon or whitespace (dependent item)
            \s*       # Clear whitespace we didn't capture
            :
            \s*
            ([^\s]+)  # Capture all non-whitespace (source item)
            \s*$      # Ensure no trailing cruft. Any whitespace should end line
            /x;       # /x Enables extended whitespace mode

        while(my $line = <$fh>) {
            # Strip comments, skip empty lines.
            $line =~ s{#.*$}{};
            next if $line =~ /^\s*$/;

            if ($line !~ $dependencyAtom) {
                croak_internal("Invalid line $line when reading dependency data.");
            }

            my ($dependentItem, $sourceItem) = $line =~ $dependencyAtom;

            # Initialize with array if not already defined.
            $dependenciesOfRef->{$dependentItem} //= [ ];

            push @{$dependenciesOfRef->{$dependentItem}}, $sourceItem;
        }
    }

    # Internal.
    # This method is used to topographically sort dependency data. It accepts
    # a Module, ensures that any KDE Projects it depends on are already on the
    # build list, and then adds the Module to the build list (whether it is
    # a KDE Project or not, to preserve ordering).
    #
    # Static method.
    # First parameter: Reference to a hash of parameters.
    # Second parameter: Module to "visit". Does not have to be a KDE Project.
    # Return: Nothing.
    sub _visitModuleAndDependencies
    {
        my ($optionsRef, $module) = @_;
        assert_isa($module, 'Module');

        my $visitedItemsRef     = $optionsRef->{visitedItems};
        my $properBuildOrderRef = $optionsRef->{properBuildOrder};
        my $dependenciesOfRef   = $optionsRef->{dependenciesOf};
        my $modulesFromNameRef  = $optionsRef->{modulesFromName};

        my $item = $module->getOption('#xml-full-path');

        if (!$item) {
            push @{$properBuildOrderRef}, $module;
            return;
        }

        debug ("dep-resolv: Visiting $item");

        $visitedItemsRef->{$item} //= 0;

        # This module may have already been added to build.
        return if $visitedItemsRef->{$item} == 1;

        # But if the value is 2 that means we've detected a cycle.
        if ($visitedItemsRef->{$item} > 1) {
            croak_internal("Somehow there is a dependency cycle involving $item! :(");
        }

        $visitedItemsRef->{$item} = 2; # Mark as currently-visiting for cycle detection.
        for my $subItem (@{$dependenciesOfRef->{$item}}) {
            debug ("\tdep-resolv: $item depends on $subItem");

            my $subModule = $modulesFromNameRef->{$subItem};
            if (!$subModule) {
                note (" y[b[*] $module depends on $subItem, but no module builds $subItem for this run.");
                next;
            }

            _visitModuleAndDependencies($optionsRef, $subModule);
        }

        $visitedItemsRef->{$item} = 1; # Mark as done visiting.
        push @{$properBuildOrderRef}, $module;
        return;
    }

    # This method takes a list of Modules (real Module objects, not just module
    # names).
    #
    # These modules have their dependencies resolved, and a new list of Modules
    # is returned, containing the proper build order for the module given.
    #
    # Only "KDE Project" modules can be re-ordered or otherwise affect the
    # build so this currently won't affect Subversion modules or "plain Git"
    # modules.
    #
    # The dependency data must have been read in first (readDependencyData).
    #
    # Object method
    # Parameters: Modules to evaluate, in suggested build order.
    # Return: Modules to build, with any KDE Project modules in a valid
    # ordering based on the currently-read dependency data.
    sub resolveDependencies
    {
        my $self = assert_isa(shift, 'DependencyResolver');
        my @modules = @_;

        my $optionsRef = {
            visitedItems => { },
            properBuildOrder => [ ],
            dependenciesOf => $self->{dependenciesOf},

            # will map names back to their Modules
            modulesFromName => {
                map { $_->getOption('#xml-full-path') => $_ } @modules
            },
        };

        for my $module (@modules) {
            _visitModuleAndDependencies($optionsRef, $module);
        }

        return @{$optionsRef->{properBuildOrder}};
    }

    1;
}
# }}}

# }}}

# These packages are not in separate files so we must manually call import().
ksb::Debug->import();
ksb::Util->import();

# Moves the directory given by the first parameter to be at the directory given
# by the second parameter, but only if the first exists and the second doesn't.
# The use case is to automatically migrate source and build directories from
# the change in dest-dir handling for XML-based modules.
sub moveOldDirectories
{
    my ($oldDir, $newDir) = @_;
    state $pretendedMoves = { };

    # All this pretended move stuff is just to avoid tons of debug output
    # if run in pretend mode while still showing the message the first time.
    $pretendedMoves->{$oldDir} //= { };
    if (!$pretendedMoves->{$oldDir}->{$newDir} && -e $oldDir && ! -e $newDir) {
        info ("\tMoving old kdesrc-build directory at\n\t\tb[$oldDir] to\n\t\tb[$newDir]");

        $pretendedMoves->{$oldDir}->{$newDir} = 1 if pretending();
        safe_system('mv', $oldDir, $newDir) == 0 or
            croak_runtime("Unable to move directory $oldDir to $newDir");
    }

    return 1;
}

# Subroutine to return the directory that a module will be stored in.
# NOTE: The return value is a hash. The key 'module' will return the final
# module name, the key 'path' will return the full path to the module. The
# key 'fullpath' will return their concatenation.
# For example, with $module == 'KDE/kdelibs', and no change in the dest-dir
# option, you'd get something like:
# {
#   'path'     => '/home/user/kdesrc/KDE',
#   'module'   => 'kdelibs',
#   'fullpath' => '/home/user/kdesrc/KDE/kdelibs'
# }
# If dest-dir were changed to e.g. extragear-multimedia, you'd get:
# {
#   'path'     => '/home/user/kdesrc',
#   'module'   => 'extragear-multimedia',
#   'fullpath' => '/home/user/kdesrc/extragear-multimedia'
# }
# First parameter is the module.
# Second parameter is either source or build.
sub get_module_path_dir
{
    my $module = assert_isa(shift, 'Module');
    my $type = shift;
    my $destdir = $module->destDir();
    my $srcbase = $module->getSourceDir();
    $srcbase = $module->getSubdirPath('build-dir') if $type eq 'build';

    my $combined = "$srcbase/$destdir";

    # Remove dup //
    $combined =~ s/\/+/\//;

    my @parts = split(/\//, $combined);
    my %result = ();
    $result{'module'} = pop @parts;
    $result{'path'} = join('/', @parts);
    $result{'fullpath'} = "$result{path}/$result{module}";

    my $compatDestDir = $module->destDir($module->name());
    my $fullCompatPath = "$srcbase/$compatDestDir";

    # kdesrc-build 1.14 changed the source directory layout to be more
    # compatible with the sharply-growing number of modules.
    if ($fullCompatPath ne $combined && -d $fullCompatPath) {
        if ($type eq 'source') {
            super_mkdir($result{'path'});
            moveOldDirectories($fullCompatPath, $combined);
        }
        elsif ($type eq 'build') {
            # CMake doesn't like moving build directories, just destroy the
            # old one.
            state %warnedFor;

            if (!$warnedFor{$fullCompatPath}) {
                $warnedFor{$fullCompatPath} = 1;

                safe_rmtree($fullCompatPath) or do {
                    warning("\tUnable to remove the old build directory for y[b[$module]");
                    warning("\tThe disk layout has changed, you no longer need the old directory at");
                    warning("\t\tb[$fullCompatPath]");
                    warning("\tHowever you will have to delete it, kdesrc-build was unable to.");
                }
            };
        }
    }

    return %result;
}

# This subroutine downloads the file pointed to by the URL given in the first
# parameter, saving to the given filename.  (FILENAME, not directory). HTTP
# and FTP are supported, but this functionality requires libwww-perl
#
# First parameter: URL of link to download (i.e. http://kdesrc-build.kde.org/foo.tbz2)
# Second parameter: Filename to save as (i.e. $ENV{HOME}/blah.tbz2)
# Return value is 0 for failure, non-zero for success.
sub download_file
{
    my $url = shift;
    my $filename = shift;

    my $ua = LWP::UserAgent->new(timeout => 30);

    # Trailing space adds the appropriate LWP info since the resolver is not
    # my custom coding anymore.
    $ua->agent("kdesrc-build $versionNum ");

    whisper ("Downloading g[$filename] from g[$url]");
    my $response = $ua->mirror($url, $filename);

    # LWP's mirror won't auto-convert "Unchanged" code to success, so check for
    # both.
    return 1 if $response->code == 304 || $response->is_success;

    error ("Failed to download y[b[$url] to b[$filename]");
    error ("Result was: y[b[" . $response->status_line . "]");
    return 0;
}

# Returns the user-selected branch for the given module, or 'master' if no
# branch was selected.
#
# First parameter is the module name.
sub get_git_branch
{
    my $module = assert_isa(shift, 'Module');
    my $branch = $module->getOption('branch');

    if (!$branch && $module->getOption('use-stable-kde')) {
        my $stable = $module->getOption('#branch:stable');
        if ($stable && $stable ne 'none') {
            $branch = $stable;
        }
    }

    $branch ||= 'master'; # If no branch, use 'master'
    return $branch;
}

# Returns the current sha1 of the given git "commit-ish".
sub git_commit_id
{
    my $module = assert_isa(shift, 'Module');
    my $commit = shift;
    $commit = 'HEAD' unless $commit;

    my $gitdir = $module->fullpath('source') . '/.git';

    # Note that the --git-dir must come before the git command itself.
    my ($id, undef) = filter_program_output(
        undef, # No filter
        qw/git --git-dir/, $gitdir, 'rev-parse', $commit,
    );
    chomp $id if $id;

    return $id;
}

# Returns the number of lines in the output of the given command. The command
# and all required arguments should be passed as a normal list, and the current
# directory should already be set as appropriate.
#
# Return value is the number of lines of output.
# Exceptions are raised if the command could not be run.
sub count_command_output
{
    my @args = @_;

    open(my $fh, '-|', @args);
    my $count = 0;

    $count++ while(<$fh>);
    close $fh;
    return $count;
}

# Attempts to download and install a git snapshot for the given Module. This
# requires the module to have the '#snapshot-tarball' option set, normally
# done after KDEXMLReader is used to parse the projects.kde.org XML database.
# This function should be called with the current directory set to the be
# the source directory.
#
# After installing the tarball, an immediate git pull will be run to put the
# module up-to-date. The branch is not updated however!
#
# The user can cause this function to fail by setting the disable-snapshots
# option for the module (either at the command line or in the rc file).
#
# First and only parameter is the Module to install the snapshot for.
#
# Returns boolean true on success, false otherwise.
sub installGitSnapshot
{
    my $module = assert_isa(shift, 'Module');
    my $tarball = $module->getOption('#snapshot-tarball');

    return 0 if $module->getOption('disable-snapshots');
    return 0 unless $tarball;

    if (pretending()) {
        pretend ("\tWould have downloaded snapshot for g[$module], from");
        pretend ("\tb[g[$tarball]");
        return 1;
    }

    info ("\tDownloading git snapshot for g[$module]");

    my $filename = basename(URI->new($tarball)->path());
    my $tmpdir = File::Spec->tmpdir() // "/tmp";
    $filename = "$tmpdir/$filename"; # Make absolute

    if (!download_file($tarball, $filename)) {
        error ("Unable to download snapshot for module r[$module]");
        return 0;
    }

    info ("\tDownload complete, preparing module source code");

    # It would be possible to use Archive::Tar, but it's apparently fairly
    # slow. In addition we need to use -C and --strip-components (which are
    # also supported in BSD tar, perhaps not Solaris) to ensure it's extracted
    # in a known location. Since we're using "sufficiently good" tar programs
    # we can take advantage of their auto-decompression.
    my $sourceDir = $module->fullpath('source');
    super_mkdir($sourceDir);

    my $result = safe_system(qw(tar --strip-components 1 -C),
                          $sourceDir, '-xf', $filename);
    my $savedError = $!; # Avoid interference from safe_unlink
    safe_unlink ($filename);

    if ($result) {
        error ("Unable to extract snapshot for r[b[$module]: $savedError");
        safe_rmtree($sourceDir);
        return 0;
    }

    whisper ("\tg[$module] snapshot is in place");

    # Complete the preparation by running the initrepo.sh script
    p_chdir($sourceDir);
    $result = log_command($module, 'init-git-repo', ['/bin/sh', './initrepo.sh']);

    if ($result) {
        error ("Snapshot for r[$module] extracted successfully, but failed to complete initrepo.sh");
        safe_rmtree($sourceDir);
        return 0;
    }

    whisper ("\tConverting to kde:-style URL");
    $result = log_command($module, 'fixup-git-remote',
        ['git', 'remote', 'set-url', 'origin', "kde:$module"]);

    if ($result) {
        warning ("\tUnable to convert origin URL to kde:-style URL. Things should");
        warning ("\tstill work, you may have to adjust push URL manually.");
    }

    info ("\tGit snapshot installed, now bringing up to date.");
    $result = log_command($module, 'init-git-pull', ['git', 'pull']);
    return ($result == 0);
}

# Perform a git clone to checkout the latest branch of a given git module
#
# Afterwards a special remote name is setup for later usage
# (__kdesvn-build-remote). This name is retained due to its historical usage.
#
# First parameter is the module to perform the checkout of.
# Second parameter is the repository (typically URL) to use.
# Returns boolean true if successful, false otherwise.
sub git_clone_module
{
    my $module = assert_isa(shift, 'Module');
    my $git_repo = shift;
    my $srcdir = $module->fullpath('source');
    my @args = ('--', $git_repo, $srcdir);

    # The -v forces progress output from git, which seems to work around either
    # a gitorious.org bug causing timeout errors after cloning large
    # repositories (such as Qt...)
    if ($module->buildSystemType() eq 'Qt' &&
        $module->buildSystem()->forceProgressOutput())
    {
        unshift (@args, '-v');
    }

    note ("Cloning g[$module]");

    # Invert the result of installGitSnapshot to get a shell-style return code
    # like those returned by log_command. Likewise the normal || must be a &&
    my $result = (!installGitSnapshot($module)) &&
                 log_command($module, 'git-clone', ['git', 'clone', @args]);

    if ($result == 0) {
        $module->setPersistentOption('git-cloned-repository', $git_repo);

        my $branch = get_git_branch($module);

        # Switch immediately to user-requested branch now.
        if ($branch ne 'master') {
            info ("\tSwitching to branch g[$branch]");
            p_chdir($srcdir);
            $result = log_command($module, 'git-checkout',
                ['git', 'checkout', '-b', $branch, "origin/$branch"]);
        }
    }

    return ($result == 0);
}

# Returns true if the git module in the current directory has a remote of the
# name given by the first parameter.
sub git_has_remote
{
    my $remote = shift;

    open my $output, '-|', qw(git remote);
    my @remotes = grep { /^$remote/ } (<$output>);
    close $output;

    return @remotes > 0;
}

# We use a very-oddly-named remote name for the situations where we don't care
# about user interaction with git. However 99% of the time the 'origin' remote
# will be what we want anyways, and 0.5% of the rest the user will have
# manually added a remote, which we should try to utilize when doing checkouts
# for instance. To aid in this, this subroutine returns a list of all
# remote aliased matching the supplied repository (besides the internal
# alias that is).
#
# Assumes that we are already in the proper source directory.
#
# First parameter: Repository URL to match.
# Returns: A list of matching remote names (list in case the user hates us
# and has aliased more than one remote to the same repo). Obviously the list
# will be empty if no remote names were found.
sub git_get_best_remote_names
{
    my $repoUrl = shift;
    my @outputs;

    # The Repo URL isn't much good, let's find a remote name to use it with.
    # We'd have to escape the repo URL to pass it to Git, which I don't trust,
    # so we just look for all remotes and make sure the URL matches afterwards.
    eval {
        @outputs = slurp_git_config_output(
            qw/git config --null --get-regexp remote\..*\.url ./
        );
    };

    if($@) {
        error ("Unable to run git config, is there a setup error?");
        return ();
    }

    my @results;
    foreach my $output (@outputs) {
        # git config output between key/val is divided by newline.
        my ($remoteName, $url) = split(/\n/, $output);

        $remoteName =~ s/^remote\.//;
        $remoteName =~ s/\.url$//; # Extract the cruft

        # Skip other remotes
        next if $url ne $repoUrl;

        # Try to avoid "weird" remote names.
        next if $remoteName !~ /^[\w-]*$/;

        # A winner is this one.
        push @results, $remoteName;
    }

    return @results;
}

# Generates a potential new branch name for the case where we have to setup
# a new remote-tracking branch for a repository/branch. There are several
# criteria that go into this:
# * The local branch name will be equal to the remote branch name to match usual
#   Git convention.
# * The name chosen must not already exist. This methods tests for that.
# * The repo name chosen should be (ideally) a remote name that the user has
#   added. If not, we'll try to autogenerate a repo name (but not add a
#   remote!) based on the repository.git part of the URI. In no case will the
#   internal remote alias be used.
#
# As with nearly all git support functions, the git remote alias should already
# be setup, and we should be running in the source directory of the git module.
# Don't call this function unless you've already checked that a suitable
# remote-tracking branch doesn't exist.
#
# First parameter: The Module being worked on.
# Second parameter: A *reference* to a list of remote names (all pointing to
#                   the same repository) which are valid.
# Third parameter: The name of the remote head we need to make a branch name
# of.
# Returns: A useful branch name that doesn't already exist, or '' if no
# name can be generated.
sub git_make_branchname
{
    my $module = assert_isa(shift, 'Module');
    my $remoteNamesRef = shift;
    my $branch = shift;
    my $chosenName;

    # Use "$branch" directly if not already used, otherwise try
    # to prefix with the best remote name or origin.
    my $bestRemoteName = $remoteNamesRef ? $remoteNamesRef->[0] : 'origin';
    for my $possibleBranch ($branch, "$bestRemoteName-$branch", "origin-$branch") {
        my @known_branches = eval {
            # undef == no filter
            filter_program_output(undef, 'git', 'branch', '--list', $possibleBranch)
        };

        # The desired branch name is OK as-is if no exceptions were thrown and
        # the branch wasn't already known to git.
        return $possibleBranch if !@known_branches && !$@;
    }

    croak_runtime("Unable to find good branch name for $module branch name $branch");
}

# This subroutine finds an existing remote-tracking branch name for the given
# repository's named remote. For instance if the user was using the local
# remote-tracking branch called 'qt-stable' to track kde-qt's master branch,
# this subroutine would return the branchname 'qt-stable' when passed kde-qt
# and 'master'.
#
# The current directory must be the source directory of the git module.
#
# First parameter : A *reference* to a list of remote names to check against.
#                   It is important that this list all really point against the
#                   same repository URL however. (See
#                   git_get_best_remote_names)
# Second parameter: The remote head name to find a local branch for.
# Returns: Empty string if no match is found, or the name of the local remote-tracking
#          branch if one exists.
sub git_get_remote_branchname
{
    my $remoteNamesRef = shift;
    my $branchName = shift;

    # Dereference our remote names.
    my @remoteNames = @{$remoteNamesRef};

    # Look for our branchName in each possible remote alias.
    foreach my $remoteName (@remoteNames) {
        # We'll parse git config output to search for branches that have a
        # remote of $remoteName and a 'merge' of refs/heads/$branchName.

        my @branches = slurp_git_config_output(
            qw/git config --null --get-regexp branch\..*\.remote/, $remoteName
        );

        foreach my $gitBranch (@branches) {
            # The key/value is \n separated, we just want the key.
            my ($keyName) = split(/\n/, $gitBranch);
            my ($thisBranch) = ($keyName =~ m/^branch\.(.*)\.remote$/);

            # We have the local branch name, see if it points to the remote
            # branch we want.
            my @configOutput = slurp_git_config_output(
                qw/git config --null/, "branch.$thisBranch.merge"
            );

            if(@configOutput && $configOutput[0] eq "refs/heads/$branchName") {
                # We have a winner
                return $thisBranch;
            }
        }
    }

    return '';
}

# This stashes existing changes if necessary, and then runs git pull --rebase in order
# to advance the given module to the latest head. Finally, if changes were stashed, they
# are applied and the stash stack is popped.
#
# It is assumed that the required remote has been setup already, that we are on the right
# branch, and that we are already in the correct directory.
#
# Returns true on success, false otherwise. Some egregious errors result in
# exceptions being thrown however.
sub git_stash_and_update
{
    my $module = assert_isa(shift, 'Module');
    my $date = strftime ("%F-%R", gmtime()); # ISO Date, hh:mm time

    # To find out if we should stash, we just use git diff --quiet, twice to
    # account for the index and the working dir.
    # Note: Don't use safe_system, as the error code is stripped to the exit code
    my $status = pretending() ? 0 : system('git', 'diff', '--quiet');

    if ($status == -1 || $status & 127) {
        croak_runtime("$module doesn't appear to be a git module.");
    }

    my $needsStash = 0;
    if ($status) {
        # There is local changes.
        $needsStash = 1;
    }
    else {
        $status = pretending() ? 0 : system('git', 'diff', '--cached', '--quiet');
        if ($status == -1 || $status & 127) {
            croak_runtime("$module doesn't appear to be a git module.");
        }
        else {
            $needsStash = ($status != 0);
        }
    }

    if ($needsStash) {
        info ("\tLocal changes detected, stashing them away...");
        $status = log_command($module, 'git-stash-save', [
                qw(git stash save --quiet), "kdesrc-build auto-stash at $date",
            ]);
        if ($status != 0) {
            croak_runtime("Unable to stash local changes for $module, aborting update.");
        }
    }

    $status = log_command($module, 'git-pull-rebase', [
            qw(git pull --rebase --quiet)
        ]);

    if ($status != 0) {
        error ("Unable to update the source code for r[b[$module]");
        return 0;
    }

    # Update is performed and successful, re-apply the stashed changes
    if ($needsStash) {
        info ("\tModule updated, reapplying your local changes.");
        $status = log_command($module, 'git-stash-pop', [
                qw(git stash pop --index --quiet)
            ]);
        if ($status != 0) {
            error (<<EOF);
 r[b[*]
 r[b[*] Unable to re-apply stashed changes to r[b[$module]!
 r[b[*]
 * These changes were saved using the name "kdesrc-build auto-stash at $date"
 * and should still be available using the name stash\@{0}, the command run
 * to re-apply was y[git stash --pop --index]. Resolve this before you run
 * kdesrc-build to update this module again.
 *
 * If you do not desire to keep your local changes, then you can generally run
 * r[b[git reset --hard HEAD], or simply delete the source directory for
 * $module. Developers be careful, doing either of these options will remove
 * any of your local work.
EOF
            return 0;
        }
    }

    return 1;
}

# Updates an already existing git checkout by running git pull.
# Assumes the __kdesvn-build-remote git remote has been setup.
#
# First parameter is the module to download.
# Return parameter is the number of affected *commits*. Errors are
# returned only via exceptions because of this.
sub git_update_module
{
    my $module = assert_isa(shift, 'Module');
    my $srcdir = $module->fullpath('source');
    my $old_repo = $module->getPersistentOption('git-cloned-repository');
    my $cur_repo = $module->getOption('repository');
    my $branch = get_git_branch($module);
    my $remoteName = GIT_REMOTE_ALIAS;
    my $result;

    p_chdir($srcdir);

    note ("Updating g[$module] (to branch b[$branch])");
    my $start_commit = git_commit_id($module);

    # Search for an existing remote name first. If none, add our alias.
    my @remoteNames = git_get_best_remote_names($cur_repo);

    if (@remoteNames) {
        $remoteName = $remoteNames[0];
    }
    else {
        if(git_has_remote(GIT_REMOTE_ALIAS)) {
            if(log_command($module, 'git-update-remote',
                        ['git', 'remote', 'set-url', GIT_REMOTE_ALIAS, $cur_repo])
                != 0)
            {
                die "Unable to update the fetch URL for existing remote alias for $module";
            }
        }
        elsif(log_command($module, 'git-remote-setup',
                       ['git', 'remote', 'add', GIT_REMOTE_ALIAS, $cur_repo])
            != 0)
        {
            die "Unable to add a git remote named " . GIT_REMOTE_ALIAS . " for $cur_repo";
        }

        push @remoteNames, GIT_REMOTE_ALIAS;
    }

    if ($old_repo and ($cur_repo ne $old_repo)) {
        note (" y[b[*]\ty[$module]'s selected repository has changed");
        note (" y[b[*]\tfrom y[$old_repo]");
        note (" y[b[*]\tto   b[$cur_repo]");
        note (" y[b[*]\tThe git remote named b[", GIT_REMOTE_ALIAS, "] has been updated");

        # Update what we think is the current repository on-disk.
        $module->setPersistentOption('git-cloned-repository', $cur_repo);
    }

    # Download updated objects
    # This also updates remote heads so do this before we start comparing branches
    # and such, even though we will later use git pull.
    if (0 != log_command($module, 'git-fetch', ['git', 'fetch', $remoteName])) {
        die "Unable to perform git fetch for $remoteName, which should be $cur_repo";
    }

    # The 'branch' option requests a given head in the user's selected
    # repository. Normally the remote head is mapped to a local branch, which
    # can have a different name. So, first we make sure the remote head is
    # actually available, and if it is we compare its SHA1 with local branches
    # to find a matching SHA1. Any local branches that are found must also be
    # remote-tracking. If this is all true we just re-use that branch,
    # otherwise we create our own remote-tracking branch.
    my $branchName = git_get_remote_branchname(\@remoteNames, $branch);

    if (not $branchName) {
        my $newName = git_make_branchname($module, \@remoteNames, $branch);
        whisper ("\tUpdating g[$module] with new remote-tracking branch y[$newName]");
        if (0 != log_command($module, 'git-checkout-branch',
                      ['git', 'checkout', '-b', $newName, "$remoteName/$branch"]))
        {
            die "Unable to perform a git checkout of $remoteName/$branch to a local branch of $newName";
        }
    }
    else {
        whisper ("\tUpdating g[$module] using existing branch g[$branchName]");
        if (0 != log_command($module, 'git-checkout-update',
                      ['git', 'checkout', $branchName]))
        {
            die "Unable to perform a git checkout to existing branch $branchName";
        }
    }

    # With all remote branches fetched, and the checkout of our desired branch
    # completed, we can now use git pull to complete the changes.
    if (git_stash_and_update($module)) {
        my $end_commit = git_commit_id($module);
        return count_command_output('git', 'rev-list', "$start_commit..$end_commit");
    }
    else {
        # We must throw an exception if we fail.
        die "Unable to update $module";
    }
}

# Either performs the initial checkout or updates the current git checkout for
# git-using modules, as appropriate.
#
# If errors are encountered, an exception is raised using die().
#
# Returns the number of files updated (actually it just returns 0 now, but maybe someday)
sub update_module_git_checkout
{
    my $module = assert_isa(shift, 'Module');
    my $srcdir = $module->fullpath('source');

    if (-d "$srcdir/.git") {
        # Note that this function will throw an exception on failure.
        return git_update_module($module);
    }
    else {
        # Check if an existing source directory is there somehow.
        if (-e "$srcdir") {
            if ($module->getOption('#delete-my-patches')) {
                warning ("\tRemoving conflicting source directory " .
                         "as allowed by --delete-my-patches");
                warning ("\tRemoving b[$srcdir]");
                safe_rmtree($srcdir) or do {
                    die "Unable to delete r[b[$srcdir]!";
                };
            }
            else {
                error (<<EOF);
The source directory for b[$module] does not exist. kdesrc-build would download
it, except there is already a file or directory present in the desired source
directory:
\ty[b[$srcdir]

Please either remove the source directory yourself and re-run this script, or
pass the b[--delete-my-patches] option to kdesrc-build and kdesrc-build will
try to do so for you.

DO NOT FORGET TO VERIFY THERE ARE NO UNCOMMITTED CHANGES OR OTHER VALUABLE
FILES IN THE DIRECTORY.

EOF

                if (-e "$srcdir/.svn") {
                    error ("svn status of $srcdir:");
                    system('svn', 'st', '--non-interactive', $srcdir);
                }

                die ('Conflicting source-dir present');
            }
        }

        my $git_repo = $module->getOption('repository');

        if (not $git_repo) {
            die "Unable to checkout $module, you must specify a repository to use.";
        }

        git_clone_module($module, "$git_repo") or die "Can't checkout $module: $!";

        return 1 if pretending();
        return count_command_output('git', '--git-dir', "$srcdir/.git", 'ls-files');
    }

    return 0;
}

# Subroutine to run make and process the build process output in order to
# provide completion updates.  This procedure takes the same arguments as
# log_command() (described here as well), except that the callback argument is
# not used.
#
# First parameter is the Module being built (for logging purposes and such).
# Second parameter is the name of the log file to use (relative to the log
#   directory).
# Third parameter is a reference to an array with the command and its
#   arguments.  i.e. ['command', 'arg1', 'arg2']
# The return value is the shell return code, so 0 is success, and non-zero is
#   failure.
sub run_make_command
{
    my ($module, $filename, $argRef) = @_;
    assert_isa($module, 'Module');

    debug ("run_make_command: $module, ", join(', ', @{$argRef}));

    # There are situations when we don't want (or can't get) progress output:
    # 1. Not using CMake (i.e. Qt)
    # 2. If we're not printing to a terminal.
    # 3. When we're debugging (we'd interfere with debugging output).
    if (!$module->buildSystem()->isProgressOutputSupported() || ! -t STDERR || debugging())
    {
        return log_command($module, $filename, $argRef);
    }

    # Setup callback function for use by log_command.
    my $last = -1;

    # w00t.  Check out the closure!  Maks would be so proud.
    my $log_command_callback = sub {
        my ($input) = shift;

        if (not defined $input)
        {
            # End of input, cleanup.
            print STDERR "\r\e[K";
        }
        else
        {
            chomp($input);

            my $percentage = '';

            if ($input =~ /^\[\s*([0-9]+)%]/)
            {
                $percentage = $1;
            }

            # Update terminal (\e[K clears to the end of line) if the
            # percentage changed.
            if ($percentage and $percentage ne $last)
            {
                print STDERR "\r$percentage% \e[K";
            }

            $last = $percentage;
        }
    };

    return log_command($module, $filename, $argRef, { callback => $log_command_callback });
}

# Subroutine to return the path to the given executable based on the current
# binpath settings.  e.g. if you pass make you could get '/usr/bin/make'.  If
# the executable is not found undef is returned.
#
# This assumes that the module environment has already been updated since
# binpath doesn't exactly correspond to $ENV{'PATH'}.
sub absPathToExecutable
{
    my $prog = shift;
    my @paths = split(/:/, $ENV{'PATH'});

    # If it starts with a / the path is already absolute.
    return $prog if $prog =~ /^\//;

    for my $path (@paths)
    {
        return "$path/$prog" if (-x "$path/$prog");
    }

    return undef;
}

# Subroutine to delete a directory and all files and subdirectories within.
# Does nothing in pretend mode.  An analogue to "rm -rf" from Linux.
# Requires File::Find module.
#
# First parameter: Path to delete
# Returns boolean true on success, boolean false for failure.
sub safe_rmtree
{
    my $path = shift;

    # Pretty user-visible path
    my $user_path = $path;
    $user_path =~ s/^$ENV{HOME}/~/;

    my $delete_file_or_dir = sub {
        # $_ is the filename/dirname.
        return if $_ eq '.' or $_ eq '..';
        if (-f $_ || -l $_)
        {
            unlink ($_) or croak_runtime("Unable to delete $File::Find::name: $!");
        }
        elsif (-d $_)
        {
            rmdir ($File::Find::name) or
                croak_runtime("Unable to remove directory $File::Find::name: $!");
        }
    };

    if (pretending())
    {
        pretend ("Would have removed all files/folders in $user_path");
        return 1;
    }

    # Error out because we probably have a logic error even though it would
    # delete just fine.
    if (not -d $path)
    {
        error ("Cannot recursively remove $user_path, as it is not a directory.");
        return 0;
    }

    eval {
        $@ = '';
        finddepth( # finddepth does a postorder traversal.
        {
            wanted => $delete_file_or_dir,
            no_chdir => 1, # We'll end up deleting directories, so prevent this.
        }, $path);
    };

    if ($@)
    {
        error ("Unable to remove directory $user_path: $@");
        return 0;
    }

    return 1;
}

# Subroutine to run the make command with the arguments given by the passed
# hash.  In addition to finding the proper make executable, this function
# handles the step of running make for individual subdirectories (as specified
# by the checkout-only option to the module).  Due to the various ways make is
# used by this script, it is required to pass customization options in a hash:
# {
#    target         => undef, or a valid make target e.g. 'install',
#    message        => 'Compiling.../Installing.../etc.'
#    make-options   => [ list of command line arguments to pass to make. See
#                        make-options ],
#    prefix-options => [ list of command line arguments to prefix *before* the
#                        make command, used for make-install-prefix support for
#                        e.g. sudo ],
#    logbase        => 'base-log-filename',
#    subdirs        => [ list of subdirectories of the module to build,
#                        relative to the module's own build directory. ]
# }
#
# target and message are required. logbase is required if target is left
# undefined, but otherwise defaults to the same value as target.
#
# The first argument should be the Module object to be made.
# The second argument should be the reference to the hash described above.
#
# Returns 0 on success, non-zero on failure (shell script style)
sub safe_make (@)
{
    my ($module, $optsRef) = @_;
    assert_isa($module, 'Module');

    # Non Linux systems can sometimes fail to build when GNU Make would work,
    # so prefer GNU Make if present, otherwise try regular make.  Also, convert
    # the path to an absolute path since I've encountered a sudo that is
    # apparently unable to guess.  Maybe it's better that it doesn't guess
    # anyways from a security point-of-view.
    my $make;
    if(!($make = absPathToExecutable('gmake') || absPathToExecutable('make'))) {
        # Weird, we can't find make, you'd think configure would have
        # noticed...
        error (" r[b[*] Unable to find the g[make] executable!");
        return 1;
    }

    # Make it prettier if pretending (Remove leading directories).
    $make =~ s{^/.*/}{} if pretending();

    # Simplify code by forcing lists to exist.
    $optsRef->{'prefix-options'} //= [ ];
    $optsRef->{'make-options'} //= [ ];
    $optsRef->{'subdirs'} //= [ ];

    my @prefixOpts = @{$optsRef->{'prefix-options'}};

    # If using sudo ensure that it doesn't wait on tty, but tries to read from
    # stdin (which should fail as we redirect that from /dev/null)
    if (@prefixOpts && $prefixOpts[0] eq 'sudo' && !grep { /^-S$/ } @prefixOpts)
    {
        splice (@prefixOpts, 1, 0, '-S'); # Add -S right after 'sudo'
    }

    # Assemble arguments
    my @args = (@prefixOpts, $make);
    push @args, $optsRef->{target} if $optsRef->{target};
    push @args, @{$optsRef->{'make-options'}};

    info ("\t", $optsRef->{message});

    # Here we're attempting to ensure that we either run make in each
    # subdirectory, *or* for the whole module, but not both.
    my @dirs = @{$optsRef->{subdirs}};
    push (@dirs, "") if scalar @dirs == 0;

    for my $subdir (@dirs)
    {
        # Some subdirectories shouldn't have make run within them.
        next unless $module->buildSystem()->isSubdirBuildable($subdir);

        my $logname = $optsRef->{logbase} // $optsRef->{target};

        if ($subdir ne '')
        {
            $logname = $logname . "-$subdir";

            # Remove slashes in favor of something else.
            $logname =~ tr{/}{-};

            # Mention subdirectory that we're working on, move ellipsis
            # if present.
            my $subdirMessage = $optsRef->{message};
            if ($subdirMessage =~ /\.\.\.$/) {
                $subdirMessage =~ s/(\.\.\.)?$/ subdirectory g[$subdir]$1/;
            }
            info ("\t$subdirMessage");
        }

        my $builddir = $module->fullpath('build') . "/$subdir";
        $builddir =~ s/\/*$//; # Remove trailing /

        p_chdir ($builddir);

        my $result = run_make_command ($module, $logname, \@args);
        return $result if $result;
    };

    return 0;
}

# Given a module name, this subroutine returns a hash with the default module
# options for the module.
#
# The global options must already be setup but there is no requirement for any
# module options to be available.
#
# First parameter is the module to get options for.
#
# Return is a hash reference containing the default module options.
sub default_module_options
{
    my $moduleName = shift;
    my %options = (
        'set-env' => { },
    );
    my %module_options = (
        'qt' => {
            'configure-flags' => '-no-phonon -dbus -nomake demos -nomake examples -fast',
            'repository' => 'kde:qt',
            'branch'     => '4.8',
        },
        'strigi' => {
            # Until the strigi build system supports independent submodule
            # builds.
            'cmake-options' => '-DSTRIGI_SYNC_SUBMODULES=TRUE',
            'reconfigure'   => 'true',
        },
        'taglib' => {
            'cmake-options' => '-DWITH_ASF=TRUE -DWITH_MP4=TRUE',
        },
        'dbusmenu-qt' => {
            'repository' => 'git://gitorious.org/dbusmenu/dbusmenu-qt.git',
        },
    );

    # If no specific moduleName options just return the default
    return \%options unless exists $module_options{$moduleName};

    # Otherwise merge in options (uses Perl hash slice)
    my $this_module_options = $module_options{$moduleName};
    @options{keys %{$this_module_options}} = values %{$this_module_options};

    return \%options;
}

# Reads a "line" from a file. This line is stripped of comments and extraneous
# whitespace. Also, backslash-continued multiple lines are merged into a single
# line.
#
# First parameter is the reference to the filehandle to read from.
# Returns the text of the line.
sub readNextLogicalLine
{
    my $fileReader = shift;

    while($_ = $fileReader->readLine()) {
        # Remove trailing newline
        chomp;

        # Replace \ followed by optional space at EOL and try again.
        if(s/\\\s*$//)
        {
            $_ .= $fileReader->readLine();
            redo;
        }

        s/#.*$//;        # Remove comments
        next if /^\s*$/; # Skip blank lines

        return $_;
    }

    return undef;
}

# Takes an input line, and extracts it into an option name, and simplified
# value. The value has "false" converted to 0, white space simplified (like in
# Qt), and tildes (~) in what appear to be path-like entries are converted to
# the home directory path.
#
# First parameter is the input line.
# Return value is (optionname, option-value)
sub split_option_value
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $input = shift;
    my $optionRE = qr/\$\{([a-zA-Z0-9-]+)\}/;

    # The option is the first word, followed by the
    # flags on the rest of the line.  The interpretation
    # of the flags is dependant on the option.
    my ($option, $value) = ($input =~ /^\s*     # Find all spaces
                            ([-\w]+) # First match, alphanumeric, -, and _
                            # (?: ) means non-capturing group, so (.*) is $value
                            # So, skip spaces and pick up the rest of the line.
                            (?:\s+(.*))?$/x);

    $value = "" unless defined $value;

    # Simplify this.
    $value =~ s/\s+$//;
    $value =~ s/^\s+//;
    $value =~ s/\s+/ /;

    # Check for false keyword and convert it to Perl false.
    $value = 0 if lc($value) eq 'false';

    # Replace reference to global option with their value.
    # The regex basically just matches ${option-name}.
    my ($sub_var_name) = ($value =~ $optionRE);
    while ($sub_var_name)
    {
        my $sub_var_value = $ctx->getOption($sub_var_name) || '';
        if(!$ctx->hasOption($sub_var_value)) {
            warning (" *\n * WARNING: $sub_var_name is not set at line y[$.]\n *");
        }

        debug ("Substituting \${$sub_var_name} with $sub_var_value");

        $value =~ s/\${$sub_var_name}/$sub_var_value/g;

        # Replace other references as well.  Keep this RE up to date with
        # the other one.
        ($sub_var_name) = ($value =~ $optionRE);
    }

    # Replace tildes with home directory.
    1 while ($value =~ s"(^|:|=)~/"$1$ENV{'HOME'}/");

    return ($option, $value);
}

# Reads in the options from the config file and adds them to the option store.
# The first parameter is a BuildContext object to use for creating the returned
#     Module under.
# The second parameter is a reference to the file handle to read from.
# The third parameter is the module name. It can be either an
# already-constructed Module object (in which case it is used directly and any
# options read for the module are applied directly to the object), or it can be
# a string containing the module name (in which case a new Module object will
# be created). For global options the module name should be 'global', or just
# pass in the BuildContext for this param as well.
#
# The return value is the Module with options set as given in the configuration
# file for that module. If global options were being read then a BuildContext
# is returned (but that is-a Module anyways).
sub parse_module
{
    my ($ctx, $fileReader, $moduleOrName) = @_;
    assert_isa($ctx, 'ksb::BuildContext');

    my $rcfile = $ctx->rcFile();
    my $module;

    # Figure out what objects to store options into. If given, just use
    # that, otherwise use context or a new Module depending on the name.
    if (ref $moduleOrName) {
        $module = $moduleOrName;
        assert_isa($module, 'Module');
    }
    elsif ($moduleOrName eq 'global') {
        $module = $ctx;
    }
    else {
        $module = Module->new($ctx, $moduleOrName);
    }

    my $endWord = $module->isa('ksb::BuildContext') ? 'global' : 'module';
    my $endRE = qr/^end\s+$endWord/;

    # Read in each option
    while ($_ = readNextLogicalLine($fileReader))
    {
        last if m/$endRE/;

        # Sanity check, make sure the section is correctly terminated
        if(/^(module\s|module$)/)
        {
            error ("Invalid configuration file $rcfile at line $.\nAdd an 'end $endWord' before " .
                   "starting a new module.\n");
            die make_exception('Config', "Invalid $rcfile");
        }

        my ($option, $value) = split_option_value($ctx, $_);

        # Handle special options.
        if ($module->isa('ksb::BuildContext') && $option eq 'git-repository-base') {
            # This will be a hash reference instead of a scalar
            my ($repo, $url) = ($value =~ /^([a-zA-Z0-9_-]+)\s+(.+)$/);
            $value = $ctx->getOption($option) || { };

            if (!$repo || !$url) {
                error (<<"EOF");
The y[git-repository-base] option at y[b[$rcfile:$.]
requires a repository name and URL.

e.g. git-repository base y[b[kde] g[b[git://anongit.kde.org/]

Use this in a "module-set" group:

e.g.
module-set kdesupport-set
  repository y[b[kde]
  use-modules automoc akonadi soprano attica
end module-set
EOF
                die make_exception('Config', "Invalid git-repository-base");
            }

            $value->{$repo} = $url;
        }

        $module->setOption($option, $value);
    }

    return $module;
}

# Tries to download the kde_projects.xml file needed to make XML module support
# work. Only tries once per script run. If it does succeed, the result is saved
# to $srcdir/kde_projects.xml
#
# Returns the file handle that the database can be retrieved from. May throw an
# exception if an error occurred.
sub ensure_projects_xml_present
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');

    state $file;
    state $cachedSuccess;

    # See if we've already tried to download. If we ever try to download for
    # real, we end up unlinking the file if it didn't successfully complete the
    # download, so we shouldn't have to worry about a corrupt XML file hanging
    # out for all time.
    if (defined $cachedSuccess && !$cachedSuccess) {
        croak_internal("Attempted to find projects.xml after it already failed");
    }

    if ($cachedSuccess) {
        open my $fh, '<', $file or die make_exception('Runtime', "Unable to open $file: $!");
        return $fh;
    }

    # Not previously attempted, let's make a try.
    my $srcdir = $ctx->getSourceDir();
    my $fileHandleResult;

    super_mkdir($srcdir) unless -d "$srcdir";
    $file = "$srcdir/kde_projects.xml";
    my $url = "http://projects.kde.org/kde_projects.xml";

    my $result = 1;

    # Must use ->phases() directly to tell if we will be updating since
    # modules are not all processed until after this function is called...
    my $updating = grep { /^update$/ } (@{$ctx->phases()});
    if (!pretending() && $updating) {
        info (" * Downloading projects.kde.org project database...");
        $result = download_file($url, $file);
    }
    elsif (! -e $file) {
        note (" * Downloading projects.kde.org project database (will not be saved in pretend mode)...");

        # Unfortunately dumping the HTTP output straight to the XML parser is a
        # wee bit more complicated than I feel like dealing with => use a temp
        # file.
        (undef, $file) = tempfile('kde_projectsXXXXXX',
            SUFFIX=>'.xml', TMPDIR=>1, UNLINK=>0);
        $result = download_file($url, $file);
        open ($fileHandleResult, '<', $file) or croak_runtime("Unable to open KDE Project database $file: $!");
    }
    else {
        info (" * y[Using existing projects.kde.org project database], output may change");
        info (" * when database is updated next.");
    }

    $cachedSuccess = $result;

    if (!$result) {
        unlink $file if -e $file;
        croak_runtime("Unable to download kde_projects.xml for the kde-projects repository!");
    }

    if (!$fileHandleResult) {
        open ($fileHandleResult, '<', $file) or die
            make_exception('Runtime', "Unable to open $file: $!");
    }

    return $fileHandleResult;
}

# Reads in a "moduleset".
#
# First parameter is the filehandle to the config file to read from.
# Second parameter is the name of the moduleset, which is really the name
# of the base repository to use.
# Returns the expanded list of module names to include.
sub parse_moduleset
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $fileReader = shift;
    my $moduleSetName = shift || '';
    my $repoSet = $ctx->getOption('git-repository-base');
    my $rcfile = $ctx->rcFile();
    my @modules;
    my %optionSet; # We read all options, and apply them to all modules
    my $startLine = $.; # For later error messages

    while($_ = readNextLogicalLine($fileReader)) {
        last if /^end\s+module(-?set)?$/;

        my ($option, $value) = split_option_value($ctx, $_);

        if ($option eq 'use-modules') {
            @modules = split(' ', $value);

            if (not @modules) {
                error ("No modules were selected for the current module-set");
                error ("in the y[use-modules] on line $. of $rcfile");
                die make_exception('Config', 'Invalid use-modules');
            }
        }
        elsif ($option eq 'set-env') {
            handle_set_env(\%optionSet, $option, $value);
        }
        else {
            $optionSet{$option} = $value;
        }
    }

    # Check before we start looping whether the user did something silly.
    if (exists $optionSet{'repository'} &&
        ($optionSet{'repository'} ne KDE_PROJECT_ID) &&
        not exists $repoSet->{$optionSet{'repository'}})
    {
        my $projectID = KDE_PROJECT_ID;
        my $moduleSetId = "module-set";
        $moduleSetId = "module-set ($moduleSetName)" if $moduleSetName;

        error (<<EOF);
There is no repository assigned to y[b[$optionSet{repository}] when assigning a
$moduleSetId on line $startLine of $rcfile.

These repositories are defined by g[b[git-repository-base] in the global
section of $rcfile.
Make sure you spelled your repository name right!

If you are trying to pull the module information from the KDE
http://projects.kde.org/ website, please use b[$projectID] for the value of
the b[repository] option.
EOF

        die make_exception('Config', 'Unknown repository base');
    }

    my @moduleList; # module names converted to Module objects.
    my $selectedRepo;
    my $usingXML = (exists $optionSet{'repository'}) &&
                    $optionSet{'repository'} eq KDE_PROJECT_ID;

    # Setup default options for each module
    # Extraction of relevant XML modules will be handled immediately after
    # this phase of execution.
    for my $module (@modules) {
        my $moduleName = $module;

        # Remove trailing .git for module name
        $moduleName =~ s/\.git$// unless $usingXML;

        my $newModule = Module->new($ctx, $moduleName);
        $newModule->setModuleSet($moduleSetName);
        $newModule->setScmType($usingXML ? 'proj' : 'git');
        push @moduleList, $newModule;

        # Dump all options into the existing Module's options.
        $newModule->setOption(%optionSet);

        # Fixup for the special repository handling if need be.
        if (!$usingXML && exists $optionSet{'repository'}) {
            $selectedRepo = $repoSet->{$optionSet{'repository'}} unless $selectedRepo;
            $newModule->setOption('repository', $selectedRepo . $moduleName);
        }
    }

    if (not scalar @moduleList) {
        warning ("No modules were defined for the module-set in r[b[$rcfile] starting at line y[b[$startLine]");
        warning ("You should use the g[b[use-modules] option to make the module-set useful.");
    }

    return @moduleList;
}

# Goes through the provided modules that have the 'proj' type (i.e. XML
# projects.kde.org database) and expands the proj-types into their equivalent
# git modules, and returns the fully expanded list. Non-proj modules are
# included in the sequence they were originally.
sub expandXMLModules
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my @modules = @_;

    # If we detect a KDE project we want to also pull in a "build support"
    # repository that will contain metadata such as which modules depend on
    # which other ones, what modules shouldn't be built, etc.
    my $repositoryMetadataRequired = 0;

    # Using a sub allows me to use the 'return' keyword.
    my $filter = sub {
        my $moduleSet = shift;

        # Only attempt to expand out XML-based modules.
        return $moduleSet if !$moduleSet->scm()->isa('KDEProjectUpdate');

        my $databaseFile = ensure_projects_xml_present($ctx) or
            croak_runtime("kde-projects repository information could not be downloaded: $!");

        # At this point we know we'll need the kde-build-metadata module, force
        # it in by setting a flag to be used by the higher-level subroutine.
        $repositoryMetadataRequired = 1;

        my $name = $moduleSet->name();
        my $srcdir = $ctx->getSourceDir();

        my @allXmlResults = KDEXMLReader->getModulesForProject($databaseFile, $name);

        # It's possible to match modules which are marked as inactive on
        # projects.kde.org, elide those.
        my @xmlResults = grep { $_->{'active'} ne 'false' } (@allXmlResults);

        if (!@xmlResults) {
            # If this was a "guessed XML module" then we guessed wrong, and it's really
            # a misspelling.
            if ($moduleSet->getOption('#guessed-kde-project')) {
                croak_runtime("Unknown module or module-set: $name");
            }

            warning (" y[b[*] Module y[$name] is apparently XML-based, but contains no\n" .
                     "active modules to build!");
            my $count = scalar @allXmlResults;
            if ($count > 0) {
                warning ("\tAlthough no active modules are available, there were\n" .
                         "\t$count inactive modules. Perhaps the git modules are not ready?");
            }
        }

        # Setup module options. This alters the results in @xmlResults.
        foreach (@xmlResults) {
            my $result = $_;
            my $repo = $result->{'repo'};

            # Prefer kde: alias to normal clone URL.
            $repo =~ s(^git://anongit\.kde\.org/)(kde:);

            # This alters the item we were looking at.
            $_ = Module->new($ctx, $result->{'name'});
            $_->setScmType('git');
            $_->cloneOptionsFrom($moduleSet);
            $_->setModuleSet($moduleSet->moduleSet());
            $_->setOption('repository', $repo);
            $_->setOption('#xml-full-path', $result->{'fullName'});
            $_->setOption('#branch:stable', $result->{'branch:stable'});

            my $tarball = $result->{'tarball'};
            $_->setOption('#snapshot-tarball', $tarball) if $tarball;
        };

        return @xmlResults;
    };

    my @results = map { &$filter($_) } (@modules);

    if ($repositoryMetadataRequired) {
        my $repoMetadataModule = Module->new($ctx, 'kde-build-metadata');
        $repoMetadataModule->setScmType('metadata');

        # Manually run this through the filter so all the right magic happens.
        ($repoMetadataModule) = &$filter($repoMetadataModule);

        # Ensure we only ever try to update source, not build.
        $repoMetadataModule->phases()->phases('update');
        $repoMetadataModule->setScmType('metadata');
        $repoMetadataModule->setOption('disable-snapshots', 1);

        unshift @results, $repoMetadataModule;
    }

    return @results;
}

# This subroutine takes a reference to the current module list (specifically a
# list of Module objects), and takes a reference to the list of Module objects
# read in from the config file.
#
# For each module in the first list, it is checked to see if options have been
# read in for it, and if so it is left alone.
#
# If the module does not have any options for it, it is assumed that the user
# might mean a named module set (i.e. the module is the name of a module-set),
# and /if/ any of the Modules in the second list are recorded as having come
# from a module set matching the name of the current module, it is used
# instead.
#
# The processed module list is the return value.
sub expandModuleSets
{
    my ($buildModuleList, $knownModules) = @_;

    my $filter = sub {
        my $setName = $_->name();

        # If the module name matches a read-in Module, then it's not a set.
        return $_ if grep { $setName eq $_->name() } (@$knownModules);

        # XML module can only happen if forced by user on command line, allow
        # it.
        return $_ if $_->scmType() eq 'proj';

        # Likewise with l10n module.
        return $_ if $_->scmType() eq 'l10n';

        # Otherwise assume it's a set, replace this with all sub-modules in that
        # module set.
        my @modulesInSet = grep
            { ($_->moduleSet() // '') eq $setName }
        (@$knownModules);

        if (!@modulesInSet) {
            # If we make it to this point the module is either completely
            # unknown, or possibly part of a kde-projects module-set (it can't
            # be part of a regular module-set as those modules are already in
            # @knownModules). To allow things to continue we will
            # optimistically mark the module as a kde-projects module and then
            # cross our fingers...
            $_->setScmType('proj');
            $_->setOption('#guessed-kde-project', 1);
            push @modulesInSet, $_;
        }

        return @modulesInSet;
    };

    return map { &$filter } (@$buildModuleList);
}

# This subroutine reads in the settings from the user's configuration
# file. The filehandle to read from should be passed in as the first
# parameter. The filehandle should be something that the <> operator works
# on, usually some subclass of IO::Handle.
sub read_options
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $fh = shift;
    my @module_list;
    my $rcfile = $ctx->rcFile();
    my ($option, $modulename, %readModules);

    my $fileReader = RecursiveFH->new();
    $fileReader->addFilehandle($fh);

    # Read in global settings
    while ($_ = $fileReader->readLine())
    {
        s/#.*$//;       # Remove comments
        s/^\s*//;       # Remove leading whitespace
        next if (/^\s*$/); # Skip blank lines

        # First command in .kdesrc-buildrc should be a global
        # options declaration, even if none are defined.
        if (not /^global\s*$/)
        {
            error ("Invalid configuration file: $rcfile.");
            error ("Expecting global settings section at b[r[line $.]!");
            die make_exception('Config', 'Missing global section');
        }

        # Now read in each global option.
        parse_module($ctx, $fileReader, 'global');
        last;
    }

    my $using_default = 1;

    # Now read in module settings
    while ($_ = $fileReader->readLine())
    {
        s/#.*$//;          # Remove comments
        s/^\s*//;          # Remove leading whitespace
        next if (/^\s*$/); # Skip blank lines

        # Get modulename (has dash, dots, slashes, or letters/numbers)
        ($modulename) = /^module\s+([-\/\.\w]+)\s*$/;

        if (not $modulename)
        {
            my $moduleSetRE = qr/^module-set\s*([-\/\.\w]+)?\s*$/;
            ($modulename) = m/$moduleSetRE/;

            # modulename may be blank -- use the regex directly to match
            if (not /$moduleSetRE/) {
                error ("Invalid configuration file $rcfile!");
                error ("Expecting a start of module section at r[b[line $.].");
                die make_exception('Config', 'Ungrouped/Unknown option');
            }

            # A moduleset can give us more than one module to add.
            push @module_list, parse_moduleset($ctx, $fileReader, $modulename);
        }
        else {
            # Overwrite options set for existing modules.
            if (my @modules = grep { $_->name() eq $modulename } @module_list) {
                # We check for definedness as a module-set can exist but be
                # unnamed.
                if (!defined $modules[0]->moduleSet()) {
                    warning ("Multiple module declarations for $modules[0]");
                }

                parse_module($ctx, $fileReader, $modules[0]); # Don't re-add
            }
            else {
                push @module_list, parse_module($ctx, $fileReader, $modulename);
            }
        }

        # Don't build default modules if user has their own wishes.
        $using_default = 0;
    }

    # All modules and their options have been read, filter out modules not
    # to update or build, based on the --ignore-modules option already present
    # on the command line. manual-update and manual-build are also relevant,
    # but handled in updateModulePhases.
    @module_list = grep {
        not exists $ignore_list{$_->name()}
    } (@module_list);

    # If the user doesn't ask to build any modules, build a default set.
    # The good question is what exactly should be built, but oh well.
    if ($using_default) {
        $ctx->setup_default_modules();
        return ();
    }

    return @module_list;
}

# Print out an error message, and a list of modules that match that error
# message.  It will also display the log file name if one can be determined.
# The message will be displayed all in uppercase, with PACKAGES prepended, so
# all you have to do is give a descriptive message of what this list of
# packages failed at doing.
sub output_failed_module_list
{
    my ($ctx, $message, @fail_list) = @_;
    assert_isa($ctx, 'ksb::BuildContext');

    $message = uc $message; # Be annoying

    debug ("Message is $message");
    debug ("\tfor ", join(', ', @fail_list));

    if (scalar @fail_list > 0)
    {
        my $homedir = $ENV{'HOME'};
        my $logfile;

        warning ("\nr[b[<<<  PACKAGES $message  >>>]");

        for my $module (@fail_list)
        {
            $logfile = $module->getOption('#error-log-file');

            # async updates may cause us not to have a error log file stored.  There's only
            # one place it should be though, take advantage of side-effect of log_command()
            # to find it.
            if (not $logfile) {
                my $logdir = $module->getLogDir() . "/error.log";
                $logfile = $logdir if -e $logdir;
            }

            $logfile = "No log file" unless $logfile;
            $logfile =~ s|$homedir|~|;

            warning ("r[$module]") if pretending();
            warning ("r[$module] - g[$logfile]") if not pretending();
        }
    }
}

# This subroutine reads the fail_lists dictionary to automatically call
# output_failed_module_list for all the module failures in one function
# call.
sub output_failed_module_lists
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');

    # This list should correspond to the possible phase names (although
    # it doesn't yet since the old code didn't, TODO)
    for my $phase ($ctx->phases()->phases())
    {
        my @failures = $ctx->failedModulesInPhase($phase);
        output_failed_module_list($ctx, "failed to $phase", @failures);
    }

    # See if any modules fail continuously and warn specifically for them.
    my @super_fail = grep {
        ($_->getPersistentOption('failure-count') // 0) > 3
    } (@{$ctx->moduleList()});

    if (@super_fail)
    {
        warning ("\nThe following modules have failed to build 3 or more times in a row:");
        warning ("\tr[b[$_]") foreach @super_fail;
        warning ("\nThere is probably a local error causing this kind of consistent failure, it");
        warning ("is recommended to verify no issues on the system.\n");
    }
}

# This subroutine extract the value from options of the form --option=value,
# which can also be expressed as --option value.  The first parameter is the
# option that the user passed to the cmd line (e.g. --prefix=/opt/foo), and
# the second parameter is a reference to the list of command line options.
# The return value is the value of the option (the list might be shorter by
# 1, copy it if you don't want it to change), or undef if no value was
# provided.
sub extract_option_value($\@)
{
    my ($option, $options_ref) = @_;

    if ($option =~ /=/)
    {
        my @value = split(/=/, $option);
        shift @value; # We don't need the first one, that the --option part.

        return undef if (scalar @value == 0);

        # If we have more than one element left in @value it's because the
        # option itself has an = in it, make sure it goes back in the answer.
        return join('=', @value);
    }

    return undef if scalar @{$options_ref} == 0;
    return shift @{$options_ref};
}

# Like extract_option_value, but throws an exception if the value is not actually present,
# so you don't have to check for it yourself. If you do get a return value, it will be
# defined to something.
sub extract_option_value_required($\@)
{
    my ($option, $options_ref) = @_;
    my $returnValue = extract_option_value($option, @$options_ref);

    if (not defined $returnValue) {
        croak_runtime("Option $option needs to be set to some value instead of left blank");
    }

    return $returnValue;
}

# Utility subroutine to handle setting the environment variable type of value.
# Returns true (non-zero) if this subroutine handled everything, 0 otherwise.
# The first parameter should by the reference to the hash with the 'set-env'
# hash ref, second parameter is the exact option to check, and the third
# option is the value to set that option to.
sub handle_set_env
{
    my ($href, $option, $value) = @_;

    return 0 if $option !~ /^#?set-env$/;

    my ($var, @values) = split(' ', $value);

    ${$href}{$option} //= { };
    ${$href}{$option}->{$var} = join(' ', @values);

    return 1;
}

# A simple wrapper that is used to split the output of 'git config --null'
# correctly. All parameters are then passed to filter_program_output (so look
# there for help on usage).
sub slurp_git_config_output
{
    local $/ = "\000"; # Split on null

    # This gets rid of the trailing nulls for single-line output. (chomp uses
    # $/ instead of hardcoding newline
    chomp(my @output = filter_program_output(undef, @_)); # No filter
    return @output;
}

# Subroutine to process the command line arguments, which should be passed as
# a list. The list of module names passed on the command line will be returned,
# In addition, a second parameter should be passed, a reference to a hash that
# will hold options that cannot be set until the rc-file is read.
#
# NOTE: One exception to the return value is that if --run is passed, the list
# of options to pass to the new program is returned instead (you can tell by
# evaluating the '#start-program' option.
# NOTE: Don't call finish() from this routine, the lock hasn't been obtained.
sub process_arguments
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $pendingOptions = shift;
    my $phases = $ctx->phases();
    my @savedOptions = @_; # Used for --debug
    my @options = @_;
    my $arg;
    my $version = "kdesrc-build $versionNum";
    my $author = <<DONE;
$version was written (mostly) by:
  Michael Pyne <mpyne\@kde.org>

Many people have contributed code, bugfixes, and documentation.

Please report bugs using the KDE Bugzilla, at http://bugs.kde.org/
DONE

    my @enteredModules;

    while ($_ = shift @options)
    {
        SWITCH: {
            /^(--version)$/      && do { print "$version\n"; exit; };
            /^--author$/         && do { print $author; exit; };
            /^(-h)|(--?help)$/   && do {
                print <<DONE;
$version
http://kdesrc-build.kde.org/

This script automates the download, build, and install process for KDE software
using the latest available source code.

You should first setup a configuration file (~/.kdesrc-buildrc). You can do
this by running the kdesrc-build-setup program, which should be included with
this one.  You can also copy the kdesrc-buildrc-sample file (which should be
included) to ~/.kdesrc-buildrc.

Basic synopsis, after setting up .kdesrc-buildrc:
\$ $0 [--options] [module names]

The module names can be either the name of an individual module (as set in your
configuration with a module declaration, or a use-modules declaration), or of a
module set (as set with a module-set declaration).

If you don\'t specify any particular module names, then every module you have
listed in your configuration will be built, in the order listed.

Copyright (c) 2003 - 2011 $author
The script is distributed under the terms of the GNU General Public License
v2, and includes ABSOLUTELY NO WARRANTY!!!

Options:
    --no-src             Skip contacting the source server.
    --no-build           Skip the build process.
    --no-install         Don't automatically install after build.

    --src-only           Only update the source code (Identical to --no-build
                         at this point).
    --build-only         Build only, don't perform updates or install.

    --rc-file=<filename> Read configuration from filename instead of default.

    --resume-from=<pkg>  Starts building from the given package, without
                         performing the source update.
    --resume-after=<pkg> Starts building after the given package, without
                         performing the source update.

    --reconfigure        Run CMake/configure again, but don't clean the build
                         directory.
    --build-system-only  Create the build infrastructure, but don't actually
                         perform the build.

    --<option>=          Any unrecognized options are added to the global
                         configuration, overriding any value that may exist.
    --<module>,<option>= Likewise, this allows you to override any module
                         specific option from the command line.

    --pretend (or -p)    Don't actually contact the source server, run make,
                         or create/delete files and directories.  Instead,
                         output what the script would have done.
    --refresh-build      Start the build from scratch.

    --help               You\'re reading it. :-)
    --version            Output the program version.

You can get more help by going online to http://kdesrc-build.kde.org/ to view
the online documentation.  If you have installed kdesrc-build you may also be
able to view the documentation using KHelpCenter or Konqueror at the URL
help:/kdesrc-build
DONE
                # We haven't done any locking... no need to finish()
                exit 0;
            };

            /^--install$/ && do {
                $run_mode = 'install';
                $phases->phases('install');

                last SWITCH;
            };

            /^--uninstall$/ && do {
                $run_mode = 'uninstall';
                $phases->phases('uninstall');

                last SWITCH;
            };

            /^--no-snapshots$/ && do {
                $ctx->setOption('#disable-snapshots', 1);
                last SWITCH;
            };

            /^--no-(src|svn)$/ && do {
                $phases->filterOutPhase('update');
                last SWITCH;
            };

            /^--no-install$/ && do {
                $phases->filterOutPhase('install');
                last SWITCH;
            };

            /^--no-tests$/ && do {
                # The "right thing" to do
                $phases->filterOutPhase('test');

                # What actually works at this point.
                $ctx->setOption('#run-tests', 0);
                last SWITCH;
            };

            /^--(force-build)|(no-build-when-unchanged)$/ && do {
                $ctx->setOption('#build-when-unchanged', 1);
                last SWITCH;
            };

            /^(-v)|(--verbose)$/ && do {
                $ctx->setOption('#debug-level', ksb::Debug::WHISPER);
                last SWITCH;
            };

            /^(-q)|(--quiet)$/ && do {
                $ctx->setOption('#debug-level', ksb::Debug::NOTE);
                last SWITCH;
            };

            /^--really-quiet$/ && do {
                $ctx->setOption('#debug-level', ksb::Debug::WARNING);
                last SWITCH;
            };

            /^--debug$/ && do {
                $ctx->setOption('#debug-level', ksb::Debug::DEBUG);
                debug ("Commandline was: ", join(', ', @savedOptions));
                last SWITCH;
            };

            /^--reconfigure$/ && do {
                $ctx->setOption('#reconfigure', 1);
                last SWITCH;
            };

            /^--color$/ && do {
                $ctx->setOption('#colorful-output', 1);
                last SWITCH;
            };

            /^--no-color$/ && do {
                $ctx->setOption('#colorful-output', 0);
                last SWITCH;
            };

            /^--no-build$/ && do {
                $phases->filterOutPhase('build');
                last SWITCH;
            };

            /^--async$/ && do {
                $ctx->setOption('#async', 1);
                last SWITCH;
            };

            /^--no-async$/ && do {
                $ctx->setOption('#async', 0);
                last SWITCH;
            };

            # Although equivalent to --no-build at this point, someday the
            # script may interpret the two differently, so get ready now.
            /^--(src|svn)-only$/ && do {      # Identically to --no-build
                $phases->phases('update');

                # We have an auto-switching function that we only want to run
                # if --src-only was passed to the command line, so we still
                # need to set a flag for it.
                $ctx->setOption('#allow-auto-repo-move', 1);
                last SWITCH;
            };

            # Don't run source updates or install
            /^--build-only$/ && do {
                $phases->phases('build');
                last SWITCH;
            };

            # Start up a program with the environment variables as
            # read from the config file.
            /^--run=?/ && do {
                my $program = extract_option_value_required($_, @options);
                $ctx->setOption('#start-program', $program);

                # Save remaining command line options to pass to the program.
                return @options;
            };

            /^--build-system-only$/ && do {
                $ctx->setOption('#build-system-only', 1);
                last SWITCH;
            };

            /^--rc-file=?/ && do {
                my $rcfile = extract_option_value_required($_, @options);
                $ctx->setRcFile($rcfile);

                last SWITCH;
            };

            /^--prefix=?/ && do {
                my $prefix = extract_option_value_required($_, @options);

                $ctx->setOption('#kdedir', $prefix);
                $ctx->setOption('#reconfigure', 1);

                last SWITCH;
            };

            /^--nice=?/ && do {
                my $niceness = extract_option_value_required($_, @options);

                $ctx->setOption('#niceness', $niceness);
                last SWITCH;
            };

            /^--ignore-modules$/ && do {
                # We need to keep read_options() from adding these modules to
                # the build list, taken care of by ignore_list.  We then need
                # to remove the modules from the command line, taken care of
                # by the @options = () statement;
                my @innerOptions = ();
                foreach (@options)
                {
                    if (/^-/)
                    {
                        push @innerOptions, $_;
                    }
                    else
                    {
                        $ignore_list{$_} = 1;

                        # the pattern match doesn't work with $_, alias it.
                        my $module = $_;
                        @enteredModules = grep (!/^$module$/, @enteredModules);
                    }
                }
                @options = @innerOptions;

                last SWITCH;
            };

            /^(--dry-run)|(--pretend)|(-p)$/ && do {
                $ctx->setOption('#pretend', 1);
                # Simulate the build process too.
                $ctx->setOption('#build-when-unchanged', 1);
                last SWITCH;
            };

            /^--refresh-build$/ && do {
                $ctx->setOption('#refresh-build', 1);
                last SWITCH;
            };

            /^--delete-my-patches$/ && do {
                $ctx->setOption('#delete-my-patches', 1);
                last SWITCH;
            };

            /^(--revision|-r)=?/ && do {
                my $revision = extract_option_value_required($_, @options);
                $ctx->setOption('#revision', $revision);

                last SWITCH;
            };

            /^--resume-from=?/ && do {
                $_ = extract_option_value_required($_, @options);
                $ctx->setOption('#resume-from', $_);

                last SWITCH;
            };

            /^--resume-after=?/ && do {
                $_ = extract_option_value_required($_, @options);
                $ctx->setOption('#resume-after', $_);

                last SWITCH;
            };

            /^--/ && do {
                # First let's see if they're trying to override a global option.
                my ($option) = /^--([-\w\d\/]+)/;
                my $value = extract_option_value($_, @options);

                if ($ctx->hasOption($option))
                {
                    $ctx->setOption("#$option", $value);
                }
                else
                {
                    # Module specific option.  The module options haven't been
                    # read in, so we'll just have to assume that the module the
                    # user passes actually does exist.
                    my ($module, $option) = /^--([\w\/-]+),([-\w\d\/]+)/;

                    if (not $module)
                    {
                        print "Unknown option $_\n";
                        exit 8;
                    }

                    ${$pendingOptions}{$module}{"$option"} = $value;
                }

                last SWITCH;
            };

            /^-/ && do { print "WARNING: Unknown option $_\n"; last SWITCH; };

            # Strip trailing slashes.
            s/\/*$//;
            push @enteredModules, $_; # Reconstruct correct @options
        }
    }

    # Don't go async if only performing one phase.  It (should) work but why
    # risk it?
    if (scalar $phases->phases() == 1)
    {
        $ctx->setOption('#async', 0);
    }

    return map { Module->new($ctx, $_) } (@enteredModules);
}

sub updateModulePhases
{
    whisper ("Filtering out module phases.");
    for my $module (@_) {
        if ($module->getOption('manual-update') ||
            $module->getOption('no-svn') || $module->getOption('no-src'))
        {
            $module->phases()->clear();
            next;
        }

        if ($module->getOption('manual-build')) {
            $module->phases()->filterOutPhase('build');
            $module->phases()->filterOutPhase('test');
            $module->phases()->filterOutPhase('install');
        }

        $module->phases()->filterOutPhase('install') unless $module->getOption('install-after-build');
        $module->phases()->addPhase('test') if $module->getOption('run-tests');
    }

    return @_;
}

# Subroutine to remove a package from the package build list.  This
# is for use when you've detected an error that should keep the
# package from building, but you don't want to abort completely.
#
# First parameter is the module that did not build.
# Second parameter is the IPC connection to send the required message over
# Third parameter is the error reason (e.g. IPC::MODULE_CONFLICT).
# No return value;
sub dont_build
{
    my $module = assert_isa(shift, 'Module');
    my $ctx = assert_isa($module->buildContext(), 'ksb::BuildContext');
    my $ipc = shift;
    my $reason = shift;

    whisper ("Not building $module");

    if ($ipc)
    {
        $ipc->sendIPCMessage($reason, $module->name());
    }
    else
    {
        # Weed out matches of the module name
        $module->phases()->filterOutPhase('build');

        if ($module->getOption('#conflict-found'))
        {
            # Record now for posterity
            $module->setPersistentOption("conflicts-present", 1);
        }
    }

    if ($reason != IPC::MODULE_UPTODATE)
    {
        $ctx->markModulePhaseFailed('update', $module);
    }
}

# Subroutine to split a url into a protocol and host
sub split_url
{
    my $url = shift;
    my ($proto, $host) = ($url =~ m|([^:]*)://([^/]*)/|);

    return ($proto, $host);
}

# This subroutine checks if we are supposed to use ssh agent by examining the
# environment, and if so checks if ssh-agent has a list of identities.  If it
# doesn't, we run ssh-add (with no arguments) and inform the user.  This can
# be controlled with the disable-agent-check parameter.
sub check_for_ssh_agent
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');

    # Don't bother with all this if the user isn't even using SSH.
    return 1 if pretending();

    my @svnServers = grep {
        $_->scmType() eq 'svn'
    } ($ctx->modulesInPhase('update'));

    my @gitServers = grep {
        $_->scmType() eq 'git'
    } ($ctx->modulesInPhase('update'));

    my @sshServers = grep {
        my ($proto, $host) = split_url($_->getOption('svn-server'));

        # Check if ssh is explicitly used in the proto, or if the host is the
        # developer main svn.
        (defined $proto && $proto =~ /ssh/) || (defined $host && $host =~ /^svn\.kde\.org/);
    } @svnServers;

    push @sshServers, grep {
        # Check for git+ssh:// or git@git.kde.org:/path/etc.
        my $repo = $_->getOption('repository');
        ($repo =~ /^git\+ssh:\/\//) || ($repo =~ /^[a-zA-Z0-9_.]+@.*:\//);
    } @gitServers;

    whisper ("\tChecking for SSH Agent") if (scalar @sshServers);
    return 1 if (not @sshServers) or $ctx->getOption('disable-agent-check');

    # We're using ssh to download, see if ssh-agent is running.
    return 1 unless exists $ENV{'SSH_AGENT_PID'};

    my $pid = $ENV{'SSH_AGENT_PID'};

    # It's supposed to be running, let's see if there exists the program with
    # that pid (this check is linux-specific at the moment).
    if (-d "/proc" and not -e "/proc/$pid")
    {
        warning ("r[ *] SSH Agent is enabled, but y[doesn't seem to be running].");
        warning ("Since SSH is used to download from Subversion you may want to see why");
        warning ("SSH Agent is not working, or correct the environment variable settings.");

        return 0;
    }

    # The agent is running, but does it have any keys?  We can't be more specific
    # with this check because we don't know what key is required.
    my $noKeys = 0;

    filter_program_output(sub { $noKeys ||= /no identities/ }, 'ssh-add', '-l');

    if ($noKeys)
    {
        # Use print so user can't inadvertently keep us quiet about this.
        print ksb_clr (<<EOF);
b[y[*] SSH Agent does not appear to be managing any keys.  This will lead to you
  being prompted for every module update for your SSH passphrase.  So, we're
  running g[ssh-add] for you.  Please type your passphrase at the prompt when
  requested, (or simply Ctrl-C to abort the script).
EOF
        my @commandLine = ('ssh-add');
        my $identFile = $ctx->getOption('ssh-identity-file');
        push (@commandLine, $identFile) if $identFile;

        my $result = system (@commandLine);
        if ($result) # Run this code for both death-by-signal and nonzero return
        {
            my $rcfile = $ctx->rcFile();

            print "\nUnable to add SSH identity, aborting.\n";
            print "If you don't want kdesrc-build to check in the future,\n";
            print ksb_clr ("Set the g[disable-agent-check] option to g[true] in your $rcfile.\n\n");

            return 0;
        }
    }

    return 1;
}

# Subroutine to add the 'kde:' alias to the user's git config if it's not
# already set.
sub verifyGitConfig
{
    my $configOutput = `git config --global --get url.git://anongit.kde.org/.insteadOf kde: 2>/dev/null`;

    # 0 means no error, 1 means no such section exists -- which is OK
    if ((my $errNum = $? >> 8) >= 2) {
        my $error = "Code $errNum";
        my %errors = (
            3   => 'Invalid config file (~/.gitconfig)',
            4   => 'Could not write to ~/.gitconfig',
            128 => 'HOME environment variable is not set (?)',
        );

        $error = $errors{$errNum} if exists $errors{$errNum};
        error (" r[*] Unable to run b[git] command:\n\t$error");
        return 0;
    }

    # If we make it here, I'm just going to assume git works from here on out
    # on this simple task.
    if ($configOutput !~ /^kde:\s*$/) {
        info ("\tAdding git download kde: alias");
        my $result = safe_system(
            qw(git config --global --add url.git://anongit.kde.org/.insteadOf kde:)
        ) >> 8;
        return 0 if $result != 0;
    }

    $configOutput = `git config --global --get url.git\@git.kde.org:.pushInsteadOf kde: 2>/dev/null`;

    if ($configOutput !~ /^kde:\s*$/) {
        info ("\tAdding git upload kde: alias");
        my $result = safe_system(
            qw(git config --global --add url.git@git.kde.org:.pushInsteadOf kde:)
        ) >> 8;
        return 0 if $result != 0;
    }

    return 1;
}

# Subroutine to update a list of modules.  The first
# parameter is a reference of a list of the modules to update.
# If the module has not already been checkout out, this subroutine
# will do so for you.
#
# The second parameter should be the build context (ksb::BuildContext)
# for this run.
#
# The $ipc variable contains an object that is responsible for communicating
# the status of building the modules.  This function must account for every
# module in $ctx's update phase to $ipc before returning.
#
# Returns 0 on success, non-zero on error.
sub handle_updates
{
    my ($ipc, $ctx) = @_;
    my $kdesrc = $ctx->getSourceDir();
    my @update_list = $ctx->modulesInPhase('update');

    # No reason to print out the text if we're not doing anything.
    if (!@update_list)
    {
        $ipc->sendIPCMessage(IPC::ALL_UPDATING, "update-list-empty");
        return 0;
    }

    if (not check_for_ssh_agent($ctx))
    {
        $ipc->sendIPCMessage(IPC::ALL_FAILURE, "ssh-failure");
        return 1;
    }

    # Be much quieter if operating multiprocess and the user has not chosen a
    # different mode.
    if ($ipc->supportsConcurrency() && !$ctx->getOption('#debug-level'))
    {
        $ctx->setOption('#debug-level', ksb::Debug::WARNING);
    }

    if (grep { $_->scm()->isa('GitUpdate') } @update_list) {
        verifyGitConfig();
    }

    note ("<<<  Updating Source Directories  >>>");
    info (" "); # Add newline for aesthetics unless in quiet mode.

    if (not -e $kdesrc)
    {
        whisper ("KDE source download directory doesn't exist, creating.\n");
        if (not super_mkdir ($kdesrc))
        {
            error ("Unable to make directory r[$kdesrc]!");
            $ipc->sendIPCMessage(IPC::ALL_FAILURE, "no-source-dir");

            return 1;
        }
    }

    # Once at this point, any errors we get should be limited to a module,
    # which means we can tell the build thread to start.
    $ipc->sendIPCMessage(IPC::ALL_UPDATING, "starting-updates");

    # Make sure KDE's SSL signature is present since --non-interactive is
    # passed to svn.
    if (grep { $_->scmType() eq 'svn' } @update_list) {
        SvnUpdate::_install_missing_ssl_signature();
    }

    my $hadError = 0;
    foreach my $module (@update_list)
    {
        # Note that this must be in this order to avoid accidentally not
        # running ->update() from short-circuiting if an error is noted.
        $hadError = !$module->update($ipc, $ctx) || $hadError;
    }

    info ("<<<  Update Complete  >>>\n");
    return $hadError;
}

# Returns a hash digest of the given options in the list.  The return value is
# base64-encoded at this time.
#
# Note: Don't be dumb and pass data that depends on execution state as the
# returned hash is almost certainly not useful for whatever you're doing with
# it.  (i.e. passing a reference to a list is not helpful, pass the list itself)
#
# Parameters: List of scalar values to hash.
# Return value: base64-encoded hash value.
sub get_list_digest
{
    use Digest::MD5 "md5_base64"; # Included standard with Perl 5.8

    return md5_base64(@_);
}

# Subroutine to run CMake to create the build directory for a module.
# CMake is not actually run if pretend mode is enabled.
#
# First parameter is the module to run cmake on.
# Return value is the shell return value as returned by log_command().  i.e.
# 0 for success, non-zero for failure.
sub safe_run_cmake
{
    my $module = assert_isa(shift, 'Module');
    my $srcdir = $module->fullpath('source');
    my @commands = split_quoted_on_whitespace ($module->getOption('cmake-options'));

    # grep out empty fields
    @commands = grep {!/^\s*$/} @commands;

    # Add -DBUILD_foo=OFF options for the directories in do-not-compile.
    # This will only work if the CMakeLists.txt file uses macro_optional_add_subdirectory()
    my @masked_directories = split(' ', $module->getOption('do-not-compile'));
    push @commands, "-DBUILD_$_=OFF" foreach @masked_directories;

    # Get the user's CXXFLAGS, use them if specified and not already given
    # on the command line.
    my $cxxflags = $module->getOption('cxxflags');
    if ($cxxflags and not grep { /^-DCMAKE_CXX_FLAGS(:\w+)?=/ } @commands)
    {
        push @commands, "-DCMAKE_CXX_FLAGS:STRING=$cxxflags";
    }

    my $prefix = $module->installationPath();

    push @commands, "-DCMAKE_INSTALL_PREFIX=$prefix";

    if ($module->getOption('run-tests') &&
        !grep { /^\s*-DKDE4_BUILD_TESTS(:BOOL)?=(ON|TRUE|1)\s*$/ } (@commands)
       )
    {
        whisper ("Enabling tests");
        push @commands, "-DKDE4_BUILD_TESTS:BOOL=ON";

        # Also enable phonon tests.
        if ($module =~ /^phonon$/) {
            push @commands, "-DPHONON_BUILD_TESTS:BOOL=ON";
        }
    }

    if ($module->getOption('run-tests') eq 'upload')
    {
        whisper ("Enabling upload of test results");
        push @commands, "-DBUILD_experimental:BOOL=ON";
    }

    unshift @commands, 'cmake', $srcdir; # Add to beginning of list.

    my $old_options =
        $module->getPersistentOption('last-cmake-options') || '';
    my $builddir = $module->fullpath('build');

    if (($old_options ne get_list_digest(@commands)) ||
        $module->getOption('reconfigure') ||
        ! -e "$builddir/CMakeCache.txt" # File should exist only on successful cmake run
       )
    {
        info ("\tRunning g[cmake]...");

        # Remove any stray CMakeCache.txt
        safe_unlink ("$srcdir/CMakeCache.txt")   if -e "$srcdir/CMakeCache.txt";
        safe_unlink ("$builddir/CMakeCache.txt") if -e "$builddir/CMakeCache.txt";

        $module->setPersistentOption('last-cmake-options', get_list_digest(@commands));
        return log_command($module, "cmake", \@commands);
    }

    # Skip cmake run
    return 0;
}

# Subroutine to recursively symlink a directory into another location, in a
# similar fashion to how the XFree/X.org lndir() program does it.  This is
# reimplemented here since some systems lndir doesn't seem to work right.
#
# As a special exception to the GNU GPL, you may use and redistribute this
# function however you would like (i.e. consider it public domain).
#
# The first parameter is the directory to symlink from.
# The second parameter is the destination directory name.
#
# e.g. if you have $from/foo and $from/bar, lndir would create $to/foo and
# $to/bar.
#
# All intervening directories will be created as needed.  In addition, you
# may safely run this function again if you only want to catch additional files
# in the source directory.
#
# Note that this function will unconditionally output the files/directories
# created, as it is meant to be a close match to lndir.
#
# RETURN VALUE: Boolean true (non-zero) if successful, Boolean false (0, "")
#               if unsuccessful.
sub safe_lndir
{
    my ($from, $to) = @_;

    # Create destination directory.
    if (not -e $to)
    {
        print "$to\n";
        if (not pretending() and not super_mkdir($to))
        {
            error ("Couldn't create directory r[$to]: b[r[$!]");
            return 0;
        }
    }

    # Create closure callback subroutine.
    my $wanted = sub {
        my $dir = $File::Find::dir;
        my $file = $File::Find::fullname;
        $dir =~ s/$from/$to/;

        # Ignore the .svn directory and files.
        return if $dir =~ m,/\.svn,;

        # Create the directory.
        if (not -e $dir)
        {
            print "$dir\n";

            if (not pretending())
            {
                super_mkdir ($dir) or croak_runtime("Couldn't create directory $dir: $!");
            }
        }

        # Symlink the file.  Check if it's a regular file because File::Find
        # has no qualms about telling you you have a file called "foo/bar"
        # before pointing out that it was really a directory.
        if (-f $file and not -e "$dir/$_")
        {
            print "$dir/$_\n";

            if (not pretending())
            {
                symlink $File::Find::fullname, "$dir/$_" or
                    croak_runtime("Couldn't create file $dir/$_: $!");
            }
        }
    };

    # Recursively descend from source dir using File::Find
    eval {
        find ({ 'wanted' => $wanted,
                'follow_fast' => 1,
                'follow_skip' => 2},
              $from);
    };

    if ($@)
    {
        error ("Unable to symlink $from to $to: $@");
        return 0;
    }

    return 1;
}

# Subroutine to delete recursively, everything under the given directory,
# unless we're in pretend mode.
#
# i.e. the effect is similar to "rm -r $arg/* $arg/.*".
#
# This assumes we're called from a separate child process.  Therefore the
# normal logging routines are /not used/, since our output will be logged
# by the parent kdesrc-build.
#
# The first parameter should be the absolute path to the directory to delete.
#
# Returns boolean true on success, boolean false on failure.
sub prune_under_directory
{
    my $dir = shift;

    print "starting delete of $dir\n";
    eval {
        remove_tree($dir, { keep_root => 1 });
    };

    if ($@)
    {
        error ("\tUnable to clean r[$dir]:\n\ty[b[$@]");
        return 0;
    }

    return 1;
}

# This function converts any 'l10n' references on the command line to return a l10n
# module with the proper build system, scm type, etc.
#
# The languages are selected using global/kde-languages (which should be used
# exclusively from the configuration file).
sub expandl10nModules
{
    my ($ctx, @modules) = @_;
    my $l10n = 'l10n-kde4';

    assert_isa($ctx, 'ksb::BuildContext');

    # Only filter if 'l10n' is actually present in list.
    my @matches = grep {$_->name() =~ /^(?:$l10n|l10n)$/} @modules;
    my @langs = split(' ', $ctx->getOption('kde-languages'));

    return @modules if (!@matches || !@langs);

    my $l10nModule;
    for my $match (@matches)
    {
        # Remove all instances of l10n.
        @modules = grep {$_->name() ne $match->name()} @modules;

        # Save l10n module if user had it in config. We only save the first
        # one encountered though.
        $l10nModule //= $match;
    }

    # No l10n module? Just create one.
    $l10nModule //= Module->new($ctx, $l10n);

    whisper ("\tAdding languages ", join(';', @langs), " to build.");

    $l10nModule->setScmType('l10n');
    my $scm = $l10nModule->scm();

    # Add all required directories to the l10n module. Its buildsystem should
    # know to skip scripts and templates.
    $scm->setLanguageDirs(qw/scripts templates/, @langs);
    $l10nModule->setBuildSystem($scm);

    push @modules, $l10nModule;
    return @modules;
}

# This subroutine checks for programs which are absolutely essential to the
# *build* process and returns false if they are not all present. Right now this
# just means qmake and cmake (although this depends on what modules are
# actually present in the build context).
#
# Pass the build context as the only parameter.
sub checkForEssentialBuildPrograms
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');

    return 1 if pretending();

    my @buildModules = $ctx->modulesInPhase('build');
    my %requiredPrograms;
    my %modulesRequiringProgram;

    foreach my $module ($ctx->modulesInPhase('build')) {
        my @progs = $module->buildSystem()->requiredPrograms();

        # Deliberately used @, since requiredPrograms can return a list.
        @requiredPrograms{@progs} = 1;

        foreach my $prog (@progs) {
            $modulesRequiringProgram{$prog} //= { };
            $modulesRequiringProgram{$prog}->{$module->name()} = 1;
        }
    }

    my $wasError = 0;
    for my $prog (keys %requiredPrograms) {
        my %requiredPackages = (
            qmake => 'Qt',
            cmake => 'CMake',
        );

        my $programPath = absPathToExecutable($prog);

        # qmake is not necessarily named 'qmake'
        if (!$programPath && $prog eq 'qmake') {
            $programPath = QMakeBuildSystem::absPathToQMake();
        }

        if (!$programPath) {
            # Don't complain about Qt if we're building it...
            if ($prog eq 'qmake' && (
                    grep { $_->buildSystemType() eq 'Qt' } (@buildModules)) ||
                    pretending()
                )
            {
                next;
            }

            $wasError = 1;
            my $reqPackage = $requiredPackages{$prog} || $prog;

            my @modulesNeeding = keys %{$modulesRequiringProgram{$prog}};
            local $, = ', '; # List separator in output

            error (<<"EOF");

Unable to find r[b[$prog]. This program is absolutely essential for building
the modules: y[@modulesNeeding].
Please ensure the development packages for
$reqPackage are installed by using your distribution's package manager.

You can also see the
http://techbase.kde.org/Getting_Started/Build/Distributions page for
information specific to your distribution (although watch for outdated
information :( ).
EOF
        }
    }

    return !$wasError;
}

# Subroutine to handle the build process.
# First parameter is a reference of a list containing the packages
# we are to build.
# If the packages are not already checked-out and/or updated, this
# subroutine WILL NOT do so for you.
#
# This subroutine assumes that the $kdesrc directory has already been
# set up.  It will create $builddir if it doesn't already exist.
#
# If $builddir/$module/.refresh-me exists, the subroutine will
# completely rebuild the module.
#
# Returns 0 for success, non-zero for failure.
sub handle_build
{
    my ($ipc, $ctx) = @_;
    my @build_done;
    my @modules = grep ($_->name() !~ /^(KDE\/)?kde-common$/, $ctx->modulesInPhase('build'));
    my $result = 0;

    # No reason to print building messages if we're not building.
    return 0 if scalar @modules == 0;

    note ("<<<  Build Process  >>>");

    # Check for absolutely essential programs now.
    if (!checkForEssentialBuildPrograms($ctx) &&
        !exists $ENV{KDESRC_BUILD_IGNORE_MISSING_PROGRAMS})
    {
        error (" r[b[*] Aborting now to save a lot of wasted time.");
        error (" y[b[*] export KDESRC_BUILD_IGNORE_MISSING_PROGRAMS=1 and re-run (perhaps with --no-src)");
        error (" r[b[*] to continue anyways. If this check was in error please report a bug against");
        error (" y[b[*] kdesrc-build at https://bugs.kde.org/");

        return 1;
    }

    # IPC queue should have a message saying whether or not to bother with the
    # build.
    $ipc->waitForStreamStart();

    my $outfile = undef;

    if (not pretending())
    {
        $outfile = $ctx->getLogDir() . '/build-status';
        open STATUS_FILE, ">$outfile" or do {
            error (<<EOF);
	Unable to open output status file r[b[$outfile]
	You won't be able to use the g[--resume] switch next run.\n";
EOF
            $outfile = undef;
        };
    }

    my $num_modules = scalar @modules;
    my $i = 1;

    while (my $module = shift @modules)
    {
        my $moduleSet = $module->moduleSet() // '';
        my $moduleName = $module->name();
        my $modOutput = "$module";

        if (debugging(ksb::Debug::WHISPER)) {
            $modOutput .= " (build system " . $module->buildSystemType() . ")"
        }

        if ($moduleSet) {
            note ("Building g[$modOutput] from g[$moduleSet] ($i/$num_modules)");
        }
        else {
            note ("Building g[$modOutput] ($i/$num_modules)");
        }

        $ctx->resetEnvironment();
        $module->setupEnvironment();

        my $start_time = time;

        # If using IPC, read in the contents of the message buffer, and wait
        # for completion of the svn update if necessary.

        my ($resultStatus, $message) = $ipc->waitForModule($module);

        given ($resultStatus) {
            when ('failed') {
                $result = 1;
                $ctx->markModulePhaseFailed('update', $module);
                print STATUS_FILE "$module: Failed on update.\n";

                # Increment failed count to track when to start bugging the
                # user to fix stuff.
                my $fail_count = $module->getPersistentOption('failure-count') // 0;
                ++$fail_count;
                $module->setPersistentOption('failure-count', $fail_count);

                error ("\tUnable to update r[$module], build canceled.");
                next;
            }
            when ('skipped') {
                # i.e. build should be skipped.
                info ("\tNo changes to source code.");
            }
            when ('success') {
                note ("\tSource update complete for g[$module]: $message");
            }
        }

        # Skip actually building a module if the user has selected to skip
        # builds when the source code was not actually updated. But, don't skip
        # if we didn't successfully build last time.
        if (!$module->getOption('build-when-unchanged') &&
            $resultStatus eq 'skipped' &&
            ($module->getPersistentOption('failure-count') // 0) == 0)
        {
            note ("\tSkipping g[$module], its source code has not changed.");
            $i++;
            next;
        }

        if ($module->build())
        {
            my $elapsed = prettify_seconds(time - $start_time);
            print STATUS_FILE "$module: Succeeded after $elapsed.\n" if $outfile;
            $module->setPersistentOption('last-build-rev', $module->currentScmRevision());
            $module->setPersistentOption('failure-count', 0);

            info ("\tOverall time for g[$module] was g[$elapsed].");
            push @build_done, $moduleName;
        }
        else
        {
            my $elapsed = prettify_seconds(time - $start_time);
            print STATUS_FILE "$module: Failed after $elapsed.\n" if $outfile;

            info ("\tOverall time for r[$module] was g[$elapsed].");
            $ctx->markModulePhaseFailed('build', $module);
            $result = 1;

            # Increment failed count to track when to start bugging the
            # user to fix stuff.

            my $fail_count = $module->getPersistentOption('failure-count') // 0;
            ++$fail_count;
            $module->setPersistentOption('failure-count', $fail_count);

            if ($module->getOption('stop-on-failure'))
            {
                note ("\n$module didn't build, stopping here.");
                return 1; # Error
            }
        }

        $i++;
    }
    continue # Happens at the end of each loop and on next
    {
        print "\n"; # Space things out
    }

    if ($outfile)
    {
        close STATUS_FILE;

        # Update the symlink in latest to point to this file.
        my $logdir = $ctx->getSubdirPath('log-dir');
        if (-l "$logdir/latest/build-status") {
            safe_unlink("$logdir/latest/build-status");
        }
        symlink($outfile, "$logdir/latest/build-status");
    }

    info ("<<<  Build Done  >>>");
    info ("\n<<<  g[PACKAGES SUCCESSFULLY BUILT]  >>>") if scalar @build_done > 0;

    if (not pretending())
    {
        # Print out results, and output to a file
        my $kdesrc = $ctx->getSourceDir();
        open BUILT_LIST, ">$kdesrc/successfully-built";
        foreach my $module (@build_done)
        {
            info ("$module");
            print BUILT_LIST "$module\n";
        }
        close BUILT_LIST;
    }
    else
    {
        # Just print out the results
        info ('g[', join ("]\ng[", @build_done), ']');
    }

    info (" "); # Add newline for aesthetics if not in quiet mode.
    return $result;
}

# Subroutine to exit the script cleanly, including removing any
# lock files created.  If a parameter is passed, it is interpreted
# as an exit code to use
sub finish
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $exitcode = shift // 0;

    @main::atexit_subs = ();
    if (pretending() || $main::basePid != $$) {
        # Abort early if pretending or if we're not the same process
        # that was started by the user (e.g. async mode, forked pipe-opens
        exit $exitcode;
    }

    $ctx->closeLock();
    $ctx->storePersistentOptions();

    my $logdir = $ctx->getLogDir();
    note ("Your logs are saved in y[$logdir]");

    exit $exitcode;
}

# Subroutine to handle the installation process.  Simply calls
# 'make install' in the build directory.
#
# Return value is a shell-style success code (0 == success)
sub handle_install
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my @modules = @_;

    # Check all modules passed.
    map { assert_isa($_, 'Module') } @modules;

    @modules = grep { $_->buildSystem()->needsInstalled() } (@modules);
    my $result = 0;

    for my $module (@modules)
    {
        $ctx->resetEnvironment();
        $result = $module->install() || $result;

        if ($result && $module->getOption('stop-on-failure')) {
            note ("y[Stopping here].");
            return 1; # Error
        }
    }

    return $result;
}

# Subroutine to handle the installation process.  Simply calls
# 'make uninstall' in the build directory, assuming that Qt or
# CMake can actually handle it.
#
# The order of the modules is often significant, in the case of
# this function the modules are uninstalled IN THE OPPOSITE ORDER
# than passed in, to be more compatible with the rest of the code.
#
# Return value is a shell-style success code (0 == success)
sub handle_uninstall
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my @modules = @_;

    # Check all modules passed.
    map { assert_isa($_, 'Module') } @modules;

    @modules = grep { $_->buildSystem()->needsInstalled() } (@modules);
    my $result = 0;

    for my $module (reverse @modules)
    {
        $ctx->resetEnvironment();
        $result = $module->uninstall() || $result;

        if ($result && $module->getOption('stop-on-failure'))
        {
            note ("y[Stopping here].");
            return 1; # Error
        }
    }

    return $result;
}

# This subroutine is used in order to apply any module-specific filtering that
# is necessary after reading command line and rc-file options. (This is as
# opposed to phase filters, which leave each module as-is but change the phases
# they operate part of, this function could remove a module entirely from the
# build).
#
# Famously used for --resume-from and --resume-after, but more could be added
# in theory.
#
# Requires a list of "Module" type objects, and returns the list with filters
# applied. Right now the return list will be a subset of the given list, but
# it's best not to rely on that long-term.
sub applyModuleFilters
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my @moduleList = @_;

    if (!$ctx->getOption('resume-from') && !$ctx->getOption('resume-after'))
    {
        debug ("No --resume-from or --resume-after seems present.");
        return @moduleList;
    }

    if ($ctx->getOption('resume-from') && $ctx->getOption('resume-after'))
    {
        # This one's an error.
        error (<<EOF);
You specified both r[b[--resume-from] and r[b[--resume-after] but you can only
use one.
EOF

        croak_runtime("Both --resume-after and --resume-from specified.");
    }

    my $resumePoint = $ctx->getOption('resume-from') ||
                      $ctx->getOption('resume-after');

    debug ("Looking for $resumePoint for --resume-* option");

    # || 0 is a hack to force Boolean context.
    my $filterInclusive = $ctx->getOption('resume-from') || 0;
    my $found = 0;

    # If we already found our resume point, include this module. If this module
    # *is* the resume point, include it if filterInclusive is true, otherwise
    # just flag it. Module sets complicate the logic a bit, but it's basically
    # just harder in the --resume-after case where we have to leave that module
    # set before we can allow modules through the filter.
    my $filterTest = sub {
        my $moduleSet = $_->moduleSet() // '';
        if ($found) {
            return $filterInclusive || $moduleSet ne $resumePoint;
        }
        $found = $_->{'name'} eq $resumePoint || $moduleSet eq $resumePoint;
        return $found && $filterInclusive;
    };

    my @resultList = grep { &$filterTest } (@moduleList);

    if (!@resultList && @moduleList) {
        # Lost all modules somehow.
        croak_runtime("Unknown resume point $resumePoint.");
    }

    return @resultList;
}

# Exits out of kdesrc-build, executing the user's preferred shell instead.  The
# difference is that the environment variables should be as set in kdesrc-build
# instead of as read from .bashrc and friends.
#
# You should pass in the options to run the program with as a list.
#
# Meant to implement the --run command line option.
sub execute_command_line_program
{
    my ($program, @args) = @_;

    if (!$program)
    {
        error ("You need to specify a program with the --run option.");
        exit 1; # Can't use finish here.
    }

    if (($< != $>) && ($> == 0))
    {
        error ("kdesrc-build will not run a program as root unless you really are root.");
        exit 1;
    }

    debug ("Executing b[r[$program] ", join(' ', @args));

    exit 0 if pretending();

    exec $program, @args or do {
        # If we get to here, that sucks, but don't continue.
        error ("Error executing $program: $!");
        exit 1;
    };
}

# This subroutine is the monitoring process for when using PipeIPC.  It reads
# in all status reports from the source update process and then holds on
# to them.  When the build process is ready to read information we send what
# we have.  Otherwise we're waiting on the update process to send us something.
#
# This convoluted arrangement is required to allow the source update
# process to go from start to finish without undue interruption on it waiting
# to write out its status to the build process which is usually busy.
#
# First parameter is the IPC object to use.
#
# Returns 0 on success, non-zero on failure.
sub handle_monitoring
{
    my $ipc = shift;

    # Setup some file handle sets to use in the select() call.
    # The out ones are copies of the in ones since select() overwrites its
    # parameters.
    my ($win, $wout, $rin, $rout);
    ($win, $rin) = ("") x 2; # Get rid of undefined warnings.

    my @msgs;  # Message queue.

    # Perl uses vec() to setup the file handle sets.  Make some local
    # subroutines to make it suck less in the real code.
    sub setFdInSet($$$) {
        my ($set, $fh, $inSet) = @_;
        vec($set, fileno($fh), 1) = $inSet;
        return $set;
    }

    sub fdIsChosen($$) {
        my ($set, $fh) = @_;
        return vec($set, fileno($fh), 1) == 1;
    }

    # We will write to the build process and read from the update process.
    $win = setFdInSet($win, $ipc->{'toBuild'}, 1);
    $rin = setFdInSet($rin, $ipc->{'fromSvn'}, 1);

    # Start the loop.  We will be waiting on either $win or $rin.  Whenever
    # select() returns we must check both sets.
    for(;;)
    {
        my $numFound = select($rout = $rin, $wout = $win, undef, undef);
        my $selectErr = $!;

        if ($numFound == -1)
        {
            error ("r[mon]: Monitor IPC error: r[$selectErr]");
            return 1;
        }

        # Check for svn updates first.
        if (fdIsChosen($rout, $ipc->{'fromSvn'}))
        {
            my $msg = $ipc->receiveFromUpdater();

            # undef can be returned on EOF as well as error.  EOF means the
            # other side is presumably done.
            if (not defined $msg and not $!)
            {
                $rin = setFdInSet($rin, $ipc->{'fromSvn'}, 0);
                last; # Select no longer needed, just output to build.
            }

            # Don't check for $! first, it seems to always be set to EBADF.
            # Probably I'm screwing up the select() call?
            if (defined $msg)
            {
                push @msgs, $msg;
            }
            else
            {
                error ("r[mon]: Error reading update: r[b[$selectErr]");
                return 1;
            }
        }

        # Now check for build updates.
        if (fdIsChosen($wout, $ipc->{'toBuild'}))
        {
            # If we're here the update is still going.  If we have no messages
            # to send wait for that first.
            if (not @msgs)
            {
                my ($rout2, $numFound2);
                $numFound2 = select($rout2 = $rin, undef, undef, undef);
                $selectErr = $!;

                if ($numFound2 == -1 and $selectErr)
                {
                    error ("r[mon]: Monitor IPC error: r[$selectErr]");
                    return 1;
                }

                # Assume EOF can happen here.
                my $msg = $ipc->receiveFromUpdater();
                $selectErr = $!;
                if (not defined $msg and $selectErr)
                {
                    error ("r[mon]: Monitor IPC error, unexpected disappearance of updater.");
                    error ("r[mon]: Mysterious circumstances: r[b[$selectErr]");
                    return 1;
                }

                push @msgs, $msg if $msg;
            }

            # Send the message (if we got one).
            if (scalar @msgs and !$ipc->sendToBuilder(shift @msgs))
            {
                error ("r[mon]: Build process stopped too soon! r[$!]");
                return 1;
            }
        }
    }

    # Send all remaining messages.
    while (@msgs)
    {
        if (!$ipc->sendToBuilder(shift @msgs))
        {
            error ("r[mon]: Build process stopped too soon! r[$!]");
            return 1;
        }
    }

    return 0;
}

# This subroutine performs the update and build process asynchronously.
#
# Only one thread or process of execution will return from this procedure.
#
# The first parameter should be the IPC object to use, which must support
# concurrency.
#
# Returns 0 on success, non-zero on failure.
sub handle_async_build
{
    # The exact method for async is that two children are forked.  One child
    # is a svn update process.  The other child is a monitor process which will
    # hold status updates from the svn process so that the svn updates may
    # happen without waiting for us to be ready to read.

    my ($ipc, $ctx) = @_;

    my $svnPid = fork;
    if ($svnPid == 0)
    { # child
        $ipc->setUpdater();
        # Avoid calling close subroutines in more than one routine.
        POSIX::_exit (handle_updates ($ipc, $ctx));
    }

    # Parent
    my $monPid = fork;
    if ($monPid == 0)
    { # monitor
        $ipc->setMonitor();
        # Avoid calling close subroutines in more than one routine.
        POSIX::_exit (handle_monitoring ($ipc));
    }

    # Still the parent, let's do the build.
    $ipc->setBuilder();
    my $result = handle_build ($ipc, $ctx);

    # Exit code is in $?.
    waitpid ($svnPid, 0);
    $result = 1 if $? != 0;

    waitpid ($monPid, 0);
    $result = 1 if $? != 0;

    return $result;
}

# Returns the unique entries in the given list, original ordering is not
# maintained.
sub unique_list
{
    # Take advantage of the fact that Perl hashes don't support duplicate
    # keys by stuffing each item in our input list into a hash as a key, then
    # retrieve the keys to get the unique items.
    # Using the hash slice notation @hash{@list} is apparently a bit faster.
    return do { my %tempHash; @tempHash{@_} = (); keys %tempHash; };
}

# Returns a list of module directory IDs that must be kept due to being
# referenced from the "latest" symlink.  It should be called with the "latest"
# directory that is a standard subdirectory of the log directory.
#
# First parameter is the directory to search under for symlinks.  This
# subroutine will call itself recursively if necessary to search under the given
# directory.  Any symlinks are read to see which log directory is pointed to.
sub needed_module_logs
{
    my $logdir = shift;
    my @dirs;

    # A lexicalized var (my $foo) is required in face of recursiveness.
    opendir(my $fh, $logdir) or croak_runtime("Can't opendir $logdir: $!");
    my $dir = readdir($fh);

    while(defined $dir) {
        if (-l "$logdir/$dir") {
            my $link = readlink("$logdir/$dir");
            push @dirs, $link;
        }
        elsif ($dir !~ /^\.{1,2}$/) {
            # Skip . and .. directories (this is a great idea, trust me)
            push @dirs, needed_module_logs("$logdir/$dir");
        }
        $dir = readdir $fh;
    }

    closedir $fh;

    # Convert directory names to numeric IDs.
    @dirs = map { m/(\d{4}-\d\d-\d\d-\d\d)/ } (@dirs);
    return unique_list(@dirs);
}

# This function removes log directories from old kdesrc-build runs.  All log
# directories not referenced by $log_dir/latest somehow are made to go away.
sub cleanup_log_directory
{
    my $ctx = assert_isa(shift, 'ksb::BuildContext');
    my $logdir = $ctx->getSubdirPath('log-dir');

    return 0 if ! -e "$logdir/latest"; # Could happen for error on first run...

    # This glob relies on the date being in the specific format YYYY-MM-DD-ID
    my @dirs = bsd_glob("$logdir/????-??-??-??/", GLOB_NOSORT);
    my @needed = needed_module_logs("$logdir/latest");

    # Convert a list to a hash lookup since Perl lacks a "list-has"
    my %needed_table;
    @needed_table{@needed} = (1) x @needed;

    my $length = scalar @dirs - scalar @needed;
    if ($length > 15) { # Arbitrary man is arbitrary
        note ("Removing y[b[$length] out of g[b[$#dirs] old log directories (this may take some time)...");
    }
    elsif ($length > 0) {
        info ("Removing g[b[$length] out of g[b[$#dirs] old log directories...");
    }

    for my $dir (@dirs) {
        my ($id) = ($dir =~ m/(\d\d\d\d-\d\d-\d\d-\d\d)/);
        safe_rmtree($dir) unless $needed_table{$id};
    }
}

# Script starts.

# Adding in a way to load all the functions without running the program to
# enable some kind of automated QA testing.
if (defined caller && caller eq 'test')
{
    print "kdesrc-build being run from testing framework, BRING IT.\n";
    print "kdesrc-build is version $versionNum\n";
    return 1;
}

my $ctx;
our @atexit_subs;
our $basePid = $$; # Only run exit handlers from the process with the PID we started with.

END {
    # Basically used to call the finish() handler but only when appropriate.
    foreach my $sub (@atexit_subs) {
        &$sub();
    }
}

# Use some exception handling to avoid ucky error messages
eval
{
    # preinit {{{
    # Note: Don't change the order around unless you're sure of what you're
    # doing.

    # Default to colorized output if sending to TTY
    ksb::Debug::setColorfulOutput(-t STDOUT);
    $ctx = ksb::BuildContext->new();
    my $pendingOptions = { };

    # Process --help, --install, etc. first.
    my @modules = process_arguments($ctx, $pendingOptions, @ARGV);

    # Change name and type of command line entries beginning with + to force
    # them to be XML project modules.
    foreach (@modules) {
        if (substr($_->{name}, 0, 1) eq '+') {
            debug ("Forcing ", $_->name(), " to be an XML module");
            $_->setScmType('proj');
            substr($_->{name}, 0, 1) = ''; # Remove first char
        }
    }

    my $fh = $ctx->loadRcFile();

    # If we're still here, read the options
    my @optionModules = read_options($ctx, $fh);
    close $fh;

    # Modify the options read from the rc-file to have the pending changes from
    # the command line.
    foreach my $pendingModule (keys %{$pendingOptions}) {
        my $options = ${$pendingOptions}{$pendingModule};
        my ($module) = grep { $pendingModule eq $_->name() } (@optionModules);

        if (!$module) {
            warning ("Tried to set options for unknown module b[y[$pendingModule]");
            next;
        }

        while (my ($key, $value) = each %{$options}) {
            debug ("Setting pending option $key to $value for $pendingModule");
            $module->setOption($key, $value);
        }
    }

    # Check if we're supposed to drop into an interactive shell instead.  If so,
    # here's the stop off point.

    if (my $prog = $ctx->getOption('#start-program'))
    {
        # @modules is the command line arguments to pass in this case.
        execute_command_line_program($prog, @modules);
    }

    $ctx->setupOperatingEnvironment(); # i.e. niceness, ulimits, etc.

    my $commandLineModules = scalar @modules;

    # Allow named module-sets to be given on the command line.
    if ($commandLineModules) {
        # Copy Module objects from the ones created by read_options
        # since their module-type will actually be set.
        foreach my $module (@modules) {
            my ($optionModule) = grep {$_->name() eq $module->name()} @optionModules;
            $module = $optionModule if defined $optionModule;
        }

        # Modify l10n module inline, if present.
        for (@modules) {
            if ($_->name() eq 'l10n') { $_->setScmType('l10n') }
        }

        # Filter --resume-foo first so entire module-sets can be skipped.
        # Wrap in eval to catch runtime errors
        eval { @modules = applyModuleFilters($ctx, @modules); };
        @modules = expandModuleSets(\@modules, \@optionModules);
        Module->setModuleSource('cmdline');
    }
    else {
        @modules = @optionModules;

        if ($ctx->getOption('kde-languages')) {
            my $l10nModule = Module->new($ctx, 'l10n');
            $l10nModule->setScmType('l10n');
            $l10nModule->setBuildSystem($l10nModule->scm());

            push @modules, $l10nModule;
        }

        Module->setModuleSource('config');
    }

    # Must be done before filtering so that we can filter under module-sets.
    @modules = expandXMLModules($ctx, @modules);

    # Filter --resume-foo options. This might be a second pass, but that should
    # be OK since there's nothing different going on from the first pass in that
    # event.
    @modules = applyModuleFilters($ctx, @modules);

    # Apply kde-languages, by appending needed l10n modules to the end of the
    # build.
    @modules = expandl10nModules($ctx, @modules);

    # If modules were on the command line then they are effectively forced to
    # process unless overridden by command line options as well. If phases
    # *were* overridden on the command line, then no update pass is required
    # (all modules already have correct phases)
    @modules = updateModulePhases(@modules) unless $commandLineModules;

    if (exists $ENV{KDESRC_BUILD_DUMP_CONTEXT}) {
        local $Data::Dumper::Indent = 1;
        local $Data::Dumper::Sortkeys = 1;

        # This method call dumps the first list with the variables named by the
        # second list.
        print Data::Dumper->Dump([$ctx], [qw(ctx)]);
    }

    if (!pretending() && !$ctx->takeLock())
    {
        print "$0 is already running!\n";
        exit 1; # Don't finish(), it's not our lockfile!!
    }
    else
    {
        my $curPid = $$;
        push @atexit_subs, sub { finish($ctx, 99) if $$ == $curPid };
    }
    # }}}

    # execution phase {{{
    my $time = localtime;
    info ("Script started processing at g[$time]") unless pretending();

    $ctx->loadPersistentOptions();
    my $metadataModule;

    # If we have kde-build-metadata we must process it first, ASAP.
    if (grep { $_->name() eq 'kde-build-metadata' } @modules) {
        $metadataModule = shift @modules;
        assert_isa($metadataModule->scm(), 'KDEProjectMetadataUpdate');

        eval {
            super_mkdir($metadataModule->getSourceDir());
            info ("\tDownloading KDE Project module metadata...");
            $metadataModule->scm()->updateInternal();
        };

        if ($@) {
            warning (" b[r[*] Unable to download required metadata for build process");
            warning (" b[r[*] Will attempt to press onward...");
            warning (" b[r[*] Exception message: $@");
        }
    }

    # Reorder if necessary. This involves reading some metadata so wrap in its
    # own exception handler.
    eval {
        if ($metadataModule) {
            my $dependencyFile = $metadataModule->fullpath('source') . '/dependency-data';
            open my $dependencies, '<', $dependencyFile
                or die "Unable to open $dependencyFile: $!";

            my $dependencyResolver = DependencyResolver->new();
            $dependencyResolver->readDependencyData($dependencies);

            my @reorderedModules = $dependencyResolver->resolveDependencies(@modules);

            # If we make it here no exceptions were thrown, so accept the result
            @modules = @reorderedModules;
        }
    };

    if ($@) {
        warning (" r[b[*] Problems encountered trying to sort modules into correct order:");
        warning (" r[b[*] $@");
        warning (" r[b[*] Will attempt to continue.");
    }

    # Add to global module list now that we've filtered everything.
    $ctx->addModule($_) foreach @modules;

    my $result;
    my @update_list = map { $_->name() } ($ctx->modulesInPhase('update'));
    my @build_list = map { $_->name() } ($ctx->modulesInPhase('build'));

    debug ("Update list is ", join (', ', @update_list));
    debug ("Build list is ", join (', ', @build_list));

    # Do some necessary adjusting. Right now this is used for supporting
    # the command-line option shortcut to where you can enter e.g.
    # kdelibs/khtml, and the script will only try to update that part of
    # the module.
    # munge_lists(); # TODO: Unbreak my munge, say you'll work again.

    if ($run_mode eq 'build')
    {
        # No packages to install, we're in build mode

        # What we're going to do is fork another child to perform the svn
        # updates while we build.  Setup for this first by initializing some
        # shared memory.
        my $ipc = 0;

        if ($ctx->getOption('async'))
        {
            $ipc = new PipeIPC;
        }

        if (!$ipc)
        {
            $ipc = new NullIPC;
            whisper ("Using no IPC mechanism\n");

            $result = handle_updates ($ipc, $ctx);
            $result = handle_build ($ipc, $ctx) || $result;
        }
        else
        {
            $result = handle_async_build ($ipc, $ctx);
        }
    }
    elsif ($run_mode eq 'install')
    {
        # Installation mode
        my @installList = $ctx->modulesInPhase('install');

        $result = handle_install ($ctx, @installList);
    }
    elsif ($run_mode eq 'uninstall')
    {
        my @uninstallList = $ctx->modulesInPhase('uninstall');

        # Make handle_uninstall handle in right order (it reverses the order
        # so that the first module uninstalled is the last one installed).
        if (Module->moduleSource() eq 'cmdline') {
            @uninstallList = reverse @uninstallList;
        }

        $result = handle_uninstall ($ctx, @uninstallList);
    }

    cleanup_log_directory($ctx) if $ctx->getOption('purge-old-logs');
    output_failed_module_lists($ctx);

    $time = localtime;
    my $color = '';
    $color = 'r[' if $result;

    info ("${color}Script finished processing at g[$time]") unless pretending();

    @atexit_subs = (); # Clear exit handlers
    finish($ctx, $result);

    # }}}
};

if (my $err = $@)
{
    if (ref $err && $err->isa('BuildException')) {
        print $err->{'exception_type'}, " error: ", $err->{'message'}, "\n";
        print "\tCan't continue, so stopping now.\n";

        if ($err->{'exception_type'} eq 'Internal') {
            print "\nPlease submit a bug against kdesrc-build on http://bugs.kde.org/\n"
        }
    }
    else {
        # We encountered an error.
        print "Encountered an error in the execution of the script.\n";
        print "The error reported was $err\n";
        print "Please submit a bug against kdesrc-build on http://bugs.kde.org/\n";
    }

    exit 99;
}

# vim: set et sw=4 ts=4 fdm=marker: